Skip to content

Commit

Permalink
Updates for component land model (#682)
Browse files Browse the repository at this point in the history 
* add gflux

* add runoff and drain to land coupling

* add exchange coefficents

* add zvfun to land coupling

* minor fix in GFS type definitions

* update sfc_land

* remove Sa_ua and Sa_va from couling fields

* fix prefix of snow area fraction standard name

* rename exchange fields to follow inst convention

* "Supplementary physics updates for RRFS code freeze"

* update ccpp/physics by merging #161

---------

Co-authored-by: Ufuk Turuncoglu <[email protected]>
Co-authored-by: Haiqin.Li <[email protected]>
  • Loading branch information
@uturuncoglu @haiqinli
3 people authored Jan 26, 2024
1 parent a2c9176 commit 1d2c823
Show file tree
Hide file tree
Showing 9 changed files with 757 additions and 69 deletions.
266 changes: 260 additions & 6 deletions atmos_model.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2349,6 +2349,266 @@ subroutine assign_importdata(jdat, rc)
endif
endif

! get surface snow area fraction: over land (if cpllnd=true and cpllnd2atm=true)
!------------------------------------------------
fldname = 'inst_snow_area_fraction_lnd'
if (trim(impfield_name) == trim(fldname)) then
findex = queryImportFields(fldname)
if (importFieldsValid(findex) .and. GFS_control%cpllnd .and. GFS_control%cpllnd2atm) then
!$omp parallel do default(shared) private(i,j,nb,ix)
do j=jsc,jec
do i=isc,iec
nb = Atm_block%blkno(i,j)
ix = Atm_block%ixp(i,j)
if (GFS_data(nb)%Sfcprop%landfrac(ix) > zero) then
GFS_data(nb)%Coupling%sncovr1_lnd(ix) = datar8(i,j)
endif
enddo
enddo
if (mpp_pe() == mpp_root_pe() .and. debug) print *,'fv3 assign_import: get snow area fraction from land'
endif
endif

! get latent heat flux: over land (if cpllnd=true and cpllnd2atm=true)
!------------------------------------------------
fldname = 'inst_laten_heat_flx_lnd'
if (trim(impfield_name) == trim(fldname)) then
findex = queryImportFields(fldname)
if (importFieldsValid(findex) .and. GFS_control%cpllnd .and. GFS_control%cpllnd2atm) then
!$omp parallel do default(shared) private(i,j,nb,ix)
do j=jsc,jec
do i=isc,iec
nb = Atm_block%blkno(i,j)
ix = Atm_block%ixp(i,j)
if (GFS_data(nb)%Sfcprop%landfrac(ix) > zero) then
GFS_data(nb)%Coupling%evap_lnd(ix) = datar8(i,j)
endif
enddo
enddo
if (mpp_pe() == mpp_root_pe() .and. debug) print *,'fv3 assign_import: get latent heat flux from land'
endif
endif

! get sensible heat flux: over land (if cpllnd=true and cpllnd2atm=true)
!--------------------------------------------------
fldname = 'inst_sensi_heat_flx_lnd'
if (trim(impfield_name) == trim(fldname)) then
findex = queryImportFields(fldname)
if (importFieldsValid(findex) .and. GFS_control%cpllnd .and. GFS_control%cpllnd2atm) then
!$omp parallel do default(shared) private(i,j,nb,ix)
do j=jsc,jec
do i=isc,iec
nb = Atm_block%blkno(i,j)
ix = Atm_block%ixp(i,j)
if (GFS_data(nb)%Sfcprop%landfrac(ix) > zero) then
GFS_data(nb)%Coupling%hflx_lnd(ix) = datar8(i,j)
endif
enddo
enddo
if (mpp_pe() == mpp_root_pe() .and. debug) print *,'fv3 assign_import: get sensible heat flux from land'
endif
endif

! get surface upward potential latent heat flux: over land (if cpllnd=true and cpllnd2atm=true)
!------------------------------------------------
fldname = 'inst_potential_laten_heat_flx_lnd'
if (trim(impfield_name) == trim(fldname)) then
findex = queryImportFields(fldname)
if (importFieldsValid(findex) .and. GFS_control%cpllnd .and. GFS_control%cpllnd2atm) then
!$omp parallel do default(shared) private(i,j,nb,ix)
do j=jsc,jec
do i=isc,iec
nb = Atm_block%blkno(i,j)
ix = Atm_block%ixp(i,j)
if (GFS_data(nb)%Sfcprop%landfrac(ix) > zero) then
GFS_data(nb)%Coupling%ep_lnd(ix) = datar8(i,j)
endif
enddo
enddo
if (mpp_pe() == mpp_root_pe() .and. debug) print *,'fv3 assign_import: get potential latent heat flux from land'
endif
endif

! get 2m air temperature: over land (if cpllnd=true and cpllnd2atm=true)
!------------------------------------------------
fldname = 'inst_temp_height2m_lnd'
if (trim(impfield_name) == trim(fldname)) then
findex = queryImportFields(fldname)
if (importFieldsValid(findex) .and. GFS_control%cpllnd .and. GFS_control%cpllnd2atm) then
!$omp parallel do default(shared) private(i,j,nb,ix)
do j=jsc,jec
do i=isc,iec
nb = Atm_block%blkno(i,j)
ix = Atm_block%ixp(i,j)
if (GFS_data(nb)%Sfcprop%landfrac(ix) > zero) then
GFS_data(nb)%Coupling%t2mmp_lnd(ix) = datar8(i,j)
endif
enddo
enddo
if (mpp_pe() == mpp_root_pe() .and. debug) print *,'fv3 assign_import: get temperature at 2m from land'
endif
endif

! get 2m specific humidity: over land (if cpllnd=true and cpllnd2atm=true)
!------------------------------------------------
fldname = 'inst_spec_humid_height2m_lnd'
if (trim(impfield_name) == trim(fldname)) then
findex = queryImportFields(fldname)
if (importFieldsValid(findex) .and. GFS_control%cpllnd .and. GFS_control%cpllnd2atm) then
!$omp parallel do default(shared) private(i,j,nb,ix)
do j=jsc,jec
do i=isc,iec
nb = Atm_block%blkno(i,j)
ix = Atm_block%ixp(i,j)
if (GFS_data(nb)%Sfcprop%landfrac(ix) > zero) then
GFS_data(nb)%Coupling%q2mp_lnd(ix) = datar8(i,j)
endif
enddo
enddo
if (mpp_pe() == mpp_root_pe() .and. debug) print *,'fv3 assign_import: get specific humidity at 2m from land'
endif
endif

! get specific humidity: over land (if cpllnd=true and cpllnd2atm=true)
!------------------------------------------------
fldname = 'inst_spec_humid_lnd'
if (trim(impfield_name) == trim(fldname)) then
findex = queryImportFields(fldname)
if (importFieldsValid(findex) .and. GFS_control%cpllnd .and. GFS_control%cpllnd2atm) then
!$omp parallel do default(shared) private(i,j,nb,ix)
do j=jsc,jec
do i=isc,iec
nb = Atm_block%blkno(i,j)
ix = Atm_block%ixp(i,j)
if (GFS_data(nb)%Sfcprop%landfrac(ix) > zero) then
GFS_data(nb)%Coupling%qsurf_lnd(ix) = datar8(i,j)
endif
enddo
enddo
if (mpp_pe() == mpp_root_pe() .and. debug) print *,'fv3 assign_import: get specific humidity from land'
endif
endif

! get upward heat flux in soil (if cpllnd=true and cpllnd2atm=true)
!------------------------------------------------
fldname = 'inst_upward_heat_flux_lnd'
if (trim(impfield_name) == trim(fldname)) then
findex = queryImportFields(fldname)
if (importFieldsValid(findex) .and. GFS_control%cpllnd .and. GFS_control%cpllnd2atm) then
!$omp parallel do default(shared) private(i,j,nb,ix)
do j=jsc,jec
do i=isc,iec
nb = Atm_block%blkno(i,j)
ix = Atm_block%ixp(i,j)
if (GFS_data(nb)%Sfcprop%landfrac(ix) > zero) then
GFS_data(nb)%Coupling%gflux_lnd(ix) = datar8(i,j)
endif
enddo
enddo
if (mpp_pe() == mpp_root_pe() .and. debug) print *,'fv3 assign_import: get upward heat flux from land'
endif
endif

! get surface runoff in soil (if cpllnd=true and cpllnd2atm=true)
!------------------------------------------------
fldname = 'inst_runoff_rate_lnd'
if (trim(impfield_name) == trim(fldname)) then
findex = queryImportFields(fldname)
if (importFieldsValid(findex) .and. GFS_control%cpllnd .and. GFS_control%cpllnd2atm) then
!$omp parallel do default(shared) private(i,j,nb,ix)
do j=jsc,jec
do i=isc,iec
nb = Atm_block%blkno(i,j)
ix = Atm_block%ixp(i,j)
if (GFS_data(nb)%Sfcprop%landfrac(ix) > zero) then
GFS_data(nb)%Coupling%runoff_lnd(ix) = datar8(i,j)
endif
enddo
enddo
if (mpp_pe() == mpp_root_pe() .and. debug) print *,'fv3 assign_import: get surface runoff from land'
endif
endif

! get subsurface runoff in soil (if cpllnd=true and cpllnd2atm=true)
!------------------------------------------------
fldname = 'inst_subsurface_runoff_rate_lnd'
if (trim(impfield_name) == trim(fldname)) then
findex = queryImportFields(fldname)
if (importFieldsValid(findex) .and. GFS_control%cpllnd .and. GFS_control%cpllnd2atm) then
!$omp parallel do default(shared) private(i,j,nb,ix)
do j=jsc,jec
do i=isc,iec
nb = Atm_block%blkno(i,j)
ix = Atm_block%ixp(i,j)
if (GFS_data(nb)%Sfcprop%landfrac(ix) > zero) then
GFS_data(nb)%Coupling%drain_lnd(ix) = datar8(i,j)
endif
enddo
enddo
if (mpp_pe() == mpp_root_pe() .and. debug) print *,'fv3 assign_import: get subsurface runoff from land'
endif
endif

! get momentum exchange coefficient (if cpllnd=true and cpllnd2atm=true)
!------------------------------------------------
fldname = 'inst_drag_wind_speed_for_momentum'
if (trim(impfield_name) == trim(fldname)) then
findex = queryImportFields(fldname)
if (importFieldsValid(findex) .and. GFS_control%cpllnd .and. GFS_control%cpllnd2atm) then
!$omp parallel do default(shared) private(i,j,nb,ix)
do j=jsc,jec
do i=isc,iec
nb = Atm_block%blkno(i,j)
ix = Atm_block%ixp(i,j)
if (GFS_data(nb)%Sfcprop%landfrac(ix) > zero) then
GFS_data(nb)%Coupling%cmm_lnd(ix) = datar8(i,j)
endif
enddo
enddo
if (mpp_pe() == mpp_root_pe() .and. debug) print *,'fv3 assign_import: get drag wind speed for momentum from land'
endif
endif

! get thermal exchange coefficient (if cpllnd=true and cpllnd2atm=true)
!------------------------------------------------
fldname = 'inst_drag_mass_flux_for_heat_and_moisture'
if (trim(impfield_name) == trim(fldname)) then
findex = queryImportFields(fldname)
if (importFieldsValid(findex) .and. GFS_control%cpllnd .and. GFS_control%cpllnd2atm) then
!$omp parallel do default(shared) private(i,j,nb,ix)
do j=jsc,jec
do i=isc,iec
nb = Atm_block%blkno(i,j)
ix = Atm_block%ixp(i,j)
if (GFS_data(nb)%Sfcprop%landfrac(ix) > zero) then
GFS_data(nb)%Coupling%chh_lnd(ix) = datar8(i,j)
endif
enddo
enddo
if (mpp_pe() == mpp_root_pe() .and. debug) print *,'fv3 assign_import: get thermal exchange coefficient form land'
endif
endif

! get function of surface roughness length and green vegetation fraction (if cpllnd=true and cpllnd2atm=true)
!------------------------------------------------
fldname = 'inst_func_of_roughness_length_and_vfrac'
if (trim(impfield_name) == trim(fldname)) then
findex = queryImportFields(fldname)
if (importFieldsValid(findex) .and. GFS_control%cpllnd .and. GFS_control%cpllnd2atm) then
!$omp parallel do default(shared) private(i,j,nb,ix)
do j=jsc,jec
do i=isc,iec
nb = Atm_block%blkno(i,j)
ix = Atm_block%ixp(i,j)
if (GFS_data(nb)%Sfcprop%landfrac(ix) > zero) then
GFS_data(nb)%Coupling%zvfun_lnd(ix) = datar8(i,j)
endif
enddo
enddo
if (mpp_pe() == mpp_root_pe() .and. debug) print *,'fv3 assign_import: get func. of roughness length and vfrac form land'
endif
endif

endif ! if (datar8(isc,jsc) > -99999.0) then

!-------------------------------------------------------
Expand Down Expand Up @@ -3072,12 +3332,6 @@ subroutine setup_exportdata(rc)
! bottom layer meridional wind (v)
case('inst_merid_wind_height_lowest')
call block_data_copy_or_fill(datar82d, DYCORE_data(nb)%coupling%v_bot, zeror8, Atm_block, nb, rc=localrc)
! bottom layer zonal wind (u) from physics
case('inst_zonal_wind_height_lowest_from_phys')
call block_data_copy_or_fill(datar82d, GFS_data(nb)%Statein%ugrs, 1, zeror8, Atm_block, nb, rc=localrc)
! bottom layer meridional wind (v) from physics
case('inst_merid_wind_height_lowest_from_phys')
call block_data_copy_or_fill(datar82d, GFS_data(nb)%Statein%vgrs, 1, zeror8, Atm_block, nb, rc=localrc)
! surface friction velocity
case('surface_friction_velocity')
call block_data_copy_or_fill(datar82d, GFS_data(nb)%Sfcprop%uustar, zeror8, Atm_block, nb, rc=localrc)
Expand Down
1 change: 1 addition & 0 deletions ccpp/config/ccpp_prebuild_config.py
View file
Original file line number Diff line number Diff line change
Expand Up @@ -192,6 +192,7 @@
'physics/physics/SFC_Layer/UFS/sfc_nst_post.f90',
'physics/physics/SFC_Models/Land/RUC/lsm_ruc.F90',
'physics/physics/SFC_Models/SeaIce/CICE/sfc_cice.f',
'physics/physics/SFC_Models/Land/sfc_land.F90',
'physics/physics/SFC_Models/Land/Noah/lsm_noah.f',
'physics/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90',
'physics/physics/SFC_Models/Lake/Flake/flake_driver.F90',
Expand Down
Loading

0 comments on commit 1d2c823

Please sign in to comment.