From 8fa0185b705c787f3ca1ec74df8aa9926e0155dc Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 20 May 2024 12:58:34 -0600 Subject: [PATCH 01/13] changes for trigrid --- mediator/esmFldsExchange_cesm_mod.F90 | 127 ++++++++++++++++++++++---- 1 file changed, 109 insertions(+), 18 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 47d0ae1a..4b9e4437 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -57,6 +57,8 @@ module esmFldsExchange_cesm_mod logical :: flds_wiso ! Pass water isotop fields logical :: flds_r2l_stream_channel_depths ! Pass channel depths from ROF to LND + logical :: samegrid_al ! true=>atm and lnd are on the same grid + character(*), parameter :: u_FILE_u = & __FILE__ @@ -98,6 +100,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) character(len=CL) :: cvalue logical :: wav_coupling_to_cice logical :: ocn2glc_coupling + character(len=CL) :: atm_mesh + character(len=CL) :: lnd_mesh + character(len=CS) :: mrg_fracname_lnd character(len=*) , parameter :: subname=' (esmFldsExchange_cesm) ' !-------------------------------------- @@ -220,6 +225,17 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_r2l_stream_channel_depths + ! determine if atm and lnd have the same mesh + call NUOPC_CompAttributeGet(gcomp, name='ATM_DOMAIN_MESH', value=atm_mesh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='ATM_DOMAIN_MESH', value=lnd_mesh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(atm_mesh) == trim(lnd_mesh)) then + samegrid_al = .true. + else + samegrid_al = .false. + end if + ! write diagnostic output if (maintask) then write(logunit,'(a,l7)') trim(subname)//' flds_co2a = ',flds_co2a @@ -1153,8 +1169,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_taux', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_taux', rc=rc)) then call addmap_from(complnd , 'Fall_taux', compatm, mapconsf, 'lfrin', lnd2atm_map) + if (samegrid_al) then + mrg_fracname_lnd='lfrac' + else + mrg_fracname_lnd='lfrin' + end if call addmrg_to(compatm , 'Faxx_taux', & - mrg_from=complnd, mrg_fld='Fall_taux', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_taux', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_taux', rc=rc)) then call addmap_from(compice , 'Faii_taux', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1180,8 +1201,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_tauy', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_tauy', rc=rc)) then call addmap_from(complnd , 'Fall_tauy', compatm, mapconsf, 'lfrin', lnd2atm_map) + if (samegrid_al) then + mrg_fracname_lnd='lfrac' + else + mrg_fracname_lnd='lfrin' + end if call addmrg_to(compatm , 'Faxx_tauy', & - mrg_from=complnd, mrg_fld='Fall_tauy', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_tauy', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_tauy', rc=rc)) then call addmap_from(compice , 'Faii_tauy', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1207,8 +1233,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lat', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lat', rc=rc)) then call addmap_from(complnd , 'Fall_lat', compatm, mapconsf, 'lfrin', lnd2atm_map) + if (samegrid_al) then + mrg_fracname_lnd='lfrac' + else + mrg_fracname_lnd='lfrin' + end if call addmrg_to(compatm , 'Faxx_lat', & - mrg_from=complnd, mrg_fld='Fall_lat', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_lat', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_lat', rc=rc)) then call addmap_from(compice , 'Faii_lat', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1234,8 +1265,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_sen', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_sen', rc=rc)) then call addmap_from(complnd , 'Fall_sen', compatm, mapconsf, 'lfrin', lnd2atm_map) + if (samegrid_al) then + mrg_fracname_lnd='lfrac' + else + mrg_fracname_lnd='lfrin' + end if call addmrg_to(compatm , 'Faxx_sen', & - mrg_from=complnd, mrg_fld='Fall_sen', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_sen', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_sen', rc=rc)) then call addmap_from(compice , 'Faii_sen', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1261,8 +1297,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap', rc=rc)) then call addmap_from(complnd , 'Fall_evap', compatm, mapconsf, 'lfrin', lnd2atm_map) + if (samegrid_al) then + mrg_fracname_lnd='lfrac' + else + mrg_fracname_lnd='lfrin' + end if call addmrg_to(compatm , 'Faxx_evap', & - mrg_from=complnd, mrg_fld='Fall_evap', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_evap', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap', rc=rc)) then call addmap_from(compice , 'Faii_evap', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1288,8 +1329,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lwup', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lwup', rc=rc)) then call addmap_from(complnd , 'Fall_lwup', compatm, mapconsf, 'lfrin', lnd2atm_map) + if (samegrid_al) then + mrg_fracname_lnd='lfrac' + else + mrg_fracname_lnd='lfrin' + end if call addmrg_to(compatm , 'Faxx_lwup', & - mrg_from=complnd, mrg_fld='Fall_lwup', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_lwup', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_lwup', rc=rc)) then call addmap_from(compice , 'Faii_lwup', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1316,8 +1362,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap_wiso', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap_wiso', rc=rc)) then call addmap_from(complnd , 'Fall_evap_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + if (samegrid_al) then + mrg_fracname_lnd='lfrac' + else + mrg_fracname_lnd='lfrin' + end if call addmrg_to(compatm , 'Faxx_evap_wiso', & - mrg_from=complnd, mrg_fld='Fall_evap_wiso', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_evap_wiso', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap_wiso', rc=rc)) then call addmap_from(compice , 'Faii_evap_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1532,8 +1583,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compatm, 'Sl_snowh', mrg_from=complnd, mrg_fld='Sl_snowh', mrg_type='copy') end if end if + ! --------------------------------------------------------------------- - ! CARMA fields (volumetric soil water) + ! atm atm: CARMA fields (volumetric soil water) from land !----------------------------------------------------------------------------- if (phase == 'advertise') then call addfld_from(complnd, 'Sl_soilw') @@ -1545,6 +1597,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compatm, 'Sl_soilw', mrg_from=complnd, mrg_fld='Sl_soilw', mrg_type='copy') end if end if + ! --------------------------------------------------------------------- ! to atm: dust fluxes from land (4 sizes) ! --------------------------------------------------------------------- @@ -1559,6 +1612,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=complnd, mrg_fld='Fall_flxdst', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if + !----------------------------------------------------------------------------- ! to atm: MEGAN emissions fluxes from land !----------------------------------------------------------------------------- @@ -1569,10 +1623,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_voc', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_voc', rc=rc)) then call addmap_from(complnd, 'Fall_voc', compatm, mapconsf, 'one', atm2lnd_map) + if (samegrid_al) then + mrg_fracname_lnd='lfrac' + else + mrg_fracname_lnd='lfrin' + end if call addmrg_to(compatm, 'Fall_voc', & - mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) end if end if + !----------------------------------------------------------------------------- ! to atm: fire emissions fluxes from land !----------------------------------------------------------------------------- @@ -1584,8 +1644,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_fire', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_fire', rc=rc)) then call addmap_from(complnd, 'Fall_fire', compatm, mapconsf, 'one', lnd2atm_map) + if (samegrid_al) then + mrg_fracname_lnd='lfrac' + else + mrg_fracname_lnd='lfrin' + end if call addmrg_to(compatm, 'Fall_fire', & - mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) end if end if ! 'wild fire plume height' @@ -1599,6 +1664,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compatm, 'Sl_fztop', mrg_from=complnd, mrg_fld='Sl_fztop', mrg_type='copy') end if end if + !----------------------------------------------------------------------------- ! to atm: dry deposition velocities from land !----------------------------------------------------------------------------- @@ -3099,9 +3165,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsur', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsur', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofsur', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmap_from(complnd, 'Flrl_rofsur', comprof, mapconsf, 'lfrin', lnd2rof_map) + if (samegrid_al) then + mrg_fracname_lnd = 'lfrac' + else + mrg_fracname_lnd = 'lfrin' + endif call addmrg_to(comprof, 'Flrl_rofsur', & - mrg_from=complnd, mrg_fld='Flrl_rofsur', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Flrl_rofsur', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd) end if end if @@ -3114,9 +3185,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofi', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofi', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofi', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmap_from(complnd, 'Flrl_rofi', comprof, mapconsf, 'lfrin', lnd2rof_map) + if (samegrid_al) then + mrg_fracname_lnd = 'lfrac' + else + mrg_fracname_lnd = 'lfrin' + endif call addmrg_to(comprof, 'Flrl_rofi', & - mrg_from=complnd, mrg_fld='Flrl_rofi', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Flrl_rofi', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd) end if end if @@ -3129,9 +3205,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofgwl', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofgwl', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofgwl', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmap_from(complnd, 'Flrl_rofgwl', comprof, mapconsf, 'lfrin', lnd2rof_map) + if (samegrid_al) then + mrg_fracname_lnd = 'lfrac' + else + mrg_fracname_lnd = 'lfrin' + endif call addmrg_to(comprof, 'Flrl_rofgwl', & - mrg_from=complnd, mrg_fld='Flrl_rofgwl', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Flrl_rofgwl', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd) end if end if @@ -3145,8 +3226,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsub', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsub', rc=rc)) then call addmap_from(complnd, 'Flrl_rofsub', comprof, mapconsf, 'lfrac', lnd2rof_map) + if (samegrid_al) then + mrg_fracname_lnd = 'lfrac' + else + mrg_fracname_lnd = 'lfrin' + endif call addmrg_to(comprof, 'Flrl_rofsub', & - mrg_from=complnd, mrg_fld='Flrl_rofsub', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Flrl_rofsub', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd) end if end if @@ -3160,8 +3246,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_irrig', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_irrig', rc=rc)) then call addmap_from(complnd, 'Flrl_irrig', comprof, mapconsf, 'lfrac', lnd2rof_map) + if (samegrid_al) then + mrg_fracname_lnd = 'lfrac' + else + mrg_fracname_lnd = 'lfrin' + endif call addmrg_to(comprof, 'Flrl_irrig', & - mrg_from=complnd, mrg_fld='Flrl_irrig', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Flrl_irrig', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd) end if end if From a90affa284d26c082d320545fd240d0f558074da Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 30 May 2024 04:30:58 -0600 Subject: [PATCH 02/13] fixed ice discharge --- mediator/esmFldsExchange_cesm_mod.F90 | 52 ++++++++++++--------------- mediator/med_internalstate_mod.F90 | 2 ++ mediator/med_phases_prep_atm_mod.F90 | 11 ++++-- mediator/med_phases_prep_glc_mod.F90 | 18 +++++++--- mediator/med_phases_prep_rof_mod.F90 | 4 +-- 5 files changed, 48 insertions(+), 39 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 4b9e4437..e05518b6 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -20,7 +20,7 @@ module esmFldsExchange_cesm_mod !-------------------------------------- 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 : logunit, maintask + use med_internalstate_mod , only : logunit, maintask, samegrid_atmlnd implicit none public @@ -45,7 +45,6 @@ module esmFldsExchange_cesm_mod character(len=CX) :: ice2atm_map='unset' character(len=CX) :: ocn2atm_map='unset' character(len=CX) :: lnd2atm_map='unset' - character(len=CX) :: lnd2rof_map='unset' character(len=CX) :: rof2lnd_map='unset' character(len=CX) :: atm2wav_map='unset' @@ -57,8 +56,6 @@ module esmFldsExchange_cesm_mod logical :: flds_wiso ! Pass water isotop fields logical :: flds_r2l_stream_channel_depths ! Pass channel depths from ROF to LND - logical :: samegrid_al ! true=>atm and lnd are on the same grid - character(*), parameter :: u_FILE_u = & __FILE__ @@ -178,11 +175,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (maintask) write(logunit, '(a)') trim(subname)//'rof2ocn_ice_rmapname = '// trim(rof2ocn_ice_rmap) - ! mapping to rof - call NUOPC_CompAttributeGet(gcomp, name='lnd2rof_map', value=lnd2rof_map, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'lnd2rof_map = '// trim(lnd2rof_map) - ! mapping to wav call NUOPC_CompAttributeGet(gcomp, name='atm2wav_map', value=atm2wav_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -231,9 +223,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call NUOPC_CompAttributeGet(gcomp, name='ATM_DOMAIN_MESH', value=lnd_mesh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (trim(atm_mesh) == trim(lnd_mesh)) then - samegrid_al = .true. + samegrid_atmlnd = .true. else - samegrid_al = .false. + samegrid_atmlnd = .false. end if ! write diagnostic output @@ -1169,7 +1161,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_taux', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_taux', rc=rc)) then call addmap_from(complnd , 'Fall_taux', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_al) then + if (samegrid_atmlnd) then mrg_fracname_lnd='lfrac' else mrg_fracname_lnd='lfrin' @@ -1201,7 +1193,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_tauy', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_tauy', rc=rc)) then call addmap_from(complnd , 'Fall_tauy', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_al) then + if (samegrid_atmlnd) then mrg_fracname_lnd='lfrac' else mrg_fracname_lnd='lfrin' @@ -1233,7 +1225,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lat', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lat', rc=rc)) then call addmap_from(complnd , 'Fall_lat', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_al) then + if (samegrid_atmlnd) then mrg_fracname_lnd='lfrac' else mrg_fracname_lnd='lfrin' @@ -1265,7 +1257,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_sen', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_sen', rc=rc)) then call addmap_from(complnd , 'Fall_sen', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_al) then + if (samegrid_atmlnd) then mrg_fracname_lnd='lfrac' else mrg_fracname_lnd='lfrin' @@ -1297,7 +1289,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap', rc=rc)) then call addmap_from(complnd , 'Fall_evap', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_al) then + if (samegrid_atmlnd) then mrg_fracname_lnd='lfrac' else mrg_fracname_lnd='lfrin' @@ -1329,7 +1321,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lwup', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lwup', rc=rc)) then call addmap_from(complnd , 'Fall_lwup', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_al) then + if (samegrid_atmlnd) then mrg_fracname_lnd='lfrac' else mrg_fracname_lnd='lfrin' @@ -1362,7 +1354,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap_wiso', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap_wiso', rc=rc)) then call addmap_from(complnd , 'Fall_evap_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_al) then + if (samegrid_atmlnd) then mrg_fracname_lnd='lfrac' else mrg_fracname_lnd='lfrin' @@ -1623,7 +1615,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_voc', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_voc', rc=rc)) then call addmap_from(complnd, 'Fall_voc', compatm, mapconsf, 'one', atm2lnd_map) - if (samegrid_al) then + if (samegrid_atmlnd) then mrg_fracname_lnd='lfrac' else mrg_fracname_lnd='lfrin' @@ -1644,7 +1636,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_fire', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_fire', rc=rc)) then call addmap_from(complnd, 'Fall_fire', compatm, mapconsf, 'one', lnd2atm_map) - if (samegrid_al) then + if (samegrid_atmlnd) then mrg_fracname_lnd='lfrac' else mrg_fracname_lnd='lfrin' @@ -3165,8 +3157,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsur', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsur', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofsur', comprof, mapconsf, 'lfrin', lnd2rof_map) - if (samegrid_al) then + call addmap_from(complnd, 'Flrl_rofsur', comprof, mapconsf, 'lfrin', 'unset') + if (samegrid_atmlnd) then mrg_fracname_lnd = 'lfrac' else mrg_fracname_lnd = 'lfrin' @@ -3185,8 +3177,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofi', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofi', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofi', comprof, mapconsf, 'lfrin', lnd2rof_map) - if (samegrid_al) then + call addmap_from(complnd, 'Flrl_rofi', comprof, mapconsf, 'lfrin', 'unset') + if (samegrid_atmlnd) then mrg_fracname_lnd = 'lfrac' else mrg_fracname_lnd = 'lfrin' @@ -3205,8 +3197,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofgwl', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofgwl', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofgwl', comprof, mapconsf, 'lfrin', lnd2rof_map) - if (samegrid_al) then + call addmap_from(complnd, 'Flrl_rofgwl', comprof, mapconsf, 'lfrin', 'unset') + if (samegrid_atmlnd) then mrg_fracname_lnd = 'lfrac' else mrg_fracname_lnd = 'lfrin' @@ -3225,8 +3217,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsub', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsub', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofsub', comprof, mapconsf, 'lfrac', lnd2rof_map) - if (samegrid_al) then + call addmap_from(complnd, 'Flrl_rofsub', comprof, mapconsf, 'lfrac', 'unset') + if (samegrid_atmlnd) then mrg_fracname_lnd = 'lfrac' else mrg_fracname_lnd = 'lfrin' @@ -3245,8 +3237,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_irrig', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_irrig', rc=rc)) then - call addmap_from(complnd, 'Flrl_irrig', comprof, mapconsf, 'lfrac', lnd2rof_map) - if (samegrid_al) then + call addmap_from(complnd, 'Flrl_irrig', comprof, mapconsf, 'lfrac', 'unset') + if (samegrid_atmlnd) then mrg_fracname_lnd = 'lfrac' else mrg_fracname_lnd = 'lfrin' diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index fb35645d..a0fd7d95 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -115,6 +115,8 @@ module med_internalstate_mod real(r8), pointer :: lons(:) => null() end type mesh_info_type + logical, public :: samegrid_atmlnd = .true. ! true=>atm and lnd are on the same grid + ! private internal state to keep instance data type InternalStateStruct diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index b9e7582e..f8744800 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -17,7 +17,7 @@ module med_phases_prep_atm_mod use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed - use med_internalstate_mod , only : InternalState, maintask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit, samegrid_atmlnd use med_internalstate_mod , only : compatm, compocn, compice, compname, coupling_mode use esmFlds , only : med_fldlist_GetfldListTo, med_fldlist_type use perf_mod , only : t_startf, t_stopf @@ -183,8 +183,13 @@ subroutine med_phases_prep_atm(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, farrayPtr=dataptr1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='lfrac', field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (samegrid_atmlnd) then + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='lfrac', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='lfrin', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if call ESMF_FieldGet(lfield, farrayPtr=dataptr2, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,size(dataptr1) diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 4a1df0ee..cb7acea1 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -814,8 +814,13 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! get land fraction field on land mesh - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), 'lfrac', field=field_lfrac_l, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (samegrid_atmlnd) then + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='lfrac', field=lfield_lfrac_l, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='lfrin', field=lfield_lfrac_l, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if ! map accumlated land fields to each ice sheet (normalize by the land fraction in the mapping) do ns = 1,is_local%wrap%num_icesheets @@ -1149,8 +1154,13 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return ! determine fraction on land grid, lfrac(:) - call fldbun_getdata1d(is_local%wrap%FBFrac(complnd), 'lfrac', lfrac, rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return + if (samegrid_atmlnd) then + call fldbun_getdata1d(is_local%wrap%FBFrac(complnd), 'lfrac', lfrac, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + else + call fldbun_getdata1d(is_local%wrap%FBFrac(complnd), 'lfrin', lfrac, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + end if ! get qice_l_ec call fldbun_getdata2d(FBlndAccum2glc_l, trim(qice_fieldname)//'_elev', qice_l_ec, rc) diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 55b2dae8..8aeba272 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -13,7 +13,7 @@ module med_phases_prep_rof_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use ESMF , only : ESMF_FieldBundle, ESMF_Field use med_internalstate_mod , only : complnd, comprof, mapconsf, mapconsd, mapfcopy - use med_internalstate_mod , only : InternalState, maintask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit, samegrid_atmlnd use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_constants_mod , only : czero => med_constants_czero use med_utils_mod , only : chkerr => med_utils_chkerr @@ -619,7 +619,7 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) ! convert to a total irrigation flux on the ROF grid ! ------------------------------------------------------------------------ - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), 'lfrac', field=field_lfrac_lnd, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), 'lfrin', field=field_lfrac_lnd, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call med_map_field_normalized( & From b34de125d6f92119d0288d3d9524520e7f9be4af Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 31 May 2024 04:54:17 -0600 Subject: [PATCH 03/13] fixes for commit --- mediator/esmFldsExchange_cesm_mod.F90 | 249 +++++++++----------------- mediator/med_diag_mod.F90 | 13 +- mediator/med_fraction_mod.F90 | 163 ++++++++++++----- mediator/med_internalstate_mod.F90 | 48 ++++- mediator/med_phases_prep_glc_mod.F90 | 30 ++-- mediator/med_phases_prep_rof_mod.F90 | 4 +- 6 files changed, 265 insertions(+), 242 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index e05518b6..a4280c5a 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -21,6 +21,9 @@ module esmFldsExchange_cesm_mod 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 : logunit, maintask, samegrid_atmlnd + use med_internalstate_mod , only : mrg_fracname_lnd2atm_state, mrg_fracname_lnd2atm_flux, map_fracname_lnd2atm + use med_internalstate_mod , only : mrg_fracname_lnd2rof, map_fracname_lnd2rof + use med_internalstate_mod , only : mrg_fracname_lnd2glc, map_fracname_lnd2glc implicit none public @@ -28,25 +31,25 @@ module esmFldsExchange_cesm_mod public :: esmFldsExchange_cesm ! currently required mapping files - character(len=CX) :: glc2ice_rmap ='unset' - character(len=CX) :: glc2ocn_liq_rmap ='unset' - character(len=CX) :: glc2ocn_ice_rmap ='unset' character(len=CX) :: rof2ocn_fmap ='unset' character(len=CX) :: rof2ocn_ice_rmap ='unset' character(len=CX) :: rof2ocn_liq_rmap ='unset' - character(len=CX) :: wav2ocn_smap ='unset' - character(len=CX) :: ice2wav_smap ='unset' - character(len=CX) :: ocn2wav_smap ='unset' ! no mapping files (value is 'idmap' or 'unset') - character(len=CX) :: atm2ice_map='unset' - character(len=CX) :: atm2ocn_map='unset' - character(len=CX) :: atm2lnd_map='unset' - character(len=CX) :: ice2atm_map='unset' - character(len=CX) :: ocn2atm_map='unset' - character(len=CX) :: lnd2atm_map='unset' - character(len=CX) :: rof2lnd_map='unset' - character(len=CX) :: atm2wav_map='unset' + character(len=CX) :: atm2ice_map ='unset' + character(len=CX) :: atm2ocn_map ='unset' + character(len=CX) :: atm2lnd_map ='unset' + character(len=CX) :: ice2atm_map ='unset' + character(len=CX) :: ocn2atm_map ='unset' + character(len=CX) :: ocn2wav_smap ='unset' + character(len=CX) :: lnd2atm_map ='unset' + character(len=CX) :: rof2lnd_map ='unset' + character(len=CX) :: atm2wav_map ='unset' + character(len=CX) :: wav2ocn_smap ='unset' + character(len=CX) :: ice2wav_smap ='unset' + character(len=CX) :: glc2ice_rmap ='unset' + character(len=CX) :: glc2ocn_liq_rmap ='unset' + character(len=CX) :: glc2ocn_ice_rmap ='unset' logical :: mapuv_with_cart3d ! Map U/V vector wind fields from ATM to OCN/ICE by rotating in Cartesian 3D space and then back logical :: flds_i2o_per_cat ! Ice thickness category fields passed to OCN @@ -97,9 +100,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) character(len=CL) :: cvalue logical :: wav_coupling_to_cice logical :: ocn2glc_coupling - character(len=CL) :: atm_mesh - character(len=CL) :: lnd_mesh - character(len=CS) :: mrg_fracname_lnd character(len=*) , parameter :: subname=' (esmFldsExchange_cesm) ' !-------------------------------------- @@ -217,16 +217,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_r2l_stream_channel_depths - ! determine if atm and lnd have the same mesh - call NUOPC_CompAttributeGet(gcomp, name='ATM_DOMAIN_MESH', value=atm_mesh, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='ATM_DOMAIN_MESH', value=lnd_mesh, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(atm_mesh) == trim(lnd_mesh)) then - samegrid_atmlnd = .true. - else - samegrid_atmlnd = .false. - end if ! write diagnostic output if (maintask) then @@ -813,9 +803,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_avsdr', rc=rc)) then - call addmap_from(complnd, 'Sl_avsdr', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_avsdr', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sx_avsdr', & - mrg_from=complnd, mrg_fld='Sl_avsdr', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_avsdr', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_avsdr', rc=rc)) then call addmap_from(compice, 'Si_avsdr', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -840,9 +830,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_avsdf', rc=rc)) then - call addmap_from(complnd, 'Sl_avsdf', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_avsdf', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sx_avsdf', & - mrg_from=complnd, mrg_fld='Sl_avsdf', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_avsdf', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_avsdf', rc=rc)) then call addmap_from(compice, 'Si_avsdf', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -867,9 +857,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_anidr', rc=rc)) then - call addmap_from(complnd, 'Sl_anidr', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_anidr', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sx_anidr', & - mrg_from=complnd, mrg_fld='Sl_anidr', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_anidr', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_anidr', rc=rc)) then call addmap_from(compice, 'Si_anidr', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -894,9 +884,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_anidf', rc=rc)) then - call addmap_from(complnd, 'Sl_anidf', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_anidf', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sx_anidf', & - mrg_from=complnd, mrg_fld='Sl_anidf', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_anidf', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_anidf', rc=rc)) then call addmap_from(compice, 'Si_anidf', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -926,9 +916,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_tref', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_tref', rc=rc)) then - call addmap_from(complnd , 'Sl_tref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_tref', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_tref', & - mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_tref', rc=rc)) then call addmap_from(compice , 'Si_tref', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -953,9 +943,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_u10', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_u10', rc=rc)) then - call addmap_from(complnd , 'Sl_u10', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_u10', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_u10', & - mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_u10', rc=rc)) then call addmap_from(compice , 'Si_u10', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -980,9 +970,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref', rc=rc)) then - call addmap_from(complnd , 'Sl_qref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_qref', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_qref', & - mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref', rc=rc)) then call addmap_from(compice , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1008,9 +998,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref_wiso', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref_wiso', rc=rc)) then - call addmap_from(complnd , 'Sl_qref_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_qref_wiso', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_qref_wiso', & - mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref_wiso', rc=rc)) then call addmap_from(compice , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1042,9 +1032,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_tref', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_tref', rc=rc)) then - call addmap_from(complnd , 'Sl_tref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_tref', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_tref', & - mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_tref', rc=rc)) then call addmap_from(compice , 'Si_tref', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1069,9 +1059,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_u10', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_u10', rc=rc)) then - call addmap_from(complnd , 'Sl_u10', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_u10', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_u10', & - mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_u10', rc=rc)) then call addmap_from(compice , 'Si_u10', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1096,9 +1086,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref', rc=rc)) then - call addmap_from(complnd , 'Sl_qref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_qref', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_qref', & - mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref', rc=rc)) then call addmap_from(compice , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1124,9 +1114,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref_wiso', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref_wiso', rc=rc)) then - call addmap_from(complnd , 'Sl_qref_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_qref_wiso', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_qref_wiso', & - mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref_wiso', rc=rc)) then call addmap_from(compice , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1160,14 +1150,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_taux', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_taux', rc=rc)) then - call addmap_from(complnd , 'Fall_taux', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_atmlnd) then - mrg_fracname_lnd='lfrac' - else - mrg_fracname_lnd='lfrin' - end if + call addmap_from(complnd , 'Fall_taux', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_taux', & - mrg_from=complnd, mrg_fld='Fall_taux', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Fall_taux', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_taux', rc=rc)) then call addmap_from(compice , 'Faii_taux', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1192,14 +1177,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_tauy', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_tauy', rc=rc)) then - call addmap_from(complnd , 'Fall_tauy', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_atmlnd) then - mrg_fracname_lnd='lfrac' - else - mrg_fracname_lnd='lfrin' - end if + call addmap_from(complnd , 'Fall_tauy', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_tauy', & - mrg_from=complnd, mrg_fld='Fall_tauy', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Fall_tauy', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_tauy', rc=rc)) then call addmap_from(compice , 'Faii_tauy', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1224,14 +1204,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lat', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lat', rc=rc)) then - call addmap_from(complnd , 'Fall_lat', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_atmlnd) then - mrg_fracname_lnd='lfrac' - else - mrg_fracname_lnd='lfrin' - end if + call addmap_from(complnd , 'Fall_lat', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_lat', & - mrg_from=complnd, mrg_fld='Fall_lat', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Fall_lat', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_lat', rc=rc)) then call addmap_from(compice , 'Faii_lat', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1256,14 +1231,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_sen', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_sen', rc=rc)) then - call addmap_from(complnd , 'Fall_sen', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_atmlnd) then - mrg_fracname_lnd='lfrac' - else - mrg_fracname_lnd='lfrin' - end if + call addmap_from(complnd , 'Fall_sen', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_sen', & - mrg_from=complnd, mrg_fld='Fall_sen', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Fall_sen', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_sen', rc=rc)) then call addmap_from(compice , 'Faii_sen', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1288,14 +1258,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap', rc=rc)) then - call addmap_from(complnd , 'Fall_evap', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_atmlnd) then - mrg_fracname_lnd='lfrac' - else - mrg_fracname_lnd='lfrin' - end if + call addmap_from(complnd , 'Fall_evap', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_evap', & - mrg_from=complnd, mrg_fld='Fall_evap', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Fall_evap', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap', rc=rc)) then call addmap_from(compice , 'Faii_evap', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1320,14 +1285,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lwup', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lwup', rc=rc)) then - call addmap_from(complnd , 'Fall_lwup', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_atmlnd) then - mrg_fracname_lnd='lfrac' - else - mrg_fracname_lnd='lfrin' - end if + call addmap_from(complnd , 'Fall_lwup', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_lwup', & - mrg_from=complnd, mrg_fld='Fall_lwup', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Fall_lwup', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_lwup', rc=rc)) then call addmap_from(compice , 'Faii_lwup', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1353,14 +1313,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap_wiso', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap_wiso', rc=rc)) then - call addmap_from(complnd , 'Fall_evap_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_atmlnd) then - mrg_fracname_lnd='lfrac' - else - mrg_fracname_lnd='lfrin' - end if + call addmap_from(complnd , 'Fall_evap_wiso', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_evap_wiso', & - mrg_from=complnd, mrg_fld='Fall_evap_wiso', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Fall_evap_wiso', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap_wiso', rc=rc)) then call addmap_from(compice , 'Faii_evap_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1390,9 +1345,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Sx_t', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_t', rc=rc)) then - call addmap_from(complnd, 'Sl_t', compatm, mapconsf , 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_t', compatm, mapconsf , map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sx_t', & - mrg_from=complnd, mrg_fld='Sl_t', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_t', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_t', rc=rc)) then call addmap_from(compice, 'Si_t', compatm, mapconsf , 'ifrac', ice2atm_map) @@ -1461,7 +1416,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - ! --------------------------------------------------------------------- ! to atm: surface snow depth from ice (needed for cam) ! to atm: mean ice volume per unit area from ice @@ -1551,7 +1505,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_fv', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_fv', rc=rc)) then - call addmap_from(complnd, 'Sl_fv', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_fv', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sl_fv', mrg_from=complnd, mrg_fld='Sl_fv', mrg_type='copy') end if end if @@ -1561,7 +1515,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_ram1', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_ram1', rc=rc)) then - call addmap_from(complnd, 'Sl_ram1', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_ram1', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sl_ram1', mrg_from=complnd, mrg_fld='Sl_ram1', mrg_type='copy') end if end if @@ -1571,13 +1525,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_snowh', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_snowh', rc=rc)) then - call addmap_from(complnd, 'Sl_snowh', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_snowh', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sl_snowh', mrg_from=complnd, mrg_fld='Sl_snowh', mrg_type='copy') end if end if ! --------------------------------------------------------------------- - ! atm atm: CARMA fields (volumetric soil water) from land + ! to atm: CARMA fields (volumetric soil water) from land !----------------------------------------------------------------------------- if (phase == 'advertise') then call addfld_from(complnd, 'Sl_soilw') @@ -1585,7 +1539,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_soilw', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_soilw', rc=rc)) then - call addmap_from(complnd, 'Sl_soilw', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_soilw', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sl_soilw', mrg_from=complnd, mrg_fld='Sl_soilw', mrg_type='copy') end if end if @@ -1599,9 +1553,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_flxdst', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_flxdst', rc=rc)) then - call addmap_from(complnd, 'Fall_flxdst', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Fall_flxdst', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Fall_flxdst', & - mrg_from=complnd, mrg_fld='Fall_flxdst', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_flxdst', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2atm_flux) end if end if @@ -1615,13 +1569,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_voc', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_voc', rc=rc)) then call addmap_from(complnd, 'Fall_voc', compatm, mapconsf, 'one', atm2lnd_map) - if (samegrid_atmlnd) then - mrg_fracname_lnd='lfrac' - else - mrg_fracname_lnd='lfrin' - end if call addmrg_to(compatm, 'Fall_voc', & - mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if end if @@ -1635,14 +1584,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_fire', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_fire', rc=rc)) then + call addmap_from(complnd, 'Fall_fire', compatm, mapconsf, 'one', lnd2atm_map) - if (samegrid_atmlnd) then - mrg_fracname_lnd='lfrac' - else - mrg_fracname_lnd='lfrin' - end if call addmrg_to(compatm, 'Fall_fire', & - mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if end if ! 'wild fire plume height' @@ -3157,14 +3102,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsur', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsur', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofsur', comprof, mapconsf, 'lfrin', 'unset') - if (samegrid_atmlnd) then - mrg_fracname_lnd = 'lfrac' - else - mrg_fracname_lnd = 'lfrin' - endif + call addmap_from(complnd, 'Flrl_rofsur', comprof, mapconsf, map_fracname_lnd2rof, 'unset') call addmrg_to(comprof, 'Flrl_rofsur', & - mrg_from=complnd, mrg_fld='Flrl_rofsur', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Flrl_rofsur', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) end if end if @@ -3177,14 +3117,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofi', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofi', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofi', comprof, mapconsf, 'lfrin', 'unset') - if (samegrid_atmlnd) then - mrg_fracname_lnd = 'lfrac' - else - mrg_fracname_lnd = 'lfrin' - endif + call addmap_from(complnd, 'Flrl_rofi', comprof, mapconsf, map_fracname_lnd2rof, 'unset') call addmrg_to(comprof, 'Flrl_rofi', & - mrg_from=complnd, mrg_fld='Flrl_rofi', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Flrl_rofi', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) end if end if @@ -3197,14 +3132,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofgwl', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofgwl', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofgwl', comprof, mapconsf, 'lfrin', 'unset') - if (samegrid_atmlnd) then - mrg_fracname_lnd = 'lfrac' - else - mrg_fracname_lnd = 'lfrin' - endif + call addmap_from(complnd, 'Flrl_rofgwl', comprof, mapconsf, map_fracname_lnd2rof, 'unset') call addmrg_to(comprof, 'Flrl_rofgwl', & - mrg_from=complnd, mrg_fld='Flrl_rofgwl', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Flrl_rofgwl', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) end if end if @@ -3217,14 +3147,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsub', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsub', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofsub', comprof, mapconsf, 'lfrac', 'unset') - if (samegrid_atmlnd) then - mrg_fracname_lnd = 'lfrac' - else - mrg_fracname_lnd = 'lfrin' - endif + call addmap_from(complnd, 'Flrl_rofsub', comprof, mapconsf, map_fracname_lnd2rof, 'unset') call addmrg_to(comprof, 'Flrl_rofsub', & - mrg_from=complnd, mrg_fld='Flrl_rofsub', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Flrl_rofsub', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) end if end if @@ -3237,14 +3162,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_irrig', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_irrig', rc=rc)) then - call addmap_from(complnd, 'Flrl_irrig', comprof, mapconsf, 'lfrac', 'unset') - if (samegrid_atmlnd) then - mrg_fracname_lnd = 'lfrac' - else - mrg_fracname_lnd = 'lfrin' - endif + call addmap_from(complnd, 'Flrl_irrig', comprof, mapconsf, map_fracname_lnd2rof, 'unset') call addmrg_to(comprof, 'Flrl_irrig', & - mrg_from=complnd, mrg_fld='Flrl_irrig', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Flrl_irrig', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) end if end if @@ -3274,14 +3194,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! custom mapping, accumulation and merging will be done in prep_glc_mod.F90 do ns = 1,is_local%wrap%num_icesheets if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Flgl_qice_elev', rc=rc)) then - call addmap_from(complnd, 'Flgl_qice_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') + call addmap_from(complnd, 'Flgl_qice_elev', compglc(ns), mapbilnr, map_fracname_lnd2glc, 'unset') end if if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Sl_tsrf_elev' , rc=rc)) then - call addmap_from(complnd, 'Sl_tsrf_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') + call addmap_from(complnd, 'Sl_tsrf_elev', compglc(ns), mapbilnr, map_fracname_lnd2glc, 'unset') end if if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Sl_topo_elev' , rc=rc)) then - ! This is needed just for mappingn to glc - but is not sent as a field - call addmap_from(complnd, 'Sl_topo_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') + ! This is needed just for mapping to glc - but is not sent as a field + call addmap_from(complnd, 'Sl_topo_elev', compglc(ns), mapbilnr, map_fracname_lnd2glc, 'unset') end if end do end if @@ -3400,7 +3320,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else call addmap_from(complnd, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) call addmrg_to(compatm, 'Fall_fco2_lnd', & - mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2glc) end if else if (flds_co2c) then @@ -3448,7 +3368,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else call addmap_from(complnd, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) call addmrg_to(compatm, 'Fall_fco2_lnd', & - mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', & + mrg_fracname=mrg_fracname_lnd2atm_flux) end if ! --------------------------------------------------------------------- @@ -3476,7 +3397,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! it will be weighted by ifrac in the merge to the atm if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_dms_ocn', rc=rc) .and. & fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_dms_ocn', rc=rc)) then - call addmap_from(complnd, 'Faoo_dms_ocn', compocn, mapconsf, 'lfrac', ocn2atm_map) + call addmap_from(complnd, 'Faoo_dms_ocn', compocn, mapconsf, mrg_fracname_lnd2atm_flux, ocn2atm_map) call addmrg_to(compatm , 'Faoo_dms_ocn', & mrg_from=compmed, mrg_fld='Faoo_dms_ocn', mrg_type='merge', mrg_fracname='ofrac') end if diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 8ea6651e..590368a0 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -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 @@ -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) @@ -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 diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index b0cd53a6..864df1eb 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -10,6 +10,11 @@ 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: @@ -17,12 +22,12 @@ module med_fraction_mod ! ! 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 @@ -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) ! @@ -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) @@ -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 @@ -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 @@ -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) @@ -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(:) @@ -251,9 +277,12 @@ subroutine med_fraction_init(gcomp, rc) endif !--------------------------------------- - ! Set 'lfrac' for FBFrac(complnd) - this might be overwritten later + ! Set 'lfrin' in FBFrac(complnd) + ! Set 'lfrac' in FBFrac(complnd) !--------------------------------------- + ! Initially both lfrac and lfrin in FBFrac are the same + ! However, 'lfrac' in FBFrac(complnd) might be overwritten later if (is_local%wrap%comp_present(complnd)) then call fldbun_getdata1d(is_local%wrap%FBImp(complnd,complnd) , 'Sl_lfrin', Sl_lfrin, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -262,6 +291,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 !--------------------------------------- @@ -378,8 +412,42 @@ 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 ! settle for a residual calculation that is truncated to zero to @@ -387,9 +455,10 @@ subroutine med_fraction_init(gcomp, rc) if (is_local%wrap%comp_present(compatm)) then - if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compice)) then + if ( is_local%wrap%comp_present(compocn) .or. & + is_local%wrap%comp_present(compice)) then - ! Ocean is present + ! Ocean or ice are 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) @@ -407,36 +476,19 @@ subroutine med_fraction_init(gcomp, rc) end if end if - else if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%med_coupling_active(complnd,compatm)) then + else if (is_local%wrap%comp_present(complnd) .and. & + is_local%wrap%med_coupling_active(complnd,compatm)) then - ! If the ocean or ice are absent, regrid 'lfrac' from FBFrac(complnd) -> FBFrac(compatm) - 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), 'lfrac', field=field_src, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compatm), 'lfrac', field=field_dst, rc=rc) + ! Ocean or ice are not present but land is present and couples to atm + call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrin', lfrin, 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 - 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) 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 @@ -451,13 +503,13 @@ subroutine med_fraction_init(gcomp, rc) ! Reset 'lfrac' in FBFrac(complnd) if appropriate !--------------------------------------- + ! If lnd -> atm coupling is active - map 'lfrac' from FBFrac(compatm) to FBFrac(complnd) + ! If the atmosphere is absent, then simply set fractions_l(lfrac) = fractions_l(lfrin) from above + if ( is_local%wrap%comp_present(complnd) .and. & + is_local%wrap%comp_present(compatm) .and. & is_local%wrap%med_coupling_active(complnd,compatm)) then - ! If lnd -> atm coupling is active - map 'lfrac' from FBFrac(compatm) to FBFrac(complnd) - ! Note that if the atmosphere is absent, then simply set fractions_l(lfrac) = fractions_l(lfrin) - ! from above - if (med_map_RH_is_created(is_local%wrap%RH(compatm,complnd,:),mapfcopy, rc=rc)) then maptype = mapfcopy else @@ -479,7 +531,7 @@ subroutine med_fraction_init(gcomp, rc) end if !--------------------------------------- - ! Set 'rfrac' and 'lfrac' for FBFrac(comprof) + ! Set 'rfrac', 'lfrac' and 'lfrin' in FBFrac(comprof) !--------------------------------------- if (is_local%wrap%comp_present(comprof)) then @@ -502,7 +554,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 @@ -518,11 +570,18 @@ subroutine med_fraction_init(gcomp, 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 @@ -563,6 +622,13 @@ subroutine med_fraction_init(gcomp, 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 @@ -785,6 +851,7 @@ subroutine med_fraction_set(gcomp, rc) call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compatm,:), maptype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + ! Set 'aofrac' from FBImp(compatm) to FBfrac(compatm) if available if ( fldbun_fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ofrac', rc=rc)) then call fldbun_getdata1d(is_local%wrap%FBImp(compatm,compatm), 'Sa_ofrac', Sa_ofrac, rc) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index a0fd7d95..da73d98e 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -115,7 +115,14 @@ module med_internalstate_mod real(r8), pointer :: lons(:) => null() end type mesh_info_type - logical, public :: samegrid_atmlnd = .true. ! true=>atm and lnd are on the same grid + logical , public :: samegrid_atmlnd = .true. ! true=>atm and lnd are on the same grid + character(len=CS), public :: mrg_fracname_lnd2atm_state + character(len=CS), public :: mrg_fracname_lnd2atm_flux + character(len=CS), public :: map_fracname_lnd2atm + character(len=CS), public :: mrg_fracname_lnd2rof + character(len=CS), public :: map_fracname_lnd2rof + character(len=CS), public :: mrg_fracname_lnd2glc + character(len=CS), public :: map_fracname_lnd2glc ! private internal state to keep instance data type InternalStateStruct @@ -193,11 +200,11 @@ module med_internalstate_mod type(mesh_info_type) , pointer :: mesh_info(:) type(ESMF_FieldBundle) , pointer :: FBArea(:) ! needed for mediator history writes - end type InternalStateStruct + end type InternalStateStruct - type, public :: InternalState + type, public :: InternalState type(InternalStateStruct), pointer :: wrap - end type InternalState + end type InternalState character(len=*), parameter :: u_FILE_u = & __FILE__ @@ -225,6 +232,8 @@ subroutine med_internalstate_init(gcomp, rc) character(len=CX) :: msgString character(len=3) :: name integer :: num_icesheets + character(len=CL) :: atm_mesh + character(len=CL) :: lnd_mesh character(len=*),parameter :: subname=' (internalstate init) ' !----------------------------------------------------------- @@ -232,6 +241,37 @@ subroutine med_internalstate_init(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! determine if atm and lnd have the same mesh + call NUOPC_CompAttributeGet(gcomp, name='ATM_DOMAIN_MESH', value=atm_mesh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='ATM_DOMAIN_MESH', value=lnd_mesh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(atm_mesh) == trim(lnd_mesh)) then + samegrid_atmlnd = .true. + else + samegrid_atmlnd = .false. + end if + + ! See med_fraction_mod for the following definitions + if (samegrid_atmlnd) then + map_fracname_lnd2atm = 'lfrin' ! in fraclist_a + mrg_fracname_lnd2atm_state = 'lfrac' ! in fraclist_a + mrg_fracname_lnd2atm_flux = 'lfrac' ! in fraclist_a + map_fracname_lnd2rof = 'lfrac' ! in fraclist_r + mrg_fracname_lnd2rof = 'lfrac' ! in fraclist_r + map_fracname_lnd2glc = 'lfrac' ! in fraclist_g + mrg_fracname_lnd2glc = 'lfrac' ! in fraclist_g + else + map_fracname_lnd2atm = 'lfrin' ! in fraclist_a + mrg_fracname_lnd2atm_state = 'lfrin' ! in fraclist_a + mrg_fracname_lnd2atm_flux = 'lfrin' ! in fraclist_r + map_fracname_lnd2rof = 'lfrin' ! in fraclist_r + mrg_fracname_lnd2rof = 'lfrin' ! in fraclist_r + map_fracname_lnd2glc = 'lfrin' ! in fraclist_g + mrg_fracname_lnd2rof = 'lfrin' ! in fraclist_g + endif + ! Determine if glc is present call NUOPC_CompAttributeGet(gcomp, name='GLC_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index cb7acea1..0720fd42 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -22,7 +22,7 @@ module med_phases_prep_glc_mod use ESMF , only : ESMF_DYNAMICMASK, ESMF_DynamicMaskSetR8R8R8, ESMF_DYNAMICMASKELEMENTR8R8R8 use ESMF , only : ESMF_FieldRegrid, ESMF_REGION_EMPTY use med_internalstate_mod , only : complnd, compocn, mapbilnr, mapconsd, compname, compglc - use med_internalstate_mod , only : InternalState, maintask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit, map_fracname_lnd2glc use med_map_mod , only : med_map_routehandles_init, med_map_rh_is_created use med_map_mod , only : med_map_field_normalized, med_map_field use med_constants_mod , only : dbug_flag => med_constants_dbug_flag @@ -814,13 +814,8 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! get land fraction field on land mesh - if (samegrid_atmlnd) then - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='lfrac', field=lfield_lfrac_l, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='lfrin', field=lfield_lfrac_l, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), fieldName=map_fracname_lnd2glc, field=field_lfrac_l, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! map accumlated land fields to each ice sheet (normalize by the land fraction in the mapping) do ns = 1,is_local%wrap%num_icesheets @@ -1059,7 +1054,7 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) real(r8) , pointer :: frac_l_ec(:,:) ! EC fractions (Sg_ice_covered) on land grid real(r8) , pointer :: icemask_g(:) ! icemask on glc grid real(r8) , pointer :: icemask_l(:) ! icemask on land grid - real(r8) , pointer :: lfrac(:) ! land fraction on land grid + real(r8) , pointer :: lndfrac(:) ! land fraction on land grid real(r8) , pointer :: dataptr1d(:) ! temporary 1d pointer integer :: ec ! loop index over elevation classes integer :: n @@ -1073,7 +1068,7 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) ! renormalization factors (should be close to 1, e.g. in range 0.95 to 1.05) real(r8) :: accum_renorm_factor ! ratio between global accumulation on the two grids real(r8) :: ablat_renorm_factor ! ratio between global ablation on the two grids - real(r8) :: effective_area ! grid cell area multiplied by min(lfrac,icemask_l). + real(r8) :: effective_area ! grid cell area multiplied by min(lndfrac,icemask_l). real(r8), pointer :: area_g(:) ! areas on glc grid character(len=*), parameter :: subname=' (renormalize_smb) ' !--------------------------------------------------------------- @@ -1153,14 +1148,9 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) call field_getdata2d(field_frac_l_ec, frac_l_ec, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return - ! determine fraction on land grid, lfrac(:) - if (samegrid_atmlnd) then - call fldbun_getdata1d(is_local%wrap%FBFrac(complnd), 'lfrac', lfrac, rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return - else - call fldbun_getdata1d(is_local%wrap%FBFrac(complnd), 'lfrin', lfrac, rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return - end if + ! determine fraction on land grid, lndfrac(:) + call fldbun_getdata1d(is_local%wrap%FBFrac(complnd), map_fracname_lnd2glc, lndfrac, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return ! get qice_l_ec call fldbun_getdata2d(FBlndAccum2glc_l, trim(qice_fieldname)//'_elev', qice_l_ec, rc) @@ -1168,9 +1158,9 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) local_accum_lnd(1) = 0.0_r8 local_ablat_lnd(1) = 0.0_r8 - do n = 1, size(lfrac) + do n = 1, size(lndfrac) ! Calculate effective area for sum - need the mapped icemask_l - effective_area = min(lfrac(n), icemask_l(n)) * is_local%wrap%mesh_info(complnd)%areas(n) + effective_area = min(lndfrac(n), icemask_l(n)) * is_local%wrap%mesh_info(complnd)%areas(n) if (effective_area > 0.0_r8) then do ec = 1, ungriddedCount if (qice_l_ec(ec,n) >= 0.0_r8) then diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 8aeba272..f69bf59a 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -13,7 +13,7 @@ module med_phases_prep_rof_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use ESMF , only : ESMF_FieldBundle, ESMF_Field use med_internalstate_mod , only : complnd, comprof, mapconsf, mapconsd, mapfcopy - use med_internalstate_mod , only : InternalState, maintask, logunit, samegrid_atmlnd + use med_internalstate_mod , only : InternalState, maintask, logunit, map_fracname_lnd2rof use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_constants_mod , only : czero => med_constants_czero use med_utils_mod , only : chkerr => med_utils_chkerr @@ -619,7 +619,7 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) ! convert to a total irrigation flux on the ROF grid ! ------------------------------------------------------------------------ - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), 'lfrin', field=field_lfrac_lnd, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), map_fracname_lnd2rof, field=field_lfrac_lnd, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call med_map_field_normalized( & From b3053ca5bf151aa1647df0983566b2ed07b6d973 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 3 Jun 2024 03:09:58 -0600 Subject: [PATCH 04/13] more updates --- mediator/esmFldsExchange_cesm_mod.F90 | 8 +++--- mediator/med_internalstate_mod.F90 | 10 +++---- mediator/med_phases_prep_rof_mod.F90 | 38 +++++++++++++++------------ 3 files changed, 30 insertions(+), 26 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 407c27fb..4cff81c0 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1560,7 +1560,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_voc', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_voc', rc=rc)) then - call addmap_from(complnd, 'Fall_voc', compatm, mapconsf, 'one', atm2lnd_map) + call addmap_from(complnd, 'Fall_voc', compatm, mapconsf, map_fracname_lnd2atm, atm2lnd_map) call addmrg_to(compatm, 'Fall_voc', & mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if @@ -1577,7 +1577,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_fire', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_fire', rc=rc)) then - call addmap_from(complnd, 'Fall_fire', compatm, mapconsf, 'one', lnd2atm_map) + call addmap_from(complnd, 'Fall_fire', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Fall_fire', & mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if @@ -1589,7 +1589,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Sl_fztop', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Sl_fztop', rc=rc)) then - call addmap_from(complnd, 'Sl_fztop', compatm, mapconsf, 'one', lnd2atm_map) + call addmap_from(complnd, 'Sl_fztop', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sl_fztop', mrg_from=complnd, mrg_fld='Sl_fztop', mrg_type='copy') end if end if @@ -1603,7 +1603,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Sl_ddvel', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Sl_ddvel', rc=rc)) then - call addmap_from(complnd, 'Sl_ddvel', compatm, mapconsf, 'one', lnd2atm_map) + call addmap_from(complnd, 'Sl_ddvel', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sl_ddvel', mrg_from=complnd, mrg_fld='Sl_ddvel', mrg_type='copy') end if end if diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 7f7f8b12..bf6cf257 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -232,8 +232,8 @@ subroutine med_internalstate_init(gcomp, rc) character(len=CX) :: msgString character(len=3) :: name integer :: num_icesheets - character(len=CL) :: atm_mesh - character(len=CL) :: lnd_mesh + character(len=CL) :: atm_mesh_name + character(len=CL) :: lnd_mesh_name character(len=*),parameter :: subname=' (internalstate init) ' !----------------------------------------------------------- @@ -243,11 +243,11 @@ subroutine med_internalstate_init(gcomp, rc) ! determine if atm and lnd have the same mesh - call NUOPC_CompAttributeGet(gcomp, name='ATM_DOMAIN_MESH', value=atm_mesh, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=atm_mesh_name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='ATM_DOMAIN_MESH', value=lnd_mesh, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=lnd_mesh_name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(atm_mesh) == trim(lnd_mesh)) then + if (trim(atm_mesh_name) == trim(lnd_mesh_name)) then samegrid_atmlnd = .true. else samegrid_atmlnd = .false. diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 44daf091..7ba28334 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -12,8 +12,8 @@ module med_phases_prep_rof_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use ESMF , only : ESMF_FieldBundle, ESMF_Field - use med_internalstate_mod , only : complnd, compglc, comprof, mapconsd, mapfcopy - use med_internalstate_mod , only : InternalState, maintask, logunit, , map_fracname_lnd2rof + use med_internalstate_mod , only : complnd, compglc, comprof, mapconsd, mapconsf, mapfcopy + use med_internalstate_mod , only : InternalState, maintask, logunit, map_fracname_lnd2rof use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_constants_mod , only : czero => med_constants_czero use med_utils_mod , only : chkerr => med_utils_chkerr @@ -383,23 +383,27 @@ subroutine med_phases_prep_rof(gcomp, rc) ! custom merge for glc->rof ! glc->rof is mapped in med_phases_post_glc do ns = 1,is_local%wrap%num_icesheets - if (is_local%wrap%med_coupling_active(compglc(ns),comprof)) then - do nf = 1,size(fldnames_fr_glc) - call fldbun_getdata1d(is_local%wrap%FBImp(compglc(ns),comprof), & - trim(fldnames_fr_glc(nf)), dataptr_in, rc) - call fldbun_getdata1d(is_local%wrap%FBExp(comprof), & - trim(fldnames_fr_glc(nf)), dataptr_out , rc) - ! Determine export data - if (ns == 1) then - dataptr_out(:) = dataptr_in(:) - else - dataptr_out(:) = dataptr_out(:) + dataptr_in(:) - end if - end do - end if + if (is_local%wrap%med_coupling_active(compglc(ns),comprof)) then + do nf = 1,size(fldnames_fr_glc) + if ( fldbun_fldchk(is_local%wrap%FBImp(compglc(ns),comprof), fldnames_fr_glc(nf), rc=rc) .and. & + fldbun_fldchk(is_local%wrap%FBExp(comprof), fldnames_fr_glc(nf), rc=rc) ) then + call fldbun_getdata1d(is_local%wrap%FBImp(compglc(ns),comprof), & + trim(fldnames_fr_glc(nf)), dataptr_in, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getdata1d(is_local%wrap%FBExp(comprof), & + trim(fldnames_fr_glc(nf)), dataptr_out , rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Determine export data + if (ns == 1) then + dataptr_out(:) = dataptr_in(:) + else + dataptr_out(:) = dataptr_out(:) + dataptr_in(:) + end if + end if + end do + end if end do - ! Check for nans in fields export to rof call FB_check_for_nans(is_local%wrap%FBExp(comprof), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From ec56320a93693648203139147ed5dd32792cbd47 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 10 Jun 2024 10:00:40 +0200 Subject: [PATCH 05/13] generalized lnd2rof mapping --- mediator/med_phases_prep_rof_mod.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 7ba28334..f0ec87c3 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -12,8 +12,8 @@ module med_phases_prep_rof_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use ESMF , only : ESMF_FieldBundle, ESMF_Field - use med_internalstate_mod , only : complnd, compglc, comprof, mapconsd, mapconsf, mapfcopy - use med_internalstate_mod , only : InternalState, maintask, logunit, map_fracname_lnd2rof + use med_internalstate_mod , only : complnd, compglc, comprof, mapconsf, mapfcopy + use med_internalstate_mod , only : InternalState, maintask, logunit use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_constants_mod , only : czero => med_constants_czero use med_utils_mod , only : chkerr => med_utils_chkerr @@ -23,6 +23,7 @@ module med_phases_prep_rof_mod use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_average => med_methods_FB_average use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d + use med_methods_mod , only : fldbun_fldchk => med_methods_FB_fldchk use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use perf_mod , only : t_startf, t_stopf @@ -646,7 +647,7 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) ! convert to a total irrigation flux on the ROF grid ! ------------------------------------------------------------------------ - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), map_fracname_lnd2rof, field=field_lfrac_lnd, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), 'lfrac', field=field_lfrac_lnd, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call med_map_field_normalized( & From ac67312c7ddbacc9a0efc66f60b8c26a34676708 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 10 Jun 2024 11:08:03 -0600 Subject: [PATCH 06/13] updates to get f09_f09 working --- mediator/med_fraction_mod.F90 | 51 +++++++++++++++++++----------- mediator/med_internalstate_mod.F90 | 12 ++++++- 2 files changed, 44 insertions(+), 19 deletions(-) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 864df1eb..63e8cfb2 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -277,12 +277,10 @@ subroutine med_fraction_init(gcomp, rc) endif !--------------------------------------- + ! Set 'lfrac' in FBFrac(complnd) - this might be overwritten later ! Set 'lfrin' in FBFrac(complnd) - ! Set 'lfrac' in FBFrac(complnd) !--------------------------------------- - ! Initially both lfrac and lfrin in FBFrac are the same - ! However, 'lfrac' in FBFrac(complnd) might be overwritten later if (is_local%wrap%comp_present(complnd)) then call fldbun_getdata1d(is_local%wrap%FBImp(complnd,complnd) , 'Sl_lfrin', Sl_lfrin, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -447,7 +445,6 @@ subroutine med_fraction_init(gcomp, rc) ! 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 ! settle for a residual calculation that is truncated to zero to @@ -455,10 +452,9 @@ subroutine med_fraction_init(gcomp, rc) if (is_local%wrap%comp_present(compatm)) then - if ( is_local%wrap%comp_present(compocn) .or. & - is_local%wrap%comp_present(compice)) then + if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compice)) then - ! Ocean or ice are 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) @@ -476,12 +472,30 @@ subroutine med_fraction_init(gcomp, rc) end if end if - else if (is_local%wrap%comp_present(complnd) .and. & - is_local%wrap%med_coupling_active(complnd,compatm)) then + else if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%med_coupling_active(complnd,compatm)) then - ! Ocean or ice are not present but land is present and couples to atm - call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrin', lfrin, rc) + ! If the ocean or ice are absent, regrid 'lfrac' from FBFrac(complnd) -> FBFrac(compatm) + 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), 'lfrac', field=field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compatm), '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,compatm,:), maptype, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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) @@ -503,13 +517,13 @@ subroutine med_fraction_init(gcomp, rc) ! Reset 'lfrac' in FBFrac(complnd) if appropriate !--------------------------------------- - ! If lnd -> atm coupling is active - map 'lfrac' from FBFrac(compatm) to FBFrac(complnd) - ! If the atmosphere is absent, then simply set fractions_l(lfrac) = fractions_l(lfrin) from above - if ( is_local%wrap%comp_present(complnd) .and. & - is_local%wrap%comp_present(compatm) .and. & is_local%wrap%med_coupling_active(complnd,compatm)) then + ! If lnd -> atm coupling is active - map 'lfrac' from FBFrac(compatm) to FBFrac(complnd) + ! Note that if the atmosphere is absent, then simply set fractions_l(lfrac) = fractions_l(lfrin) + ! from above + if (med_map_RH_is_created(is_local%wrap%RH(compatm,complnd,:),mapfcopy, rc=rc)) then maptype = mapfcopy else @@ -531,7 +545,7 @@ subroutine med_fraction_init(gcomp, rc) end if !--------------------------------------- - ! Set 'rfrac', 'lfrac' and 'lfrin' in FBFrac(comprof) + ! Set 'rfrac' and 'lfrac' for FBFrac(comprof) !--------------------------------------- if (is_local%wrap%comp_present(comprof)) then @@ -564,6 +578,7 @@ 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) @@ -606,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 @@ -616,6 +631,7 @@ 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) @@ -851,7 +867,6 @@ subroutine med_fraction_set(gcomp, rc) call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compatm,:), maptype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! Set 'aofrac' from FBImp(compatm) to FBfrac(compatm) if available if ( fldbun_fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ofrac', rc=rc)) then call fldbun_getdata1d(is_local%wrap%FBImp(compatm,compatm), 'Sa_ofrac', Sa_ofrac, rc) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index bf6cf257..577c8a94 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -265,13 +265,23 @@ subroutine med_internalstate_init(gcomp, rc) else map_fracname_lnd2atm = 'lfrin' ! in fraclist_a mrg_fracname_lnd2atm_state = 'lfrin' ! in fraclist_a - mrg_fracname_lnd2atm_flux = 'lfrin' ! in fraclist_r + mrg_fracname_lnd2atm_flux = 'lfrin' ! in fraclist_a map_fracname_lnd2rof = 'lfrin' ! in fraclist_r mrg_fracname_lnd2rof = 'lfrin' ! in fraclist_r map_fracname_lnd2glc = 'lfrin' ! in fraclist_g mrg_fracname_lnd2rof = 'lfrin' ! in fraclist_g endif + if (maintask) then + write(logunit,'(a,i8)') trim(subname)//' map_fracname_lnd2atm = '//trim(map_fracname_lnd2atm) //' in fraclist_a' + write(logunit,'(a,i8)') trim(subname)//' mrg_fracname_lnd2atm_state = '//trim(mrg_fracname_lnd2atm_state)//' in fraclist_a' + write(logunit,'(a,i8)') trim(subname)//' mrg_fracname_lnd2atm_flux = '//trim(mrg_fracname_lnd2atm_flux) //' in fraclist_a' + write(logunit,'(a,i8)') trim(subname)//' map_fracname_lnd2rof = '//trim(map_fracname_lnd2rof) //' in fraclist_r' + write(logunit,'(a,i8)') trim(subname)//' mrg_fracname_lnd2rof = '//trim(mrg_fracname_lnd2rof) //' in fraclist_r' + write(logunit,'(a,i8)') trim(subname)//' map_fracname_lnd2glc = '//trim(map_fracname_lnd2glc) //' in fraclist_g' + write(logunit,'(a,i8)') trim(subname)//' mrg_fracname_lnd2rof = '//trim(mrg_fracname_lnd2rof) //' in fraclist_g' + end if + ! Determine if glc is present call NUOPC_CompAttributeGet(gcomp, name='GLC_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From e35644a703d4a037c6e2f6e13c25ac9e8f7ac901 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 16 Jun 2024 03:38:27 -0600 Subject: [PATCH 07/13] fixed compilation problems --- mediator/esmFldsExchange_cesm_mod.F90 | 15 +++++++++++---- mediator/fd_cesm.yaml | 6 +++++- mediator/med_phases_prep_atm_mod.F90 | 4 ++-- 3 files changed, 18 insertions(+), 7 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 11503578..09bcad02 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -233,6 +233,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! write diagnostic output if (maintask) then + write(logunit,'(a)' ) ' flds_co2a: prognostic and diagnostic CO2 at lowest atm level is sent to lnd and ocn' + write(logunit,'(a)' ) ' flds_co2b: prognostic and diagnostic CO2 at lowest atm level is sent to lnd and ocn' + write(logunit,'(a)' ) ' and surface flux of CO2 from lnd is sent back to atm' + write(logunit,'(a)' ) ' flds_co2c: prognostic and diagnostic CO2 at lowest atm level is sent to lnd and ocn' + write(logunit,'(a)' ) ' and surface flux of CO2 from lnd is sent back to atm' + write(logunit,'(a)' ) ' and surface flux of CO2 from ocn is sent back to atm' write(logunit,'(a,l7)') trim(subname)//' flds_co2a = ',flds_co2a write(logunit,'(a,l7)') trim(subname)//' flds_co2b = ',flds_co2b write(logunit,'(a,l7)') trim(subname)//' flds_co2c = ',flds_co2c @@ -1607,9 +1613,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_voc', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_voc', rc=rc)) then - call addmap_from(complnd, 'Fall_voc', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map + call addmap_from(complnd, 'Fall_voc', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Fall_voc', & - mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) + mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2atm_flux) end if end if @@ -1625,7 +1631,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) fldchk(is_local%wrap%FBExp(compatm) , 'Fall_fire', rc=rc)) then call addmap_from(complnd, 'Fall_fire', compatm, mapconsf, 'lfrin', lnd2atm_map) call addmrg_to(compatm, 'Fall_fire', & - mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) + mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2atm_flux) end if end if ! 'wild fire plume height' @@ -1636,7 +1642,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Sl_fztop', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Sl_fztop', rc=rc)) then call addmap_from(complnd, 'Sl_fztop', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) - call addmrg_to(compatm, 'Sl_fztop', mrg_from=complnd, mrg_fld='Sl_fztop', mrg_type='copy') + call addmrg_to(compatm, 'Sl_fztop', & + mrg_from=complnd, mrg_fld='Sl_fztop', mrg_type='copy') end if end if diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 50200efa..ae9c22ba 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -857,12 +857,16 @@ # - 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 canonical_units: moles m-2 s-1 description: ocn import to med - surface flux of DMS (downward positive) # + - standard_name: Faoo_bromo_ocn + canonical_units: moles m-2 s-1 + description: ocn import to med - surface flux of Bromoform (downward positive) + # - standard_name: So_anidf canonical_units: 1 description: ocn import to med diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 837f00c6..0b876b0c 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -32,7 +32,7 @@ module med_phases_prep_atm_mod real(r8), public :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn - character(len=14) :: fldnames_to_ocn(3) = (/'Faoo_bromo_ocn','Faoo_fdms_ocn ','Faoo_fco2_ocn ' + character(len=14) :: fldnames_to_ocn(3) = (/'Faoo_bromo_ocn','Faoo_fdms_ocn ','Faoo_fco2_ocn '/) character(*), parameter :: u_FILE_u = & __FILE__ @@ -54,7 +54,7 @@ subroutine med_phases_prep_atm(gcomp, rc) real(R8), pointer :: dataPtr2(:) real(R8), pointer :: ifrac(:) real(R8), pointer :: ofrac(:) - integer :: n + integer :: n,nf type(med_fldlist_type), pointer :: fldList character(len=*),parameter :: subname='(med_phases_prep_atm)' !------------------------------------------------------------------------------- From a1209b88795f26c62cb589bd9dad3a80b26cf8ef Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 19 Jun 2024 14:55:36 +0200 Subject: [PATCH 08/13] fix for merging in trigrid --- mediator/med_internalstate_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 577c8a94..2855d5cc 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -264,7 +264,7 @@ subroutine med_internalstate_init(gcomp, rc) mrg_fracname_lnd2glc = 'lfrac' ! in fraclist_g else map_fracname_lnd2atm = 'lfrin' ! in fraclist_a - mrg_fracname_lnd2atm_state = 'lfrin' ! in fraclist_a + mrg_fracname_lnd2atm_state = 'lfrac' ! in fraclist_a mrg_fracname_lnd2atm_flux = 'lfrin' ! in fraclist_a map_fracname_lnd2rof = 'lfrin' ! in fraclist_r mrg_fracname_lnd2rof = 'lfrin' ! in fraclist_r From d183d22147a3e27c3bff0b336e42c3055bb67f94 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 24 Jun 2024 10:29:13 -0600 Subject: [PATCH 09/13] fix for UFS --- mediator/med_internalstate_mod.F90 | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 2855d5cc..46eb55c3 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -234,6 +234,7 @@ subroutine med_internalstate_init(gcomp, rc) integer :: num_icesheets character(len=CL) :: atm_mesh_name character(len=CL) :: lnd_mesh_name + logical :: isPresent, isSet character(len=*),parameter :: subname=' (internalstate init) ' !----------------------------------------------------------- @@ -241,16 +242,20 @@ subroutine med_internalstate_init(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! determine if atm and lnd have the same mesh call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=atm_mesh_name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=lnd_mesh_name, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=lnd_mesh_name, & + isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(atm_mesh_name) == trim(lnd_mesh_name)) then - samegrid_atmlnd = .true. + if (isPresent .and. isSet) then + if (trim(atm_mesh_name) == trim(lnd_mesh_name)) then + samegrid_atmlnd = .true. + else + samegrid_atmlnd = .false. + end if else - samegrid_atmlnd = .false. + samegrid_atmlnd = .true. end if ! See med_fraction_mod for the following definitions From 2d3c1a77909808f38b747bbcd8956119219eca33 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 25 Jun 2024 07:57:59 -0600 Subject: [PATCH 10/13] updates for new fields from ocn --- mediator/esmFldsExchange_cesm_mod.F90 | 56 ++++++++++++++++++++------- mediator/fd_cesm.yaml | 12 +++++- mediator/med_fraction_mod.F90 | 2 +- mediator/med_phases_prep_atm_mod.F90 | 3 +- 4 files changed, 55 insertions(+), 18 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 662b8c4d..3ef6ddd1 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1684,37 +1684,65 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_from(compocn, 'Faoo_fco2_ocn') call addfld_to(compatm, 'Faoo_fco2_ocn') else - if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_co2_ocn', rc=rc) .and. & - fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_co2_ocn', rc=rc)) then + if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fco2_ocn', rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_fco2_ocn', rc=rc)) then call addmap_from(compocn, 'Faoo_fco2_ocn', compatm, mapconsd, 'one', ocn2atm_map) ! custom merge in med_phases_prep_atm end if end if !----------------------------------------------------------------------------- - ! to atm: dms from ocean + ! to atm: surface flux of dms from ocean !----------------------------------------------------------------------------- if (phase == 'advertise') then - call addfld_from(compocn, 'Faoo_dms_ocn') - call addfld_to(compatm, 'Faoo_dms_ocn') + call addfld_from(compocn, 'Faoo_fdms_ocn') + call addfld_to(compatm, 'Faoo_fdms_ocn') else - if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_dms_ocn', rc=rc) .and. & - fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_dms_ocn', rc=rc)) then - call addmap_from(compocn, 'Faoo_dms_ocn', compocn, mapconsd, 'one', ocn2atm_map) + if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fdms_ocn', rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_fdms_ocn', rc=rc)) then + call addmap_from(compocn, 'Faoo_fdms_ocn', compocn, mapconsd, 'one', ocn2atm_map) ! custom merge in med_phases_prep_atm end if end if !----------------------------------------------------------------------------- - ! to atm: bromoform from ocean + ! to atm: surface flux of bromoform from ocean !----------------------------------------------------------------------------- if (phase == 'advertise') then - call addfld_from(compocn, 'Faoo_bromo_ocn') - call addfld_to(compatm, 'Faoo_bromo_ocn') + call addfld_from(compocn, 'Faoo_fbrf_ocn') + call addfld_to(compatm, 'Faoo_fbrf_ocn') else - if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_bromo_ocn', rc=rc) .and. & - fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_bromo_ocn', rc=rc)) then - call addmap_from(compocn, 'Faoo_bromo_ocn', compocn, mapconsd, 'one', ocn2atm_map) + if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fbrf_ocn', rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_fbrf_ocn', rc=rc)) then + call addmap_from(compocn, 'Faoo_fbrf_ocn', compocn, mapconsd, 'one', ocn2atm_map) + ! custom merge in med_phases_prep_atm + end if + end if + + !----------------------------------------------------------------------------- + ! to atm: surface flux of n2o from ocean + !----------------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compocn, 'Faoo_fn2o_ocn') + call addfld_to(compatm, 'Faoo_fn2o_ocn') + else + if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fn2o_ocn', rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_fn2o_ocn', rc=rc)) then + call addmap_from(compocn, 'Faoo_fn2o_ocn', compocn, mapconsd, 'one', ocn2atm_map) + ! custom merge in med_phases_prep_atm + end if + end if + + !----------------------------------------------------------------------------- + ! to atm: surface flux of nh3 from ocean + !----------------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compocn, 'Faoo_fnh3_ocn') + call addfld_to(compatm, 'Faoo_fnh3_ocn') + else + if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fnh3_ocn', rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_fnh3_ocn', rc=rc)) then + call addmap_from(compocn, 'Faoo_fnh3_ocn', compocn, mapconsd, 'one', ocn2atm_map) ! custom merge in med_phases_prep_atm end if end if diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index ae9c22ba..c6d57857 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -859,14 +859,22 @@ canonical_units: moles m-2 s-1 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_bromo_ocn + - 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 diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 63e8cfb2..8245b558 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -50,7 +50,7 @@ module med_fraction_mod ! *frac is the fraction of a particular component in the bundle. ! ! in general, on every grid, - ! fractions_*(ifrac) + fractions_*(ofrac) + fractions_*(lfrac) = 1.0 + ! fractions_*(ifrac) + fractions_*(ofrac) + fractions_*(lfrac) = 1.0 ! ! the fractions are computed fundamentally as follows (although the ! detailed implementation might be slightly different) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 0b876b0c..e4baa199 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -32,7 +32,8 @@ module med_phases_prep_atm_mod real(r8), public :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn - character(len=14) :: fldnames_to_ocn(3) = (/'Faoo_bromo_ocn','Faoo_fdms_ocn ','Faoo_fco2_ocn '/) + character(len=14) :: fldnames_to_ocn(5) = (/'Faoo_fbrf_ocn','Faoo_fdms_ocn ','Faoo_fco2_ocn ',& + 'Faoo_fn2o_ocn','Faoo_fnh3_ocn'/) character(*), parameter :: u_FILE_u = & __FILE__ From 5624c70818a6cd4dd85e460d9c4fb925f073a398 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 25 Jun 2024 08:06:38 -0600 Subject: [PATCH 11/13] fixes for problems found in UFS --- mediator/med_internalstate_mod.F90 | 9 ++++--- mediator/med_phases_prep_atm_mod.F90 | 36 +++++++++++++++------------- 2 files changed, 25 insertions(+), 20 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 46eb55c3..95745098 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -234,7 +234,8 @@ subroutine med_internalstate_init(gcomp, rc) integer :: num_icesheets character(len=CL) :: atm_mesh_name character(len=CL) :: lnd_mesh_name - logical :: isPresent, isSet + logical :: isPresent_lnd, isSet_lnd + logical :: isPresent_atm, isSet_atm character(len=*),parameter :: subname=' (internalstate init) ' !----------------------------------------------------------- @@ -243,12 +244,14 @@ subroutine med_internalstate_init(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determine if atm and lnd have the same mesh - call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=atm_mesh_name, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=atm_mesh_name, & + isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=lnd_mesh_name, & isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then + + if ((isPresent_lnd .and. isSet_lnd) .and. (isPresent_atm .and. isSet_atm)) then if (trim(atm_mesh_name) == trim(lnd_mesh_name)) then samegrid_atmlnd = .true. else diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index e4baa199..3ae84c97 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -32,8 +32,8 @@ module med_phases_prep_atm_mod real(r8), public :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn - character(len=14) :: fldnames_to_ocn(5) = (/'Faoo_fbrf_ocn','Faoo_fdms_ocn ','Faoo_fco2_ocn ',& - 'Faoo_fn2o_ocn','Faoo_fnh3_ocn'/) + character(len=14) :: fldnames_from_ocn(5) = (/'Faoo_fbrf_ocn','Faoo_fdms_ocn ','Faoo_fco2_ocn ',& + 'Faoo_fn2o_ocn','Faoo_fnh3_ocn'/) character(*), parameter :: u_FILE_u = & __FILE__ @@ -211,21 +211,23 @@ subroutine med_phases_prep_atm(gcomp, rc) call ESMF_FieldGet(lfield, farrayPtr=ofrac, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - do nf = 1,len(fldnames_to_ocn) - if ( FB_FldChk(is_local%wrap%FBExp(compatm) , trim(fldnames_to_ocn(nf)), rc=rc) .and. & - FB_FldChk(is_local%wrap%FBImp(compocn,compocn), trim(fldnames_to_ocn(nf)), rc=rc)) then - call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compatm), fieldName=trim(fldnames_to_ocn(nf)), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=dataptr1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBExp(compatm), fieldName=trim(fldnames_to_ocn(nf)), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=dataptr2, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr2) - dataptr2(n) = (ifrac(n) + ofrac(n)) * dataptr1(n) - end do - end if + do nf = 1,len(fldnames_from_ocn) + if ( FB_FldChk(is_local%wrap%FBExp(compatm) , trim(fldnames_from_ocn(nf)), rc=rc) .and. & + FB_FldChk(is_local%wrap%FBImp(compocn,compocn), trim(fldnames_from_ocn(nf)), rc=rc)) then + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compatm), & + fieldName=trim(fldnames_from_ocn(nf)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dataptr1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBExp(compatm), & + fieldName=trim(fldnames_from_ocn(nf)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dataptr2, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(dataptr2) + dataptr2(n) = (ifrac(n) + ofrac(n)) * dataptr1(n) + end do + end if end do ! Add enthalpy correction to sensible heat if appropriate From 9b3cec233e11bb2d467b5099af2e3caed7e07991 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 25 Jun 2024 11:57:26 -0600 Subject: [PATCH 12/13] fixed bug --- mediator/med_internalstate_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 95745098..d09903be 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -245,10 +245,10 @@ subroutine med_internalstate_init(gcomp, rc) ! determine if atm and lnd have the same mesh call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=atm_mesh_name, & - isPresent=isPresent, isSet=isSet, rc=rc) + isPresent=isPresent_atm, isSet=isSet_atm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=lnd_mesh_name, & - isPresent=isPresent, isSet=isSet, rc=rc) + isPresent=isPresent_lnd, isSet=isSet_lnd, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if ((isPresent_lnd .and. isSet_lnd) .and. (isPresent_atm .and. isSet_atm)) then From 66ce7e5786d0ac939efab7ae8b23835a8a8a64c9 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 26 Jun 2024 07:02:15 -0600 Subject: [PATCH 13/13] fixed bug --- mediator/med_phases_prep_atm_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 3ae84c97..c4d872d1 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -32,7 +32,7 @@ module med_phases_prep_atm_mod real(r8), public :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn - character(len=14) :: fldnames_from_ocn(5) = (/'Faoo_fbrf_ocn','Faoo_fdms_ocn ','Faoo_fco2_ocn ',& + character(len=13) :: fldnames_from_ocn(5) = (/'Faoo_fbrf_ocn','Faoo_fdms_ocn','Faoo_fco2_ocn',& 'Faoo_fn2o_ocn','Faoo_fnh3_ocn'/) character(*), parameter :: u_FILE_u = & @@ -211,7 +211,7 @@ subroutine med_phases_prep_atm(gcomp, rc) call ESMF_FieldGet(lfield, farrayPtr=ofrac, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - do nf = 1,len(fldnames_from_ocn) + do nf = 1,size(fldnames_from_ocn) if ( FB_FldChk(is_local%wrap%FBExp(compatm) , trim(fldnames_from_ocn(nf)), rc=rc) .and. & FB_FldChk(is_local%wrap%FBImp(compocn,compocn), trim(fldnames_from_ocn(nf)), rc=rc)) then call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compatm), &