Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Updated the calculation of the 2-meter temperature, potential temperature, and specfic humidity over seaice points #1147

Merged
merged 3 commits into from
Mar 20, 2024
Merged

Updated the calculation of the 2-meter temperature, potential temperature, and specfic humidity over seaice points #1147

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
243001d
* In ./src/core_atmosphere/physics:
ldfowler58 Feb 27, 2024
b856552
* In ./src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F, now wei…
ldfowler58 Mar 12, 2024
348f404
* In ./src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F, moved t…
ldfowler58 Mar 12, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions src/core_atmosphere/physics/Makefile
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 \
Expand Down Expand Up @@ -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: \
Expand Down
107 changes: 37 additions & 70 deletions src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -98,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.


!
Expand Down Expand Up @@ -646,6 +650,39 @@ 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

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
do i = its,ite
Expand Down Expand Up @@ -707,27 +744,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)

Expand Down Expand Up @@ -888,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

Expand All @@ -912,44 +917,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
!=================================================================================================================
4 changes: 2 additions & 2 deletions .../physics/mpas_atmphys_driver_lsm_shared.F → ...osphere/physics/mpas_atmphys_lsm_shared.F
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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


Expand Down Expand Up @@ -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
!=================================================================================================================


Expand Down