Skip to content

Commit

Permalink
Merge pull request #470 from mvertens/feature/trigrid
Browse files Browse the repository at this point in the history 
Add trigrid capability - ability to run atm and lnd on separate grids
  • Loading branch information
@jedwards4b
jedwards4b authored Jun 26, 2024
2 parents e1335d3 + 66ce7e5 commit 1dd90c7
Show file tree
Hide file tree
Showing 7 changed files with 450 additions and 298 deletions.
446 changes: 214 additions & 232 deletions mediator/esmFldsExchange_cesm_mod.F90
View file

Large diffs are not rendered by default.

16 changes: 14 additions & 2 deletions mediator/fd_cesm.yaml
View file
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
View file
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
View file
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

0 comments on commit 1dd90c7

Please sign in to comment.