Skip to content

Commit

Permalink
Add support for external land component (ufs-community#591)
Browse files Browse the repository at this point in the history 
* fixes for land coupling
* work to support external land component side-by-side config
* fix issue with ort dbg test
  • Loading branch information
@uturuncoglu
uturuncoglu authored Oct 28, 2022
1 parent d38ccaf commit 324591b
Show file tree
Hide file tree
Showing 6 changed files with 272 additions and 71 deletions.
70 changes: 52 additions & 18 deletions atmos_model.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1685,22 +1685,22 @@ subroutine update_atmos_chemistry(state, rc)
enddo

! -- zero out accumulated fields
if (.not. GFS_control%cplflx .and. .not. GFS_control%cpllnd) then
!$OMP parallel do default (none) &
!$OMP shared (nj, ni, Atm_block, GFS_control, GFS_data) &
!$OMP private (j, jb, i, ib, nb, ix)
do j = 1, nj
jb = j + Atm_block%jsc - 1
do i = 1, ni
ib = i + Atm_block%isc - 1
nb = Atm_block%blkno(ib,jb)
ix = Atm_block%ixp(ib,jb)
GFS_data(nb)%coupling%rainc_cpl(ix) = zero
if (.not.GFS_control%cplflx) then
do j = 1, nj
jb = j + Atm_block%jsc - 1
do i = 1, ni
ib = i + Atm_block%isc - 1
nb = Atm_block%blkno(ib,jb)
ix = Atm_block%ixp(ib,jb)
GFS_data(nb)%coupling%rainc_cpl(ix) = zero
GFS_data(nb)%coupling%rain_cpl(ix) = zero
GFS_data(nb)%coupling%snow_cpl(ix) = zero
end if
enddo
enddo
enddo
end if

if (GFS_control%debug) then
! -- diagnostics
Expand Down Expand Up @@ -2883,7 +2883,6 @@ subroutine setup_exportdata(rc)
! Instantaneous u wind (m/s) 10 m above ground
case ('inst_zonal_wind_height10m')
call block_data_copy(datar82d, GFS_data(nb)%coupling%u10mi_cpl, Atm_block, nb, rc=localrc)
!call block_data_copy(datar82d, GFS_data(nb)%coupling%u10mi_cpl, Atm_block, nb, rc=localrc)
! Instantaneous v wind (m/s) 10 m above ground
case ('inst_merid_wind_height10m')
call block_data_copy(datar82d, GFS_data(nb)%coupling%v10mi_cpl, Atm_block, nb, rc=localrc)
Expand Down Expand Up @@ -3005,6 +3004,9 @@ subroutine setup_exportdata(rc)
! MEAN precipitation rate (kg/m2/s)
case ('mean_prec_rate')
call block_data_copy(datar82d, GFS_data(nb)%coupling%rain_cpl, Atm_block, nb, scale_factor=rtimek, rc=localrc)
! MEAN convective precipitation rate (kg/m2/s)
case ('mean_prec_rate_conv')
call block_data_copy(datar82d, GFS_Data(nb)%Coupling%rainc_cpl, Atm_block, nb, scale_factor=rtimek, rc=localrc)
! MEAN snow precipitation rate (kg/m2/s)
case ('mean_fprec_rate')
call block_data_copy(datar82d, GFS_data(nb)%coupling%snow_cpl, Atm_block, nb, scale_factor=rtimek, rc=localrc)
Expand All @@ -3015,19 +3017,38 @@ subroutine setup_exportdata(rc)
! bottom layer temperature (t)
case('inst_temp_height_lowest')
call block_data_copy_or_fill(datar82d, DYCORE_data(nb)%coupling%t_bot, zeror8, Atm_block, nb, rc=localrc)
case('inst_temp_height_lowest_from_phys')
call block_data_copy_or_fill(datar82d, GFS_data(nb)%Statein%tgrs, 1, zeror8, Atm_block, nb, rc=localrc)
! bottom layer specific humidity (q)
! ! ! CHECK if tracer 1 is for specific humidity ! ! !
case('inst_spec_humid_height_lowest')
call block_data_copy_or_fill(datar82d, DYCORE_data(nb)%coupling%tr_bot, 1, zeror8, Atm_block, nb, rc=localrc)
case('inst_spec_humid_height_lowest_from_phys')
call block_data_copy_or_fill(datar82d, GFS_data(nb)%Statein%qgrs, 1, GFS_Control%ntqv, zeror8, Atm_block, nb, rc=localrc)
! bottom layer zonal wind (u)
case('inst_zonal_wind_height_lowest')
call block_data_copy_or_fill(datar82d, DYCORE_data(nb)%coupling%u_bot, zeror8, Atm_block, nb, rc=localrc)
! bottom layer meridionalw wind (v)
! 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)
! bottom layer pressure (p)
case('inst_pres_height_lowest')
call block_data_copy_or_fill(datar82d, DYCORE_data(nb)%coupling%p_bot, zeror8, Atm_block, nb, rc=localrc)
! bottom layer pressure (p) from physics
case('inst_pres_height_lowest_from_phys')
call block_data_copy_or_fill(datar82d, GFS_data(nb)%Statein%prsl, 1, zeror8, Atm_block, nb, rc=localrc)
! dimensionless exner function at surface adjacent layer
case('inst_exner_function_height_lowest')
call block_data_copy_or_fill(datar82d, GFS_data(nb)%Statein%prslk, 1, zeror8, Atm_block, nb, rc=localrc)
! bottom layer height (z)
case('inst_height_lowest')
call block_data_copy_or_fill(datar82d, DYCORE_data(nb)%coupling%z_bot, zeror8, Atm_block, nb, rc=localrc)
Expand Down Expand Up @@ -3105,24 +3126,37 @@ subroutine setup_exportdata(rc)
GFS_data(nb)%coupling%dvsfc_cpl(ix) = zero
GFS_data(nb)%coupling%dtsfc_cpl(ix) = zero
GFS_data(nb)%coupling%dqsfc_cpl(ix) = zero
GFS_data(nb)%coupling%dlwsfc_cpl(ix) = zero
GFS_data(nb)%coupling%dswsfc_cpl(ix) = zero
GFS_data(nb)%coupling%rain_cpl(ix) = zero
GFS_data(nb)%coupling%nlwsfc_cpl(ix) = zero
GFS_data(nb)%coupling%nswsfc_cpl(ix) = zero
GFS_data(nb)%coupling%dnirbm_cpl(ix) = zero
GFS_data(nb)%coupling%dnirdf_cpl(ix) = zero
GFS_data(nb)%coupling%dvisbm_cpl(ix) = zero
GFS_data(nb)%coupling%dvisdf_cpl(ix) = zero
enddo
enddo
if (mpp_pe() == mpp_root_pe()) print *,'zeroing coupling accumulated fields at kdt= ',GFS_control%kdt
endif !cplflx
!---
if (GFS_control%cplflx .or. GFS_control%cpllnd) then
! zero out accumulated fields
!$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)
GFS_data(nb)%coupling%dlwsfc_cpl(ix) = zero
GFS_data(nb)%coupling%dswsfc_cpl(ix) = zero
GFS_data(nb)%coupling%rain_cpl(ix) = zero
GFS_data(nb)%coupling%rainc_cpl(ix) = zero
GFS_data(nb)%coupling%snow_cpl(ix) = zero
GFS_data(nb)%coupling%nswsfc_cpl(ix) = zero
GFS_data(nb)%coupling%nnirbm_cpl(ix) = zero
GFS_data(nb)%coupling%nnirdf_cpl(ix) = zero
GFS_data(nb)%coupling%nvisbm_cpl(ix) = zero
GFS_data(nb)%coupling%nvisdf_cpl(ix) = zero
GFS_data(nb)%coupling%snow_cpl(ix) = zero
enddo
enddo
if (mpp_pe() == mpp_root_pe()) print *,'zeroing coupling accumulated fields at kdt= ',GFS_control%kdt
endif !cplflx
endif !cplflx or cpllnd

