diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 86f513d7..3ef6ddd1 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -59,7 +59,10 @@ 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 + 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 @@ -231,6 +234,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 @@ -474,6 +483,32 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if ! --------------------------------------------------------------------- + ! to lnd: prognostic CO2 at the lowest atm model level + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compatm, 'Sa_co2prog') + call addfld_to(complnd, 'Sa_co2prog') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_co2prog', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_co2prog', rc=rc)) then + call addmap_from(compatm, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Sa_co2prog', mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- + ! to lnd: diagnostic CO2 at the lowest atm model level + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compatm, 'Sa_co2diag') + call addfld_to(complnd, 'Sa_co2diag') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_co2diag', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_co2diag', rc=rc)) then + call addmap_from(compatm, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Sa_co2diag', mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to lnd: convective and large scale precipitation rate water equivalent from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then @@ -814,9 +849,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) @@ -841,9 +876,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) @@ -868,9 +903,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) @@ -895,9 +930,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) @@ -927,9 +962,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) @@ -954,9 +989,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) @@ -981,9 +1016,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) @@ -1009,9 +1044,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) @@ -1043,9 +1078,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) @@ -1070,9 +1105,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) @@ -1097,9 +1132,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) @@ -1125,9 +1160,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) @@ -1161,9 +1196,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) + 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='lfrac') + 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) @@ -1188,9 +1223,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) + 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='lfrac') + 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) @@ -1215,9 +1250,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) + 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='lfrac') + 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) @@ -1242,9 +1277,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) + 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='lfrac') + 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) @@ -1269,9 +1304,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) + 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='lfrac') + 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) @@ -1296,9 +1331,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) + 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='lfrac') + 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) @@ -1324,9 +1359,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) + 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='lfrac') + 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) @@ -1356,9 +1391,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) @@ -1427,7 +1462,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 @@ -1517,7 +1551,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 @@ -1527,7 +1561,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 @@ -1537,12 +1571,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 + ! --------------------------------------------------------------------- - ! CARMA fields (volumetric soil water) + ! to atm: CARMA fields (volumetric soil water) from land !----------------------------------------------------------------------------- if (phase == 'advertise') then call addfld_from(complnd, 'Sl_soilw') @@ -1550,10 +1585,11 @@ 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 + ! --------------------------------------------------------------------- ! to atm: dust fluxes from land (4 sizes) ! --------------------------------------------------------------------- @@ -1563,11 +1599,12 @@ 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 + !----------------------------------------------------------------------------- ! to atm: MEGAN emissions fluxes from land !----------------------------------------------------------------------------- @@ -1577,11 +1614,12 @@ 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, 'lfrin', 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='lfrac') + mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2atm_flux) end if end if + !----------------------------------------------------------------------------- ! to atm: fire emissions fluxes from land !----------------------------------------------------------------------------- @@ -1594,7 +1632,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='lfrac') + 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' @@ -1604,10 +1642,12 @@ 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, 'lfrin', lnd2atm_map) - call addmrg_to(compatm, 'Sl_fztop', mrg_from=complnd, mrg_fld='Sl_fztop', mrg_type='copy') + 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 + !----------------------------------------------------------------------------- ! to atm: dry deposition velocities from land !----------------------------------------------------------------------------- @@ -1617,25 +1657,93 @@ 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, 'lfrin', 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 + ! --------------------------------------------------------------------- + ! to atm: surface flux of CO2 from land + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(complnd, 'Fall_fco2_lnd') + call addfld_to(compatm, 'Fall_fco2_lnd') + else + if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_co2_lnd', rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_co2_lnd', rc=rc)) then + 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=mrg_fracname_lnd2atm_flux) + end if + end if + + ! --------------------------------------------------------------------- + ! to atm: surface flux of CO2 from ocn + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compocn, 'Faoo_fco2_ocn') + call addfld_to(compatm, 'Faoo_fco2_ocn') + else + 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: surface flux of dms from ocean + !----------------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compocn, 'Faoo_fdms_ocn') + call addfld_to(compatm, 'Faoo_fdms_ocn') + else + 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: surface flux of bromoform from ocean + !----------------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compocn, 'Faoo_fbrf_ocn') + call addfld_to(compatm, 'Faoo_fbrf_ocn') + else + 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: dms from ocean + ! to atm: surface flux of n2o 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_fn2o_ocn') + call addfld_to(compatm, 'Faoo_fn2o_ocn') else - ! Note that Faoo_dmds should not be weighted by ifrac - since - ! 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 addmrg_to(compatm , 'Faoo_dms_ocn', & - mrg_from=compmed, mrg_fld='Faoo_dms_ocn', mrg_type='merge', mrg_fracname='ofrac') + 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 @@ -1864,7 +1972,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_from(compatm, 'Faxa_snowl') call addfld_to(compocn, 'Faxa_snow' ) else - ! TODO: why are we not merging Faxa_rain and Faxa_snow if they are sent from atm wiht ofrac + ! TODO: why are we not merging Faxa_rain and Faxa_snow if they are sent from atm with ofrac ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization ! which by default is not actually used if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', rc=rc) .and. & @@ -1996,6 +2104,32 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if + ! --------------------------------------------------------------------- + ! to ocn: prognostic CO2 at the lowest atm model level + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compatm, 'Sa_co2prog') + call addfld_to(compocn, 'Sa_co2prog') + else + if ( fldchk(is_local%wrap%FBImp(compatm, compatm), 'Sa_co2prog', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Sa_co2prog', rc=rc)) then + call addmap_from(compatm, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Sa_co2prog', mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- + ! to ocn: diagnostic CO2 at the lowest atm model level + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compatm, 'Sa_co2diag') + call addfld_to(compocn, 'Sa_co2diag') + else + if ( fldchk(is_local%wrap%FBImp(compatm, compatm), 'Sa_co2diag', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Sa_co2diag', rc=rc)) then + call addmap_from(compatm, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Sa_co2diag', mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') + end if + end if ! --------------------------------------------------------------------- ! to ocn: black carbon deposition fluxes from atm ! - hydrophylic black carbon dry deposition flux @@ -3081,9 +3215,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, 'lfrac', lnd2rof_map) + 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='lfrac') + mrg_from=complnd, mrg_fld='Flrl_rofsur', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) end if end if @@ -3096,9 +3230,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, 'lfrac', lnd2rof_map) + 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='lfrac') + mrg_from=complnd, mrg_fld='Flrl_rofi', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) end if end if @@ -3111,9 +3245,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, 'lfrac', lnd2rof_map) + 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='lfrac') + mrg_from=complnd, mrg_fld='Flrl_rofgwl', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) end if end if @@ -3126,9 +3260,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', lnd2rof_map) + 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='lfrac') + mrg_from=complnd, mrg_fld='Flrl_rofsub', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) end if end if @@ -3141,9 +3275,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', lnd2rof_map) + 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='lfrac') + mrg_from=complnd, mrg_fld='Flrl_irrig', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) end if end if @@ -3173,14 +3307,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 @@ -3210,158 +3344,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - !===================================================================== - ! CO2 EXCHANGE - !===================================================================== - - call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flds_co2a - call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO) - - call NUOPC_CompAttributeGet(gcomp, name='flds_co2b', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flds_co2b - call ESMF_LogWrite('flds_co2b = '// trim(cvalue), ESMF_LOGMSG_INFO) - - call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flds_co2c - call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO) - - if (flds_co2a) then - ! --------------------------------------------------------------------- - ! to lnd and ocn: prognostic CO2 at the lowest atm model level - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_co2prog') - call addfld_to(complnd, 'Sa_co2prog') - call addfld_to(compocn, 'Sa_co2prog') - else - call addmap_from(compatm, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) - call addmap_from(compatm, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) - - call addmrg_to(complnd, 'Sa_co2prog', & - mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - call addmrg_to(compocn, 'Sa_co2prog', & - mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - end if - - ! --------------------------------------------------------------------- - ! to lnd and ocn: diagnostic CO2 at the lowest atm model level - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_co2diag') - call addfld_to(complnd, 'Sa_co2diag') - call addfld_to(compocn, 'Sa_co2diag') - else - call addmap_from(compatm, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) - call addmap_from(compatm, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) - - call addmrg_to(complnd, 'Sa_co2diag', & - mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - call addmrg_to(compocn, 'Sa_co2diag', & - mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - end if - - else if (flds_co2b) then - - ! --------------------------------------------------------------------- - ! to lnd: prognostic CO2 at the lowest atm model level - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_co2prog') - call addfld_to(complnd, 'Sa_co2prog') - else - call addmap_from(compatm, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg_to(complnd, 'Sa_co2prog', & - mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - end if - - ! --------------------------------------------------------------------- - ! to lnd: diagnostic CO2 at the lowest atm model level - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_co2diag') - call addfld_to(complnd, 'Sa_co2diag') - else - call addmap_from(compatm, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg_to(complnd, 'Sa_co2diag', & - mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - end if - - ! --------------------------------------------------------------------- - ! to atm: surface flux of CO2 from land - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(complnd, 'Fall_fco2_lnd') - call addfld_to(compatm, 'Fall_fco2_lnd') - 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') - end if - - else if (flds_co2c) then - - ! --------------------------------------------------------------------- - ! to lnd and ocn: prognostic CO2 at the lowest atm model level - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_co2prog') - call addfld_to(complnd, 'Sa_co2prog') - call addfld_to(compocn, 'Sa_co2prog') - else - call addmap_from(compatm, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) - call addmap_from(compatm, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) - - call addmrg_to(complnd, 'Sa_co2prog', & - mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - call addmrg_to(compocn, 'Sa_co2prog', & - mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - end if - - ! --------------------------------------------------------------------- - ! to lnd and ocn: diagnostic CO2 at the lowest atm model level - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_co2diag') - call addfld_to(complnd, 'Sa_co2diag') - call addfld_to(compocn, 'Sa_co2diag') - else - call addmap_from(compatm, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) - call addmap_from(compatm, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) - - call addmrg_to(complnd, 'Sa_co2diag', & - mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - call addmrg_to(compocn, 'Sa_co2diag', & - mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - end if - - ! --------------------------------------------------------------------- - ! to atm: surface flux of CO2 from land - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(complnd, 'Fall_fco2_lnd') - call addfld_to(compatm, 'Fall_fco2_lnd') - 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') - end if - - ! --------------------------------------------------------------------- - ! to atm: surface flux of CO2 from ocn - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compocn, 'Faoo_fco2_ocn') - call addfld_to(compatm, 'Faoo_fco2_ocn') - else - call addmap_from(compocn, 'Faoo_fco2_ocn', compatm, mapconsd, 'one', ocn2atm_map) - ! custom merge in med_phases_prep_atm - end if - endif - end subroutine esmFldsExchange_cesm end module esmFldsExchange_cesm_mod diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 50200efa..c6d57857 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -857,12 +857,24 @@ # - standard_name: Faoo_fco2_ocn canonical_units: moles m-2 s-1 - description: ocn import to med + description: ocn import to med - surface flux of CO2 (downward positive) # - - standard_name: Faoo_dms_ocn + - standard_name: Faoo_fdms_ocn canonical_units: moles m-2 s-1 description: ocn import to med - surface flux of DMS (downward positive) # + - standard_name: Faoo_fbrf_ocn + canonical_units: moles m-2 s-1 + description: ocn import to med - surface flux of Bromoform (downward positive) + # + - standard_name: Faoo_fn2o_ocn + canonical_units: moles m-2 s-1 + description: ocn import to med - surface flux of N2O (downward positive) + # + - standard_name: Faoo_fnh3_ocn + canonical_units: moles m-2 s-1 + description: ocn import to med - surface flux of NH3 (downward positive) + # - standard_name: So_anidf canonical_units: 1 description: ocn import to med diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index b527dc27..69ff44f2 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..8245b558 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,7 +277,8 @@ subroutine med_fraction_init(gcomp, rc) endif !--------------------------------------- - ! Set 'lfrac' for FBFrac(complnd) - this might be overwritten later + ! Set 'lfrac' in FBFrac(complnd) - this might be overwritten later + ! Set 'lfrin' in FBFrac(complnd) !--------------------------------------- if (is_local%wrap%comp_present(complnd)) then @@ -262,6 +289,11 @@ subroutine med_fraction_init(gcomp, rc) if (associated(lfrac)) then lfrac(:) = Sl_lfrin(:) end if + call fldbun_getdata1d(is_local%wrap%FBFrac(complnd) , 'lfrin', lfrin, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (associated(lfrin)) then + lfrin(:) = Sl_lfrin(:) + end if end if !--------------------------------------- @@ -378,7 +410,40 @@ subroutine med_fraction_init(gcomp, rc) end if !--------------------------------------- - ! Set 'lfrac' in FBFrac(compatm) and correct 'ofrac' in FBFrac(compatm) + ! Set 'lfrin' in FBFrac(compatm) + ! --------------------------------------- + + if ( is_local%wrap%comp_present(compatm) .and. & + is_local%wrap%comp_present(complnd) .and. & + is_local%wrap%med_coupling_active(complnd,compatm)) then + + if (med_map_RH_is_created(is_local%wrap%RH(complnd,compatm,:),mapfcopy, rc=rc)) then + maptype = mapfcopy + else + maptype = mapconsd + if (.not. med_map_RH_is_created(is_local%wrap%RH(complnd,compatm,:),maptype, rc=rc)) then + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(complnd,compatm))) then + call med_map_routehandles_init( complnd, compatm, & + FBSrc=is_local%wrap%FBImp(complnd,complnd), & + FBDst=is_local%wrap%FBImp(complnd,compatm), & + mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + end if + + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrin', field=field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compatm), 'lfrin', field=field_dst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,compatm,:), maptype, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end if + + !--------------------------------------- + ! Set 'lfrac' in FBFrac(compatm) + ! Reset 'ofrac' in FBFrac(compatm) if appropriate ! --------------------------------------- ! These should actually be mapo2a of ofrac and lfrac but we can't ! map lfrac from o2a due to masked mapping weights. So we have to @@ -389,7 +454,7 @@ subroutine med_fraction_init(gcomp, rc) if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compice)) then - ! Ocean is present + ! Ocean or ice is present call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc) @@ -437,6 +502,7 @@ subroutine med_fraction_init(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (associated(ofrac)) then do n = 1,size(lfrac) + lfrac(n) = lfrin(n) ofrac(n) = 1.0_R8 - lfrac(n) if (abs(ofrac(n)) < eps_fraclim) then ofrac(n) = 0.0_R8 @@ -502,7 +568,7 @@ subroutine med_fraction_init(gcomp, rc) endif endif - ! Set 'lfrac' in FBFrac(comprof) + ! Set 'lfrac' and 'lfrin' in FBFrac(comprof) if (is_local%wrap%comp_present(complnd)) then maptype = mapconsd if (.not. med_map_RH_is_created(is_local%wrap%RH(complnd,comprof,:),maptype, rc=rc)) then @@ -512,17 +578,25 @@ subroutine med_fraction_init(gcomp, rc) mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrac', field=field_src, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleGet(is_local%wrap%FBfrac(comprof), 'lfrac', field=field_dst, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,comprof,:), maptype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrin', field=field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(comprof), 'lfrin', field=field_dst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,comprof,:), maptype, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif !--------------------------------------- - ! Set 'gfrac' and 'lfrac' for FBFrac(compglc) + ! Set 'gfrac', 'lfrac' and 'lfrin' in FBFrac(compglc) !--------------------------------------- do ns = 1,is_local%wrap%num_icesheets @@ -547,7 +621,7 @@ subroutine med_fraction_init(gcomp, rc) endif endif - ! Set 'lfrac' in FBFrac(compglc(ns)) + ! Set 'lfrac' and 'lfrin' in FBFrac(compglc(ns)) if ( is_local%wrap%comp_present(complnd) .and. is_local%wrap%med_coupling_active(complnd,compglc(ns))) then maptype = mapconsd if (.not. med_map_RH_is_created(is_local%wrap%RH(complnd,compglc(ns),:),maptype, rc=rc)) then @@ -557,12 +631,20 @@ subroutine med_fraction_init(gcomp, rc) mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrac', field=field_src, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compglc(ns)), 'lfrac', field=field_dst, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,compglc(ns),:), maptype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrin', field=field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compglc(ns)), 'lfrin', field=field_dst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,compglc(ns),:), maptype, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif end do diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 21b480a4..d09903be 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -115,6 +115,15 @@ 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 + 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 @@ -191,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__ @@ -223,6 +232,10 @@ subroutine med_internalstate_init(gcomp, rc) character(len=CX) :: msgString character(len=3) :: name integer :: num_icesheets + character(len=CL) :: atm_mesh_name + character(len=CL) :: lnd_mesh_name + logical :: isPresent_lnd, isSet_lnd + logical :: isPresent_atm, isSet_atm character(len=*),parameter :: subname=' (internalstate init) ' !----------------------------------------------------------- @@ -230,6 +243,53 @@ 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, & + 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_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 + if (trim(atm_mesh_name) == trim(lnd_mesh_name)) then + samegrid_atmlnd = .true. + else + samegrid_atmlnd = .false. + end if + else + samegrid_atmlnd = .true. + 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 = '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 + 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 diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index b9e7582e..c4d872d1 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 @@ -32,6 +32,9 @@ module med_phases_prep_atm_mod real(r8), public :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_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 = & __FILE__ @@ -52,7 +55,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)' !------------------------------------------------------------------------------- @@ -183,8 +186,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) @@ -194,30 +202,33 @@ subroutine med_phases_prep_atm(gcomp, rc) ! Note - the following needs a custom merge since Faoo_fco2_ocn is scaled by (ifrac+ofrac) ! in the merge to the atm - if ( FB_FldChk(is_local%wrap%FBExp(compatm) , 'Faoo_fco2_ocn', rc=rc) .and. & - FB_FldChk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fco2_ocn', rc=rc)) then - 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='ifrac', field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=ifrac, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='ofrac', field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=ofrac, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compatm), fieldName='Faoo_fco2_ocn', 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='Faoo_fco2_ocn', 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) + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='ifrac', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=ifrac, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='ofrac', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=ofrac, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + 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), & + 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 + end if + end do ! Add enthalpy correction to sensible heat if appropriate if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index fb46bb8a..1681aa9b 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 @@ -812,8 +812,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 - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), 'lfrac', field=field_lfrac_l, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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 @@ -1052,7 +1052,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 @@ -1066,7 +1066,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) ' !--------------------------------------------------------------- @@ -1146,8 +1146,8 @@ 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(:) - call fldbun_getdata1d(is_local%wrap%FBFrac(complnd), 'lfrac', lfrac, rc) + ! 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 @@ -1156,9 +1156,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