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.

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

Add trigrid capability - ability to run atm and lnd on separate grids #470

Merged
merged 17 commits into from
Jun 26, 2024
446 changes: 214 additions & 232 deletions mediator/esmFldsExchange_cesm_mod.F90

Large diffs are not rendered by default.

16 changes: 14 additions & 2 deletions mediator/fd_cesm.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -857,12 +857,24 @@
#
- standard_name: Faoo_fco2_ocn
canonical_units: moles m-2 s-1
description: ocn import to med
description: ocn import to med - surface flux of CO2 (downward positive)
#
- standard_name: Faoo_dms_ocn
- standard_name: Faoo_fdms_ocn
canonical_units: moles m-2 s-1
description: ocn import to med - surface flux of DMS (downward positive)
#
- standard_name: Faoo_fbrf_ocn
canonical_units: moles m-2 s-1
description: ocn import to med - surface flux of Bromoform (downward positive)
#
- standard_name: Faoo_fn2o_ocn
canonical_units: moles m-2 s-1
description: ocn import to med - surface flux of N2O (downward positive)
#
- standard_name: Faoo_fnh3_ocn
canonical_units: moles m-2 s-1
description: ocn import to med - surface flux of NH3 (downward positive)
#
- standard_name: So_anidf
canonical_units: 1
description: ocn import to med
Expand Down
13 changes: 9 additions & 4 deletions mediator/med_diag_mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,7 @@ module med_diag_mod
use med_constants_mod , only : shr_const_rearth, shr_const_pi, shr_const_latice, shr_const_latvap
use med_constants_mod , only : shr_const_ice_ref_sal, shr_const_ocn_ref_sal, shr_const_isspval
use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8
use med_internalstate_mod , only : InternalState, logunit, maintask, diagunit
use med_internalstate_mod , only : InternalState, logunit, maintask, diagunit, samegrid_atmlnd
use med_methods_mod , only : fldbun_getdata2d => med_methods_FB_getdata2d
use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d
use med_methods_mod , only : fldbun_fldChk => med_methods_FB_FldChk
Expand Down Expand Up @@ -666,8 +666,13 @@ subroutine med_phases_diag_atm(gcomp, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

! Get fractions on atm mesh
call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (samegrid_atmlnd) then
call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
else
call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrin', lfrac, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end if
call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'ifrac', ifrac, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc)
Expand Down Expand Up @@ -986,7 +991,7 @@ subroutine med_phases_diag_lnd( gcomp, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

! get fractions on lnd mesh
call fldbun_getdata1d(is_local%wrap%FBfrac(complnd), 'lfrac', lfrac, rc=rc)
call fldbun_getdata1d(is_local%wrap%FBfrac(complnd), 'lfrin', lfrac, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

areas => is_local%wrap%mesh_info(complnd)%areas
Expand Down
124 changes: 103 additions & 21 deletions mediator/med_fraction_mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -10,19 +10,24 @@ module med_fraction_mod
! ifrad = fraction of ocn on a grid at last radiation time
! ofrad = fraction of ice on a grid at last radiation time
!
! ofrad = fraction of ice on a grid at last radiation time
! afrac, lfrac, ifrac, and ofrac are the self-consistent values in the
! system. lfrin is the fraction on the land grid and is allowed to
! vary from the self-consistent value as descibed below. ifrad
! and ofrad are needed for the swnet calculation.
! lfrac, ifrac, and ofrac:
! are the self-consistent values in the system
! ifrad and ofrad:
! are needed for the swnet calculation.
!
! the fractions fields are defined for each grid in the fraction bundles as
! needed as follows.
! character(*),parameter :: fraclist_a = 'ifrac:ofrac:lfrac:aofrac
! character(*),parameter :: fraclist_a = 'ifrac:ofrac:lfrac:lfrin:aofrac
! character(*),parameter :: fraclist_o = 'ifrac:ofrac:ifrad:ofrad'
! character(*),parameter :: fraclist_i = 'ifrac:ofrac'
! character(*),parameter :: fraclist_l = 'lfrac'
! character(*),parameter :: fraclist_g = 'gfrac:lfrac'
! character(*),parameter :: fraclist_r = 'lfrac:rfrac'
! character(*),parameter :: fraclist_l = 'lfrac:lfrin'
! character(*),parameter :: fraclist_g = 'gfrac:lfrac:lfrin'
! character(*),parameter :: fraclist_r = 'rfrac:lfrac:lfrin'
!
! we assume ocean and ice are on the same grids, same masks
! we assume ocn2atm and ice2atm are masked maps
Expand All @@ -44,6 +49,9 @@ module med_fraction_mod
! where fractions_* are a bundle of fractions on a particular grid and
! *frac is the fraction of a particular component in the bundle.
!
! in general, on every grid,
! fractions_*(ifrac) + fractions_*(ofrac) + fractions_*(lfrac) = 1.0
!
! the fractions are computed fundamentally as follows (although the
! detailed implementation might be slightly different)
!
Expand All @@ -52,8 +60,12 @@ module med_fraction_mod
! fractions_*(ifrac) = 0.0
! fractions/masks provided by surface components
! fractions_o(ofrac) = ocean "mask" provided by ocean
! fractions_l(lfrin) = Sl_lfrin ! land model fraction computed as
! map of ocean mask to land grid
! then mapped to the atm model
! fractions_a(ofrac) = mapo2a(fractions_o(ofrac))
! fractions_a(lfrin) = mapl2a(fractions_l(lfrin))
!
! and a few things are then derived
! fractions_a(lfrac) = 1.0 - fractions_a(ofrac)
! this is truncated to zero for very small values (< 0.001)
Expand All @@ -79,8 +91,8 @@ module med_fraction_mod
! fraction corrections in mapping are as follows
! mapo2a uses *fractions_o(ofrac) and /fractions_a(ofrac)
! mapi2a uses *fractions_i(ifrac) and /fractions_a(ifrac)
! mapl2a uses *fractions_l(lfrac)
! mapl2g weights by fractions_l(lfrac) with normalization and multiplies by fractions_g(lfrac)
! mapl2a uses *fractions_l(lfrin) and /fractions_a(lfrin)
! mapl2g weights by fractions_l(lfrin) with normalization and multiplies by fractions_g(lfrin) ???
!
! run time:
! fractions_a(lfrac) + fractions_a(ofrac) + fractions_a(ifrac) ~ 1.0
Expand All @@ -95,6 +107,19 @@ module med_fraction_mod
! is_local%wrap%FBImp(compocn,compocn) => 'So_omask'
! is_local%wrap%FBImp(compice,compice) => 'Si_ifrac' (runtime)
!
! NOTE: In trigrid configurations, lfrin MUST be defined as the
! conservative o2l mapping of the complement of the ocean mask.
! In non-trigrid configurations, lfrin is generally associated with
! the fraction of land grid defined by the surface dataset and might
! be 1 everywhere for instance. In many cases, the non-trigrid
! lfrin is defined to be the conservative o2a mapping of the complement
! of the ocean mask. In this case, it is defined the same as the
! trigrid. But to support all cases,
! for trigrid:
! mapping from the land grid should use the lfrin field (same in non-trigrid)
! budget diagnostics should use lfrin (lfrac in non-trigrid)
! merges in the atm should use lfrac (same in non-trigrid)
! the runoff should use the lfrin fraction in the runoff merge (lfrac in non-trigrid)
!-----------------------------------------------------------------------------

use med_kind_mod , only : CX =>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8
Expand All @@ -118,15 +143,15 @@ module med_fraction_mod
public med_fraction_init
public med_fraction_set

integer, parameter :: nfracs = 5
character(len=6),allocatable :: fraclist(:,:)
character(len=6),parameter,dimension(4) :: fraclist_a = (/'ifrac ','ofrac ','lfrac ','aofrac'/)
character(len=6),parameter,dimension(4) :: fraclist_o = (/'ifrac ','ofrac ','ifrad ','ofrad '/)
character(len=6),parameter,dimension(2) :: fraclist_i = (/'ifrac ','ofrac '/)
character(len=6),parameter,dimension(1) :: fraclist_l = (/'lfrac '/)
character(len=6),parameter,dimension(2) :: fraclist_g = (/'gfrac ','lfrac '/)
character(len=6),parameter,dimension(2) :: fraclist_r = (/'rfrac ','lfrac '/)
character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/)
integer, parameter :: nfracs = 5
character(len=6),allocatable :: fraclist(:,:)
character(len=6),parameter :: fraclist_a(5) = (/'ifrac ','ofrac ','lfrac ','lfrin ','aofrac'/)
character(len=6),parameter :: fraclist_o(4) = (/'ifrac ','ofrac ','ifrad ','ofrad '/)
character(len=6),parameter :: fraclist_i(2) = (/'ifrac ','ofrac '/)
character(len=6),parameter :: fraclist_l(2) = (/'lfrac ','lfrin '/)
character(len=6),parameter :: fraclist_g(3) = (/'gfrac ','lfrac ','lfrin '/)
character(len=6),parameter :: fraclist_r(3) = (/'rfrac ','lfrac ','lfrin '/)
character(len=6),parameter :: fraclist_w(1) = (/'wfrac '/)

!--- standard ---
real(R8) , parameter :: eps_fraclim = 1.0e-03 ! truncation limit in fractions_a(lfrac)
Expand Down Expand Up @@ -169,6 +194,7 @@ subroutine med_fraction_init(gcomp, rc)
real(R8), pointer :: ofrac(:)
real(R8), pointer :: aofrac(:)
real(R8), pointer :: lfrac(:)
real(R8), pointer :: lfrin(:)
real(R8), pointer :: ifrac(:)
real(R8), pointer :: gfrac(:)
real(R8), pointer :: rfrac(:)
Expand Down Expand Up @@ -251,7 +277,8 @@ subroutine med_fraction_init(gcomp, rc)
endif

!---------------------------------------
! Set 'lfrac' for FBFrac(complnd) - this might be overwritten later
! Set 'lfrac' in FBFrac(complnd) - this might be overwritten later
! Set 'lfrin' in FBFrac(complnd)
!---------------------------------------

if (is_local%wrap%comp_present(complnd)) then
Expand All @@ -262,6 +289,11 @@ subroutine med_fraction_init(gcomp, rc)
if (associated(lfrac)) then
lfrac(:) = Sl_lfrin(:)
end if
call fldbun_getdata1d(is_local%wrap%FBFrac(complnd) , 'lfrin', lfrin, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (associated(lfrin)) then
lfrin(:) = Sl_lfrin(:)
end if
end if

!---------------------------------------
Expand Down Expand Up @@ -378,7 +410,40 @@ subroutine med_fraction_init(gcomp, rc)
end if

!---------------------------------------
! Set 'lfrac' in FBFrac(compatm) and correct 'ofrac' in FBFrac(compatm)
! Set 'lfrin' in FBFrac(compatm)
! ---------------------------------------

if ( is_local%wrap%comp_present(compatm) .and. &
is_local%wrap%comp_present(complnd) .and. &
is_local%wrap%med_coupling_active(complnd,compatm)) then

if (med_map_RH_is_created(is_local%wrap%RH(complnd,compatm,:),mapfcopy, rc=rc)) then
maptype = mapfcopy
else
maptype = mapconsd
if (.not. med_map_RH_is_created(is_local%wrap%RH(complnd,compatm,:),maptype, rc=rc)) then
if (ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(complnd,compatm))) then
call med_map_routehandles_init( complnd, compatm, &
FBSrc=is_local%wrap%FBImp(complnd,complnd), &
FBDst=is_local%wrap%FBImp(complnd,compatm), &
mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end if
end if
end if

call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrin', field=field_src, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compatm), 'lfrin', field=field_dst, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,compatm,:), maptype, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

end if

!---------------------------------------
! Set 'lfrac' in FBFrac(compatm)
! Reset 'ofrac' in FBFrac(compatm) if appropriate
! ---------------------------------------
! These should actually be mapo2a of ofrac and lfrac but we can't
! map lfrac from o2a due to masked mapping weights. So we have to
Expand All @@ -389,7 +454,7 @@ subroutine med_fraction_init(gcomp, rc)

if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compice)) then