end subroutine setup_exportdata

Expand Down
77 changes: 44 additions & 33 deletions ccpp/data/GFS_typedefs.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -674,6 +674,7 @@ module GFS_typedefs
logical :: cplwav2atm !< default no wav->atm coupling
logical :: cplaqm !< default no cplaqm collection
logical :: cplchm !< default no cplchm collection
logical :: cpllnd !< default no cpllnd collection
logical :: rrfs_smoke !< default no rrfs_smoke collection
integer :: dust_smoke_rrtmg_band_number !< band number to affect in rrtmg_pre from smoke and dust
logical :: use_cice_alb !< default .false. - i.e. don't use albedo imported from the ice model
Expand Down Expand Up @@ -2525,7 +2526,7 @@ subroutine coupling_create (Coupling, IM, Model)
Coupling%tsfc_radtime = clear_val
endif

if (Model%cplflx .or. Model%do_sppt .or. Model%cplchm .or. Model%ca_global) then
if (Model%cplflx .or. Model%do_sppt .or. Model%cplchm .or. Model%ca_global .or. Model%cpllnd) then
allocate (Coupling%rain_cpl (IM))
allocate (Coupling%snow_cpl (IM))
Coupling%rain_cpl = clear_val
Expand All @@ -2541,7 +2542,7 @@ subroutine coupling_create (Coupling, IM, Model)
Coupling%v10mi_cpl = clear_val
endif

