From 243001d99be9cb4376108623ed854c9dc593d4e3 Mon Sep 17 00:00:00 2001 From: Laura Fowler Date: Tue, 27 Feb 2024 12:31:05 -0700 Subject: [PATCH 1/3] * In ./src/core_atmosphere/physics: -> renamed module mpas_atmphys_driver_lsm_shared.F to mpas_atmphys_lsm_shared.F. -> in mpas_atmphys_driver_lsm.F, now use mpas_atmphys_lsm_shared to call subroutine correct_tsk_over_seaice. removed subroutine correct_tsk_over_seaice at the bottom of the module. -> corrected Makefile accordingly. --- src/core_atmosphere/physics/Makefile | 2 + .../physics/mpas_atmphys_driver_lsm.F | 39 +------------------ ...lsm_shared.F => mpas_atmphys_lsm_shared.F} | 4 +- 3 files changed, 5 insertions(+), 40 deletions(-) rename src/core_atmosphere/physics/{mpas_atmphys_driver_lsm_shared.F => mpas_atmphys_lsm_shared.F} (96%) diff --git a/src/core_atmosphere/physics/Makefile b/src/core_atmosphere/physics/Makefile index 22e7e22b1e..df9317e1fb 100644 --- a/src/core_atmosphere/physics/Makefile +++ b/src/core_atmosphere/physics/Makefile @@ -36,6 +36,7 @@ OBJS = \ mpas_atmphys_interface.o \ mpas_atmphys_landuse.o \ mpas_atmphys_lsm_noahinit.o \ + mpas_atmphys_lsm_shared.o \ mpas_atmphys_manager.o \ mpas_atmphys_o3climatology.o \ mpas_atmphys_packages.o \ @@ -104,6 +105,7 @@ mpas_atmphys_driver_lsm.o: \ mpas_atmphys_constants.o \ mpas_atmphys_landuse.o \ mpas_atmphys_lsm_noahinit.o \ + mpas_atmphys_lsm_shared.o \ mpas_atmphys_vars.o mpas_atmphys_driver_microphysics.o: \ diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F b/src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F index 5231645a29..e1cda47fab 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F @@ -14,6 +14,7 @@ module mpas_atmphys_driver_lsm use mpas_atmphys_constants use mpas_atmphys_landuse, only: isurban use mpas_atmphys_lsm_noahinit + use mpas_atmphys_lsm_shared,only: correct_tsk_over_seaice use mpas_atmphys_vars !wrf physics @@ -912,44 +913,6 @@ subroutine driver_lsm(itimestep,configs,mesh,diag_physics,sfc_input,its,ite) end subroutine driver_lsm -!================================================================================================================= - subroutine correct_tsk_over_seaice(ims,ime,jms,jme,its,ite,jts,jte,xice_thresh,xice,tsk,tsk_sea,tsk_ice) -!================================================================================================================= - -!input arguments: - integer,intent(in):: ims,ime,its,ite,jms,jme,jts,jte - real(kind=RKIND),intent(in):: xice_thresh - real(kind=RKIND),intent(in),dimension(ims:ime,jms:jme):: tsk,xice - -!inout arguments: - real(kind=RKIND),intent(inout),dimension(ims:ime,jms:jme):: tsk_sea,tsk_ice - -!local variables: - integer:: i,j - -!----------------------------------------------------------------------------------------------------------------- - -!initialize the local sea-surface temperature and local sea-ice temperature to the local surface -!temperature: - do j = jts,jte - do i = its,ite - tsk_sea(i,j) = tsk(i,j) - tsk_ice(i,j) = tsk(i,j) - - if(xice(i,j).ge.xice_thresh .and. xice(i,j).le.1._RKIND) then - !over sea-ice grid cells, limit sea-surface temperatures to temperatures warmer than 271.4: - tsk_sea(i,j) = max(tsk_sea(i,j),271.4_RKIND) - - !over sea-ice grid cells, avoids unphysically too cold sea-ice temperatures for grid cells - !with small sea-ice fractions: - if(xice(i,j).lt.0.2_RKIND .and. tsk_ice(i,j).lt.253.15_RKIND) tsk_ice(i,j) = 253.15_RKIND - if(xice(i,j).lt.0.1_RKIND .and. tsk_ice(i,j).lt.263.15_RKIND) tsk_ice(i,j) = 263.15_RKIND - endif - enddo - enddo - - end subroutine correct_tsk_over_seaice - !================================================================================================================= end module mpas_atmphys_driver_lsm !================================================================================================================= diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_lsm_shared.F b/src/core_atmosphere/physics/mpas_atmphys_lsm_shared.F similarity index 96% rename from src/core_atmosphere/physics/mpas_atmphys_driver_lsm_shared.F rename to src/core_atmosphere/physics/mpas_atmphys_lsm_shared.F index fdac7ed20c..af5a1a436a 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_lsm_shared.F +++ b/src/core_atmosphere/physics/mpas_atmphys_lsm_shared.F @@ -6,7 +6,7 @@ ! distributed with this code, or at http://mpas-dev.github.com/license.html ! !================================================================================================================= - module mpas_atmphys_driver_lsm_shared + module mpas_atmphys_lsm_shared use mpas_kind_types @@ -57,7 +57,7 @@ subroutine correct_tsk_over_seaice(ims,ime,jms,jme,its,ite,jts,jte,xice_thresh,x end subroutine correct_tsk_over_seaice !================================================================================================================= - end module mpas_atmphys_driver_lsm_shared + end module mpas_atmphys_lsm_shared !================================================================================================================= From b856552723217ef119ad68f838cdd0dd775ae331 Mon Sep 17 00:00:00 2001 From: Laura Fowler Date: Tue, 12 Mar 2024 13:52:30 -0600 Subject: [PATCH 2/3] * In ./src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F, now weigh the local variables needed in the calculation of t2m, th2m, and q2 prior to updating all LSM variables (see subroutine lsm_to_MPAS). --- .../physics/mpas_atmphys_driver_lsm.F | 44 ++++++++++--------- 1 file changed, 23 insertions(+), 21 deletions(-) diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F b/src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F index e1cda47fab..6145c39116 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F @@ -647,6 +647,29 @@ subroutine lsm_to_MPAS(configs,mesh,diag_physics,sfc_input,its,ite) call mpas_pool_get_array(sfc_input,'smois' ,smois ) call mpas_pool_get_array(sfc_input,'tslb' ,tslb ) +!--- weigh local variables needed in the calculation of t2m, th2m, and q2 over seaice points: + if(config_frac_seaice) then + do j = jts,jte + do i = its,ite + if(xice_p(i,j).ge.xice_threshold .and. xice_p(i,j).le.1._RKIND) then + chs_p(i,j) = xice_p(i,j)*chs_p(i,j) + (1._RKIND-xice_p(i,j))*chs_sea(i,j) + chs2_p(i,j) = xice_p(i,j)*chs2_p(i,j) + (1._RKIND-xice_p(i,j))*chs2_sea(i,j) + cqs2_p(i,j) = xice_p(i,j)*cqs2_p(i,j) + (1._RKIND-xice_p(i,j))*cqs2_sea(i,j) + cpm_p(i,j) = xice_p(i,j)*cpm_p(i,j) + (1._RKIND-xice_p(i,j))*cpm_sea(i,j) + hfx_p(i,j) = xice_p(i,j)*hfx_p(i,j) + (1._RKIND-xice_p(i,j))*hfx_sea(i,j) + lh_p(i,j) = xice_p(i,j)*lh_p(i,j) + (1._RKIND-xice_p(i,j))*lh_sea(i,j) + qfx_p(i,j) = xice_p(i,j)*qfx_p(i,j) + (1._RKIND-xice_p(i,j))*qfx_sea(i,j) + qgh_p(i,j) = xice_p(i,j)*qgh_p(i,j) + (1._RKIND-xice_p(i,j))*qgh_sea(i,j) + qsfc_p(i,j) = xice_p(i,j)*qsfc_p(i,j) + (1._RKIND-xice_p(i,j))*qsfc_sea(i,j) + tsk_p(i,j) = xice_p(i,j)*tsk_p(i,j) + (1._RKIND-xice_p(i,j))*tsk_sea(i,j) + sfc_albedo_p(i,j) = xice_p(i,j)*sfc_albedo_p(i,j) + (1._RKIND-xice_p(i,j))*0.08_RKIND + sfc_emiss_p(i,j) = xice_p(i,j)*sfc_emiss_p(i,j) + (1._RKIND-xice_p(i,j))*0.98_RKIND + endif + enddo + enddo + endif + +!--- update all land-surface variables: do j = jts,jte do n = 1,num_soils do i = its,ite @@ -708,27 +731,6 @@ subroutine lsm_to_MPAS(configs,mesh,diag_physics,sfc_input,its,ite) enddo enddo - if(config_frac_seaice) then - do j = jts,jte - do i = its,ite - if(xice_p(i,j).ge.xice_threshold .and. xice_p(i,j).le.1._RKIND) then - chs(i) = xice_p(i,j)*chs_p(i,j) + (1._RKIND-xice_p(i,j))*chs_sea(i,j) - chs2(i) = xice_p(i,j)*chs2_p(i,j) + (1._RKIND-xice_p(i,j))*chs2_sea(i,j) - cqs2(i) = xice_p(i,j)*cqs2_p(i,j) + (1._RKIND-xice_p(i,j))*cqs2_sea(i,j) - cpm(i) = xice_p(i,j)*cpm_p(i,j) + (1._RKIND-xice_p(i,j))*cpm_sea(i,j) - hfx(i) = xice_p(i,j)*hfx_p(i,j) + (1._RKIND-xice_p(i,j))*hfx_sea(i,j) - lh(i) = xice_p(i,j)*lh_p(i,j) + (1._RKIND-xice_p(i,j))*lh_sea(i,j) - qfx(i) = xice_p(i,j)*qfx_p(i,j) + (1._RKIND-xice_p(i,j))*qfx_sea(i,j) - qgh(i) = xice_p(i,j)*qgh_p(i,j) + (1._RKIND-xice_p(i,j))*qgh_sea(i,j) - qsfc(i) = xice_p(i,j)*qsfc_p(i,j) + (1._RKIND-xice_p(i,j))*qsfc_sea(i,j) - skintemp(i) = xice_p(i,j)*tsk_p(i,j) + (1._RKIND-xice_p(i,j))*tsk_sea(i,j) - sfc_albedo(i) = xice_p(i,j)*sfc_albedo_p(i,j) + (1._RKIND-xice_p(i,j))*0.08_RKIND - sfc_emiss(i) = xice_p(i,j)*sfc_emiss_p(i,j) + (1._RKIND-xice_p(i,j))*0.98_RKIND - endif - enddo - enddo - endif - if(config_microp_scheme .ne. 'off') then call mpas_pool_get_array(diag_physics,'sr',sr) From 348f4041e458738edc778a46fccbe41a715f6e4f Mon Sep 17 00:00:00 2001 From: Laura Fowler Date: Tue, 12 Mar 2024 14:57:38 -0600 Subject: [PATCH 3/3] * In ./src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F, moved the call to sfcdiags from subroutine driver_lsm to subroutine lsm_to_MPAS. This allows t2m, th2m, and q2 to be correctly computed over seaice points. --- .../physics/mpas_atmphys_driver_lsm.F | 24 ++++++++++--------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F b/src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F index 6145c39116..fa012be8ad 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F @@ -99,6 +99,9 @@ module mpas_atmphys_driver_lsm ! Laura D. Fowler (laura@ucar.edu) / 2020-05-10. ! * replaced the option "noah" with "sf_noah" to run the NOAH land surface scheme. ! Laura D. Fowler (laura@ucar.edu) / 2022-02-18. +! * moved the call to sfcdiags from subroutine driver_lsm to subroutine lsm_to_MPAS. this allows t2m, th2m, +! and q2 to be correctly computed over seaice points. +! Laura D. Fowler (laura@ucar.edu) / 2024-03-12. ! @@ -669,6 +672,16 @@ subroutine lsm_to_MPAS(configs,mesh,diag_physics,sfc_input,its,ite) enddo endif + call sfcdiags( & + hfx = hfx_p , qfx = qfx_p , tsk = tsk_p , qsfc = qsfc_p , chs = chs_p , & + chs2 = chs2_p , cqs2 = cqs2_p , t2 = t2m_p , th2 = th2m_p , q2 = q2_p , & + psfc = psfc_p , t3d = t_p , qv3d = qv_p , cp = cp , R_d = R_d , & + rovcp = rcp , ua_phys = ua_phys , & + ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , & + ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , & + its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte & + ) + !--- update all land-surface variables: do j = jts,jte do n = 1,num_soils @@ -891,18 +904,7 @@ subroutine driver_lsm(itimestep,configs,mesh,diag_physics,sfc_input,its,ite) its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte & ) endif - - call sfcdiags( & - hfx = hfx_p , qfx = qfx_p , tsk = tsk_p , qsfc = qsfc_p , chs = chs_p , & - chs2 = chs2_p , cqs2 = cqs2_p , t2 = t2m_p , th2 = th2m_p , q2 = q2_p , & - psfc = psfc_p , t3d = t_p , qv3d = qv_p , cp = cp , R_d = R_d , & - rovcp = rcp , ua_phys = ua_phys , & - ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , & - ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , & - its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte & - ) call mpas_timer_stop('sf_noah') - case default