From e889b037948b58e7009e80e13206c7b694a14e95 Mon Sep 17 00:00:00 2001 From: Ben Green Date: Thu, 18 Jun 2020 14:17:38 +0000 Subject: [PATCH 1/4] Mods to GSL physics for fractional --- physics/module_MYNNPBL_wrapper.F90 | 79 +++++++++++++++++---- physics/module_MYNNPBL_wrapper.meta | 105 ++++++++++++++++++++++++++++ physics/module_MYNNSFC_wrapper.F90 | 6 ++ physics/module_MYNNSFC_wrapper.meta | 54 ++++++++++++++ physics/module_sf_mynn.F90 | 34 +++++++-- 5 files changed, 259 insertions(+), 19 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 413db8b62..ea507db82 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -60,6 +60,10 @@ SUBROUTINE mynnedmf_wrapper_run( & & dtsfci_diag,dqsfci_diag, & & dusfc_diag,dvsfc_diag, & & dtsfc_diag,dqsfc_diag, & + & dusfc_cice,dvsfc_cice, & + & dtsfc_cice,dqsfc_cice, & + & hflx_ocn,qflx_ocn,stress_ocn, & + & oceanfrac,fice,wet,icy,dry, & & dusfci_cpl,dvsfci_cpl, & & dtsfci_cpl,dqsfci_cpl, & & dusfc_cpl,dvsfc_cpl, & @@ -175,6 +179,9 @@ SUBROUTINE mynnedmf_wrapper_run( & REAL, PARAMETER :: TKmin=253.0 !< for total water conversion, Tripoli and Cotton (1981) REAL, PARAMETER :: tv0=p608*tref, tv1=(1.+p608)*tref, gtr=g/tref, g_inv=1./g + REAL, PARAMETER :: zero=0.0d0, one=1.0d0, epsln=1.0d-10 + REAL, PARAMETER :: huge=9.9692099683868690E36 ! NetCDF float FillValue, same as in GFS_typedefs.F90 + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -279,6 +286,14 @@ SUBROUTINE mynnedmf_wrapper_run( & & dx,zorl,slmsk,tsurf,qsfc,ps, & & hflx,qflx,ust,wspd,rb,recmol + real(kind=kind_phys), dimension(im), intent(in) :: & + & dusfc_cice,dvsfc_cice,dtsfc_cice,dqsfc_cice, & + & stress_ocn,hflx_ocn,qflx_ocn, & + & oceanfrac,fice + + logical, dimension(im), intent(in) :: & + & wet, dry, icy + real(kind=kind_phys), dimension(im), intent(inout) :: & & pblh real(kind=kind_phys), dimension(im), intent(out) :: & @@ -289,9 +304,9 @@ SUBROUTINE mynnedmf_wrapper_run( & integer, dimension(im), intent(inout) :: & & kpbl,nupdraft,ktop_plume - real(kind=kind_phys), dimension(:), intent(inout) :: & + real(kind=kind_phys), dimension(im), intent(inout) :: & & dusfc_cpl,dvsfc_cpl,dtsfc_cpl,dqsfc_cpl - real(kind=kind_phys), dimension(:), intent(inout) :: & + real(kind=kind_phys), dimension(im), intent(inout) :: & & dusfci_cpl,dvsfci_cpl,dtsfci_cpl,dqsfci_cpl !LOCAL @@ -508,17 +523,55 @@ SUBROUTINE mynnedmf_wrapper_run( & dvsfc_diag(i) = dvsfc_diag(i) + dvsfci_diag(i)*delt ! BWG: Coupling insertion - if(cplflx) then - dusfci_cpl(i) = dusfci_diag(i) - dvsfci_cpl(i) = dvsfci_diag(i) - dtsfci_cpl(i) = dtsfci_diag(i) - dqsfci_cpl(i) = dqsfci_diag(i) - - dusfc_cpl(i) = dusfc_cpl(i) + dusfci_cpl(i)*delt - dvsfc_cpl(i) = dvsfc_cpl(i) + dvsfci_cpl(i)*delt - dtsfc_cpl(i) = dtsfc_cpl(i) + dtsfci_cpl(i)*delt - dqsfc_cpl(i) = dqsfc_cpl(i) + dqsfci_cpl(i)*delt - endif + 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) + elseif (icy(i) .or. dry(i)) then ! use stress_ocean for opw component at mixed point + if (wspd(i) > zero) then + dusfci_cpl(i) = -1.*rho(i,1)*stress_ocn(i)*u(i,1)/wspd(i) ! U-momentum flux + dvsfci_cpl(i) = -1.*rho(i,1)*stress_ocn(i)*v(i,1)/wspd(i) ! V-momentum flux + else + dusfci_cpl(i) = zero + dvsfci_cpl(i) = zero + endif + dtsfci_cpl(i) = cp*rho(i,1)*hflx_ocn(i) ! sensible heat flux over open ocean + dqsfci_cpl(i) = XLV*rho(i,1)*qflx_ocn(i) ! latent heat flux over open ocean + else ! use results from this scheme for 100% open ocean + dusfci_cpl(i) = dusfci_diag(i) + dvsfci_cpl(i) = dvsfci_diag(i) + dtsfci_cpl(i) = dtsfci_diag(i) + dqsfci_cpl(i) = dqsfci_diag(i) + endif +! + dusfc_cpl (i) = dusfc_cpl(i) + dusfci_cpl(i) * delt + dvsfc_cpl (i) = dvsfc_cpl(i) + dvsfci_cpl(i) * delt + dtsfc_cpl (i) = dtsfc_cpl(i) + dtsfci_cpl(i) * delt + dqsfc_cpl (i) = dqsfc_cpl(i) + dqsfci_cpl(i) * delt + else ! If no ocean + dusfc_cpl(i) = huge + dvsfc_cpl(i) = huge + dtsfc_cpl(i) = huge + dqsfc_cpl(i) = huge + endif ! Ocean only, NO LAKES + !enddo + endif + +! if(cplflx) then +! dusfci_cpl(i) = dusfci_diag(i) +! dvsfci_cpl(i) = dvsfci_diag(i) +! dtsfci_cpl(i) = dtsfci_diag(i) +! dqsfci_cpl(i) = dqsfci_diag(i) +! +! dusfc_cpl(i) = dusfc_cpl(i) + dusfci_cpl(i)*delt +! dvsfc_cpl(i) = dvsfc_cpl(i) + dvsfci_cpl(i)*delt +! dtsfc_cpl(i) = dtsfc_cpl(i) + dtsfci_cpl(i)*delt +! dqsfc_cpl(i) = dqsfc_cpl(i) + dqsfci_cpl(i)*delt +! endif znt(i)=zorl(i)*0.01 !cm -> m? if (do_mynnsfclay) then diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 1ab7af8b4..b256277a2 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -352,6 +352,111 @@ kind = kind_phys intent = in optional = F +[oceanfrac] + standard_name = sea_area_fraction + long_name = fraction of horizontal grid area occupied by ocean + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dusfc_cice] + standard_name = surface_x_momentum_flux_for_coupling + long_name = sfc x momentum flux for coupling + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dvsfc_cice] + standard_name = surface_y_momentum_flux_for_coupling + long_name = sfc y momentum flux for coupling + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dtsfc_cice] + standard_name = surface_upward_sensible_heat_flux_for_coupling + long_name = sfc sensible heat flux for coupling + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dqsfc_cice] + standard_name = surface_upward_latent_heat_flux_for_coupling + long_name = sfc latent heat flux for coupling + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + 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 = in + optional = F +[stress_ocn] + standard_name = surface_wind_stress_over_ocean + long_name = surface wind stress over ocean + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hflx_ocn] + 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 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qflx_ocn] + 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 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [wspd] standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level diff --git a/physics/module_MYNNSFC_wrapper.F90 b/physics/module_MYNNSFC_wrapper.F90 index d14932e07..496db7580 100644 --- a/physics/module_MYNNSFC_wrapper.F90 +++ b/physics/module_MYNNSFC_wrapper.F90 @@ -48,6 +48,8 @@ SUBROUTINE mynnsfc_wrapper_run( & & fh_ocn, fh_lnd, fh_ice, & !intent(inout) & fm10_ocn, fm10_lnd, fm10_ice, & !intent(inout) & fh2_ocn, fh2_lnd, fh2_ice, & !intent(inout) + & hflx_ocn, hflx_lnd, hflx_ice, & + & qflx_ocn, qflx_lnd, qflx_ice, & & QSFC, qsfc_ruc, USTM, ZOL, MOL, & & RMOL, WSPD, ch, HFLX, QFLX, LH, & & FLHC, FLQC, & @@ -149,6 +151,8 @@ SUBROUTINE mynnsfc_wrapper_run( & & fh_ocn, fh_lnd, fh_ice, & & fm10_ocn, fm10_lnd, fm10_ice, & & fh2_ocn, fh2_lnd, fh2_ice, & + & hflx_ocn, hflx_lnd, hflx_ice, & + & qflx_ocn, qflx_lnd, qflx_ice, & & qsfc_ocn, qsfc_lnd, qsfc_ice !MYNN-2D @@ -267,6 +271,8 @@ SUBROUTINE mynnsfc_wrapper_run( & fh_ocn=fh_ocn, fh_lnd=fh_lnd, fh_ice=fh_ice, & !intent(inout) fm10_ocn=fm10_ocn, fm10_lnd=fm10_lnd, fm10_ice=fm10_ice, & !intent(inout) fh2_ocn=fh2_ocn, fh2_lnd=fh2_lnd, fh2_ice=fh2_ice, & !intent(inout) + hflx_ocn=hflx_ocn, hflx_lnd=hflx_lnd, hflx_ice=hflx_ice, & + qflx_ocn=qflx_ocn, qflx_lnd=qflx_lnd, qflx_ice=qflx_ice, & ch=ch,CHS=chs,CHS2=chs2,CQS2=cqs2,CPM=cpm, & ZNT=znt,USTM=ustm,ZOL=zol,MOL=mol,RMOL=rmol, & psim=psim,psih=psih, & diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index 73bf1a462..54aa4ff4c 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -725,6 +725,33 @@ kind = kind_phys intent = inout optional = F +[hflx_ocn] + 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 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx_lnd] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_land + long_name = kinematic surface upward sensible heat flux over land + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx_ice] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_ice + long_name = kinematic surface upward sensible heat flux over ice + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [qflx] standard_name = kinematic_surface_upward_latent_heat_flux long_name = kinematic surface upward latent heat flux @@ -734,6 +761,33 @@ kind = kind_phys intent = inout optional = F +[qflx_ocn] + 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 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qflx_lnd] + standard_name = kinematic_surface_upward_latent_heat_flux_over_land + long_name = kinematic surface upward latent heat flux over land + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qflx_ice] + standard_name = kinematic_surface_upward_latent_heat_flux_over_ice + long_name = kinematic surface upward latent heat flux over ice + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [lh] standard_name = surface_latent_heat long_name = latent heating at the surface (pos = up) diff --git a/physics/module_sf_mynn.F90 b/physics/module_sf_mynn.F90 index 777a3d53f..94b118521 100644 --- a/physics/module_sf_mynn.F90 +++ b/physics/module_sf_mynn.F90 @@ -166,6 +166,8 @@ SUBROUTINE SFCLAY_mynn( & fh_ocn, fh_lnd, fh_ice, & !intent(inout) fm10_ocn, fm10_lnd, fm10_ice, & !intent(inout) fh2_ocn, fh2_lnd, fh2_ice, & !intent(inout) + HFLX_ocn, HFLX_lnd, HFLX_ice, & + QFLX_ocn, QFLX_lnd, QFLX_ice, & CH,CHS,CHS2,CQS2,CPM, & ZNT,USTM,ZOL,MOL,RMOL, & PSIM,PSIH, & @@ -360,6 +362,8 @@ SUBROUTINE SFCLAY_mynn( & & fh_ocn, fh_lnd, fh_ice, & & fm10_ocn, fm10_lnd, fm10_ice, & & fh2_ocn, fh2_lnd, fh2_ice, & + & HFLX_ocn, HFLX_lnd, HFLX_ice, & + & QFLX_ocn, QFLX_lnd, QFLX_ice, & & qsfc_ocn, qsfc_lnd, qsfc_ice, & & qsfc_ruc @@ -468,6 +472,8 @@ SUBROUTINE SFCLAY_mynn( & fh_ocn, fh_lnd, fh_ice, & !intent(inout) fm10_ocn, fm10_lnd, fm10_ice, & !intent(inout) fh2_ocn, fh2_lnd, fh2_ice, & + HFLX_ocn, HFLX_lnd, HFLX_ice, & + QFLX_ocn, QFLX_lnd, QFLX_ice, & ch(ims,j),CHS(ims,j),CHS2(ims,j),CQS2(ims,j), & CPM(ims,j), & ZNT(ims,j),USTM(ims,j),ZOL(ims,j), & @@ -519,6 +525,8 @@ SUBROUTINE SFCLAY1D_mynn( & psit_ocn, psit_lnd, psit_ice, & !=fh, intent(inout) psix10_ocn, psix10_lnd, psix10_ice, & !=fm10, intent(inout) psit2_ocn, psit2_lnd, psit2_ice, & !=fh2, intent(inout) + HFLX_ocn, HFLX_lnd, HFLX_ice, & + QFLX_ocn, QFLX_lnd, QFLX_ice, & ch,CHS,CHS2,CQS2,CPM, & ZNT,USTM,ZOL,MOL,RMOL, & PSIM,PSIH, & @@ -613,6 +621,8 @@ SUBROUTINE SFCLAY1D_mynn( & & psit_ocn, psit_lnd, psit_ice, & & psix10_ocn,psix10_lnd,psix10_ice, & & psit2_ocn, psit2_lnd, psit2_ice, & + & HFLX_ocn, HFLX_lnd, HFLX_ice, & + & QFLX_ocn, QFLX_lnd, QFLX_ice, & & qsfc_ocn, qsfc_lnd, qsfc_ice REAL, DIMENSION( its:ite ), INTENT(IN) :: rstoch1D @@ -1763,14 +1773,18 @@ SUBROUTINE SFCLAY1D_mynn( & QFX(I)=FLQC(I)*(QSFC_lnd(I)-QV1D(I)) QFX(I)=MAX(QFX(I),-0.02) !allows small neg QFX LH(i)=XLV*QFX(i) - QFLX(i)=QFX(i)/RHO1D(i) + ! BWG, 2020-06-17: Mod next 2 lines for fractional + QFLX_lnd(i)=QFX(i)/RHO1D(i) + QFLX(i)=QFLX_lnd(i) !---------------------------------- ! COMPUTE SURFACE HEAT FLUX: !---------------------------------- HFX(I)=FLHC(I)*(THSK_lnd(I)-TH1D(I)) HFX(I)=MAX(HFX(I),-250.) - HFLX(I)=HFX(I)/(RHO1D(I)*cpm(I)) + ! BWG, 2020-06-17: Mod next 2 lines for fractional + HFLX_lnd(I)=HFX(I)/(RHO1D(I)*cpm(I)) + HFLX(I)=HFLX_lnd(I) ENDIF !TRANSFER COEFF FOR SOME LSMs: @@ -1801,7 +1815,9 @@ SUBROUTINE SFCLAY1D_mynn( & QFX(I)=FLQC(I)*(QSFC_ocn(I)-QV1D(I)) QFX(I)=MAX(QFX(I),-0.02) !allows small neg QFX LH(I)=XLV*QFX(I) - QFLX(i)=QFX(i)/RHO1D(i) + ! BWG, 2020-06-17: Mod next 2 lines for fractional + QFLX_ocn(i)=QFX(i)/RHO1D(i) + QFLX(i)=QFLX_ocn(i) !---------------------------------- ! COMPUTE SURFACE HEAT FLUX: @@ -1813,7 +1829,9 @@ SUBROUTINE SFCLAY1D_mynn( & HFX(I)=HFX(I)+RHO1D(I)*USTM(I)*USTM(I)*WSPDI(I) ENDIF ENDIF - HFLX(I)=HFX(I)/(RHO1D(I)*cpm(I)) + ! BWG, 2020-06-17: Mod next 2 lines for fractional + HFLX_ocn(I)=HFX(I)/(RHO1D(I)*cpm(I)) + HFLX(I)=HFLX_ocn(I) ENDIF !TRANSFER COEFF FOR SOME LSMs: @@ -1844,14 +1862,18 @@ SUBROUTINE SFCLAY1D_mynn( & QFX(I)=FLQC(I)*(QSFC_ice(I)-QV1D(I)) QFX(I)=MAX(QFX(I),-0.02) !allows small neg QFX LH(I)=XLF*QFX(I) - QFLX(i)=QFX(i)/RHO1D(i) + ! BWG, 2020-06-17: Mod next 2 lines for fractional + QFLX_ice(i)=QFX(i)/RHO1D(i) + QFLX(i)=QFLX_ice(i) !---------------------------------- ! COMPUTE SURFACE HEAT FLUX: !---------------------------------- HFX(I)=FLHC(I)*(THSK_ice(I)-TH1D(I)) HFX(I)=MAX(HFX(I),-250.) - HFLX(I)=HFX(I)/(RHO1D(I)*cpm(I)) + ! BWG, 2020-06-17: Mod next 2 lines for fractional + HFLX_ice(I)=HFX(I)/(RHO1D(I)*cpm(I)) + HFLX(I)=HFLX_ice(I) ENDIF !TRANSFER COEFF FOR SOME LSMs: From 707dece954e8ea97211167ac42b5718230401715 Mon Sep 17 00:00:00 2001 From: Ben Green Date: Thu, 18 Jun 2020 15:45:14 +0000 Subject: [PATCH 2/4] Cosmetic changes to MYNNPBL --- physics/module_MYNNPBL_wrapper.F90 | 62 ++++++++++++------------------ 1 file changed, 25 insertions(+), 37 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index ea507db82..57d05390f 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -522,9 +522,30 @@ SUBROUTINE mynnedmf_wrapper_run( & dusfc_diag(i) = dusfc_diag(i) + dusfci_diag(i)*delt dvsfc_diag(i) = dvsfc_diag(i) + dvsfci_diag(i)*delt - ! BWG: Coupling insertion + znt(i)=zorl(i)*0.01 !cm -> m? + if (do_mynnsfclay) then + rmol(i)=recmol(i) + else + if (hfx(i) .ge. 0.)then + rmol(i)=-hfx(i)/(200.*dz(i,1)*0.5) + else + rmol(i)=ABS(rb(i))*1./(dz(i,1)*0.5) + endif + !if (rb(i) .ge. 0.)then + ! rmol(i)=rb(i)*8./(dz(i,1)*0.5) + !else + ! rmol(i)=MAX(rb(i)*5.,-10.)/(dz(i,1)*0.5) + !endif + endif + ts(i)=tsurf(i)/exner(i,1) !theta +! qsfc(i)=qss(i) +! ps(i)=pgr(i) +! wspd(i)=wind(i) + enddo + + ! BWG: Coupling insertion if (cplflx) then - !do i=1,im + 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) @@ -558,41 +579,8 @@ SUBROUTINE mynnedmf_wrapper_run( & dtsfc_cpl(i) = huge dqsfc_cpl(i) = huge endif ! Ocean only, NO LAKES - !enddo - endif - -! if(cplflx) then -! dusfci_cpl(i) = dusfci_diag(i) -! dvsfci_cpl(i) = dvsfci_diag(i) -! dtsfci_cpl(i) = dtsfci_diag(i) -! dqsfci_cpl(i) = dqsfci_diag(i) -! -! dusfc_cpl(i) = dusfc_cpl(i) + dusfci_cpl(i)*delt -! dvsfc_cpl(i) = dvsfc_cpl(i) + dvsfci_cpl(i)*delt -! dtsfc_cpl(i) = dtsfc_cpl(i) + dtsfci_cpl(i)*delt -! dqsfc_cpl(i) = dqsfc_cpl(i) + dqsfci_cpl(i)*delt -! endif - - znt(i)=zorl(i)*0.01 !cm -> m? - if (do_mynnsfclay) then - rmol(i)=recmol(i) - else - if (hfx(i) .ge. 0.)then - rmol(i)=-hfx(i)/(200.*dz(i,1)*0.5) - else - rmol(i)=ABS(rb(i))*1./(dz(i,1)*0.5) - endif - !if (rb(i) .ge. 0.)then - ! rmol(i)=rb(i)*8./(dz(i,1)*0.5) - !else - ! rmol(i)=MAX(rb(i)*5.,-10.)/(dz(i,1)*0.5) - !endif - endif - ts(i)=tsurf(i)/exner(i,1) !theta -! qsfc(i)=qss(i) -! ps(i)=pgr(i) -! wspd(i)=wind(i) - enddo + enddo + endif ! End coupling insertion if (lprnt) then print* From 37719daee48f16e7be2c510ab0a3425e856c1eef Mon Sep 17 00:00:00 2001 From: Ben Green Date: Thu, 18 Jun 2020 18:25:16 +0000 Subject: [PATCH 3/4] cleanup of .meta file order to match corresponding .F90 --- physics/module_MYNNPBL_wrapper.F90 | 4 +- physics/module_MYNNPBL_wrapper.meta | 210 ++++++++++++++-------------- physics/module_MYNNSFC_wrapper.meta | 108 +++++++------- 3 files changed, 161 insertions(+), 161 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 57d05390f..53561818a 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -304,9 +304,9 @@ SUBROUTINE mynnedmf_wrapper_run( & integer, dimension(im), intent(inout) :: & & kpbl,nupdraft,ktop_plume - real(kind=kind_phys), dimension(im), intent(inout) :: & + real(kind=kind_phys), dimension(:), intent(inout) :: & & dusfc_cpl,dvsfc_cpl,dtsfc_cpl,dqsfc_cpl - real(kind=kind_phys), dimension(im), intent(inout) :: & + real(kind=kind_phys), dimension(:), intent(inout) :: & & dusfci_cpl,dvsfci_cpl,dtsfci_cpl,dqsfci_cpl !LOCAL diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index b256277a2..9833f7eba 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -352,111 +352,6 @@ kind = kind_phys intent = in optional = F -[oceanfrac] - standard_name = sea_area_fraction - long_name = fraction of horizontal grid area occupied by ocean - units = frac - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[fice] - standard_name = sea_ice_concentration - long_name = ice fraction over open water - units = frac - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dusfc_cice] - standard_name = surface_x_momentum_flux_for_coupling - long_name = sfc x momentum flux for coupling - units = Pa - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dvsfc_cice] - standard_name = surface_y_momentum_flux_for_coupling - long_name = sfc y momentum flux for coupling - units = Pa - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dtsfc_cice] - standard_name = surface_upward_sensible_heat_flux_for_coupling - long_name = sfc sensible heat flux for coupling - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dqsfc_cice] - standard_name = surface_upward_latent_heat_flux_for_coupling - long_name = sfc latent heat flux for coupling - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[wet] - standard_name = flag_nonzero_wet_surface_fraction - long_name = flag indicating presence of some ocean or lake surface area fraction - units = flag - dimensions = (horizontal_dimension) - type = logical - intent = in - optional = F -[dry] - standard_name = flag_nonzero_land_surface_fraction - long_name = flag indicating presence of some land surface area fraction - units = flag - dimensions = (horizontal_dimension) - 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 = in - optional = F -[stress_ocn] - standard_name = surface_wind_stress_over_ocean - long_name = surface wind stress over ocean - units = m2 s-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[hflx_ocn] - 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 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[qflx_ocn] - 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 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F [wspd] standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level @@ -583,6 +478,111 @@ kind = kind_phys intent = inout optional = F +[dusfc_cice] + standard_name = surface_x_momentum_flux_for_coupling + long_name = sfc x momentum flux for coupling + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dvsfc_cice] + standard_name = surface_y_momentum_flux_for_coupling + long_name = sfc y momentum flux for coupling + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dtsfc_cice] + standard_name = surface_upward_sensible_heat_flux_for_coupling + long_name = sfc sensible heat flux for coupling + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dqsfc_cice] + standard_name = surface_upward_latent_heat_flux_for_coupling + long_name = sfc latent heat flux for coupling + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hflx_ocn] + 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 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qflx_ocn] + 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 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stress_ocn] + standard_name = surface_wind_stress_over_ocean + long_name = surface wind stress over ocean + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[oceanfrac] + standard_name = sea_area_fraction + long_name = fraction of horizontal grid area occupied by ocean + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + 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 = in + optional = F +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F [dusfci_cpl] standard_name = instantaneous_surface_x_momentum_flux_for_coupling long_name = instantaneous sfc u momentum flux diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index 54aa4ff4c..cf366d3d4 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -644,6 +644,60 @@ kind = kind_phys intent = inout optional = F +[hflx_ocn] + 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 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx_lnd] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_land + long_name = kinematic surface upward sensible heat flux over land + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx_ice] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_ice + long_name = kinematic surface upward sensible heat flux over ice + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qflx_ocn] + 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 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qflx_lnd] + standard_name = kinematic_surface_upward_latent_heat_flux_over_land + long_name = kinematic surface upward latent heat flux over land + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qflx_ice] + standard_name = kinematic_surface_upward_latent_heat_flux_over_ice + long_name = kinematic surface upward latent heat flux over ice + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [qsfc] standard_name = surface_specific_humidity long_name = surface air saturation specific humidity @@ -725,33 +779,6 @@ kind = kind_phys intent = inout optional = F -[hflx_ocn] - 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 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[hflx_lnd] - standard_name = kinematic_surface_upward_sensible_heat_flux_over_land - long_name = kinematic surface upward sensible heat flux over land - units = K m s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[hflx_ice] - standard_name = kinematic_surface_upward_sensible_heat_flux_over_ice - long_name = kinematic surface upward sensible heat flux over ice - units = K m s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [qflx] standard_name = kinematic_surface_upward_latent_heat_flux long_name = kinematic surface upward latent heat flux @@ -761,33 +788,6 @@ kind = kind_phys intent = inout optional = F -[qflx_ocn] - 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 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[qflx_lnd] - standard_name = kinematic_surface_upward_latent_heat_flux_over_land - long_name = kinematic surface upward latent heat flux over land - units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[qflx_ice] - standard_name = kinematic_surface_upward_latent_heat_flux_over_ice - long_name = kinematic surface upward latent heat flux over ice - units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F [lh] standard_name = surface_latent_heat long_name = latent heating at the surface (pos = up) From 728c076a64f921670e8be18d1b0c0d79de6e3254 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 25 Jun 2020 09:58:45 -0600 Subject: [PATCH 4/4] physics/module_MYNNPBL_wrapper.F90: modify coupling code as suggested by @shansun6 --- physics/module_MYNNPBL_wrapper.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 1faa62889..06385b0b1 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -179,7 +179,7 @@ SUBROUTINE mynnedmf_wrapper_run( & REAL, PARAMETER :: TKmin=253.0 !< for total water conversion, Tripoli and Cotton (1981) REAL, PARAMETER :: tv0=p608*tref, tv1=(1.+p608)*tref, gtr=g/tref, g_inv=1./g - REAL, PARAMETER :: zero=0.0d0, one=1.0d0, epsln=1.0d-10 + REAL, PARAMETER :: zero=0.0d0, one=1.0d0 REAL, PARAMETER :: huge=9.9692099683868690E36 ! NetCDF float FillValue, same as in GFS_typedefs.F90 character(len=*), intent(out) :: errmsg @@ -549,7 +549,7 @@ SUBROUTINE mynnedmf_wrapper_run( & 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 + if ( .not. wet(i)) 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)