if (Model%cplflx .or. Model%cplchm) then
if (Model%cplflx .or. Model%cplchm .or. Model%cpllnd) then
!--- instantaneous quantities
allocate (Coupling%tsfci_cpl (IM))
Coupling%tsfci_cpl = clear_val
Expand All @@ -2554,6 +2555,36 @@ subroutine coupling_create (Coupling, IM, Model)
! Coupling%zorlwav_cpl = clear_val
! endif

if (Model%cplflx .or. Model%cpllnd) then
allocate (Coupling%dlwsfc_cpl (IM))
allocate (Coupling%dswsfc_cpl (IM))
allocate (Coupling%psurfi_cpl (IM))
allocate (Coupling%nswsfc_cpl (IM))
allocate (Coupling%nswsfci_cpl (IM))
allocate (Coupling%nnirbmi_cpl (IM))
allocate (Coupling%nnirdfi_cpl (IM))
allocate (Coupling%nvisbmi_cpl (IM))
allocate (Coupling%nvisdfi_cpl (IM))
allocate (Coupling%nnirbm_cpl (IM))
allocate (Coupling%nnirdf_cpl (IM))
allocate (Coupling%nvisbm_cpl (IM))
allocate (Coupling%nvisdf_cpl (IM))

Coupling%dlwsfc_cpl = clear_val
Coupling%dswsfc_cpl = clear_val
Coupling%psurfi_cpl = clear_val
Coupling%nswsfc_cpl = clear_val
Coupling%nswsfci_cpl = clear_val
Coupling%nnirbmi_cpl = clear_val
Coupling%nnirdfi_cpl = clear_val
Coupling%nvisbmi_cpl = clear_val
Coupling%nvisdfi_cpl = clear_val
Coupling%nnirbm_cpl = clear_val
Coupling%nnirdf_cpl = clear_val
Coupling%nvisbm_cpl = clear_val
Coupling%nvisdf_cpl = clear_val
end if

if (Model%cplflx) then
!--- incoming quantities
allocate (Coupling%slimskin_cpl (IM))
Expand Down Expand Up @@ -2608,35 +2639,21 @@ subroutine coupling_create (Coupling, IM, Model)
allocate (Coupling%dvsfc_cpl (IM))
allocate (Coupling%dtsfc_cpl (IM))
allocate (Coupling%dqsfc_cpl (IM))
allocate (Coupling%dlwsfc_cpl (IM))
allocate (Coupling%dswsfc_cpl (IM))
allocate (Coupling%dnirbm_cpl (IM))
allocate (Coupling%dnirdf_cpl (IM))
allocate (Coupling%dvisbm_cpl (IM))
allocate (Coupling%dvisdf_cpl (IM))
allocate (Coupling%nlwsfc_cpl (IM))
allocate (Coupling%nswsfc_cpl (IM))
allocate (Coupling%nnirbm_cpl (IM))
allocate (Coupling%nnirdf_cpl (IM))
allocate (Coupling%nvisbm_cpl (IM))
allocate (Coupling%nvisdf_cpl (IM))

Coupling%dusfc_cpl = clear_val
Coupling%dvsfc_cpl = clear_val
Coupling%dtsfc_cpl = clear_val
Coupling%dqsfc_cpl = clear_val
Coupling%dlwsfc_cpl = clear_val
Coupling%dswsfc_cpl = clear_val
Coupling%dnirbm_cpl = clear_val
Coupling%dnirdf_cpl = clear_val
Coupling%dvisbm_cpl = clear_val
Coupling%dvisdf_cpl = clear_val
Coupling%nlwsfc_cpl = clear_val
Coupling%nswsfc_cpl = clear_val
Coupling%nnirbm_cpl = clear_val
Coupling%nnirdf_cpl = clear_val
Coupling%nvisbm_cpl = clear_val
Coupling%nvisdf_cpl = clear_val

!--- instantaneous quantities
allocate (Coupling%dusfci_cpl (IM))
Expand All @@ -2650,14 +2667,8 @@ subroutine coupling_create (Coupling, IM, Model)
allocate (Coupling%dvisbmi_cpl (IM))
allocate (Coupling%dvisdfi_cpl (IM))
allocate (Coupling%nlwsfci_cpl (IM))
allocate (Coupling%nswsfci_cpl (IM))
allocate (Coupling%nnirbmi_cpl (IM))
allocate (Coupling%nnirdfi_cpl (IM))
allocate (Coupling%nvisbmi_cpl (IM))
allocate (Coupling%nvisdfi_cpl (IM))
allocate (Coupling%t2mi_cpl (IM))
allocate (Coupling%q2mi_cpl (IM))
allocate (Coupling%psurfi_cpl (IM))
allocate (Coupling%oro_cpl (IM))
allocate (Coupling%slmsk_cpl (IM))

