diff --git a/physics/GFS_cloud_diagnostics.F90 b/physics/GFS_cloud_diagnostics.F90 new file mode 100644 index 000000000..c62cc685d --- /dev/null +++ b/physics/GFS_cloud_diagnostics.F90 @@ -0,0 +1,596 @@ +! ######################################################################################## +! This module contains code to produce the UFS High/Mid/Low cloud-diagnostics. +! This was bundled together with the prognostic cloud modules within the RRTMG implementation. +! For the RRTMGP implementation we propose to keep these diagnostics independent. +! ######################################################################################## +module GFS_cloud_diagnostics + use machine, only: kind_phys + use physparam, only: iovrlw, iovrsw, ivflip, icldflg, idcor + + ! Module parameters (imported directly from radiation_cloud.f) + integer, parameter :: & + NF_CLDS = 9, & ! Number of fields in cloud array + NK_CLDS = 3 ! Number of cloud vertical domains + real(kind_phys), parameter :: & + climit = 0.001, & ! Lowest allowable cloud-fraction + ovcst = 1.0 - 1.0e-8 ! Overcast cloud-fraction 0.999999999 + real(kind_phys), parameter, dimension(NK_CLDS+1,2) :: & + ptopc = reshape(source=(/ 1050., 650., 400., 0.0, 1050., 750., 500., 0.0 /), & + shape=(/NK_CLDS+1,2/)) + + ! Version tag and last revision date + character(40), parameter :: VTAGCLD='UFS-cloud-diagnostics vX.x May 2020 ' + + ! Module variables + integer :: & + iovr = 1, & ! Cloud overlap used for diagnostic HML cloud outputs + llyr = 2 ! Upper limit of boundary layer clouds + + public GFS_cloud_diagnostics_run, GFS_cloud_diagnostics_init,& + GFS_cloud_diagnostics_finalize, hml_cloud_diagnostics_init +contains + ! ###################################################################################### + ! ###################################################################################### + subroutine GFS_cloud_diagnostics_init() + end subroutine GFS_cloud_diagnostics_init + + ! ###################################################################################### + ! ###################################################################################### +!! \section arg_table_GFS_cloud_diagnostics_run +!! \htmlinclude GFS_cloud_diagnostics_run.html +!! + subroutine GFS_cloud_diagnostics_run(nCol, nLev, lsswr, lslwr, lat, de_lgth, p_lay, & + cld_frac, p_lev, deltaZ, cloud_overlap_param, precip_overlap_param, con_pi, & + mbota, mtopa, cldsa, errmsg, errflg) + implicit none + + ! Inputs + integer, intent(in) :: & + nCol, & ! Number of horizontal grid-points + nLev ! Number of vertical-layers + logical, intent(in) :: & + lsswr, & ! Call SW radiation? + lslwr ! Call LW radiation + real(kind_phys), intent(in) :: & + con_pi ! Physical constant: pi + real(kind_phys), dimension(nCol), intent(in) :: & + lat, & ! Latitude + de_lgth ! Decorrelation length + real(kind_phys), dimension(nCol,nLev), intent(in) :: & + p_lay, & ! Pressure at model-layer + cld_frac ! Total cloud fraction + real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & + p_lev ! Pressure at model interfaces + real(kind_phys), dimension(nCol,nLev), intent(in) :: & + deltaZ, & ! Layer thickness (km) + cloud_overlap_param, & ! Cloud-overlap parameter + precip_overlap_param ! Precipitation overlap parameter + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + integer,dimension(ncol,3),intent(out) :: & + mbota, & ! Vertical indices for cloud tops + mtopa ! Vertical indices for cloud bases + real(kind_phys), dimension(ncol,5), intent(out) :: & + cldsa ! Fraction of clouds for low, middle, high, total and BL + + ! Local variables + integer i,id,iCol,iLay,icld + real(kind_phys) :: tem1 + real(kind_phys),dimension(nCol,NK_CLDS+1) :: ptop1 + real(kind_phys),dimension(nCol) :: rlat + real(kind_phys),dimension(nCol,nLev) :: cldcnv + + if (.not. (lsswr .or. lslwr)) return + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! This is set to zero in all of the progcld() routines and passed to gethml(). + cldcnv(:,:) = 0._kind_phys + + do icld = 1, NK_CLDS+1 + tem1 = ptopc(icld,2) - ptopc(icld,1) + do i=1,nCol + rlat(i) = abs(lat(i) / con_pi ) + ptop1(i,icld) = ptopc(icld,1) + tem1*max( 0.0, 4.0*rlat(i)-1.0 ) + enddo + enddo + + ! Compute low, mid, high, total, and boundary layer cloud fractions and clouds top/bottom + ! layer indices for low, mid, and high clouds. The three cloud domain boundaries are + ! defined by ptopc. The cloud overlapping method is defined by control flag 'iovr', which may + ! be different for lw and sw radiation programs. + call gethml(p_lay/100., ptop1, cld_frac, cldcnv, deltaZ, de_lgth, cloud_overlap_param,& + nCol, nLev, cldsa, mtopa, mbota) + + end subroutine GFS_cloud_diagnostics_run + + ! ###################################################################################### + ! ###################################################################################### + subroutine GFS_cloud_diagnostics_finalize() + end subroutine GFS_cloud_diagnostics_finalize + + ! ###################################################################################### + ! Initialization routine for High/Mid/Low cloud diagnostics. + ! ###################################################################################### + subroutine hml_cloud_diagnostics_initialize(imp_physics, imp_physics_fer_hires, & + imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & + imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_mg, nLev, & + mpi_rank, sigmainit, errflg) + implicit none + ! Inputs + integer, intent(in) :: & + imp_physics, & ! Flag for MP scheme + imp_physics_fer_hires, & ! Flag for fer-hires scheme + imp_physics_gfdl, & ! Flag for gfdl scheme + imp_physics_thompson, & ! Flag for thompsonscheme + imp_physics_wsm6, & ! Flag for wsm6 scheme + imp_physics_zhao_carr, & ! Flag for zhao-carr scheme + imp_physics_zhao_carr_pdf, & ! Flag for zhao-carr+PDF scheme + imp_physics_mg ! Flag for MG scheme + integer, intent(in) :: & + nLev, & ! Number of vertical-layers + mpi_rank + real(kind_phys), dimension(nLev+1), intent(in) :: & + sigmainit + ! Outputs + integer, intent(out) :: & + errflg + + ! Local variables + integer :: iLay, kl + + ! Initialize error flag + errflg = 0 + + ! Cloud overlap used for diagnostic HML cloud outputs + iovr = max(iovrsw,iovrlw) + + if (mpi_rank == 0) print *, VTAGCLD !print out version tag + + if ( icldflg == 0 ) then + print *,' - Diagnostic Cloud Method has been discontinued' + errflg = 1 + else + if (mpi_rank == 0) then + print *,' - Using Prognostic Cloud Method' + if (imp_physics == imp_physics_zhao_carr) then + print *,' --- Zhao/Carr/Sundqvist microphysics' + elseif (imp_physics == imp_physics_zhao_carr_pdf) then + print *,' --- zhao/carr/sundqvist + pdf cloud' + elseif (imp_physics == imp_physics_gfdl) then + print *,' --- GFDL Lin cloud microphysics' + elseif (imp_physics == imp_physics_thompson) then + print *,' --- Thompson cloud microphysics' + elseif (imp_physics == imp_physics_wsm6) then + print *,' --- WSM6 cloud microphysics' + elseif (imp_physics == imp_physics_mg) then + print *,' --- MG cloud microphysics' + elseif (imp_physics == imp_physics_fer_hires) then + print *,' --- Ferrier-Aligo cloud microphysics' + else + print *,' !!! ERROR in cloud microphysc specification!!!', & + ' imp_physics (NP3D) =',imp_physics + errflg = 1 + endif + endif + endif + + ! Compute the top of BL cld (llyr), which is the topmost non cld(low) layer for + ! stratiform (at or above lowest 0.1 of the atmosphere). + lab_do_k0 : do iLay = nLev, 2, -1 + kl = iLay + if (sigmainit(iLay) < 0.9e0) exit lab_do_k0 + enddo lab_do_k0 + llyr = kl + + return + end subroutine hml_cloud_diagnostics_initialize + + ! ######################################################################################### + ! ######################################################################################### + subroutine gethml(plyr, ptop1, cldtot, cldcnv, dz, de_lgth, alpha, IX, NLAY, clds, mtop, mbot) + ! =================================================================== ! + ! ! + ! abstract: compute high, mid, low, total, and boundary cloud fractions ! + ! and cloud top/bottom layer indices for model diagnostic output. ! + ! the three cloud domain boundaries are defined by ptopc. the cloud ! + ! overlapping method is defined by control flag 'iovr', which is also ! + ! used by lw and sw radiation programs. ! + ! ! + ! usage: call gethml ! + ! ! + ! subprograms called: none ! + ! ! + ! attributes: ! + ! language: fortran 90 ! + ! machine: ibm-sp, sgi ! + ! ! + ! ! + ! ==================== definition of variables ==================== ! + ! ! + ! input variables: ! + ! plyr (IX,NLAY) : model layer mean pressure in mb (100Pa) ! + ! ptop1 (IX,4) : pressure limits of cloud domain interfaces ! + ! (sfc,low,mid,high) in mb (100Pa) ! + ! cldtot(IX,NLAY) : total or straiform cloud profile in fraction ! + ! cldcnv(IX,NLAY) : convective cloud (for diagnostic scheme only) ! + ! dz (ix,nlay) : layer thickness (km) ! + ! de_lgth(ix) : clouds vertical de-correlation length (km) ! + ! alpha(ix,nlay) : alpha decorrelation parameter ! + ! IX : horizontal dimention ! + ! NLAY : vertical layer dimensions ! + ! ! + ! output variables: ! + ! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! + ! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! + ! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! + ! ! + ! external module variables: (in physparam) ! + ! ivflip : control flag of vertical index direction ! + ! =0: index from toa to surface ! + ! =1: index from surface to toa ! + ! ! + ! internal module variables: ! + ! iovr : control flag for cloud overlap ! + ! =0 random overlapping clouds ! + ! =1 max/ran overlapping clouds ! + ! =2 maximum overlapping ( for mcica only ) ! + ! =3 decorr-length ovlp ( for mcica only ) ! + ! =4 exponential cloud overlap (AER; mcica only) ! + ! =5 exponential-random overlap (AER; mcica only) ! + ! ! + ! ==================== end of description ===================== ! + ! + implicit none! + + ! --- inputs: + integer, intent(in) :: IX, NLAY + + real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, ptop1, & + cldtot, cldcnv, dz + real (kind=kind_phys), dimension(:), intent(in) :: de_lgth + real (kind=kind_phys), dimension(:,:), intent(in) :: alpha + + ! --- outputs + real (kind=kind_phys), dimension(:,:), intent(out) :: clds + + integer, dimension(:,:), intent(out) :: mtop, mbot + + ! --- local variables: + real (kind=kind_phys) :: cl1(IX), cl2(IX), dz1(ix) + real (kind=kind_phys) :: pcur, pnxt, ccur, cnxt, alfa + + integer, dimension(IX):: idom, kbt1, kth1, kbt2, kth2 + integer :: i, k, id, id1, kstr, kend, kinc + + ! + !===> ... begin here + ! + clds(:,:) = 0.0 + + do i = 1, IX + cl1(i) = 1.0 + cl2(i) = 1.0 + enddo + + ! --- total and bl clouds, where cl1, cl2 are fractions of clear-sky view + ! layer processed from surface and up + + !> - Calculate total and BL cloud fractions (maximum-random cloud + !! overlapping is operational). + + if ( ivflip == 0 ) then ! input data from toa to sfc + kstr = NLAY + kend = 1 + kinc = -1 + else ! input data from sfc to toa + kstr = 1 + kend = NLAY + kinc = 1 + endif ! end_if_ivflip + + if ( iovr == 0 ) then ! random overlap + + do k = kstr, kend, kinc + do i = 1, IX + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + if (ccur >= climit) cl1(i) = cl1(i) * (1.0 - ccur) + enddo + + if (k == llyr) then + do i = 1, IX + clds(i,5) = 1.0 - cl1(i) ! save bl cloud + enddo + endif + enddo + + do i = 1, IX + clds(i,4) = 1.0 - cl1(i) ! save total cloud + enddo + + elseif ( iovr == 1 ) then ! max/ran overlap + + do k = kstr, kend, kinc + do i = 1, IX + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + if (ccur >= climit) then ! cloudy layer + cl2(i) = min( cl2(i), (1.0 - ccur) ) + else ! clear layer + cl1(i) = cl1(i) * cl2(i) + cl2(i) = 1.0 + endif + enddo + + if (k == llyr) then + do i = 1, IX + clds(i,5) = 1.0 - cl1(i) * cl2(i) ! save bl cloud + enddo + endif + enddo + + do i = 1, IX + clds(i,4) = 1.0 - cl1(i) * cl2(i) ! save total cloud + enddo + + elseif ( iovr == 2 ) then ! maximum overlap all levels + + cl1(:) = 0.0 + + do k = kstr, kend, kinc + do i = 1, IX + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + if (ccur >= climit) cl1(i) = max( cl1(i), ccur ) + enddo + + if (k == llyr) then + do i = 1, IX + clds(i,5) = cl1(i) ! save bl cloud + enddo + endif + enddo + + do i = 1, IX + clds(i,4) = cl1(i) ! save total cloud + enddo + + elseif ( iovr == 3 ) then ! random if clear-layer divided, + ! otherwise de-corrlength method + do i = 1, ix + dz1(i) = - dz(i,kstr) + enddo + + do k = kstr, kend, kinc + do i = 1, ix + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + if (ccur >= climit) then ! cloudy layer + alfa = exp( -0.5*((dz1(i)+dz(i,k)))/de_lgth(i) ) + dz1(i) = dz(i,k) + cl2(i) = alfa * min(cl2(i), (1.0 - ccur)) & ! maximum part + + (1.0 - alfa) * (cl2(i) * (1.0 - ccur)) ! random part + else ! clear layer + cl1(i) = cl1(i) * cl2(i) + cl2(i) = 1.0 + if (k /= kend) dz1(i) = -dz(i,k+kinc) + endif + enddo + + if (k == llyr) then + do i = 1, ix + clds(i,5) = 1.0 - cl1(i) * cl2(i) ! save bl cloud + enddo + endif + enddo + + do i = 1, ix + clds(i,4) = 1.0 - cl1(i) * cl2(i) ! save total cloud + enddo + + elseif ( iovr == 4 .or. iovr == 5 ) then ! exponential overlap (iovr=4), or + ! exponential-random (iovr=5); + ! distinction defined by alpha + do k = kstr, kend, kinc + do i = 1, ix + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + if (ccur >= climit) then ! cloudy layer + cl2(i) = alpha(i,k) * min(cl2(i), (1.0 - ccur)) & ! maximum part + + (1.0 - alpha(i,k)) * (cl2(i) * (1.0 - ccur)) ! random part + else ! clear layer + cl1(i) = cl1(i) * cl2(i) + cl2(i) = 1.0 + endif + enddo + if (k == llyr) then + do i = 1, ix + clds(i,5) = 1.0 - cl1(i) * cl2(i) ! save bl cloud + enddo + endif + enddo + do i = 1, ix + clds(i,4) = 1.0 - cl1(i) * cl2(i) ! save total cloud + enddo + endif ! end_if_iovr + + ! --- high, mid, low clouds, where cl1, cl2 are cloud fractions + ! layer processed from one layer below llyr and up + ! --- change! layer processed from surface to top, so low clouds will + ! contains both bl and low clouds. + + !> - Calculte high, mid, low cloud fractions and vertical indices of + !! cloud tops/bases. + if ( ivflip == 0 ) then ! input data from toa to sfc + + do i = 1, IX + cl1 (i) = 0.0 + cl2 (i) = 0.0 + kbt1(i) = NLAY + kbt2(i) = NLAY + kth1(i) = 0 + kth2(i) = 0 + idom(i) = 1 + mbot(i,1) = NLAY + mtop(i,1) = NLAY + mbot(i,2) = NLAY - 1 + mtop(i,2) = NLAY - 1 + mbot(i,3) = NLAY - 1 + mtop(i,3) = NLAY - 1 + enddo + + !org do k = llyr-1, 1, -1 + do k = NLAY, 1, -1 + do i = 1, IX + id = idom(i) + id1= id + 1 + + pcur = plyr(i,k) + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + + if (k > 1) then + pnxt = plyr(i,k-1) + cnxt = min( ovcst, max( cldtot(i,k-1), cldcnv(i,k-1) )) + else + pnxt = -1.0 + cnxt = 0.0 + endif + + if (pcur < ptop1(i,id1)) then + id = id + 1 + id1= id1 + 1 + idom(i) = id + endif + + if (ccur >= climit) then + if (kth2(i) == 0) kbt2(i) = k + kth2(i) = kth2(i) + 1 + + if ( iovr == 0 ) then + cl2(i) = cl2(i) + ccur - cl2(i)*ccur + else + cl2(i) = max( cl2(i), ccur ) + endif + + if (cnxt < climit .or. pnxt < ptop1(i,id1)) then + kbt1(i) = nint( (cl1(i)*kbt1(i) + cl2(i)*kbt2(i) ) & + / (cl1(i) + cl2(i)) ) + kth1(i) = nint( (cl1(i)*kth1(i) + cl2(i)*kth2(i) ) & + / (cl1(i) + cl2(i)) ) + cl1 (i) = cl1(i) + cl2(i) - cl1(i)*cl2(i) + + kbt2(i) = k - 1 + kth2(i) = 0 + cl2 (i) = 0.0 + endif ! end_if_cnxt_or_pnxt + endif ! end_if_ccur + + if (pnxt < ptop1(i,id1)) then + clds(i,id) = cl1(i) + mtop(i,id) = min( kbt1(i), kbt1(i)-kth1(i)+1 ) + mbot(i,id) = kbt1(i) + + cl1 (i) = 0.0 + kbt1(i) = k - 1 + kth1(i) = 0 + + if (id1 <= NK_CLDS) then + mbot(i,id1) = kbt1(i) + mtop(i,id1) = kbt1(i) + endif + endif ! end_if_pnxt + + enddo ! end_do_i_loop + enddo ! end_do_k_loop + + else ! input data from sfc to toa + + do i = 1, IX + cl1 (i) = 0.0 + cl2 (i) = 0.0 + kbt1(i) = 1 + kbt2(i) = 1 + kth1(i) = 0 + kth2(i) = 0 + idom(i) = 1 + mbot(i,1) = 1 + mtop(i,1) = 1 + mbot(i,2) = 2 + mtop(i,2) = 2 + mbot(i,3) = 2 + mtop(i,3) = 2 + enddo + + !org do k = llyr+1, NLAY + do k = 1, NLAY + do i = 1, IX + id = idom(i) + id1= id + 1 + + pcur = plyr(i,k) + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + + if (k < NLAY) then + pnxt = plyr(i,k+1) + cnxt = min( ovcst, max( cldtot(i,k+1), cldcnv(i,k+1) )) + else + pnxt = -1.0 + cnxt = 0.0 + endif + + if (pcur < ptop1(i,id1)) then + id = id + 1 + id1= id1 + 1 + idom(i) = id + endif + + if (ccur >= climit) then + if (kth2(i) == 0) kbt2(i) = k + kth2(i) = kth2(i) + 1 + + if ( iovr == 0 ) then + cl2(i) = cl2(i) + ccur - cl2(i)*ccur + else + cl2(i) = max( cl2(i), ccur ) + endif + + if (cnxt < climit .or. pnxt < ptop1(i,id1)) then + kbt1(i) = nint( (cl1(i)*kbt1(i) + cl2(i)*kbt2(i)) & + / (cl1(i) + cl2(i)) ) + kth1(i) = nint( (cl1(i)*kth1(i) + cl2(i)*kth2(i)) & + / (cl1(i) + cl2(i)) ) + cl1 (i) = cl1(i) + cl2(i) - cl1(i)*cl2(i) + + kbt2(i) = k + 1 + kth2(i) = 0 + cl2 (i) = 0.0 + endif ! end_if_cnxt_or_pnxt + endif ! end_if_ccur + + if (pnxt < ptop1(i,id1)) then + clds(i,id) = cl1(i) + mtop(i,id) = max( kbt1(i), kbt1(i)+kth1(i)-1 ) + mbot(i,id) = kbt1(i) + + cl1 (i) = 0.0 + kbt1(i) = min(k+1, nlay) + kth1(i) = 0 + + if (id1 <= NK_CLDS) then + mbot(i,id1) = kbt1(i) + mtop(i,id1) = kbt1(i) + endif + endif ! end_if_pnxt + + enddo ! end_do_i_loop + enddo ! end_do_k_loop + + endif ! end_if_ivflip + + ! + return + !................................... + end subroutine gethml +end module GFS_cloud_diagnostics diff --git a/physics/GFS_cloud_diagnostics.meta b/physics/GFS_cloud_diagnostics.meta new file mode 100644 index 000000000..f78a76490 --- /dev/null +++ b/physics/GFS_cloud_diagnostics.meta @@ -0,0 +1,159 @@ +######################################################################## +[ccpp-arg-table] + name = GFS_cloud_diagnostics_run + type = scheme +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lat] + standard_name = latitude + long_name = latitude + units = radian + dimensions = (horizontal_dimension) + type = real + intent = in + kind = kind_phys + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[mtopa] + standard_name = model_layer_number_at_cloud_top + long_name = vertical indices for low, middle and high cloud tops + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = out + optional = F +[mbota] + standard_name = model_layer_number_at_cloud_base + long_name = vertical indices for low, middle and high cloud bases + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = out + optional = F +[de_lgth] + standard_name = cloud_decorrelation_length + long_name = cloud decorrelation length + units = km + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[deltaZ] + standard_name = layer_thickness + long_name = layer_thickness + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cloud_overlap_param] + standard_name = cloud_overlap_param + long_name = cloud overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[precip_overlap_param] + standard_name = precip_overlap_param + long_name = precipitation overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cldsa] + standard_name = cloud_area_fraction_for_radiation + long_name = fraction of clouds for low, middle, high, total and BL + units = frac + dimensions = (horizontal_dimension,5) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F \ No newline at end of file diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 new file mode 100644 index 000000000..b67b22d41 --- /dev/null +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -0,0 +1,234 @@ +! ######################################################################################## +! This module contains the interface between the GFDL macrophysics and the RRTMGP radiation +! schemes. Only compatable with Model%imp_physics = Model%imp_physics_gfdl +! ######################################################################################## +module GFS_rrtmgp_gfdlmp_pre + use machine, only: kind_phys + use physparam, only: lcnorm, lcrick, idcor, iovrlw, iovrsw + use rrtmgp_aux, only: check_error_msg + use module_radiation_clouds, only: get_alpha_exp, get_alpha_dcorr + ! Parameters + real(kind_phys), parameter :: & + reliq_def = 10.0 , & ! Default liq radius to 10 micron (used when effr_in=F) + reice_def = 50.0, & ! Default ice radius to 50 micron (used when effr_in=F) + rerain_def = 1000.0, & ! Default rain radius to 1000 micron (used when effr_in=F) + resnow_def = 250.0, & ! Default snow radius to 250 micron (used when effr_in=F) + reice_min = 10.0, & ! Minimum ice size allowed by scheme + reice_max = 150.0, & ! Maximum ice size allowed by scheme + cllimit = 0.001 ! Lowest cloud fraction in GFDL MP scheme + + public GFS_rrtmgp_gfdlmp_pre_init, GFS_rrtmgp_gfdlmp_pre_run, GFS_rrtmgp_gfdlmp_pre_finalize + +contains + ! ###################################################################################### + ! ###################################################################################### + subroutine GFS_rrtmgp_gfdlmp_pre_init() + end subroutine GFS_rrtmgp_gfdlmp_pre_init + + ! ###################################################################################### + ! ###################################################################################### +!! \section arg_table_GFS_rrtmgp_gfdlmp_pre_run +!! \htmlinclude GFS_rrtmgp_gfdlmp_pre_run.html +!! + subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, & + i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, yearlen, lsswr, lslwr, effr_in, julian,& + lat, p_lev, p_lay, tv_lay, effrin_cldliq, effrin_cldice, effrin_cldrain, & + effrin_cldsnow, tracer, con_pi, con_g, con_rd, con_epsq, & + cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & + cld_rerain, precip_frac, cloud_overlap_param, precip_overlap_param, de_lgth, & + deltaZ, errmsg, errflg) + implicit none + + ! Inputs + integer, intent(in) :: & + nCol, & ! Number of horizontal grid points + nLev, & ! Number of vertical layers + ncnd, & ! Number of cloud condensation types. + nTracers, & ! Number of tracers from model. + i_cldliq, & ! Index into tracer array for cloud liquid. + i_cldice, & ! Index into tracer array for cloud ice. + i_cldrain, & ! Index into tracer array for cloud rain. + i_cldsnow, & ! Index into tracer array for cloud snow. + i_cldgrpl, & ! Index into tracer array for cloud groupel. + i_cldtot, & ! Index into tracer array for cloud total amount. + yearlen ! Length of current year (365/366) WTF? + logical, intent(in) :: & + lsswr, & ! Call SW radiation? + lslwr, & ! Call LW radiation + effr_in ! Provide hydrometeor radii from macrophysics? + real(kind_phys), intent(in) :: & + julian, & ! Julian day + con_pi, & ! Physical constant: pi + con_g, & ! Physical constant: gravitational constant + con_rd, & ! Physical constant: gas-constant for dry air + con_epsq ! Physical constant(?): Minimum value for specific humidity + real(kind_phys), dimension(nCol), intent(in) :: & + lat ! Latitude + real(kind_phys), dimension(nCol,nLev), intent(in) :: & + tv_lay, & ! Virtual temperature (K) + p_lay, & ! Pressure at model-layers (Pa) + effrin_cldliq, & ! Effective radius for liquid cloud-particles (microns) + effrin_cldice, & ! Effective radius for ice cloud-particles (microns) + effrin_cldrain, & ! Effective radius for rain cloud-particles (microns) + effrin_cldsnow ! Effective radius for snow cloud-particles (microns) + real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & + p_lev ! Pressure at model-level interfaces (Pa) + real(kind_phys), dimension(nCol, nLev, nTracers),intent(in) :: & + tracer ! Cloud condensate amount in layer by type () + + ! Outputs + real(kind_phys), dimension(nCol),intent(out) :: & + de_lgth ! Decorrelation length + real(kind_phys), dimension(nCol,nLev),intent(out) :: & + cld_frac, & ! Total cloud fraction + cld_lwp, & ! Cloud liquid water path + cld_reliq, & ! Cloud liquid effective radius + cld_iwp, & ! Cloud ice water path + cld_reice, & ! Cloud ice effecive radius + cld_swp, & ! Cloud snow water path + cld_resnow, & ! Cloud snow effective radius + cld_rwp, & ! Cloud rain water path + cld_rerain, & ! Cloud rain effective radius + precip_frac, & ! Precipitation fraction + cloud_overlap_param, & ! Cloud-overlap parameter + precip_overlap_param, & ! Precipitation overlap parameter + deltaZ ! Layer thickness (km) + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + + ! Local variables + real(kind_phys) :: tem1 + real(kind_phys), dimension(nCol, nLev, min(4,ncnd)) :: cld_condensate + integer :: iCol,iLay,l,ncndl,iovr + real(kind_phys), dimension(nCol,nLev) :: deltaP + + if (.not. (lsswr .or. lslwr)) return + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Test inputs + if (ncnd .ne. 5) then + errmsg = 'Incorrect number of cloud condensates provided' + errflg = 1 + call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) + return + endif + ! + if (lcrick) then + errmsg = 'Namelist option lcrick is not supported.' + errflg = 1 + call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) + return + endif + ! + if (lcnorm) then + errmsg = 'Namelist option lcnorm is not supported.' + errflg = 1 + call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) + return + endif + + ! Initialize outputs + cld_lwp(:,:) = 0.0 + cld_reliq(:,:) = 0.0 + cld_iwp(:,:) = 0.0 + cld_reice(:,:) = 0.0 + cld_rwp(:,:) = 0.0 + cld_rerain(:,:) = 0.0 + cld_swp(:,:) = 0.0 + cld_resnow(:,:) = 0.0 + + ! #################################################################################### + ! Pull out cloud information for GFDL MP scheme. + ! #################################################################################### + ! Condensate + cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,i_cldliq) ! -liquid water + cld_condensate(1:nCol,1:nLev,2) = tracer(1:nCol,1:nLev,i_cldice) ! -ice water + cld_condensate(1:nCol,1:nLev,3) = tracer(1:nCol,1:nLev,i_cldrain) ! -rain water + cld_condensate(1:nCol,1:nLev,4) = tracer(1:nCol,1:nLev,i_cldsnow) + &! -snow + grapuel + tracer(1:nCol,1:nLev,i_cldgrpl) + + ! Since we combine the snow and grapuel, define local variable for number of condensate types. + ncndl = min(4,ncnd) + + ! Set really tiny suspended particle amounts to clear + do l=1,ncndl + do iLay=1,nLev + do iCol=1,nCol + if (cld_condensate(iCol,iLay,l) < con_epsq) cld_condensate(iCol,iLay,l) = 0.0 + enddo + enddo + enddo + + ! Cloud-fraction + cld_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,i_cldtot) + + ! Precipitation fraction (Hack. For now use cloud-fraction) + precip_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,i_cldtot) + + ! Condensate and effective size + deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. + do iLay = 1, nLev + do iCol = 1, nCol + ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) + if (cld_frac(iCol,iLay) .ge. cllimit) then + tem1 = (1.0e5/con_g) * deltaP(iCol,iLay) + cld_lwp(iCol,iLay) = cld_condensate(iCol,iLay,1) * tem1 + cld_iwp(iCol,iLay) = cld_condensate(iCol,iLay,2) * tem1 + cld_rwp(iCol,iLay) = cld_condensate(iCol,iLay,3) * tem1 + cld_swp(iCol,iLay) = cld_condensate(iCol,iLay,4) * tem1 + endif + ! Use radii provided from the macrophysics + if (effr_in) then + cld_reliq(iCol,iLay) = effrin_cldliq(iCol,iLay) + cld_reice(iCol,iLay) = max(reice_min, min(reice_max,effrin_cldice(iCol,iLay))) + cld_rerain(iCol,iLay) = effrin_cldrain(iCol,iLay) + cld_resnow(iCol,iLay) = effrin_cldsnow(iCol,iLay) + else + cld_reliq(iCol,iLay) = reliq_def + cld_reice(iCol,iLay) = reice_def + cld_rerain(iCol,iLay) = rerain_def + cld_resnow(iCol,iLay) = resnow_def + endif + enddo + enddo + + ! #################################################################################### + ! Cloud (and precipitation) overlap + ! #################################################################################### + + iovr = max(iovrsw,iovrlw) + + ! Compute layer-thickness + do iCol=1,nCol + do iLay=1,nLev + 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 + enddo + + ! + ! Cloud overlap parameter + ! + if (iovr == 3) then + call get_alpha_dcorr(nCol, nLev, lat, con_pi, deltaZ, de_lgth, cloud_overlap_param) + endif + if (iovr == 4 .or. iovr == 5) then + call get_alpha_exp(nCol, nLev, deltaZ, iovr, lat, julian, yearlen, cld_frac, cloud_overlap_param) + endif + + ! + ! Compute precipitation overlap parameter (Hack. Using same as cloud for now) + ! + precip_overlap_param = cloud_overlap_param + + end subroutine GFS_rrtmgp_gfdlmp_pre_run + + ! ######################################################################################### + ! ######################################################################################### + subroutine GFS_rrtmgp_gfdlmp_pre_finalize() + end subroutine GFS_rrtmgp_gfdlmp_pre_finalize +end module GFS_rrtmgp_gfdlmp_pre diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta new file mode 100644 index 000000000..932ffeb8f --- /dev/null +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -0,0 +1,385 @@ +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmgp_gfdlmp_pre_run + type = scheme +[nCol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[nTracers] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ncnd] + standard_name = number_of_cloud_condensate_types + long_name = number of cloud condensate types + units = count + dimensions = () + type = integer + intent = in + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[effr_in] + standard_name = flag_for_cloud_effective_radii + long_name = flag for cloud effective radii calculations in GFDL microphysics + units = + dimensions = () + type = logical + intent = in + optional = F +[i_cldliq] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldice] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldrain] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldsnow] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldgrpl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldtot] + standard_name = index_for_cloud_amount + long_name = tracer index for cloud amount integer + units = index + dimensions = () + type = integer + intent = in + optional = F +[effrin_cldliq] + standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um + long_name = eff. radius of cloud liquid water particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[effrin_cldice] + standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um + long_name = eff. radius of cloud ice water particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[effrin_cldrain] + standard_name = effective_radius_of_stratiform_cloud_rain_particle_in_um + long_name = effective radius of cloud rain particle in micrometers + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[effrin_cldsnow] + standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um + long_name = effective radius of cloud snow particle in micrometers + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[yearlen] + standard_name = number_of_days_in_year + long_name = number of days in a year + units = days + dimensions = () + type = integer + intent = in + optional = F +[julian] + standard_name = julian_day + long_name = julian day + units = days + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lat] + standard_name = latitude + long_name = latitude + units = radian + dimensions = (horizontal_dimension) + type = real + intent = in + kind = kind_phys + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tracer] + standard_name = chemical_tracers + long_name = chemical tracers + units = g g-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_epsq] + standard_name = minimum_value_of_specific_humidity + long_name = floor value for specific humidity + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[de_lgth] + standard_name = cloud_decorrelation_length + long_name = cloud decorrelation length + units = km + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_lwp] + standard_name = cloud_liquid_water_path + long_name = layer cloud liquid water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_reliq] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_iwp] + standard_name = cloud_ice_water_path + long_name = layer cloud ice water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_reice] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_swp] + standard_name = cloud_snow_water_path + long_name = layer cloud snow water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_resnow] + standard_name = mean_effective_radius_for_snow_flake + long_name = mean effective radius for snow cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_rwp] + standard_name = cloud_rain_water_path + long_name = layer cloud rain water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_rerain] + standard_name = mean_effective_radius_for_rain_drop + long_name = mean effective radius for rain cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[precip_frac] + standard_name = precipitation_fraction_by_layer + long_name = precipitation fraction in each layer + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cloud_overlap_param] + standard_name = cloud_overlap_param + long_name = cloud overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[precip_overlap_param] + standard_name = precip_overlap_param + long_name = precipitation overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[deltaZ] + standard_name = layer_thickness + long_name = layer_thickness + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F \ No newline at end of file diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 index 103d88274..a6b37acfc 100644 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -1,11 +1,5 @@ module GFS_rrtmgp_lw_post - use machine, only: kind_phys - use GFS_typedefs, only: GFS_coupling_type, & - GFS_control_type, & - GFS_grid_type, & - GFS_radtend_type, & - GFS_statein_type, & - GFS_diag_type + use machine, only: kind_phys use module_radiation_aerosols, only: NSPC1 use module_radlw_parameters, only: topflw_type, sfcflw_type, proflw_type ! RRTMGP DDT's @@ -26,79 +20,84 @@ end subroutine GFS_rrtmgp_lw_post_init ! ######################################################################################### ! SUBROUTINE GFS_rrtmgp_lw_post_run - ! ######################################################################################### + ! ######################################################################################## !> \section arg_table_GFS_rrtmgp_lw_post_run !! \htmlinclude GFS_rrtmgp_lw_post.html !! - subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statein, im, & - p_lev, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky,& - raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, & - flxprf_lw, errmsg, errflg) + 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, sfcdlw, & + sfcflw, tsflw, htrlw, topflw, flxprf_lw, htrlwc, errmsg, errflg) - ! Inputs - type(GFS_control_type), intent(in) :: & - Model ! Fortran DDT: FV3-GFS model control parameters - type(GFS_grid_type), intent(in) :: & - Grid ! Fortran DDT: FV3-GFS grid and interpolation related data - type(GFS_statein_type), intent(in) :: & - Statein ! Fortran DDT: FV3-GFS prognostic state data in from dycore + ! Inputs integer, intent(in) :: & - im ! Horizontal loop extent - real(kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: & + nCol, & ! Horizontal loop extent + nLev ! Number of vertical layers + logical, intent(in) :: & + lslwr, & ! Logical flags for lw radiation calls + do_lw_clrsky_hr, & ! Output clear-sky SW heating-rate? + save_diag ! Output radiation diagnostics? + real(kind_phys), intent(in) :: & + fhlwr ! Frequency for SW radiation + real(kind_phys), dimension(nCol), intent(in) :: & tsfa ! Lowest model layer air temperature for radiation (K) - real(kind_phys), dimension(size(Grid%xlon,1), Model%levs+1), intent(in) :: & - p_lev ! Pressure @ model layer-interfaces (hPa) - real(kind_phys), dimension(size(Grid%xlon,1), Model%levs+1), intent(in) :: & + real(kind_phys), dimension(nCol, nLev), intent(in) :: & + t_lay ! Temperature @ model layer centers (K) + real(kind_phys), dimension(nCol, nLev+1), intent(in) :: & + p_lev, & ! Pressure @ model layer-interfaces (Pa) fluxlwUP_allsky, & ! RRTMGP longwave all-sky flux (W/m2) fluxlwDOWN_allsky, & ! RRTMGP longwave all-sky flux (W/m2) fluxlwUP_clrsky, & ! RRTMGP longwave clear-sky flux (W/m2) fluxlwDOWN_clrsky ! RRTMGP longwave clear-sky flux (W/m2) real(kind_phys), intent(in) :: & raddt ! Radiation time step - real(kind_phys), dimension(im,NSPC1), intent(in) :: & + real(kind_phys), dimension(nCol,NSPC1), intent(in) :: & aerodp ! Vertical integrated optical depth for various aerosol species - real(kind_phys), dimension(im,5), intent(in) :: & + real(kind_phys), dimension(nCol,5), intent(in) :: & cldsa ! Fraction of clouds for low, middle, high, total and BL - integer, dimension(im,3), intent(in) ::& + integer, dimension(nCol,3), intent(in) ::& mbota, & ! vertical indices for low, middle and high cloud tops mtopa ! vertical indices for low, middle and high cloud bases - real(kind_phys), dimension(im,Model%levs), intent(in) :: & + real(kind_phys), dimension(nCol,nLev), intent(in) :: & cld_frac, & ! Total cloud fraction in each layer cldtaulw ! approx 10.mu band layer cloud optical depth - real(kind_phys),dimension(size(Grid%xlon,1), Model%levs) :: & - hlwc, & ! Longwave all-sky heating-rate (K/sec) - hlw0 ! Longwave clear-sky heating-rate (K/sec) ! Outputs (mandatory) + real(kind_phys), dimension(nCol), intent(out) :: & + sfcdlw, & ! Total sky sfc downward lw flux (W/m2) + tsflw ! surface air temp during lw calculation (K) + type(sfcflw_type), dimension(nCol), intent(out) :: & + sfcflw ! LW radiation fluxes at sfc + real(kind_phys), dimension(nCol,nLev), intent(out) :: & + htrlw ! LW all-sky heating rate + type(topflw_type), dimension(nCol), intent(out) :: & + topflw ! lw_fluxes_top_atmosphere character(len=*), intent(out) :: & errmsg integer, intent(out) :: & errflg - type(GFS_coupling_type), intent(inout) :: & - Coupling ! Fortran DDT: FV3-GFS fields to/from coupling with other components - type(GFS_radtend_type), intent(inout) :: & - Radtend ! Fortran DDT: FV3-GFS radiation tendencies - type(GFS_diag_type), intent(inout) :: & - Diag ! Fortran DDT: FV3-GFS diagnotics data - + ! Outputs (optional) - type(proflw_type), dimension(size(Grid%xlon,1), Model%levs+1), optional, intent(inout) :: & + type(proflw_type), dimension(nCol, nLev+1), optional, intent(out) :: & 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(out),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 real(kind_phys) :: tem0d, tem1, tem2 + real(kind_phys),dimension(nCol,nLev) :: hlwc ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (.not. Model%lslwr) return + if (.not. lslwr) return ! Are any optional outputs requested? l_fluxeslw2d = present(flxprf_lw) @@ -106,72 +105,59 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei ! ####################################################################################### ! What is vertical ordering? ! ####################################################################################### - top_at_1 = (p_lev(1,1) .lt. p_lev(1, Model%levs)) + top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) if (top_at_1) then - iSFC = Model%levs+1 + iSFC = nLev+1 iTOA = 1 else iSFC = 1 - iTOA = Model%levs+1 + iTOA = nLev+1 endif ! ####################################################################################### ! Compute LW heating-rates. ! ####################################################################################### - if (Model%lslwr) then - ! Clear-sky heating-rate (optional) - if (Model%lwhtr) then - call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & - fluxlwUP_clrsky, & ! IN - RRTMGP upward longwave clear-sky flux profiles (W/m2) - fluxlwDOWN_clrsky, & ! IN - RRTMGP downward longwave clear-sky flux profiles (W/m2) - p_lev, & ! IN - Pressure @ layer-interfaces (Pa) - hlw0)) ! OUT - Longwave clear-sky heating rate (K/sec) - endif - ! All-sky heating-rate (mandatory) - call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & - fluxlwUP_allsky, & ! IN - RRTMGP upward longwave all-sky flux profiles (W/m2) - fluxlwDOWN_allsky, & ! IN - RRTMGP downward longwave all-sky flux profiles (W/m2) - p_lev, & ! IN - Pressure @ layer-interfaces (Pa) - hlwc)) ! OUT - Longwave all-sky heating rate (K/sec) - - ! Copy fluxes from RRTGMP types into model radiation types. - ! Mandatory outputs - Diag%topflw(:)%upfxc = fluxlwUP_allsky(:,iTOA) - Diag%topflw(:)%upfx0 = fluxlwUP_clrsky(:,iTOA) - Radtend%sfcflw(:)%upfxc = fluxlwUP_allsky(:,iSFC) - Radtend%sfcflw(:)%upfx0 = fluxlwUP_clrsky(:,iSFC) - Radtend%sfcflw(:)%dnfxc = fluxlwDOWN_allsky(:,iSFC) - Radtend%sfcflw(:)%dnfx0 = fluxlwDOWN_clrsky(:,iSFC) - - ! Optional outputs - if(l_fluxeslw2d) then - flxprf_lw%upfxc = fluxlwUP_allsky - flxprf_lw%dnfxc = fluxlwDOWN_allsky - flxprf_lw%upfx0 = fluxlwUP_clrsky - flxprf_lw%dnfx0 = fluxlwDOWN_clrsky - endif + ! Clear-sky heating-rate (optional) + if (do_lw_clrsky_hr) then + call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & + fluxlwUP_clrsky, & ! IN - RRTMGP upward longwave clear-sky flux profiles (W/m2) + fluxlwDOWN_clrsky, & ! IN - RRTMGP downward longwave clear-sky flux profiles (W/m2) + p_lev, & ! IN - Pressure @ layer-interfaces (Pa) + htrlwc)) ! OUT - Longwave clear-sky heating rate (K/sec) endif + ! All-sky heating-rate (mandatory) + call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & + fluxlwUP_allsky, & ! IN - RRTMGP upward longwave all-sky flux profiles (W/m2) + fluxlwDOWN_allsky, & ! IN - RRTMGP downward longwave all-sky flux profiles (W/m2) + p_lev, & ! IN - Pressure @ layer-interfaces (Pa) + htrlw)) ! OUT - Longwave all-sky heating rate (K/sec) + ! ####################################################################################### - ! Save LW outputs. + ! Save LW outputs. ! ####################################################################################### - if (Model%lslwr) then - ! Save surface air temp for diurnal adjustment at model t-steps - Radtend%tsflw (:) = tsfa(:) - - ! All-sky heating rate profile - do k = 1, model%levs - Radtend%htrlw(1:im,k) = hlwc(1:im,k) - enddo - if (Model%lwhtr) then - do k = 1, model%levs - Radtend%lwhc(1:im,k) = hlw0(1:im,k) - enddo - endif + ! Copy fluxes from RRTGMP types into model radiation types. + ! Mandatory outputs + topflw(:)%upfxc = fluxlwUP_allsky(:,iTOA) + topflw(:)%upfx0 = fluxlwUP_clrsky(:,iTOA) + sfcflw(:)%upfxc = fluxlwUP_allsky(:,iSFC) + sfcflw(:)%upfx0 = fluxlwUP_clrsky(:,iSFC) + sfcflw(:)%dnfxc = fluxlwDOWN_allsky(:,iSFC) + sfcflw(:)%dnfx0 = fluxlwDOWN_clrsky(:,iSFC) - ! Radiation fluxes for other physics processes - Coupling%sfcdlw(:) = Radtend%sfcflw(:)%dnfxc - endif + ! 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(:) + + ! Radiation fluxes for other physics processes + sfcdlw(:) = sfcflw(:)%dnfxc ! ####################################################################################### ! Save LW diagnostics @@ -181,45 +167,43 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei ! corresponding slots of array fluxr with appropriate time weights. ! - Collect the fluxr data for wrtsfc ! ####################################################################################### - if (Model%lssav) then - if (Model%lslwr) then - do i=1,im - ! LW all-sky fluxes - Diag%fluxr(i,1 ) = Diag%fluxr(i,1 ) + Model%fhlwr * fluxlwUP_allsky( i,iTOA) ! total sky top lw up - Diag%fluxr(i,19) = Diag%fluxr(i,19) + Model%fhlwr * fluxlwDOWN_allsky(i,iSFC) ! total sky sfc lw dn - Diag%fluxr(i,20) = Diag%fluxr(i,20) + Model%fhlwr * fluxlwUP_allsky( i,iSFC) ! total sky sfc lw up - ! LW clear-sky fluxes - Diag%fluxr(i,28) = Diag%fluxr(i,28) + Model%fhlwr * fluxlwUP_clrsky( i,iTOA) ! clear sky top lw up - Diag%fluxr(i,30) = Diag%fluxr(i,30) + Model%fhlwr * fluxlwDOWN_clrsky(i,iSFC) ! clear sky sfc lw dn - Diag%fluxr(i,33) = Diag%fluxr(i,33) + Model%fhlwr * fluxlwUP_clrsky( i,iSFC) ! clear sky sfc lw up - enddo - - do i=1,im - Diag%fluxr(i,17) = Diag%fluxr(i,17) + raddt * cldsa(i,4) - Diag%fluxr(i,18) = Diag%fluxr(i,18) + raddt * cldsa(i,5) - enddo - - ! Save cld frac,toplyr,botlyr and top temp, note that the order of h,m,l cloud is reversed for - ! the fluxr output. save interface pressure (pa) of top/bot - do j = 1, 3 - do i = 1, IM - tem0d = raddt * cldsa(i,j) - itop = mtopa(i,j) - ibtc = mbota(i,j) - Diag%fluxr(i, 8-j) = Diag%fluxr(i, 8-j) + tem0d - Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * Statein%prsi(i,itop) - Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * Statein%prsi(i,ibtc) - Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * Statein%tgrs(i,itop) - - ! Add optical depth and emissivity output - tem2 = 0. - do k=ibtc,itop - tem2 = tem2 + cldtaulw(i,k) ! approx 10. mu channel - enddo - Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) - enddo - enddo - endif + if (save_diag) then +! do i=1,nCol +! ! LW all-sky fluxes +! Diag%fluxr(i,1 ) = Diag%fluxr(i,1 ) + fhlwr * fluxlwUP_allsky( i,iTOA) ! total sky top lw up +! Diag%fluxr(i,19) = Diag%fluxr(i,19) + fhlwr * fluxlwDOWN_allsky(i,iSFC) ! total sky sfc lw dn +! Diag%fluxr(i,20) = Diag%fluxr(i,20) + fhlwr * fluxlwUP_allsky( i,iSFC) ! total sky sfc lw up +! ! LW clear-sky fluxes +! Diag%fluxr(i,28) = Diag%fluxr(i,28) + fhlwr * fluxlwUP_clrsky( i,iTOA) ! clear sky top lw up +! Diag%fluxr(i,30) = Diag%fluxr(i,30) + fhlwr * fluxlwDOWN_clrsky(i,iSFC) ! clear sky sfc lw dn +! Diag%fluxr(i,33) = Diag%fluxr(i,33) + fhlwr * fluxlwUP_clrsky( i,iSFC) ! clear sky sfc lw up +! enddo +! +! do i=1,nCol +! Diag%fluxr(i,17) = Diag%fluxr(i,17) + raddt * cldsa(i,4) +! Diag%fluxr(i,18) = Diag%fluxr(i,18) + raddt * cldsa(i,5) +! enddo +! +! ! Save cld frac,toplyr,botlyr and top temp, note that the order of h,m,l cloud is reversed for +! ! the fluxr output. save interface pressure (pa) of top/bot +! do j = 1, 3 +! do i = 1, nCol +! tem0d = raddt * cldsa(i,j) +! itop = mtopa(i,j) +! ibtc = mbota(i,j) +! Diag%fluxr(i, 8-j) = Diag%fluxr(i, 8-j) + tem0d +! Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * p_lev(i,itop) +! Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * p_lev(i,ibtc) +! Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * t_lay(i,itop) +! +! ! Add optical depth and emissivity output +! tem2 = 0. +! do k=ibtc,itop +! tem2 = tem2 + cldtaulw(i,k) ! approx 10. mu channel +! enddo +! Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) +! enddo +! enddo endif end subroutine GFS_rrtmgp_lw_post_run diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index dbe96120d..c261a7797 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -1,62 +1,55 @@ [ccpp-arg-table] name = GFS_rrtmgp_lw_post_run type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type - units = DDT +[nCol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count dimensions = () - type = GFS_control_type + type = integer intent = in optional = F -[Grid] - standard_name = GFS_grid_type_instance - long_name = instance of derived type GFS_grid_type - units = DDT +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count dimensions = () - type = GFS_grid_type + type = integer intent = in - optional = F -[Radtend] - standard_name = GFS_radtend_type_instance - long_name = instance of derived type GFS_radtend_type - units = DDT - dimensions = () - type = GFS_radtend_type - intent = inout - optional = F -[Coupling] - standard_name = GFS_coupling_type_instance - long_name = instance of derived type GFS_coupling_type - units = DDT + optional = F +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag dimensions = () - type = GFS_coupling_type - intent = inout - optional = F -[Diag] - standard_name = GFS_diag_type_instance - long_name = instance of derived type GFS_diag_type - units = DDT + type = logical + intent = in + optional = F +[do_lw_clrsky_hr] + standard_name = flag_for_output_of_longwave_heating_rate + long_name = flag to output lw heating rate + units = flag dimensions = () - type = GFS_diag_type - intent = inout - optional = F -[Statein] - standard_name = GFS_statein_type_instance - long_name = instance of derived type GFS_statein_type - units = DDT + type = logical + intent = in + optional = F +[save_diag] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag dimensions = () - type = GFS_statein_type + type = logical intent = in - optional = F -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count + optional = F +[fhlwr] + standard_name = frequency_for_longwave_radiation + long_name = frequency for longwave radiation + units = s dimensions = () - type = integer + type = real + kind = kind_phys intent = in - optional = F + optional = F [tsfa] standard_name = surface_air_temperature_for_radiation long_name = lowest model layer air temperature for radiation @@ -66,6 +59,15 @@ kind = kind_phys intent = in optional = F +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature at vertical layer for radiation calculation + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure level @@ -172,13 +174,65 @@ kind = kind_phys intent = in optional = F +[sfcdlw] + standard_name = surface_downwelling_longwave_flux_on_radiation_time_step + long_name = total sky sfc downward lw flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfcflw] + standard_name = lw_fluxes_sfc + long_name = lw radiation fluxes at sfc + units = W m-2 + dimensions = (horizontal_dimension) + type = sfcflw_type + intent = out + optional = F +[tsflw] + standard_name = surface_midlayer_air_temperature_in_longwave_radiation + long_name = surface air temp during lw calculation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[htrlw] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step + long_name = total sky lw heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[topflw] + standard_name = lw_fluxes_top_atmosphere + long_name = lw radiation fluxes at top + units = W m-2 + dimensions = (horizontal_dimension) + type = topflw_type + intent = out + optional = F [flxprf_lw] standard_name = RRTMGP_lw_fluxes long_name = lw fluxes total sky / csk and up / down at levels units = W m-2 dimensions = (horizontal_dimension,vertical_dimension_plus_one) type = proflw_type - intent = inout + intent = out + optional = T +[htrlwc] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step + long_name = longwave clear sky heating rate + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = out optional = T [errmsg] standard_name = ccpp_error_message diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index a95a0fffd..0e5d65f5c 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -1,56 +1,16 @@ module GFS_rrtmgp_pre - use physparam use machine, only: & kind_phys ! Working type - use GFS_typedefs, only: & - GFS_statein_type, & ! Prognostic state data in from dycore - GFS_stateout_type, & ! Prognostic state or tendencies return to dycore - GFS_sfcprop_type, & ! Surface fields - GFS_coupling_type, & ! Fields to/from coupling with other components (e.g. land/ice/ocean/etc.) - GFS_control_type, & ! Model control parameters - GFS_grid_type, & ! Grid and interpolation related data - GFS_tbd_type, & ! To-Be-Determined data that doesn't fit in any one container - GFS_radtend_type, & ! Radiation tendencies needed in physics - GFS_diag_type ! Fields targetted for diagnostic output - use physcons, only: & - eps => con_eps, & ! Rd/Rv - epsm1 => con_epsm1, & ! Rd/Rv-1 - fvirt => con_fvirt, & ! Rv/Rd-1 - rog => con_rog ! Rd/g - use radcons, only: & - qmin, epsq ! Minimum vlaues for varius calculations use funcphys, only: & fpvs ! Function ot compute sat. vapor pressure over liq. - use module_radiation_astronomy,only: & - coszmn ! Function to compute cos(SZA) use module_radiation_gases, only: & NF_VGAS, & ! Number of active gas species getgases, & ! Routine to setup trace gases getozn ! Routine to setup ozone - use module_radiation_aerosols, only: & - NF_AESW, & ! Number of optical-fields in SW output (3=tau+g+omega) - NF_AELW, & ! Number of optical-fields in LW output (3=tau+g+omega) - setaer, & ! Routine to compute aerosol radiative properties (tau,g,omega) - NSPC1 ! Number of species for vertically integrated aerosol optical-depth - use module_radiation_clouds, only: & - NF_CLDS, & ! Number of fields in "clouds" array (e.g. (cloud(1)=lwp,clouds(2)=ReffLiq,...) - progcld1, & ! Zhao/Moorthi's prognostic cloud scheme - progcld3, & ! Zhao/Moorthi's prognostic cloud+pdfcld - progcld4, & ! GFDL cloud scheme - progcld5, & ! Thompson / WSM6 cloud micrphysics scheme - progclduni ! Unified cloud-scheme - use surface_perturbation, only: & - cdfnor ! Routine to compute CDF (used to compute percentiles) - use module_radiation_surface, only: & - setemis, & ! Routine to compute surface-emissivity - NF_ALBD, & ! Number of surface albedo categories (4; nir-direct, nir-diffuse, uvvis-direct, uvvis-diffuse) - setalb ! Routine to compute surface albedo ! RRTMGP types use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_gas_concentrations, only: ty_gas_concs - use rrtmgp_aux, only: check_error_msg!, rrtmgp_minP, rrtmgp_minT - use mo_rrtmgp_constants, only: grav, avogad - use mo_rrtmg_lw_cloud_optics + use rrtmgp_aux, only: check_error_msg real(kind_phys), parameter :: & amd = 28.9644_kind_phys, & ! Molecular weight of dry-air (g/mol) @@ -85,13 +45,14 @@ module GFS_rrtmgp_pre !! \section arg_table_GFS_rrtmgp_pre_init !! \htmlinclude GFS_rrtmgp_pre_init.html !! - subroutine GFS_rrtmgp_pre_init(Model, active_gases_array, errmsg, errflg) + subroutine GFS_rrtmgp_pre_init(nGases, active_gases, active_gases_array, errmsg, errflg) ! Inputs - type(GFS_control_type), intent(inout) :: & - Model ! DDT: FV3-GFS model control parameters - + integer, intent(in) :: & + nGases ! Number of active gases in RRTMGP + character(len=*), intent(in) :: & + active_gases ! List of active gases from namelist. ! Outputs - character(len=*),dimension(Model%ngases), intent(out) :: & + character(len=*),dimension(nGases), intent(out) :: & active_gases_array ! Character array containing trace gases to include in RRTMGP character(len=*), intent(out) :: & errmsg ! Error message @@ -101,13 +62,13 @@ subroutine GFS_rrtmgp_pre_init(Model, active_gases_array, errmsg, errflg) ! Local variables character(len=1) :: tempstr integer :: ij, count - integer,dimension(Model%ngases,2) :: gasIndices + integer,dimension(nGases,2) :: gasIndices ! Initialize errmsg = '' errflg = 0 - if (len(Model%active_gases) .eq. 0) return + if (len(active_gases) .eq. 0) return ! Which gases are active? Provided via physics namelist. @@ -115,23 +76,23 @@ subroutine GFS_rrtmgp_pre_init(Model, active_gases_array, errmsg, errflg) ! First grab indices in character array corresponding to start:end of gas name. gasIndices(1,1)=1 count=1 - do ij=1,len(Model%active_gases) - tempstr=trim(Model%active_gases(ij:ij)) + do ij=1,len(active_gases) + tempstr=trim(active_gases(ij:ij)) if (tempstr .eq. '_') then gasIndices(count,2)=ij-1 gasIndices(count+1,1)=ij+1 count=count+1 endif enddo - gasIndices(Model%ngases,2)=len(trim(Model%active_gases)) + gasIndices(nGases,2)=len(trim(active_gases)) ! Now extract the gas names - do ij=1,Model%ngases - active_gases_array(ij) = Model%active_gases(gasIndices(ij,1):gasIndices(ij,2)) + do ij=1,nGases + active_gases_array(ij) = active_gases(gasIndices(ij,1):gasIndices(ij,2)) enddo ! Which gases are active? (This is purely for flexibility) - do ij=1,Model%ngases + do ij=1,nGases if(trim(active_gases_array(ij)) .eq. 'h2o') then isActive_h2o = .true. istr_h2o = ij @@ -182,105 +143,92 @@ end subroutine GFS_rrtmgp_pre_init !> \section arg_table_GFS_rrtmgp_pre_run !! \htmlinclude GFS_rrtmgp_pre_run.html !! - subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, Tbd, & ! IN - ncol, lw_gas_props, active_gases_array, & ! IN - sec_diff_byband, raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, cld_frac, cld_lwp,& ! OUT - cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, & ! OUT - tv_lay, relhum, tracer, cldsa, mtopa, mbota, de_lgth, gas_concentrations, & ! OUT - errmsg, errflg) + subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, fhswr, & + fhlwr, xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, active_gases_array, & + con_eps, con_epsm1, con_fvirt, con_epsqs, & + raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, tv_lay, relhum, tracer, & + gas_concentrations, errmsg, errflg) - ! Inputs - type(GFS_control_type), intent(in) :: & - Model ! DDT: FV3-GFS model control parameters - type(GFS_grid_type), intent(in) :: & - Grid ! DDT: FV3-GFS grid and interpolation related data - type(GFS_statein_type), intent(in) :: & - Statein ! DDT: FV3-GFS prognostic state data in from dycore - type(GFS_coupling_type), intent(in) :: & - Coupling ! DDT: FV3-GFS fields to/from coupling with other components - type(GFS_radtend_type), intent(inout) :: & - Radtend ! DDT: FV3-GFS radiation tendencies - type(GFS_sfcprop_type), intent(in) :: & - Sfcprop ! DDT: FV3-GFS surface fields - type(GFS_tbd_type), intent(in) :: & - Tbd ! DDT: FV3-GFS data not yet assigned to a defined container + ! Inputs integer, intent(in) :: & - ncol ! Number of horizontal grid points - type(ty_gas_optics_rrtmgp),intent(in) :: & - lw_gas_props ! RRTMGP DDT: longwave spectral information - character(len=*),dimension(Model%ngases), intent(in) :: & + nCol, & ! Number of horizontal grid points + nLev, & ! Number of vertical layers + nGases, & ! Number of active gases in RRTMGP. + nTracers, & ! Number of tracers from model. + i_o3 ! Index into tracer array for ozone + logical, intent(in) :: & + lsswr, & ! Call SW radiation? + lslwr ! Call LW radiation + character(len=*),dimension(nGases), intent(in) :: & active_gases_array ! Character array containing trace gases to include in RRTMGP + real(kind_phys), intent(in) :: & + fhswr, & ! Frequency of SW radiation call. + fhlwr ! Frequency of LW radiation call. + real(kind_phys), intent(in) :: & + 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) + real(kind_phys), dimension(nCol), intent(in) :: & + xlon, & ! Longitude + xlat, & ! Latitude + tsfc ! Surface skin temperature (K) + real(kind_phys), dimension(nCol,nLev), intent(in) :: & + 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) :: & + prsi ! Pressure at model-interfaces (Pa) + real(kind_phys), dimension(nCol,nLev,nTracers) :: & + qgrs ! Tracer concentrations (kg/kg) ! Outputs - real(kind_phys), dimension(ncol,Model%levs), intent(out) :: & - p_lay, & ! Pressure at model-layer - t_lay ! Temperature at model layer - real(kind_phys), dimension(ncol,Model%levs+1), intent(out) :: & - p_lev, & ! Pressure at model-interface - t_lev ! Temperature at model-interface + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag real(kind_phys), intent(out) :: & raddt ! Radiation time-step real(kind_phys), dimension(ncol), intent(out) :: & tsfg, & ! Ground temperature - tsfa ! Skin temperature + tsfa ! Skin temperature + real(kind_phys), dimension(nCol,nLev), intent(out) :: & + p_lay, & ! Pressure at model-layer + t_lay, & ! Temperature at model layer + tv_lay, & ! Virtual temperature at model-layers + relhum ! Relative-humidity at model-layers + real(kind_phys), dimension(nCol,nLev+1), intent(out) :: & + p_lev, & ! Pressure at model-interface + t_lev ! Temperature at model-interface + real(kind_phys), dimension(nCol, nLev, nTracers),intent(out) :: & + tracer ! Array containing trace gases type(ty_gas_concs),intent(out) :: & gas_concentrations ! RRTMGP DDT: gas volumne mixing ratios - character(len=*), intent(out) :: & - errmsg ! Error message - integer, intent(out) :: & - errflg ! Error flag - real(kind_phys), dimension(ncol,Model%levs),intent(out) :: & - cld_frac, & ! Total cloud fraction - cld_lwp, & ! Cloud liquid water path - cld_reliq, & ! Cloud liquid effective radius - cld_iwp, & ! Cloud ice water path - cld_reice, & ! Cloud ice effecive radius - cld_swp, & ! Cloud snow water path - cld_resnow, & ! Cloud snow effective radius - cld_rwp, & ! Cloud rain water path - cld_rerain ! Cloud rain effective radius - real(kind_phys), dimension(ncol,Model%levs),intent(out) :: & - tv_lay, & ! Virtual temperatue at model-layers - relhum ! Relative-humidity at model-layers - real(kind_phys), dimension(ncol, Model%levs, 2:Model%ntrac),intent(out) :: & - tracer ! Array containing trace gases - integer,dimension(ncol,3),intent(out) :: & - mbota, & ! Vertical indices for cloud tops - mtopa ! Vertical indices for cloud bases - real(kind_phys), dimension(ncol,5), intent(out) :: & - cldsa ! Fraction of clouds for low, middle, high, total and BL - real(kind_phys), dimension(ncol), intent(out) :: & - de_lgth ! Decorrelation length - real(kind_phys), dimension(lw_gas_props%get_nband(),ncol),intent(out) :: & - sec_diff_byband - + ! Local variables integer :: i, j, iCol, iBand, iSFC, iTOA, iLay logical :: top_at_1 - real(kind_phys),dimension(NCOL,Model%levs) :: vmr_o3, vmr_h2o, coldry, tem0, colamt + real(kind_phys),dimension(nCol,nLev) :: vmr_o3, vmr_h2o real(kind_phys) :: es, qs, tem1, tem2 - real(kind_phys), dimension(ncol, NF_ALBD) :: sfcalb - real(kind_phys), dimension(ncol, Model%levs) :: qs_lay, q_lay, deltaZ, deltaP, o3_lay - real(kind_phys), dimension(ncol, Model%levs, NF_VGAS) :: gas_vmr - real(kind_phys), dimension(ncol, Model%levs, NF_CLDS) :: clouds - real(kind_phys), dimension(ncol) :: precipitableH2o + real(kind_phys), dimension(nCol,nLev) :: o3_lay, q_lay + real(kind_phys), dimension(nCol,nLev, NF_VGAS) :: gas_vmr ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (.not. (Model%lsswr .or. Model%lslwr)) return - + if (.not. (lsswr .or. lslwr)) return + ! ####################################################################################### ! What is vertical ordering? ! ####################################################################################### - top_at_1 = (Statein%prsi(1,1) .lt. Statein%prsi(1, Model%levs)) + top_at_1 = (prsi(1,1) .lt. prsi(1, nLev)) if (top_at_1) then - iSFC = Model%levs + iSFC = nLev iTOA = 1 else iSFC = 1 - iTOA = Model%levs + iTOA = nLev endif ! ####################################################################################### @@ -288,42 +236,38 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, ! ####################################################################################### ! Water-vapor mixing-ratio - q_lay(1:ncol,:) = Statein%qgrs(1:NCOL,:,1) + q_lay(1:ncol,:) = qgrs(1:NCOL,:,1) where(q_lay .lt. 1.e-6) q_lay = 1.e-6 ! Pressure at layer-interface - p_lev(1:NCOL,:) = Statein%prsi(1:NCOL,:) + p_lev(1:NCOL,:) = prsi(1:NCOL,:) ! Pressure at layer-center - p_lay(1:NCOL,:) = Statein%prsl(1:NCOL,:) + p_lay(1:NCOL,:) = prsl(1:NCOL,:) ! Temperature at layer-center - t_lay(1:NCOL,:) = Statein%tgrs(1:NCOL,:) + t_lay(1:NCOL,:) = tgrs(1:NCOL,:) ! Temperature at layer-interfaces if (top_at_1) then t_lev(1:NCOL,1) = t_lay(1:NCOL,iTOA) t_lev(1:NCOL,2:iSFC) = (t_lay(1:NCOL,2:iSFC)+t_lay(1:NCOL,1:iSFC-1))/2._kind_phys - t_lev(1:NCOL,iSFC+1) = Sfcprop%tsfc(1:NCOL) + t_lev(1:NCOL,iSFC+1) = tsfc(1:NCOL) else - t_lev(1:NCOL,1) = Sfcprop%tsfc(1:NCOL) + t_lev(1:NCOL,1) = tsfc(1:NCOL) t_lev(1:NCOL,2:iTOA) = (t_lay(1:NCOL,2:iTOA)+t_lay(1:NCOL,1:iTOA-1))/2._kind_phys t_lev(1:NCOL,iTOA+1) = t_lay(1:NCOL,iTOA) endif - - ! Compute layer pressure thicknes - deltaP = abs(p_lev(:,2:model%levs+1)-p_lev(:,1:model%levs)) - ! Compute a bunch of thermodynamic fields needed by the macrophysics schemes. Relative humidity, - ! saturation mixing-ratio, vapor mixing-ratio, virtual temperature, layer thickness,... + ! Compute a bunch of thermodynamic fields needed by the cloud microphysics schemes. + ! Relative humidity, saturation mixing-ratio, vapor mixing-ratio, virtual temperature, + ! layer thickness,... do iCol=1,NCOL - do iLay=1,Model%levs + do iLay=1,nLev es = min( p_lay(iCol,iLay), fpvs( t_lay(iCol,iLay) ) ) ! fpvs and prsl in pa - qs = max( QMIN, eps * es / (p_lay(iCol,iLay) + epsm1*es) ) - relhum(iCol,iLay) = max( 0._kind_phys, min( 1._kind_phys, max(QMIN, q_lay(iCol,iLay))/qs ) ) - qs_lay(iCol,iLay) = qs - tv_lay(iCol,iLay) = t_lay(iCol,iLay) * (1._kind_phys + fvirt*q_lay(iCol,iLay)) - deltaZ(iCol,iLay) = (rog*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) + qs = max( con_epsqs, con_eps * es / (p_lay(iCol,iLay) + con_epsm1*es) ) + relhum(iCol,iLay) = max( 0._kind_phys, min( 1._kind_phys, max(con_epsqs, q_lay(iCol,iLay))/qs ) ) + tv_lay(iCol,iLay) = t_lay(iCol,iLay) * (1._kind_phys + con_fvirt*q_lay(iCol,iLay)) enddo enddo @@ -331,27 +275,27 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, ! Get layer ozone mass mixing ratio ! ####################################################################################### ! First recast remaining all tracers (except sphum) forcing them all to be positive - do j = 2, model%NTRAC - tracer(1:NCOL,:,j) = Statein%qgrs(1:NCOL,:,j) + do j = 2, nTracers + tracer(1:NCOL,:,j) = qgrs(1:NCOL,:,j) where(tracer(:,:,j) .lt. 0.0) tracer(:,:,j) = 0._kind_phys enddo - if (Model%ntoz > 0) then - do iLay=1,Model%levs + if (i_o3 > 0) then + do iLay=1,nlev do iCol=1,NCOL - o3_lay(iCol,iLay) = max( QMIN, tracer(iCol,iLay,Model%ntoz) ) + o3_lay(iCol,iLay) = max( con_epsqs, tracer(iCol,iLay,i_o3) ) enddo enddo ! OR Use climatological ozone data else - call getozn (Statein%prslk(1:NCOL,:), Grid%xlat, NCOL, Model%levs, o3_lay) + call getozn (prslk(1:NCOL,:), xlat, nCol, nLev, o3_lay) endif ! ####################################################################################### ! Set gas concentrations for RRTMGP ! ####################################################################################### ! Call getgases(), to set up non-prognostic gas volume mixing ratios (gas_vmr). - call getgases (p_lev/100., Grid%xlon, Grid%xlat, NCOL, Model%levs, gas_vmr) + call getgases (p_lev/100., xlon, xlat, nCol, nLev, gas_vmr) ! Compute volume mixing-ratios for ozone (mmr) and specific-humidity. vmr_h2o = merge((q_lay/(1-q_lay))*amdw, 0., q_lay .ne. 1.) @@ -367,67 +311,16 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_o3), vmr_o3)) ! ####################################################################################### - ! Compute diffusivity angle adjustments for each longwave band - ! *NOTE* Legacy RRTMGP code - ! ####################################################################################### - ! Conpute diffusivity angle adjustments. - ! First need to compute precipitable water in each column - tem0 = (1._kind_phys - vmr_h2o)*amd + vmr_h2o*amw - coldry = ( 1.0e-20 * 1.0e3 *avogad)*(deltap*.01) / (100.*grav*tem0*(1._kind_phys + vmr_h2o)) - colamt = max(0._kind_phys, coldry*vmr_h2o) - do iCol=1,nCol - tem1 = 0._kind_phys - tem2 = 0._kind_phys - do iLay=1,Model%levs - tem1 = tem1 + coldry(iCol,iLay)+colamt(iCol,iLay) - tem2 = tem2 + colamt(iCol,iLay) - enddo - precipitableH2o(iCol) = p_lev(iCol,iSFC)*0.01*(10._kind_phys*tem2 / (amdw*tem1*grav)) - enddo - - ! Reset diffusivity angle for Bands 2-3 and 5-9 to vary (between 1.50 - ! and 1.80) as a function of total column water vapor. the function - ! has been defined to minimize flux and cooling rate errors in these bands - ! over a wide range of precipitable water values. - do iCol=1,nCol - do iBand = 1, lw_gas_props%get_nband() - if (iBand==1 .or. iBand==4 .or. iBand==10) then - sec_diff_byband(iBand,iCol) = diffusivityB1410 - else - sec_diff_byband(iBand,iCol) = min( diffusivityHigh, max(diffusivityLow, & - a0(iBand)+a1(iBand)*exp(a2(iBand)*precipitableH2o(iCol)))) - endif - enddo - enddo - - ! ####################################################################################### - ! Radiation time step (output) (Is this really needed?) (Used by some diangostics) + ! Radiation time step (output) (Is this really needed?) (Used by some diagnostics) ! ####################################################################################### - raddt = min(Model%fhswr, Model%fhlwr) + raddt = min(fhswr, fhlwr) ! ####################################################################################### ! Setup surface ground temperature and ground/air skin temperature if required. ! ####################################################################################### - tsfg(1:NCOL) = Sfcprop%tsfc(1:NCOL) - tsfa(1:NCOL) = Sfcprop%tsfc(1:NCOL) - - ! ####################################################################################### - ! Cloud microphysics - ! ####################################################################################### - call cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_lay, p_lev, & - tv_lay, relhum, qs_lay, q_lay, deltaZ, deltaP, clouds, cldsa, mbota, mtopa, de_lgth) + tsfg(1:NCOL) = tsfc(1:NCOL) + tsfa(1:NCOL) = tsfc(1:NCOL) - ! Copy output cloud fields - cld_frac = clouds(:,:,1) - cld_lwp = clouds(:,:,2) - cld_reliq = clouds(:,:,3) - cld_iwp = clouds(:,:,4) - cld_reice = clouds(:,:,5) - cld_rwp = clouds(:,:,6) - cld_rerain = clouds(:,:,7) - cld_swp = clouds(:,:,8) - cld_resnow = clouds(:,:,9) - end subroutine GFS_rrtmgp_pre_run ! ######################################################################################### @@ -436,346 +329,4 @@ end subroutine GFS_rrtmgp_pre_run subroutine GFS_rrtmgp_pre_finalize () end subroutine GFS_rrtmgp_pre_finalize - ! ######################################################################################### - ! Subroutine cloud_microphysics() - ! ######################################################################################### - subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_lay, p_lev,& - tv_lay, relhum, qs_lay, q_lay, deltaZ, deltaP, clouds, cldsa, mbota, mtopa, de_lgth) - - ! Inputs - type(GFS_control_type), intent(in) :: & - Model ! DDT: FV3-GFS model control parameters - type(GFS_tbd_type), intent(in) :: & - Tbd ! DDT: FV3-GFS data not yet assigned to a defined container - type(GFS_grid_type), intent(in) :: & - Grid ! DDT: FV3-GFS grid and interpolation related data - type(GFS_sfcprop_type), intent(in) :: & - Sfcprop ! DDT: FV3-GFS surface fields - integer, intent(in) :: & - ncol ! Number of horizontal gridpoints - real(kind_phys), dimension(ncol, Model%levs, 2:Model%ntrac),intent(in) :: & - tracer ! Cloud condensate amount in layer by type () - real(kind_phys), dimension(ncol,Model%levs), intent(in) :: & - p_lay, & ! Pressure @ model layer centers (Pa) - t_lay, & ! Temperature @ layer centers (K) - tv_lay, & ! Virtual temperature @ layer centers (K) - relhum, & ! Relative humidity @ layer centers(1) - qs_lay, & ! Saturation specific humidity @ layer center (kg/kg) - q_lay, & ! Specific humidity @ layer centers(kg/kg) - deltaZ, & ! Layer thickness (km) - deltaP ! Layer thickness (Pa) - real(kind_phys), dimension(ncol,Model%levs+1), intent(in) :: & - p_lev ! Pressure @ model layer interface (Pa) - - ! Outputs - real(kind_phys), dimension(ncol, Model%levs, NF_CLDS),intent(out) :: & - clouds ! Cloud properties (NCOL,Model%levs,NF_CLDS) - integer,dimension(ncol,3), intent(out) :: & - mbota, & ! Vertical indices for low, mid, hi cloud bases (NCOL,3) - mtopa ! Vertical indices for low, mid, hi cloud tops (NCOL,3) - real(kind_phys), dimension(ncol), intent(out) ::& - de_lgth ! Clouds decorrelation length (km) - real(kind_phys), dimension(ncol, 5), intent(out) :: & - cldsa ! Fraction of clouds for low, mid, hi, tot, bl (NCOL,5) - - ! Local variables - real(kind_phys), dimension(ncol, Model%levs, Model%ncnd) :: cld_condensate - integer :: i,k - real(kind_phys), parameter :: xrc3 = 100. - real(kind_phys), dimension(ncol, Model%levs) :: delta_q, cnv_w, cnv_c, effr_l, & - effr_i, effr_r, effr_s, cldcov - - ! ####################################################################################### - ! Obtain cloud information for radiation calculations - ! (clouds,cldsa,mtopa,mbota) - ! for prognostic cloud: - ! - For Zhao/Moorthi's prognostic cloud scheme, - ! call module_radiation_clouds::progcld1() - ! - For Zhao/Moorthi's prognostic cloud+pdfcld, - ! call module_radiation_clouds::progcld3() - ! call module_radiation_clouds::progclduni() for unified cloud and ncld=2 - ! ####################################################################################### - cld_condensate = 0.0_kind_phys - if (Model%ncnd == 1) then ! Zhao_Carr_Sundqvist - cld_condensate(1:NCOL,1:Model%levs,1) = tracer(1:NCOL,1:Model%levs,Model%ntcw) ! -liquid water/ice - elseif (Model%ncnd == 2) then ! MG - cld_condensate(1:NCOL,1:Model%levs,1) = tracer(1:NCOL,1:Model%levs,Model%ntcw) ! -liquid water - cld_condensate(1:NCOL,1:Model%levs,2) = tracer(1:NCOL,1:Model%levs,Model%ntiw) ! -ice water - elseif (Model%ncnd == 4) then ! MG2 - cld_condensate(1:NCOL,1:Model%levs,1) = tracer(1:NCOL,1:Model%levs,Model%ntcw) ! -liquid water - cld_condensate(1:NCOL,1:Model%levs,2) = tracer(1:NCOL,1:Model%levs,Model%ntiw) ! -ice water - cld_condensate(1:NCOL,1:Model%levs,3) = tracer(1:NCOL,1:Model%levs,Model%ntrw) ! -rain water - cld_condensate(1:NCOL,1:Model%levs,4) = tracer(1:NCOL,1:Model%levs,Model%ntsw) ! -snow water - elseif (Model%ncnd == 5) then ! GFDL MP, Thompson, MG3 - cld_condensate(1:NCOL,1:Model%levs,1) = tracer(1:NCOL,1:Model%levs,Model%ntcw) ! -liquid water - cld_condensate(1:NCOL,1:Model%levs,2) = tracer(1:NCOL,1:Model%levs,Model%ntiw) ! -ice water - cld_condensate(1:NCOL,1:Model%levs,3) = tracer(1:NCOL,1:Model%levs,Model%ntrw) ! -rain water - cld_condensate(1:NCOL,1:Model%levs,4) = tracer(1:NCOL,1:Model%levs,Model%ntsw) + & ! -snow + grapuel - tracer(1:NCOL,1:Model%levs,Model%ntgl) - endif - where(cld_condensate < epsq) cld_condensate = 0.0 - - ! For GFDL microphysics scheme... - if (Model%imp_physics == 11 ) then - if (.not. Model%lgfdlmprad) then - cld_condensate(:,:,1) = tracer(:,1:Model%levs,Model%ntcw) - cld_condensate(:,:,1) = cld_condensate(:,:,1) + tracer(:,1:Model%levs,Model%ntrw) - cld_condensate(:,:,1) = cld_condensate(:,:,1) + tracer(:,1:Model%levs,Model%ntiw) - cld_condensate(:,:,1) = cld_condensate(:,:,1) + tracer(:,1:Model%levs,Model%ntsw) - cld_condensate(:,:,1) = cld_condensate(:,:,1) + tracer(:,1:Model%levs,Model%ntgl) - endif - do k=1,Model%levs - do i=1,NCOL - if (cld_condensate(i,k,1) < EPSQ ) cld_condensate(i,k,1) = 0.0 - enddo - enddo - endif - - if (Model%uni_cld) then - if (Model%effr_in) then - cldcov(:,:) = Tbd%phy_f3d(:,:,Model%indcld) - effr_l(:,:) = Tbd%phy_f3d(:,:,2) - effr_i(:,:) = Tbd%phy_f3d(:,:,3) - effr_r(:,:) = Tbd%phy_f3d(:,:,4) - effr_s(:,:) = Tbd%phy_f3d(:,:,5) - else - do k=1,model%levs - do i=1,ncol - cldcov(i,k) = Tbd%phy_f3d(i,k,Model%indcld) - enddo - enddo - endif - elseif (Model%imp_physics == Model%imp_physics_gfdl) then ! GFDL MP - cldcov(1:NCOL,1:Model%levs) = tracer(1:NCOL,1:Model%levs,Model%ntclamt) - if (Model%effr_in) then - effr_l(:,:) = Tbd%phy_f3d(:,:,1) - effr_i(:,:) = Tbd%phy_f3d(:,:,2) - effr_r(:,:) = Tbd%phy_f3d(:,:,3) - effr_s(:,:) = Tbd%phy_f3d(:,:,4) - endif - else ! neither of the other two cases - cldcov = 0.0 - endif - - - ! Add suspended convective cloud water to grid-scale cloud water - ! only for cloud fraction & radiation computation it is to enhance - ! cloudiness due to suspended convec cloud water for zhao/moorthi's - ! (imp_phys=99) & ferrier's (imp_phys=5) microphysics schemes - if ((Model%num_p3d == 4) .and. (Model%npdf3d == 3)) then ! same as Model%imp_physics = 99 - delta_q(1:ncol,1:Model%levs) = Tbd%phy_f3d(1:ncol,Model%levs:1:-1,5) - cnv_w (1:ncol,1:Model%levs) = Tbd%phy_f3d(1:ncol,Model%levs:1:-1,6) - cnv_c (1:ncol,1:Model%levs) = Tbd%phy_f3d(1:ncol,Model%levs:1:-1,7) - elseif ((Model%npdf3d == 0) .and. (Model%ncnvcld3d == 1)) then ! same as MOdel%imp_physics=98 - delta_q(1:ncol,1:Model%levs) = 0.0 - cnv_w (1:ncol,1:Model%levs) = Tbd%phy_f3d(1:ncol,1:Model%levs,Model%num_p3d+1) - cnv_c (1:ncol,1:Model%levs) = 0.0 - else ! all the rest - delta_q(1:ncol,1:Model%levs) = 0.0 - cnv_w (1:ncol,1:Model%levs) = 0.0 - cnv_c (1:ncol,1:Model%levs) = 0.0 - endif - - ! For zhao/moorthi's prognostic cloud scheme, add in convective cloud water to liquid-cloud water - if (Model%imp_physics == 99) then - cld_condensate(1:NCOL,1:Model%levs,1) = cld_condensate(1:NCOL,1:Model%levs,1) + cnv_w(1:NCOL,1:Model%levs) - endif - - ! For MG prognostic cloud scheme, add in convective cloud water to liquid-and-ice-cloud condensate - if (Model%imp_physics == 10) then - cld_condensate(1:NCOL,1:Model%levs,1) = cld_condensate(1:NCOL,1:Model%levs,1) + cnv_w(1:NCOL,1:Model%levs) + cld_condensate(1:NCOL,1:Model%levs,2) - endif - - ! ####################################################################################### - ! MICROPHYSICS - ! ####################################################################################### - ! *) zhao/moorthi's prognostic cloud scheme or unified cloud and/or with MG microphysics - if (Model%imp_physics == 99 .or. Model%imp_physics == 10) then - if (Model%uni_cld .and. Model%ncld >= 2) then - call progclduni( & - p_lay/100., & ! IN - Pressure at model layer centers (mb) - p_lev/100., & ! IN - Pressure at model interfaces (mb) - t_lay, & ! IN - Temperature at layer centers (K) - tv_lay, & ! IN - Virtual temperature at layer centers (K) - cld_condensate, & ! IN - Cloud condensate amount (Model%ncnd types) () - Model%ncnd, & ! IN - Number of cloud condensate types () - Grid%xlat, & ! IN - Latitude (radians) - Grid%xlon, & ! IN - Longitude (radians) - Sfcprop%slmsk, & ! IN - Land/Sea mask () - deltaZ, & ! IN - Layer thickness (km) - deltaP/100., & ! IN - Layer thickness (hPa) - NCOL, & ! IN - Number of horizontal gridpoints - MODEL%LEVS, & ! IN - Number of model layers - MODEL%LEVS+1, & ! IN - Number of model levels - cldcov, & ! IN - Layer cloud fraction (used if uni_cld=.true.) - effr_l, & ! IN - Liquid-water effective radius (microns) - effr_i, & ! IN - Ice-water effective radius (microns) - effr_r, & ! IN - Rain-water effective radius (microns) - effr_s, & ! IN - Snow-water effective radius (microns) - Model%effr_in, & ! IN - Logical, if .true. use input effective radii - clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) - cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) - mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) - mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) - de_lgth) ! OUT - clouds decorrelation length (km) - else - call progcld1 ( & - p_lay/100., & ! IN - Pressure at model layer centers (mb) - p_lev/100., & ! IN - Pressure at model interfaces (mb) - t_lay, & ! IN - Temperature at layer centers (K) - tv_lay, & ! IN - Virtual temperature at layer centers (K) - q_lay, & ! IN - Specific humidity at layer center (kg/kg) - qs_lay, & ! IN - Saturation specific humidity at layer center (kg/kg) - relhum, & ! IN - Relative humidity at layer center (1) - cld_condensate(:,:,1),& ! IN - Cloud condensate amount () - ! (Zhao: liq+convective; MG: liq+ice+convective) - Grid%xlat, & ! IN - Latitude (radians) - Grid%xlon, & ! IN - Longitude (radians) - Sfcprop%slmsk, & ! IN - Land/Sea mask () - deltaZ, & ! IN - Layer thickness (km) - deltaP/100., & ! IN - Layer thickness (hPa) - NCOL, & ! IN - Number of horizontal gridpoints - MODEL%LEVS, & ! IN - Number of model layers - MODEL%LEVS+1, & ! IN - Number of model levels - Model%uni_cld, & ! IN - True for cloud fraction from shoc - Model%lmfshal, & ! IN - True for mass flux shallow convection - Model%lmfdeep2, & ! IN - True for mass flux deep convection - cldcov, & ! IN - Layer cloud fraction (used if uni_cld=.true.) - effr_l, & ! IN - Liquid-water effective radius (microns) - effr_i, & ! IN - Ice-water effective radius (microns) - effr_r, & ! IN - Rain-water effective radius (microns) - effr_s, & ! IN - Snow-water effective radius (microns) - Model%effr_in, & ! IN - Logical, if .true. use input effective radii - clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) - cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) - mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) - mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) - de_lgth) ! OUT - clouds decorrelation length (km) - endif - ! *) zhao/moorthi's prognostic cloud+pdfcld - elseif(Model%imp_physics == 98) then - call progcld3 ( & - p_lay/100., & ! IN - Pressure at model layer centers (mb) - p_lev/100., & ! IN - Pressure at model interfaces (mb) - t_lay, & ! IN - Temperature at layer centers (K) - tv_lay, & ! IN - Virtual temperature at layer centers (K) - q_lay, & ! IN - Specific humidity at layer center (kg/kg) - qs_lay, & ! IN - Saturation specific humidity at layer center (kg/kg) - relhum, & ! IN - Relative humidity at layer center (1) - cld_condensate(:,:,1),& ! IN - Cloud condensate amount (only h20) () - cnv_w, & ! IN - Layer convective cloud condensate - cnv_c, & ! IN - Layer convective cloud cover - Grid%xlat, & ! IN - Latitude (radians) - Grid%xlon, & ! IN - Longitude (radians) - Sfcprop%slmsk, & ! IN - Land/Sea mask () - deltaZ, & ! IN - Layer thickness (km) - deltaP/100., & ! IN - Layer thickness (hPa) - NCOL, & ! IN - Number of horizontal gridpoints - MODEL%LEVS, & ! IN - Number of model layers - MODEL%LEVS+1, & ! IN - Number of model levels - delta_q, & ! IN - Total water distribution width - Model%sup, & ! IN - ??? Supersaturation? - Model%kdt, & ! IN - ??? - Model%me, & ! IN - ??? NOT USED IN PROGCLD3() - clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) - cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) - mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) - mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) - de_lgth) ! OUT - clouds decorrelation length (km) - ! *) GFDL cloud scheme - elseif (Model%imp_physics == 11) then - if (.not.Model%lgfdlmprad) then - call progcld4 ( & - p_lay/100., & ! IN - Pressure at model layer centers (mb) - p_lev/100., & ! IN - Pressure at model interfaces (mb) - t_lay, & ! IN - Temperature at layer centers (K) - tv_lay, & ! IN - Virtual temperature at layer centers (K) - q_lay, & ! IN - Specific humidity at layer center (kg/kg) - qs_lay, & ! IN - Saturation specific humidity at layer center (kg/kg) - relhum, & ! IN - Relative humidity at layer center (1) - cld_condensate(:,:,1),& ! IN - Cloud condensate amount (only h20) () - cnv_w, & ! IN - Layer convective cloud condensate - cnv_c, & ! IN - Layer convective cloud cover - Grid%xlat, & ! IN - Latitude (radians) - Grid%xlon, & ! IN - Longitude (radians) - Sfcprop%slmsk, & ! IN - Land/Sea mask () - cldcov, & ! IN - Layer cloud fraction (used if uni_cld=.true.) - deltaZ, & ! IN - Layer thickness (km) - deltaP/100., & ! IN - Layer thickness (hPa) - NCOL, & ! IN - Number of horizontal gridpoints - MODEL%LEVS, & ! IN - Number of model layers - MODEL%LEVS+1, & ! IN - Number of model levels - clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) - cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) - mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) - mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) - de_lgth) ! OUT - clouds decorrelation length (km) - else - call progclduni( & - p_lay/100., & ! IN - Pressure at model layer centers (mb) - p_lev/100., & ! IN - Pressure at model interfaces (mb) - t_lay, & ! IN - Temperature at layer centers (K) - tv_lay, & ! IN - Virtual temperature at layer centers (K) - cld_condensate, & ! IN - Cloud condensate amount (Model%ncnd types) () - Model%ncnd, & ! IN - Number of cloud condensate types () - Grid%xlat, & ! IN - Latitude (radians) - Grid%xlon, & ! IN - Longitude (radians) - Sfcprop%slmsk, & ! IN - Land/Sea mask () - deltaZ, & ! IN - Layer thickness (km) - deltaP/100., & ! IN - Layer thickness (hPa) - NCOL, & ! IN - Number of horizontal gridpoints - MODEL%LEVS, & ! IN - Number of model layers - MODEL%LEVS+1, & ! IN - Number of model levels - cldcov, & ! IN - Layer cloud fraction (used if uni_cld=.true.) - effr_l, & ! IN - Liquid-water effective radius (microns) - effr_i, & ! IN - Ice-water effective radius (microns) - effr_r, & ! IN - Rain-water effective radius (microns) - effr_s, & ! IN - Snow-water effective radius (microns) - Model%effr_in, & ! IN - Logical, if .true. use input effective radii - clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) - cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) - mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) - mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) - de_lgth) ! OUT - clouds decorrelation length (km) - endif - ! *) Thompson / WSM6 cloud micrphysics scheme - elseif(Model%imp_physics == 8 .or. Model%imp_physics == 6) then - - call progcld5 ( & ! IN - p_lay/100., & ! IN - Pressure at model layer centers (mb) - p_lev/100., & ! IN - Pressure at model interfaces (mb) - t_lay, & ! IN - Temperature at layer centers (K) - q_lay, & ! IN - Specific humidity at layer center (kg/kg) - qs_lay, & ! IN - Saturation specific humidity at layer center (kg/kg) - relhum, & ! IN - Relative humidity at layer center (1) - tracer, & ! IN - Cloud condensate amount in layer by type () - Grid%xlat, & ! IN - Latitude (radians) - Grid%xlon, & ! IN - Longitude (radians) - Sfcprop%slmsk, & ! IN - Land/Sea mask () - deltaZ, & ! IN - Layer thickness (km) - deltaP/100., & ! IN - Layer thickness (hPa) - Model%ntrac-1, & ! IN - Number of tracers - Model%ntcw-1, & ! IN - Tracer index for cloud condensate (or liquid water) - Model%ntiw-1, & ! IN - Tracer index for ice - Model%ntrw-1, & ! IN - Tracer index for rain - Model%ntsw-1, & ! IN - Tracer index for snow - Model%ntgl-1, & ! IN - Tracer index for groupel - NCOL, & ! IN - Number of horizontal gridpoints - MODEL%LEVS, & ! IN - Number of model layers - MODEL%LEVS+1, & ! IN - Number of model levels - Model%uni_cld, & ! IN - True for cloud fraction from shoc - Model%lmfshal, & ! IN - True for mass flux shallow convection - Model%lmfdeep2, & ! IN - True for mass flux deep convection - cldcov(:,1:Model%levs), & ! IN - Layer cloud fraction (used if uni_cld=.true.) - Tbd%phy_f3d(:,:,1), & ! IN - Liquid-water effective radius (microns) - Tbd%phy_f3d(:,:,2), & ! IN - Ice-water effective radius (microns) - Tbd%phy_f3d(:,:,3), & ! IN - LSnow-water effective radius (microns) - clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) - cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) - mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) - mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) - de_lgth) ! OUT - clouds decorrelation length (km) - endif ! end if_imp_physics - end subroutine cloud_microphysics - ! end module GFS_rrtmgp_pre diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index ae94ddf20..95a9403cd 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -1,14 +1,23 @@ [ccpp-arg-table] name = GFS_rrtmgp_pre_init type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type - units = DDT - dimensions = () - type = GFS_control_type - intent = inout - optional = F +[active_gases] + standard_name = active_gases_used_by_RRTMGP + long_name = active gases used by RRTMGP + units = none + dimensions = () + type = character + kind = len=128 + intent = in + optional = F +[nGases] + standard_name = number_of_active_gases_used_by_RRTMGP + long_name = number of gases available used by RRTMGP (Model%nGases) + units = count + dimensions = () + type = integer + intent = in + optional = F [active_gases_array] standard_name = list_of_active_gases_used_by_RRTMGP long_name = list of active gases used by RRTMGP @@ -40,76 +49,150 @@ [ccpp-arg-table] name = GFS_rrtmgp_pre_run type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type - units = DDT +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count dimensions = () - type = GFS_control_type + type = integer intent = in optional = F -[Grid] - standard_name = GFS_grid_type_instance - long_name = instance of derived type GFS_grid_type - units = DDT +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count dimensions = () - type = GFS_grid_type + type = integer intent = in - optional = F -[Sfcprop] - standard_name = GFS_sfcprop_type_instance - long_name = instance of derived type GFS_sfcprop_type - units = DDT - dimensions = () - type = GFS_sfcprop_type + optional = F +[nGases] + standard_name = number_of_active_gases_used_by_RRTMGP + long_name = number of gases available used by RRTMGP (Model%nGases) + units = count + dimensions = () + type = integer intent = in - optional = F -[Statein] - standard_name = GFS_statein_type_instance - long_name = instance of derived type GFS_statein_type - units = DDT + optional = F +[nTracers] + standard_name = number_of_tracers + long_name = number of tracers + units = count dimensions = () - type = GFS_statein_type + type = integer intent = in optional = F -[Tbd] - standard_name = GFS_tbd_type_instance - long_name = instance of derived type GFS_tbd_type - units = DDT +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag dimensions = () - type = GFS_tbd_type + type = logical intent = in optional = F -[Coupling] - standard_name = GFS_coupling_type_instance - long_name = instance of derived type GFS_coupling_type - units = DDT +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag dimensions = () - type = GFS_coupling_type + type = logical intent = in - optional = F -[Radtend] - standard_name = GFS_radtend_type_instance - long_name = instance of derived type GFS_radtend_type - units = DDT - dimensions = () - type = GFS_radtend_type - intent = inout - optional = F -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count + optional = F +[i_o3] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index dimensions = () type = integer intent = in - optional = F -[lw_gas_props] - standard_name = coefficients_for_lw_gas_optics - long_name = DDT containing spectral information for RRTMGP LW radiation scheme - units = DDT + optional = F +[fhswr] + standard_name = frequency_for_shortwave_radiation + long_name = frequency for shortwave radiation + units = s dimensions = () - type = ty_gas_optics_rrtmgp + type = real + kind = kind_phys + intent = in + optional = F +[fhlwr] + standard_name = frequency_for_longwave_radiation + long_name = frequency for longwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xlat] + standard_name = latitude + long_name = latitude + units = radian + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xlon] + standard_name = longitude + long_name = longitude + units = radian + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = dimensionless Exner function at model layer centers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs] + standard_name = tracer_concentration + long_name = model layer mean tracer concentration + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys intent = in optional = F [active_gases_array] @@ -121,20 +204,47 @@ kind = len=* intent = in optional = F -[raddt] - standard_name = time_step_for_radiation - long_name = radiation time step - units = s +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none dimensions = () type = real kind = kind_phys - intent = out + intent = in optional = F -[sec_diff_byband] - standard_name = secant_of_diffusivity_angle_each_RRTMGP_LW_band - long_name = secant of diffusivity angle in each RRTMGP LW band +[con_epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 units = none - dimensions = (number_of_lw_bands_rrtmgp,horizontal_dimension) + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_epsqs] + standard_name = minimum_value_of_saturation_mixing_ratio + long_name = floor value for saturation mixing ratio + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[raddt] + standard_name = time_step_for_radiation + long_name = radiation time step + units = s + dimensions = () type = real kind = kind_phys intent = out @@ -220,121 +330,6 @@ kind = kind_phys intent = out optional = F -[cld_frac] - standard_name = total_cloud_fraction - long_name = layer total cloud fraction - units = frac - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[cld_lwp] - standard_name = cloud_liquid_water_path - long_name = layer cloud liquid water path - units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[cld_reliq] - standard_name = mean_effective_radius_for_liquid_cloud - long_name = mean effective radius for liquid cloud - units = micron - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[cld_iwp] - standard_name = cloud_ice_water_path - long_name = layer cloud ice water path - units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[cld_reice] - standard_name = mean_effective_radius_for_ice_cloud - long_name = mean effective radius for ice cloud - units = micron - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[cld_swp] - standard_name = cloud_snow_water_path - long_name = layer cloud snow water path - units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[cld_resnow] - standard_name = mean_effective_radius_for_snow_flake - long_name = mean effective radius for snow cloud - units = micron - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[cld_rwp] - standard_name = cloud_rain_water_path - long_name = layer cloud rain water path - units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[cld_rerain] - standard_name = mean_effective_radius_for_rain_drop - long_name = mean effective radius for rain cloud - units = micron - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[mtopa] - standard_name = model_layer_number_at_cloud_top - long_name = vertical indices for low, middle and high cloud tops - units = index - dimensions = (horizontal_dimension,3) - type = integer - intent = out - optional = F -[mbota] - standard_name = model_layer_number_at_cloud_base - long_name = vertical indices for low, middle and high cloud bases - units = index - dimensions = (horizontal_dimension,3) - type = integer - intent = out - optional = F -[de_lgth] - standard_name = cloud_decorrelation_length - long_name = cloud decorrelation length - units = km - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[cldsa] - standard_name = cloud_area_fraction_for_radiation - long_name = fraction of clouds for low, middle, high, total and BL - units = frac - dimensions = (horizontal_dimension,5) - type = real - kind = kind_phys - intent = out - optional = F [gas_concentrations] standard_name = Gas_concentrations_for_RRTMGP_suite long_name = DDT containing gas concentrations for RRTMGP radiation scheme @@ -360,8 +355,3 @@ type = integer intent = out optional = F - -######################################################################## -[ccpp-arg-table] - name = GFS_rrtmgp_pre_finalize - type = scheme diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 index 45bc4397b..9b503e3bc 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -8,8 +8,6 @@ module GFS_rrtmgp_setup isubcsw, isubclw, ivflip , ipsd0, iswcliq use machine, only: & kind_phys ! Working type - use GFS_typedefs, only: & - GFS_control_type ! Model control parameters implicit none public GFS_rrtmgp_setup_init, GFS_rrtmgp_setup_run, GFS_rrtmgp_setup_finalize @@ -39,21 +37,28 @@ module GFS_rrtmgp_setup !! \section arg_table_GFS_rrtmgp_setup_init !! \htmlinclude GFS_rrtmgp_setup_init.html !! - subroutine GFS_rrtmgp_setup_init (Model, si, levr, ictm, isol, ico2, & - iaer, ialb, iems, ntcw, num_p3d, ntoz, iovr_sw, iovr_lw, & - isubc_sw, isubc_lw, icliq_sw, crick_proof, ccnorm, imp_physics, & - norad_precip, idate, iflip, me, & - errmsg, errflg) + subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics_gfdl,& + imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & + imp_physics_zhao_carr_pdf, imp_physics_mg, si, levr, ictm, isol, ico2, iaer, & + ialb, iems, ntcw, num_p3d, ntoz, iovr_sw, iovr_lw, isubc_sw, isubc_lw, & + icliq_sw, crick_proof, ccnorm, norad_precip, idate, iflip, me, errmsg, errflg) implicit none ! Inputs - type(GFS_control_type), intent(in) :: & - Model ! DDT containing model control parameters + integer, intent(in) :: & + imp_physics, & ! Flag for MP scheme + imp_physics_fer_hires, & ! Flag for fer-hires scheme + imp_physics_gfdl, & ! Flag for gfdl scheme + imp_physics_thompson, & ! Flag for thompsonscheme + imp_physics_wsm6, & ! Flag for wsm6 scheme + imp_physics_zhao_carr, & ! Flag for zhao-carr scheme + imp_physics_zhao_carr_pdf, & ! Flag for zhao-carr+PDF scheme + imp_physics_mg ! Flag for MG scheme real(kind_phys), dimension(levr+1), intent(in) :: & si integer, intent(in) :: levr, ictm, isol, ico2, iaer, ialb, iems, & ntcw, num_p3d, ntoz, iovr_sw, iovr_lw, isubc_sw, isubc_lw, & - icliq_sw, imp_physics, iflip, me + icliq_sw, iflip, me logical, intent(in) :: & crick_proof, ccnorm, norad_precip integer, intent(in), dimension(4) :: & @@ -120,10 +125,10 @@ subroutine GFS_rrtmgp_setup_init (Model, si, levr, ictm, isol, ico2, & ' ccnorm=',ccnorm,' norad_precip=',norad_precip endif - ! Hack for using RRTMGP-Sw and RRTMG-LW - if (.not. Model%do_GPsw_Glw) then - call radinit( si, levr, imp_physics, me ) - endif + + call radinit( si, levr, imp_physics, imp_physics_fer_hires, imp_physics_gfdl, & + imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & + imp_physics_zhao_carr_pdf, imp_physics_mg, me, errflg ) if ( me == 0 ) then print *,' Radiation sub-cloud initial seed =',ipsd0, & @@ -199,13 +204,17 @@ end subroutine GFS_rrtmgp_setup_finalize ! Private functions - subroutine radinit( si, NLAY, imp_physics, me ) + subroutine radinit(si, NLAY, imp_physics, imp_physics_fer_hires, imp_physics_gfdl, & + imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & + imp_physics_zhao_carr_pdf, imp_physics_mg, me, errflg ) !................................... ! --- inputs: -! & ( si, NLAY, imp_physics, me ) +! & ( si, NLAY, imp_physics, imp_physics_fer_hires, imp_physics_gfdl, & +! & imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & +! & imp_physics_zhao_carr_pdf, imp_physics_mg, me ) ! --- outputs: -! ( none ) +! ( errflg ) ! ================= subprogram documentation block ================ ! ! ! @@ -316,19 +325,31 @@ subroutine radinit( si, NLAY, imp_physics, me ) use module_radiation_aerosols, only : aer_init use module_radiation_gases, only : gas_init use module_radiation_surface, only : sfc_init - use module_radiation_clouds, only : cld_init + use GFS_cloud_diagnostics, only : hml_cloud_diagnostics_initialize implicit none ! --- inputs: - integer, intent(in) :: NLAY, me, imp_physics - + integer, intent(in) :: & + imp_physics, & ! Flag for MP scheme + imp_physics_fer_hires, & ! Flag for fer-hires scheme + imp_physics_gfdl, & ! Flag for gfdl scheme + imp_physics_thompson, & ! Flag for thompsonscheme + imp_physics_wsm6, & ! Flag for wsm6 scheme + imp_physics_zhao_carr, & ! Flag for zhao-carr scheme + imp_physics_zhao_carr_pdf, & ! Flag for zhao-carr+PDF scheme + imp_physics_mg ! Flag for MG scheme + integer, intent(in) :: NLAY, me real (kind=kind_phys), intent(in) :: si(:) ! --- outputs: (none, to module variables) + integer, intent(out) :: & + errflg ! --- locals: + ! Initialize + errflg = 0 ! !===> ... begin here ! @@ -409,7 +430,10 @@ subroutine radinit( si, NLAY, imp_physics, me ) call aer_init ( NLAY, me ) ! --- ... aerosols initialization routine call gas_init ( me ) ! --- ... co2 and other gases initialization routine call sfc_init ( me ) ! --- ... surface initialization routine - call cld_init ( si, NLAY, imp_physics, me) ! --- ... cloud initialization routine + call hml_cloud_diagnostics_initialize(imp_physics, imp_physics_fer_hires, & + imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & + imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_mg, NLAY, me, si,& + errflg) return !................................... diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index 9165117c5..aec1b4374 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -1,14 +1,70 @@ [ccpp-arg-table] name = GFS_rrtmgp_setup_init type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type - units = DDT +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_fer_hires] + standard_name = flag_for_fer_hires_microphysics_scheme + long_name = choice of Ferrier-Aligo microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_gfdl] + standard_name = flag_for_gfdl_microphysics_scheme + long_name = choice of GFDL microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_thompson] + standard_name = flag_for_thompson_microphysics_scheme + long_name = choice of Thompson microphysics scheme + units = flag + dimensions = () + type = integer +[imp_physics_wsm6] + intent = in + optional = F + standard_name = flag_for_wsm6_microphysics_scheme + long_name = choice of WSM6 microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_zhao_carr] + standard_name = flag_for_zhao_carr_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme + units = flag dimensions = () - type = GFS_control_type + type = integer + intent = in + optional = F +[imp_physics_zhao_carr_pdf] + standard_name = flag_for_zhao_carr_pdf_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme with PDF clouds + units = flag + dimensions = () + type = integer intent = in optional = F +[imp_physics_mg] + standard_name = flag_for_morrison_gettelman_microphysics_scheme + long_name = choice of Morrison-Gettelman microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [si] standard_name = vertical_sigma_coordinate_for_radiation_initialization long_name = vertical sigma coordinate for radiation initialization @@ -154,14 +210,6 @@ type = logical intent = in optional = F -[imp_physics] - standard_name = flag_for_microphysics_scheme - long_name = choice of microphysics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F [norad_precip] standard_name = flag_for_precipitation_effect_on_radiation long_name = radiation precip flag for Ferrier/Moorthi diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index 3b09298c4..0d3991fcf 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -1,7 +1,5 @@ module GFS_rrtmgp_sw_post use machine, only: kind_phys - use GFS_typedefs, only: GFS_coupling_type, GFS_control_type, GFS_grid_type, & - GFS_radtend_type, GFS_diag_type, GFS_statein_type use module_radiation_aerosols, only: NSPC1 use module_radsw_parameters, only: topfsw_type, sfcfsw_type, profsw_type, cmpfsw_type use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp @@ -26,40 +24,41 @@ end subroutine GFS_rrtmgp_sw_post_init !> \section arg_table_GFS_rrtmgp_sw_post_run !! \htmlinclude GFS_rrtmgp_sw_post_run.html !! - subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein, scmpsw, & - nCol, p_lev, sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, & - sw_gas_props, nday, idxday, fluxswUP_allsky, fluxswDOWN_allsky, fluxswUP_clrsky, & - fluxswDOWN_clrsky, raddt, aerodp, cldsa, mbota, mtopa, cld_frac, cldtausw, flxprf_sw,& - errmsg, errflg) + subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky_hr, & + 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, sw_gas_props, fluxswUP_allsky, & + fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, raddt, aerodp, cldsa, mbota, & + mtopa, cld_frac, cldtausw, & + nirbmdi, nirdfdi, visbmdi, visdfdi, nirbmui, nirdfui, visbmui, visdfui, sfcnsw, & + sfcdsw, htrsw, sfcfsw, topfsw, htrswc, flxprf_sw, scmpsw, errmsg, errflg) - ! Inputs - type(GFS_control_type), intent(in) :: & - Model ! Fortran DDT: FV3-GFS model control parameters - type(GFS_grid_type), intent(in) :: & - Grid ! Fortran DDT: FV3-GFS grid and interpolation related data - type(GFS_coupling_type), intent(inout) :: & - Coupling ! Fortran DDT: FV3-GFS fields to/from coupling with other components - type(GFS_radtend_type), intent(inout) :: & - Radtend ! Fortran DDT: FV3-GFS radiation tendencies - type(GFS_diag_type), intent(inout) :: & - Diag ! Fortran DDT: FV3-GFS diagnotics data - type(GFS_statein_type), intent(in) :: & - Statein ! Fortran DDT: FV3-GFS prognostic state data in from dycore + ! Inputs integer, intent(in) :: & nCol, & ! Horizontal loop extent + nLev, & ! Number of vertical layers nDay ! Number of daylit columns integer, intent(in), dimension(nday) :: & idxday ! Index array for daytime points + logical, intent(in) :: & + lsswr, & ! Call SW radiation? + do_sw_clrsky_hr, & ! Output clear-sky SW heating-rate? + save_diag ! Output radiation diagnostics? type(ty_gas_optics_rrtmgp),intent(in) :: & sw_gas_props ! DDT containing SW spectral information - real(kind_phys), dimension(nCol, Model%levs+1), intent(in) :: & - p_lev ! Pressure @ model layer-interfaces (hPa) + real(kind_phys), intent(in) :: & + fhswr ! Frequency for SW radiation + real(kind_phys), dimension(nCol), intent(in) :: & + t_lay, & ! Temperature at model layer centers (K) + coszen, & ! Cosine(SZA) + coszdg ! Cosine(SZA), daytime + real(kind_phys), dimension(nCol, nLev+1), intent(in) :: & + p_lev ! Pressure @ model layer-interfaces (Pa) real(kind_phys), dimension(sw_gas_props%get_nband(),ncol), intent(in) :: & sfc_alb_nir_dir, & ! Surface albedo (direct) sfc_alb_nir_dif, & ! Surface albedo (diffuse) sfc_alb_uvvis_dir, & ! Surface albedo (direct) sfc_alb_uvvis_dif ! Surface albedo (diffuse) - real(kind_phys), dimension(nCol, Model%levs+1), intent(in) :: & + real(kind_phys), dimension(nCol, nLev+1), intent(in) :: & fluxswUP_allsky, & ! SW All-sky flux (W/m2) fluxswDOWN_allsky, & ! SW All-sky flux (W/m2) fluxswUP_clrsky, & ! SW Clear-sky flux (W/m2) @@ -73,94 +72,119 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein integer, dimension(nCol,3), intent(in) ::& mbota, & ! vertical indices for low, middle and high cloud tops mtopa ! vertical indices for low, middle and high cloud bases - real(kind_phys), dimension(nCol,Model%levs), intent(in) :: & + real(kind_phys), dimension(nCol,nLev), intent(in) :: & cld_frac, & ! Total cloud fraction in each layer - cldtausw ! approx .55mu band layer cloud optical depth - real(kind_phys),dimension(nCol, Model%levs) :: & - hswc, & ! All-sky heating rate (K/s) - hsw0 ! Clear-sky heating rate (K/s) + cldtausw ! approx .55mu band layer cloud optical depth + + ! Inputs (optional) + type(cmpfsw_type), dimension(nCol), intent(in), optional :: & + scmpsw ! 2D surface fluxes, components: + ! uvbfc - total sky downward uv-b flux at (W/m2) + ! uvbf0 - clear sky downward uv-b flux at (W/m2) + ! nirbm - downward nir direct beam flux (W/m2) + ! nirdf - downward nir diffused flux (W/m2) + ! visbm - downward uv+vis direct beam flux (W/m2) + ! visdf - downward uv+vis diffused flux (W/m2) ! Outputs (mandatory) + real(kind_phys), dimension(nCol), intent(out) :: & + nirbmdi, & ! sfc nir beam sw downward flux (W/m2) + nirdfdi, & ! sfc nir diff sw downward flux (W/m2) + visbmdi, & ! sfc uv+vis beam sw downward flux (W/m2) + visdfdi, & ! sfc uv+vis diff sw downward flux (W/m2) + nirbmui, & ! sfc nir beam sw upward flux (W/m2) + nirdfui, & ! sfc nir diff sw upward flux (W/m2) + visbmui, & ! sfc uv+vis beam sw upward flux (W/m2) + visdfui, & ! sfc uv+vis diff sw upward flux (W/m2) + sfcnsw, & ! total sky sfc netsw flx into ground + sfcdsw ! + real(kind_phys), dimension(nCol,nLev), intent(out) :: & + htrsw ! SW all-sky heating rate + type(sfcfsw_type), dimension(nCol), intent(out) :: & + sfcfsw ! sw radiation fluxes at sfc + type(topfsw_type), dimension(nCol), intent(out) :: & + topfsw ! sw_fluxes_top_atmosphere character(len=*), intent(out) :: & errmsg integer, intent(out) :: & errflg ! Outputs (optional) - type(profsw_type), dimension(nCol, Model%levs+1), intent(inout), optional :: & + type(profsw_type), dimension(nCol, nLev), intent(out), optional :: & flxprf_sw ! 2D radiative fluxes, components: ! upfxc - total sky upward flux (W/m2) ! dnfxc - total sky dnward flux (W/m2) ! upfx0 - clear sky upward flux (W/m2) ! dnfx0 - clear sky dnward flux (W/m2) - type(cmpfsw_type), dimension(nCol), intent(inout) :: & - scmpsw ! 2D surface fluxes, components: - ! uvbfc - total sky downward uv-b flux at (W/m2) - ! uvbf0 - clear sky downward uv-b flux at (W/m2) - ! nirbm - downward nir direct beam flux (W/m2) - ! nirdf - downward nir diffused flux (W/m2) - ! visbm - downward uv+vis direct beam flux (W/m2) - ! visdf - downward uv+vis diffused flux (W/m2) + real(kind_phys),dimension(nCol, nLev),intent(out),optional :: & + htrswc ! Clear-sky heating rate (K/s) + ! Local variables integer :: i, j, k, iSFC, iTOA, itop, ibtc real(kind_phys) :: tem0d, tem1, tem2 - real(kind_phys), dimension(nDay, Model%levs) :: thetaTendClrSky, thetaTendAllSky - logical :: l_fluxessw2d, top_at_1 + real(kind_phys), dimension(nDay, nLev) :: thetaTendClrSky, thetaTendAllSky + logical :: l_fluxessw2d, top_at_1, l_scmpsw ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (.not. Model%lsswr) return + if (.not. lsswr) return if (nDay .gt. 0) then ! Are any optional outputs requested? - l_fluxessw2d = present(flxprf_sw) + 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, Model%levs)) + top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) if (top_at_1) then - iSFC = Model%levs+1 + iSFC = nLev+1 iTOA = 1 else iSFC = 1 - iTOA = Model%levs+1 + iTOA = nLev+1 endif ! ####################################################################################### ! Compute SW heating-rates ! ####################################################################################### ! Clear-sky heating-rate (optional) - if (Model%swhtr) then - hsw0(:,:) = 0._kind_phys + if (do_sw_clrsky_hr) then + htrswc(:,:) = 0._kind_phys call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & fluxswUP_clrsky(idxday(1:nDay),:), & ! IN - Shortwave upward clear-sky flux profiles (W/m2) fluxswDOWN_clrsky(idxday(1:nDay),:), & ! IN - Shortwave downward clear-sky flux profiles (W/m2) p_lev(idxday(1:nDay),:), & ! IN - Pressure at model-interface (Pa) thetaTendClrSky)) ! OUT - Clear-sky heating-rate (K/sec) - hsw0(idxday(1:nDay),:)=thetaTendClrSky + htrswc(idxday(1:nDay),:)=thetaTendClrSky !**NOTE** GP doesn't use radiation levels, it uses the model fields. Not sure if this is necessary endif ! All-sky heating-rate (mandatory) - hswc(:,:) = 0._kind_phys + htrsw(:,:) = 0._kind_phys call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & fluxswUP_allsky(idxday(1:nDay),:), & ! IN - Shortwave upward all-sky flux profiles (W/m2) fluxswDOWN_allsky(idxday(1:nDay),:), & ! IN - Shortwave downward all-sky flux profiles (W/m2) p_lev(idxday(1:nDay),:), & ! IN - Pressure at model-interface (Pa) thetaTendAllSky)) ! OUT - All-sky heating-rate (K/sec) - hswc(idxday(1:nDay),:) = thetaTendAllSky + htrsw(idxday(1:nDay),:) = thetaTendAllSky + ! ####################################################################################### + ! Save SW outputs + ! ####################################################################################### ! Copy fluxes from RRTGMP types into model radiation types. ! Mandatory outputs - Diag%topfsw(:)%upfxc = fluxswUP_allsky(:,iTOA) - Diag%topfsw(:)%upfx0 = fluxswUP_clrsky(:,iTOA) - Diag%topfsw(:)%dnfxc = fluxswDOWN_allsky(:,iTOA) - Radtend%sfcfsw(:)%upfxc = fluxswUP_allsky(:,iSFC) - Radtend%sfcfsw(:)%upfx0 = fluxswUP_clrsky(:,iSFC) - Radtend%sfcfsw(:)%dnfxc = fluxswDOWN_allsky(:,iSFC) - Radtend%sfcfsw(:)%dnfx0 = fluxswDOWN_clrsky(:,iSFC) + topfsw(:)%upfxc = fluxswUP_allsky(:,iTOA) + topfsw(:)%upfx0 = fluxswUP_clrsky(:,iTOA) + topfsw(:)%dnfxc = fluxswDOWN_allsky(:,iTOA) + 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 @@ -170,63 +194,54 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein flxprf_sw(:,:)%dnfx0 = fluxswDOWN_clrsky(:,:) endif - ! ####################################################################################### - ! Save SW outputs - ! ####################################################################################### - ! All-sky heating rate - do k = 1, Model%levs - Radtend%htrsw(1:nCol,k) = hswc(1:nCol,k) - enddo - ! Clear-sky heating rate - if (Model%swhtr) then - do k = 1, Model%levs - Radtend%swhc(1:nCol,k) = hsw0(1:nCol,k) - enddo - endif - ! Surface down and up spectral component fluxes ! - Save two spectral bands' surface downward and upward fluxes for output. - do i=1,nCol - Coupling%nirbmdi(i) = scmpsw(i)%nirbm - Coupling%nirdfdi(i) = scmpsw(i)%nirdf - Coupling%visbmdi(i) = scmpsw(i)%visbm - Coupling%visdfdi(i) = scmpsw(i)%visdf - - Coupling%nirbmui(i) = scmpsw(i)%nirbm * sfc_alb_nir_dir(1,i) - Coupling%nirdfui(i) = scmpsw(i)%nirdf * sfc_alb_nir_dif(1,i) - Coupling%visbmui(i) = scmpsw(i)%visbm * sfc_alb_uvvis_dir(1,i) - Coupling%visdfui(i) = scmpsw(i)%visdf * sfc_alb_uvvis_dif(1,i) - enddo + 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 else ! if_nday_block ! ####################################################################################### - ! Save SW outputs + ! Dark everywhere ! ####################################################################################### - Radtend%htrsw(:,:) = 0.0 - Radtend%sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) - Diag%topfsw = topfsw_type( 0.0, 0.0, 0.0 ) - scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) + htrsw(:,:) = 0.0 + sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) + topfsw = topfsw_type( 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 - do i=1,nCol - Coupling%nirbmdi(i) = 0.0 - Coupling%nirdfdi(i) = 0.0 - Coupling%visbmdi(i) = 0.0 - Coupling%visdfdi(i) = 0.0 - - Coupling%nirbmui(i) = 0.0 - Coupling%nirdfui(i) = 0.0 - Coupling%visbmui(i) = 0.0 - Coupling%visdfui(i) = 0.0 - enddo - - if (Model%swhtr) then - Radtend%swhc(:,:) = 0 + if (do_sw_clrsky_hr) then + htrswc(:,:) = 0 endif endif ! end_if_nday ! Radiation fluxes for other physics processes do i=1,nCol - Coupling%sfcnsw(i) = Radtend%sfcfsw(i)%dnfxc - Radtend%sfcfsw(i)%upfxc - Coupling%sfcdsw(i) = Radtend%sfcfsw(i)%dnfxc + sfcnsw(i) = sfcfsw(i)%dnfxc - sfcfsw(i)%upfxc + sfcdsw(i) = sfcfsw(i)%dnfxc enddo ! ####################################################################################### @@ -237,63 +252,63 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein ! corresponding slots of array fluxr with appropriate time weights. ! - Collect the fluxr data for wrtsfc ! ####################################################################################### - if (Model%lssav) then - do i=1,nCol - Diag%fluxr(i,34) = Diag%fluxr(i,34) + Model%fhswr*aerodp(i,1) ! total aod at 550nm - Diag%fluxr(i,35) = Diag%fluxr(i,35) + Model%fhswr*aerodp(i,2) ! DU aod at 550nm - Diag%fluxr(i,36) = Diag%fluxr(i,36) + Model%fhswr*aerodp(i,3) ! BC aod at 550nm - Diag%fluxr(i,37) = Diag%fluxr(i,37) + Model%fhswr*aerodp(i,4) ! OC aod at 550nm - Diag%fluxr(i,38) = Diag%fluxr(i,38) + Model%fhswr*aerodp(i,5) ! SU aod at 550nm - Diag%fluxr(i,39) = Diag%fluxr(i,39) + Model%fhswr*aerodp(i,6) ! SS aod at 550nm - if (Radtend%coszen(i) > 0.) then - ! SW all-sky fluxes - tem0d = Model%fhswr * Radtend%coszdg(i) / Radtend%coszen(i) - Diag%fluxr(i,2 ) = Diag%fluxr(i,2) + Diag%topfsw(i)%upfxc * tem0d ! total sky top sw up - Diag%fluxr(i,3 ) = Diag%fluxr(i,3) + Radtend%sfcfsw(i)%upfxc * tem0d - Diag%fluxr(i,4 ) = Diag%fluxr(i,4) + Radtend%sfcfsw(i)%dnfxc * tem0d ! total sky sfc sw dn - ! SW uv-b fluxes - Diag%fluxr(i,21) = Diag%fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b sw dn - Diag%fluxr(i,22) = Diag%fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b sw dn - ! SW TOA incoming fluxes - Diag%fluxr(i,23) = Diag%fluxr(i,23) + Diag%topfsw(i)%dnfxc * tem0d ! top sw dn - ! SW SFC flux components - Diag%fluxr(i,24) = Diag%fluxr(i,24) + scmpsw(i)%visbm * tem0d ! uv/vis beam sw dn - Diag%fluxr(i,25) = Diag%fluxr(i,25) + scmpsw(i)%visdf * tem0d ! uv/vis diff sw dn - Diag%fluxr(i,26) = Diag%fluxr(i,26) + scmpsw(i)%nirbm * tem0d ! nir beam sw dn - Diag%fluxr(i,27) = Diag%fluxr(i,27) + scmpsw(i)%nirdf * tem0d ! nir diff sw dn - ! SW clear-sky fluxes - Diag%fluxr(i,29) = Diag%fluxr(i,29) + Diag%topfsw(i)%upfx0 * tem0d - Diag%fluxr(i,31) = Diag%fluxr(i,31) + Radtend%sfcfsw(i)%upfx0 * tem0d - Diag%fluxr(i,32) = Diag%fluxr(i,32) + Radtend%sfcfsw(i)%dnfx0 * tem0d - endif - enddo - - ! Save total and boundary-layer clouds - do i=1,nCol - Diag%fluxr(i,17) = Diag%fluxr(i,17) + raddt * cldsa(i,4) - Diag%fluxr(i,18) = Diag%fluxr(i,18) + raddt * cldsa(i,5) - enddo - - ! Save cld frac,toplyr,botlyr and top temp, note that the order of h,m,l cloud - ! is reversed for the fluxr output. save interface pressure (pa) of top/bot - do j = 1, 3 - do i = 1, nCol - tem0d = raddt * cldsa(i,j) - itop = mtopa(i,j) - ibtc = mbota(i,j) - Diag%fluxr(i, 8-j) = Diag%fluxr(i, 8-j) + tem0d - Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * Statein%prsi(i,itop) - Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * Statein%prsi(i,ibtc) - Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * Statein%tgrs(i,itop) - - ! Add optical depth and emissivity output - tem1 = 0. - do k=ibtc,itop - tem1 = tem1 + cldtausw(i,k) ! approx .55 mu channel - enddo - Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1 - enddo - enddo + if (save_diag) then +! do i=1,nCol +! Diag%fluxr(i,34) = Diag%fluxr(i,34) + fhswr*aerodp(i,1) ! total aod at 550nm +! Diag%fluxr(i,35) = Diag%fluxr(i,35) + fhswr*aerodp(i,2) ! DU aod at 550nm +! Diag%fluxr(i,36) = Diag%fluxr(i,36) + fhswr*aerodp(i,3) ! BC aod at 550nm +! Diag%fluxr(i,37) = Diag%fluxr(i,37) + fhswr*aerodp(i,4) ! OC aod at 550nm +! Diag%fluxr(i,38) = Diag%fluxr(i,38) + fhswr*aerodp(i,5) ! SU aod at 550nm +! Diag%fluxr(i,39) = Diag%fluxr(i,39) + fhswr*aerodp(i,6) ! SS aod at 550nm +! if (coszen(i) > 0.) then +! ! SW all-sky fluxes +! tem0d = fhswr * coszdg(i) / coszen(i) +! Diag%fluxr(i,2 ) = Diag%fluxr(i,2) + topfsw(i)%upfxc * tem0d ! total sky top sw up +! Diag%fluxr(i,3 ) = Diag%fluxr(i,3) + sfcfsw(i)%upfxc * tem0d +! Diag%fluxr(i,4 ) = Diag%fluxr(i,4) + sfcfsw(i)%dnfxc * tem0d ! total sky sfc sw dn +! ! SW uv-b fluxes +! Diag%fluxr(i,21) = Diag%fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b sw dn +! Diag%fluxr(i,22) = Diag%fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b sw dn +! ! SW TOA incoming fluxes +! Diag%fluxr(i,23) = Diag%fluxr(i,23) + topfsw(i)%dnfxc * tem0d ! top sw dn +! ! SW SFC flux components +! Diag%fluxr(i,24) = Diag%fluxr(i,24) + visbmdi(i) * tem0d ! uv/vis beam sw dn +! Diag%fluxr(i,25) = Diag%fluxr(i,25) + visdfdi(i) * tem0d ! uv/vis diff sw dn +! Diag%fluxr(i,26) = Diag%fluxr(i,26) + nirbmdi(i) * tem0d ! nir beam sw dn +! Diag%fluxr(i,27) = Diag%fluxr(i,27) + nirdfdi(i) * tem0d ! nir diff sw dn +! ! SW clear-sky fluxes +! Diag%fluxr(i,29) = Diag%fluxr(i,29) + topfsw(i)%upfx0 * tem0d +! Diag%fluxr(i,31) = Diag%fluxr(i,31) + sfcfsw(i)%upfx0 * tem0d +! Diag%fluxr(i,32) = Diag%fluxr(i,32) + sfcfsw(i)%dnfx0 * tem0d +! endif +! enddo +! +! ! Save total and boundary-layer clouds +! do i=1,nCol +! Diag%fluxr(i,17) = Diag%fluxr(i,17) + raddt * cldsa(i,4) +! Diag%fluxr(i,18) = Diag%fluxr(i,18) + raddt * cldsa(i,5) +! enddo +! +! ! Save cld frac,toplyr,botlyr and top temp, note that the order of h,m,l cloud +! ! is reversed for the fluxr output. save interface pressure (pa) of top/bot +! do j = 1, 3 +! do i = 1, nCol +! tem0d = raddt * cldsa(i,j) +! itop = mtopa(i,j) +! ibtc = mbota(i,j) +! Diag%fluxr(i, 8-j) = Diag%fluxr(i, 8-j) + tem0d +! Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * p_lev(i,itop) +! Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * p_lev(i,ibtc) +! Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * p_lev(i,itop) +! +! ! Add optical depth and emissivity output +! tem1 = 0. +! do k=ibtc,itop +! tem1 = tem1 + cldtausw(i,k) ! approx .55 mu channel +! enddo +! Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1 +! enddo +! enddo endif end subroutine GFS_rrtmgp_sw_post_run diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index 806bd49e4..94f2cbf5f 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -1,68 +1,96 @@ [ccpp-arg-table] name = GFS_rrtmgp_sw_post_run type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type - units = DDT +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count dimensions = () - type = GFS_control_type + type = integer intent = in optional = F -[Grid] - standard_name = GFS_grid_type_instance - long_name = instance of derived type GFS_grid_type - units = DDT +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count dimensions = () - type = GFS_grid_type + type = integer intent = in - optional = F -[Diag] - standard_name = GFS_diag_type_instance - long_name = instance of derived type GFS_diag_type - units = DDT + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count dimensions = () - type = GFS_diag_type - intent = inout + type = integer + intent = in optional = F -[Radtend] - standard_name = GFS_radtend_type_instance - long_name = instance of derived type GFS_radtend_type - units = DDT - dimensions = () - type = GFS_radtend_type - intent = inout +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in optional = F -[Coupling] - standard_name = GFS_coupling_type_instance - long_name = instance of derived type GFS_coupling_type - units = DDT +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag dimensions = () - type = GFS_coupling_type - intent = inout + type = logical + intent = in optional = F -[Statein] - standard_name = GFS_statein_type_instance - long_name = instance of derived type GFS_statein_type - units = DDT +[do_sw_clrsky_hr] + standard_name = flag_for_output_of_shortwave_heating_rate + long_name = flag to output sw heating rate + units = flag dimensions = () - type = GFS_statein_type + type = logical intent = in - optional = F -[scmpsw] - standard_name = components_of_surface_downward_shortwave_fluxes - long_name = derived type for special components of surface downward shortwave fluxes - units = W m-2 + optional = F +[save_diag] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[fhswr] + standard_name = frequency_for_shortwave_radiation + long_name = frequency for shortwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[coszen] + standard_name = cosine_of_zenith_angle + long_name = mean cos of zenith angle over rad call period + units = none dimensions = (horizontal_dimension) - type = cmpfsw_type - intent = inout + type = real + kind = kind_phys + intent = in + optional = F +[coszdg] + standard_name = daytime_mean_cosz_over_rad_call_period + long_name = daytime mean cosz over rad call period + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in optional = F -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature at vertical layer for radiation calculation + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys intent = in optional = F [p_lev] @@ -110,22 +138,6 @@ kind = kind_phys intent = in optional = F -[nday] - standard_name = daytime_points_dimension - long_name = daytime points dimension - units = count - dimensions = () - type = integer - intent = in - optional = F -[idxday] - standard_name = daytime_points - long_name = daytime points - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in - optional = F [fluxswUP_allsky] standard_name = RRTMGP_sw_flux_profile_upward_allsky long_name = RRTMGP upward shortwave all-sky flux profile @@ -231,14 +243,146 @@ type = ty_gas_optics_rrtmgp intent = in optional = F +[nirbmdi] + standard_name = surface_downwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step + long_name = sfc nir beam sw downward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[nirdfdi] + standard_name = surface_downwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step + long_name = sfc nir diff sw downward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[visbmdi] + standard_name = surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step + long_name = sfc uv+vis beam sw downward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[visdfdi] + standard_name = surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step + long_name = sfc uv+vis diff sw downward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[nirbmui] + standard_name = surface_upwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step + long_name = sfc nir beam sw upward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[nirdfui] + standard_name = surface_upwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step + long_name = sfc nir diff sw upward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[visbmui] + standard_name = surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step + long_name = sfc uv+vis beam sw upward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[visdfui] + standard_name = surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step + long_name = sfc uv+vis diff sw upward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfcnsw] + standard_name = surface_net_downwelling_shortwave_flux_on_radiation_time_step + long_name = total sky sfc netsw flx into ground + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfcdsw] + standard_name = surface_downwelling_shortwave_flux_on_radiation_time_step + long_name = total sky sfc downward sw flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfcfsw] + standard_name = sw_fluxes_sfc + long_name = sw radiation fluxes at sfc + units = W m-2 + dimensions = (horizontal_dimension) + type = sfcfsw_type + intent = out + optional = F +[htrsw] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step + long_name = total sky sw heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[topfsw] + standard_name = sw_fluxes_top_atmosphere + long_name = sw radiation fluxes at toa + units = W m-2 + dimensions = (horizontal_dimension) + type = topfsw_type + intent = out + optional = F +[htrswc] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step + long_name = clear sky sw heating rates + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = T +[scmpsw] + standard_name = components_of_surface_downward_shortwave_fluxes + long_name = derived type for special components of surface downward shortwave fluxes + units = W m-2 + dimensions = (horizontal_dimension) + type = cmpfsw_type + intent = in + optional = T [flxprf_sw] standard_name = RRTMGP_sw_fluxes long_name = sw fluxes total sky / csk and up / down at levels units = W m-2 dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_plus_one) type = profsw_type - intent = inout - optional = T + intent = out + optional = T [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 6987c3e4a..c4208d872 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -2,14 +2,6 @@ module GFS_rrtmgp_sw_pre use physparam use machine, only: & kind_phys ! Working type - use GFS_typedefs, only: & - GFS_sfcprop_type, & ! Surface fields - GFS_control_type, & ! Model control parameters - GFS_grid_type, & ! Grid and interpolation related data - GFS_coupling_type, & ! - GFS_statein_type, & ! - GFS_radtend_type, & ! Radiation tendencies needed in physics - GFS_interstitial_type use module_radiation_astronomy,only: & coszmn ! Function to compute cos(SZA) use module_radiation_surface, only: & @@ -35,29 +27,52 @@ 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(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_lev, & - tv_lay, relhum, tracer, sw_gas_props, nday, idxday, alb1d, sfc_alb_nir_dir, & - sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, RadTend, Coupling, & - errmsg, errflg) + subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, nsfcpert, lsswr, do_sfcperts, solhr, & + pertalb, lon, coslat, sinlat, snowd, sncovr, snoalb, zorl, tsfc, hprime, alvsf, & + alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, lsmask, sfc_wts, p_lay, tv_lay, & + relhum, p_lev, sw_gas_props, & + nday, idxday, alb1d, coszen, coszdg, sfc_alb_nir_dir, sfc_alb_nir_dif, & + sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, errmsg, errflg) - ! Inputs - type(GFS_control_type), intent(in) :: & - Model ! DDT: FV3-GFS model control parameters - type(GFS_grid_type), intent(in) :: & - Grid ! DDT: FV3-GFS grid and interpolation related data - type(GFS_sfcprop_type), intent(in) :: & - Sfcprop ! DDT: FV3-GFS surface fields - type(GFS_statein_type), intent(in) :: & - Statein ! DDT: FV3-GFS prognostic state data in from dycore + ! Inputs integer, intent(in) :: & - ncol ! Number of horizontal grid points - real(kind_phys), dimension(ncol,Model%levs),intent(in) :: & + me, & ! Current MPI rank + nCol, & ! Number of horizontal grid points + nLev, & ! Number of vertical layers + nsfcpert ! Number of surface perturbations + logical,intent(in) :: & + lsswr, & ! Call RRTMGP SW radiation? + do_sfcperts + real(kind_phys), intent(in) :: & + solhr ! Time in hours after 00z at the current timestep + real(kind_phys), dimension(5), intent(in) :: & + pertalb ! Magnitude of surface albedo perturbation (frac) + real(kind_phys), dimension(nCol), intent(in) :: & + lsmask, & ! Landmask: sea/land/ice=0/1/2 + lon, & ! Longitude + coslat, & ! Cosine(latitude) + sinlat, & ! Sine(latitude) + snowd, & ! Water equivalent snow depth (mm) + sncovr, & ! Surface snow area fraction (frac) + snoalb, & ! Maximum snow albedo (frac) + zorl, & ! Surface roughness length (cm) + tsfc, & ! Surface skin temperature (K) + hprime, & ! Standard deviation of subgrid orography (m) + alvsf, & ! Mean vis albedo with strong cosz dependency (frac) + alnsf, & ! Mean nir albedo with strong cosz dependency (frac) + alvwf, & ! Mean vis albedo with weak cosz dependency (frac) + alnwf, & ! Mean nir albedo with weak cosz dependency (frac) + facsf, & ! Fractional coverage with strong cosz dependency (frac) + facwf, & ! Fractional coverage with weak cosz dependency (frac) + fice, & ! Ice fraction over open water (frac) + tisfc ! Sea ice surface skin temperature (K) + real(kind_phys), dimension(nCol,nsfcpert), intent(in) :: & + sfc_wts ! Weights for stochastic surface physics perturbation () + real(kind_phys), dimension(nCol,nLev),intent(in) :: & p_lay, & ! Layer pressure tv_lay, & ! Layer virtual-temperature relhum ! Layer relative-humidity - real(kind_phys), dimension(ncol, Model%levs, 2:Model%ntrac),intent(in) :: & - tracer - real(kind_phys), dimension(ncol,Model%levs+1),intent(in) :: & + real(kind_phys), dimension(nCol,nLev+1),intent(in) :: & p_lev ! Pressure @ layer interfaces (Pa) type(ty_gas_optics_rrtmgp),intent(in) :: & sw_gas_props ! RRTMGP DDT: spectral information for SW calculation @@ -68,16 +83,15 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_ integer, dimension(ncol), intent(out) :: & idxday ! Indices for daylit points real(kind_phys), dimension(ncol), intent(out) :: & - alb1d ! Surface albedo pertubation + alb1d, & ! Surface albedo pertubation + coszen, & ! Cosine of SZA + coszdg, & ! Cosine of SZA, daytime + sfc_alb_dif ! Mean surface diffused (nIR+uvvis) sw albedo real(kind_phys), dimension(sw_gas_props%get_nband(),ncol), intent(out) :: & sfc_alb_nir_dir, & ! Surface albedo (direct) sfc_alb_nir_dif, & ! Surface albedo (diffuse) sfc_alb_uvvis_dir, & ! Surface albedo (direct) sfc_alb_uvvis_dif ! Surface albedo (diffuse) - type(GFS_radtend_type), intent(inout) :: & - Radtend ! DDT: FV3-GFS radiation tendencies - type(GFS_coupling_type), intent(inout) :: & - Coupling ! DDT: FV3-GFS coupling arrays character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & @@ -91,13 +105,12 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_ errmsg = '' errflg = 0 - if (.not. Model%lsswr) return + if (.not. lsswr) return ! ####################################################################################### ! Compute cosine of zenith angle (only when SW is called) ! ####################################################################################### - call coszmn (Grid%xlon, Grid%sinlat, Grid%coslat, Model%solhr, NCOL, Model%me, & - Radtend%coszen, Radtend%coszdg) + call coszmn (lon, sinlat, coslat, solhr, nCol, me, coszen, coszdg) ! ####################################################################################### ! For SW gather daylit points @@ -105,7 +118,7 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_ nday = 0 idxday = 0 do i = 1, NCOL - if (Radtend%coszen(i) >= 0.0001) then + if (coszen(i) >= 0.0001) then nday = nday + 1 idxday(nday) = i endif @@ -117,10 +130,10 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_ ! --- turn vegetation fraction pattern into percentile pattern ! ####################################################################################### alb1d(:) = 0. - if (Model%do_sfcperts) then - if (Model%pertalb(1) > 0.) then + if (do_sfcperts) then + if (pertalb(1) > 0.) then do i=1,ncol - call cdfnor(Coupling%sfc_wts(i,5),alb1d(i)) + call cdfnor(sfc_wts(i,5),alb1d(i)) enddo endif endif @@ -128,13 +141,11 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_ ! ####################################################################################### ! Call module_radiation_surface::setalb() to setup surface albedo. ! ####################################################################################### - call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%snoalb, Sfcprop%zorl, & - Radtend%coszen, Sfcprop%tsfc, Sfcprop%tsfc, Sfcprop%hprime(:,1), Sfcprop%alvsf, & - Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, Sfcprop%facsf, Sfcprop%facwf, & - Sfcprop%fice, Sfcprop%tisfc, NCOL, alb1d, Model%pertalb, sfcalb) + call setalb (lsmask, snowd, sncovr, snoalb, zorl, coszen, tsfc, tsfc, hprime, alvsf, & + alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, NCOL, alb1d, pertalb, sfcalb) ! Approximate mean surface albedo from vis- and nir- diffuse values. - Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) + sfc_alb_dif(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) ! Spread across all SW bands do iBand=1,sw_gas_props%get_nband() diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index 3a96e1522..1cccf6ffd 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -1,60 +1,241 @@ [ccpp-arg-table] name = GFS_rrtmgp_sw_pre_run type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type - units = DDT +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index dimensions = () - type = GFS_control_type + type = integer intent = in optional = F -[Grid] - standard_name = GFS_grid_type_instance - long_name = instance of derived type GFS_grid_type - units = DDT +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count dimensions = () - type = GFS_grid_type + type = integer intent = in optional = F -[Sfcprop] - standard_name = GFS_sfcprop_type_instance - long_name = instance of derived type GFS_sfcprop_type - units = DDT +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count dimensions = () - type = GFS_sfcprop_type + type = integer intent = in - optional = F -[Statein] - standard_name = GFS_statein_type_instance - long_name = instance of derived type GFS_statein_type - units = DDT + optional = F +[nsfcpert] + standard_name = number_of_surface_perturbations + long_name = number of surface perturbations + units = count dimensions = () - type = GFS_statein_type + type = integer intent = in - optional = F -[Radtend] - standard_name = GFS_radtend_type_instance - long_name = instance of derived type GFS_radtend_type - units = DDT + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag dimensions = () - type = GFS_radtend_type - intent = inout + type = logical + intent = in optional = F -[Coupling] - standard_name = GFS_coupling_type_instance - long_name = Fortran DDT containing FV3-GFS fields to/from coupling with other components - units = DDT +[do_sfcperts] + standard_name = flag_for_stochastic_surface_perturbations + long_name = flag for stochastic surface perturbations option + units = flag dimensions = () - type = GFS_coupling_type - intent = inout + type = logical + intent = in optional = F -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count +[solhr] + standard_name = forecast_hour_of_the_day + long_name = time in hours after 00z at the current timestep + units = h dimensions = () - type = integer + type = real + kind = kind_phys + intent = in + optional = F +[pertalb] + standard_name = magnitude_of_surface_albedo_perturbation + long_name = magnitude of surface albedo perturbation + units = frac + dimensions = (5) + type = real + kind = kind_phys + intent = in + optional = F +[lon] + standard_name = longitude + long_name = longitude + units = radian + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[coslat] + standard_name = cosine_of_latitude + long_name = cosine of latitude + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sinlat] + standard_name = sine_of_latitude + long_name = sine of latitude + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lsmask] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snowd] + standard_name = surface_snow_thickness_water_equivalent + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sncovr] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snoalb] + standard_name = upper_bound_on_max_albedo_over_deep_snow + long_name = maximum snow albedo + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hprime] + standard_name = standard_deviation_of_subgrid_orography + long_name = standard deviation of subgrid orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alvsf] + standard_name = mean_vis_albedo_with_strong_cosz_dependency + long_name = mean vis albedo with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alnsf] + standard_name = mean_nir_albedo_with_strong_cosz_dependency + long_name = mean nir albedo with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alvwf] + standard_name = mean_vis_albedo_with_weak_cosz_dependency + long_name = mean vis albedo with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alnwf] + standard_name = mean_nir_albedo_with_weak_cosz_dependency + long_name = mean nir albedo with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[facsf] + standard_name =fractional_coverage_with_strong_cosz_dependency + long_name = fractional coverage with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[facwf] + standard_name = fractional_coverage_with_weak_cosz_dependency + long_name = fractional coverage with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tisfc] + standard_name = sea_ice_temperature + long_name = sea ice surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_wts] + standard_name = weights_for_stochastic_surface_physics_perturbation + long_name = weights for stochastic surface physics perturbation + units = none + dimensions = (horizontal_dimension,number_of_surface_perturbations) + type = real + kind = kind_phys intent = in optional = F [tv_lay] @@ -93,15 +274,6 @@ kind = kind_phys intent = in optional = F -[tracer] - standard_name = chemical_tracers - long_name = chemical tracers - units = g g-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = in - optional = F [sw_gas_props] standard_name = coefficients_for_sw_gas_optics long_name = DDT containing spectral information for RRTMGP SW radiation scheme @@ -171,6 +343,33 @@ type = integer intent = out optional = F +[coszen] + standard_name = cosine_of_zenith_angle + long_name = mean cos of zenith angle over rad call period + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[coszdg] + standard_name = daytime_mean_cosz_over_rad_call_period + long_name = daytime mean cosz over rad call period + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfc_alb_dif] + standard_name = surface_diffused_shortwave_albedo + long_name = mean surface diffused sw albedo + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rrtmgp_zhaocarr_pre.F90 b/physics/GFS_rrtmgp_zhaocarr_pre.F90 new file mode 100644 index 000000000..ac9fb7446 --- /dev/null +++ b/physics/GFS_rrtmgp_zhaocarr_pre.F90 @@ -0,0 +1,253 @@ +! ######################################################################################## +! This module contains the interface between the Zhao-Carr macrophysics and the RRTMGP +! radiation schemes. Only compatable with imp_physics = imp_physics_zhaocarr +! ######################################################################################## +module GFS_rrtmgp_zhaocarr_pre + use machine, only: kind_phys + use rrtmgp_aux, only: check_error_msg + use funcphys, only: fpvs + use module_radiation_clouds, only: get_alpha_dcorr + + ! Zhao-Carr MP parameters. + real(kind_phys), parameter :: & + reliq_def = 10.0 , & ! Default liq radius to 10 micron + reice_def = 50.0, & ! Default ice radius to 50 micron + rerain_def = 1000.0, & ! Default rain radius to 1000 micron + resnow_def = 250.0 ! Default snow radius to 250 micron + + public GFS_rrtmgp_zhaocarr_pre_init, GFS_rrtmgp_zhaocarr_pre_run, GFS_rrtmgp_zhaocarr_pre_finalize + +contains + ! ###################################################################################### + ! ###################################################################################### + subroutine GFS_rrtmgp_zhaocarr_pre_init() + end subroutine GFS_rrtmgp_zhaocarr_pre_init + + ! ###################################################################################### + ! ###################################################################################### +!! \section arg_table_GFS_rrtmgp_zhaocarr_pre_run +!! \htmlinclude GFS_rrtmgp_zhaocarr_pre_run.html +!! + subroutine GFS_rrtmgp_zhaocarr_pre_run(nCol, nLev, nCnd, nTracers, i_cldliq, lsswr, & + lslwr, effr_in, uni_cld, lmfshal, lat, lsmask, p_lev, p_lay, t_lay, relhum, & + tv_lay, effrin_cldliq, effrin_cldice, effrin_cldrain, effrin_cldsnow, & + shoc_sgs_cldfrac, cncvw, tracer, & + con_eps, con_epsq, con_epsqs, con_epsm1, con_g, con_ttp, con_rd, con_pi, & + cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & + cld_rerain, de_lgth, deltaZ, cloud_overlap_param, errmsg, errflg) + implicit none + + ! Inputs + integer, intent(in) :: & + nCol, & ! Number of horizontal grid points + nLev, & ! Number of vertical layers + nCnd, & ! Number of cloud condensation types. + nTracers, & ! Number of tracers from model. + i_cldliq ! Index into tracer array for cloud liquid. + logical, intent(in) :: & + lsswr, & ! Call SW radiation? + lslwr, & ! Call LW radiation + effr_in, & ! Provide hydrometeor radii from macrophysics? + uni_cld, & ! + lmfshal + real(kind_phys), intent(in) :: & + con_eps, & ! rd/rv + con_epsm1, & ! (rd/rv) - 1 + con_epsq, & ! Floor value for specific humidity + con_epsqs, & ! Floor value for saturation mixing ratio + con_g, & ! Gravitational acceleration (m/s2) + con_ttp, & ! Triple point temperature of water (K) + con_rd, & ! Ideal gas constant for dry air (J/kg/K) + con_pi ! Pi + real(kind_phys), dimension(nCol), intent(in) :: & + lsmask, & ! Land/Sea mask + lat ! Latitude + real(kind_phys), dimension(nCol,nLev), intent(in) :: & + tv_lay, & ! Virtual temperature (K) + p_lay, & ! Pressure at model-layers (Pa) + t_lay, & ! Temperature at model-layers (K) + relhum, & ! Relative humidity at model-layers () + effrin_cldliq, & ! Effective radius for liquid cloud-particles (microns) + effrin_cldice, & ! Effective radius for ice cloud-particles (microns) + effrin_cldrain, & ! Effective radius for rain cloud-particles (microns) + effrin_cldsnow, & ! Effective radius for snow cloud-particles (microns) + shoc_sgs_cldfrac, & ! Subgrid-scale cloud fraction from the SHOC scheme + cncvw ! Convective cloud water mixing ratio (kg/kg) + real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & + p_lev ! Pressure at model-level interfaces (Pa) + real(kind_phys), dimension(nCol, nLev, nTracers),intent(in) :: & + tracer ! Cloud condensate amount in layer by type () + + ! Outputs + real(kind_phys), dimension(nCol),intent(out) :: & + de_lgth ! Decorrelation length + real(kind_phys), dimension(nCol,nLev),intent(out) :: & + cld_frac, & ! Total cloud fraction + cld_lwp, & ! Cloud liquid water path + cld_reliq, & ! Cloud liquid effective radius + cld_iwp, & ! Cloud ice water path + cld_reice, & ! Cloud ice effecive radius + cld_swp, & ! Cloud snow water path + cld_resnow, & ! Cloud snow effective radius + cld_rwp, & ! Cloud rain water path + cld_rerain, & ! Cloud rain effective radius + deltaZ, & ! Layer thickness (km) + cloud_overlap_param ! Cloud-overlap parameter + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + + ! Local variables + real(kind_phys) :: tem1,tem2,tem3,clwt,onemrh,clwm,clwmin,es,qs,value + real(kind_phys), dimension(nCol, nLev, min(4,nCnd)) :: cld_condensate + integer :: iCol,iLay + real(kind_phys), dimension(nCol,nLev) :: deltaP + + if (.not. (lsswr .or. lslwr)) return + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Initialize outputs + cld_lwp(:,:) = 0.0 + cld_reliq(:,:) = 0.0 + cld_iwp(:,:) = 0.0 + cld_reice(:,:) = 0.0 + cld_rwp(:,:) = 0.0 + cld_rerain(:,:) = 0.0 + cld_swp(:,:) = 0.0 + cld_resnow(:,:) = 0.0 + + ! #################################################################################### + ! Pull out cloud information for Zhao-Carr MP scheme. + ! #################################################################################### + ! Condensate + cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,i_cldliq) ! Liquid water + + ! Set really tiny suspended particle amounts to clear + do iLay=1,nLev + do iCol=1,nCol + if (cld_condensate(iCol,iLay,1) < con_epsq) cld_condensate(iCol,iLay,1) = 0.0 + enddo + enddo + + ! Use radii provided from the macrophysics? + if (effr_in) then + cld_reliq(1:nCol,1:nLev) = effrin_cldliq(1:nCol,1:nLev) + cld_reice(1:nCol,1:nLev) = effrin_cldice(1:nCol,1:nLev) + cld_rerain(1:nCol,1:nLev) = effrin_cldrain(1:nCol,1:nLev) + cld_resnow(1:nCol,1:nLev) = effrin_cldsnow(1:nCol,1:nLev) + endif + + ! Use cloud-fraction from SHOC? + if (uni_cld) then + cld_frac(1:nCol,1:nLev) = shoc_sgs_cldfrac(1:nCol,1:nLev) + ! Compute cloud-fraction? + else + clwmin = 0.0e-6 + if (.not. lmfshal) then + do iLay = 1,nLev + do iCol = 1, nCol + es = min( p_lay(iCol,iLay), fpvs( t_lay(iCol,iLay) ) ) ! fpvs and prsl in pa + qs = max( con_epsqs, con_eps * es / (p_lay(iCol,iLay) + con_epsm1*es) ) + clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.00001) + if (cld_condensate(iCol,iLay,1) > clwt) then + onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) + clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.00001 ) + tem1 = min(max(sqrt(sqrt(onemrh*qs)),0.0001),1.0) + tem1 = 2000.0 / tem1 + value = max( min( tem1*(cld_condensate(iCol,iLay,1)-clwm), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) + cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-value)), 0.0 ) + endif + enddo + enddo + else + do iLay=1,nLev + do iCol = 1, nCol + es = min( p_lay(iCol,iLay), fpvs( t_lay(iCol,iLay) ) ) ! fpvs and prsl in pa + qs = max( con_epsqs, con_eps * es / (p_lay(iCol,iLay) + con_epsm1*es) ) + clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.00001) + if (cld_condensate(iCol,iLay,1) > clwt) then + onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) + clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.00001 ) + tem1 = min(max((onemrh*qs)**0.49,0.0001),1.0) !jhan + tem1 = 100.0 / tem1 + value = max( min( tem1*(cld_condensate(iCol,iLay,1)-clwm), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) + cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-value)), 0.0 ) + endif + enddo + enddo + endif + endif + + ! Add suspended convective cloud water to grid-scale cloud water only for cloud + ! fraction & radiation computation it is to enhance cloudiness due to suspended convec + ! cloud water for zhao/moorthi's (imp_phys=99) + cld_condensate(1:nCol,1:nLev,1) = cld_condensate(1:nCol,1:nLev,1) + cncvw(1:nCol,1:nLev) + + ! Compute cloud liquid/ice condensate path. + deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. + do iLay=1,nLev + do iCol=1,nCol + tem1 = max(0.0, cld_condensate(iCol,iLay,1)) * (1.0e5/con_g) * deltaP(iCol,iLay) + cld_iwp(iCol,iLay) = tem1*(t_lay(iCol,iLay) - 273.16) + cld_lwp(iCol,iLay) = tem1 - cld_iwp(iCol,iLay) + enddo + enddo + + ! Compute effective liquid cloud droplet radius over land. + if(.not. effr_in) then + do iCol = 1, nCol + if (nint(lsmask(iCol)) == 1) then + do iLay = 1, nLev + cld_reliq(iCol,iLay) = 5.0 + 5.0 * (t_lay(iCol,iLay) - 273.16) + enddo + endif + enddo + + ! Compute effective ice cloud droplet radius following Heymsfield + ! and McFarquhar (1996) \cite heymsfield_and_mcfarquhar_1996. + do iLay=1,nLev + do iCol=1,nCol + tem2 = t_lay(iCol,iLay) - con_ttp + if (cld_iwp(iCol,iLay) > 0.0) then + tem3 = (con_g/con_rd ) * cld_iwp(iCol,iLay) * (0.01*p_lay(iCol,iLay)) / (deltaP(iCol,iLay)*tv_lay(iCol,iLay)) + if (tem2 < -50.0) then + cld_reice(iCol,iLay) = (1250.0/9.917) * tem3 ** 0.109 + elseif (tem2 < -40.0) then + cld_reice(iCol,iLay) = (1250.0/9.337) * tem3 ** 0.08 + elseif (tem2 < -30.0) then + cld_reice(iCol,iLay) = (1250.0/9.208) * tem3 ** 0.055 + else + cld_reice(iCol,iLay) = (1250.0/9.387) * tem3 ** 0.031 + endif + cld_reice(iCol,iLay) = max(10.0, min(cld_reice(iCol,iLay), 150.0)) + endif + enddo + enddo + endif + + ! #################################################################################### + ! Cloud (and precipitation) overlap ! #################################################################################### + ! Compute layer-thickness + do iCol=1,nCol + do iLay=1,nLev + 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 + enddo + + ! Cloud overlap parameter + call get_alpha_dcorr(nCol, nLev, lat, con_pi, deltaZ, de_lgth, cloud_overlap_param) + + end subroutine GFS_rrtmgp_zhaocarr_pre_run + + ! ######################################################################################### + ! ######################################################################################### + subroutine GFS_rrtmgp_zhaocarr_pre_finalize() + end subroutine GFS_rrtmgp_zhaocarr_pre_finalize + +end module GFS_rrtmgp_zhaocarr_pre diff --git a/physics/GFS_rrtmgp_zhaocarr_pre.meta b/physics/GFS_rrtmgp_zhaocarr_pre.meta new file mode 100644 index 000000000..052da5798 --- /dev/null +++ b/physics/GFS_rrtmgp_zhaocarr_pre.meta @@ -0,0 +1,406 @@ +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmgp_zhaocarr_pre_run + type = scheme +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[nTracers] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ncnd] + standard_name = number_of_cloud_condensate_types + long_name = number of cloud condensate types + units = count + dimensions = () + type = integer + intent = in + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[effr_in] + standard_name = flag_for_cloud_effective_radii + long_name = flag for cloud effective radii calculations in GFDL microphysics + units = + dimensions = () + type = logical + intent = in + optional = F +[uni_cld] + standard_name = flag_for_uni_cld + long_name = flag for uni_cld + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lmfshal] + standard_name = flag_for_lmfshal + long_name = flag for lmfshal + units = flag + dimensions = () + type = logical + intent = in + optional = F +[i_cldliq] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[lat] + standard_name = latitude + long_name = latitude + units = radian + dimensions = (horizontal_dimension) + type = real + intent = in + kind = kind_phys +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[relhum] + standard_name = relative_humidity + long_name = layer relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature at vertical layer for radiation calculation + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[effrin_cldliq] + standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um + long_name = eff. radius of cloud liquid water particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[effrin_cldice] + standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um + long_name = eff. radius of cloud ice water particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[effrin_cldrain] + standard_name = effective_radius_of_stratiform_cloud_rain_particle_in_um + long_name = effective radius of cloud rain particle in micrometers + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[effrin_cldsnow] + standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um + long_name = effective radius of cloud snow particle in micrometers + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[shoc_sgs_cldfrac] + standard_name = subgrid_scale_cloud_fraction_from_shoc + long_name = subgrid-scale cloud fraction from the SHOC scheme + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cncvw] + standard_name = convective_cloud_water_mixing_ratio_in_phy_f3d + long_name = convective cloud water mixing ratio in the phy_f3d array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tracer] + standard_name = chemical_tracers + long_name = chemical tracers + units = g g-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[lsmask] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[con_ttp] + standard_name = triple_point_temperature_of_water + long_name = triple point temperature of water + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_epsq] + standard_name = minimum_value_of_specific_humidity + long_name = floor value for specific humidity + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_epsqs] + standard_name = minimum_value_of_saturation_mixing_ratio + long_name = floor value for saturation mixing ratio + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_lwp] + standard_name = cloud_liquid_water_path + long_name = layer cloud liquid water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_reliq] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_iwp] + standard_name = cloud_ice_water_path + long_name = layer cloud ice water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_reice] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_swp] + standard_name = cloud_snow_water_path + long_name = layer cloud snow water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_resnow] + standard_name = mean_effective_radius_for_snow_flake + long_name = mean effective radius for snow cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_rwp] + standard_name = cloud_rain_water_path + long_name = layer cloud rain water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_rerain] + standard_name = mean_effective_radius_for_rain_drop + long_name = mean effective radius for rain cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cloud_overlap_param] + standard_name = cloud_overlap_param + long_name = cloud overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[deltaZ] + standard_name = layer_thickness + long_name = layer_thickness + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[de_lgth] + standard_name = cloud_decorrelation_length + long_name = cloud decorrelation length + units = km + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F \ No newline at end of file diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 694487704..5e6104478 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -144,6 +144,7 @@ module GFS_suite_interstitial_2 use machine, only: kind_phys real(kind=kind_phys), parameter :: one = 1.0d0 + logical :: linit_mod = .false. contains @@ -157,11 +158,11 @@ end subroutine GFS_suite_interstitial_2_finalize !! \htmlinclude GFS_suite_interstitial_2_run.html !! #endif - subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplflx, flag_cice, shal_cnv, old_monin, mstrat, & - do_shoc, frac_grid, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, cice, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm, & - work1, work2, prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, suntim, adjsfculw, adjsfculw_lnd, & - adjsfculw_ice, adjsfculw_wat, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, & - ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, errmsg, errflg) + subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplflx, flag_cice, shal_cnv, old_monin, mstrat, & + do_shoc, frac_grid, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, cice, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm, & + work1, work2, prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, suntim, adjsfculw, adjsfculw_lnd, & + adjsfculw_ice, adjsfculw_wat, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, & + ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, use_GP_jacobian, skt, sktp1r, fluxlwUP, fluxlwUP_jac, errmsg, errflg) implicit none @@ -178,11 +179,21 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl real(kind=kind_phys), intent(in ), dimension(im, levs) :: htrsw, htrlw, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, prslk real(kind=kind_phys), intent(in ), dimension(im, levs+1) :: prsi real(kind=kind_phys), intent(in ), dimension(im, levs, 6) :: lwhd - integer, intent(inout), dimension(im) :: kinver real(kind=kind_phys), intent(inout), dimension(im) :: suntim, dlwsfc, ulwsfc, psmean, ctei_rml, ctei_r real(kind=kind_phys), intent(in ), dimension(im) :: adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat real(kind=kind_phys), intent( out), dimension(im) :: adjsfculw + + ! RRTMGP + logical, intent(in ) :: & + use_GP_jacobian ! Use RRTMGP LW Jacobian of upwelling to adjust the surface flux? + real(kind=kind_phys), intent(in ), dimension(im) :: & + skt ! Skin temperature + real(kind=kind_phys), intent(inout), dimension(im) :: & + sktp1r ! Skin temperature at previous timestep + real(kind=kind_phys), intent(in ), dimension(im,levs+1), optional :: & + fluxlwUP, & ! Upwelling LW flux (W/m2) + fluxlwUP_jac ! Jacobian of upwelling LW flux (W/m2/K) ! These arrays are only allocated if ldiag3d is .true. real(kind=kind_phys), intent(inout), dimension(:,:) :: dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp @@ -199,7 +210,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl integer :: i, k real(kind=kind_phys) :: tem1, tem2, tem, hocp logical, dimension(im) :: invrsn - real(kind=kind_phys), dimension(im) :: tx1, tx2 + real(kind=kind_phys), dimension(im) :: tx1, tx2, dT real(kind=kind_phys), parameter :: qmin = 1.0d-10 @@ -226,6 +237,61 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl ! --- ... sfc lw fluxes used by atmospheric model are saved for output +! --- ... when using RRTMGP w/ use_GP_jacobian, these adjustment factors are pre-computed +! --- ... and provided as inputs in this routine. + + if (use_GP_jacobian) then + ! Compute adjustment to the surface flux using Jacobian. + if(linit_mod) then + dT(:) = (skt(:) - sktp1r(:)) + adjsfculw(:) = fluxlwUP(:,1) + fluxlwUP_jac(:,1) * dT(:) + else + adjsfculw(:) = 0. + linit_mod = .true. + endif + + ! Store surface temperature for next iteration + sktp1r(:) = skt(:) + else + if (frac_grid) then + do i=1,im + tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell + if (flag_cice(i)) then + adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & + + ulwsfc_cice(i) * tem & + + adjsfculw_wat(i) * (one - frland(i) - tem) + else + adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & + + adjsfculw_ice(i) * tem & + + adjsfculw_wat(i) * (one - frland(i) - tem) + endif + enddo + else + do i=1,im + if (dry(i)) then ! all land + adjsfculw(i) = adjsfculw_lnd(i) + elseif (icy(i)) then ! ice (and water) + tem = one - cice(i) + if (flag_cice(i)) then + if (wet(i) .and. adjsfculw_wat(i) /= huge) then + adjsfculw(i) = ulwsfc_cice(i)*cice(i) + adjsfculw_wat(i)*tem + else + adjsfculw(i) = ulwsfc_cice(i) + endif + else + if (wet(i) .and. adjsfculw_wat(i) /= huge) then + adjsfculw(i) = adjsfculw_ice(i)*cice(i) + adjsfculw_wat(i)*tem + else + adjsfculw(i) = adjsfculw_ice(i) + endif + endif + else ! all water + adjsfculw(i) = adjsfculw_wat(i) + endif + enddo + endif + endif + if (frac_grid) then do i=1,im tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 37c474335..522d03f31 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -584,7 +584,7 @@ dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = inout + intent = out optional = F [adjsfculw_lnd] standard_name = surface_upwelling_longwave_flux_over_land_interstitial @@ -762,6 +762,50 @@ kind = kind_phys intent = in optional = F +[use_GP_jacobian] + standard_name = flag_to_calc_RRTMGP_LW_jacobian + long_name = logical flag to control RRTMGP LW calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F +[skt] + standard_name = air_temperature_at_lowest_model_layer + long_name = air temperature at lowest model layer + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sktp1r] + standard_name = surface_skin_temperature_at_previous_time_step + long_name = surface skin temperature at previous time step + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fluxlwUP] + standard_name = RRTMGP_lw_flux_profile_upward_allsky + long_name = RRTMGP upward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = T +[fluxlwUP_jac] + standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward + long_name = RRTMGP Jacobian upward longwave flux profile + units = W m-2 K-1 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = T [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 725011ee4..55ef9c268 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -473,6 +473,7 @@ subroutine drag_suite_run( & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + var_temp2 = 0. !-------------------------------------------------------------------- diff --git a/physics/mo_cloud_sampling.F90 b/physics/mo_cloud_sampling.F90 new file mode 100644 index 000000000..02741439f --- /dev/null +++ b/physics/mo_cloud_sampling.F90 @@ -0,0 +1,398 @@ +! This code is part of RRTM for GCM Applications - Parallel (RRTMGP) +! +! Contacts: Robert Pincus and Eli Mlawer +! email: rrtmgp@aer.com +! +! Copyright 2015-2019, Atmospheric and Environmental Research and +! Regents of the University of Colorado. All right reserved. +! +! Use and duplication is permitted under the terms of the +! BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause +! ------------------------------------------------------------------------------------------------- +! +! This module provides a simple implementation of sampling for the +! Monte Carlo Independent Pixel Approximation (McICA, doi:10.1029/2002jd003322) +! Cloud optical properties, defined by band and assumed homogenous within each cell (column/layer), +! are randomly sampled to preserve the mean cloud fraction and one of several possible overlap assumptions +! Users supply random numbers with order ngpt,nlay,ncol +! These are only accessed if cloud_fraction(icol,ilay) > 0 so many values don't need to be filled in +! +! ------------------------------------------------------------------------------------------------- +module mo_cloud_sampling + use mo_rte_kind, only: wp, wl + use mo_optical_props, only: ty_optical_props_arry, & + ty_optical_props_1scl, & + ty_optical_props_2str, & + ty_optical_props_nstr + implicit none + private + public :: draw_samples, sampled_mask_max_ran, sampled_mask_exp_dcorr, sampled_mask_exp_ran +contains + ! ------------------------------------------------------------------------------------------------- + ! + ! Apply a T/F sampled cloud mask to cloud optical properties defined by band to produce + ! McICA-sampled cloud optical properties + ! + function draw_samples(cloud_mask,clouds,clouds_sampled) result(error_msg) + logical, dimension(:,:,:), intent(in ) :: cloud_mask ! Dimensions ncol,nlay,ngpt + class(ty_optical_props_arry), intent(in ) :: clouds ! Defined by band + class(ty_optical_props_arry), intent(inout) :: clouds_sampled ! Defined by g-point + character(len=128) :: error_msg + ! ------------------------ + integer :: ncol,nlay,nbnd,ngpt + integer :: imom + ! ------------------------ + ! + ! Error checking + ! + error_msg = "" + if(.not. clouds%is_initialized()) then + error_msg = "draw_samples: cloud optical properties are not initialized" + return + end if + if(.not. clouds_sampled%is_initialized()) then + error_msg = "draw_samples: sampled cloud optical properties are not initialized" + return + end if + + ! + ! Variables clouds and clouds_sampled have to be of the same type (have the same set of fields) + ! nstr isn't supported + ! 2str is checked at assignment + ! + select type(clouds) + type is (ty_optical_props_1scl) + select type(clouds_sampled) + type is (ty_optical_props_2str) + error_msg = "draw_samples: by-band and sampled cloud properties need to be the same variable type" + return + type is (ty_optical_props_nstr) + error_msg = "draw_samples: by-band and sampled cloud properties need to be the same variable type" + return + end select + type is (ty_optical_props_nstr) + error_msg = "draw_samples: sampling isn't implemented yet for ty_optical_props_nstr" + return + end select + + ! + ! Spectral discretization + ! + if(.not. clouds%bands_are_equal(clouds_sampled)) then + error_msg = "draw_samples: by-band and sampled cloud properties spectral structure is different" + return + end if + + ! + ! Array extents + ! + ncol = clouds%get_ncol() + nlay = clouds%get_nlay() + nbnd = clouds%get_nband() + ngpt = clouds_sampled%get_ngpt() + if (any([size(cloud_mask,1), size(cloud_mask,2), size(cloud_mask,3)] /= [ncol,nlay,ngpt])) then + error_msg = "draw_samples: cloud mask and cloud optical properties have different ncol and/or nlay" + return + end if + if (any([clouds_sampled%get_ncol(), clouds_sampled%get_nlay()] /= [ncol,nlay])) then + error_msg = "draw_samples: sampled/unsampled cloud optical properties have different ncol and/or nlay" + return + end if + ! ------------------------ + ! + ! Finally - sample fields according to the cloud mask + ! + ! Optical depth assignment works for 1scl, 2str (also nstr) + call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%tau,clouds_sampled%tau) + ! + ! For 2-stream + ! + select type(clouds) + type is (ty_optical_props_2str) + select type(clouds_sampled) + type is (ty_optical_props_2str) + call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%ssa,clouds_sampled%ssa) + call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%g, clouds_sampled%g ) + class default + error_msg = "draw_samples: by-band and sampled cloud properties need to be the same variable type" + end select + end select + end function draw_samples + ! ------------------------------------------------------------------------------------------------- + ! + ! Generate a McICA-sampled cloud mask for maximum-random overlap + ! + function sampled_mask_max_ran(randoms,cloud_frac,cloud_mask) result(error_msg) + real(wp), dimension(:,:,:), intent(in ) :: randoms !ngpt,nlay,ncol + real(wp), dimension(:,:), intent(in ) :: cloud_frac ! ncol,nlay + logical, dimension(:,:,:), intent(out) :: cloud_mask ! ncol,nlay,ngpt + character(len=128) :: error_msg + ! ------------------------ + integer :: ncol, nlay, ngpt, icol, ilay, igpt + integer :: cloud_lay_fst, cloud_lay_lst + real(wp), dimension(size(randoms,1)) :: local_rands + logical, dimension(size(randoms,2)) :: cloud_mask_layer + ! ------------------------ + ! + ! Error checking + ! + error_msg = "" + ncol = size(randoms, 3) + nlay = size(randoms, 2) + ngpt = size(randoms, 1) + if(any([ncol,nlay] /= [size(cloud_frac, 1),size(cloud_frac, 2)])) then + error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and cloud_frac(ncol,nlay) are inconsistent" + return + end if + if(any([ncol,nlay,ngpt] /= [size(cloud_mask, 1),size(cloud_mask, 2), size(cloud_mask,3)])) then + error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and cloud_mask(ncol,nlay,ngpt) are inconsistent" + return + end if + if(any(cloud_frac > 1._wp) .or. any(cloud_frac < 0._wp)) then + error_msg = "sampled_mask_max_ran: cloud fraction values out of range [0,1]" + return + end if + ! + ! We chould check the random numbers but that would be computationally heavy + ! + ! ------------------------ + ! + ! Construct the cloud mask for each column + ! + do icol = 1, ncol + cloud_mask_layer(1:nlay) = cloud_frac(icol,1:nlay) > 0._wp + if(.not. any(cloud_mask_layer)) then + cloud_mask(icol,1:nlay,1:ngpt) = .false. + cycle + end if + cloud_lay_fst = findloc(cloud_mask_layer, .true., dim=1) + cloud_lay_lst = findloc(cloud_mask_layer, .true., dim=1, back = .true.) + cloud_mask(icol,1:cloud_lay_fst,1:ngpt) = .false. + + ilay = cloud_lay_fst + local_rands(1:ngpt) = randoms(1:ngpt,cloud_lay_fst,icol) + cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) + do ilay = cloud_lay_fst+1, cloud_lay_lst + if(cloud_mask_layer(ilay)) then + ! + ! Max-random overlap: + ! new random deviates if the adjacent layer isn't cloudy + ! same random deviates if the adjacent layer is cloudy + ! + if(.not. cloud_mask_layer(ilay-1)) local_rands(1:ngpt) = randoms(1:ngpt,ilay,icol) + cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) + else + cloud_mask(icol,ilay,1:ngpt) = .false. + end if + end do + + cloud_mask(icol,cloud_lay_lst+1:nlay, 1:ngpt) = .false. + end do + + end function sampled_mask_max_ran + ! ------------------------------------------------------------------------------------------------- + ! + ! Generate a McICA-sampled cloud mask for exponential-random overlap + ! The overlap parameter alpha is defined between pairs of layers + ! for layer i, alpha(i) describes the overlap betwen cloud_frac(i) and cloud_frac(i+1) + ! By skipping layers with 0 cloud fraction the code forces alpha(i) = 0 for cloud_frac(i) = 0. + ! + function sampled_mask_exp_ran(randoms,cloud_frac,overlap_param,cloud_mask) result(error_msg) + real(wp), dimension(:,:,:), intent(in ) :: randoms ! ngpt,nlay,ncol + real(wp), dimension(:,:), intent(in ) :: cloud_frac ! ncol,nlay + real(wp), dimension(:,:), intent(in ) :: overlap_param ! ncol,nlay-1 + logical, dimension(:,:,:), intent(out) :: cloud_mask ! ncol,nlay,ngpt + character(len=128) :: error_msg + ! ------------------------ + integer :: ncol, nlay, ngpt, icol, ilay, igpt + integer :: cloud_lay_fst, cloud_lay_lst + real(wp) :: rho ! correlation coefficient + real(wp), dimension(size(randoms,1)) :: local_rands + logical, dimension(size(randoms,2)) :: cloud_mask_layer + ! ------------------------ + ! + ! Error checking + ! + error_msg = "" + ncol = size(randoms, 3) + nlay = size(randoms, 2) + ngpt = size(randoms, 1) + if(any([ncol,nlay] /= [size(cloud_frac, 1),size(cloud_frac, 2)])) then + error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and cloud_frac(ncol,nlay) are inconsistent" + return + end if + if(any([ncol,nlay-1] /= [size(overlap_param, 1),size(overlap_param, 2)])) then + error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and overlap_param(ncol,nlay-1) are inconsistent" + return + end if + if(any([ncol,nlay,ngpt] /= [size(cloud_mask, 1),size(cloud_mask, 2), size(cloud_mask,3)])) then + error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and cloud_mask(ncol,nlay,ngpt) are inconsistent" + return + end if + + if(any(cloud_frac > 1._wp) .or. any(cloud_frac < 0._wp)) then + error_msg = "sampled_mask_max_ran: cloud fraction values out of range [0,1]" + return + end if + if(any(overlap_param > 1._wp) .or. any(overlap_param < -1._wp)) then + error_msg = "sampled_mask_max_ran: overlap_param values out of range [-1,1]" + return + end if + ! + ! We chould check the random numbers but that would be computationally heavy + ! + ! ------------------------ + ! Construct the cloud mask for each column + ! + do icol = 1, ncol + cloud_mask_layer(1:nlay) = cloud_frac(icol,1:nlay) > 0._wp + if(.not. any(cloud_mask_layer)) then + cloud_mask(icol,1:nlay,1:ngpt) = .false. + cycle + end if + cloud_lay_fst = findloc(cloud_mask_layer, .true., dim=1) + cloud_lay_lst = findloc(cloud_mask_layer, .true., dim=1, back = .true.) + cloud_mask(icol,1:cloud_lay_fst,1:ngpt) = .false. + + ilay = cloud_lay_fst + local_rands(1:ngpt) = randoms(1:ngpt,ilay,icol) + cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) + do ilay = cloud_lay_fst+1, cloud_lay_lst + if(cloud_mask_layer(ilay)) then + ! + ! Exponential-random overlap: + ! new random deviates if the adjacent layer isn't cloudy + ! correlated deviates if the adjacent layer is cloudy + ! + if(cloud_mask_layer(ilay-1)) then + ! + ! Create random deviates correlated between this layer and the previous layer + ! (have to remove mean value before enforcing correlation) + ! + rho = overlap_param(icol,ilay-1) + local_rands(1:ngpt) = rho*(local_rands(1:ngpt) -0.5_wp) + & + sqrt(1._wp-rho*rho)*(randoms(1:ngpt,ilay,icol)-0.5_wp) + 0.5_wp + else + local_rands(1:ngpt) = randoms(1:ngpt,ilay,icol) + end if + cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) + end if + end do + + cloud_mask(icol,cloud_lay_lst+1:nlay, 1:ngpt) = .false. + end do + end function sampled_mask_exp_ran + + ! ------------------------------------------------------------------------------------------------- + ! + ! Generate a McICA-sampled cloud mask for exponential-decorrelation overlap + ! The overlap parameter is defined between pairs of layers + ! + function sampled_mask_exp_dcorr(randoms1,randoms2,cloud_frac,overlap_param,cloud_mask) result(error_msg) + real(wp), dimension(:,:,:), intent(in ) :: randoms1,randoms2 ! ngpt,nlay,ncol + real(wp), dimension(:,:), intent(in ) :: cloud_frac ! ncol,nlay + real(wp), dimension(:,:), intent(in ) :: overlap_param ! ncol,nlay-1 + logical, dimension(:,:,:), intent(out) :: cloud_mask ! ncol,nlay,ngpt + character(len=128) :: error_msg + ! ------------------------ + integer :: ncol, nlay, ngpt, icol, ilay, igpt + integer :: cloud_lay_fst, cloud_lay_lst + logical, dimension(size(randoms1,2)) :: cloud_mask_layer + ! ------------------------ + ! + ! Error checking + ! + error_msg = "" + ncol = size(randoms1, 3) + nlay = size(randoms1, 2) + ngpt = size(randoms1, 1) + if(any([ncol,nlay] /= [size(cloud_frac, 1),size(cloud_frac, 2)])) then + error_msg = "sampled_mask_max_ran: sizes of randoms1(ngpt,nlay,ncol) and cloud_frac(ncol,nlay) are inconsistent" + return + end if + if(any([ncol,nlay-1] /= [size(overlap_param, 1),size(overlap_param, 2)])) then + error_msg = "sampled_mask_max_ran: sizes of randoms1(ngpt,nlay,ncol) and overlap_param(ncol,nlay-1) are inconsistent" + return + end if + if(any([ncol,nlay,ngpt] /= [size(cloud_mask, 1),size(cloud_mask, 2), size(cloud_mask,3)])) then + error_msg = "sampled_mask_max_ran: sizes of randoms1(ngpt,nlay,ncol) and cloud_mask(ncol,nlay,ngpt) are inconsistent" + return + end if + + if(any(cloud_frac > 1._wp) .or. any(cloud_frac < 0._wp)) then + error_msg = "sampled_mask_max_ran: cloud fraction values out of range [0,1]" + return + end if + if(any(overlap_param > 1._wp) .or. any(overlap_param < -1._wp)) then + error_msg = "sampled_mask_max_ran: overlap_param values out of range [-1,1]" + return + end if + + ! + do icol = 1, ncol + ! Column cloud-mask + cloud_mask_layer(1:nlay) = cloud_frac(icol,1:nlay) > 0._wp + + ! Skip column if no clouds + if(.not. any(cloud_mask_layer)) then + cloud_mask(icol,1:nlay,1:ngpt) = .false. + cycle + end if + + ! Pull out indices for First/Last cloudy layers + cloud_lay_fst = findloc(cloud_mask_layer, .true., dim=1) + cloud_lay_lst = findloc(cloud_mask_layer, .true., dim=1, back = .true.) + + ! Set cloud-mask in layers above cloud to false + cloud_mask(icol,1:cloud_lay_fst,1:ngpt) = .false. + + ! Loop over cloudy-layers + ! + ! First layer + ! + ilay = cloud_lay_fst + cloud_mask(icol,ilay,1:ngpt) = randoms1(1:ngpt,iLay,iCol) > (1._wp - cloud_frac(iCol,iLay)) + ! + ! Subsequent-layers + ! + do ilay = cloud_lay_fst+1, cloud_lay_lst + !if(cloud_mask_layer(ilay) .and. cloud_mask_layer(ilay-1)) then + where(randoms2(1:nGpt,iLay,iCol) .le. overlap_param(iCol,iLay)) + cloud_mask(iCol,iLay,1:nGpt) = randoms1(1:ngpt,iLay-1,iCol) > (1._wp - cloud_frac(iCol,iLay)) + elsewhere + cloud_mask(iCol,iLay,1:nGpt) = randoms1(1:ngpt,iLay,iCol) > (1._wp - cloud_frac(iCol,iLay)) + endwhere + !else + ! cloud_mask(iCol,iLay,1:nGpt) = .false. + !endif + end do + + ! Set cloud-mask in layer below clouds to false + cloud_mask(icol,cloud_lay_lst+1:nlay, 1:ngpt) = .false. + end do + + end function sampled_mask_exp_dcorr + ! ------------------------------------------------------------------------------------------------- + ! + ! Apply a true/false cloud mask to a homogeneous field + ! This could be a kernel + ! + subroutine apply_cloud_mask(ncol,nlay,nbnd,ngpt,band_lims_gpt,cloud_mask,input_field,sampled_field) + integer, intent(in ) :: ncol,nlay,nbnd,ngpt + integer, dimension(2,nbnd), intent(in ) :: band_lims_gpt + logical, dimension(ncol,nlay,ngpt), intent(in ) :: cloud_mask + real(wp), dimension(ncol,nlay,nbnd), intent(in ) :: input_field + real(wp), dimension(ncol,nlay,ngpt), intent(out) :: sampled_field + + integer :: icol,ilay,ibnd,igpt + + do ibnd = 1, nbnd + do igpt = band_lims_gpt(1,ibnd), band_lims_gpt(2,ibnd) + do ilay = 1, nlay + sampled_field(1:ncol,ilay,igpt) = merge(input_field(1:ncol,ilay,ibnd), 0._wp, cloud_mask(1:ncol,ilay,igpt)) + end do + end do + end do + end subroutine apply_cloud_mask + +end module mo_cloud_sampling diff --git a/physics/module_sf_noahmp_glacier.f90 b/physics/module_sf_noahmp_glacier.f90 index 1b9b3cf3f..f3e0531f5 100644 --- a/physics/module_sf_noahmp_glacier.f90 +++ b/physics/module_sf_noahmp_glacier.f90 @@ -1111,6 +1111,8 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z dtg = 0. mozsgn = 0 mozold = 0. + moz = 0. + h = 0. fv = 0.1 diff --git a/physics/physcons.F90 b/physics/physcons.F90 index 5fb993ac3..6a41bda44 100644 --- a/physics/physcons.F90 +++ b/physics/physcons.F90 @@ -79,6 +79,7 @@ module physcons real(kind=kind_phys),parameter:: con_jcal =4.1855E+0_kind_phys !< joules per calorie real(kind=kind_phys),parameter:: con_rhw0 =1022.0_kind_phys !< sea water reference density (\f$kg/m^{3}\f$) real(kind=kind_phys),parameter:: con_epsq =1.0E-12_kind_phys !< min q for computing precip type + real(kind=kind_phys),parameter:: con_epsqs =1.0E-10_kind_phys ! Selected thermodynamics constants with kind=kind_dyn real(kind=kind_dyn), parameter:: con_rd_dyn =2.8705e+2_kind_dyn !< gas constant air (\f$J/kg/K\f$) real(kind=kind_dyn), parameter:: con_rv_dyn =4.6150e+2_kind_dyn !< gas constant H2O (\f$J/kg/K\f$) @@ -137,6 +138,9 @@ module physcons real(kind=kind_phys),parameter:: rhosnow = 100._kind_phys !< density of snow (kg/m^3) real(kind=kind_phys),parameter:: rhoair = 1.28_kind_phys !< density of air near surface (kg/m^3) +! Decorrelation length constant (km) for iovrlw/iovrsw = 4 or 5 and idcor = 0 + real(kind=kind_phys),parameter:: decorr_con = 2.50_kind_phys + !........................................! end module physcons ! !========================================! diff --git a/physics/physparam.f b/physics/physparam.f index 795cb4fab..0747b2a14 100644 --- a/physics/physparam.f +++ b/physics/physparam.f @@ -234,6 +234,8 @@ module physparam !!\n =1:use maximum-random cloud overlapping method !!\n =2:use maximum cloud overlapping method !!\n =3:use decorrelation length overlapping method +!!\n =4:use exponential overlapping method +!!\n =5:use exponential-random overlapping method !!\n Opr GFS/CFS=1; see IOVR_SW in run scripts integer, save :: iovrsw = 1 !> cloud overlapping control flag for LW @@ -241,9 +243,15 @@ module physparam !!\n =1:use maximum-random cloud overlapping method !!\n =2:use maximum cloud overlapping method !!\n =3:use decorrelation length overlapping method +!!\n =4:use exponential overlapping method +!!\n =5:use exponential-random overlapping method !!\n Opr GFS/CFS=1; see IOVR_LW in run scripts integer, save :: iovrlw = 1 - +!!\n Decorrelation length type for iovrlw/iovrsw = 4 or 5 +!!\n =0:use constant decorrelation length defined by decorr_con (in module physcons) +!!\n =1:use day-of-year and latitude-varying decorrelation length + integer, save :: idcor = 1 + !> sub-column cloud approx flag in SW radiation !!\n =0:no McICA approximation in SW radiation !!\n =1:use McICA with precribed permutation seeds (test mode) diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 5b4aa54ab..f6d7e32cb 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -243,7 +243,8 @@ module module_radiation_clouds integer :: iovr = 1 !< maximum-random cloud overlapping method public progcld1, progcld2, progcld3, progcld4, progclduni, & - & cld_init, progcld5, progcld4o, gethml + & cld_init, progcld5, progcld4o, gethml, & + & get_alpha_dcorr, get_alpha_exp ! ================= @@ -3451,6 +3452,204 @@ subroutine gethml & end subroutine gethml !----------------------------------- !! @} + ! ######################################################################################### + ! Subroutine to compute cloud-overlap parameter, alpha, for decorrelation-length cloud + ! overlap assumption. + ! ######################################################################################### + subroutine get_alpha_dcorr(nCol, nLev, lat, con_pi, deltaZ, & + & de_lgth, cloud_overlap_param) + + integer, intent(in) :: nCol, nLev + real(kind_phys), intent(in) :: con_pi + real(kind_phys), dimension(nCol), intent(in) :: lat + real(kind_phys), dimension(nCol,nLev),intent(in) :: deltaZ + real(kind_phys), dimension(nCol),intent(out) :: de_lgth + real(kind_phys), dimension(nCol,nLev),intent(out) :: & + & cloud_overlap_param + + ! Local + integer :: iCol, iLay + + do iCol =1,nCol + de_lgth(iCol) = max( 0.6, 2.78-4.6*abs(lat(iCol)/con_pi) ) + do iLay=nLev,2,-1 + if (de_lgth(iCol) .gt. 0) then + cloud_overlap_param(iCol,iLay-1) = & + & exp( -0.5 * (deltaZ(iCol,iLay)+deltaZ(iCol,iLay-1))/& + & de_lgth(iCol)) + endif + enddo + enddo + end subroutine get_alpha_dcorr + + ! ######################################################################################### +!> \ingroup module_radiation_clouds +!! This program derives the exponential transition, alpha, from maximum to +!! random overlap needed to define the fractional cloud vertical correlation +!! for the exponential (EXP, iovrlp=4) or the exponential-random (ER, iovrlp=5) +!! cloud overlap options for RRTMGP. For exponential, the transition from +!! maximum to random with distance through model layers occurs without regard +!! to the configuration of clear and cloudy layers. For the ER method, each +!! block of adjacent cloudy layers is treated with a separate transition from +!! maximum to random, and blocks of cloudy layers separated by one or more +!! clear layers are correlated randomly. +!> /param nlon : number of model longitude points +!> /param nlay : vertical layer dimension +!> /param dzlay(nlon,nlay) : distance between the center of model layers +!> /param iovrlp : cloud overlap method +!> : 0 = random +!> : 1 = maximum-random +!> : 2 = maximum +!> : 3 = decorrelation (NOAA/Hou) +!> : 4 = exponential (AER) +!> : 5 = exponential-random (AER) +!> /param latdeg(nlon) : latitude (in degrees 90 -> -90) +!> /param juldat : day of the year (fractional julian day) +!> /param yearlen : current length of the year (365/366 days) +!> /param cldf(nlon,nlay) : cloud fraction +!> /param idcor : decorrelation length method +!> : 0 = constant value (AER; decorr_con) +!> : 1 = latitude and day of year varying value (AER; Oreopoulos, et al., 2012) +!> /param decorr_con : decorrelation length constant +!! +!>\section detail Detailed Algorithm +!! @{ + subroutine get_alpha_exp(nlon, nlay, dzlay, iovrlp, latdeg, & + & juldat, yearlen, cldf, alpha) +! =================================================================== ! +! ! +! abstract: Derives the exponential transition, alpha, from maximum to ! +! random overlap needed to define the fractional cloud vertical ! +! correlation for the exponential (EXP, iovrlp=4) or the exponential- ! +! random (ER, iovrlp=5) cloud overlap options for RRTMG. For ! +! exponential, the transition from maximum to random with distance ! +! through model layers occurs without regard to the configuration of ! +! clear and cloudy layers. For the ER method, each block of adjacent ! +! cloudy layers is treated with a separate transition from maximum to ! +! random, and blocks of cloudy layers separated by one or more ! +! clear layers are correlated randomly. ! +! ! +! usage: call get_alpha ! +! ! +! subprograms called: none ! +! ! +! attributes: ! +! language: fortran 90 ! +! machine: ibm-sp, sgi ! +! ! +! author: m.j. iacono (AER) for use with the RRTMG radiation code ! +! ! +! ==================== definition of variables ==================== ! +! ! +! Input variables: ! +! nlon : number of model longitude points ! +! nlay : vertical layer dimension ! +! dzlay(nlon,nlay) : distance between the center of model layers ! +! iovrlp : cloud overlap method ! +! : 0 = random ! +! : 1 = maximum-random ! +! : 2 = maximum ! +! : 3 = decorrelation (NOAA/Hou) ! +! : 4 = exponential (AER) ! +! : 5 = exponential-random (AER) ! +! latdeg(nlon) : latitude (in degrees 90 -> -90) ! +! juldat : day of the year (fractional julian day) ! +! yearlen : current length of the year (365/366 days) ! +! cldf(nlon,nlay) : cloud fraction ! +! ! +! output variables: ! +! alpha(nlon,nlay) : alpha exponential transition parameter for ! +! : cloud vertical correlation ! +! ! +! external module variables: (in physcons) ! +! decorr_con : decorrelation length constant (km) ! +! ! +! external module variables: (in physparam) ! +! idcor : control flag for decorrelation length method ! +! =0: constant decorrelation length (decorr_con) ! +! =1: latitude and day-of-year varying decorrelation! +! length (AER; Oreopoulos, et al., 2012) ! +! ! +! ==================== end of description ===================== ! +! + use physparam, only: idcor + use physcons, only: decorr_con + implicit none +! Input + integer, intent(in) :: nlon, nlay + integer, intent(in) :: iovrlp + integer, intent(in) :: yearlen + real(kind_phys), dimension(:,:), intent(in) :: dzlay + real(kind_phys), dimension(:,:), intent(in) :: cldf + real(kind_phys), dimension(:), intent(in) :: latdeg + real(kind_phys), intent(in) :: juldat +! Output + real(kind_phys), dimension(:,:), intent(out):: alpha +! Local + integer :: i, k + real(kind_phys) :: decorr_len(nlon) ! Decorrelation length (km) +! Constants for latitude and day-of-year dependent decorrlation length (Oreopoulos et al, 2012) +! Used when idcor = 1 + real(kind_phys), parameter :: am1 = 1.4315_kind_phys + real(kind_phys), parameter :: am2 = 2.1219_kind_phys + real(kind_phys), parameter :: am4 = -25.584_kind_phys + real(kind_phys), parameter :: amr = 7.0_kind_phys + real(kind_phys) :: am3 + real(kind_phys), parameter :: zero = 0.0d0 + real(kind_phys), parameter :: one = 1.0d0 +! +!===> ... begin here +! +! If exponential or exponential-random cloud overlap is used: +! derive day-of-year and latitude-varying decorrelation lendth if requested; +! otherwise use the constant decorrelation length, decorr_con, specified in physcons.F90 + do i = 1, nlon + if (iovrlp == 4 .or. iovrlp == 5) then + if (idcor .eq. 1) then + if (juldat .gt. 181._kind_phys) then + am3 = -4._kind_phys * amr * (juldat - 272._kind_phys)/& + & yearlen + else + am3 = 4._kind_phys * amr * (juldat - 91._kind_phys) / & + & yearlen + endif +! For latitude in degrees, decorr_len in km + decorr_len(i) = am1 + am2 * exp( -(latdeg(i) - am3)**2 / & + & am4**2) + else + decorr_len(i) = decorr_con + endif + endif + enddo +! For atmospheric data defined from surface to toa; define alpha from surface to toa +! Exponential cloud overlap + if (iovrlp == 4) then + do i = 1, nlon + alpha(i,1) = zero + do k = 2, nlay + alpha(i,k) = exp( -(dzlay(i,k)) / decorr_len(i)) + enddo + enddo + endif +! Exponential-random cloud overlap + if (iovrlp == 5) then + do i = 1, nlon + alpha(i,1) = zero + do k = 2, nlay + alpha(i,k) = exp( -(dzlay(i,k)) / decorr_len(i)) + ! Decorrelate layers when a clear layer follows a cloudy layer to enforce + ! random correlation between non-adjacent blocks of cloudy layers + if (cldf(i,k) .eq. zero .and. cldf(i,k-1) .gt. zero) then + alpha(i,k) = zero + endif + enddo + enddo + endif + + return + end subroutine get_alpha_exp + + ! !........................................! diff --git a/physics/rrtmg_lw_cloud_optics.F90 b/physics/rrtmg_lw_cloud_optics.F90 index 31551d797..ea0a703c7 100644 --- a/physics/rrtmg_lw_cloud_optics.F90 +++ b/physics/rrtmg_lw_cloud_optics.F90 @@ -554,7 +554,8 @@ module mo_rrtmg_lw_cloud_optics ! subroutine rrtmg_lw_cloud_optics ! ####################################################################################### subroutine rrtmg_lw_cloud_optics(ncol, nlay, nBandsLW, cld_lwp, cld_ref_liq, cld_iwp, & - cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, cld_frac, tau_cld) + cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, cld_frac, tau_cld, & + tau_precip) ! Inputs integer,intent(in) :: & nBandsLW, & ! Number of spectral bands @@ -573,14 +574,16 @@ subroutine rrtmg_lw_cloud_optics(ncol, nlay, nBandsLW, cld_lwp, cld_ref_liq, cld ! Outputs real(kind_phys),dimension(ncol,nlay,nBandsLW),intent(out) :: & - tau_cld - + tau_cld, & ! Cloud optical-depth (1) + tau_precip ! Precipitation optical-depth (1) + ! Local variables integer :: ij,ik,ib,index,ia real(kind_phys) :: factor,fint,cld_ref_iceTemp,tau_snow, tau_rain real(kind_phys),dimension(nBandsLW) :: tau_liq, tau_ice - tau_cld(:,:,:) = 0._kind_phys + tau_cld(:,:,:) = 0._kind_phys + tau_precip(:,:,:) = 0._kind_phys if (ilwcliq .gt. 0) then do ij=1,ncol @@ -655,167 +658,11 @@ subroutine rrtmg_lw_cloud_optics(ncol, nlay, nBandsLW, cld_lwp, cld_ref_liq, cld endif ! Cloud optical depth do ib = 1, nBandsLW - tau_cld(ij,ik,ib) = tau_ice(ib) + tau_liq(ib) + tau_rain + tau_snow + tau_cld(ij,ik,ib) = tau_ice(ib) + tau_liq(ib) + tau_precip(ij,ik,ib) = tau_rain + tau_snow enddo end do end do endif end subroutine rrtmg_lw_cloud_optics - ! ####################################################################################### - ! SUBROUTINE mcica_subcol_lw - ! ####################################################################################### - subroutine mcica_subcol_lw(ncol, nlay, ngpts, cld_frac, icseed, dzlyr, de_lgth, cld_frac_mcica) - ! Inputs - integer,intent(in) :: & - ncol, & ! Number of horizontal gridpoints - nlay, & ! Number of vertical layers - ngpts ! Number of spectral g-points - integer,dimension(ncol),intent(in) :: & - icseed ! Permutation seed for each column. - real(kind_phys), dimension(ncol), intent(in) :: & - de_lgth ! Cloud decorrelation length (km) - real(kind_phys), dimension(ncol,nlay), intent(in) :: & - cld_frac, & ! Cloud-fraction - dzlyr ! Layer thinkness (km) - ! Outputs - !real(kind_phys),dimension(ncol,nlay,ngpts),intent(out) :: & - logical,dimension(ncol,nlay,ngpts),intent(out) :: & - cld_frac_mcica - ! Local variables - type(random_stat) :: stat - integer :: icol,n,k,k1 - real(kind_phys) :: tem1 - real(kind_phys),dimension(ngpts) :: rand1D - real(kind_phys),dimension(nlay*ngpts) :: rand2D - real(kind_phys),dimension(ngpts,nlay) :: cdfunc,cdfun2 - real(kind_phys),dimension(nlay) :: fac_lcf - logical,dimension(ngpts,nlay) :: lcloudy - - ! Loop over all columns - do icol=1,ncol - ! Call random_setseed() to advance random number generator by "icseed" values. - call random_setseed(icseed(icol),stat) - - ! ################################################################################### - ! Sub-column set up according to overlapping assumption: - ! - For random overlap, pick a random value at every level - ! - For max-random overlap, pick a random value at every level - ! - For maximum overlap, pick same random numebr at every level - ! ################################################################################### - select case ( iovrlw ) - ! ################################################################################### - ! 0) Random overlap - ! ################################################################################### - case( 0 ) - call random_number(rand2D,stat) - k1 = 0 - do n = 1, ngpts - do k = 1, nlay - k1 = k1 + 1 - cdfunc(n,k) = rand2d(k1) - enddo - enddo - - ! ################################################################################### - ! 1) Maximum-random overlap - ! ################################################################################### - case(1) - call random_number(rand2D,stat) - k1 = 0 - do n = 1, ngpts - do k = 1, nlay - k1 = k1 + 1 - cdfunc(n,k) = rand2d(k1) - enddo - enddo - - ! First pick a random number for bottom (or top) layer. - ! then walk up the column: (aer's code) - ! if layer below is cloudy, use the same rand num in the layer below - ! if layer below is clear, use a new random number - do k = 2, nlay - k1 = k - 1 - tem1 = 1._kind_phys - cld_frac(icol,k1) - do n = 1, ngpts - if ( cdfunc(n,k1) > tem1 ) then - cdfunc(n,k) = cdfunc(n,k1) - else - cdfunc(n,k) = cdfunc(n,k) * tem1 - endif - enddo - enddo - - ! ################################################################################### - ! 2) Maximum overlap - ! ################################################################################### - case(2) - call random_number(rand1d,stat) - do n = 1, ngpts - tem1 = rand1d(n) - do k = 1, nlay - cdfunc(n,k) = tem1 - enddo - enddo - - ! ################################################################################### - ! 3) Decorrelation length - ! ################################################################################### - case(3) - ! Compute overlapping factors based on layer midpoint distances and decorrelation - ! depths - do k = nlay, 2, -1 - fac_lcf(k) = exp( -0.5 * (dzlyr(iCol,k)+dzlyr(iCol,k-1)) / de_lgth(iCol) ) - enddo - - ! Setup 2 sets of random numbers - call random_number ( rand2d, stat ) - k1 = 0 - do k = 1, nlay - do n = 1, ngpts - k1 = k1 + 1 - cdfunc(n,k) = rand2d(k1) - enddo - enddo - ! - call random_number ( rand2d, stat ) - k1 = 0 - do k = 1, nlay - do n = 1, ngpts - k1 = k1 + 1 - cdfun2(n,k) = rand2d(k1) - enddo - enddo - - ! Then working from the top down: - ! if a random number (from an independent set -cdfun2) is smaller then the - ! scale factor: use the upper layer's number, otherwise use a new random - ! number (keep the original assigned one). - do k = nlay-1, 1, -1 - k1 = k + 1 - do n = 1, ngpts - if ( cdfun2(n,k) <= fac_lcf(k1) ) then - cdfunc(n,k) = cdfunc(n,k1) - endif - enddo - enddo - - end select - - ! ################################################################################### - ! Generate subcolumn cloud mask (.false./.true. for clear/cloudy) - ! ################################################################################### - do k = 1, nlay - tem1 = 1._kind_phys - cld_frac(icol,k) - do n = 1, ngpts - lcloudy(n,k) = cdfunc(n,k) >= tem1 - if (lcloudy(n,k)) then - cld_frac_mcica(icol,k,n) = .true. - else - cld_frac_mcica(icol,k,n) = .false. - endif - enddo - enddo - enddo ! END LOOP OVER COLUMNS - end subroutine mcica_subcol_lw - end module mo_rrtmg_lw_cloud_optics diff --git a/physics/rrtmg_sw_cloud_optics.F90 b/physics/rrtmg_sw_cloud_optics.F90 index 7ff57039e..37b4e094c 100644 --- a/physics/rrtmg_sw_cloud_optics.F90 +++ b/physics/rrtmg_sw_cloud_optics.F90 @@ -8,7 +8,9 @@ module mo_rrtmg_sw_cloud_optics integer,parameter :: & nBandsSW_RRTMG = 14 real(kind_phys),parameter :: & - a0r = 3.07e-3 + a0r = 3.07e-3, & + a0s = 0.0, &! + a1s = 1.5 ! real(kind_phys),dimension(nBandsSW_RRTMG),parameter :: & b0r = (/0.466, 0.437, 0.416, 0.391, 0.374, 0.352, 0.183, & 0.048, 0.012, 0.000, 0.000, 0.000, 0.000, 0.496/) @@ -2025,8 +2027,6 @@ module mo_rrtmg_sw_cloud_optics 9.727157e-03/), & ! shape = (/46,nBandsSW_RRTMG/)) - - real(kind_phys),dimension(5) :: & abari = (/ 3.448e-03,3.448e-03,3.448e-03,3.448e-03,3.448e-03 /), & bbari = (/ 2.431e+00,2.431e+00,2.431e+00,2.431e+00,2.431e+00 /), & @@ -2043,9 +2043,9 @@ module mo_rrtmg_sw_cloud_optics ! ######################################################################################### ! rrtmg_sw_cloud_optics ! ######################################################################################### - subroutine rrtmg_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cld_iwp, & - cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, cld_frac, & - tau_cld, ssa_cld, asy_cld) + subroutine rrtmg_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cld_iwp, & + cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, cld_frac, & + tau_cld, ssa_cld, asy_cld, tau_precip, ssa_precip, asy_precip) ! Inputs integer,intent(in) :: & nBandsSW, & ! Number of spectral bands @@ -2066,7 +2066,10 @@ subroutine rrtmg_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cld real(kind_phys),dimension(ncol,nlay,nBandsSW),intent(out) :: & tau_cld, & ! In-cloud optical depth (1) ssa_cld, & ! In-cloud single-scattering albedo (1) - asy_cld ! In-cloud asymmetry parameter (1) + asy_cld, & ! In-cloud asymmetry parameter (1) + tau_precip, & ! Precipitation optical depth (1) + ssa_precip, & ! Precipitation single-scattering albedo (1) + asy_precip ! Precipitation asymmetry parameter (1) ! Local variables integer :: iCol, iLay, iBand, index, ia @@ -2077,11 +2080,14 @@ subroutine rrtmg_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cld forwice, extcoice, asycoice, ssacoice, fdelta, extcoliq, ssacoliq ! Initialize - tau_cld(:,:,:) = 0._kind_phys - ssa_cld(:,:,:) = 1._kind_phys - asy_cld(:,:,:) = 0._kind_phys + tau_cld(:,:,:) = 0._kind_phys + ssa_cld(:,:,:) = 1._kind_phys + asy_cld(:,:,:) = 0._kind_phys + tau_precip(:,:,:) = 0._kind_phys + ssa_precip(:,:,:) = 1._kind_phys + asy_precip(:,:,:) = 0._kind_phys - ! Compute cloud radiative properties for cloud. + ! Compute cloud/precipitation radiative properties if (iswcliq > 0) then do iCol=1,ncol do iLay=1,nlay @@ -2116,7 +2122,7 @@ subroutine rrtmg_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cld ! ########################################################################### ! Snow optical depth (No band dependence) if (cld_swp(iCol,iLay) .gt. 0. .and. cld_ref_snow(iCol,iLay) .gt. 10._kind_phys) then - tau_snow = cld_swp(iCol,iLay) + tau_snow = cld_swp(iCol,iLay)*1.09087*(a0s + a1s/(1.0315*cld_ref_snow(iCol,iLay))) ! fu's formula else tau_snow = 0._kind_phys endif @@ -2229,15 +2235,18 @@ subroutine rrtmg_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cld endif ! IF cloudy column ! ########################################################################### - ! Compute total cloud radiative properties (tau, omega, and g) + ! Compute total cloud and precipitation radiative properties (tau, omega, and g) ! ########################################################################### if (cld_frac(iCol,iLay) .gt. 1.e-12_kind_phys) then do iBand = 1,nBandsSW + ! + ! Cloud optics + ! ! Sum up radiative properties by type. - tau_cld(iCol,iLay,iBand) = max(1.e-12_kind_phys, tau_liq(iBand) + tau_ice(iBand) + tau_rain + tau_snow) - ssa_cld(iCol,iLay,iBand) = max(1.e-12_kind_phys, ssa_liq(iBand) + ssa_ice(iBand) + ssa_rain(iBand) + ssa_snow(iBand)) - asy_cld(iCol,iLay,iBand) = max(1.e-12_kind_phys, asy_liq(iBand) + asy_ice(iBand) + asy_rain(iBand) + asy_snow(iBand)) - ! Delta-scale + tau_cld(iCol,iLay,iBand) = max(1.e-12_kind_phys, tau_liq(iBand) + tau_ice(iBand)) + ssa_cld(iCol,iLay,iBand) = max(1.e-12_kind_phys, ssa_liq(iBand) + ssa_ice(iBand)) + asy_cld(iCol,iLay,iBand) = max(1.e-12_kind_phys, asy_liq(iBand) + asy_ice(iBand)) + ! Combine asyw = asy_cld(iCol,iLay,iBand)/max(1.e-12_kind_phys, ssa_cld(iCol,iLay,iBand)) ssaw = min(1._kind_phys-0.000001, ssa_cld(iCol,iLay,iBand)/tau_cld(iCol,iLay,iBand)) za1 = asyw * asyw @@ -2245,6 +2254,22 @@ subroutine rrtmg_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cld tau_cld(iCol,iLay,iBand) = (1._kind_phys - za2) * tau_cld(iCol,iLay,iBand) ssa_cld(iCol,iLay,iBand) = (ssaw - za2) / (1._kind_phys - za2) asy_cld(iCol,iLay,iBand) = asyw/(1+asyw) + ! + ! Precipitation optics + ! + ! Sum up radiative properties by type. + tau_precip(iCol,iLay,iBand) = max(1.e-12_kind_phys, tau_rain + tau_snow) + ssa_precip(iCol,iLay,iBand) = max(1.e-12_kind_phys, ssa_rain(iBand) + ssa_snow(iBand)) + asy_precip(iCol,iLay,iBand) = max(1.e-12_kind_phys, asy_rain(iBand) + asy_snow(iBand)) + ! Combine + asyw = asy_precip(iCol,iLay,iBand)/max(1.e-12_kind_phys, ssa_precip(iCol,iLay,iBand)) + ssaw = min(1._kind_phys-0.000001, ssa_precip(iCol,iLay,iBand)/tau_precip(iCol,iLay,iBand)) + za1 = asyw * asyw + za2 = ssaw * za1 + tau_precip(iCol,iLay,iBand) = (1._kind_phys - za2) * tau_precip(iCol,iLay,iBand) + ssa_precip(iCol,iLay,iBand) = (ssaw - za2) / (1._kind_phys - za2) + asy_precip(iCol,iLay,iBand) = asyw/(1+asyw) + enddo ! Loop over SW bands endif ! END sum cloudy properties ! @@ -2252,161 +2277,4 @@ subroutine rrtmg_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cld enddo ! Loop over columns endif end subroutine rrtmg_sw_cloud_optics - - ! ####################################################################################### - ! SUBROUTINE mcica_subcol_sw - ! ###################################################################################### - subroutine mcica_subcol_sw(ncol, nlay, ngpts, cld_frac, icseed, dzlyr, de_lgth, & - cld_frac_mcica) - ! Inputs - integer,intent(in) :: & - ncol, & ! Number of horizontal gridpoints - nlay, & ! Number of vertical layers - ngpts ! Number of spectral g-points - integer,dimension(ncol),intent(in) :: & - icseed ! Permutation seed for each column. - real(kind_phys), dimension(ncol), intent(in) :: & - de_lgth ! Cloud decorrelation length (km) - real(kind_phys), dimension(ncol,nlay), intent(in) :: & - cld_frac, & ! Cloud-fraction - dzlyr ! Layer thinkness (km) - ! Outputs - logical,dimension(ncol,nlay,ngpts),intent(out) :: & - cld_frac_mcica - ! Local variables - type(random_stat) :: stat - integer :: icol,n,k,k1 - real(kind_phys) :: tem1 - real(kind_phys),dimension(ngpts) :: rand1D - real(kind_phys),dimension(nlay*ngpts) :: rand2D - real(kind_phys),dimension(ngpts,nlay) :: cdfunc,cdfun2 - real(kind_phys),dimension(nlay) :: fac_lcf - logical,dimension(ngpts,nlay) :: lcloudy - - ! Loop over all columns - do icol=1,ncol - ! Call random_setseed() to advance random number generator by "icseed" values. - call random_setseed(icseed(icol),stat) - - ! ################################################################################### - ! Sub-column set up according to overlapping assumption: - ! - For random overlap, pick a random value at every level - ! - For max-random overlap, pick a random value at every level - ! - For maximum overlap, pick same random numebr at every level - ! ################################################################################### - select case ( iovrsw ) - ! ################################################################################### - ! 0) Random overlap - ! ################################################################################### - case( 0 ) - call random_number(rand2D,stat) - k1 = 0 - do n = 1, ngpts - do k = 1, nlay - k1 = k1 + 1 - cdfunc(n,k) = rand2d(k1) - enddo - enddo - - ! ################################################################################### - ! 1) Maximum-random overlap - ! ################################################################################### - case(1) - call random_number(rand2D,stat) - k1 = 0 - do n = 1, ngpts - do k = 1, nlay - k1 = k1 + 1 - cdfunc(n,k) = rand2d(k1) - enddo - enddo - - ! First pick a random number for bottom (or top) layer. - ! then walk up the column: (aer's code) - ! if layer below is cloudy, use the same rand num in the layer below - ! if layer below is clear, use a new random number - do k = 2, nlay - k1 = k - 1 - tem1 = 1._kind_phys - cld_frac(icol,k1) - do n = 1, ngpts - if ( cdfunc(n,k1) > tem1 ) then - cdfunc(n,k) = cdfunc(n,k1) - else - cdfunc(n,k) = cdfunc(n,k) * tem1 - endif - enddo - enddo - - ! ################################################################################### - ! 2) Maximum overlap - ! ################################################################################### - case(2) - call random_number(rand1d,stat) - do n = 1, ngpts - tem1 = rand1d(n) - do k = 1, nlay - cdfunc(n,k) = tem1 - enddo - enddo - - ! ################################################################################### - ! 3) Decorrelation length - ! ################################################################################### - case(3) - ! Compute overlapping factors based on layer midpoint distances and decorrelation - ! depths - do k = nlay, 2, -1 - fac_lcf(k) = exp( -0.5 * (dzlyr(iCol,k)+dzlyr(iCol,k-1)) / de_lgth(iCol) ) - enddo - - ! Setup 2 sets of random numbers - call random_number ( rand2d, stat ) - k1 = 0 - do k = 1, nlay - do n = 1, ngpts - k1 = k1 + 1 - cdfunc(n,k) = rand2d(k1) - enddo - enddo - ! - call random_number ( rand2d, stat ) - k1 = 0 - do k = 1, nlay - do n = 1, ngpts - k1 = k1 + 1 - cdfun2(n,k) = rand2d(k1) - enddo - enddo - - ! Then working from the top down: - ! if a random number (from an independent set -cdfun2) is smaller then the - ! scale factor: use the upper layer's number, otherwise use a new random - ! number (keep the original assigned one). - do k = nlay-1, 1, -1 - k1 = k + 1 - do n = 1, ngpts - if ( cdfun2(n,k) <= fac_lcf(k1) ) then - cdfunc(n,k) = cdfunc(n,k1) - endif - enddo - enddo - - end select - - ! ################################################################################### - ! Generate subcolumn cloud mask (0/1 for clear/cloudy) - ! ################################################################################### - do k = 1, nlay - tem1 = 1._kind_phys - cld_frac(icol,k) - do n = 1, ngpts - lcloudy(n,k) = cdfunc(n,k) >= tem1 - if (lcloudy(n,k)) then - cld_frac_mcica(icol,k,n) = .true. - else - cld_frac_mcica(icol,k,n) = .false. - endif - enddo - enddo - enddo ! END LOOP OVER COLUMNS - end subroutine mcica_subcol_sw end module mo_rrtmg_sw_cloud_optics diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 1738f895d..93e38994b 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -12,6 +12,12 @@ module rrtmgp_lw_cloud_optics public rrtmgp_lw_cloud_optics_init, rrtmgp_lw_cloud_optics_run, rrtmgp_lw_cloud_optics_finalize + ! Parameters used for rain and snow(+groupel) RRTMGP cloud-optics + real(kind_phys), parameter :: & + absrain = 0.33e-3, & ! Rain drop absorption coefficient \f$(m^{2}/g)\f$ . + abssnow0 = 1.5, & ! Snow flake absorption coefficient (micron), fu coeff + abssnow1 = 2.34e-3 ! Snow flake absorption coefficient \f$(m^{2}/g)\f$, ncar coef + contains ! ######################################################################################### @@ -20,14 +26,17 @@ module rrtmgp_lw_cloud_optics !! \section arg_table_rrtmgp_lw_cloud_optics_init !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_dir, & - rrtmgp_lw_file_clouds, mpicomm, mpirank, mpiroot, lw_cloud_props, errmsg, errflg) + subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_cldoptics_LUT, & + nrghice, rrtmgp_root_dir, rrtmgp_lw_file_clouds, mpicomm, mpirank, mpiroot, lw_cloud_props, errmsg, errflg) ! Inputs + logical, intent(in) :: & + doG_cldoptics, & ! Use legacy RRTMG cloud-optics? + doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? + doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs? integer, intent(inout) :: & - nrghice ! Number of ice-roughness categories + nrghice ! Number of ice-roughness categories integer, intent(in) :: & - cld_optics_scheme, & ! Cloud-optics scheme mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank @@ -44,7 +53,6 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d errflg ! Error code ! Variables that will be passed to cloud_optics%load() - ! cld_optics_scheme = 1 real(kind_phys) :: & radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation radliq_upr, & ! Liquid particle size upper bound for LUT interpolation @@ -61,7 +69,6 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d lut_extice, & ! LUT shortwave ice extinction coefficient lut_ssaice, & ! LUT shortwave ice single scattering albedo lut_asyice ! LUT shortwave ice asymmetry parameter - ! cld_optics_scheme = 2 real(kind_phys), dimension(:), allocatable :: & pade_sizereg_extliq, & ! Particle size regime boundaries for shortwave liquid extinction ! coefficient for Pade interpolation @@ -97,7 +104,7 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d errmsg = '' errflg = 0 - if (cld_optics_scheme .eq. 0) return + if (doG_cldoptics) return ! Filenames are set in the physics_nml lw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_clouds) @@ -105,7 +112,7 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d ! On master processor only... ! if (mpirank .eq. mpiroot) then ! Open file - status = nf90_open(trim(lw_cloud_props_file), NF90_WRITE, ncid) + status = nf90_open(trim(lw_cloud_props_file), NF90_NOWRITE, ncid) ! Read dimensions status = nf90_inq_dimid(ncid, 'nband', dimid) @@ -126,7 +133,6 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d status = nf90_inquire_dimension(ncid, dimid, len=nBound) status = nf90_inq_dimid(ncid, 'pair', dimid) status = nf90_inquire_dimension(ncid, dimid, len=npairs) - status = nf90_close(ncid) ! Has the number of ice-roughnesses to use been provided from the namelist? ! If not provided, use default number of ice-roughness categories @@ -142,7 +148,7 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d endif ! Allocate space for arrays - if (cld_optics_scheme .eq. 1) then + if (doGP_cldoptics_LUT) then allocate(lut_extliq(nSize_liq, nBand)) allocate(lut_ssaliq(nSize_liq, nBand)) allocate(lut_asyliq(nSize_liq, nBand)) @@ -150,7 +156,7 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d allocate(lut_ssaice(nSize_ice, nBand, nrghice_fromfile)) allocate(lut_asyice(nSize_ice, nBand, nrghice_fromfile)) endif - if (cld_optics_scheme .eq. 2) then + if (doGP_cldoptics_PADE) then allocate(pade_extliq(nBand, nSizeReg, nCoeff_ext )) allocate(pade_ssaliq(nBand, nSizeReg, nCoeff_ssa_g)) allocate(pade_asyliq(nBand, nSizeReg, nCoeff_ssa_g)) @@ -167,7 +173,7 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d allocate(band_lims(2,nBand)) ! Read in fields from file - if (cld_optics_scheme .eq. 1) then + if (doGP_cldoptics_LUT) then write (*,*) 'Reading RRTMGP longwave cloud data (LUT) ... ' status = nf90_inq_varid(ncid,'radliq_lwr',varID) status = nf90_get_var(ncid,varID,radliq_lwr) @@ -196,7 +202,7 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) status = nf90_get_var(ncid,varID,band_lims) endif - if (cld_optics_scheme .eq. 2) then + if (doGP_cldoptics_PADE) then write (*,*) 'Reading RRTMGP longwave cloud data (PADE) ... ' status = nf90_inq_varid(ncid,'radliq_lwr',varID) status = nf90_get_var(ncid,varID,radliq_lwr) @@ -243,18 +249,18 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d ! endif ! Load tables data for RRTMGP cloud-optics - if (cld_optics_scheme .eq. 1) then - call check_error_msg('lw_cloud_optics_init',lw_cloud_props%load(band_lims, & - radliq_lwr, radliq_upr, radliq_fac, radice_lwr, radice_upr, radice_fac, & + if (doGP_cldoptics_LUT) then + call check_error_msg('lw_cloud_optics_init',lw_cloud_props%load(band_lims, & + radliq_lwr, radliq_upr, radliq_fac, radice_lwr, radice_upr, radice_fac, & lut_extliq, lut_ssaliq, lut_asyliq, lut_extice, lut_ssaice, lut_asyice)) endif - if (cld_optics_scheme .eq. 2) then - call check_error_msg('lw_cloud_optics_init', lw_cloud_props%load(band_lims, & + if (doGP_cldoptics_PADE) then + call check_error_msg('lw_cloud_optics_init', lw_cloud_props%load(band_lims, & pade_extliq, pade_ssaliq, pade_asyliq, pade_extice, pade_ssaice, pade_asyice,& pade_sizereg_extliq, pade_sizereg_ssaliq, pade_sizereg_asyliq, & pade_sizereg_extice, pade_sizereg_ssaice, pade_sizereg_asyice)) endif - call check_error_msg('lw_cloud_optics_init', lw_cloud_props%set_ice_roughness(nrghice)) + call check_error_msg('lw_cloud_optics_init',lw_cloud_props%set_ice_roughness(nrghice)) end subroutine rrtmgp_lw_cloud_optics_init @@ -264,100 +270,123 @@ end subroutine rrtmgp_lw_cloud_optics_init !! \section arg_table_rrtmgp_lw_cloud_optics_run !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nrghice, & - cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & - cld_rerain, p_lay, lw_cloud_props, lw_gas_props, lon, lat, & - cldtaulw, lw_optical_props_cloudsByBand, errmsg, errflg) + subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, doGP_cldoptics_PADE, & + doGP_cldoptics_LUT, nCol, nLev, nrghice, p_lay, cld_frac, cld_lwp, cld_reliq, & + cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, precip_frac, & + lw_cloud_props, lw_gas_props, lon, lat, cldtaulw, lw_optical_props_cloudsByBand, & + lw_optical_props_precipByBand, errmsg, errflg) ! Inputs logical, intent(in) :: & - doLWrad ! Logical flag for longwave radiation call - integer, intent(in) :: & - nCol, & ! Number of horizontal gridpoints - nLev, & ! Number of vertical levels - nrghice, & ! Number of ice-roughness categories - cld_optics_scheme ! Cloud-optics scheme + doLWrad, & ! Logical flag for longwave radiation call + doG_cldoptics, & ! Use legacy RRTMG cloud-optics? + doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? + doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs? + integer, intent(in) :: & + nCol, & ! Number of horizontal gridpoints + nLev, & ! Number of vertical levels + nrghice ! Number of ice-roughness categories real(kind_phys), dimension(nCol), intent(in) :: & - lon, & ! Longitude - lat ! Latitude + lon, & ! Longitude + lat ! Latitude real(kind_phys), dimension(ncol,nLev),intent(in) :: & - p_lay, & ! Layer pressure (Pa) - cld_frac, & ! Total cloud fraction by layer - cld_lwp, & ! Cloud liquid water path - cld_reliq, & ! Cloud liquid effective radius - cld_iwp, & ! Cloud ice water path - cld_reice, & ! Cloud ice effective radius - cld_swp, & ! Cloud snow water path (used only for RRTMG legacy scheme) - cld_resnow, & ! Cloud snow effective radius (used only for RRTMG legacy scheme) - cld_rwp, & ! Cloud rain water path (used only for RRTMG legacy scheme) - cld_rerain ! Cloud rain effective radius (used only for RRTMG legacy scheme) + p_lay, & ! Layer pressure (Pa) + cld_frac, & ! Total cloud fraction by layer + cld_lwp, & ! Cloud liquid water path + cld_reliq, & ! Cloud liquid effective radius + cld_iwp, & ! Cloud ice water path + cld_reice, & ! Cloud ice effective radius + cld_swp, & ! Cloud snow water path + cld_resnow, & ! Cloud snow effective radius + cld_rwp, & ! Cloud rain water path + cld_rerain, & ! Cloud rain effective radius + precip_frac ! Precipitation fraction by layer. type(ty_cloud_optics),intent(in) :: & - lw_cloud_props ! RRTMGP DDT: spectral information for RRTMGP LW radiation scheme + lw_cloud_props ! RRTMGP DDT: spectral information for RRTMGP LW radiation scheme type(ty_gas_optics_rrtmgp),intent(in) :: & - lw_gas_props ! RRTMGP DDT: spectral information for RRTMGP LW radiation scheme + lw_gas_props ! RRTMGP DDT: spectral information for RRTMGP LW radiation scheme ! Outputs - real(kind_phys), dimension(ncol,nLev), intent(out) :: & - cldtaulw ! Approx. 10.mu band layer cloud optical depth - type(ty_optical_props_1scl),intent(out) :: & - lw_optical_props_cloudsByBand ! RRTMGP DDT: longwave cloud optical properties in each band - integer, intent(out) :: & - errflg ! CCPP error flag character(len=*), intent(out) :: & - errmsg ! CCPP error message - + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error flag + type(ty_optical_props_1scl),intent(out) :: & + lw_optical_props_cloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (clouds) + lw_optical_props_precipByBand ! RRTMGP DDT: Longwave optical properties in each band (precipitation) + real(kind_phys), dimension(ncol,nLev), intent(out) :: & + cldtaulw ! Approx 10.mu band layer cloud optical depth + ! Local variables - logical,dimension(ncol,nLev) :: liqmask, icemask + real(kind_phys) :: tau_rain, tau_snow real(kind_phys), dimension(ncol,nLev,lw_gas_props%get_nband()) :: & - tau_cld - integer :: iCol, iLay + tau_cld, tau_precip + integer :: iCol, iLay, iBand ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - tau_cld = 0. + + ! Initialize locals + tau_cld = 0._kind_phys + tau_precip = 0._kind_phys if (.not. doLWrad) return - - ! Compute ice/liquid cloud masks, needed by rrtmgp_cloud_optics - liqmask = (cld_frac .gt. 0 .and. cld_lwp .gt. 0) - icemask = (cld_frac .gt. 0 .and. cld_iwp .gt. 0) - ! Allocate space for RRTMGP DDTs containing cloud radiative properties + ! Allocate space for RRTMGP DDTs containing cloud radiative properties ! Cloud optics [nCol,nLev,nBands] call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_cloudsByBand%alloc_1scl(& ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) - lw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys - + lw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys + ! Precipitation optics [nCol,nLev,nBands] + call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_precipByBand%alloc_1scl(& + ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) + lw_optical_props_precipByBand%tau(:,:,:) = 0._kind_phys + ! Compute cloud-optics for RTE. - if (cld_optics_scheme .gt. 0) then + if (doGP_cldoptics_PADE .or. doGP_cldoptics_LUT) then ! i) RRTMGP cloud-optics. call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_cloud_props%cloud_optics(& - !ncol, & ! IN - Number of horizontal gridpoints - !nLev, & ! IN - Number of vertical layers - !lw_cloud_props%get_nband(), & ! IN - Number of LW bands - !nrghice, & ! IN - Number of ice-roughness categories - !liqmask, & ! IN - Liquid-cloud mask (1) - !icemask, & ! IN - Ice-cloud mask (1) cld_lwp, & ! IN - Cloud liquid water path (g/m2) cld_iwp, & ! IN - Cloud ice water path (g/m2) cld_reliq, & ! IN - Cloud liquid effective radius (microns) cld_reice, & ! IN - Cloud ice effective radius (microns) lw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT containing cloud radiative properties ! in each band - else + ! Add in rain and snow(+groupel) + do iCol=1,nCol + do iLay=1,nLev + if (cld_frac(iCol,iLay) .gt. 0.) then + ! Rain optical-depth (No band dependence) + tau_rain = absrain*cld_rwp(iCol,iLay) + + ! Snow (+groupel) optical-depth (No band dependence) + if (cld_swp(iCol,iLay) .gt. 0. .and. cld_resnow(iCol,iLay) .gt. 10._kind_phys) then + tau_snow = abssnow0*1.05756*cld_swp(iCol,iLay)/cld_resnow(iCol,iLay) + else + tau_snow = 0.0 + endif + do iBand=1,lw_gas_props%get_nband() + lw_optical_props_precipByBand%tau(iCol,iLay,iBand) = tau_rain + tau_snow + enddo + endif + enddo + enddo + endif + if (doG_cldoptics) then ! ii) RRTMG cloud-optics. if (any(cld_frac .gt. 0)) then call rrtmg_lw_cloud_optics(ncol, nLev, lw_gas_props%get_nband(), cld_lwp, & cld_reliq, cld_iwp, cld_reice, cld_rwp, cld_rerain, cld_swp, cld_resnow, & - cld_frac, tau_cld) + cld_frac, tau_cld, tau_precip) endif lw_optical_props_cloudsByBand%tau = tau_cld - endif - - ! All-sky LW optical depth ~10microns + lw_optical_props_precipByBand%tau = tau_precip + endif + + ! All-sky LW optical depth ~10microns (DJS asks: Same as SW, move to cloud-diagnostics?) cldtaulw = lw_optical_props_cloudsByBand%tau(:,:,7) - + end subroutine rrtmgp_lw_cloud_optics_run ! ######################################################################################### diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index 9de19382a..41afb6c72 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -1,14 +1,30 @@ [ccpp-arg-table] name = rrtmgp_lw_cloud_optics_init type = scheme -[cld_optics_scheme] - standard_name = rrtmgp_cloud_optics_flag - long_name = Flag to control which RRTMGP cloud-optics scheme +[doG_cldoptics] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMG + long_name = logical flag to control cloud optics scheme. units = flag - dimensions = () - type = integer + dimensions = () + type = logical intent = in - optional = F + optional = F +[doGP_cldoptics_PADE] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in + optional = F +[doGP_cldoptics_LUT] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_LUT + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in + optional = F [nrghice] standard_name = number_of_rrtmgp_ice_roughness long_name = number of ice-roughness categories in RRTMGP calculation @@ -97,6 +113,30 @@ type = logical intent = in optional = F +[doG_cldoptics] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMG + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in + optional = F +[doGP_cldoptics_PADE] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in + optional = F +[doGP_cldoptics_LUT] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_LUT + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in + optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -113,14 +153,6 @@ type = integer intent = in optional = F -[cld_optics_scheme] - standard_name = rrtmgp_cloud_optics_flag - long_name = Flag to control which RRTMGP cloud-optics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F [nrghice] standard_name = number_of_rrtmgp_ice_roughness long_name = number of ice-roughness categories in RRTMGP calculation @@ -201,6 +233,15 @@ type = real intent = in kind = kind_phys +[precip_frac] + standard_name = precipitation_fraction_by_layer + long_name = precipitation fraction in each layer + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [p_lay] standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure layer @@ -261,6 +302,14 @@ type = ty_optical_props_1scl intent = out optional = F +[lw_optical_props_precipByBand] + standard_name = longwave_optical_properties_for_precipitation_by_band + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + intent = out + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index d1da08405..1d6cc06a1 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -3,7 +3,7 @@ module rrtmgp_lw_cloud_sampling use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use physparam, only: isubclw, iovrlw use mo_optical_props, only: ty_optical_props_1scl - use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_ran, draw_samples + use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_dcorr, sampled_mask_exp_ran, draw_samples use mersenne_twister, only: random_setseed, random_number, random_stat use rrtmgp_aux, only: check_error_msg use netcdf @@ -26,9 +26,9 @@ subroutine rrtmgp_lw_cloud_sampling_init(lw_gas_props, ipsdlw0, errmsg, errflg) integer, intent(out) :: & ipsdlw0 ! Initial permutation seed for McICA character(len=*), intent(out) :: & - errmsg ! CCPP error message + errmsg ! Error message integer, intent(out) :: & - errflg ! CCPP error code + errflg ! Error flag ! Initialize CCPP error handling variables errmsg = '' @@ -45,27 +45,34 @@ end subroutine rrtmgp_lw_cloud_sampling_init !! \section arg_table_rrtmgp_lw_cloud_sampling_run !! \htmlinclude rrtmgp_lw_cloud_sampling_run.html !! - subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, cld_frac,& - lw_gas_props, lw_optical_props_cloudsByBand, lw_optical_props_clouds, errmsg, errflg) + subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, & + cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, lw_gas_props, & + lw_optical_props_cloudsByBand, lw_optical_props_precipByBand, & + lw_optical_props_clouds, lw_optical_props_precip, errmsg, errflg) ! Inputs logical, intent(in) :: & - doLWrad ! Logical flag for shortwave radiation call + doLWrad ! Logical flag for shortwave radiation call integer, intent(in) :: & - nCol, & ! Number of horizontal gridpoints - nLev, & ! Number of vertical layers - ipsdlw0 ! Initial permutation seed for McICA + nCol, & ! Number of horizontal gridpoints + nLev, & ! Number of vertical layers + ipsdlw0 ! Initial permutation seed for McICA integer,intent(in),dimension(ncol) :: & - icseed_lw ! auxiliary special cloud related array when module - ! variable isubclw=2, it provides permutation seed - ! for each column profile that are used for generating - ! random numbers. when isubclw /=2, it will not be used. + icseed_lw ! auxiliary special cloud related array when module + ! variable isubclw=2, it provides permutation seed + ! for each column profile that are used for generating + ! random numbers. when isubclw /=2, it will not be used. real(kind_phys), dimension(ncol,nLev),intent(in) :: & - cld_frac ! Total cloud fraction by layer + cld_frac, & ! Total cloud fraction by layer + precip_frac ! Precipitation fraction by layer + real(kind_phys), dimension(ncol,nLev), intent(in) :: & + cloud_overlap_param, & ! Cloud overlap parameter + precip_overlap_param ! Precipitation overlap parameter type(ty_gas_optics_rrtmgp),intent(in) :: & - lw_gas_props ! RRTMGP DDT: K-distribution data + lw_gas_props ! RRTMGP DDT: K-distribution data type(ty_optical_props_1scl),intent(in) :: & - lw_optical_props_cloudsByBand ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) + lw_optical_props_cloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (clouds) + lw_optical_props_precipByBand ! RRTMGP DDT: Longwave optical properties in each band (precipitation) ! Outputs character(len=*), intent(out) :: & @@ -73,23 +80,35 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, integer, intent(out) :: & errflg ! CCPP error code type(ty_optical_props_1scl),intent(out) :: & - lw_optical_props_clouds ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) + lw_optical_props_clouds, & ! RRTMGP DDT: Shortwave optical properties by spectral point (clouds) + lw_optical_props_precip ! RRTMGP DDT: Shortwave optical properties by spectral point (precipitation) ! Local variables integer :: iCol integer,dimension(ncol) :: ipseed_lw type(random_stat) :: rng_stat - real(kind_phys), dimension(lw_gas_props%get_ngpt(),nLev,ncol) :: rng3D + real(kind_phys), dimension(lw_gas_props%get_ngpt(),nLev,ncol) :: rng3D,rng3D2 real(kind_phys), dimension(lw_gas_props%get_ngpt()*nLev) :: rng1D - logical, dimension(ncol,nLev,lw_gas_props%get_ngpt()) :: cldfracMCICA - real(kind_phys), dimension(ncol,nLev) :: cld_frac_noSamp + logical, dimension(ncol,nLev,lw_gas_props%get_ngpt()) :: cldfracMCICA,precipfracSAMP ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + ! + if (iovrlw .ne. 1 .and. iovrlw .ne. 3 .and. iovrlw .ne. 4 .and. iovrlw .ne. 5) then + errmsg = 'Cloud overlap assumption not supported.' + errflg = 1 + call check_error_msg('rrtmgp_lw_cloud_sampling',errmsg) + return + endif + if (.not. doLWrad) return - + + ! #################################################################################### + ! First sample the clouds... + ! #################################################################################### + ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] call check_error_msg('rrtmgp_lw_cloud_sampling_run',& lw_optical_props_clouds%alloc_1scl(nCol, nLev, lw_gas_props)) @@ -105,7 +124,6 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, enddo endif - ! Call McICA to generate subcolumns. ! Call RNG. Mersennse Twister accepts 1D array, so loop over columns and collapse along G-points ! and layers. ([nGpts,nLev,nColumn]-> [nGpts*nLev]*nColumn) do iCol=1,ncol @@ -114,16 +132,119 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, rng3D(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) enddo - ! Call McICA + ! Cloud-overlap. + select case ( iovrlw ) + case(1) ! Maximum-random overlap + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + sampled_mask_max_ran(rng3D, & + cld_frac, & + cldfracMCICA)) + case(3) ! Exponential decorrelation length overlap + ! 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 check_error_msg('rrtmgp_lw_cloud_sampling_run', & + sampled_mask_exp_dcorr(rng3D, & + rng3D2, & + cld_frac, & + cloud_overlap_param(:,1:nLev-1), & + cldfracMCICA)) + case(4) ! Exponential overlap + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + sampled_mask_exp_ran(rng3D, & + cld_frac, & + cloud_overlap_param(:,1:nLev-1), & + cldfracMCICA)) + case(5) ! Exponential-random overlap + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + sampled_mask_exp_ran(rng3D, & + cld_frac, & + cloud_overlap_param(:,1:nLev-1), & + cldfracMCICA)) + end select + + ! Sampling. Map band optical depth to each g-point using McICA + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + draw_samples(cldfracMCICA, & + lw_optical_props_cloudsByBand, & + lw_optical_props_clouds)) + + ! #################################################################################### + ! Next sample the precipitation... + ! #################################################################################### + + ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] + call check_error_msg('rrtmgp_lw_cloud_sampling_run',& + lw_optical_props_precip%alloc_1scl(nCol, nLev, lw_gas_props)) + + ! Change random number seed value for each radiation invocation (isubclw =1 or 2). + if(isubclw == 1) then ! advance prescribed permutation seed + do iCol = 1, ncol + ipseed_lw(iCol) = ipsdlw0 + iCol + enddo + elseif (isubclw == 2) then ! use input array of permutaion seeds + do iCol = 1, ncol + ipseed_lw(iCol) = icseed_lw(iCol) + enddo + endif + + ! 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. select case ( iovrlw ) - ! Maximumn-random - case(1) - call check_error_msg('rrtmgp_lw_cloud_sampling_run',sampled_mask_max_ran(rng3D,cld_frac,cldfracMCICA)) + case(1) ! Maximum-random overlap + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + sampled_mask_max_ran(rng3D, & + precip_frac, & + precipfracSAMP)) + case(3) ! Exponential decorrelation length overlap + ! 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 check_error_msg('rrtmgp_lw_cloud_sampling_run', & + sampled_mask_exp_dcorr(rng3D, & + rng3D2, & + precip_frac, & + precip_overlap_param(:,1:nLev-1), & + precipfracSAMP)) + case(4) ! Exponential overlap + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + sampled_mask_exp_ran(rng3D, & + precip_frac, & + precip_overlap_param(:,1:nLev-1), & + precipfracSAMP)) + case(5) ! Exponential-random overlap + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + sampled_mask_exp_ran(rng3D, & + precip_frac, & + precip_overlap_param(:,1:nLev-1), & + precipfracSAMP)) end select - ! Map band optical depth to each g-point using McICA - call check_error_msg('rrtmgp_lw_cloud_sampling_run',draw_samples(& - cldfracMCICA,lw_optical_props_cloudsByBand,lw_optical_props_clouds)) + ! Sampling. Map band optical depth to each g-point using McICA + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + draw_samples(precipfracSAMP, & + lw_optical_props_precipByBand, & + lw_optical_props_precip)) + + ! #################################################################################### + ! Just add precipitation optics to cloud-optics + ! #################################################################################### + lw_optical_props_clouds%tau = lw_optical_props_clouds%tau + lw_optical_props_precip%tau end subroutine rrtmgp_lw_cloud_sampling_run diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index 87e785a4d..251e1e880 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -88,6 +88,33 @@ kind = kind_phys intent = in optional = F +[precip_frac] + standard_name = precipitation_fraction_by_layer + long_name = precipitation fraction in each layer + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cloud_overlap_param] + standard_name = cloud_overlap_param + long_name = cloud overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[precip_overlap_param] + standard_name = precip_overlap_param + long_name = precipitation overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [lw_gas_props] standard_name = coefficients_for_lw_gas_optics long_name = DDT containing spectral information for RRTMGP LW radiation scheme @@ -104,6 +131,14 @@ type = ty_optical_props_1scl intent = in optional = F +[lw_optical_props_precipByBand] + standard_name = longwave_optical_properties_for_precipitation_by_band + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + intent = in + optional = F [lw_optical_props_clouds] standard_name = longwave_optical_properties_for_cloudy_atmosphere long_name = Fortran DDT containing RRTMGP optical properties @@ -112,6 +147,14 @@ type = ty_optical_props_1scl intent = out optional = F +[lw_optical_props_precip] + standard_name = longwave_optical_properties_for_precipitation + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + intent = out + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 408cc48f5..787db6bb4 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -66,7 +66,8 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp temp_ref ! Temperatures for reference atmosphere; temp_ref(# reference layers) [K] real(kind_phys), dimension(:,:), allocatable :: & band_lims, & ! Beginning and ending wavenumber [cm -1] for each band - totplnk ! Integrated Planck function by band + totplnk, & ! Integrated Planck function by band + optimal_angle_fit real(kind_phys), dimension(:,:,:), allocatable :: & vmr_ref, & ! volume mixing ratios for reference atmosphere kminor_lower, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to @@ -97,7 +98,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp ntemps, npress, ngpts, nabsorbers, nextrabsorbers, nminorabsorbers,& nmixingfracs, nlayers, nbnds, npairs, ninternalSourcetemps, & nminor_absorber_intervals_lower, nminor_absorber_intervals_upper, & - ncontributors_lower, ncontributors_upper + ncontributors_lower, ncontributors_upper,nfit_coeffs ! Local variables integer :: ncid, dimID, varID, status, iGas, ierr @@ -115,7 +116,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp ! On master processor only... ! if (mpirank .eq. mpiroot) then ! Open file - status = nf90_open(trim(lw_gas_props_file), NF90_WRITE, ncid) + status = nf90_open(trim(lw_gas_props_file), NF90_NOWRITE, ncid) ! Read dimensions for k-distribution fields status = nf90_inq_dimid(ncid, 'temperature', dimid) @@ -142,6 +143,8 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp status = nf90_inquire_dimension(ncid, dimid, len = ncontributors_lower) status = nf90_inq_dimid(ncid, 'contributors_upper', dimid) status = nf90_inquire_dimension(ncid, dimid, len = ncontributors_upper) + status = nf90_inq_dimid(ncid, 'fit_coeffs', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = nfit_coeffs) status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_lower', dimid) status = nf90_inquire_dimension(ncid, dimid, len = nminor_absorber_intervals_lower) status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_upper', dimid) @@ -170,6 +173,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp allocate(kminor_start_lower(nminor_absorber_intervals_lower)) allocate(kminor_upper(ncontributors_upper, nmixingfracs, ntemps)) allocate(kminor_start_upper(nminor_absorber_intervals_upper)) + allocate(optimal_angle_fit(nfit_coeffs,nbnds)) allocate(minor_scales_with_density_lower(nminor_absorber_intervals_lower)) allocate(minor_scales_with_density_upper(nminor_absorber_intervals_upper)) allocate(scale_by_complement_lower(nminor_absorber_intervals_lower)) @@ -223,6 +227,8 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp status = nf90_get_var( ncid, varID, kminor_upper) status = nf90_inq_varid(ncid, 'vmr_ref', varID) status = nf90_get_var( ncid, varID, vmr_ref) + status = nf90_inq_varid(ncid, 'optimal_angle_fit',varID) + status = nf90_get_var( ncid, varID, optimal_angle_fit) status = nf90_inq_varid(ncid, 'kmajor', varID) status = nf90_get_var( ncid, varID, kmajor) status = nf90_inq_varid(ncid, 'kminor_start_lower', varID) @@ -264,7 +270,8 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp minor_gases_lower, minor_gases_upper, minor_limits_gpt_lower, minor_limits_gpt_upper, & minor_scales_with_density_lower, minor_scales_with_density_upper, scaling_gas_lower, & scaling_gas_upper, scale_by_complement_lower, scale_by_complement_upper, & - kminor_start_lower, kminor_start_upper, totplnk, planck_frac, rayl_lower, rayl_upper)) + kminor_start_lower, kminor_start_upper, totplnk, planck_frac, rayl_lower, rayl_upper, & + optimal_angle_fit)) end subroutine rrtmgp_lw_gas_optics_init diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index 583fa9ee2..dc49260f6 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -14,7 +14,6 @@ module rrtmgp_lw_rte implicit none public rrtmgp_lw_rte_init, rrtmgp_lw_rte_run, rrtmgp_lw_rte_finalize - contains ! ######################################################################################### @@ -29,14 +28,17 @@ end subroutine rrtmgp_lw_rte_init !! \section arg_table_rrtmgp_lw_rte_run !! \htmlinclude rrtmgp_lw_rte_run.html !! - subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_gas_props, & - sfc_emiss_byband, sources, lw_optical_props_clrsky, lw_optical_props_clouds, & - lw_optical_props_aerosol, secdiff, nGauss_angles, fluxlwUP_allsky, fluxlwDOWN_allsky,& - fluxlwUP_clrsky, fluxlwDOWN_clrsky, hlwb, errmsg, errflg) + subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, nCol, nLev, p_lay, & + t_lay, p_lev, skt, lw_gas_props, sfc_emiss_byband, sources, lw_optical_props_clrsky,& + lw_optical_props_clouds, lw_optical_props_aerosol, nGauss_angles, fluxlwUP_allsky, & + fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac, & + fluxlwDOWN_jac, errmsg, errflg) ! Inputs logical, intent(in) :: & - doLWrad ! Logical flag for longwave radiation call + 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? integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical levels @@ -59,8 +61,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g type(ty_optical_props_1scl),intent(in) :: & lw_optical_props_clouds, & ! RRTMGP DDT: longwave cloud radiative properties lw_optical_props_aerosol ! RRTMGP DDT: longwave aerosol radiative properties - real(kind_phys), dimension(lw_gas_props%get_nband(),ncol),intent(in) :: & - secdiff ! Outputs real(kind_phys), dimension(ncol,nLev+1), intent(out) :: & fluxlwUP_allsky, & ! All-sky flux (W/m2) @@ -71,10 +71,10 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g errmsg ! CCPP error message integer, intent(out) :: & errflg ! CCPP error flag - ! Outputs (optional) - real(kind_phys), dimension(ncol,nLev,lw_gas_props%get_nband()), optional, intent(inout) :: & - hlwb ! All-sky heating rate, by band (K/sec) + real(kind_phys), dimension(ncol,nLev+1), intent(out), optional :: & + fluxlwUP_jac, & ! Jacobian of upward LW flux (W/m2/K) + fluxlwDOWN_jac ! Jacobian of downward LW flux (W/m2/K) ! Local variables integer :: & @@ -84,7 +84,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g real(kind_phys), dimension(ncol,nLev+1,lw_gas_props%get_nband()),target :: & fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky logical :: & - l_AllSky_HR_byband, top_at_1 + top_at_1 ! Initialize CCPP error handling variables errmsg = '' @@ -94,10 +94,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g ! Vertical ordering? top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) - - ! Are any optional outputs requested? Need to know now to compute correct fluxes. - l_AllSky_HR_byband = present(hlwb) - + ! Initialize RRTMGP DDT containing 2D(3D) fluxes flux_allsky%bnd_flux_up => fluxLW_up_allsky flux_allsky%bnd_flux_dn => fluxLW_dn_allsky @@ -110,54 +107,56 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g ! Add aerosol optics to gas optics call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_aerosol%increment(lw_optical_props_clrsky)) - ! Apply diffusivity angle adjustment (RRTMG legacy) - do iCol=1,nCol - do iBand=1,lw_gas_props%get_nband() - lw_optical_props_clrsky%tau(iCol,1:nLev,iBand) = lw_optical_props_clrsky%tau(iCol,1:nLev,iBand)*secdiff(iBand,iCol) - enddo - enddo - ! Call RTE solver - call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & - lw_optical_props_clrsky, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_clrsky, & ! OUT - Fluxes - n_gauss_angles = nGauss_angles)) - ! Store fluxes - fluxlwUP_clrsky = sum(flux_clrsky%bnd_flux_up,dim=3) - fluxlwDOWN_clrsky = sum(flux_clrsky%bnd_flux_dn,dim=3) - + if (doLWclrsky) then + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles)) ! IN - Number of angles in Gaussian quadrature + + ! Store fluxes + fluxlwUP_clrsky = sum(flux_clrsky%bnd_flux_up,dim=3) + fluxlwDOWN_clrsky = sum(flux_clrsky%bnd_flux_dn,dim=3) + else + fluxlwUP_clrsky = 0.0 + fluxlwDOWN_clrsky = 0.0 + endif + ! ! All-sky fluxes ! - - ! Apply diffusivity angle adjustment (RRTMG legacy) - !do iCol=1,nCol - ! do iBand=1,lw_gas_props%get_nband() - ! lw_optical_props_clouds%tau(iCol,1:nLev,iBand) = lw_optical_props_clouds%tau(iCol,1:nLev,iBand)*secdiff(iBand,iCol) - ! enddo - !enddo ! Add cloud optics to clear-sky optics call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clouds%increment(lw_optical_props_clrsky)) ! Call RTE solver - call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & - lw_optical_props_clrsky, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky, & ! OUT - Flxues - n_gauss_angles = nGauss_angles)) + if (use_LW_jacobian) then + ! Compute LW Jacobians + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky, & ! OUT - Flxues + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + flux_up_Jac = fluxlwUP_jac, & ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) + flux_dn_Jac = fluxlwDOWN_jac)) ! OUT - surface temperature flux (downward) Jacobian (W/m2/K) + else + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky, & ! OUT - Flxues + n_gauss_angles = nGauss_angles)) ! IN - Number of angles in Gaussian quadrature + end if + ! Store fluxes fluxlwUP_allsky = sum(flux_allsky%bnd_flux_up,dim=3) fluxlwDOWN_allsky = sum(flux_allsky%bnd_flux_dn,dim=3) - ! Only output fluxes by-band when heating-rate profiles by band are requested. - !if (l_AllSky_HR_byband) then - !endif - end subroutine rrtmgp_lw_rte_run ! ######################################################################################### diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index a8426bc15..f8cdfe891 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -9,6 +9,22 @@ type = logical intent = in optional = F +[doLWclrsky] + standard_name = flag_for_output_of_longwave_heating_rate + long_name = flag to output lw heating rate (Radtend%lwhc) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[use_LW_jacobian] + standard_name = flag_to_calc_RRTMGP_LW_jacobian + long_name = logical flag to control RRTMGP LW calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -118,24 +134,6 @@ type = ty_source_func_lw intent = in optional = F -[hlwb] - standard_name = RRTMGP_lw_heating_rate_spectral - long_name = RRTMGP longwave total sky heating rate (spectral) - units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_lw_spectral_points_rrtmgp) - type = real - kind = kind_phys - intent = in - optional = T -[secdiff] - standard_name = secant_of_diffusivity_angle_each_RRTMGP_LW_band - long_name = secant of diffusivity angle in each RRTMGP LW band - units = none - dimensions = (number_of_lw_bands_rrtmgp,horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F [fluxlwUP_allsky] standard_name = RRTMGP_lw_flux_profile_upward_allsky long_name = RRTMGP upward longwave all-sky flux profile @@ -172,6 +170,24 @@ kind = kind_phys intent = out optional = F +[fluxlwUP_jac] + standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward + long_name = RRTMGP Jacobian upward longwave flux profile + units = W m-2 K-1 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = out + optional = T +[fluxlwDOWN_jac] + standard_name = RRTMGP_jacobian_of_lw_flux_profile_downward + long_name = RRTMGP Jacobian downward of longwave flux profile + units = W m-2 K-1 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = out + optional = T [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 79e439030..7ab3c27e3 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -12,6 +12,13 @@ module rrtmgp_sw_cloud_optics implicit none public rrtmgp_sw_cloud_optics_init, rrtmgp_sw_cloud_optics_run, rrtmgp_sw_cloud_optics_finalize + + ! Parameters used for rain and snow(+groupel) RRTMGP cloud-optics + real(kind_phys),parameter :: & + a0r = 3.07e-3, & ! + a0s = 0.0, & ! + a1s = 1.5 ! + real(kind_phys),dimension(:),allocatable :: b0r,b0s,b1s,c0r,c0s contains ! ######################################################################################### @@ -20,21 +27,25 @@ module rrtmgp_sw_cloud_optics !! \section arg_table_rrtmgp_sw_cloud_optics_init !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_dir, & - rrtmgp_sw_file_clouds, mpicomm, mpirank, mpiroot, sw_cloud_props, errmsg, errflg) + subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_cldoptics_LUT, & + nrghice, rrtmgp_root_dir, rrtmgp_sw_file_clouds, mpicomm, mpirank, mpiroot, sw_cloud_props,& + errmsg, errflg) ! Inputs + logical, intent(in) :: & + doG_cldoptics, & ! Use legacy RRTMG cloud-optics? + doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? + doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs? integer, intent(inout) :: & nrghice ! Number of ice-roughness categories integer, intent(in) :: & - cld_optics_scheme, & ! Cloud-optics scheme mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank character(len=128),intent(in) :: & rrtmgp_root_dir, & ! RTE-RRTMGP root directory rrtmgp_sw_file_clouds ! RRTMGP file containing coefficients used to compute clouds optical properties - + ! Outputs type(ty_cloud_optics),intent(out) :: & sw_cloud_props ! RRTMGP DDT: shortwave spectral information @@ -42,9 +53,8 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d errmsg ! CCPP error message integer, intent(out) :: & errflg ! CCPP error code - + ! Variables that will be passed to cloud_optics%load() - ! cld_optics_scheme = 1 real(kind_phys) :: & radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation radliq_upr, & ! Liquid particle size upper bound for LUT interpolation @@ -61,7 +71,6 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d lut_extice, & ! LUT shortwave ice extinction coefficient lut_ssaice, & ! LUT shortwave ice single scattering albedo lut_asyice ! LUT shortwave ice asymmetry parameter - ! cld_optics_scheme = 2 real(kind_phys), dimension(:), allocatable :: & pade_sizereg_extliq, & ! Particle size regime boundaries for shortwave liquid extinction ! coefficient for Pade interpolation @@ -97,7 +106,7 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d errmsg = '' errflg = 0 - if (cld_optics_scheme .eq. 0) return + if (doG_cldoptics) return ! Filenames are set in the physics_nml sw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_clouds) @@ -105,7 +114,7 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d ! On master processor only... ! if (mpirank .eq. mpiroot) then ! Open file - status = nf90_open(trim(sw_cloud_props_file), NF90_WRITE, ncid) + status = nf90_open(trim(sw_cloud_props_file), NF90_NOWRITE, ncid) ! Read dimensions status = nf90_inq_dimid(ncid, 'nband', dimid) @@ -141,7 +150,7 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d endif ! Allocate space for arrays - if (cld_optics_scheme .eq. 1) then + if (doGP_cldoptics_LUT) then allocate(lut_extliq(nSize_liq, nBand)) allocate(lut_ssaliq(nSize_liq, nBand)) allocate(lut_asyliq(nSize_liq, nBand)) @@ -149,7 +158,7 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d allocate(lut_ssaice(nSize_ice, nBand, nrghice_fromfile)) allocate(lut_asyice(nSize_ice, nBand, nrghice_fromfile)) endif - if (cld_optics_scheme .eq. 2) then + if (doGP_cldoptics_PADE) then allocate(pade_extliq(nBand, nSizeReg, nCoeff_ext )) allocate(pade_ssaliq(nBand, nSizeReg, nCoeff_ssa_g)) allocate(pade_asyliq(nBand, nSizeReg, nCoeff_ssa_g)) @@ -166,7 +175,7 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d allocate(band_lims(2,nBand)) ! Read in fields from file - if (cld_optics_scheme .eq. 1) then + if (doGP_cldoptics_LUT) then write (*,*) 'Reading RRTMGP shortwave cloud data (LUT) ... ' status = nf90_inq_varid(ncid,'radliq_lwr',varID) status = nf90_get_var(ncid,varID,radliq_lwr) @@ -195,7 +204,7 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) status = nf90_get_var(ncid,varID,band_lims) endif - if (cld_optics_scheme .eq. 2) then + if (doGP_cldoptics_PADE) then write (*,*) 'Reading RRTMGP shortwave cloud data (PADE) ... ' status = nf90_inq_varid(ncid,'radliq_lwr',varID) status = nf90_get_var(ncid,varID,radliq_lwr) @@ -242,18 +251,34 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d ! endif ! Load tables data for RRTMGP cloud-optics - if (cld_optics_scheme .eq. 1) then + if (doGP_cldoptics_LUT) then call check_error_msg('sw_cloud_optics_init',sw_cloud_props%load(band_lims, & radliq_lwr, radliq_upr, radliq_fac, radice_lwr, radice_upr, radice_fac, & lut_extliq, lut_ssaliq, lut_asyliq, lut_extice, lut_ssaice, lut_asyice)) endif - if (cld_optics_scheme .eq. 2) then + if (doGP_cldoptics_PADE) then call check_error_msg('sw_cloud_optics_init', sw_cloud_props%load(band_lims, & pade_extliq, pade_ssaliq, pade_asyliq, pade_extice, pade_ssaice, pade_asyice,& pade_sizereg_extliq, pade_sizereg_ssaliq, pade_sizereg_asyliq, & pade_sizereg_extice, pade_sizereg_ssaice, pade_sizereg_asyice)) endif call check_error_msg('sw_cloud_optics_init',sw_cloud_props%set_ice_roughness(nrghice)) + + ! Initialize coefficients for rain and snow(+groupel) cloud optics + allocate(b0r(sw_cloud_props%get_nband()),b0s(sw_cloud_props%get_nband()), & + b1s(sw_cloud_props%get_nband()),c0r(sw_cloud_props%get_nband()), & + c0s(sw_cloud_props%get_nband())) + b0r = (/0.496, 0.466, 0.437, 0.416, 0.391, 0.374, 0.352, & + 0.183, 0.048, 0.012, 0.000, 0.000, 0.000, 0.000/) + b0s = (/0.460, 0.460, 0.460, 0.460, 0.460, 0.460, 0.460, & + 0.460, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/) + b1s = (/0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & + 0.000, 1.62e-5, 1.62e-5, 0.000, 0.000, 0.000, 0.000/) + c0r = (/0.980, 0.975, 0.965, 0.960, 0.955, 0.952, 0.950, & + 0.944, 0.894, 0.884, 0.883, 0.883, 0.883, 0.883/) + c0s = (/0.970, 0.970, 0.970, 0.970, 0.970, 0.970, 0.970, & + 0.970, 0.970, 0.970, 0.700, 0.700, 0.700, 0.700/) + end subroutine rrtmgp_sw_cloud_optics_init ! ######################################################################################### @@ -262,73 +287,85 @@ end subroutine rrtmgp_sw_cloud_optics_init !! \section arg_table_rrtmgp_sw_cloud_optics_run !! \htmlinclude rrtmgp_sw_cloud_optics.html !! - subroutine rrtmgp_sw_cloud_optics_run(doSWrad, nCol, nLev, nDay, idxday, nrghice, & - cld_optics_scheme, cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, & - cld_resnow, cld_rwp, cld_rerain, sw_cloud_props, sw_gas_props, & - sw_optical_props_cloudsByBand, cldtausw, errmsg, errflg) + subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, doGP_cldoptics_PADE, & + doGP_cldoptics_LUT, nCol, nLev, nDay, idxday, nrghice, cld_frac, cld_lwp, cld_reliq, & + cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, precip_frac, & + sw_cloud_props, sw_gas_props, sw_optical_props_cloudsByBand, & + sw_optical_props_precipByBand, cldtausw, errmsg, errflg) ! Inputs logical, intent(in) :: & - doSWrad ! Logical flag for shortwave radiation call + doSWrad, & ! Logical flag for shortwave radiation call + doG_cldoptics, & ! Use legacy RRTMG cloud-optics? + doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? + doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs? integer, intent(in) :: & - nCol, & ! Number of horizontal gridpoints - nLev, & ! Number of vertical levels - nday, & ! Number of daylit points. - nrghice, & ! Number of ice-roughness categories - cld_optics_scheme ! Cloud-optics scheme + nCol, & ! Number of horizontal gridpoints + nLev, & ! Number of vertical levels + nday, & ! Number of daylit points. + nrghice ! Number of ice-roughness categories integer,intent(in),dimension(ncol) :: & - idxday ! Indices for daylit points. + idxday ! Indices for daylit points. real(kind_phys), dimension(ncol,nLev),intent(in) :: & - cld_frac, & ! Total cloud fraction by layer - cld_lwp, & ! Cloud liquid water path - cld_reliq, & ! Cloud liquid effective radius - cld_iwp, & ! Cloud ice water path - cld_reice, & ! Cloud ice effective radius - cld_swp, & ! Cloud snow water path - cld_resnow, & ! Cloud snow effective radius - cld_rwp, & ! Cloud rain water path - cld_rerain ! Cloud rain effective radius + cld_frac, & ! Total cloud fraction by layer + cld_lwp, & ! Cloud liquid water path + cld_reliq, & ! Cloud liquid effective radius + cld_iwp, & ! Cloud ice water path + cld_reice, & ! Cloud ice effective radius + cld_swp, & ! Cloud snow water path + cld_resnow, & ! Cloud snow effective radius + cld_rwp, & ! Cloud rain water path + cld_rerain, & ! Cloud rain effective radius + precip_frac ! Precipitation fraction by layer type(ty_cloud_optics),intent(in) :: & - sw_cloud_props ! RRTMGP DDT: shortwave cloud properties + sw_cloud_props ! RRTMGP DDT: shortwave cloud properties type(ty_gas_optics_rrtmgp),intent(in) :: & - sw_gas_props ! RRTMGP DDT: shortwave K-distribution data - + sw_gas_props ! RRTMGP DDT: shortwave K-distribution data + ! Outputs character(len=*), intent(out) :: & - errmsg ! CCPP error message + errmsg ! CCPP error message integer, intent(out) :: & - errflg ! CCPP error code + errflg ! CCPP error flag type(ty_optical_props_2str),intent(out) :: & - sw_optical_props_cloudsByBand ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) + 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 (cloud precipitation) real(kind_phys), dimension(ncol,NLev), intent(out) :: & - cldtausw ! approx 10.mu band layer cloud optical depth - + cldtausw ! Approx 10.mu band layer cloud optical depth + ! Local variables - logical,dimension(nday,nLev) :: liqmask, icemask + integer :: iDay, iLay, iBand + real(kind_phys) :: tau_rain, tau_snow, ssa_rain, ssa_snow, asy_rain, asy_snow, & + tau_prec, asy_prec, ssa_prec, asyw, ssaw, za1, za2 real(kind_phys), dimension(nday,nLev,sw_gas_props%get_nband()) :: & - tau_cld, ssa_cld, asy_cld - + tau_cld, ssa_cld, asy_cld, tau_precip, ssa_precip, asy_precip + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + if (.not. doSWrad) return + + ! Only process sunlit points... if (nDay .gt. 0) then - ! Compute ice/liquid cloud masks, needed by rrtmgp_cloud_optics - liqmask = (cld_frac(idxday(1:nday),:) .gt. 0 .and. cld_lwp(idxday(1:nday),:) .gt. 0) - icemask = (cld_frac(idxday(1:nday),:) .gt. 0 .and. cld_iwp(idxday(1:nday),:) .gt. 0) - - ! Allocate space for RRTMGP DDTs containing cloud radiative properties + ! Allocate space for RRTMGP DDTs containing cloud/precipitation radiative properties ! Cloud optics [nday,nLev,nBands] call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_optical_props_cloudsByBand%alloc_2str(& nday, nLev, sw_gas_props%get_band_lims_wavenumber())) sw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys - sw_optical_props_cloudsByBand%ssa(:,:,:) = 0._kind_phys + sw_optical_props_cloudsByBand%ssa(:,:,:) = 1._kind_phys sw_optical_props_cloudsByBand%g(:,:,:) = 0._kind_phys - - ! Compute cloud-optics for RTE. - if (cld_optics_scheme .gt. 0) then + + ! Cloud-precipitation optics [nday,nLev,nBands] + call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_optical_props_precipByBand%alloc_2str(& + nday, nLev, sw_gas_props%get_band_lims_wavenumber())) + sw_optical_props_precipByBand%tau(:,:,:) = 0._kind_phys + sw_optical_props_precipByBand%ssa(:,:,:) = 1._kind_phys + sw_optical_props_precipByBand%g(:,:,:) = 0._kind_phys + + ! Compute cloud/precipitation optics. + if (doGP_cldoptics_PADE .or. doGP_cldoptics_LUT) then ! RRTMGP cloud-optics. call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_cloud_props%cloud_optics(& cld_lwp(idxday(1:nday),:), & ! IN - Cloud liquid water path @@ -337,28 +374,74 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, nCol, nLev, nDay, idxday, nrghice cld_reice(idxday(1:nday),:), & ! IN - Cloud ice effective radius sw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT: Shortwave optical properties, ! in each band (tau,ssa,g) - else - ! RRTMG cloud-optics - tau_cld(:,:,:) = 0._kind_phys - ssa_cld(:,:,:) = 0._kind_phys - asy_cld(:,:,:) = 0._kind_phys + ! Cloud precipitation optics: rain and snow(+groupel) + do iDay=1,nDay + do iLay=1,nLev + if (cld_frac(idxday(iDay),iLay) .gt. 1.e-12_kind_phys) then + ! Rain/Snow optical depth (No band dependence) + tau_rain = cld_rwp(idxday(iDay),iLay)*a0r + if (cld_swp(idxday(iDay),iLay) .gt. 0. .and. cld_resnow(idxday(iDay),iLay) .gt. 10._kind_phys) then + tau_snow = cld_swp(idxday(iDay),iLay)*1.09087*(a0s + a1s/(1.0315*cld_resnow(idxday(iDay),iLay))) ! fu's formula + else + tau_snow = 0._kind_phys + endif + + ! Rain/Snow single-scattering albedo and asymmetry (Band dependent) + do iBand=1,sw_cloud_props%get_nband() + ! By species + ssa_rain = tau_rain*(1.-b0r(iBand)) + asy_rain = ssa_rain*c0r(iBand) + ssa_snow = tau_snow*(1.-(b0s(iBand)+b1s(iBand)*1.0315*cld_resnow(idxday(iDay),iLay))) + asy_snow = ssa_snow*c0s(iBand) + ! Combine + tau_prec = max(1.e-12_kind_phys, tau_rain + tau_snow) + ssa_prec = max(1.e-12_kind_phys, ssa_rain + ssa_snow) + asy_prec = max(1.e-12_kind_phys, asy_rain + asy_snow) + asyw = asy_prec/max(1.e-12_kind_phys, ssa_prec) + ssaw = min(1._kind_phys-0.000001, ssa_prec/tau_prec) + za1 = asyw * asyw + za2 = ssaw * za1 + sw_optical_props_precipByBand%tau(iDay,iLay,iBand) = (1._kind_phys - za2) * tau_prec + sw_optical_props_precipByBand%ssa(iDay,iLay,iBand) = (ssaw - za2) / (1._kind_phys - za2) + sw_optical_props_precipByBand%g(iDay,iLay,iBand) = asyw/(1+asyw) + enddo + endif + enddo + enddo + endif + if (doG_cldoptics) then + ! RRTMG cloud(+precipitation) optics if (any(cld_frac .gt. 0)) then call rrtmg_sw_cloud_optics(nday, nLev, sw_gas_props%get_nband(), & cld_lwp(idxday(1:nday),:), cld_reliq(idxday(1:nday),:), & cld_iwp(idxday(1:nday),:), cld_reice(idxday(1:nday),:), & cld_rwp(idxday(1:nday),:), cld_rerain(idxday(1:nday),:), & cld_swp(idxday(1:nday),:), cld_resnow(idxday(1:nday),:), & - cld_frac(idxday(1:nday),:), tau_cld, ssa_cld, asy_cld) + cld_frac(idxday(1:nday),:), & + tau_cld, ssa_cld, asy_cld, & + tau_precip, ssa_precip, asy_precip) + + ! 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()) + sw_optical_props_cloudsByBand%tau(:,:,2:sw_gas_props%get_nband()) = tau_cld(:,:,1:sw_gas_props%get_nband()-1) + sw_optical_props_cloudsByBand%ssa(:,:,2:sw_gas_props%get_nband()) = ssa_cld(:,:,1:sw_gas_props%get_nband()-1) + sw_optical_props_cloudsByBand%g(:,:,2:sw_gas_props%get_nband()) = asy_cld(:,:,1:sw_gas_props%get_nband()-1) + ! Precipitation-optics (Need to reorder from G->GP band conventions) + sw_optical_props_precipByBand%tau(:,:,1) = tau_precip(:,:,sw_gas_props%get_nband()) + sw_optical_props_precipByBand%ssa(:,:,1) = ssa_precip(:,:,sw_gas_props%get_nband()) + sw_optical_props_precipByBand%g(:,:,1) = asy_precip(:,:,sw_gas_props%get_nband()) + sw_optical_props_precipByBand%tau(:,:,2:sw_gas_props%get_nband()) = tau_precip(:,:,1:sw_gas_props%get_nband()-1) + sw_optical_props_precipByBand%ssa(:,:,2:sw_gas_props%get_nband()) = ssa_precip(:,:,1:sw_gas_props%get_nband()-1) + sw_optical_props_precipByBand%g(:,:,2:sw_gas_props%get_nband()) = asy_precip(:,:,1:sw_gas_props%get_nband()-1) endif - sw_optical_props_cloudsByBand%tau(:,:,:) = tau_cld - sw_optical_props_cloudsByBand%ssa(:,:,:) = ssa_cld - sw_optical_props_cloudsByBand%g(:,:,:) = asy_cld endif - - ! All-sky SW optical depth ~0.55microns + + ! All-sky SW optical depth ~0.55microns (DJS asks: Move to cloud diagnostics?) cldtausw(idxday(1:nDay),:) = sw_optical_props_cloudsByBand%tau(:,:,11) endif - + end subroutine rrtmgp_sw_cloud_optics_run ! ######################################################################################### diff --git a/physics/rrtmgp_sw_cloud_optics.meta b/physics/rrtmgp_sw_cloud_optics.meta index c60ae90d6..9edb4130a 100644 --- a/physics/rrtmgp_sw_cloud_optics.meta +++ b/physics/rrtmgp_sw_cloud_optics.meta @@ -1,14 +1,30 @@ [ccpp-arg-table] name = rrtmgp_sw_cloud_optics_init type = scheme -[cld_optics_scheme] - standard_name = rrtmgp_cloud_optics_flag - long_name = Flag to control which RRTMGP cloud-optics scheme +[doG_cldoptics] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMG + long_name = logical flag to control cloud optics scheme. units = flag - dimensions = () - type = integer + dimensions = () + type = logical intent = in - optional = F + optional = F +[doGP_cldoptics_PADE] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in + optional = F +[doGP_cldoptics_LUT] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_LUT + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in + optional = F [nrghice] standard_name = number_of_rrtmgp_ice_roughness long_name = number of ice-roughness categories in RRTMGP calculation @@ -113,14 +129,30 @@ type = integer intent = in optional = F -[cld_optics_scheme] - standard_name = rrtmgp_cloud_optics_flag - long_name = Flag to control which RRTMGP cloud-optics scheme +[doG_cldoptics] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMG + long_name = logical flag to control cloud optics scheme. units = flag - dimensions = () - type = integer + dimensions = () + type = logical intent = in - optional = F + optional = F +[doGP_cldoptics_PADE] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in + optional = F +[doGP_cldoptics_LUT] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_LUT + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in + optional = F [nrghice] standard_name = number_of_rrtmgp_ice_roughness long_name = number of ice-roughness categories in RRTMGP calculation @@ -210,6 +242,15 @@ kind = kind_phys intent = in optional = F +[precip_frac] + standard_name = precipitation_fraction_by_layer + long_name = precipitation fraction in each layer + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [sw_cloud_props] standard_name = coefficients_for_sw_cloud_optics long_name = DDT containing spectral information for cloudy RRTMGP SW radiation scheme @@ -250,6 +291,14 @@ type = ty_optical_props_2str intent = out optional = F +[sw_optical_props_precipByBand] + standard_name = shortwave_optical_properties_for_precipitation_by_band + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + intent = out + optional = F [cldtausw] standard_name = RRTMGP_cloud_optical_depth_layers_at_0_55mu_band long_name = approx .55mu band layer cloud optical depth diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index 45d0fad67..0a0511bc2 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -3,7 +3,8 @@ module rrtmgp_sw_cloud_sampling use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use physparam, only: isubcsw, iovrsw use mo_optical_props, only: ty_optical_props_2str - use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_ran, draw_samples + use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_dcorr, & + sampled_mask_exp_ran, draw_samples use mersenne_twister, only: random_setseed, random_number, random_stat use rrtmgp_aux, only: check_error_msg use netcdf @@ -11,9 +12,8 @@ module rrtmgp_sw_cloud_sampling implicit none contains - ! ######################################################################################### - ! SUBROUTINE mcica_init + ! SUBROUTINE rrtmgp_sw_cloud_sampling_init() ! ######################################################################################### !! \section arg_table_rrtmgp_sw_cloud_sampling_init !! \htmlinclude rrtmgp_sw_cloud_sampling.html @@ -26,17 +26,17 @@ subroutine rrtmgp_sw_cloud_sampling_init(sw_gas_props, ipsdsw0, errmsg, errflg) integer, intent(out) :: & ipsdsw0 ! Initial permutation seed for McICA character(len=*), intent(out) :: & - errmsg ! Error message + errmsg ! Error message integer, intent(out) :: & - errflg ! Error code + errflg ! Error flag ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + ! Set initial permutation seed for McICA, initially set to number of G-points ipsdsw0 = sw_gas_props%get_ngpt() - + end subroutine rrtmgp_sw_cloud_sampling_init ! ######################################################################################### @@ -46,92 +46,238 @@ end subroutine rrtmgp_sw_cloud_sampling_init !! \htmlinclude rrtmgp_sw_cloud_sampling.html !! subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxday, & - icseed_sw, cld_frac, sw_gas_props, sw_optical_props_cloudsByBand, & - sw_optical_props_clouds, errmsg, errflg) + icseed_sw, cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, & + sw_gas_props, sw_optical_props_cloudsByBand, sw_optical_props_precipByBand, & + sw_optical_props_clouds, sw_optical_props_precip, errmsg, errflg) ! Inputs logical, intent(in) :: & - doSWrad ! Logical flag for shortwave radiation call + doSWrad ! Logical flag for shortwave radiation call integer, intent(in) :: & - nCol, & ! Number of horizontal gridpoints - nDay, & ! Number of daylit points. - nLev, & ! Number of vertical layers - ipsdsw0 ! Initial permutation seed for McICA + nCol, & ! Number of horizontal gridpoints + nDay, & ! Number of daylit points. + nLev, & ! Number of vertical layers + ipsdsw0 ! Initial permutation seed for McICA integer,intent(in),dimension(ncol) :: & - idxday ! Indices for daylit points. + idxday ! Indices for daylit points. integer,intent(in),dimension(ncol) :: & - icseed_sw ! auxiliary special cloud related array when module - ! variable isubcsw=2, it provides permutation seed - ! for each column profile that are used for generating - ! random numbers. when isubcsw /=2, it will not be used. + icseed_sw ! auxiliary special cloud related array when module + ! variable isubcsw=2, it provides permutation seed + ! for each column profile that are used for generating + ! random numbers. when isubcsw /=2, it will not be used. real(kind_phys), dimension(ncol,nLev),intent(in) :: & - cld_frac ! Total cloud fraction by layer + cld_frac, & ! Total cloud fraction by layer + precip_frac ! Precipitation fraction by layer + real(kind_phys), dimension(ncol,nLev), intent(in) :: & + cloud_overlap_param, & ! Cloud overlap parameter + precip_overlap_param ! Precipitation overlap parameter type(ty_gas_optics_rrtmgp),intent(in) :: & - sw_gas_props ! RRTMGP DDT: K-distribution data + sw_gas_props ! RRTMGP DDT: K-distribution data type(ty_optical_props_2str),intent(in) :: & - sw_optical_props_cloudsByBand ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) + 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) ! Outputs character(len=*), intent(out) :: & - errmsg ! Error message + errmsg ! Error message integer, intent(out) :: & - errflg ! Error code + errflg ! Error flag type(ty_optical_props_2str),intent(out) :: & - sw_optical_props_clouds ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) + sw_optical_props_clouds, & ! RRTMGP DDT: Shortwave optical properties at each spectral point (clouds) + sw_optical_props_precip ! RRTMGP DDT: Shortwave optical properties at each spectral point (precipitation) ! Local variables - integer :: iCol - integer,dimension(ncol) :: ipseed_sw + integer :: iday,iLay,iGpt + integer,dimension(nday) :: ipseed_sw type(random_stat) :: rng_stat - real(kind_phys), dimension(sw_gas_props%get_ngpt(),nLev,ncol) :: rng3D + real(kind_phys) :: tauloc,asyloc,ssaloc + real(kind_phys), dimension(sw_gas_props%get_ngpt(),nLev,nday) :: rng3D,rng3D2 real(kind_phys), dimension(sw_gas_props%get_ngpt()*nLev) :: rng1D - logical, dimension(ncol,nLev,sw_gas_props%get_ngpt()) :: cldfracMCICA - real(kind_phys), dimension(ncol,nLev) :: cld_frac_noSamp + logical, dimension(nday,nLev,sw_gas_props%get_ngpt()) :: cldfracMCICA,precipfracSAMP ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + + ! Only works w/ SDFs v15p2 and v16beta + if (iovrsw .ne. 1 .and. iovrsw .ne. 3 .and. iovrsw .ne. 4 .and. iovrsw .ne. 5) then + errmsg = 'Cloud overlap assumption not supported.' + errflg = 1 + call check_error_msg('rrtmgp_sw_cloud_sampling',errmsg) + return + endif + if (.not. doSWrad) return if (nDay .gt. 0) then - + ! ################################################################################# + ! First sample the clouds... + ! ################################################################################# + ! 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)) + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + sw_optical_props_clouds%alloc_2str(nday, nLev, sw_gas_props)) ! Change random number seed value for each radiation invocation (isubcsw =1 or 2). if(isubcsw == 1) then ! advance prescribed permutation seed - do iCol = 1, ncol - ipseed_sw(iCol) = ipsdsw0 + iCol + do iday = 1, nday + ipseed_sw(iday) = ipsdsw0 + iday enddo elseif (isubcsw == 2) then ! use input array of permutaion seeds - do iCol = 1, ncol - ipseed_sw(iCol) = icseed_sw(iCol) + do iday = 1, nday + ipseed_sw(iday) = icseed_sw(iday) enddo endif - ! Call McICA to generate subcolumns. ! Call RNG. Mersennse Twister accepts 1D array, so loop over columns and collapse along G-points - ! and layers. ([nGpts,nLev,nColumn]-> [nGpts*nLev]*nColumn) - do iCol=1,ncol - call random_setseed(ipseed_sw(icol),rng_stat) + ! and layers. ([nGpts,nLev,nDayumn]-> [nGpts*nLev]*nDayumn) + do iday=1,nday + call random_setseed(ipseed_sw(iday),rng_stat) call random_number(rng1D,rng_stat) - rng3D(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) + rng3D(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) enddo + + ! Cloud overlap. + select case ( iovrsw ) + case(1) ! Maximum-random overlap + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + sampled_mask_max_ran(rng3D, & + cld_frac(idxday(1:nDay),:), & + cldfracMCICA)) + case(3) ! Decorrelation-length overlap + 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 check_error_msg('rrtmgp_sw_cloud_sampling_run', & + sampled_mask_exp_dcorr(rng3D, & + rng3D2, & + cld_frac(idxday(1:nDay),:), & + cloud_overlap_param(idxday(1:nDay),1:nLev-1), & + cldfracMCICA)) + case(4) ! Exponential overlap + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + sampled_mask_exp_ran(rng3D, & + cld_frac(idxday(1:nDay),:), & + cloud_overlap_param(idxday(1:nDay),1:nLev-1), & + cldfracMCICA)) + case(5) ! Exponential-random overlap + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + sampled_mask_exp_ran(rng3D, & + cld_frac(idxday(1:nDay),:), & + cloud_overlap_param(idxday(1:nDay),1:nLev-1), & + cldfracMCICA)) + end select - ! Call McICA + ! Sampling. Map band optical depth to each g-point using McICA + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + draw_samples(cldfracMCICA, & + sw_optical_props_cloudsByBand, & + sw_optical_props_clouds)) + + ! ################################################################################# + ! Next sample precipitation (same as clouds for now) + ! ################################################################################# + + ! 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 (isubcsw =1 or 2). + if(isubcsw == 1) then ! advance prescribed permutation seed + do iday = 1, nday + ipseed_sw(iday) = ipsdsw0 + iday + enddo + elseif (isubcsw == 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 select case ( iovrsw ) - ! Maximumn-random - case(1) - call check_error_msg('rrtmgp_sw_cloud_sampling_run',sampled_mask_max_ran(rng3D,cld_frac,cldfracMCICA)) + case(1) ! Maximum-random + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + sampled_mask_max_ran(rng3D, & + precip_frac(idxday(1:nDay),:), & + precipfracSAMP)) + case(3) ! Exponential-random + !! 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 check_error_msg('rrtmgp_sw_cloud_sampling_run', & + sampled_mask_exp_dcorr(rng3D, & + rng3D2, & + precip_frac(idxday(1:nDay),:), & + precip_overlap_param(idxday(1:nDay),1:nLev-1), & + precipfracSAMP)) + case(4) ! Exponential overlap + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + sampled_mask_exp_ran(rng3D, & + precip_frac(idxday(1:nDay),:), & + precip_overlap_param(idxday(1:nDay),1:nLev-1), & + precipfracSAMP)) + case(5) ! Exponential-random overlap + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + sampled_mask_exp_ran(rng3D, & + precip_frac(idxday(1:nDay),:), & + precip_overlap_param(idxday(1:nDay),1:nLev-1), & + precipfracSAMP)) end select ! Map band optical depth to each g-point using McICA - call check_error_msg('rrtmgp_sw_cloud_sampling_run',draw_samples(& - cldfracMCICA(idxday(1:nDay),:,:),sw_optical_props_cloudsByBand,sw_optical_props_clouds)) - + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + draw_samples(precipfracSAMP, & + sw_optical_props_precipByBand, & + sw_optical_props_precip)) endif - + + ! #################################################################################### + ! Just add precipitation optics to cloud-optics + ! #################################################################################### + do iGpt=1,sw_gas_props%get_ngpt() + do iday=1,nDay + do iLay=1,nLev + tauloc = sw_optical_props_clouds%tau(iday,iLay,iGpt) + & + sw_optical_props_precip%tau(iday,iLay,iGpt) + if (sw_optical_props_precip%tau(iday,iLay,iGpt) > 0) then + ssaloc = (sw_optical_props_clouds%tau(iday,iLay,iGpt) * & + sw_optical_props_clouds%ssa(iday,iLay,iGpt) + & + sw_optical_props_precip%tau(iday,iLay,iGpt) * & + sw_optical_props_precip%ssa(iday,iLay,iGpt)) / & + tauloc + if (ssaloc > 0) then + asyloc = (sw_optical_props_clouds%tau(iday,iLay,iGpt) * & + sw_optical_props_clouds%ssa(iday,iLay,iGpt) * & + sw_optical_props_clouds%g(iday,iLay,iGpt) + & + sw_optical_props_precip%tau(iday,iLay,iGpt) * & + sw_optical_props_precip%ssa(iday,iLay,iGpt) * & + sw_optical_props_precip%g(iday,iLay,iGpt)) / & + (tauloc*ssaloc) + else + tauloc = sw_optical_props_clouds%tau(iday,iLay,iGpt) + ssaloc = sw_optical_props_clouds%ssa(iday,iLay,iGpt) + asyloc = sw_optical_props_clouds%g(iday,iLay,iGpt) + endif + sw_optical_props_clouds%tau(iday,iLay,iGpt) = tauloc + sw_optical_props_clouds%ssa(iday,iLay,iGpt) = ssaloc + sw_optical_props_clouds%g(iday,iLay,iGpt) = asyloc + endif + enddo + enddo + enddo end subroutine rrtmgp_sw_cloud_sampling_run ! ######################################################################################### diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta index c30d4934d..7ce6a708d 100644 --- a/physics/rrtmgp_sw_cloud_sampling.meta +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -104,6 +104,33 @@ kind = kind_phys intent = in optional = F +[precip_frac] + standard_name = precipitation_fraction_by_layer + long_name = precipitation fraction in each layer + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cloud_overlap_param] + standard_name = cloud_overlap_param + long_name = cloud overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[precip_overlap_param] + standard_name = precip_overlap_param + long_name = precipitation overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [sw_gas_props] standard_name = coefficients_for_sw_gas_optics long_name = DDT containing spectral information for RRTMGP SW radiation scheme @@ -120,6 +147,14 @@ type = ty_optical_props_2str intent = in optional = F +[sw_optical_props_precipByBand] + standard_name = shortwave_optical_properties_for_precipitation_by_band + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + intent = in + optional = F [sw_optical_props_clouds] standard_name = shortwave_optical_properties_for_cloudy_atmosphere long_name = Fortran DDT containing RRTMGP optical properties @@ -128,6 +163,14 @@ type = ty_optical_props_2str intent = out optional = F +[sw_optical_props_precip] + standard_name = shortwave_optical_properties_for_precipitation + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + intent = out + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index 7945f43fe..efe611e0c 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -60,14 +60,18 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp real(kind_phys) :: & press_ref_trop, & ! Reference pressure separating the lower and upper atmosphere [Pa] temp_ref_p, & ! Standard spectroscopic reference pressure [Pa] - temp_ref_t ! Standard spectroscopic reference temperature [K] + temp_ref_t, & ! Standard spectroscopic reference temperature [K] + tsi_default, & ! + mg_default, & ! + sb_default ! real(kind_phys), dimension(:), allocatable :: & press_ref, & ! Pressures for reference atmosphere; press_ref(# reference layers) [Pa] temp_ref, & ! Temperatures for reference atmosphere; temp_ref(# reference layers) [K] - solar_source ! Stored solar source function from original RRTM + solar_quiet, & ! + solar_facular, & ! + solar_sunspot ! real(kind_phys), dimension(:,:), allocatable :: & band_lims ! Beginning and ending wavenumber [cm -1] for each band - real(kind_phys), dimension(:,:,:), allocatable :: & vmr_ref, & ! Volume mixing ratios for reference atmosphere kminor_lower, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to @@ -113,7 +117,7 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp ! Read dimensions for k-distribution fields (only on master processor(0)) ! if (mpirank .eq. mpiroot) then ! Open file - status = nf90_open(trim(sw_gas_props_file), NF90_WRITE, ncid) + status = nf90_open(trim(sw_gas_props_file), NF90_NOWRITE, ncid) ! Read dimensions for k-distribution fields status = nf90_inq_dimid(ncid, 'temperature', dimid) @@ -172,7 +176,9 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp allocate(scale_by_complement_upper(nminor_absorber_intervals_upper)) allocate(rayl_upper(ngpts, nmixingfracs, ntemps)) allocate(rayl_lower(ngpts, nmixingfracs, ntemps)) - allocate(solar_source(ngpts)) + allocate(solar_quiet(ngpts)) + allocate(solar_facular(ngpts)) + allocate(solar_sunspot(ngpts)) allocate(temp1(nminor_absorber_intervals_lower)) allocate(temp2(nminor_absorber_intervals_upper)) allocate(temp3(nminor_absorber_intervals_lower)) @@ -211,7 +217,13 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_P', varID) status = nf90_get_var( ncid, varID, temp_ref_p) status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_T', varID) - status = nf90_get_var( ncid, varID, temp_ref_t) + status = nf90_get_var( ncid, varID, temp_ref_t) + status = nf90_inq_varid(ncid, 'tsi_default', varID) + status = nf90_get_var( ncid, varID, tsi_default) + status = nf90_inq_varid(ncid, 'mg_default', varID) + status = nf90_get_var( ncid, varID, mg_default) + status = nf90_inq_varid(ncid, 'sb_default', varID) + status = nf90_get_var( ncid, varID, sb_default) status = nf90_inq_varid(ncid, 'press_ref_trop', varID) status = nf90_get_var( ncid, varID, press_ref_trop) status = nf90_inq_varid(ncid, 'kminor_lower', varID) @@ -226,8 +238,12 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp status = nf90_get_var( ncid, varID, kminor_start_lower) status = nf90_inq_varid(ncid, 'kminor_start_upper', varID) status = nf90_get_var( ncid, varID, kminor_start_upper) - status = nf90_inq_varid(ncid, 'solar_source', varID) - status = nf90_get_var( ncid, varID, solar_source) + status = nf90_inq_varid(ncid, 'solar_source_quiet', varID) + status = nf90_get_var( ncid, varID, solar_quiet) + status = nf90_inq_varid(ncid, 'solar_source_facular', varID) + status = nf90_get_var( ncid, varID, solar_facular) + status = nf90_inq_varid(ncid, 'solar_source_sunspot', varID) + status = nf90_get_var( ncid, varID, solar_sunspot) status = nf90_inq_varid(ncid, 'rayl_lower', varID) status = nf90_get_var( ncid, varID, rayl_lower) status = nf90_inq_varid(ncid, 'rayl_upper', varID) @@ -264,7 +280,8 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp minor_gases_lower, minor_gases_upper, minor_limits_gpt_lower,minor_limits_gpt_upper, & minor_scales_with_density_lower, minor_scales_with_density_upper, scaling_gas_lower, & scaling_gas_upper, scale_by_complement_lower, scale_by_complement_upper, & - kminor_start_lower, kminor_start_upper, solar_source, rayl_lower, rayl_upper)) + kminor_start_lower, kminor_start_upper, solar_quiet, solar_facular, solar_sunspot, & + tsi_default, mg_default, sb_default, rayl_lower, rayl_upper)) end subroutine rrtmgp_sw_gas_optics_init diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90 index 98f95a1bd..9719c6e86 100644 --- a/physics/rrtmgp_sw_rte.F90 +++ b/physics/rrtmgp_sw_rte.F90 @@ -28,15 +28,16 @@ end subroutine rrtmgp_sw_rte_init !! \section arg_table_rrtmgp_sw_rte_run !! \htmlinclude rrtmgp_sw_rte.html !! - subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t_lay, & - p_lev, sw_gas_props, sw_optical_props_clrsky, sfc_alb_nir_dir, sfc_alb_nir_dif, & + subroutine rrtmgp_sw_rte_run(doSWrad, doSWclrsky, nCol, nLev, nDay, idxday, coszen, p_lay, & + t_lay, p_lev, sw_gas_props, sw_optical_props_clrsky, sfc_alb_nir_dir, sfc_alb_nir_dif,& sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, toa_src_sw, sw_optical_props_clouds, & sw_optical_props_aerosol, rrtmgp_nGases, active_gases_array, scmpsw, fluxswUP_allsky, & - fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, hswb, errmsg, errflg) + fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, errmsg, errflg) ! Inputs logical, intent(in) :: & - doSWrad ! Flag to calculate SW irradiances + doSWrad, & ! Flag to calculate SW irradiances + doSWclrsky ! Compute clear-sky fluxes? integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nday, & ! Number of daytime points @@ -69,10 +70,6 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t character(len=*),dimension(rrtmgp_nGases), intent(in) :: & active_gases_array ! Character array containing trace gases to include in RRTMGP - ! Inputs (optional) (NOTE. We only need the optional arguments to know what fluxes to output, HR's are computed later) - real(kind_phys), dimension(ncol,NLev,sw_gas_props%get_nband()), intent(inout), optional :: & - hswb ! All-sky heating rate, by band (K/sec) - ! Outputs character(len=*), intent(out) :: & errmsg ! CCPP error message @@ -103,7 +100,7 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t real(kind_phys), dimension(nday,NLev+1,sw_gas_props%get_nband()),target :: & fluxSW_up_allsky, fluxSW_up_clrsky, fluxSW_dn_allsky, fluxSW_dn_clrsky, fluxSW_dn_dir_allsky real(kind_phys), dimension(ncol,NLev) :: vmrTemp - logical :: l_AllSky_HR_byband=.false., l_scmpsw=.false., top_at_1 + logical :: l_scmpsw=.false., top_at_1 integer :: iGas,iSFC,iTOA,iBand ! Initialize CCPP error handling variables @@ -131,7 +128,6 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t endif ! Are any optional outputs requested? Need to know now to compute correct fluxes. - l_AllSky_HR_byband = present(hswb) l_scmpsw = present(scmpsw) if ( l_scmpsw ) then scmpsw = cmpfsw_type (0., 0., 0., 0., 0., 0.) @@ -170,18 +166,20 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_aerosol%increment(sw_optical_props_clrsky)) ! Delta-scale optical properties call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_clrsky%delta_scale()) - call check_error_msg('rrtmgp_sw_rte_run',rte_sw( & - sw_optical_props_clrsky, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - coszen(idxday(1:nday)), & ! IN - Cosine of solar zenith angle - toa_src_sw(idxday(1:nday),:), & ! IN - incident solar flux at TOA - sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) - sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) - flux_clrsky)) ! OUT - Fluxes, clear-sky, 3D (nCol,NLev,nBand) - ! Store fluxes - fluxswUP_clrsky(idxday(1:nday),:) = sum(flux_clrsky%bnd_flux_up,dim=3) - fluxswDOWN_clrsky(idxday(1:nday),:) = sum(flux_clrsky%bnd_flux_dn,dim=3) - + if (doSWclrsky) then + call check_error_msg('rrtmgp_sw_rte_run',rte_sw( & + sw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + coszen(idxday(1:nday)), & ! IN - Cosine of solar zenith angle + toa_src_sw(idxday(1:nday),:), & ! IN - incident solar flux at TOA + sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) + sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) + flux_clrsky)) ! OUT - Fluxes, clear-sky, 3D (nCol,NLev,nBand) + ! Store fluxes + fluxswUP_clrsky(idxday(1:nday),:) = sum(flux_clrsky%bnd_flux_up,dim=3) + fluxswDOWN_clrsky(idxday(1:nday),:) = sum(flux_clrsky%bnd_flux_dn,dim=3) + endif + ! Compute all-sky fluxes ! All-sky fluxes (clear-sky + clouds) call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_clouds%increment(sw_optical_props_clrsky)) diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta index 629ede530..6f0be98c5 100644 --- a/physics/rrtmgp_sw_rte.meta +++ b/physics/rrtmgp_sw_rte.meta @@ -9,6 +9,14 @@ type = logical intent = in optional = F +[doSWclrsky] + standard_name = flag_for_output_of_shortwave_heating_rate + long_name = flag to output sw heating rate (Radtend%swhc) + units = flag + dimensions = () + type = logical + intent = in + optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -215,15 +223,6 @@ kind = kind_phys intent = inout optional = F -[hswb] - standard_name = RRTMGP_sw_heating_rate_spectral - long_name = shortwave total sky heating rate (spectral) - units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_sw_spectral_points_rrtmgp) - type = real - kind = kind_phys - intent = inout - optional = T [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 7dfff2025..6ee0b62c1 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 7dfff2025cae02c84b12df2402a39d77065f0e62 +Subproject commit 6ee0b62c1ac6204a89a4e922382b611c16dd5fa7