diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 75c27fcc7..77be662fa 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -313,8 +313,8 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqdt, dusfc_cpl, dvsfc_cpl, dtsfc_cpl, & dqsfc_cpl, dusfci_cpl, dvsfci_cpl, dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, & dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag, dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, dq3dt, & - dq3dt_ozone, rd, cp,fvirt, hvap, t1, q1, prsl, hflx, ushfsfci, oceanfrac, fice, dusfc_cice, dvsfc_cice, dtsfc_cice, & - dqsfc_cice, wet, dry, icy, wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1, dkt_cpl, dkt, hffac, hefac, & + dq3dt_ozone, rd, cp, fvirt, hvap, t1, q1, prsl, hflx, ushfsfci, oceanfrac, flag_cice, dusfc_cice, dvsfc_cice, & + dtsfc_cice, dqsfc_cice, wet, dry, icy, wind, stress_wat, hflx_wat, evap_wat, ugrs1, vgrs1, dkt_cpl, dkt, hffac, hefac, & ugrs, vgrs, tgrs, qgrs, save_u, save_v, save_t, save_q, errmsg, errflg) use machine, only : kind_phys @@ -329,17 +329,18 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires logical, intent(in) :: ltaerosol, cplflx, cplchm, lssav, ldiag3d, qdiag3d, lsidea logical, intent(in) :: hybedmf, do_shoc, satmedmf, shinhong, do_ysu - logical, intent(in) :: flag_for_pbl_generic_tend - + logical, dimension(:), intent(in) :: flag_cice + + logical, intent(in) :: flag_for_pbl_generic_tend real(kind=kind_phys), dimension(im, levs), intent(in) :: save_u, save_v, save_t real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: save_q real(kind=kind_phys), intent(in) :: dtf real(kind=kind_phys), intent(in) :: rd, cp, fvirt, hvap - real(kind=kind_phys), dimension(:), intent(in) :: t1, q1, hflx, oceanfrac, fice + real(kind=kind_phys), dimension(:), intent(in) :: t1, q1, hflx, oceanfrac real(kind=kind_phys), dimension(:,:), intent(in) :: prsl real(kind=kind_phys), dimension(:), intent(in) :: dusfc_cice, dvsfc_cice, dtsfc_cice, dqsfc_cice, & - wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1 + wind, stress_wat, hflx_wat, evap_wat, ugrs1, vgrs1 real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: qgrs real(kind=kind_phys), dimension(im, levs), intent(in) :: ugrs, vgrs, tgrs @@ -373,7 +374,6 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, real(kind=kind_phys), parameter :: zero = 0.0d0 real(kind=kind_phys), parameter :: one = 1.0d0 real(kind=kind_phys), parameter :: huge = 9.9692099683868690E36 ! NetCDF float FillValue, same as in GFS_typedefs.F90 - real(kind=kind_phys), parameter :: epsln = 1.0d-10 ! same as in GFS_physics_driver.F90 integer :: i, k, kk, k1, n real(kind=kind_phys) :: tem, tem1, rho @@ -381,7 +381,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, errmsg = '' errflg = 0 !GJF: dvdftra is only used if nvdiff != ntrac or (nvdiff == ntrac .and. ) - if_nvdiff_ntrac: if (nvdiff == ntrac .and. (hybedmf .or. do_shoc .or. satmedmf)) then + if (nvdiff == ntrac .and. (hybedmf .or. do_shoc .or. satmedmf)) then dqdt = dvdftra elseif (nvdiff /= ntrac .and. .not. shinhong .and. .not. do_ysu) then ! @@ -393,7 +393,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, enddo endif ! - if_trans_aero: if (trans_aero) then + if (trans_aero) then ! Set kk if chemistry-aerosol tracers are diffused call set_aerosol_tracer_index(imp_physics, imp_physics_wsm6, & imp_physics_thompson, ltaerosol, & @@ -411,9 +411,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, enddo enddo enddo - endif if_trans_aero + endif ! - if_imp_physics: if (imp_physics == imp_physics_wsm6) then + if (imp_physics == imp_physics_wsm6) then ! WSM6 do k=1,levs do i=1,im @@ -525,9 +525,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqdt(i,k,ntoz) = dvdftra(i,k,3) enddo enddo - endif if_imp_physics + endif - endif if_nvdiff_ntrac + endif ! nvdiff == ntrac if (cplchm) then do i = 1, im @@ -542,27 +542,34 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ! --- ... coupling insertion - if_cplflx: if (cplflx) then + if (cplflx) then do i=1,im if (oceanfrac(i) > zero) then ! Ocean only, NO LAKES - if (fice(i) > one - epsln) then ! no open water, use results from CICE - dusfci_cpl(i) = dusfc_cice(i) - dvsfci_cpl(i) = dvsfc_cice(i) - dtsfci_cpl(i) = dtsfc_cice(i) - dqsfci_cpl(i) = dqsfc_cice(i) + if ( .not. wet(i)) then ! no open water + if (flag_cice(i)) then !use results from CICE + dusfci_cpl(i) = dusfc_cice(i) + dvsfci_cpl(i) = dvsfc_cice(i) + dtsfci_cpl(i) = dtsfc_cice(i) + dqsfci_cpl(i) = dqsfc_cice(i) + else !use PBL fluxes when CICE fluxes is unavailable + dusfci_cpl(i) = dusfc1(i) + dvsfci_cpl(i) = dvsfc1(i) + dtsfci_cpl(i) = dtsfc1(i) + dqsfci_cpl(i) = dqsfc1(i) + end if elseif (icy(i) .or. dry(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point tem1 = max(q1(i), 1.e-8) rho = prsl(i,1) / (rd*t1(i)*(one+fvirt*tem1)) if (wind(i) > zero) then - tem = - rho * stress_ocn(i) / wind(i) + tem = - rho * stress_wat(i) / wind(i) dusfci_cpl(i) = tem * ugrs1(i) ! U-momentum flux dvsfci_cpl(i) = tem * vgrs1(i) ! V-momentum flux else dusfci_cpl(i) = zero dvsfci_cpl(i) = zero endif - dtsfci_cpl(i) = cp * rho * hflx_ocn(i) ! sensible heat flux over open ocean - dqsfci_cpl(i) = hvap * rho * evap_ocn(i) ! latent heat flux over open ocean + dtsfci_cpl(i) = cp * rho * hflx_wat(i) ! sensible heat flux over open ocean + dqsfci_cpl(i) = hvap * rho * evap_wat(i) ! latent heat flux over open ocean else ! use results from PBL scheme for 100% open ocean dusfci_cpl(i) = dusfc1(i) dvsfci_cpl(i) = dvsfc1(i) @@ -583,10 +590,10 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, !! endif ! Ocean only, NO LAKES enddo - endif if_cplflx + endif !-------------------------------------------------------lssav if loop ---------- - if_lssav: if (lssav) then + if (lssav) then do i=1,im dusfc_diag (i) = dusfc_diag(i) + dusfc1(i)*dtf dvsfc_diag (i) = dvsfc_diag(i) + dvsfc1(i)*dtf @@ -598,7 +605,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqsfci_diag(i) = dqsfc1(i)*hefac(i) enddo - if_diag: if (ldiag3d .and. flag_for_pbl_generic_tend .and. lssav) then + if (ldiag3d .and. flag_for_pbl_generic_tend .and. lssav) then if (lsidea) then dt3dt(1:im,:) = dt3dt(1:im,:) + dtdt(1:im,:)*dtf else @@ -622,9 +629,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, enddo enddo endif - endif if_diag - - endif if_lssav + endif + + endif ! end if_lssav end subroutine GFS_PBL_generic_post_run diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 9a130831c..1e08e3ef0 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -1166,13 +1166,12 @@ kind = kind_phys intent = in optional = F -[fice] - standard_name = sea_ice_concentration - long_name = ice fraction over open water - units = frac +[flag_cice] + standard_name = flag_for_cice + long_name = flag for cice + units = flag dimensions = (horizontal_dimension) - type = real - kind = kind_phys + type = logical intent = in optional = F [dusfc_cice] @@ -1244,7 +1243,7 @@ kind = kind_phys intent = in optional = F -[stress_ocn] +[stress_wat] standard_name = surface_wind_stress_over_ocean long_name = surface wind stress over ocean units = m2 s-2 @@ -1253,7 +1252,7 @@ kind = kind_phys intent = in optional = F -[hflx_ocn] +[hflx_wat] standard_name = kinematic_surface_upward_sensible_heat_flux_over_ocean long_name = kinematic surface upward sensible heat flux over ocean units = K m s-1 @@ -1262,7 +1261,7 @@ kind = kind_phys intent = in optional = F -[evap_ocn] +[evap_wat] standard_name = kinematic_surface_upward_latent_heat_flux_over_ocean long_name = kinematic surface upward latent heat flux over ocean units = kg kg-1 m s-1 diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index cfd190b26..d1e42f162 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -18,6 +18,7 @@ module GFS_diagtoscreen interface print_var module procedure print_logic_0d + module procedure print_logic_1d module procedure print_int_0d module procedure print_int_1d module procedure print_real_0d @@ -116,6 +117,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, do impi=0,mpisize-1 do iomp=0,ompsize-1 if (mpirank==impi .and. omprank==iomp) then + call print_var(mpirank,omprank, blkno, 'Model%kdt' , Model%kdt) ! Sfcprop call print_var(mpirank,omprank, blkno, 'Sfcprop%slmsk' , Sfcprop%slmsk) call print_var(mpirank,omprank, blkno, 'Sfcprop%oceanfrac', Sfcprop%oceanfrac) @@ -560,6 +562,30 @@ subroutine print_int_0d(mpirank,omprank,blkno,name,var) end subroutine print_int_0d + subroutine print_logic_1d(mpirank,omprank,blkno,name,var) + + use machine, only: kind_phys + + implicit none + + integer, intent(in) :: mpirank, omprank, blkno + character(len=*), intent(in) :: name + logical, intent(in) :: var(:) + + integer :: i + +#ifdef PRINT_SUM + write(0,'(2a,3i6,2i8)') 'XXX: ', trim(name), mpirank, omprank, blkno, size(var), count(var) +#elif defined(PRINT_CHKSUM) + write(0,'(2a,3i6,2i8)') 'XXX: ', trim(name), mpirank, omprank, blkno, size(var), count(var) +#else + do i=ISTART,min(IEND,size(var(:))) + write(0,'(2a,3i6,i6,1x,l)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, var(i) + end do +#endif + + end subroutine print_logic_1d + subroutine print_int_1d(mpirank,omprank,blkno,name,var) use machine, only: kind_phys diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 466bcbb19..694487704 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -160,7 +160,7 @@ end subroutine GFS_suite_interstitial_2_finalize 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_ocn, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, & + 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) implicit none @@ -181,7 +181,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl 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_ocn + real(kind=kind_phys), intent(in ), dimension(im) :: adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat real(kind=kind_phys), intent( out), dimension(im) :: adjsfculw ! These arrays are only allocated if ldiag3d is .true. @@ -232,11 +232,11 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl if (flag_cice(i)) then adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & + ulwsfc_cice(i) * tem & - + adjsfculw_ocn(i) * (one - frland(i) - tem) + + adjsfculw_wat(i) * (one - frland(i) - tem) else adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & + adjsfculw_ice(i) * tem & - + adjsfculw_ocn(i) * (one - frland(i) - tem) + + adjsfculw_wat(i) * (one - frland(i) - tem) endif enddo else @@ -246,20 +246,20 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl elseif (icy(i)) then ! ice (and water) tem = one - cice(i) if (flag_cice(i)) then - if (wet(i) .and. adjsfculw_ocn(i) /= huge) then - adjsfculw(i) = ulwsfc_cice(i)*cice(i) + adjsfculw_ocn(i)*tem + 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_ocn(i) /= huge) then - adjsfculw(i) = adjsfculw_ice(i)*cice(i) + adjsfculw_ocn(i)*tem + 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_ocn(i) + adjsfculw(i) = adjsfculw_wat(i) endif enddo endif diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index d05d7335c..127de9c6e 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -604,7 +604,7 @@ kind = kind_phys intent = in optional = F -[adjsfculw_ocn] +[adjsfculw_wat] standard_name = surface_upwelling_longwave_flux_over_ocean_interstitial long_name = surface upwelling longwave flux at current time over ocean (temporary use as interstitial) units = W m-2 diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index c1ef98ab6..d5bc98322 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -26,13 +26,13 @@ end subroutine GFS_surface_composites_pre_finalize !! subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cplwav2atm, & landfrac, lakefrac, oceanfrac, & - frland, dry, icy, lake, ocean, wet, cice, cimin, zorl, zorlo, zorll, zorl_ocn, & - zorl_lnd, zorl_ice, snowd, snowd_ocn, snowd_lnd, snowd_ice, tprcp, tprcp_ocn, & - tprcp_lnd, tprcp_ice, uustar, uustar_ocn, uustar_lnd, uustar_ice, & - weasd, weasd_ocn, weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_ocn,& - tsfc_lnd, tsfc_ice, tisfc, tice, tsurf, tsurf_ocn, tsurf_lnd, tsurf_ice, & - gflx_ice, tgice, islmsk, semis_rad, semis_ocn, semis_lnd, semis_ice, & - qss, qss_ocn, qss_lnd, qss_ice, hflx, hflx_ocn, hflx_lnd, hflx_ice, & + frland, dry, icy, lake, ocean, wet, cice, cimin, zorl, zorlo, zorll, zorl_wat, & + zorl_lnd, zorl_ice, snowd, snowd_wat, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & + tprcp_lnd, tprcp_ice, uustar, uustar_wat, uustar_lnd, uustar_ice, & + weasd, weasd_wat, weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_wat,& + tsfc_lnd, tsfc_ice, tisfc, tice, tsurf, tsurf_wat, tsurf_lnd, tsurf_ice, & + gflx_ice, tgice, islmsk, semis_rad, semis_wat, semis_lnd, semis_ice, & + qss, qss_wat, qss_lnd, qss_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, & min_lakeice, min_seaice, errmsg, errflg) implicit none @@ -49,15 +49,15 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl real(kind=kind_phys), dimension(im), intent(in ) :: zorl, snowd, tprcp, uustar, weasd, qss, hflx real(kind=kind_phys), dimension(im), intent(inout) :: zorlo, zorll, tsfc, tsfco, tsfcl, tisfc, tsurf - real(kind=kind_phys), dimension(im), intent(inout) :: snowd_ocn, snowd_lnd, snowd_ice, tprcp_ocn, & - tprcp_lnd, tprcp_ice, zorl_ocn, zorl_lnd, zorl_ice, tsfc_ocn, tsfc_lnd, tsfc_ice, tsurf_ocn, & - tsurf_lnd, tsurf_ice, uustar_ocn, uustar_lnd, uustar_ice, weasd_ocn, weasd_lnd, weasd_ice, & - qss_ocn, qss_lnd, qss_ice, hflx_ocn, hflx_lnd, hflx_ice, ep1d_ice, gflx_ice + real(kind=kind_phys), dimension(im), intent(inout) :: snowd_wat, snowd_lnd, snowd_ice, tprcp_wat, & + tprcp_lnd, tprcp_ice, zorl_wat, zorl_lnd, zorl_ice, tsfc_wat, tsfc_lnd, tsfc_ice, tsurf_wat, & + tsurf_lnd, tsurf_ice, uustar_wat, uustar_lnd, uustar_ice, weasd_wat, weasd_lnd, weasd_ice, & + qss_wat, qss_lnd, qss_ice, hflx_wat, hflx_lnd, hflx_ice, ep1d_ice, gflx_ice real(kind=kind_phys), dimension(im), intent( out) :: tice real(kind=kind_phys), intent(in ) :: tgice integer, dimension(im), intent(in ) :: islmsk real(kind=kind_phys), dimension(im), intent(in ) :: semis_rad - real(kind=kind_phys), dimension(im), intent(inout) :: semis_ocn, semis_lnd, semis_ice + real(kind=kind_phys), dimension(im), intent(inout) :: semis_wat, semis_lnd, semis_ice real(kind=kind_phys), intent(in ) :: min_lakeice, min_seaice ! CCPP error handling @@ -140,21 +140,21 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl endif do i=1,im - tprcp_ocn(i) = tprcp(i) + tprcp_wat(i) = tprcp(i) tprcp_lnd(i) = tprcp(i) tprcp_ice(i) = tprcp(i) if (wet(i)) then ! Water - uustar_ocn(i) = uustar(i) - zorl_ocn(i) = zorlo(i) - tsfc_ocn(i) = tsfco(i) - tsurf_ocn(i) = tsfco(i) -! weasd_ocn(i) = weasd(i) -! snowd_ocn(i) = snowd(i) - weasd_ocn(i) = zero - snowd_ocn(i) = zero - semis_ocn(i) = 0.984d0 - qss_ocn(i) = qss(i) - hflx_ocn(i) = hflx(i) + uustar_wat(i) = uustar(i) + zorl_wat(i) = zorlo(i) + tsfc_wat(i) = tsfco(i) + tsurf_wat(i) = tsfco(i) +! weasd_wat(i) = weasd(i) +! snowd_wat(i) = snowd(i) + weasd_wat(i) = zero + snowd_wat(i) = zero + semis_wat(i) = 0.984d0 + qss_wat(i) = qss(i) + hflx_wat(i) = hflx(i) endif if (dry(i)) then ! Land uustar_lnd(i) = uustar(i) @@ -213,8 +213,8 @@ end subroutine GFS_surface_composites_inter_finalize !> \section arg_table_GFS_surface_composites_inter_run Argument Table !! \htmlinclude GFS_surface_composites_inter_run.html !! - subroutine GFS_surface_composites_inter_run (im, dry, icy, wet, semis_ocn, semis_lnd, semis_ice, adjsfcdlw, & - gabsbdlw_lnd, gabsbdlw_ice, gabsbdlw_ocn, & + subroutine GFS_surface_composites_inter_run (im, dry, icy, wet, semis_wat, semis_lnd, semis_ice, adjsfcdlw, & + gabsbdlw_lnd, gabsbdlw_ice, gabsbdlw_wat, & adjsfcusw, adjsfcdsw, adjsfcnsw, errmsg, errflg) implicit none @@ -222,9 +222,9 @@ subroutine GFS_surface_composites_inter_run (im, dry, icy, wet, semis_ocn, semis ! Interface variables integer, intent(in ) :: im logical, dimension(im), intent(in ) :: dry, icy, wet - real(kind=kind_phys), dimension(im), intent(in ) :: semis_ocn, semis_lnd, semis_ice, adjsfcdlw, & + real(kind=kind_phys), dimension(im), intent(in ) :: semis_wat, semis_lnd, semis_ice, adjsfcdlw, & adjsfcdsw, adjsfcnsw - real(kind=kind_phys), dimension(im), intent(inout) :: gabsbdlw_lnd, gabsbdlw_ice, gabsbdlw_ocn + real(kind=kind_phys), dimension(im), intent(inout) :: gabsbdlw_lnd, gabsbdlw_ice, gabsbdlw_wat real(kind=kind_phys), dimension(im), intent(out) :: adjsfcusw ! CCPP error handling @@ -259,7 +259,7 @@ subroutine GFS_surface_composites_inter_run (im, dry, icy, wet, semis_ocn, semis do i=1,im if (dry(i)) gabsbdlw_lnd(i) = semis_lnd(i) * adjsfcdlw(i) if (icy(i)) gabsbdlw_ice(i) = semis_ice(i) * adjsfcdlw(i) - if (wet(i)) gabsbdlw_ocn(i) = semis_ocn(i) * adjsfcdlw(i) + if (wet(i)) gabsbdlw_wat(i) = semis_wat(i) * adjsfcdlw(i) adjsfcusw(i) = adjsfcdsw(i) - adjsfcnsw(i) enddo @@ -294,29 +294,29 @@ end subroutine GFS_surface_composites_post_finalize !! #endif subroutine GFS_surface_composites_post_run ( & - im, cplflx, cplwav2atm, frac_grid, flag_cice, islmsk, dry, wet, icy, landfrac, lakefrac, oceanfrac, & - zorl, zorlo, zorll, zorl_ocn, zorl_lnd, zorl_ice, & - cd, cd_ocn, cd_lnd, cd_ice, cdq, cdq_ocn, cdq_lnd, cdq_ice, rb, rb_ocn, rb_lnd, rb_ice, stress, stress_ocn, stress_lnd, & - stress_ice, ffmm, ffmm_ocn, ffmm_lnd, ffmm_ice, ffhh, ffhh_ocn, ffhh_lnd, ffhh_ice, uustar, uustar_ocn, uustar_lnd, & - uustar_ice, fm10, fm10_ocn, fm10_lnd, fm10_ice, fh2, fh2_ocn, fh2_lnd, fh2_ice, tsurf, tsurf_ocn, tsurf_lnd, tsurf_ice, & - cmm, cmm_ocn, cmm_lnd, cmm_ice, chh, chh_ocn, chh_lnd, chh_ice, gflx, gflx_ocn, gflx_lnd, gflx_ice, ep1d, ep1d_ocn, & - ep1d_lnd, ep1d_ice, weasd, weasd_ocn, weasd_lnd, weasd_ice, snowd, snowd_ocn, snowd_lnd, snowd_ice, tprcp, tprcp_ocn, & - tprcp_lnd, tprcp_ice, evap, evap_ocn, evap_lnd, evap_ice, hflx, hflx_ocn, hflx_lnd, hflx_ice, qss, qss_ocn, qss_lnd, & - qss_ice, tsfc, tsfco, tsfcl, tsfc_ocn, tsfc_lnd, tsfc_ice, tisfc, tice, hice, cice, errmsg, errflg) + im, kice, km, cplflx, cplwav2atm, frac_grid, flag_cice, islmsk, dry, wet, icy, landfrac, lakefrac, oceanfrac, & + zorl, zorlo, zorll, zorl_wat, zorl_lnd, zorl_ice, & + cd, cd_wat, cd_lnd, cd_ice, cdq, cdq_wat, cdq_lnd, cdq_ice, rb, rb_wat, rb_lnd, rb_ice, stress, stress_wat, stress_lnd, & + stress_ice, ffmm, ffmm_wat, ffmm_lnd, ffmm_ice, ffhh, ffhh_wat, ffhh_lnd, ffhh_ice, uustar, uustar_wat, uustar_lnd, & + uustar_ice, fm10, fm10_wat, fm10_lnd, fm10_ice, fh2, fh2_wat, fh2_lnd, fh2_ice, tsurf, tsurf_wat, tsurf_lnd, tsurf_ice, & + cmm, cmm_wat, cmm_lnd, cmm_ice, chh, chh_wat, chh_lnd, chh_ice, gflx, gflx_wat, gflx_lnd, gflx_ice, ep1d, ep1d_wat, & + ep1d_lnd, ep1d_ice, weasd, weasd_wat, weasd_lnd, weasd_ice, snowd, snowd_wat, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & + tprcp_lnd, tprcp_ice, evap, evap_wat, evap_lnd, evap_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, qss, qss_wat, qss_lnd, & + qss_ice, tsfc, tsfco, tsfcl, tsfc_wat, tsfc_lnd, tsfc_ice, tisfc, tice, hice, cice, tiice, stc, errmsg, errflg) implicit none - integer, intent(in) :: im + integer, intent(in) :: im, kice, km logical, intent(in) :: cplflx, frac_grid, cplwav2atm logical, dimension(im), intent(in) :: flag_cice, dry, wet, icy integer, dimension(im), intent(in) :: islmsk real(kind=kind_phys), dimension(im), intent(in) :: landfrac, lakefrac, oceanfrac, & - zorl_ocn, zorl_lnd, zorl_ice, cd_ocn, cd_lnd, cd_ice, cdq_ocn, cdq_lnd, cdq_ice, rb_ocn, rb_lnd, rb_ice, stress_ocn, & - stress_lnd, stress_ice, ffmm_ocn, ffmm_lnd, ffmm_ice, ffhh_ocn, ffhh_lnd, ffhh_ice, uustar_ocn, uustar_lnd, uustar_ice, & - fm10_ocn, fm10_lnd, fm10_ice, fh2_ocn, fh2_lnd, fh2_ice, tsurf_ocn, tsurf_lnd, tsurf_ice, cmm_ocn, cmm_lnd, cmm_ice, & - chh_ocn, chh_lnd, chh_ice, gflx_ocn, gflx_lnd, gflx_ice, ep1d_ocn, ep1d_lnd, ep1d_ice, weasd_ocn, weasd_lnd, weasd_ice, & - snowd_ocn, snowd_lnd, snowd_ice,tprcp_ocn, tprcp_lnd, tprcp_ice, evap_ocn, evap_lnd, evap_ice, hflx_ocn, hflx_lnd, & - hflx_ice, qss_ocn, qss_lnd, qss_ice, tsfc_ocn, tsfc_lnd, tsfc_ice + zorl_wat, zorl_lnd, zorl_ice, cd_wat, cd_lnd, cd_ice, cdq_wat, cdq_lnd, cdq_ice, rb_wat, rb_lnd, rb_ice, stress_wat, & + stress_lnd, stress_ice, ffmm_wat, ffmm_lnd, ffmm_ice, ffhh_wat, ffhh_lnd, ffhh_ice, uustar_wat, uustar_lnd, uustar_ice, & + fm10_wat, fm10_lnd, fm10_ice, fh2_wat, fh2_lnd, fh2_ice, tsurf_wat, tsurf_lnd, tsurf_ice, cmm_wat, cmm_lnd, cmm_ice, & + chh_wat, chh_lnd, chh_ice, gflx_wat, gflx_lnd, gflx_ice, ep1d_wat, ep1d_lnd, ep1d_ice, weasd_wat, weasd_lnd, weasd_ice, & + snowd_wat, snowd_lnd, snowd_ice,tprcp_wat, tprcp_lnd, tprcp_ice, evap_wat, evap_lnd, evap_ice, hflx_wat, hflx_lnd, & + hflx_ice, qss_wat, qss_lnd, qss_ice, tsfc_wat, tsfc_lnd, tsfc_ice real(kind=kind_phys), dimension(im), intent(inout) :: zorl, zorlo, zorll, cd, cdq, rb, stress, ffmm, ffhh, uustar, fm10, & fh2, tsurf, cmm, chh, gflx, ep1d, weasd, snowd, tprcp, evap, hflx, qss, tsfc, tsfco, tsfcl, tisfc @@ -324,11 +324,14 @@ subroutine GFS_surface_composites_post_run ( real(kind=kind_phys), dimension(im), intent(in ) :: tice ! interstitial sea ice temperature real(kind=kind_phys), dimension(im), intent(inout) :: hice, cice + real(kind=kind_phys), dimension(im, kice), intent(in ) :: tiice + real(kind=kind_phys), dimension(im, km), intent(inout) :: stc + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables - integer :: i + integer :: i, k real(kind=kind_phys) :: txl, txi, txo, tem ! Initialize CCPP error handling variables @@ -346,27 +349,27 @@ subroutine GFS_surface_composites_post_run ( txi = cice(i)*(one - txl) ! txi = ice fraction wrt whole cell txo = max(zero, one - txl - txi) - zorl(i) = txl*zorl_lnd(i) + txi*zorl_ice(i) + txo*zorl_ocn(i) - cd(i) = txl*cd_lnd(i) + txi*cd_ice(i) + txo*cd_ocn(i) - cdq(i) = txl*cdq_lnd(i) + txi*cdq_ice(i) + txo*cdq_ocn(i) - rb(i) = txl*rb_lnd(i) + txi*rb_ice(i) + txo*rb_ocn(i) - stress(i) = txl*stress_lnd(i) + txi*stress_ice(i) + txo*stress_ocn(i) - ffmm(i) = txl*ffmm_lnd(i) + txi*ffmm_ice(i) + txo*ffmm_ocn(i) - ffhh(i) = txl*ffhh_lnd(i) + txi*ffhh_ice(i) + txo*ffhh_ocn(i) - uustar(i) = txl*uustar_lnd(i) + txi*uustar_ice(i) + txo*uustar_ocn(i) - fm10(i) = txl*fm10_lnd(i) + txi*fm10_ice(i) + txo*fm10_ocn(i) - fh2(i) = txl*fh2_lnd(i) + txi*fh2_ice(i) + txo*fh2_ocn(i) - !tsurf(i) = txl*tsurf_lnd(i) + txi*tice(i) + txo*tsurf_ocn(i) - !tsurf(i) = txl*tsurf_lnd(i) + txi*tsurf_ice(i) + txo*tsurf_ocn(i) ! not used again! Moorthi - cmm(i) = txl*cmm_lnd(i) + txi*cmm_ice(i) + txo*cmm_ocn(i) - chh(i) = txl*chh_lnd(i) + txi*chh_ice(i) + txo*chh_ocn(i) - !gflx(i) = txl*gflx_lnd(i) + txi*gflx_ice(i) + txo*gflx_ocn(i) - ep1d(i) = txl*ep1d_lnd(i) + txi*ep1d_ice(i) + txo*ep1d_ocn(i) - !weasd(i) = txl*weasd_lnd(i) + txi*weasd_ice(i) + txo*weasd_ocn(i) - !snowd(i) = txl*snowd_lnd(i) + txi*snowd_ice(i) + txo*snowd_ocn(i) + zorl(i) = txl*zorl_lnd(i) + txi*zorl_ice(i) + txo*zorl_wat(i) + cd(i) = txl*cd_lnd(i) + txi*cd_ice(i) + txo*cd_wat(i) + cdq(i) = txl*cdq_lnd(i) + txi*cdq_ice(i) + txo*cdq_wat(i) + rb(i) = txl*rb_lnd(i) + txi*rb_ice(i) + txo*rb_wat(i) + stress(i) = txl*stress_lnd(i) + txi*stress_ice(i) + txo*stress_wat(i) + ffmm(i) = txl*ffmm_lnd(i) + txi*ffmm_ice(i) + txo*ffmm_wat(i) + ffhh(i) = txl*ffhh_lnd(i) + txi*ffhh_ice(i) + txo*ffhh_wat(i) + uustar(i) = txl*uustar_lnd(i) + txi*uustar_ice(i) + txo*uustar_wat(i) + fm10(i) = txl*fm10_lnd(i) + txi*fm10_ice(i) + txo*fm10_wat(i) + fh2(i) = txl*fh2_lnd(i) + txi*fh2_ice(i) + txo*fh2_wat(i) + !tsurf(i) = txl*tsurf_lnd(i) + txi*tice(i) + txo*tsurf_wat(i) + !tsurf(i) = txl*tsurf_lnd(i) + txi*tsurf_ice(i) + txo*tsurf_wat(i) ! not used again! Moorthi + cmm(i) = txl*cmm_lnd(i) + txi*cmm_ice(i) + txo*cmm_wat(i) + chh(i) = txl*chh_lnd(i) + txi*chh_ice(i) + txo*chh_wat(i) + !gflx(i) = txl*gflx_lnd(i) + txi*gflx_ice(i) + txo*gflx_wat(i) + ep1d(i) = txl*ep1d_lnd(i) + txi*ep1d_ice(i) + txo*ep1d_wat(i) + !weasd(i) = txl*weasd_lnd(i) + txi*weasd_ice(i) + txo*weasd_wat(i) + !snowd(i) = txl*snowd_lnd(i) + txi*snowd_ice(i) + txo*snowd_wat(i) weasd(i) = txl*weasd_lnd(i) + txi*weasd_ice(i) snowd(i) = txl*snowd_lnd(i) + txi*snowd_ice(i) - !tprcp(i) = txl*tprcp_lnd(i) + txi*tprcp_ice(i) + txo*tprcp_ocn(i) + !tprcp(i) = txl*tprcp_lnd(i) + txi*tprcp_ice(i) + txo*tprcp_wat(i) if (.not. flag_cice(i) .and. islmsk(i) == 2) then tem = one - txl @@ -375,24 +378,24 @@ subroutine GFS_surface_composites_post_run ( qss(i) = txl*qss_lnd(i) + tem*qss_ice(i) gflx(i) = txl*gflx_lnd(i) + tem*gflx_ice(i) else - evap(i) = txl*evap_lnd(i) + txi*evap_ice(i) + txo*evap_ocn(i) - hflx(i) = txl*hflx_lnd(i) + txi*hflx_ice(i) + txo*hflx_ocn(i) - qss(i) = txl*qss_lnd(i) + txi*qss_ice(i) + txo*qss_ocn(i) - gflx(i) = txl*gflx_lnd(i) + txi*gflx_ice(i) + txo*gflx_ocn(i) + evap(i) = txl*evap_lnd(i) + txi*evap_ice(i) + txo*evap_wat(i) + hflx(i) = txl*hflx_lnd(i) + txi*hflx_ice(i) + txo*hflx_wat(i) + qss(i) = txl*qss_lnd(i) + txi*qss_ice(i) + txo*qss_wat(i) + gflx(i) = txl*gflx_lnd(i) + txi*gflx_ice(i) + txo*gflx_wat(i) endif - tsfc(i) = txl*tsfc_lnd(i) + txi*tice(i) + txo*tsfc_ocn(i) + tsfc(i) = txl*tsfc_lnd(i) + txi*tice(i) + txo*tsfc_wat(i) zorll(i) = zorl_lnd(i) - zorlo(i) = zorl_ocn(i) + zorlo(i) = zorl_wat(i) if (dry(i)) tsfcl(i) = tsfc_lnd(i) ! over land - if (wet(i)) tsfco(i) = tsfc_ocn(i) ! over lake or ocean when uncoupled + if (wet(i)) tsfco(i) = tsfc_wat(i) ! over lake or ocean when uncoupled ! for coupled model ocean will replace this ! if (icy(i)) tisfc(i) = tsfc_ice(i) ! over ice when uncoupled ! if (icy(i)) tisfc(i) = tice(i) ! over ice when uncoupled ! if (wet(i) .and. .not. cplflx) then -! tsfco(i) = tsfc_ocn(i) ! over lake or ocean when uncoupled +! tsfco(i) = tsfc_wat(i) ! over lake or ocean when uncoupled ! tisfc(i) = tsfc_ice(i) ! over ice when uncoupled ! endif @@ -438,30 +441,30 @@ subroutine GFS_surface_composites_post_run ( !cice(i) = zero !tisfc(i) = tsfc(i) elseif (islmsk(i) == 0) then - zorl(i) = zorl_ocn(i) - cd(i) = cd_ocn(i) - cdq(i) = cdq_ocn(i) - rb(i) = rb_ocn(i) - stress(i) = stress_ocn(i) - ffmm(i) = ffmm_ocn(i) - ffhh(i) = ffhh_ocn(i) - uustar(i) = uustar_ocn(i) - fm10(i) = fm10_ocn(i) - fh2(i) = fh2_ocn(i) - !tsurf(i) = tsurf_ocn(i) - tsfco(i) = tsfc_ocn(i) ! over lake (and ocean when uncoupled) - if( cplflx ) tsfcl(i) = tsfc_ocn(i) ! for restart repro comparisons - cmm(i) = cmm_ocn(i) - chh(i) = chh_ocn(i) - gflx(i) = gflx_ocn(i) - ep1d(i) = ep1d_ocn(i) - weasd(i) = weasd_ocn(i) - snowd(i) = snowd_ocn(i) - !tprcp(i) = tprcp_ocn(i) - evap(i) = evap_ocn(i) - hflx(i) = hflx_ocn(i) - qss(i) = qss_ocn(i) - tsfc(i) = tsfc_ocn(i) + zorl(i) = zorl_wat(i) + cd(i) = cd_wat(i) + cdq(i) = cdq_wat(i) + rb(i) = rb_wat(i) + stress(i) = stress_wat(i) + ffmm(i) = ffmm_wat(i) + ffhh(i) = ffhh_wat(i) + uustar(i) = uustar_wat(i) + fm10(i) = fm10_wat(i) + fh2(i) = fh2_wat(i) + !tsurf(i) = tsurf_wat(i) + tsfco(i) = tsfc_wat(i) ! over lake (and ocean when uncoupled) + if( cplflx ) tsfcl(i) = tsfc_wat(i) ! for restart repro comparisons + cmm(i) = cmm_wat(i) + chh(i) = chh_wat(i) + gflx(i) = gflx_wat(i) + ep1d(i) = ep1d_wat(i) + weasd(i) = weasd_wat(i) + snowd(i) = snowd_wat(i) + !tprcp(i) = tprcp_wat(i) + evap(i) = evap_wat(i) + hflx(i) = hflx_wat(i) + qss(i) = qss_wat(i) + tsfc(i) = tsfc_wat(i) !hice(i) = zero !cice(i) = zero !tisfc(i) = tsfc(i) @@ -470,7 +473,7 @@ subroutine GFS_surface_composites_post_run ( cd(i) = cd_ice(i) cdq(i) = cdq_ice(i) rb(i) = rb_ice(i) - stress(i) = cice(i)*stress_ice(i) + (one-cice(i))*stress_ocn(i) + stress(i) = cice(i)*stress_ice(i) + (one-cice(i))*stress_wat(i) ffmm(i) = ffmm_ice(i) ffhh(i) = ffhh_ice(i) uustar(i) = uustar_ice(i) @@ -486,24 +489,27 @@ subroutine GFS_surface_composites_post_run ( ep1d(i) = ep1d_ice(i) weasd(i) = weasd_ice(i) snowd(i) = snowd_ice(i) - !tprcp(i) = cice(i)*tprcp_ice(i) + (one-cice(i))*tprcp_ocn(i) + !tprcp(i) = cice(i)*tprcp_ice(i) + (one-cice(i))*tprcp_wat(i) qss(i) = qss_ice(i) evap(i) = evap_ice(i) hflx(i) = hflx_ice(i) qss(i) = qss_ice(i) tsfc(i) = tsfc_ice(i) - if( cplflx ) tsfcl(i) = tsfc_ice(i) + do k=1,kice ! store tiice in stc to reduce output in the nonfrac grid case + stc(i,k)=tiice(i,k) + end do + if( cplflx ) tsfcl(i) = tsfc_ice(i) endif zorll(i) = zorl_lnd(i) - zorlo(i) = zorl_ocn(i) + zorlo(i) = zorl_wat(i) if (flag_cice(i) .and. wet(i)) then ! this was already done for lake ice in sfc_sice txi = cice(i) txo = one - txi - evap(i) = txi * evap_ice(i) + txo * evap_ocn(i) - hflx(i) = txi * hflx_ice(i) + txo * hflx_ocn(i) - tsfc(i) = txi * tsfc_ice(i) + txo * tsfc_ocn(i) + evap(i) = txi * evap_ice(i) + txo * evap_wat(i) + hflx(i) = txi * hflx_ice(i) + txo * hflx_wat(i) + tsfc(i) = txi * tsfc_ice(i) + txo * tsfc_wat(i) else if (islmsk(i) == 2) then tisfc(i) = tice(i) diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index d21747122..ff0ca9774 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -162,7 +162,7 @@ kind = kind_phys intent = inout optional = F -[zorl_ocn] +[zorl_wat] standard_name = surface_roughness_length_over_ocean_interstitial long_name = surface roughness length over ocean (temporary use as interstitial) units = cm @@ -198,7 +198,7 @@ kind = kind_phys intent = in optional = F -[snowd_ocn] +[snowd_wat] standard_name = surface_snow_thickness_water_equivalent_over_ocean long_name = water equivalent snow depth over ocean units = mm @@ -234,7 +234,7 @@ kind = kind_phys intent = in optional = F -[tprcp_ocn] +[tprcp_wat] standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ocean long_name = total precipitation amount in each time step over ocean units = m @@ -270,7 +270,7 @@ kind = kind_phys intent = in optional = F -[uustar_ocn] +[uustar_wat] standard_name = surface_friction_velocity_over_ocean long_name = surface friction velocity over ocean units = m s-1 @@ -306,7 +306,7 @@ kind = kind_phys intent = in optional = F -[weasd_ocn] +[weasd_wat] standard_name = water_equivalent_accumulated_snow_depth_over_ocean long_name = water equiv of acc snow depth over ocean units = mm @@ -369,7 +369,7 @@ kind = kind_phys intent = inout optional = F -[tsfc_ocn] +[tsfc_wat] standard_name = surface_skin_temperature_over_ocean_interstitial long_name = surface skin temperature over ocean (temporary use as interstitial) units = K @@ -423,7 +423,7 @@ kind = kind_phys intent = inout optional = F -[tsurf_ocn] +[tsurf_wat] standard_name = surface_skin_temperature_after_iteration_over_ocean long_name = surface skin temperature after iteration over ocean units = K @@ -485,7 +485,7 @@ kind = kind_phys intent = in optional = F -[semis_ocn] +[semis_wat] standard_name = surface_longwave_emissivity_over_ocean_interstitial long_name = surface lw emissivity in fraction over ocean (temporary use as interstitial) units = frac @@ -521,7 +521,7 @@ kind = kind_phys intent = in optional = F -[qss_ocn] +[qss_wat] standard_name = surface_specific_humidity_over_ocean long_name = surface air saturation specific humidity over ocean units = kg kg-1 @@ -557,7 +557,7 @@ kind = kind_phys intent = in optional = F -[hflx_ocn] +[hflx_wat] standard_name = kinematic_surface_upward_sensible_heat_flux_over_ocean long_name = kinematic surface upward sensible heat flux over ocean units = K m s-1 @@ -656,7 +656,7 @@ type = logical intent = in optional = F -[semis_ocn] +[semis_wat] standard_name = surface_longwave_emissivity_over_ocean_interstitial long_name = surface lw emissivity in fraction over ocean (temporary use as interstitial) units = frac @@ -710,7 +710,7 @@ kind = kind_phys intent = inout optional = F -[gabsbdlw_ocn] +[gabsbdlw_wat] standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_ocean long_name = total sky surface downward longwave flux absorbed by the ground over ocean units = W m-2 @@ -776,6 +776,22 @@ type = integer intent = in optional = F +[kice] + standard_name = ice_vertical_dimension + long_name = vertical loop extent for ice levels, start at 1 + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = soil_vertical_dimension + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F [cplflx] standard_name = flag_for_flux_coupling long_name = flag controlling cplflx collection (default off) @@ -894,7 +910,7 @@ kind = kind_phys intent = inout optional = F -[zorl_ocn] +[zorl_wat] standard_name = surface_roughness_length_over_ocean_interstitial long_name = surface roughness length over ocean (temporary use as interstitial) units = cm @@ -930,7 +946,7 @@ kind = kind_phys intent = inout optional = F -[cd_ocn] +[cd_wat] standard_name = surface_drag_coefficient_for_momentum_in_air_over_ocean long_name = surface exchange coeff for momentum over ocean units = none @@ -966,7 +982,7 @@ kind = kind_phys intent = inout optional = F -[cdq_ocn] +[cdq_wat] standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean long_name = surface exchange coeff heat & moisture over ocean units = none @@ -1002,7 +1018,7 @@ kind = kind_phys intent = inout optional = F -[rb_ocn] +[rb_wat] standard_name = bulk_richardson_number_at_lowest_model_level_over_ocean long_name = bulk Richardson number at the surface over ocean units = none @@ -1038,7 +1054,7 @@ kind = kind_phys intent = inout optional = F -[stress_ocn] +[stress_wat] standard_name = surface_wind_stress_over_ocean long_name = surface wind stress over ocean units = m2 s-2 @@ -1074,7 +1090,7 @@ kind = kind_phys intent = inout optional = F -[ffmm_ocn] +[ffmm_wat] standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ocean long_name = Monin-Obukhov similarity function for momentum over ocean units = none @@ -1110,7 +1126,7 @@ kind = kind_phys intent = inout optional = F -[ffhh_ocn] +[ffhh_wat] standard_name = Monin_Obukhov_similarity_function_for_heat_over_ocean long_name = Monin-Obukhov similarity function for heat over ocean units = none @@ -1146,7 +1162,7 @@ kind = kind_phys intent = inout optional = F -[uustar_ocn] +[uustar_wat] standard_name = surface_friction_velocity_over_ocean long_name = surface friction velocity over ocean units = m s-1 @@ -1182,7 +1198,7 @@ kind = kind_phys intent = inout optional = F -[fm10_ocn] +[fm10_wat] standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ocean long_name = Monin-Obukhov similarity parameter for momentum at 10m over ocean units = none @@ -1218,7 +1234,7 @@ kind = kind_phys intent = inout optional = F -[fh2_ocn] +[fh2_wat] standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ocean long_name = Monin-Obukhov similarity parameter for heat at 2m over ocean units = none @@ -1254,7 +1270,7 @@ kind = kind_phys intent = inout optional = F -[tsurf_ocn] +[tsurf_wat] standard_name = surface_skin_temperature_after_iteration_over_ocean long_name = surface skin temperature after iteration over ocean units = K @@ -1290,7 +1306,7 @@ kind = kind_phys intent = inout optional = F -[cmm_ocn] +[cmm_wat] standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ocean long_name = momentum exchange coefficient over ocean units = m s-1 @@ -1326,7 +1342,7 @@ kind = kind_phys intent = inout optional = F -[chh_ocn] +[chh_wat] standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ocean long_name = thermal exchange coefficient over ocean units = kg m-2 s-1 @@ -1362,7 +1378,7 @@ kind = kind_phys intent = inout optional = F -[gflx_ocn] +[gflx_wat] standard_name = upward_heat_flux_in_soil_over_ocean long_name = soil heat flux over ocean units = W m-2 @@ -1398,7 +1414,7 @@ kind = kind_phys intent = inout optional = F -[ep1d_ocn] +[ep1d_wat] standard_name = surface_upward_potential_latent_heat_flux_over_ocean long_name = surface upward potential latent heat flux over ocean units = W m-2 @@ -1434,7 +1450,7 @@ kind = kind_phys intent = inout optional = F -[weasd_ocn] +[weasd_wat] standard_name = water_equivalent_accumulated_snow_depth_over_ocean long_name = water equiv of acc snow depth over ocean units = mm @@ -1470,7 +1486,7 @@ kind = kind_phys intent = inout optional = F -[snowd_ocn] +[snowd_wat] standard_name = surface_snow_thickness_water_equivalent_over_ocean long_name = water equivalent snow depth over ocean units = mm @@ -1506,7 +1522,7 @@ kind = kind_phys intent = inout optional = F -[tprcp_ocn] +[tprcp_wat] standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ocean long_name = total precipitation amount in each time step over ocean units = m @@ -1542,7 +1558,7 @@ kind = kind_phys intent = inout optional = F -[evap_ocn] +[evap_wat] standard_name = kinematic_surface_upward_latent_heat_flux_over_ocean long_name = kinematic surface upward latent heat flux over ocean units = kg kg-1 m s-1 @@ -1578,7 +1594,7 @@ kind = kind_phys intent = inout optional = F -[hflx_ocn] +[hflx_wat] standard_name = kinematic_surface_upward_sensible_heat_flux_over_ocean long_name = kinematic surface upward sensible heat flux over ocean units = K m s-1 @@ -1614,7 +1630,7 @@ kind = kind_phys intent = inout optional = F -[qss_ocn] +[qss_wat] standard_name = surface_specific_humidity_over_ocean long_name = surface air saturation specific humidity over ocean units = kg kg-1 @@ -1668,7 +1684,7 @@ kind = kind_phys intent = inout optional = F -[tsfc_ocn] +[tsfc_wat] standard_name = surface_skin_temperature_over_ocean_interstitial long_name = surface skin temperature over ocean (temporary use as interstitial) units = K @@ -1731,6 +1747,24 @@ kind = kind_phys intent = inout optional = F +[tiice] + standard_name = internal_ice_temperature + long_name = sea ice internal temperature + units = K + dimensions = (horizontal_dimension,ice_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 30a29d393..bdc546ce9 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -215,8 +215,8 @@ end subroutine GFS_surface_generic_post_finalize !! \htmlinclude GFS_surface_generic_post_run.html !! subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dtf, ep1d, gflx, tgrs_1, qgrs_1, ugrs_1, vgrs_1,& - adjsfcdlw, adjsfcdsw, adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd, adjsfculw, adjsfculw_ocn, adjnirbmu, adjnirdfu, & - adjvisbmu, adjvisdfu,t2m, q2m, u10m, v10m, tsfc, tsfc_ocn, pgr, xcosz, evbs, evcw, trans, sbsno, snowc, snohf, & + adjsfcdlw, adjsfcdsw, adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd, adjsfculw, adjsfculw_wat, adjnirbmu, adjnirdfu, & + adjvisbmu, adjvisdfu,t2m, q2m, u10m, v10m, tsfc, tsfc_wat, pgr, xcosz, evbs, evcw, trans, sbsno, snowc, snohf, & epi, gfluxi, t1, q1, u1, v1, dlwsfci_cpl, dswsfci_cpl, dlwsfc_cpl, dswsfc_cpl, dnirbmi_cpl, dnirdfi_cpl, dvisbmi_cpl, & dvisdfi_cpl, dnirbm_cpl, dnirdf_cpl, dvisbm_cpl, dvisdf_cpl, nlwsfci_cpl, nlwsfc_cpl, t2mi_cpl, q2mi_cpl, u10mi_cpl, & v10mi_cpl, tsfci_cpl, psurfi_cpl, nnirbmi_cpl, nnirdfi_cpl, nvisbmi_cpl, nvisdfi_cpl, nswsfci_cpl, nswsfc_cpl, nnirbm_cpl, & @@ -232,8 +232,8 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt real(kind=kind_phys), intent(in) :: dtf real(kind=kind_phys), dimension(im), intent(in) :: ep1d, gflx, tgrs_1, qgrs_1, ugrs_1, vgrs_1, adjsfcdlw, adjsfcdsw, & - adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd, adjsfculw, adjsfculw_ocn, adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, & - t2m, q2m, u10m, v10m, tsfc, tsfc_ocn, pgr, xcosz, evbs, evcw, trans, sbsno, snowc, snohf + adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd, adjsfculw, adjsfculw_wat, adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, & + t2m, q2m, u10m, v10m, tsfc, tsfc_wat, pgr, xcosz, evbs, evcw, trans, sbsno, snowc, snohf real(kind=kind_phys), dimension(im), intent(inout) :: epi, gfluxi, t1, q1, u1, v1, dlwsfci_cpl, dswsfci_cpl, dlwsfc_cpl, & dswsfc_cpl, dnirbmi_cpl, dnirdfi_cpl, dvisbmi_cpl, dvisdfi_cpl, dnirbm_cpl, dnirdf_cpl, dvisbm_cpl, dvisdf_cpl, & @@ -304,13 +304,13 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt dvisdf_cpl (i) = dvisdf_cpl(i) + adjvisdfd(i)*dtf nlwsfci_cpl (i) = adjsfcdlw(i) - adjsfculw(i) if (wet(i)) then - nlwsfci_cpl(i) = adjsfcdlw(i) - adjsfculw_ocn(i) + nlwsfci_cpl(i) = adjsfcdlw(i) - adjsfculw_wat(i) endif nlwsfc_cpl (i) = nlwsfc_cpl(i) + nlwsfci_cpl(i)*dtf t2mi_cpl (i) = t2m(i) q2mi_cpl (i) = q2m(i) tsfci_cpl (i) = tsfc(i) -! tsfci_cpl (i) = tsfc_ocn(i) +! tsfci_cpl (i) = tsfc_wat(i) psurfi_cpl (i) = pgr(i) enddo diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index 10a060bc3..fb4bd5944 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -677,7 +677,7 @@ kind = kind_phys intent = in optional = F -[adjsfculw_ocn] +[adjsfculw_wat] standard_name = surface_upwelling_longwave_flux_over_ocean_interstitial long_name = surface upwelling longwave flux at current time over ocean (temporary use as interstitial) units = W m-2 @@ -767,7 +767,7 @@ kind = kind_phys intent = in optional = F -[tsfc_ocn] +[tsfc_wat] standard_name = surface_skin_temperature_over_ocean_interstitial long_name = surface skin temperature over ocean (temporary use as interstitial) units = K diff --git a/physics/dcyc2.f b/physics/dcyc2.f index dcb164369..f5967f7a2 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -47,8 +47,8 @@ end subroutine dcyc2t3_finalize ! call dcyc2t3 ! ! inputs: ! ! ( solhr,slag,sdec,cdec,sinlat,coslat, ! -! xlon,coszen,tsfc_lnd,tsfc_ice,tsfc_ocn, ! -! tf,tsflw,sfcemis_lnd,sfcemis_ice,sfcemis_ocn, ! +! xlon,coszen,tsfc_lnd,tsfc_ice,tsfc_wat, ! +! tf,tsflw,sfcemis_lnd,sfcemis_ice,sfcemis_wat, ! ! sfcdsw,sfcnsw,sfcdlw,swh,swhc,hlw,hlwc, ! ! sfcnirbmu,sfcnirdfu,sfcvisbmu,sfcvisdfu, ! ! sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, ! @@ -58,7 +58,7 @@ end subroutine dcyc2t3_finalize ! dtdt,dtdtc, ! ! outputs: ! ! adjsfcdsw,adjsfcnsw,adjsfcdlw, ! -! adjsfculw_lnd,adjsfculw_ice,adjsfculw_ocn,xmu,xcosz, ! +! adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, ! ! adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, ! ! adjdnnbmd,adjdnndfd,adjdnvbmd,adjdnvdfd) ! ! ! @@ -74,11 +74,11 @@ end subroutine dcyc2t3_finalize ! coszen (im) - real, avg of cosz over daytime sw call interval ! ! tsfc_lnd (im) - real, bottom surface temperature over land (k) ! ! tsfc_ice (im) - real, bottom surface temperature over ice (k) ! -! tsfc_ocn (im) - real, bottom surface temperature over ocean (k) ! +! tsfc_wat (im) - real, bottom surface temperature over ocean (k) ! ! tf (im) - real, surface air (layer 1) temperature (k) ! ! sfcemis_lnd(im) - real, surface emissivity (fraction) o. land (k) ! ! sfcemis_ice(im) - real, surface emissivity (fraction) o. ice (k) ! -! sfcemis_ocn(im) - real, surface emissivity (fraction) o. ocean (k)! +! sfcemis_wat(im) - real, surface emissivity (fraction) o. ocean (k)! ! tsflw (im) - real, sfc air (layer 1) temp in k saved in lw call ! ! sfcdsw (im) - real, total sky sfc downward sw flux ( w/m**2 ) ! ! sfcnsw (im) - real, total sky sfc net sw into ground (w/m**2) ! @@ -115,7 +115,7 @@ end subroutine dcyc2t3_finalize ! adjsfcdlw(im)- real, time step adjusted sfc dn lw flux (w/m**2) ! ! adjsfculw_lnd(im)- real, sfc upw. lw flux at current time (w/m**2)! ! adjsfculw_ice(im)- real, sfc upw. lw flux at current time (w/m**2)! -! adjsfculw_ocn(im)- real, sfc upw. lw flux at current time (w/m**2)! +! adjsfculw_wat(im)- real, sfc upw. lw flux at current time (w/m**2)! ! adjnirbmu(im)- real, t adj sfc nir-beam sw upward flux (w/m2) ! ! adjnirdfu(im)- real, t adj sfc nir-diff sw upward flux (w/m2) ! ! adjvisbmu(im)- real, t adj sfc uv+vis-beam sw upward flux (w/m2) ! @@ -179,8 +179,8 @@ end subroutine dcyc2t3_finalize subroutine dcyc2t3_run & ! --- inputs: & ( solhr,slag,sdec,cdec,sinlat,coslat, & - & xlon,coszen,tsfc_lnd,tsfc_ice,tsfc_ocn,tf,tsflw, & - & sfcemis_lnd, sfcemis_ice, sfcemis_ocn, & + & xlon,coszen,tsfc_lnd,tsfc_ice,tsfc_wat,tf,tsflw, & + & sfcemis_lnd, sfcemis_ice, sfcemis_wat, & & sfcdsw,sfcnsw,sfcdlw,swh,swhc,hlw,hlwc, & & sfcnirbmu,sfcnirdfu,sfcvisbmu,sfcvisdfu, & & sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, & @@ -191,7 +191,7 @@ subroutine dcyc2t3_run & & dtdt,dtdtc, & ! --- outputs: & adjsfcdsw,adjsfcnsw,adjsfcdlw, & - & adjsfculw_lnd,adjsfculw_ice,adjsfculw_ocn,xmu,xcosz, & + & adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, & & adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, & & adjnirbmd,adjnirdfd,adjvisbmd,adjvisdfd, & & errmsg,errflg & @@ -225,8 +225,8 @@ subroutine dcyc2t3_run & & sfcdsw, sfcnsw real(kind=kind_phys), dimension(im), intent(in) :: & - & tsfc_lnd, tsfc_ice, tsfc_ocn, & - & sfcemis_lnd, sfcemis_ice, sfcemis_ocn + & tsfc_lnd, tsfc_ice, tsfc_wat, & + & sfcemis_lnd, sfcemis_ice, sfcemis_wat real(kind=kind_phys), dimension(im), intent(in) :: & & sfcnirbmu, sfcnirdfu, sfcvisbmu, sfcvisdfu, & @@ -246,7 +246,7 @@ subroutine dcyc2t3_run & & adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd real(kind=kind_phys), dimension(im), intent(out) :: & - & adjsfculw_lnd, adjsfculw_ice, adjsfculw_ocn + & adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -321,9 +321,9 @@ subroutine dcyc2t3_run & & + (one - sfcemis_ice(i)) * adjsfcdlw(i) endif if (wet(i)) then - tem2 = tsfc_ocn(i) * tsfc_ocn(i) - adjsfculw_ocn(i) = sfcemis_ocn(i) * con_sbc * tem2 * tem2 - & + (one - sfcemis_ocn(i)) * adjsfcdlw(i) + tem2 = tsfc_wat(i) * tsfc_wat(i) + adjsfculw_wat(i) = sfcemis_wat(i) * con_sbc * tem2 * tem2 + & + (one - sfcemis_wat(i)) * adjsfcdlw(i) endif ! if (lprnt .and. i == ipr) write(0,*)' in dcyc3: dry==',dry(i) ! &,' wet=',wet(i),' icy=',icy(i),' tsfc3=',tsfc3(i,:) diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index fa1ef4800..69f787ea0 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -92,7 +92,7 @@ kind = kind_phys intent = in optional = F -[tsfc_ocn] +[tsfc_wat] standard_name = surface_skin_temperature_over_ocean_interstitial long_name = surface skin temperature over ocean (temporary use as interstitial) units = K @@ -146,7 +146,7 @@ kind = kind_phys intent = in optional = F -[sfcemis_ocn] +[sfcemis_wat] standard_name = surface_longwave_emissivity_over_ocean_interstitial long_name = surface lw emissivity in fraction over ocean (temporary use as interstitial) units = frac @@ -411,7 +411,7 @@ kind = kind_phys intent = out optional = F -[adjsfculw_ocn] +[adjsfculw_wat] standard_name = surface_upwelling_longwave_flux_over_ocean_interstitial long_name = surface upwelling longwave flux at current time over ocean (temporary use as interstitial) units = W m-2 diff --git a/physics/gcycle.F90 b/physics/gcycle.F90 index 8c5dd041a..bc1bb032c 100644 --- a/physics/gcycle.F90 +++ b/physics/gcycle.F90 @@ -239,6 +239,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) Sfcprop(nb)%smc (ix,ls) = SMCFC1 (len + (ls-1)*npts) Sfcprop(nb)%stc (ix,ls) = STCFC1 (len + (ls-1)*npts) Sfcprop(nb)%slc (ix,ls) = SLCFC1 (len + (ls-1)*npts) + if (ls<=Model%kice) Sfcprop(nb)%tiice (ix,ls) = STCFC1 (len + (ls-1)*npts) enddo ENDDO !-----END BLOCK SIZE LOOP------------------------------ ENDDO !-----END BLOCK LOOP------------------------------- diff --git a/physics/gfdl_fv_sat_adj.F90 b/physics/gfdl_fv_sat_adj.F90 index 025ee1c34..816488f7a 100644 --- a/physics/gfdl_fv_sat_adj.F90 +++ b/physics/gfdl_fv_sat_adj.F90 @@ -269,7 +269,7 @@ subroutine fv_sat_adj_run(mdt, zvir, is, ie, isd, ied, kmp, km, kmdelz, js, je, real(kind=kind_dyn), intent(in) :: hs(isd:ied, jsd:jed) real(kind=kind_dyn), intent(in) :: peln(is:ie, 1:km+1, js:je) ! For hydrostatic build, kmdelz=1, otherwise kmdelz=km (see fv_arrays.F90) - real(kind=kind_dyn), intent(in) :: delz(isd:ied, jsd:jed, 1:kmdelz) + real(kind=kind_dyn), intent(in) :: delz(is:ie, js:je, 1:kmdelz) real(kind=kind_dyn), intent(in) :: delp(isd:ied, jsd:jed, 1:km) real(kind=kind_dyn), intent(inout) :: pt(isd:ied, jsd:jed, 1:km) real(kind=kind_dyn), intent(inout) :: pkz(is:ie, js:je, 1:km) @@ -342,7 +342,7 @@ subroutine fv_sat_adj_run(mdt, zvir, is, ie, isd, ied, kmp, km, kmdelz, js, je, #endif ql(isd,jsd,k), qi(isd,jsd,k), & qr(isd,jsd,k), qs(isd,jsd,k), qg(isd,jsd,k), & - hs, dpln, delz(isd:,jsd:,kdelz), pt(isd,jsd,k), delp(isd,jsd,k),& + hs, dpln, delz(is:,js:,kdelz), pt(isd,jsd,k), delp(isd,jsd,k),& q_con(isd:,jsd:,k), cappa(isd:,jsd:,k), area, dtdt(is,js,k), & out_dt, last_step, do_qa, qa(isd,jsd,k)) if ( .not. hydrostatic ) then @@ -402,8 +402,8 @@ subroutine fv_sat_adj_work(mdt, zvir, is, ie, js, je, ng, hydrostatic, consv_te, integer, intent (in) :: is, ie, js, je, ng logical, intent (in) :: hydrostatic, consv_te, out_dt, last_step, do_qa real(kind=kind_dyn), intent (in) :: zvir, mdt ! remapping time step - real(kind=kind_dyn), intent (in), dimension (is - ng:ie + ng, js - ng:je + ng) :: dp, delz, hs - real(kind=kind_dyn), intent (in), dimension (is:ie, js:je) :: dpln + real(kind=kind_dyn), intent (in), dimension (is - ng:ie + ng, js - ng:je + ng) :: dp, hs + real(kind=kind_dyn), intent (in), dimension (is:ie, js:je) :: dpln, delz real(kind=kind_dyn), intent (inout), dimension (is - ng:ie + ng, js - ng:je + ng) :: pt #ifdef MULTI_GASES real(kind=kind_dyn), intent (inout), dimension (is - ng:ie + ng, js - ng:je + ng, 1:1, 1:num_gas) :: qvi diff --git a/physics/gfdl_fv_sat_adj.meta b/physics/gfdl_fv_sat_adj.meta index 983863a26..18b37a3c5 100644 --- a/physics/gfdl_fv_sat_adj.meta +++ b/physics/gfdl_fv_sat_adj.meta @@ -352,7 +352,7 @@ standard_name = thickness_at_Lagrangian_surface long_name = thickness at Lagrangian_surface units = m - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_thickness_at_Lagrangian_surface) + dimensions = (starting_x_direction_index:ending_x_direction_index,starting_y_direction_index:ending_y_direction_index,1:vertical_dimension_for_thickness_at_Lagrangian_surface) type = real kind = kind_dyn intent = in diff --git a/physics/lsm_ruc_sfc_sice_interstitial.F90 b/physics/lsm_ruc_sfc_sice_interstitial.F90 index 63f006f1e..27033fcc8 100644 --- a/physics/lsm_ruc_sfc_sice_interstitial.F90 +++ b/physics/lsm_ruc_sfc_sice_interstitial.F90 @@ -21,17 +21,18 @@ end subroutine lsm_ruc_sfc_sice_pre_finalize !! \htmlinclude lsm_ruc_sfc_sice_pre_run.html !! #endif - subroutine lsm_ruc_sfc_sice_pre_run(im, lsoil_ruc, lsoil, land, stc, tslb, errmsg, errflg) + subroutine lsm_ruc_sfc_sice_pre_run(im, lsoil_ruc, lsoil, kice, land, icy, stc, tslb, tiice, errmsg, errflg) implicit none ! Interface variables - integer, intent(in) :: im, lsoil_ruc, lsoil - logical, dimension(im), intent(in) :: land + integer, intent(in) :: im, lsoil_ruc, lsoil, kice + logical, dimension(im), intent(in) :: land, icy ! --- on Noah levels real (kind=kind_phys), dimension(im,lsoil), intent(inout) :: stc ! --- on RUC levels real (kind=kind_phys), dimension(im,lsoil_ruc), intent(in) :: tslb + real (kind=kind_phys), dimension(im,kice), intent(inout) :: tiice character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -44,7 +45,11 @@ subroutine lsm_ruc_sfc_sice_pre_run(im, lsoil_ruc, lsoil, land, stc, tslb, errms errflg = 0 do i=1,im - if (.not.land(i)) then + if (icy(i)) then + do k=1,kice + tiice(i,k) = tslb(i,k) + end do + else if (.not.land(i)) then do k=1,min(lsoil,lsoil_ruc) stc(i,k) = tslb(i,k) end do @@ -78,15 +83,16 @@ end subroutine lsm_ruc_sfc_sice_post_finalize !! \htmlinclude lsm_ruc_sfc_sice_post_run.html !! #endif - subroutine lsm_ruc_sfc_sice_post_run(im, lsoil_ruc, lsoil, land, stc, tslb, errmsg, errflg) + subroutine lsm_ruc_sfc_sice_post_run(im, lsoil_ruc, lsoil, kice, land, icy, stc, tslb, tiice, errmsg, errflg) implicit none ! Interface variables - integer, intent(in) :: im, lsoil_ruc, lsoil - logical, dimension(im), intent(in) :: land + integer, intent(in) :: im, lsoil_ruc, lsoil, kice + logical, dimension(im), intent(in) :: land, icy ! --- on Noah levels real (kind=kind_phys), dimension(im,lsoil), intent(in) :: stc + real (kind=kind_phys), dimension(im,kice), intent(in) :: tiice ! --- on RUC levels real (kind=kind_phys), dimension(im,lsoil_ruc), intent(inout) :: tslb @@ -101,7 +107,11 @@ subroutine lsm_ruc_sfc_sice_post_run(im, lsoil_ruc, lsoil, land, stc, tslb, errm errflg = 0 do i=1,im - if (.not.land(i)) then + if (icy(i)) then + do k=1,kice + tslb(i,k) = tiice(i,k) + end do + else if (.not.land(i)) then do k=1,min(lsoil,lsoil_ruc) tslb(i,k) = stc(i,k) end do diff --git a/physics/lsm_ruc_sfc_sice_interstitial.meta b/physics/lsm_ruc_sfc_sice_interstitial.meta index c105abe9d..3b8213d78 100644 --- a/physics/lsm_ruc_sfc_sice_interstitial.meta +++ b/physics/lsm_ruc_sfc_sice_interstitial.meta @@ -9,6 +9,14 @@ type = integer intent = in optional = F +[kice] + standard_name = ice_vertical_dimension + long_name = vertical loop extent for ice levels, start at 1 + units = count + dimensions = () + type = integer + intent = in + optional = F [lsoil_ruc] standard_name = soil_vertical_dimension_for_land_surface_model long_name = number of soil layers internal to land surface model @@ -33,6 +41,23 @@ type = logical intent = in optional = F +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = inout + optional = F +[tiice] + standard_name = internal_ice_temperature + long_name = sea ice internal temperature + units = K + dimensions = (horizontal_dimension,ice_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [stc] standard_name = soil_temperature long_name = soil temperature @@ -81,6 +106,14 @@ type = integer intent = in optional = F +[kice] + standard_name = ice_vertical_dimension + long_name = vertical loop extent for ice levels, start at 1 + units = count + dimensions = () + type = integer + intent = in + optional = F [lsoil_ruc] standard_name = soil_vertical_dimension_for_land_surface_model long_name = number of soil layers internal to land surface model @@ -105,6 +138,23 @@ type = logical intent = in optional = F +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = inout + optional = F +[tiice] + standard_name = internal_ice_temperature + long_name = sea ice internal temperature + units = K + dimensions = (horizontal_dimension,ice_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [stc] standard_name = soil_temperature long_name = soil temperature diff --git a/physics/module_MYJSFC_wrapper.F90 b/physics/module_MYJSFC_wrapper.F90 index 8d4ccc858..e3dcf4111 100644 --- a/physics/module_MYJSFC_wrapper.F90 +++ b/physics/module_MYJSFC_wrapper.F90 @@ -37,16 +37,16 @@ SUBROUTINE myjsfc_wrapper_run( & & pblh, slmsk, zorl, ustar, rib, & & cm,ch,stress,ffm,ffh,fm10,fh2, & & landfrac,lakefrac,oceanfrac,fice, & - & z0rl_ocn, z0rl_lnd, z0rl_ice, & ! intent(inout) - & ustar_ocn, ustar_lnd, ustar_ice, & ! intent(inout) - & cm_ocn, cm_lnd, cm_ice, & ! intent(inout) - & ch_ocn, ch_lnd, ch_ice, & ! intent(inout) - & rb_ocn, rb_lnd, rb_ice, & ! intent(inout) - & stress_ocn,stress_lnd,stress_ice, & ! intent(inout) - & fm_ocn, fm_lnd, fm_ice, & ! intent(inout) - & fh_ocn, fh_lnd, fh_ice, & ! intent(inout) - & fm10_ocn, fm10_lnd, fm10_ice, & ! intent(inout) - & fh2_ocn, fh2_lnd, fh2_ice, & ! intent(inout) + & z0rl_wat, z0rl_lnd, z0rl_ice, & ! intent(inout) + & ustar_wat, ustar_lnd, ustar_ice, & ! intent(inout) + & cm_wat, cm_lnd, cm_ice, & ! intent(inout) + & ch_wat, ch_lnd, ch_ice, & ! intent(inout) + & rb_wat, rb_lnd, rb_ice, & ! intent(inout) + & stress_wat,stress_lnd,stress_ice, & ! intent(inout) + & fm_wat, fm_lnd, fm_ice, & ! intent(inout) + & fh_wat, fh_lnd, fh_ice, & ! intent(inout) + & fm10_wat, fm10_lnd, fm10_ice, & ! intent(inout) + & fh2_wat, fh2_lnd, fh2_ice, & ! intent(inout) & wind, con_cp, con_g, con_rd, & & me, lprnt, errmsg, errflg ) ! intent(inout) ! @@ -107,16 +107,16 @@ SUBROUTINE myjsfc_wrapper_run( & real(kind=kind_phys), dimension(im), intent(inout) :: & & landfrac, lakefrac, oceanfrac, fice real(kind=kind_phys), dimension(im), intent(inout) :: & - & z0rl_ocn, z0rl_lnd, z0rl_ice, & - & ustar_ocn, ustar_lnd, ustar_ice, & - & cm_ocn, cm_lnd, cm_ice, & - & ch_ocn, ch_lnd, ch_ice, & - & rb_ocn, rb_lnd, rb_ice, & - & stress_ocn,stress_lnd,stress_ice, & - & fm_ocn, fm_lnd, fm_ice, & - & fh_ocn, fh_lnd, fh_ice, & - & fm10_ocn, fm10_lnd, fm10_ice, & - & fh2_ocn, fh2_lnd, fh2_ice, & + & z0rl_wat, z0rl_lnd, z0rl_ice, & + & ustar_wat, ustar_lnd, ustar_ice, & + & cm_wat, cm_lnd, cm_ice, & + & ch_wat, ch_lnd, ch_ice, & + & rb_wat, rb_lnd, rb_ice, & + & stress_wat,stress_lnd,stress_ice, & + & fm_wat, fm_lnd, fm_ice, & + & fh_wat, fh_lnd, fh_ice, & + & fm10_wat, fm10_lnd, fm10_ice, & + & fh2_wat, fh2_lnd, fh2_ice, & & wind @@ -404,16 +404,16 @@ SUBROUTINE myjsfc_wrapper_run( & do i = 1, im if(flag_iter(i))then - z0rl_ocn(i) = zorl(i) - cm_ocn(i) = cm(i) - ch_ocn(i) = ch(i) - rb_ocn(i) = rib(i) - stress_ocn(i) = stress(i) - fm_ocn(i) = ffm(i) - fh_ocn(i) = ffh(i) - ustar_ocn(i) = ustar(i) - fm10_ocn(i) = fm10(i) - fh2_ocn(i) = fh2(i) + z0rl_wat(i) = zorl(i) + cm_wat(i) = cm(i) + ch_wat(i) = ch(i) + rb_wat(i) = rib(i) + stress_wat(i) = stress(i) + fm_wat(i) = ffm(i) + fh_wat(i) = ffh(i) + ustar_wat(i) = ustar(i) + fm10_wat(i) = fm10(i) + fh2_wat(i) = fh2(i) z0rl_lnd(i) = zorl(i) cm_lnd(i) = cm(i) diff --git a/physics/module_MYJSFC_wrapper.meta b/physics/module_MYJSFC_wrapper.meta index bc7c7cec4..0ee3f521e 100644 --- a/physics/module_MYJSFC_wrapper.meta +++ b/physics/module_MYJSFC_wrapper.meta @@ -465,7 +465,7 @@ kind = kind_phys intent = in optional = F -[z0rl_ocn] +[z0rl_wat] standard_name = surface_roughness_length_over_ocean_interstitial long_name = surface roughness length over ocean (interstitial) units = cm @@ -492,7 +492,7 @@ kind = kind_phys intent = inout optional = F -[ustar_ocn] +[ustar_wat] standard_name = surface_friction_velocity_over_ocean long_name = surface friction velocity over ocean units = m s-1 @@ -519,7 +519,7 @@ kind = kind_phys intent = inout optional = F -[cm_ocn] +[cm_wat] standard_name = surface_drag_coefficient_for_momentum_in_air_over_ocean long_name = surface exchange coeff for momentum over ocean units = none @@ -546,7 +546,7 @@ kind = kind_phys intent = inout optional = F -[ch_ocn] +[ch_wat] standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean long_name = surface exchange coeff heat & moisture over ocean units = none @@ -573,7 +573,7 @@ kind = kind_phys intent = inout optional = F -[rb_ocn] +[rb_wat] standard_name = bulk_richardson_number_at_lowest_model_level_over_ocean long_name = bulk Richardson number at the surface over ocean units = none @@ -600,7 +600,7 @@ kind = kind_phys intent = inout optional = F -[stress_ocn] +[stress_wat] standard_name = surface_wind_stress_over_ocean long_name = surface wind stress over ocean units = m2 s-2 @@ -627,7 +627,7 @@ kind = kind_phys intent = inout optional = F -[fm_ocn] +[fm_wat] standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ocean long_name = Monin-Obukhov similarity funct for momentum over ocean units = none @@ -654,7 +654,7 @@ kind = kind_phys intent = inout optional = F -[fh_ocn] +[fh_wat] standard_name = Monin_Obukhov_similarity_function_for_heat_over_ocean long_name = Monin-Obukhov similarity function for heat over ocean units = none @@ -681,7 +681,7 @@ kind = kind_phys intent = inout optional = F -[fm10_ocn] +[fm10_wat] standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ocean long_name = Monin-Obukhov parameter for momentum at 10m over ocean units = none @@ -708,7 +708,7 @@ kind = kind_phys intent = inout optional = F -[fh2_ocn] +[fh2_wat] standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ocean long_name = Monin-Obukhov parameter for heat at 2m over ocean units = none diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 413db8b62..f54ae7d38 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -429,6 +429,7 @@ SUBROUTINE mynnedmf_wrapper_run( & qni(i,k) = 0. qnwfa(i,k) = 0. qnifa(i,k) = 0. + ozone(i,k) = qgrs_ozone(i,k) enddo enddo else @@ -456,6 +457,7 @@ SUBROUTINE mynnedmf_wrapper_run( & qni(i,k) = 0. qnwfa(i,k) = 0. qnifa(i,k) = 0. + ozone(i,k) = qgrs_ozone(i,k) enddo enddo endif diff --git a/physics/radsw_datatb.f b/physics/radsw_datatb.f index 3cc9e2d82..6d88f1989 100644 --- a/physics/radsw_datatb.f +++ b/physics/radsw_datatb.f @@ -2551,7 +2551,7 @@ module module_radsw_sflux ! !> band index (3rd index in array sfluxref described below) integer, dimension(nblow:nbhgh), public :: ibx - data layreffr/ 18,30, 6, 3, 3, 8, 2, 6, 1, 2, 0,32,58,49 / + data layreffr/ 18,30, 6, 3, 3, 8, 2, 6, 1, 2, 0,32,42,49 / data ix1 / 1, 1, 1, 1, 0, 1, 1, 0, 1, 0, 0, 0, 3, 0 / data ix2 / 5, 2, 5, 2, 0, 2, 6, 0, 6, 0, 0, 0, 6, 0 / data ibx / 1, 1, 1, 2, 2, 3, 4, 3, 5, 4, 5, 6, 2, 7 / diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 361aadbae..67576af15 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -71,7 +71,7 @@ end subroutine samfdeepcnv_finalize subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & & eps,epsm1,fv,grav,hvap,rd,rv, & & t0c,delt,ntk,ntr,delp, & - & prslp,psp,phil,qtr,q1,t1,u1,v1,fscav, & + & prslp,psp,phil,qtr,q1,t1,u1,v1,fscav,hwrf_samfdeep, & & cldwrk,rn,kbot,ktop,kcnv,islimsk,garea, & & dot,ncloud,ud_mf,dd_mf,dt_mf,cnvw,cnvc, & & QLCN, QICN, w_upi, cf_upi, CNV_MFD, & @@ -94,6 +94,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & real(kind=kind_phys), intent(in) :: psp(im), delp(im,km), & & prslp(im,km), garea(im), dot(im,km), phil(im,km) real(kind=kind_phys), dimension(:), intent(in) :: fscav + logical, intent(in) :: hwrf_samfdeep real(kind=kind_phys), intent(in) :: nthresh real(kind=kind_phys), intent(in) :: ca_deep(im) real(kind=kind_phys), intent(out) :: rainevap(im) @@ -119,7 +120,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & ! *GJF integer :: mp_phys, mp_phys_mg - real(kind=kind_phys), intent(in) :: clam, c0s, c1, & + real(kind=kind_phys), intent(in) :: clam, c0s, c1, & & betal, betas, asolfac, & & evfact, evfactl, pgcon character(len=*), intent(out) :: errmsg @@ -132,8 +133,10 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & real(kind=kind_phys) clamd, tkemx, tkemn, dtke, & beta, dbeta, betamx, betamn, & cxlame, cxlamd, + & cxlamu, & xlamde, xlamdd, - & crtlame, crtlamd + & crtlamd, + & crtlame ! ! real(kind=kind_phys) detad real(kind=kind_phys) adw, aup, aafac, d0, @@ -141,7 +144,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & & dh, dhh, dp, & dq, dqsdp, dqsdt, dt, & dt2, dtmax, dtmin, - & dxcrtas, dxcrtuf, + & dxcrtas, dxcrtuf, & dv1h, dv2h, dv3h, & dv1q, dv2q, dv3q, & dz, dz1, e1, edtmax, @@ -184,8 +187,8 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & & rntot(im), vshear(im), xaa0(im), & xlamd(im), xk(im), cina(im), & xmb(im), xmbmax(im), xpwav(im), -! & xpwev(im), xlamx(im), delebar(im,ntr), - & xpwev(im), delebar(im,ntr), + & xpwev(im), xlamx(im), delebar(im,ntr), +! & xpwev(im), delebar(im,ntr), & delubar(im), delvbar(im) ! real(kind=kind_phys) c0(im) @@ -196,12 +199,11 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & ! ! parameters for updraft velocity calculation real(kind=kind_phys) bet1, cd1, f1, gam1, - & bb1, bb2 -! & bb1, bb2, wucb +! & bb1, bb2 + & bb1, bb2, wucb ! c physical parameters ! parameter(grav=grav,asolfac=0.958) -! parameter(grav=grav) ! parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp)) ! parameter(c0s=.002,c1=.002,d0=.01) ! parameter(d0=.01) @@ -220,7 +222,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & parameter(clamd=0.03,tkemx=0.65,tkemn=0.05) parameter(dtke=tkemx-tkemn) parameter(dbeta=0.1) - parameter(cthk=200.,dthk=25.) + parameter(cthk=150.,dthk=25.) parameter(cinpcrmx=180.,cinpcrmn=120.) ! parameter(cinacrmx=-120.,cinacrmn=-120.) parameter(cinacrmx=-120.,cinacrmn=-80.) @@ -276,16 +278,20 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & errmsg = '' errflg = 0 + elocp = hvap/cp el2orc = hvap*hvap/(rv*cp) fact1 = (cvap-cliq)/rv fact2 = hvap/rv-fact1*t0c -! c----------------------------------------------------------------------- !> ## Determine whether to perform aerosol transport - do_aerosols = (itc > 0) .and. (ntc > 0) .and. (ntr > 0) - if (do_aerosols) do_aerosols = (ntr >= itc + ntc - 3) + if(hwrf_samfdeep) then + do_aerosols = .false. + else + do_aerosols = (itc > 0) .and. (ntc > 0) .and. (ntr > 0) + if (do_aerosols) do_aerosols = (ntr >= itc + ntc - 3) + endif ! c----------------------------------------------------------------------- !> ## Compute preliminary quantities needed for static, dynamic, and feedback control portions of the algorithm. @@ -335,6 +341,14 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & rainevap(i) = 0. gdx(i) = sqrt(garea(i)) enddo +! + if (hwrf_samfdeep) then + do i=1,im + scaldfunc(i)=-1.0 + sigmagfm(i)=-1.0 +! sigmuout(i)=-1.0 + enddo + endif ! !> - determine aerosol-aware rain conversion parameter over land do i=1,im @@ -404,22 +418,15 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & ! model tunable parameters are all here edtmaxl = .3 edtmaxs = .3 -! clam = .1 -! aafac = .1 - aafac = .05 -! betal = .15 -! betas = .15 -! betal = .05 -! betas = .05 -! evef = 0.07 -! evfact = 0.3 -! evfactl = 0.3 -! - crtlame = 1.0e-4 + if (hwrf_samfdeep) then + aafac = .1 + cxlamu = 1.0e-3 + else + aafac = .05 + crtlame = 1.0e-4 + cxlame = 1.0e-4 + endif crtlamd = 1.0e-4 -! -! cxlame = 1.0e-3 - cxlame = 1.0e-4 cxlamd = 1.0e-4 xlamde = 1.0e-4 xlamdd = 1.0e-4 @@ -471,10 +478,17 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & enddo !> - Calculate interface height do k = 1, km1 + do i=1,im + zi(i,k) = 0.5*(zo(i,k)+zo(i,k+1)) + enddo + enddo + if (hwrf_samfdeep) then + do k = 1, km1 do i=1,im - zi(i,k) = 0.5*(zo(i,k)+zo(i,k+1)) + xlamue(i,k) = clam / zi(i,k) enddo - enddo + enddo + endif c c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! c convert surface pressure to mb from cb @@ -520,6 +534,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & ! ! initialize tracer variables ! + if(.not.hwrf_samfdeep) then do n = 3, ntr+2 kk = n-2 do k = 1, km @@ -533,6 +548,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & enddo enddo enddo + endif ! !> - Calculate saturation specific humidity and enforce minimum moisture values. do k = 1, km @@ -629,6 +645,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo + if (.not.hwrf_samfdeep) then do n = 1, ntr do k = 1, km1 do i=1,im @@ -638,6 +655,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & enddo enddo enddo + endif c c look for the level of free convection as cloud base c @@ -739,7 +757,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & ! turbulent entrainment rate assumed to be proportional ! to subcloud mean TKE ! - if(ntk > 0) then + if(.not. hwrf_samfdeep .and. ntk > 0) then ! do i= 1, im if(cnvflg(i)) then @@ -795,7 +813,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & enddo endif ! - endif + endif !(.not. hwrf_samfdeep .and. ntk > 0) ! ! also initially assume updraft entrainment rate ! is an inverse function of height @@ -812,39 +830,49 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & c assume that updraft entrainment rate above cloud base is c same as that at cloud base c -!> - Calculate the entrainment rate according to Han and Pan (2011) \cite han_and_pan_2011 , equation 8, after Bechtold et al. (2008) \cite bechtold_et_al_2008, equation 2 given by: +!> - In HWRF samfdeep, calculate the entrainment rate according to Han and Pan (2011) \cite han_and_pan_2011 , equation 8, after Bechtold et al. (2008) \cite bechtold_et_al_2008, equation 2 given by: !! \f[ !! \epsilon = \epsilon_0F_0 + d_1\left(1-RH\right)F_1 !! \f] !! where \f$\epsilon_0\f$ is the cloud base entrainment rate, \f$d_1\f$ is a tunable constant, and \f$F_0=\left(\frac{q_s}{q_{s,b}}\right)^2\f$ and \f$F_1=\left(\frac{q_s}{q_{s,b}}\right)^3\f$ where \f$q_s\f$ and \f$q_{s,b}\f$ are the saturation specific humidities at a given level and cloud base, respectively. The detrainment rate in the cloud is assumed to be equal to the entrainment rate at cloud base. -! do i=1,im -! if(cnvflg(i)) then -! xlamx(i) = xlamue(i,kbcon(i)) -! endif -! enddo -! do k = 2, km1 -! do i=1,im -! if(cnvflg(i).and. -! & (k > kbcon(i) .and. k < kmax(i))) then -! xlamue(i,k) = xlamx(i) -! endif -! enddo -! enddo + if (hwrf_samfdeep) then + do i=1,im + if(cnvflg(i)) then + xlamx(i) = xlamue(i,kbcon(i)) + endif + enddo + do k = 2, km1 + do i=1,im + if(cnvflg(i).and. & + & (k > kbcon(i) .and. k < kmax(i))) then + xlamue(i,k) = xlamx(i) + endif + enddo + enddo + endif c c specify detrainment rate for the updrafts c !! (The updraft detrainment rate is set constant and equal to the entrainment rate at cloud base.) !! !> - The updraft detrainment rate is vertically constant and proportional to clamt - do k = 1, km1 + if (hwrf_samfdeep) then + do k = 1, km1 do i=1,im if(cnvflg(i) .and. k < kmax(i)) then -! xlamud(i,k) = xlamx(i) -! xlamud(i,k) = crtlamd - xlamud(i,k) = 0.001 * clamt(i) + xlamud(i,k) = xlamx(i) endif enddo - enddo + enddo + else + do k = 1, km1 + do i=1,im + if(cnvflg(i) .and. k < kmax(i)) then + xlamud(i,k) = 0.001 * clamt(i) + endif + enddo + enddo + endif c c entrainment functions decreasing with height (fent), c mimicking a cloud ensemble @@ -865,7 +893,18 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & c organized one depending on the environmental relative humidity c (Bechtold et al., 2008; Derbyshire et al., 2011) c - do k = 2, km1 + if (hwrf_samfdeep) then + do k = 2, km1 + do i=1,im + if(cnvflg(i) .and. + & (k > kbcon(i) .and. k < kmax(i))) then + tem = cxlamu * frh(i,k) * fent2(i,k) + xlamue(i,k) = xlamue(i,k)*fent1(i,k) + tem + endif + enddo + enddo + else + do k = 2, km1 do i=1,im if(cnvflg(i) .and. & (k > kbcon(i) .and. k < kmax(i))) then @@ -875,7 +914,8 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & xlamud(i,k) = xlamud(i,k) + tem1 endif enddo - enddo + enddo + endif ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! c @@ -934,15 +974,17 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & pwavo(i) = 0. endif enddo + if (.not.hwrf_samfdeep) then ! for tracers - do n = 1, ntr + do n = 1, ntr do i = 1, im if(cnvflg(i)) then indx = kb(i) ecko(i,indx,n) = ctro(i,indx,n) endif enddo - enddo + enddo + endif c c cloud property is modified by the entrainment process c @@ -973,8 +1015,9 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo - do n = 1, ntr - do k = 2, km1 + if (.not.hwrf_samfdeep) then + do n = 1, ntr + do k = 2, km1 do i = 1, im if (cnvflg(i)) then if(k > kb(i) .and. k < kmax(i)) then @@ -986,8 +1029,9 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & endif endif enddo - enddo - enddo + enddo + enddo + endif c c taking account into convection inhibition due to existence of c dry layers below cloud base @@ -1062,9 +1106,16 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & enddo enddo !> - Turn off convection if the CIN is less than a critical value (cinacr) which is inversely proportional to the large-scale vertical velocity. - do i = 1, im + if(hwrf_samfdeep) then + do i = 1, im + if(cnvflg(i)) then + cinacr = cinacrmx + if(cina(i) < cinacr) cnvflg(i) = .false. + endif + enddo + else !gfs_samfdeep + do i = 1, im if(cnvflg(i)) then -! if(islimsk(i) == 1) then w1 = w1l w2 = w2l @@ -1091,11 +1142,10 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & tem = 1. - tem tem1= .5*(cinacrmx-cinacrmn) cinacr = cinacrmx - tem * tem1 -! -! cinacr = cinacrmx if(cina(i) < cinacr) cnvflg(i) = .false. endif - enddo + enddo + endif !hwrf_samfdeep !! if(do_ca .and. ca_trigger)then do i=1,im @@ -1191,18 +1241,9 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & !> - Calculate the maximum value of the cloud base mass flux using the CFL-criterion-based formula of Han and Pan (2011) \cite han_and_pan_2011, equation 7. do i = 1, im if(cnvflg(i)) then -! xmbmax(i) = .1 -! k = kbcon(i) dp = 1000. * del(i,k) - xmbmax(i) = dp / (2. * grav * dt2) -! -! xmbmax(i) = dp / (grav * dt2) -! -! mbdt(i) = 0.1 * dp / grav -! -! tem = dp / (grav * dt2) -! xmbmax(i) = min(tem, xmbmax(i)) + xmbmax(i) = dp / (grav * dt2) endif enddo c @@ -1436,31 +1477,24 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & ! ! compute updraft velocity square(wu2) !> - Calculate updraft velocity square(wu2) according to Han et al.'s (2017) \cite han_et_al_2017 equation 7. -! -! bb1 = 2. * (1.+bet1*cd1) -! bb2 = 2. / (f1*(1.+gam1)) -! -! bb1 = 3.9 -! bb2 = 0.67 -! -! bb1 = 2.0 -! bb2 = 4.0 ! bb1 = 4.0 bb2 = 0.8 + if (hwrf_samfdeep) then + do i = 1, im + if (cnvflg(i)) then + k = kbcon1(i) + tem = po(i,k) / (rd * to(i,k)) + wucb = -0.01 * dot(i,k) / (tem * grav) + if(wucb.gt.0.) then + wu2(i,k) = wucb * wucb + else + wu2(i,k) = 0. + endif + endif + enddo + endif ! -! do i = 1, im -! if (cnvflg(i)) then -! k = kbcon1(i) -! tem = po(i,k) / (rd * to(i,k)) -! wucb = -0.01 * dot(i,k) / (tem * grav) -! if(wucb > 0.) then -! wu2(i,k) = wucb * wucb -! else -! wu2(i,k) = 0. -! endif -! endif -! enddo do k = 2, km1 do i = 1, im if (cnvflg(i)) then @@ -1611,28 +1645,41 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo - do i = 1, im + + if (hwrf_samfdeep) then + do i = 1, im + beta = betas + if(islimsk(i) == 1) beta = betal if(cnvflg(i)) then - betamn = betas - if(islimsk(i) == 1) betamn = betal - if(ntk > 0) then - betamx = betamn + dbeta - if(tkemean(i) > tkemx) then - beta = betamn - else if(tkemean(i) < tkemn) then - beta = betamx - else - tem = (betamx - betamn) * (tkemean(i) - tkemn) - beta = betamx - tem / dtke - endif - else - beta = betamn - endif dz = (sumx(i)+zi(i,1))/float(kbcon(i)) tem = 1./float(kbcon(i)) xlamd(i) = (1.-beta**tem)/dz endif - enddo + enddo + else + do i = 1, im + if(cnvflg(i)) then + betamn = betas + if(islimsk(i) == 1) betamn = betal + if(ntk > 0) then + betamx = betamn + dbeta + if(tkemean(i) > tkemx) then + beta = betamn + else if(tkemean(i) < tkemn) then + beta = betamx + else + tem = (betamx - betamn) * (tkemean(i) - tkemn) + beta = betamx - tem / dtke + endif + else + beta = betamn + endif + dz = (sumx(i)+zi(i,1))/float(kbcon(i)) + tem = 1./float(kbcon(i)) + xlamd(i) = (1.-beta**tem)/dz + endif + enddo + endif c c determine downdraft mass flux c @@ -1668,6 +1715,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & endif enddo ! for tracers + if (.not.hwrf_samfdeep) then do n = 1, ntr do i = 1, im if(cnvflg(i)) then @@ -1676,6 +1724,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo + endif cj !> - Calculate the cloud properties as a parcel descends, modified by entrainment and detrainment. Discretization follows Appendix B of Grell (1993) \cite grell_1993 . do k = km1, 1, -1 @@ -1705,6 +1754,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo + if(.not.hwrf_samfdeep) then do n = 1, ntr do k = km1, 1, -1 do i = 1, im @@ -1718,6 +1768,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & enddo enddo enddo + endif c !> - Compute the amount of moisture that is necessary to keep the downdraft saturated. do k = km1, 1, -1 @@ -1820,6 +1871,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo + if (.not.hwrf_samfdeep) then do n = 1, ntr do k = 1, km do i = 1, im @@ -1829,6 +1881,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & enddo enddo enddo + endif do i = 1, im if(cnvflg(i)) then dp = 1000. * del(i,1) @@ -1842,6 +1895,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & & - vo(i,1)) * grav / dp endif enddo + if (.not.hwrf_samfdeep) then do n = 1, ntr do i = 1, im if(cnvflg(i)) then @@ -1851,6 +1905,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo + endif c c--- changed due to subsidence and entrainment c @@ -1915,6 +1970,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo + if (.not.hwrf_samfdeep) then do n = 1, ntr do k = 2, km1 do i = 1, im @@ -1936,6 +1992,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & enddo enddo enddo + endif c c------- cloud top c @@ -1960,6 +2017,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & & qlko_ktcon(i) * grav / dp endif enddo + if (.not.hwrf_samfdeep) then do n = 1, ntr do i = 1, im if(cnvflg(i)) then @@ -1970,6 +2028,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo + endif c c------- final changed variable per unit mass flux c @@ -2336,7 +2395,17 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & ! compute convective turn-over time ! !> - Following Bechtold et al. (2008) \cite bechtold_et_al_2008, the convective adjustment time (dtconv) is set to be proportional to the convective turnover time, which is computed using the mean updraft velocity (wc) and the cloud depth. It is also proportional to the grid size (gdx). - do i= 1, im + if(hwrf_samfdeep) then + do i= 1, im + if(cnvflg(i)) then + tem = zi(i,ktcon1(i)) - zi(i,kbcon1(i)) + dtconv(i) = tem / wc(i) + dtconv(i) = max(dtconv(i),dtmin) + dtconv(i) = min(dtconv(i),dtmax) + endif + enddo + else + do i= 1, im if(cnvflg(i)) then tem = zi(i,ktcon1(i)) - zi(i,kbcon1(i)) dtconv(i) = tem / wc(i) @@ -2345,7 +2414,8 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & dtconv(i) = max(dtconv(i),dtmin) dtconv(i) = min(dtconv(i),dtmax) endif - enddo + enddo + endif ! !> - Calculate advective time scale (tauadv) using a mean cloud layer wind speed. do i= 1, im @@ -2424,7 +2494,6 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & tfac = tauadv(i) / dtconv(i) tfac = min(tfac, 1.) xmb(i) = -tfac * fld(i) / xk(i) -! xmb(i) = min(xmb(i),xmbmax(i)) endif enddo !! @@ -2438,6 +2507,18 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & !! ! !> - For scale-aware parameterization, the updraft fraction (sigmagfm) is first computed as a function of the lateral entrainment rate at cloud base (see Han et al.'s (2017) \cite han_et_al_2017 equation 4 and 5), following the study by Grell and Freitas (2014) \cite grell_and_freitas_2014. + if(hwrf_samfdeep) then + do i = 1, im + if(cnvflg(i)) then + tem = min(max(xlamx(i), 7.e-5), 3.e-4) + tem = 0.2 / tem + tem1 = 3.14 * tem * tem + sigmagfm(i) = tem1 / garea(i) + sigmagfm(i) = max(sigmagfm(i), 0.001) + sigmagfm(i) = min(sigmagfm(i), 0.999) + endif + enddo + else do i = 1, im if(cnvflg(i)) then tem = min(max(xlamue(i,kbcon(i)), 7.e-5), 3.e-4) @@ -2448,6 +2529,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & sigmagfm(i) = min(sigmagfm(i), 0.999) endif enddo + endif ! !> - Then, calculate the reduction factor (scaldfunc) of the vertical convective eddy transport of mass flux as a function of updraft fraction from the studies by Arakawa and Wu (2013) \cite arakawa_and_wu_2013 (also see Han et al.'s (2017) \cite han_et_al_2017 equation 1 and 2). The final cloud base mass flux with scale-aware parameterization is obtained from the mass flux when sigmagfm << 1, multiplied by the reduction factor (Han et al.'s (2017) \cite han_et_al_2017 equation 2). do i = 1, im @@ -2498,15 +2580,17 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo - do n = 1, ntr - do k = 1, km + if (.not.hwrf_samfdeep) then + do n = 1, ntr + do k = 1, km do i = 1, im if (cnvflg(i) .and. k <= kmax(i)) then ctro(i,k,n) = ctr(i,k,n) endif enddo - enddo - enddo + enddo + enddo + endif c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! c c--- feedback: simply the changes from the cloud with unit mass flux @@ -2525,11 +2609,13 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & delvbar(i) = 0. qcond(i) = 0. enddo - do n = 1, ntr - do i = 1, im - delebar(i,n) = 0. - enddo - enddo + if (.not.hwrf_samfdeep) then + do n = 1, ntr + do i = 1, im + delebar(i,n) = 0. + enddo + enddo + endif do k = 1, km do i = 1, im if (cnvflg(i) .and. k <= kmax(i)) then @@ -2552,9 +2638,10 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo - do n = 1, ntr - kk = n+2 - do k = 1, km + if (.not.hwrf_samfdeep) then + do n = 1, ntr + kk = n+2 + do k = 1, km do i = 1, im if (cnvflg(i) .and. k <= kmax(i)) then if(k <= ktcon(i)) then @@ -2564,8 +2651,9 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & endif endif enddo - enddo - enddo + enddo + enddo + endif !> - Recalculate saturation specific humidity using the updated temperature. do k = 1, km do i = 1, im @@ -2757,6 +2845,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo + if (.not.hwrf_samfdeep) then do n = 1, ntr kk = n+2 do k = 1, km @@ -2784,6 +2873,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & enddo enddo endif + endif ! ! hchuang code change ! @@ -2819,6 +2909,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & ! ! include TKE contribution from deep convection ! + if (.not.hwrf_samfdeep) then if (ntk > 0) then ! do k = 2, km1 @@ -2866,6 +2957,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & enddo enddo endif + endif ! (.not.hwrf_samfdeep) return end subroutine samfdeepcnv_run diff --git a/physics/samfdeepcnv.meta b/physics/samfdeepcnv.meta index 6f7ec3166..2a134bac7 100644 --- a/physics/samfdeepcnv.meta +++ b/physics/samfdeepcnv.meta @@ -257,6 +257,12 @@ kind = kind_phys intent = in optional = F +[hwrf_samfdeep] + standard_name = flag_for_hwrf_samfdeepcnv_scheme + long_name = flag for hwrf samfdeepcnv scheme + units = flag + dimensions = () + type = logical [nthresh] standard_name = threshold_for_perturbed_vertical_velocity long_name = threshold used for perturbed vertical velocity diff --git a/physics/samfshalcnv.f b/physics/samfshalcnv.f index 36dab1c9a..e48962822 100644 --- a/physics/samfshalcnv.f +++ b/physics/samfshalcnv.f @@ -55,7 +55,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & & prslp,psp,phil,qtr,q1,t1,u1,v1,fscav, & & rn,kbot,ktop,kcnv,islimsk,garea, & & dot,ncloud,hpbl,ud_mf,dt_mf,cnvw,cnvc, & - & clam,c0s,c1,pgcon,asolfac,errmsg,errflg) + & clam,c0s,c1,pgcon,asolfac,hwrf_samfshal,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -82,6 +82,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & ! real(kind=kind_phys), intent(in) :: clam, c0s, c1, & & asolfac, pgcon + logical, intent(in) :: hwrf_samfshal character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! @@ -140,8 +141,8 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & ! ! parameters for updraft velocity calculation real(kind=kind_phys) bet1, cd1, f1, gam1, - & bb1, bb2 -! & bb1, bb2, wucb +! & bb1, bb2 + & bb1, bb2, wucb cc c physical parameters @@ -167,8 +168,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & parameter(dtke=tkemx-tkemn) parameter(dthk=25.) parameter(cinpcrmx=180.,cinpcrmn=120.) -! parameter(cinacrmx=-120.,cinacrmn=-120.) - parameter(cinacrmx=-120.,cinacrmn=-80.) + parameter(cinacrmx=-120.) parameter(crtlamd=3.e-4) parameter(dtmax=10800.,dtmin=600.) parameter(bet1=1.875,cd1=.506,f1=2.0,gam1=.5) @@ -202,7 +202,8 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & ! real(kind=kind_phys) tf, tcr, tcrf parameter (tf=233.16, tcr=263.16, tcrf=1.0/(tcr-tf)) -! + + c----------------------------------------------------------------------- ! ! Initialize CCPP error handling variables @@ -215,10 +216,16 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & fact1 = (cvap-cliq)/rv fact2 = hvap/rv-fact1*t0c + if (.not.hwrf_samfshal) then + cinacrmn=-80. + endif + c----------------------------------------------------------------------- + if (.not.hwrf_samfshal) then !> ## Determine whether to perform aerosol transport - do_aerosols = (itc > 0) .and. (ntc > 0) .and. (ntr > 0) - if (do_aerosols) do_aerosols = (ntr >= itc + ntc - 3) + do_aerosols = (itc > 0) .and. (ntc > 0) .and. (ntr > 0) + if (do_aerosols) do_aerosols = (ntr >= itc + ntc - 3) + endif ! !************************************************************************ ! convert input Pa terms to Cb terms -- Moorthi @@ -234,7 +241,8 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & c initialize arrays c !> - Initialize column-integrated and other single-value-per-column variable arrays. - do i=1,im + if(hwrf_samfshal) then + do i=1,im cnvflg(i) = .true. if(kcnv(i) == 1) cnvflg(i) = .false. if(cnvflg(i)) then @@ -253,7 +261,32 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & cina(i) = 0. vshear(i) = 0. gdx(i) = sqrt(garea(i)) - enddo + scaldfunc(i)=-1.0 ! wang initialized + sigmagfm(i)=-1.0 + enddo + + else !gfs_samfshal + do i=1,im + cnvflg(i) = .true. + if(kcnv(i) == 1) cnvflg(i) = .false. + if(cnvflg(i)) then + kbot(i)=km+1 + ktop(i)=0 + endif + rn(i)=0. + kbcon(i)=km + ktcon(i)=1 + ktconn(i)=1 + kb(i)=km + pdot(i) = 0. + qlko_ktcon(i) = 0. + edt(i) = 0. + aa1(i) = 0. + cina(i) = 0. + vshear(i) = 0. + gdx(i) = sqrt(garea(i)) + enddo + endif !! !> - Return to the calling routine if deep convection is present or the surface buoyancy flux is negative. totflg = .true. @@ -303,15 +336,15 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & dt2 = delt ! c model tunable parameters are all here -! clam = .3 -! aafac = .1 - aafac = .05 + if (hwrf_samfshal) then + aafac = .1 + else + aafac = .05 + endif c evef = 0.07 evfact = 0.3 evfactl = 0.3 ! -! pgcon = 0.7 ! Gregory et al. (1997, QJRMS) -! pgcon = 0.55 ! Zhang & Wu (2003,JAS) w1l = -8.e-3 w2l = -4.e-2 w3l = -5.e-3 @@ -351,11 +384,23 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & enddo enddo !> - Calculate interface height - do k = 1, km1 + if(hwrf_samfshal) then + do k = 1, km1 do i=1,im zi(i,k) = 0.5*(zo(i,k)+zo(i,k+1)) + xlamue(i,k) = clam / zi(i,k) enddo - enddo + enddo + do i=1,im + xlamue(i,km) = xlamue(i,km1) + enddo + else + do k = 1, km1 + do i=1,im + zi(i,k) = 0.5*(zo(i,k)+zo(i,k+1)) + enddo + enddo + endif c c pbl height c @@ -410,8 +455,9 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & ! ! initialize tracer variables ! - do n = 3, ntr+2 - kk = n-2 + if (.not.hwrf_samfshal) then + do n = 3, ntr+2 + kk = n-2 do k = 1, km do i = 1, im if (cnvflg(i) .and. k <= kmax(i)) then @@ -421,7 +467,8 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo - enddo + enddo + endif !> - Calculate saturation specific humidity and enforce minimum moisture values. do k = 1, km do i=1,im @@ -517,15 +564,18 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo - do n = 1, ntr - do k = 1, km1 + + if (.not.hwrf_samfshal) then + do n = 1, ntr + do k = 1, km1 do i=1,im if (cnvflg(i) .and. k <= kmax(i)-1) then ctro(i,k,n) = .5 * (ctro(i,k,n) + ctro(i,k+1,n)) endif enddo - enddo - enddo + enddo + enddo + endif c c look for the level of free convection as cloud base c @@ -597,6 +647,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & ptem1= .5*(cinpcrmx-cinpcrmn) cinpcr = cinpcrmx - ptem * ptem1 tem1 = pfld(i,kb(i)) - pfld(i,kbcon(i)) + if(tem1 > cinpcr) then cnvflg(i) = .false. endif @@ -612,14 +663,27 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & ! turbulent entrainment rate assumed to be proportional ! to subcloud mean TKE ! - if(ntk > 0) then ! + +!c +!c specify the detrainment rate for the updrafts +!c + if (hwrf_samfshal) then + do i = 1, im + if(cnvflg(i)) then + xlamud(i) = xlamue(i,kbcon(i)) +! xlamud(i) = crtlamd + endif + enddo + else + if(ntk > 0) then do i= 1, im if(cnvflg(i)) then sumx(i) = 0. tkemean(i) = 0. endif enddo + do k = 1, km1 do i = 1, im if(cnvflg(i)) then @@ -687,6 +751,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & xlamud(i) = 0.001 * clamt(i) endif enddo + endif ! hwrf_samfshal c c determine updraft mass flux for the subcloud layers c @@ -742,6 +807,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & endif enddo ! for tracers + if (.not. hwrf_samfshal) then do n = 1, ntr do i = 1, im if(cnvflg(i)) then @@ -750,6 +816,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo + endif c ! cm is an enhancement factor in entrainment rates for momentum ! @@ -778,8 +845,10 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo - do n = 1, ntr - do k = 2, km1 + + if (.not.hwrf_samfshal) then + do n = 1, ntr + do k = 2, km1 do i = 1, im if (cnvflg(i)) then if(k > kb(i) .and. k < kmax(i)) then @@ -791,8 +860,9 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & endif endif enddo - enddo - enddo + enddo + enddo + endif c c taking account into convection inhibition due to existence of c dry layers below cloud base @@ -859,9 +929,17 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & enddo enddo !> - Turn off convection if the CIN is less than a critical value (cinacr) which is inversely proportional to the large-scale vertical velocity. - do i = 1, im + + if (hwrf_samfshal) then + do i = 1, im + if(cnvflg(i)) then + cinacr = cinacrmx + if(cina(i) < cinacr) cnvflg(i) = .false. + endif + enddo + else + do i = 1, im if(cnvflg(i)) then -! if(islimsk(i) == 1) then w1 = w1l w2 = w2l @@ -888,11 +966,10 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & tem = 1. - tem tem1= .5*(cinacrmx-cinacrmn) cinacr = cinacrmx - tem * tem1 -! -! cinacr = cinacrmx if(cina(i) < cinacr) cnvflg(i) = .false. - endif - enddo + endif + enddo + endif !! totflg = .true. do i=1,im @@ -923,20 +1000,23 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & c specify upper limit of mass flux at cloud base c !> - Calculate the maximum value of the cloud base mass flux using the CFL-criterion-based formula of Han and Pan (2011) \cite han_and_pan_2011, equation 7. - do i = 1, im + if(hwrf_samfshal) then + do i = 1, im + if(cnvflg(i)) then + k = kbcon(i) + dp = 1000. * del(i,k) + xmbmax(i) = dp / (grav * dt2) + endif + enddo + else + do i = 1, im if(cnvflg(i)) then -! xmbmax(i) = .1 -! k = kbcon(i) dp = 1000. * del(i,k) xmbmax(i) = dp / (2. * grav * dt2) -! -! xmbmax(i) = dp / (grav * dt2) -! -! tem = dp / (grav * dt2) -! xmbmax(i) = min(tem, xmbmax(i)) endif - enddo + enddo + endif c c compute cloud moisture property and precipitation c @@ -1156,31 +1236,24 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & ! ! compute updraft velocity square(wu2) !> - Calculate updraft velocity square(wu2) according to Han et al.'s (2017) \cite han_et_al_2017 equation 7. -! -! bb1 = 2. * (1.+bet1*cd1) -! bb2 = 2. / (f1*(1.+gam1)) -! -! bb1 = 3.9 -! bb2 = 0.67 -! -! bb1 = 2.0 -! bb2 = 4.0 ! bb1 = 4.0 bb2 = 0.8 ! -! do i = 1, im -! if (cnvflg(i)) then -! k = kbcon1(i) -! tem = po(i,k) / (rd * to(i,k)) -! wucb = -0.01 * dot(i,k) / (tem * grav) -! if(wucb > 0.) then -! wu2(i,k) = wucb * wucb -! else -! wu2(i,k) = 0. -! endif -! endif -! enddo + if (hwrf_samfshal) then + do i = 1, im + if (cnvflg(i)) then + k = kbcon1(i) + tem = po(i,k) / (rd * to(i,k)) + wucb = -0.01 * dot(i,k) / (tem * grav) + if(wucb > 0.) then + wu2(i,k) = wucb * wucb + else + wu2(i,k) = 0. + endif + endif + enddo + endif do k = 2, km1 do i = 1, im if (cnvflg(i)) then @@ -1314,15 +1387,17 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo - do n = 1, ntr - do k = 1, km + if (.not.hwrf_samfshal) then + do n = 1, ntr + do k = 1, km do i = 1, im if(cnvflg(i) .and. k <= kmax(i)) then dellae(i,k,n) = 0. endif enddo - enddo - enddo + enddo + enddo + endif c c--- changed due to subsidence and entrainment c @@ -1367,8 +1442,9 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo - do n = 1, ntr - do k = 2, km1 + if(.not.hwrf_samfshal) then + do n = 1, ntr + do k = 2, km1 do i = 1, im if (cnvflg(i)) then if(k > kb(i) .and. k < ktcon(i)) then @@ -1381,8 +1457,9 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & endif endif enddo - enddo - enddo + enddo + enddo + endif c c------- cloud top c @@ -1407,6 +1484,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & & qlko_ktcon(i) * grav / dp endif enddo + if (.not.hwrf_samfshal) then do n = 1, ntr do i = 1, im if(cnvflg(i)) then @@ -1417,6 +1495,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo + endif ! ! compute convective turn-over time ! @@ -1425,8 +1504,10 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & if(cnvflg(i)) then tem = zi(i,ktcon1(i)) - zi(i,kbcon1(i)) dtconv(i) = tem / wc(i) - tfac = 1. + gdx(i) / 75000. - dtconv(i) = tfac * dtconv(i) + if (.not.hwrf_samfshal) then + tfac = 1. + gdx(i) / 75000. + dtconv(i) = tfac * dtconv(i) + endif dtconv(i) = max(dtconv(i),dtmin) dtconv(i) = max(dtconv(i),dt2) dtconv(i) = min(dtconv(i),dtmax) @@ -1503,13 +1584,15 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & ! !> - Transport aerosols if present ! - if (do_aerosols) + if (.not.hwrf_samfshal) then + if (do_aerosols) & call samfshalcnv_aerosols(im, im, km, itc, ntc, ntr, delt, ! & xlamde, xlamdd, cnvflg, jmin, kb, kmax, kbcon, ktcon, fscav, & cnvflg, kb, kmax, kbcon, ktcon, fscav, ! & edto, xlamd, xmb, c0t, eta, etad, zi, xlamue, xlamud, delp, & xmb, c0t, eta, zi, xlamue, xlamud, delp, & qtr, qaero) + endif ! !> ## For the "feedback control", calculate updated values of the state variables by multiplying the cloud base mass flux and the tendencies calculated per unit cloud base mass flux from the static control. !! - Recalculate saturation specific humidity. @@ -1539,11 +1622,13 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & delvbar(i) = 0. qcond(i) = 0. enddo - do n = 1, ntr - do i = 1, im + if (.not. hwrf_samfshal) then + do n = 1, ntr + do i = 1, im delebar(i,n) = 0. - enddo - enddo + enddo + enddo + endif do k = 1, km do i = 1, im if (cnvflg(i)) then @@ -1566,6 +1651,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo + if (.not.hwrf_samfshal) then do n = 1, ntr kk = n+2 do k = 1, km @@ -1580,6 +1666,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & enddo enddo enddo + endif ! !> - Recalculate saturation specific humidity using the updated temperature. do k = 1, km @@ -1750,7 +1837,8 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & ! endif !> - Store aerosol concentrations if present - if (do_aerosols) then + if (.not. hwrf_samfshal) then + if (do_aerosols) then do n = 1, ntc kk = n + itc - 1 do k = 1, km @@ -1762,6 +1850,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & enddo enddo endif + endif ! ! hchuang code change ! @@ -1787,6 +1876,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & ! ! include TKE contribution from shallow convection ! + if (.not.hwrf_samfshal) then if (ntk > 0) then ! do k = 2, km1 @@ -1804,6 +1894,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & enddo ! endif + endif !! return end subroutine samfshalcnv_run diff --git a/physics/samfshalcnv.meta b/physics/samfshalcnv.meta index 156cda581..0fd6c2922 100644 --- a/physics/samfshalcnv.meta +++ b/physics/samfshalcnv.meta @@ -414,6 +414,14 @@ kind = kind_phys intent = in optional = F +[hwrf_samfshal] + standard_name = flag_for_hwrf_samfshalcnv_scheme + long_name = flag for hwrf samfshalcnv scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index c71663dc7..f192788fe 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -59,8 +59,8 @@ end subroutine satmedmfvdifq_finalize !! @{ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & & grav,rd,cp,rv,hvap,hfus,fv,eps,epsm1, & - & dv,du,tdt,rtg,u1,v1,t1,q1,swh,hlw,xmu,garea, & - & psk,rbsoil,zorl,u10m,v10m,fm,fh, & + & dv,du,tdt,rtg,u1,v1,t1,q1,swh,hlw,xmu,garea,islimsk, & + & snwdph_lnd,psk,rbsoil,zorl,u10m,v10m,fm,fh, & & tsea,heat,evap,stress,spd1,kpbl, & & prsi,del,prsl,prslk,phii,phil,delt, & & dspheat,dusfc,dvsfc,dtsfc,dqsfc,hpbl, & @@ -76,6 +76,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & !---------------------------------------------------------------------- integer, intent(in) :: im, km, ntrac, ntcw, ntiw, ntke, ntoz integer, intent(in) :: kinver(im) + integer, intent(in) :: islimsk(im) integer, intent(out) :: kpbl(im) logical, intent(in) :: ldiag3d,qdiag3d ! @@ -90,6 +91,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & & t1(im,km), q1(im,km,ntrac), & & swh(im,km), hlw(im,km), & & xmu(im), garea(im), & + & snwdph_lnd(im), & & psk(im), rbsoil(im), & & zorl(im), tsea(im), & & u10m(im), v10m(im), & @@ -207,6 +209,8 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & & zlup, zldn, bsum, & tem, tem1, tem2, & ptem, ptem0, ptem1, ptem2 +! + real(kind=kind_phys) xkzm_mp, xkzm_hp ! real(kind=kind_phys) ck0, ck1, ch0, ch1, ce0, rchck ! @@ -218,7 +222,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & parameter(gamcrt=3.,gamcrq=0.,sfcfrac=0.1) parameter(vk=0.4,rimin=-100.) parameter(rbcr=0.25,zolcru=-0.02,tdzmin=1.e-3) - parameter(rlmn=30.,rlmn1=5.,rlmn2=15.) + parameter(rlmn=30.,rlmn1=5.,rlmn2=10.) parameter(rlmx=300.,elmx=300.) parameter(prmin=0.25,prmax=4.0) parameter(pr0=1.0,prtke=1.0,prscu=0.67) @@ -228,7 +232,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & parameter(aphi5=5.,aphi16=16.) parameter(elmfac=1.0,elefac=1.0,cql=100.) parameter(dw2min=1.e-4,dkmax=1000.,xkgdx=5000.) - parameter(qlcr=3.5e-5,zstblmax=2500.,xkzinv=0.15) + parameter(qlcr=3.5e-5,zstblmax=2500.,xkzinv=0.1) parameter(h1=0.33333333) parameter(ck0=0.4,ck1=0.15,ch0=0.4,ch1=0.15) parameter(ce0=0.4) @@ -323,16 +327,31 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & !! \n xkzm_mx = 0.01 + (xkzm_h - 0.01)/(xkgdx-5.) * (gdx-5.) do i=1,im + xkzm_mp = xkzm_m + xkzm_hp = xkzm_h +! + if( islimsk(i) == 1 .and. snwdph_lnd(i) > 10.0 ) then ! over land + if (rbsoil(i) > 0. .and. rbsoil(i) <= 0.25) then + xkzm_mp = xkzm_m * (1.0 - rbsoil(i)/0.25)**2 + + & 0.1 * (1.0 - (1.0-rbsoil(i)/0.25)**2) + xkzm_hp = xkzm_h * (1.0 - rbsoil(i)/0.25)**2 + + & 0.1 * (1.0 - (1.0-rbsoil(i)/0.25)**2) + else if (rbsoil(i) > 0.25) then + xkzm_mp = 0.1 + xkzm_hp = 0.1 + endif + endif +! kx1(i) = 1 tx1(i) = 1.0 / prsi(i,1) tx2(i) = tx1(i) if(gdx(i) >= xkgdx) then - xkzm_hx(i) = xkzm_h - xkzm_mx(i) = xkzm_m + xkzm_hx(i) = xkzm_hp + xkzm_mx(i) = xkzm_mp else tem = 1. / (xkgdx - 5.) - tem1 = (xkzm_h - 0.01) * tem - tem2 = (xkzm_m - 0.01) * tem + tem1 = (xkzm_hp - 0.01) * tem + tem2 = (xkzm_mp - 0.01) * tem ptem = gdx(i) - 5. xkzm_hx(i) = 0.01 + tem1 * ptem xkzm_mx(i) = 0.01 + tem2 * ptem @@ -839,7 +858,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & ! tem1 = (tvx(i,k+1)-tvx(i,k)) * rdzt(i,k) ! if(tem1 > 1.e-5) then tem1 = tvx(i,k+1)-tvx(i,k) - if(tem1 > 0.) then + if(tem1 > 0. .and. islimsk(i) /= 1) then xkzo(i,k) = min(xkzo(i,k), xkzinv) xkzmo(i,k) = min(xkzmo(i,k), xkzinv) rlmnz(i,k) = min(rlmnz(i,k), rlmn2) diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index c0cefb632..397d71537 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -276,6 +276,23 @@ kind = kind_phys intent = in optional = F +[islimsk] + standard_name = sea_land_ice_mask + long_name = sea/land/ice mask (=0/1/2) + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[snwdph_lnd] + standard_name = surface_snow_thickness_water_equivalent_over_land + long_name = water equivalent snow depth over land + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [psk] standard_name = dimensionless_exner_function_at_lowest_model_interface long_name = dimensionless Exner function at the surface interface diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index c2ebf8257..fd35d5964 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -68,19 +68,19 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & flag_iter,redrag, & !intent(in) & u10m,v10m,sfc_z0_type, & !hafs,z0 type !intent(in) & wet,dry,icy, & !intent(in) - & tskin_ocn, tskin_lnd, tskin_ice, & !intent(in) - & tsurf_ocn, tsurf_lnd, tsurf_ice, & !intent(in) - & snwdph_ocn,snwdph_lnd,snwdph_ice, & !intent(in) - & z0rl_ocn, z0rl_lnd, z0rl_ice, & !intent(inout) - & ustar_ocn, ustar_lnd, ustar_ice, & !intent(inout) - & cm_ocn, cm_lnd, cm_ice, & !intent(inout) - & ch_ocn, ch_lnd, ch_ice, & !intent(inout) - & rb_ocn, rb_lnd, rb_ice, & !intent(inout) - & stress_ocn,stress_lnd,stress_ice, & !intent(inout) - & fm_ocn, fm_lnd, fm_ice, & !intent(inout) - & fh_ocn, fh_lnd, fh_ice, & !intent(inout) - & fm10_ocn, fm10_lnd, fm10_ice, & !intent(inout) - & fh2_ocn, fh2_lnd, fh2_ice, & !intent(inout) + & tskin_wat, tskin_lnd, tskin_ice, & !intent(in) + & tsurf_wat, tsurf_lnd, tsurf_ice, & !intent(in) + & snwdph_wat,snwdph_lnd,snwdph_ice, & !intent(in) + & z0rl_wat, z0rl_lnd, z0rl_ice, & !intent(inout) + & ustar_wat, ustar_lnd, ustar_ice, & !intent(inout) + & cm_wat, cm_lnd, cm_ice, & !intent(inout) + & ch_wat, ch_lnd, ch_ice, & !intent(inout) + & rb_wat, rb_lnd, rb_ice, & !intent(inout) + & stress_wat,stress_lnd,stress_ice, & !intent(inout) + & fm_wat, fm_lnd, fm_ice, & !intent(inout) + & fh_wat, fh_lnd, fh_ice, & !intent(inout) + & fm10_wat, fm10_lnd, fm10_ice, & !intent(inout) + & fh2_wat, fh2_lnd, fh2_ice, & !intent(inout) & errmsg, errflg) !intent(out) ! implicit none @@ -100,21 +100,21 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & wind,sigmaf,shdmax, & & z0pert,ztpert ! mg, sfc-perts real(kind=kind_phys), dimension(im), intent(in) :: & - & tskin_ocn, tskin_lnd, tskin_ice, & - & tsurf_ocn, tsurf_lnd, tsurf_ice, & - & snwdph_ocn,snwdph_lnd,snwdph_ice + & tskin_wat, tskin_lnd, tskin_ice, & + & tsurf_wat, tsurf_lnd, tsurf_ice, & + & snwdph_wat,snwdph_lnd,snwdph_ice real(kind=kind_phys), dimension(im), intent(inout) :: & - & z0rl_ocn, z0rl_lnd, z0rl_ice, & - & ustar_ocn, ustar_lnd, ustar_ice, & - & cm_ocn, cm_lnd, cm_ice, & - & ch_ocn, ch_lnd, ch_ice, & - & rb_ocn, rb_lnd, rb_ice, & - & stress_ocn,stress_lnd,stress_ice, & - & fm_ocn, fm_lnd, fm_ice, & - & fh_ocn, fh_lnd, fh_ice, & - & fm10_ocn, fm10_lnd, fm10_ice, & - & fh2_ocn, fh2_lnd, fh2_ice + & z0rl_wat, z0rl_lnd, z0rl_ice, & + & ustar_wat, ustar_lnd, ustar_ice, & + & cm_wat, cm_lnd, cm_ice, & + & ch_wat, ch_lnd, ch_ice, & + & rb_wat, rb_lnd, rb_ice, & + & stress_wat,stress_lnd,stress_ice, & + & fm_wat, fm_lnd, fm_ice, & + & fh_wat, fh_lnd, fh_ice, & + & fm10_wat, fm10_lnd, fm10_ice, & + & fh2_wat, fh2_lnd, fh2_ice character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! @@ -220,15 +220,11 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0max = max(z0max, 1.0e-6) ! czilc = 10.0 ** (- (0.40/0.07) * z0) ! fei's canopy height dependance of czil -! czilc = 0.8 + czilc = 0.8 -! tem1 = 1.0 - sigmaf(i) -! ztmax = z0max*exp( - tem1*tem1 -! & * czilc*ca*sqrt(ustar_lnd(i)*(0.01/1.5e-05))) -! - czilc = 10.0 ** (- 4. * z0max) ! Trier et al. (2011, WAF) - ztmax = z0max * exp( - czilc * ca - & * 258.2 * sqrt(ustar_lnd(i)*z0max) ) + tem1 = 1.0 - sigmaf(i) + ztmax = z0max*exp( - tem1*tem1 + & * czilc*ca*sqrt(ustar_lnd(i)*(0.01/1.5e-05))) ! mg, sfc-perts: add surface perturbations to ztmax/z0max ratio over land @@ -265,15 +261,11 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! czilc = 10.0 ** (- (0.40/0.07) * z0) ! fei's canopy height ! dependance of czil -! czilc = 0.8 - -! tem1 = 1.0 - sigmaf(i) -! ztmax = z0max*exp( - tem1*tem1 -! & * czilc*ca*sqrt(ustar_ice(i)*(0.01/1.5e-05))) - czilc = 10.0 ** (- 4. * z0max) ! Trier et al. (2011, WAF) - ztmax = z0max * exp( - czilc * ca - & * 258.2 * sqrt(ustar_ice(i)*z0max) ) + czilc = 0.8 + tem1 = 1.0 - sigmaf(i) + ztmax = z0max*exp( - tem1*tem1 + & * czilc*ca*sqrt(ustar_ice(i)*(0.01/1.5e-05))) ztmax = max(ztmax, 1.0e-6) ! call stability @@ -289,17 +281,17 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! the stuff now put into "stability" if (wet(i)) then ! Some open ocean - tvs = 0.5 * (tsurf_ocn(i)+tskin_ocn(i)) * virtfac - z0 = 0.01 * z0rl_ocn(i) + tvs = 0.5 * (tsurf_wat(i)+tskin_wat(i)) * virtfac + z0 = 0.01 * z0rl_wat(i) z0max = max(1.0e-6, min(z0,z1(i))) - ustar_ocn(i) = sqrt(grav * z0 / charnock) + ustar_wat(i) = sqrt(grav * z0 / charnock) wind10m = sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i)) !** test xubin's new z0 ! ztmax = z0max - restar = max(ustar_ocn(i)*z0max*visi, 0.000001) + restar = max(ustar_wat(i)*z0max*visi, 0.000001) ! restar = log(restar) ! restar = min(restar,5.) @@ -322,17 +314,17 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! call stability ! --- inputs: - & (z1(i), snwdph_ocn(i), thv1, wind(i), + & (z1(i), snwdph_wat(i), thv1, wind(i), & z0max, ztmax, tvs, grav, ! --- outputs: - & rb_ocn(i), fm_ocn(i), fh_ocn(i), fm10_ocn(i), fh2_ocn(i), - & cm_ocn(i), ch_ocn(i), stress_ocn(i), ustar_ocn(i)) + & rb_wat(i), fm_wat(i), fh_wat(i), fm10_wat(i), fh2_wat(i), + & cm_wat(i), ch_wat(i), stress_wat(i), ustar_wat(i)) ! ! update z0 over ocean ! if (sfc_z0_type >= 0) then if (sfc_z0_type == 0) then - z0 = (charnock / grav) * ustar_ocn(i) * ustar_ocn(i) + z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) ! mbek -- toga-coare flux algorithm ! z0 = (charnock / grav) * ustar(i)*ustar(i) + arnu/ustar(i) @@ -343,21 +335,20 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! z0 = arnu / (ustar(i) * ff ** pp) if (redrag) then - z0rl_ocn(i) = 100.0 * max(min(z0, z0s_max), 1.e-7) + z0rl_wat(i) = 100.0 * max(min(z0, z0s_max), 1.e-7) else - z0rl_ocn(i) = 100.0 * max(min(z0,.1), 1.e-7) + z0rl_wat(i) = 100.0 * max(min(z0,.1), 1.e-7) endif elseif (sfc_z0_type == 6) then ! wang call znot_m_v6(wind10m, z0) ! wind, m/s, z0, m - z0rl_ocn(i) = 100.0 * z0 ! cm + z0rl_wat(i) = 100.0 * z0 ! cm elseif (sfc_z0_type == 7) then ! wang call znot_m_v7(wind10m, z0) ! wind, m/s, z0, m - z0rl_ocn(i) = 100.0 * z0 ! cm + z0rl_wat(i) = 100.0 * z0 ! cm else - z0rl_ocn(i) = 1.0e-4 + z0rl_wat(i) = 1.0e-4 endif - endif endif ! end of if(open ocean) ! diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index 232b0050f..ab99dcb06 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -244,7 +244,7 @@ type = logical intent = in optional = F -[tskin_ocn] +[tskin_wat] standard_name = surface_skin_temperature_over_ocean_interstitial long_name = surface skin temperature over ocean (temporary use as interstitial) units = K @@ -271,7 +271,7 @@ kind = kind_phys intent = in optional = F -[tsurf_ocn] +[tsurf_wat] standard_name = surface_skin_temperature_after_iteration_over_ocean long_name = surface skin temperature after iteration over ocean units = K @@ -298,7 +298,7 @@ kind = kind_phys intent = in optional = F -[snwdph_ocn] +[snwdph_wat] standard_name = surface_snow_thickness_water_equivalent_over_ocean long_name = water equivalent snow depth over ocean units = mm @@ -325,7 +325,7 @@ kind = kind_phys intent = in optional = F -[z0rl_ocn] +[z0rl_wat] standard_name = surface_roughness_length_over_ocean_interstitial long_name = surface roughness length over ocean (temporary use as interstitial) units = cm @@ -352,7 +352,7 @@ kind = kind_phys intent = inout optional = F -[ustar_ocn] +[ustar_wat] standard_name = surface_friction_velocity_over_ocean long_name = surface friction velocity over ocean units = m s-1 @@ -379,7 +379,7 @@ kind = kind_phys intent = inout optional = F -[cm_ocn] +[cm_wat] standard_name = surface_drag_coefficient_for_momentum_in_air_over_ocean long_name = surface exchange coeff for momentum over ocean units = none @@ -406,7 +406,7 @@ kind = kind_phys intent = inout optional = F -[ch_ocn] +[ch_wat] standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean long_name = surface exchange coeff heat & moisture over ocean units = none @@ -433,7 +433,7 @@ kind = kind_phys intent = inout optional = F -[rb_ocn] +[rb_wat] standard_name = bulk_richardson_number_at_lowest_model_level_over_ocean long_name = bulk Richardson number at the surface over ocean units = none @@ -460,7 +460,7 @@ kind = kind_phys intent = inout optional = F -[stress_ocn] +[stress_wat] standard_name = surface_wind_stress_over_ocean long_name = surface wind stress over ocean units = m2 s-2 @@ -487,7 +487,7 @@ kind = kind_phys intent = inout optional = F -[fm_ocn] +[fm_wat] standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ocean long_name = Monin-Obukhov similarity function for momentum over ocean units = none @@ -514,7 +514,7 @@ kind = kind_phys intent = inout optional = F -[fh_ocn] +[fh_wat] standard_name = Monin_Obukhov_similarity_function_for_heat_over_ocean long_name = Monin-Obukhov similarity function for heat over ocean units = none @@ -541,7 +541,7 @@ kind = kind_phys intent = inout optional = F -[fm10_ocn] +[fm10_wat] standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ocean long_name = Monin-Obukhov similarity parameter for momentum at 10m over ocean units = none @@ -568,7 +568,7 @@ kind = kind_phys intent = inout optional = F -[fh2_ocn] +[fh2_wat] standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ocean long_name = Monin-Obukhov similarity parameter for heat at 2m over ocean units = none diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index a7436cb8f..81eefcce5 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -145,7 +145,7 @@ subroutine lsm_ruc_run & ! inputs & imp_physics, imp_physics_gfdl, imp_physics_thompson, & & smcwlt2, smcref2, do_mynnsfclay, & & con_cp, con_rv, con_rd, con_g, con_pi, con_hvap, con_fvirt,& ! constants - & weasd, snwdph, tskin, tskin_ocn, & ! in/outs + & weasd, snwdph, tskin, tskin_wat, & ! in/outs & rainnc, rainc, ice, snow, graupel, & ! in & srflag, smois, tslb, sh2o, keepfr, smfrkeep, & ! in/outs, on RUC levels & canopy, trans, tsurf, tsnow, zorl, & @@ -194,7 +194,7 @@ subroutine lsm_ruc_run & ! inputs real (kind=kind_phys), dimension(lsoil_ruc) :: dzs real (kind=kind_phys), dimension(lsoil_ruc), intent(inout ) :: zs real (kind=kind_phys), dimension(im), intent(inout) :: weasd, & - & snwdph, tskin, tskin_ocn, & + & snwdph, tskin, tskin_wat, & & srflag, canopy, trans, tsurf, zorl, tsnow, & & sfcqc, sfcqv, sfcdew, fice, tice, sfalb, smcwlt2, smcref2 ! --- in @@ -312,7 +312,7 @@ subroutine lsm_ruc_run & ! inputs call rucinit (flag_restart, im, lsoil_ruc, lsoil, nlev, & ! in isot, soiltyp, vegtype, fice, & ! in - land, tskin, tskin_ocn, tg3, & ! in + land, tskin, tskin_wat, tg3, & ! in smc, slc, stc, & ! in smcref2, smcwlt2, & ! inout lsm_ruc, lsm, & ! in @@ -1038,7 +1038,7 @@ end subroutine lsm_ruc_run !! This subroutine contains RUC LSM initialization. subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in isot, soiltyp, vegtype, fice, & ! in - land, tsurf, tsurf_ocn, & ! in + land, tsurf, tsurf_wat, & ! in tg3, smc, slc, stc, & ! in smcref2, smcwlt2, & ! inout lsm_ruc, lsm, & ! in @@ -1055,7 +1055,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in integer, intent(in ) :: lsoil_ruc integer, intent(in ) :: lsoil logical, dimension(im), intent(in ) :: land - real (kind=kind_phys), dimension(im), intent(in ) :: tsurf, tsurf_ocn + real (kind=kind_phys), dimension(im), intent(in ) :: tsurf, tsurf_wat real (kind=kind_phys), dimension(im), intent(inout) :: smcref2 real (kind=kind_phys), dimension(im), intent(inout) :: smcwlt2 real (kind=kind_phys), dimension(im), intent(in ) :: tg3 @@ -1214,7 +1214,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in ! land only version if (land(i)) then tsk(i,j) = tsurf(i) - sst(i,j) = tsurf_ocn(i) + sst(i,j) = tsurf_wat(i) tbot(i,j)= tg3(i) ivgtyp(i,j)=vegtype(i) isltyp(i,j)=soiltyp(i) diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 6eaadfbb4..aa0ad3d0c 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -782,7 +782,7 @@ kind = kind_phys intent = inout optional = F -[tskin_ocn] +[tskin_wat] standard_name = surface_skin_temperature_over_ocean_interstitial long_name = surface skin temperature over ocean (temporary use as interstitial) units = K diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f index b2fcb0948..05b4f817a 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -672,7 +672,7 @@ end subroutine sfc_nst_pre_finalize !> \section NSST_general_pre_algorithm General Algorithm !! @{ subroutine sfc_nst_pre_run - & (im, wet, tsfc_ocn, tsurf_ocn, tseal, xt, xz, dt_cool, + & (im, wet, tsfc_wat, tsurf_wat, tseal, xt, xz, dt_cool, & z_c, tref, cplflx, oceanfrac, errmsg, errflg) use machine , only : kind_phys @@ -683,12 +683,12 @@ subroutine sfc_nst_pre_run integer, intent(in) :: im logical, dimension(im), intent(in) :: wet real (kind=kind_phys), dimension(im), intent(in) :: - & tsfc_ocn, xt, xz, dt_cool, z_c, oceanfrac + & tsfc_wat, xt, xz, dt_cool, z_c, oceanfrac logical, intent(in) :: cplflx ! --- input/outputs: real (kind=kind_phys), dimension(im), intent(inout) :: - & tsurf_ocn, tseal, tref + & tsurf_wat, tseal, tref ! --- outputs: character(len=*), intent(out) :: errmsg @@ -711,9 +711,9 @@ subroutine sfc_nst_pre_run ! tem = (oro(i)-oro_uf(i)) * rlapse ! DH* 20190927 simplyfing this code because tem is zero !tem = zero - !tseal(i) = tsfc_ocn(i) + tem - tseal(i) = tsfc_ocn(i) - !tsurf_ocn(i) = tsurf_ocn(i) + tem + !tseal(i) = tsfc_wat(i) + tem + tseal(i) = tsfc_wat(i) + !tsurf_wat(i) = tsurf_wat(i) + tem ! *DH endif enddo @@ -733,7 +733,7 @@ subroutine sfc_nst_pre_run endif tseal(i) = tref(i) + dt_warm - dt_cool(i) ! - (Sfcprop%oro(i)-Sfcprop%oro_uf(i))*rlapse - tsurf_ocn(i) = tseal(i) + tsurf_wat(i) = tseal(i) endif enddo endif @@ -776,7 +776,7 @@ end subroutine sfc_nst_post_finalize subroutine sfc_nst_post_run & & ( im, rlapse, tgice, wet, icy, oro, oro_uf, nstf_name1, & & nstf_name4, nstf_name5, xt, xz, dt_cool, z_c, tref, xlon, & - & tsurf_ocn, tsfc_ocn, dtzm, errmsg, errflg & + & tsurf_wat, tsfc_wat, dtzm, errmsg, errflg & & ) use machine , only : kind_phys @@ -794,8 +794,8 @@ subroutine sfc_nst_post_run & & dt_cool, z_c, tref, xlon ! --- input/outputs: - real (kind=kind_phys), dimension(im), intent(inout) :: tsurf_ocn, & - & tsfc_ocn + real (kind=kind_phys), dimension(im), intent(inout) :: tsurf_wat, & + & tsfc_wat ! --- outputs: real (kind=kind_phys), dimension(size(xlon,1)), intent(out) :: & @@ -818,7 +818,7 @@ subroutine sfc_nst_post_run & ! do i = 1, im ! if (wet(i) .and. .not. icy(i)) then -! tsurf_ocn(i) = tsurf_ocn(i) - (oro(i)-oro_uf(i)) * rlapse +! tsurf_wat(i) = tsurf_wat(i) - (oro(i)-oro_uf(i)) * rlapse ! endif ! enddo @@ -835,8 +835,8 @@ subroutine sfc_nst_post_run & ! if (wet(i) .and. .not.icy(i)) then ! if (wet(i) .and. (Model%frac_grid .or. .not. icy(i))) then if (wet(i)) then - tsfc_ocn(i) = max(tgice, tref(i) + dtzm(i)) -! tsfc_ocn(i) = max(271.2, tref(i) + dtzm(i)) - & + tsfc_wat(i) = max(tgice, tref(i) + dtzm(i)) +! tsfc_wat(i) = max(271.2, tref(i) + dtzm(i)) - & ! (oro(i)-oro_uf(i))*rlapse endif enddo diff --git a/physics/sfc_nst.meta b/physics/sfc_nst.meta index ac75aa05d..ff3566ac0 100644 --- a/physics/sfc_nst.meta +++ b/physics/sfc_nst.meta @@ -679,7 +679,7 @@ type = logical intent = in optional = F -[tsfc_ocn] +[tsfc_wat] standard_name = surface_skin_temperature_over_ocean_interstitial long_name = surface skin temperature over ocean (temporary use as interstitial) units = K @@ -688,7 +688,7 @@ kind = kind_phys intent = in optional = F -[tsurf_ocn] +[tsurf_wat] standard_name = surface_skin_temperature_after_iteration_over_ocean long_name = surface skin temperature after iteration over ocean units = K @@ -938,7 +938,7 @@ kind = kind_phys intent = in optional = F -[tsurf_ocn] +[tsurf_wat] standard_name = surface_skin_temperature_after_iteration_over_ocean long_name = surface skin temperature after iteration over ocean units = K @@ -947,7 +947,7 @@ kind = kind_phys intent = inout optional = F -[tsfc_ocn] +[tsfc_wat] standard_name = surface_skin_temperature_over_ocean_interstitial long_name = surface skin temperature over ocean (temporary use as interstitial) units = K diff --git a/physics/sfc_sice.f b/physics/sfc_sice.f index 750a6d795..6010fa4c9 100644 --- a/physics/sfc_sice.f +++ b/physics/sfc_sice.f @@ -40,12 +40,12 @@ end subroutine sfc_sice_finalize !> \section detailed_sice_run GFS Sea Ice Driver Detailed Algorithm !> @{ subroutine sfc_sice_run & - & ( im, km, sbc, hvap, tgice, cp, eps, epsm1, rvrdm1, grav, & ! --- inputs: + & ( im, kice, sbc, hvap, tgice, cp, eps, epsm1, rvrdm1, grav, & ! --- inputs: & t0c, rd, ps, t1, q1, delt, & & sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, & & cm, ch, prsl1, prslki, prsik1, prslk1, islimsk, wind, & & flag_iter, lprnt, ipr, cimin, & - & hice, fice, tice, weasd, tskin, tprcp, stc, ep, & ! --- input/outputs: + & hice, fice, tice, weasd, tskin, tprcp, tiice, ep, & ! --- input/outputs: & snwdph, qsurf, snowmt, gflux, cmm, chh, evap, hflx, & ! & cplflx, cplchm, flag_cice, islmsk_cice, & & errmsg, errflg @@ -58,12 +58,12 @@ subroutine sfc_sice_run & ! ! ! call sfc_sice ! ! inputs: ! -! ( im, km, ps, t1, q1, delt, ! +! ( im, kice, ps, t1, q1, delt, ! ! sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, ! ! cm, ch, prsl1, prslki, prsik1, prslk1, islimsk, wind, ! ! flag_iter, ! ! input/outputs: ! -! hice, fice, tice, weasd, tskin, tprcp, stc, ep, ! +! hice, fice, tice, weasd, tskin, tprcp, tiice, ep, ! ! outputs: ! ! snwdph, qsurf, snowmt, gflux, cmm, chh, evap, hflx ) ! ! ! @@ -90,7 +90,7 @@ subroutine sfc_sice_run & ! ==================== defination of variables ==================== ! ! ! ! inputs: size ! -! im, km - integer, horiz dimension and num of soil layers 1 ! +! im, kice - integer, horiz dimension and num of ice layers 1 ! ! ps - real, surface pressure im ! ! t1 - real, surface layer mean temperature ( k ) im ! ! q1 - real, surface layer mean specific humidity im ! @@ -117,7 +117,7 @@ subroutine sfc_sice_run & ! weasd - real, water equivalent accumulated snow depth (mm)im ! ! tskin - real, ground surface skin temperature ( k ) im ! ! tprcp - real, total precipitation im ! -! stc - real, soil temp (k) im,km ! +! tiice - real, temperature of ice internal (k) im,kice ! ! ep - real, potential evaporation im ! ! ! ! outputs: ! @@ -138,7 +138,6 @@ subroutine sfc_sice_run & implicit none ! ! - Define constant parameters - integer, parameter :: kmi = 2 !< 2-layer of ice real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0 real(kind=kind_phys), parameter :: himax = 8.0d0 !< maximum ice thickness allowed real(kind=kind_phys), parameter :: himin = 0.1d0 !< minimum ice thickness required @@ -148,7 +147,7 @@ subroutine sfc_sice_run & real(kind=kind_phys), parameter :: dsi = one/0.33d0 ! --- inputs: - integer, intent(in) :: im, km, ipr + integer, intent(in) :: im, kice, ipr logical, intent(in) :: lprnt logical, intent(in) :: cplflx logical, intent(in) :: cplchm @@ -170,7 +169,7 @@ subroutine sfc_sice_run & real (kind=kind_phys), dimension(im), intent(inout) :: hice, & & fice, tice, weasd, tskin, tprcp, ep - real (kind=kind_phys), dimension(im,km), intent(inout) :: stc + real (kind=kind_phys), dimension(im,kice), intent(inout) :: tiice ! --- outputs: real (kind=kind_phys), dimension(im), intent(inout) :: snwdph, & @@ -186,7 +185,7 @@ subroutine sfc_sice_run & & focn, snof, rch, rho, & & snowd, theta1 - real (kind=kind_phys) :: t12, t14, tem, stsice(im,kmi) + real (kind=kind_phys) :: t12, t14, tem, stsice(im,kice) &, hflxi, hflxw, q0, qs1, qssi, qssw real (kind=kind_phys) :: cpinv, hvapi, elocp @@ -236,12 +235,12 @@ subroutine sfc_sice_run & endif endif enddo -!> - Update/read sea ice temperature from soil temperature and initialize variables. +! --- ... update sea ice temperature - do k = 1, kmi + do k = 1, kice do i = 1, im if (flag(i)) then - stsice(i,k) = stc(i,k) + stsice(i,k) = tiice(i,k) endif enddo enddo @@ -357,7 +356,7 @@ subroutine sfc_sice_run & !> - Call the three-layer thermodynamics sea ice model ice3lay(). call ice3lay ! --- inputs: ! - & ( im, kmi, fice, flag, hfi, hfd, sneti, focn, delt, ! + & ( im, kice, fice, flag, hfi, hfd, sneti, focn, delt, ! & lprnt, ipr, ! --- outputs: ! & snowd, hice, stsice, tice, snof, snowmt, gflux ) ! @@ -388,10 +387,10 @@ subroutine sfc_sice_run & endif enddo - do k = 1, kmi + do k = 1, kice do i = 1, im if (flag(i)) then - stc(i,k) = min(stsice(i,k), t0c) + tiice(i,k) = min(stsice(i,k), t0c) endif enddo enddo diff --git a/physics/sfc_sice.meta b/physics/sfc_sice.meta index c9641ffaa..dc08e0170 100644 --- a/physics/sfc_sice.meta +++ b/physics/sfc_sice.meta @@ -9,9 +9,9 @@ type = integer intent = in optional = F -[km] - standard_name = soil_vertical_dimension - long_name = vertical loop extent for soil levels, start at 1 +[kice] + standard_name = ice_vertical_dimension + long_name = vertical loop extent for ice levels, start at 1 units = count dimensions = () type = integer @@ -346,11 +346,11 @@ kind = kind_phys intent = inout optional = F -[stc] - standard_name = soil_temperature - long_name = soil temp +[tiice] + standard_name = internal_ice_temperature + long_name = sea ice internal temperature units = K - dimensions = (horizontal_dimension,soil_vertical_dimension) + dimensions = (horizontal_dimension,ice_vertical_dimension) type = real kind = kind_phys intent = inout