Expand All @@ -2672,14 +2683,8 @@ subroutine coupling_create (Coupling, IM, Model)
Coupling%dvisbmi_cpl = clear_val
Coupling%dvisdfi_cpl = clear_val
Coupling%nlwsfci_cpl = clear_val
Coupling%nswsfci_cpl = clear_val
Coupling%nnirbmi_cpl = clear_val
Coupling%nnirdfi_cpl = clear_val
Coupling%nvisbmi_cpl = clear_val
Coupling%nvisdfi_cpl = clear_val
Coupling%t2mi_cpl = clear_val
Coupling%q2mi_cpl = clear_val
Coupling%psurfi_cpl = clear_val
Coupling%oro_cpl = clear_val !< pointer to sfcprop%oro
Coupling%slmsk_cpl = clear_val !< pointer to sfcprop%slmsk
endif
Expand Down Expand Up @@ -2710,17 +2715,20 @@ subroutine coupling_create (Coupling, IM, Model)
if (Model%cplchm .or. Model%rrfs_smoke) then
!--- outgoing instantaneous quantities
allocate (Coupling%ushfsfci (IM))
!--- accumulated convective rainfall
allocate (Coupling%rainc_cpl (IM))
! -- instantaneous 3d fluxes of nonconvective ice and liquid precipitations
allocate (Coupling%pfi_lsan (IM,Model%levs))
allocate (Coupling%pfl_lsan (IM,Model%levs))
Coupling%rainc_cpl = clear_val
Coupling%ushfsfci = clear_val
Coupling%pfi_lsan = clear_val
Coupling%pfl_lsan = clear_val
endif

if (Model%cplchm .or. Model%rrfs_smoke .or. Model%cplflx .or. Model%cpllnd) then
!--- accumulated convective rainfall
allocate (Coupling%rainc_cpl (IM))
Coupling%rainc_cpl = clear_val
end if

! -- additional coupling options for air quality
if (Model%cplaqm .and. .not.Model%cplflx) then
!--- outgoing instantaneous quantities
Expand Down Expand Up @@ -2929,6 +2937,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
logical :: cplwav2atm = .false. !< default no cplwav2atm coupling
logical :: cplaqm = .false. !< default no cplaqm collection
logical :: cplchm = .false. !< default no cplchm collection
logical :: cpllnd = .false. !< default no cpllnd collection
logical :: rrfs_smoke = .false. !< default no rrfs_smoke collection
integer :: dust_smoke_rrtmg_band_number = 10!< band number to affect in rrtmg_pre from smoke and dust
logical :: use_cice_alb = .false. !< default no cice albedo
Expand Down Expand Up @@ -3455,7 +3464,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
thermodyn_id, sfcpress_id, &
!--- coupling parameters
cplflx, cplice, cplocn2atm, cplwav, cplwav2atm, cplaqm, &
cplchm, cpl_imp_mrg, cpl_imp_dbg, rrfs_smoke, &
cplchm, cpllnd, cpl_imp_mrg, cpl_imp_dbg, rrfs_smoke, &
use_cice_alb, dust_smoke_rrtmg_band_number, &
#ifdef IDEA_PHYS
lsidea, weimer_model, f107_kp_size, f107_kp_interval, &
Expand Down Expand Up @@ -3777,6 +3786,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
Model%cplwav2atm = cplwav2atm
Model%cplaqm = cplaqm
Model%cplchm = cplchm .or. cplaqm
Model%cpllnd = cpllnd
Model%use_cice_alb = use_cice_alb
Model%cpl_imp_mrg = cpl_imp_mrg
Model%cpl_imp_dbg = cpl_imp_dbg
Expand Down Expand Up @@ -5703,6 +5713,7 @@ subroutine control_print(Model)
print *, ' cplwav2atm : ', Model%cplwav2atm
print *, ' cplaqm : ', Model%cplaqm
print *, ' cplchm : ', Model%cplchm
print *, ' cpllnd : ', Model%cpllnd
print *, ' rrfs_smoke : ', Model%rrfs_smoke
print *, ' use_cice_alb : ', Model%use_cice_alb
print *, ' cpl_imp_mrg : ', Model%cpl_imp_mrg
Expand Down Expand Up @@ -6324,7 +6335,7 @@ subroutine tbd_create (Tbd, IM, Model)
Tbd%acvb = clear_val
Tbd%acvt = clear_val

if (Model%cplflx .or. Model%cplchm) then
if (Model%cplflx .or. Model%cplchm .or. Model%cpllnd) then
allocate (Tbd%drain_cpl (IM))
allocate (Tbd%dsnow_cpl (IM))
Tbd%drain_cpl = clear_val
Expand Down
Loading

0 comments on commit 324591b

Please sign in to comment.