! Ocean is present
! Ocean or ice is present
call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc)
Expand Down Expand Up @@ -437,6 +502,7 @@ subroutine med_fraction_init(gcomp, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (associated(ofrac)) then
do n = 1,size(lfrac)
lfrac(n) = lfrin(n)
ofrac(n) = 1.0_R8 - lfrac(n)
if (abs(ofrac(n)) < eps_fraclim) then
ofrac(n) = 0.0_R8
Expand Down Expand Up @@ -502,7 +568,7 @@ subroutine med_fraction_init(gcomp, rc)
endif
endif

! Set 'lfrac' in FBFrac(comprof)
! Set 'lfrac' and 'lfrin' in FBFrac(comprof)
if (is_local%wrap%comp_present(complnd)) then
maptype = mapconsd
if (.not. med_map_RH_is_created(is_local%wrap%RH(complnd,comprof,:),maptype, rc=rc)) then
Expand All @@ -512,17 +578,25 @@ subroutine med_fraction_init(gcomp, rc)
mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end if

call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrac', field=field_src, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldBundleGet(is_local%wrap%FBfrac(comprof), 'lfrac', field=field_dst, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,comprof,:), maptype, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrin', field=field_src, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldBundleGet(is_local%wrap%FBfrac(comprof), 'lfrin', field=field_dst, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,comprof,:), maptype, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
endif
endif

!---------------------------------------
! Set 'gfrac' and 'lfrac' for FBFrac(compglc)
! Set 'gfrac', 'lfrac' and 'lfrin' in FBFrac(compglc)
!---------------------------------------

do ns = 1,is_local%wrap%num_icesheets
Expand All @@ -547,7 +621,7 @@ subroutine med_fraction_init(gcomp, rc)
endif
endif

! Set 'lfrac' in FBFrac(compglc(ns))
! Set 'lfrac' and 'lfrin' in FBFrac(compglc(ns))
if ( is_local%wrap%comp_present(complnd) .and. is_local%wrap%med_coupling_active(complnd,compglc(ns))) then
maptype = mapconsd
if (.not. med_map_RH_is_created(is_local%wrap%RH(complnd,compglc(ns),:),maptype, rc=rc)) then
Expand All @@ -557,12 +631,20 @@ subroutine med_fraction_init(gcomp, rc)
mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end if

call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrac', field=field_src, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compglc(ns)), 'lfrac', field=field_dst, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,compglc(ns),:), maptype, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrin', field=field_src, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compglc(ns)), 'lfrin', field=field_dst, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,compglc(ns),:), maptype, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
endif
endif
end do
Expand Down
Loading
Loading