From 4cf3e05eb4505c6944b137948f9a93f17e96bc7a Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 12 Apr 2023 14:31:14 -0400 Subject: [PATCH 01/34] Added Fwxx_taux and Fwxx_tauy, based on Foxx_taux and Foxx_tauy --- mediator/esmFldsExchange_cesm_mod.F90 | 35 +++++++++++++++++++++++++++ mediator/fd_cesm.yaml | 19 +++++++++++++++ 2 files changed, 54 insertions(+) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 149c7791d..f53d9e38b 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2963,6 +2963,41 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compwav, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') end if end if +!PSH begin + ! --------------------------------------------------------------------- + ! to wav: zonal and meridional wind stress + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_to(compwav , 'Fwxx_taux') + call addfld_from(compice , 'Fioi_taux') + call addfld_aoflux('Faox_taux') + else + if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then + if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then + call addmap_from(compice, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compwav, 'Fwxx_taux', & + mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + end if + call addmrg_to(compwav, 'Fwxx_taux', & + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + if (phase == 'advertise') then + call addfld_to(compwav , 'Fwxx_tauy') + call addfld_from(compice , 'Fioi_tauy') + call addfld_aoflux('Faox_tauy') + else + if ( fldchk(is_local%wrap%FBexp(compwav), 'Foxx_tauy', rc=rc)) then + if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_tauy', rc=rc)) then + call addmap_from(compice, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compwav, 'Fwxx_tauy', & + mrg_from=compice, mrg_fld='Fioi_tauy', mrg_type='merge', mrg_fracname='ifrac') + end if + call addmrg_to(compwav, 'Fwxx_tauy', & + mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') + end if + end if +!PSH end !===================================================================== ! FIELDS TO RIVER (comprof) diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 648a4fed2..d6a281249 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1172,6 +1172,25 @@ canonical_units: m2/s description: wave elevation spectrum +#PSH begin + # + #----------------------------------- + # section: wave import + #----------------------------------- + # + + # + - standard_name: Fwxx_taux + alias: mean_zonal_moment_flx + canonical_units: N m-2 + description: wave import - zonal surface stress + # + - standard_name: Fwxx_tauy + alias: mean_merid_moment_flx + canonical_units: N m-2 + description: wave import - meridional surface stress +#PSH end + #----------------------------------- # mediator fields #----------------------------------- From e68d9bc49bf080e36272944db49ac196ba0bf4f2 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 14 Apr 2023 13:14:41 -0400 Subject: [PATCH 02/34] Trying simpler form of sharing Foxx to compwav --- mediator/esmFldsExchange_cesm_mod.F90 | 56 +++++++++++++-------------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index f53d9e38b..a9e556de6 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2968,34 +2968,34 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld_to(compwav , 'Fwxx_taux') - call addfld_from(compice , 'Fioi_taux') - call addfld_aoflux('Faox_taux') - else - if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then - if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then - call addmap_from(compice, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') - end if - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - if (phase == 'advertise') then - call addfld_to(compwav , 'Fwxx_tauy') - call addfld_from(compice , 'Fioi_tauy') - call addfld_aoflux('Faox_tauy') - else - if ( fldchk(is_local%wrap%FBexp(compwav), 'Foxx_tauy', rc=rc)) then - if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_tauy', rc=rc)) then - call addmap_from(compice, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') - call addmrg_to(compwav, 'Fwxx_tauy', & - mrg_from=compice, mrg_fld='Fioi_tauy', mrg_type='merge', mrg_fracname='ifrac') - end if - call addmrg_to(compwav, 'Fwxx_tauy', & - mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') - end if + call addfld_to(compwav , 'Foxx_taux') +! call addfld_from(compice , 'Fioi_taux') +! call addfld_aoflux('Faox_taux') +! else +! if ( fldchk(is_local%wrap%FBexp(compwav), 'Foxx_taux', rc=rc)) then +! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then +! call addmap_from(compice, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') +! call addmrg_to(compwav, 'Foxx_taux', & +! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') +! end if +! call addmrg_to(compwav, 'Foxx_taux', & +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') +! end if + end if + if (phase == 'advertise') then + call addfld_to(compwav , 'Foxx_tauy') +! call addfld_from(compice , 'Fioi_tauy') +! call addfld_aoflux('Faox_tauy') +! else +! if ( fldchk(is_local%wrap%FBexp(compwav), 'Foxx_tauy', rc=rc)) then +! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_tauy', rc=rc)) then +! call addmap_from(compice, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') +! call addmrg_to(compwav, 'Fwxx_tauy', & +! mrg_from=compice, mrg_fld='Fioi_tauy', mrg_type='merge', mrg_fracname='ifrac') +! end if +! call addmrg_to(compwav, 'Fwxx_tauy', & +! mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') +! end if end if !PSH end From eb186945b14c3dba06c5056dd9f605dcb3aca7b6 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 14 Apr 2023 18:06:53 -0400 Subject: [PATCH 03/34] Turning off Foxx export to waves for testing --- mediator/esmFldsExchange_cesm_mod.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index a9e556de6..881235573 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2967,8 +2967,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_to(compwav , 'Foxx_taux') +! if (phase == 'advertise') then +! call addfld_to(compwav , 'Foxx_taux') ! call addfld_from(compice , 'Fioi_taux') ! call addfld_aoflux('Faox_taux') ! else @@ -2981,9 +2981,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! call addmrg_to(compwav, 'Foxx_taux', & ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') ! end if - end if - if (phase == 'advertise') then - call addfld_to(compwav , 'Foxx_tauy') +! end if +! if (phase == 'advertise') then +! call addfld_to(compwav , 'Foxx_tauy') ! call addfld_from(compice , 'Fioi_tauy') ! call addfld_aoflux('Faox_tauy') ! else @@ -2996,7 +2996,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! call addmrg_to(compwav, 'Fwxx_tauy', & ! mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') ! end if - end if +! end if !PSH end !===================================================================== From c791efc7d85c130d1001af6f2f0db4ee5de12cf8 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Mon, 17 Apr 2023 12:25:07 -0400 Subject: [PATCH 04/34] Adding Fwxx_taux to get wind stress to pass to wave model --- mediator/esmFldsExchange_cesm_mod.F90 | 15 +++++++++++++++ mediator/fd_cesm.yaml | 10 +++++----- 2 files changed, 20 insertions(+), 5 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 881235573..4ee196f5a 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2967,6 +2967,21 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_to(compwav , 'Fwxx_taux') + call addfld_from(compice , 'Fioi_taux') + call addfld_aoflux('Faox_taux') + else + if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then + if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then + call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') + call addmrg_to(compwav, 'Fwxx_taux', & + mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + end if + call addmrg_to(compwav, 'Fwxx_taux', & + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + end if + end if ! if (phase == 'advertise') then ! call addfld_to(compwav , 'Foxx_taux') ! call addfld_from(compice , 'Fioi_taux') diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index d6a281249..9d2d873bc 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1179,16 +1179,16 @@ #----------------------------------- # - # + # - standard_name: Fwxx_taux alias: mean_zonal_moment_flx canonical_units: N m-2 description: wave import - zonal surface stress # - - standard_name: Fwxx_tauy - alias: mean_merid_moment_flx - canonical_units: N m-2 - description: wave import - meridional surface stress +# - standard_name: Fwxx_tauy +# alias: mean_merid_moment_flx +# canonical_units: N m-2 +# description: wave import - meridional surface stress #PSH end #----------------------------------- From 8db24496210078ea9584aa970e731d5d2cd3eab8 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Mon, 17 Apr 2023 14:00:36 -0400 Subject: [PATCH 05/34] Adding Fwxx_taux, using Foxx_taux as a model --- mediator/med_phases_prep_wav_mod.F90 | 44 ++++++++++++++++++++++------ 1 file changed, 35 insertions(+), 9 deletions(-) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 4fdd630ea..578b2837f 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -13,12 +13,20 @@ module med_phases_prep_wav_mod use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose +!PSH begin + use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk + use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr +!PSH end use med_methods_mod , only : FB_accum => med_methods_FB_accum use med_methods_mod , only : FB_average => med_methods_FB_average use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset - use esmFlds , only : med_fldList_GetfldListTo - use med_internalstate_mod , only : compwav +!PSH begin +! use esmFlds , only : med_fldList_GetfldListTo +! use med_internalstate_mod , only : compwav + use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type + use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode +!PSH end use perf_mod , only : t_startf, t_stopf implicit none @@ -28,6 +36,10 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_accum ! called from run sequence public :: med_phases_prep_wav_avg ! called from run sequence +!PSH begin + private :: med_phases_prep_ocn_custom_cesm +!PSH end + character(*), parameter :: u_FILE_u = & __FILE__ @@ -82,6 +94,9 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n, ncnt +!PSH begin + type(med_fldlist_type), pointer :: fldList +!PSH end character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' !--------------------------------------- @@ -96,14 +111,25 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - +!PSH begin + fldList => med_fldList_GetfldListTo(compwav) +!PSH end ! auto merges to wav - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compwav), & - is_local%wrap%FBExp(compwav), & - is_local%wrap%FBFrac(compwav), & - is_local%wrap%FBImp(:,compwav), & - med_fldList_GetfldListTo(compwav), rc=rc) +!PSH begin +! call med_merge_auto(& +! is_local%wrap%med_coupling_active(:,compwav), & +! is_local%wrap%FBExp(compwav), & +! is_local%wrap%FBFrac(compwav), & +! is_local%wrap%FBImp(:,compwav), & +! med_fldList_GetfldListTo(compwav), rc=rc) + call med_merge_auto(& + is_local%wrap%med_coupling_active(:,compwav), & + is_local%wrap%FBExp(compwav), & + is_local%wrap%FBFrac(compwav), & + is_local%wrap%FBImp(:,compwav), & + fldList, & + FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) +!PSH end if (ChkErr(rc,__LINE__,u_FILE_u)) return ! wave accumulator From a599c2f9844d1d6adf4a54e8a701756d08b0e0d9 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Mon, 17 Apr 2023 14:27:20 -0400 Subject: [PATCH 06/34] Comment out unnecessary line --- mediator/med_phases_prep_wav_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 578b2837f..3a99f295f 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -37,7 +37,7 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_avg ! called from run sequence !PSH begin - private :: med_phases_prep_ocn_custom_cesm +! private :: med_phases_prep_wav_custom_cesm !PSH end character(*), parameter :: u_FILE_u = & From 17fa9d5a97395d323b21675b7829b237f3f4a51c Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 10:37:02 -0400 Subject: [PATCH 07/34] Adding custom field subroutine for waves with cesm, based on equivalent routine for ocn component --- mediator/med_phases_prep_wav_mod.F90 | 307 ++++++++++++++++++++++++++- 1 file changed, 306 insertions(+), 1 deletion(-) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 3a99f295f..fa6e6617e 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -37,7 +37,7 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_avg ! called from run sequence !PSH begin -! private :: med_phases_prep_wav_custom_cesm + private :: med_phases_prep_wav_custom_cesm !PSH end character(*), parameter :: u_FILE_u = & @@ -131,6 +131,13 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) !PSH end if (ChkErr(rc,__LINE__,u_FILE_u)) return +!PSH begin + ! custom merges to ocean + if (trim(coupling_mode) == 'cesm') then + call med_phases_prep_wav_custom_cesm(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if +!PSH end ! wave accumulator call FB_accum(is_local%wrap%FBExpAccumWav, is_local%wrap%FBExp(compwav), rc=rc) @@ -216,4 +223,302 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_prep_wav_avg + !----------------------------------------------------------------------------- + subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) + + !--------------------------------------- + ! custom calculations for cesm + !--------------------------------------- + + use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet + use ESMF , only : ESMF_VMBroadCast + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + type(ESMF_Field) :: lfield + real(R8), pointer :: ifrac(:) + real(R8), pointer :: ofrac(:) + real(R8), pointer :: ifracr(:) + real(R8), pointer :: ofracr(:) + real(R8), pointer :: avsdr(:) + real(R8), pointer :: avsdf(:) + real(R8), pointer :: anidr(:) + real(R8), pointer :: anidf(:) + real(R8), pointer :: Faxa_swvdf(:) + real(R8), pointer :: Faxa_swndf(:) + real(R8), pointer :: Faxa_swvdr(:) + real(R8), pointer :: Faxa_swndr(:) + real(R8), pointer :: Foxx_swnet(:) + real(R8), pointer :: Foxx_swnet_afracr(:) + real(R8), pointer :: Foxx_swnet_vdr(:) + real(R8), pointer :: Foxx_swnet_vdf(:) + real(R8), pointer :: Foxx_swnet_idr(:) + real(R8), pointer :: Foxx_swnet_idf(:) + real(R8), pointer :: Fioi_swpen_vdr(:) + real(R8), pointer :: Fioi_swpen_vdf(:) + real(R8), pointer :: Fioi_swpen_idr(:) + real(R8), pointer :: Fioi_swpen_idf(:) + real(R8), pointer :: Fioi_swpen(:) + real(R8), pointer :: dataptr(:) + real(R8), pointer :: dataptr_scalar_ocn(:,:) + real(R8) :: frac_sum + real(R8) :: ifrac_scaled, ofrac_scaled + real(R8) :: ifracr_scaled, ofracr_scaled + logical :: export_swnet_by_bands + logical :: import_swpen_by_bands + logical :: export_swnet_afracr + real(R8) :: precip_fact(1) + character(CS) :: cvalue + real(R8) :: fswabsv, fswabsi + integer :: scalar_id + integer :: n + integer :: lsize + real(R8) :: c1,c2,c3,c4 + character(len=64), allocatable :: fldnames(:) + character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > 20) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + end if + call memcheck(subname, 5, mastertask) + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + +! !--------------------------------------- +! ! Compute netsw for ocean +! !--------------------------------------- +! ! netsw_for_ocn = downsw_from_atm * (1-ocn_albedo) * (1-ice_fraction) + pensw_from_ice * (ice_fraction) +! +! ! Input from atm +! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swvdr', Faxa_swvdr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swndr', Faxa_swndr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swvdf', Faxa_swvdf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swndf', Faxa_swndf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! lsize = size(Faxa_swvdr) +! +! ! Input from mediator, ocean albedos +! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_avsdr' , avsdr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_anidr' , anidr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_avsdf' , avsdf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_anidf' , anidf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! +! ! Output to ocean swnet total +! if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet', Foxx_swnet, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! else +! lsize = size(Faxa_swvdr) +! allocate(Foxx_swnet(lsize)) +! end if +! +! ! Output to ocean swnet by radiation bands +! if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc)) then +! export_swnet_by_bands = .true. +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', Foxx_swnet_vdr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', Foxx_swnet_vdf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', Foxx_swnet_idr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', Foxx_swnet_idf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! else +! export_swnet_by_bands = .false. +! end if +! +! ! ----------------------- +! ! If cice IS NOT PRESENT +! ! ----------------------- +! if (.not. is_local%wrap%comp_present(compice)) then +! ! Compute total swnet to ocean independent of swpen from sea-ice +! do n = 1,lsize +! fswabsv = Faxa_swvdr(n) * (1.0_R8 - avsdr(n)) + Faxa_swvdf(n) * (1.0_R8 - avsdf(n)) +! fswabsi = Faxa_swndr(n) * (1.0_R8 - anidr(n)) + Faxa_swndf(n) * (1.0_R8 - anidf(n)) +! Foxx_swnet(n) = fswabsv + fswabsi +! end do +! ! Compute sw export to ocean bands if required +! if (export_swnet_by_bands) then +! c1 = 0.285; c2 = 0.285; c3 = 0.215; c4 = 0.215 +! Foxx_swnet_vdr(:) = c1 * Foxx_swnet(:) +! Foxx_swnet_vdf(:) = c2 * Foxx_swnet(:) +! Foxx_swnet_idr(:) = c3 * Foxx_swnet(:) +! Foxx_swnet_idf(:) = c4 * Foxx_swnet(:) +! end if +! end if +! +! ! ----------------------- +! ! If cice IS PRESENT +! ! ----------------------- +! if (is_local%wrap%comp_present(compice)) then +! +! ! Input from mediator, ice-covered ocean and open ocean fractions +! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrac' , ifrac, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac' , ofrac, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrad' , ifracr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrad' , ofracr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! +! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen', Fioi_swpen, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! if (FB_fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdr', rc=rc)) then +! import_swpen_by_bands = .true. +! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_vdr', Fioi_swpen_vdr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_vdf', Fioi_swpen_vdf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_idr', Fioi_swpen_idr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_idf', Fioi_swpen_idf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! else +! import_swpen_by_bands = .false. +! end if +! +! if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr',rc=rc)) then +! ! Swnet without swpen from sea-ice +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr', Foxx_swnet_afracr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! export_swnet_afracr = .true. +! else +! export_swnet_afracr = .false. +! end if +! +! do n = 1,lsize +! ! Compute total swnet to ocean independent of swpen from sea-ice +! fswabsv = Faxa_swvdr(n) * (1.0_R8 - avsdr(n)) + Faxa_swvdf(n) * (1.0_R8 - avsdf(n)) +! fswabsi = Faxa_swndr(n) * (1.0_R8 - anidr(n)) + Faxa_swndf(n) * (1.0_R8 - anidf(n)) +! Foxx_swnet(n) = fswabsv + fswabsi +! +! ! Add swpen from sea ice +! ifrac_scaled = ifrac(n) +! ofrac_scaled = ofrac(n) +! frac_sum = ifrac(n) + ofrac(n) +! if (frac_sum /= 0._R8) then +! ifrac_scaled = ifrac(n) / (frac_sum) +! ofrac_scaled = ofrac(n) / (frac_sum) +! endif +! ifracr_scaled = ifracr(n) +! ofracr_scaled = ofracr(n) +! frac_sum = ifracr(n) + ofracr(n) +! if (frac_sum /= 0._R8) then +! ifracr_scaled = ifracr(n) / (frac_sum) +! ofracr_scaled = ofracr(n) / (frac_sum) +! endif +! Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) +! +! if (export_swnet_afracr) then +! Foxx_swnet_afracr(n) = ofracr_scaled*(fswabsv + fswabsi) +! end if +! +! ! Compute sw export to ocean bands if required +! if (export_swnet_by_bands) then +! if (import_swpen_by_bands) then +! ! use each individual band for swpen coming from the sea-ice +! Foxx_swnet_vdr(n) = Faxa_swvdr(n)*(1.0_R8-avsdr(n))*ofracr_scaled + Fioi_swpen_vdr(n)*ifrac_scaled +! Foxx_swnet_vdf(n) = Faxa_swvdf(n)*(1.0_R8-avsdf(n))*ofracr_scaled + Fioi_swpen_vdf(n)*ifrac_scaled +! Foxx_swnet_idr(n) = Faxa_swndr(n)*(1.0_R8-anidr(n))*ofracr_scaled + Fioi_swpen_idr(n)*ifrac_scaled +! Foxx_swnet_idf(n) = Faxa_swndf(n)*(1.0_R8-anidf(n))*ofracr_scaled + Fioi_swpen_idf(n)*ifrac_scaled +! else +! ! scale total Foxx_swnet to get contributions from each band +! c1 = 0.285; c2 = 0.285; c3 = 0.215; c4 = 0.215 +! Foxx_swnet_vdr(n) = c1 * Foxx_swnet(n) +! Foxx_swnet_vdf(n) = c2 * Foxx_swnet(n) +! Foxx_swnet_idr(n) = c3 * Foxx_swnet(n) +! Foxx_swnet_idf(n) = c4 * Foxx_swnet(n) +! end if +! end if +! end do +! +! ! Output to ocean per ice thickness fraction and sw penetrating into ocean +! if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Sf_afrac', rc=rc)) then +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afrac', fldptr1=dataptr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! dataptr(:) = ofrac(:) +! end if +! if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Sf_afracr', rc=rc)) then +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afracr', fldptr1=dataptr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! dataptr(:) = ofracr(:) +! end if +! +! end if ! if sea-ice is present +! +! ! Deallocate Foxx_swnet if it was allocated in this subroutine +! if (.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then +! deallocate(Foxx_swnet) +! end if +! +! ! Apply precipitation factor from ocean (that scales atm rain and snow back to ocn ) if appropriate +! if (trim(coupling_mode) == 'cesm' .and. is_local%wrap%flds_scalar_index_precip_factor /= 0) then +! +! ! Note that in med_internal_mod.F90 all is_local%wrap%flds_scalar_index_precip_factor +! ! is initialized to 0. +! ! In addition, in med.F90, if this attribute is not present as a mediator component attribute, +! ! it is set to 0. +! if (mastertask) then +! call ESMF_StateGet(is_local%wrap%NstateImp(compocn), & +! itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return +! call ESMF_FieldGet(lfield, farrayPtr=dataptr_scalar_ocn, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return +! scalar_id=is_local%wrap%flds_scalar_index_precip_factor +! precip_fact(1) = dataptr_scalar_ocn(scalar_id,1) +! if (precip_fact(1) /= 1._r8) then +! write(logunit,'(a,f21.13)')& +! '(merge_to_ocn): Scaling rain, snow, liquid and ice runoff by non-unity precip_fact ',& +! precip_fact(1) +! end if +! end if +! call ESMF_VMBroadCast(is_local%wrap%vm, precip_fact, 1, 0, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return +! is_local%wrap%flds_scalar_precip_factor = precip_fact(1) +! if (dbug_flag > 5) then +! write(cvalue,*) precip_fact(1) +! call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO) +! end if +! +! ! Scale rain and snow to ocn from atm by the precipitation factor received from the ocean +! allocate(fldnames(4)) +! fldnames = (/'Faxa_rain', 'Faxa_snow', 'Foxx_rofl', 'Foxx_rofi'/) +! do n = 1,size(fldnames) +! if (FB_fldchk(is_local%wrap%FBExp(compocn), trim(fldnames(n)), rc=rc)) then +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), trim(fldnames(n)) , dataptr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! dataptr(:) = dataptr(:) * is_local%wrap%flds_scalar_precip_factor +! end if +! end do +! deallocate(fldnames) +! end if +! +! if (dbug_flag > 20) then +! call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) +! end if +! call t_stopf('MED:'//subname) +! + end subroutine med_phases_prep_wav_custom_cesm + end module med_phases_prep_wav_mod From 5712122b396bde5d742d0402fd2823e369b7ee24 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 13:04:35 -0400 Subject: [PATCH 08/34] Passing So_ofrac to wav component --- mediator/esmFldsExchange_cesm_mod.F90 | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 4ee196f5a..566040563 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2964,6 +2964,22 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !PSH begin + if (phase == 'advertise') then + call addfld_from(compocn, 'So_ofrac') + call addfld_to(compwav, 'So_ofrac') + end if +! if (phase == 'advertise') then +! call addfld_from(compocn, 'So_ofrac') +! call addfld_to(compwav, 'So_ofrac') +! else +! if ( fldchk(is_local%wrap%FBexp(compwav) , 'So_ofrac', rc=rc) .and. & +! fldchk(is_local%wrap%FBImp(compice,compice ), 'So_ofrac', rc=rc)) then +! ! By default will be using a custom map - but if one is not available, use a generated bilinear instead +! call addmap_from(compice, 'Si_ifrac', compwav, mapbilnr, 'one', ice2wav_smap) +! call addmrg_to(compwav, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') +! end if +! end if + ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- From e6451a48903d5a1588a4b6e1e5288138e805992d Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 14:19:14 -0400 Subject: [PATCH 09/34] Changing merge to Fwxx_taux to copy --- mediator/esmFldsExchange_cesm_mod.F90 | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 566040563..897e942a3 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2985,17 +2985,18 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') - call addfld_from(compice , 'Fioi_taux') +! call addfld_from(compice , 'Fioi_taux') call addfld_aoflux('Faox_taux') else if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then - if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then - call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') - end if +! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then +! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') +! call addmrg_to(compwav, 'Fwxx_taux', & +! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') +! end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='copy') +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if ! if (phase == 'advertise') then From bdd726adc35eefc4cc26bf6185857fdaca004a1b Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 15:24:45 -0400 Subject: [PATCH 10/34] Fixed syntax of addmrg_to call for Fwxx_taux --- mediator/esmFldsExchange_cesm_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 897e942a3..42bb327ee 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2995,7 +2995,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') ! end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='copy') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if From dec4bfb7c43dfb43f46e6a41592b04aa25640b10 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 16:47:24 -0400 Subject: [PATCH 11/34] Reverted earlier modifications --- mediator/med_phases_prep_wav_mod.F90 | 202 +++++++++++++-------------- 1 file changed, 101 insertions(+), 101 deletions(-) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index fa6e6617e..eb89bde22 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -14,18 +14,18 @@ module med_phases_prep_wav_mod use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose !PSH begin - use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk - use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr +! use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk +! use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr !PSH end use med_methods_mod , only : FB_accum => med_methods_FB_accum use med_methods_mod , only : FB_average => med_methods_FB_average use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset !PSH begin -! use esmFlds , only : med_fldList_GetfldListTo -! use med_internalstate_mod , only : compwav - use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type - use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode + use esmFlds , only : med_fldList_GetfldListTo + use med_internalstate_mod , only : compwav +! use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type +! use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode !PSH end use perf_mod , only : t_startf, t_stopf @@ -37,7 +37,7 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_avg ! called from run sequence !PSH begin - private :: med_phases_prep_wav_custom_cesm +! private :: med_phases_prep_wav_custom_cesm !PSH end character(*), parameter :: u_FILE_u = & @@ -95,7 +95,7 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) type(InternalState) :: is_local integer :: n, ncnt !PSH begin - type(med_fldlist_type), pointer :: fldList +! type(med_fldlist_type), pointer :: fldList !PSH end character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' !--------------------------------------- @@ -112,31 +112,31 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !PSH begin - fldList => med_fldList_GetfldListTo(compwav) +! fldList => med_fldList_GetfldListTo(compwav) !PSH end ! auto merges to wav !PSH begin -! call med_merge_auto(& -! is_local%wrap%med_coupling_active(:,compwav), & -! is_local%wrap%FBExp(compwav), & -! is_local%wrap%FBFrac(compwav), & -! is_local%wrap%FBImp(:,compwav), & -! med_fldList_GetfldListTo(compwav), rc=rc) - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compwav), & - is_local%wrap%FBExp(compwav), & - is_local%wrap%FBFrac(compwav), & - is_local%wrap%FBImp(:,compwav), & - fldList, & - FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) + call med_merge_auto(& + is_local%wrap%med_coupling_active(:,compwav), & + is_local%wrap%FBExp(compwav), & + is_local%wrap%FBFrac(compwav), & + is_local%wrap%FBImp(:,compwav), & + med_fldList_GetfldListTo(compwav), rc=rc) +! call med_merge_auto(& +! is_local%wrap%med_coupling_active(:,compwav), & +! is_local%wrap%FBExp(compwav), & +! is_local%wrap%FBFrac(compwav), & +! is_local%wrap%FBImp(:,compwav), & +! fldList, & +! FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) !PSH end if (ChkErr(rc,__LINE__,u_FILE_u)) return !PSH begin - ! custom merges to ocean - if (trim(coupling_mode) == 'cesm') then - call med_phases_prep_wav_custom_cesm(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if +! ! custom merges to ocean +! if (trim(coupling_mode) == 'cesm') then +! call med_phases_prep_wav_custom_cesm(gcomp, rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if !PSH end ! wave accumulator @@ -224,79 +224,79 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) end subroutine med_phases_prep_wav_avg !----------------------------------------------------------------------------- - subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) - - !--------------------------------------- - ! custom calculations for cesm - !--------------------------------------- - - use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet - use ESMF , only : ESMF_VMBroadCast - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR - - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(InternalState) :: is_local - type(ESMF_Field) :: lfield - real(R8), pointer :: ifrac(:) - real(R8), pointer :: ofrac(:) - real(R8), pointer :: ifracr(:) - real(R8), pointer :: ofracr(:) - real(R8), pointer :: avsdr(:) - real(R8), pointer :: avsdf(:) - real(R8), pointer :: anidr(:) - real(R8), pointer :: anidf(:) - real(R8), pointer :: Faxa_swvdf(:) - real(R8), pointer :: Faxa_swndf(:) - real(R8), pointer :: Faxa_swvdr(:) - real(R8), pointer :: Faxa_swndr(:) - real(R8), pointer :: Foxx_swnet(:) - real(R8), pointer :: Foxx_swnet_afracr(:) - real(R8), pointer :: Foxx_swnet_vdr(:) - real(R8), pointer :: Foxx_swnet_vdf(:) - real(R8), pointer :: Foxx_swnet_idr(:) - real(R8), pointer :: Foxx_swnet_idf(:) - real(R8), pointer :: Fioi_swpen_vdr(:) - real(R8), pointer :: Fioi_swpen_vdf(:) - real(R8), pointer :: Fioi_swpen_idr(:) - real(R8), pointer :: Fioi_swpen_idf(:) - real(R8), pointer :: Fioi_swpen(:) - real(R8), pointer :: dataptr(:) - real(R8), pointer :: dataptr_scalar_ocn(:,:) - real(R8) :: frac_sum - real(R8) :: ifrac_scaled, ofrac_scaled - real(R8) :: ifracr_scaled, ofracr_scaled - logical :: export_swnet_by_bands - logical :: import_swpen_by_bands - logical :: export_swnet_afracr - real(R8) :: precip_fact(1) - character(CS) :: cvalue - real(R8) :: fswabsv, fswabsi - integer :: scalar_id - integer :: n - integer :: lsize - real(R8) :: c1,c2,c3,c4 - character(len=64), allocatable :: fldnames(:) - character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' - !--------------------------------------- - - rc = ESMF_SUCCESS - - call t_startf('MED:'//subname) - if (dbug_flag > 20) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - end if - call memcheck(subname, 5, mastertask) - - ! Get the internal state - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - +! subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) +! +! !--------------------------------------- +! ! custom calculations for cesm +! !--------------------------------------- +! +! use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet +! use ESMF , only : ESMF_VMBroadCast +! use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS +! use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR +! +! ! input/output variables +! type(ESMF_GridComp) :: gcomp +! integer, intent(out) :: rc +! +! ! local variables +! type(InternalState) :: is_local +! type(ESMF_Field) :: lfield +! real(R8), pointer :: ifrac(:) +! real(R8), pointer :: ofrac(:) +! real(R8), pointer :: ifracr(:) +! real(R8), pointer :: ofracr(:) +! real(R8), pointer :: avsdr(:) +! real(R8), pointer :: avsdf(:) +! real(R8), pointer :: anidr(:) +! real(R8), pointer :: anidf(:) +! real(R8), pointer :: Faxa_swvdf(:) +! real(R8), pointer :: Faxa_swndf(:) +! real(R8), pointer :: Faxa_swvdr(:) +! real(R8), pointer :: Faxa_swndr(:) +! real(R8), pointer :: Foxx_swnet(:) +! real(R8), pointer :: Foxx_swnet_afracr(:) +! real(R8), pointer :: Foxx_swnet_vdr(:) +! real(R8), pointer :: Foxx_swnet_vdf(:) +! real(R8), pointer :: Foxx_swnet_idr(:) +! real(R8), pointer :: Foxx_swnet_idf(:) +! real(R8), pointer :: Fioi_swpen_vdr(:) +! real(R8), pointer :: Fioi_swpen_vdf(:) +! real(R8), pointer :: Fioi_swpen_idr(:) +! real(R8), pointer :: Fioi_swpen_idf(:) +! real(R8), pointer :: Fioi_swpen(:) +! real(R8), pointer :: dataptr(:) +! real(R8), pointer :: dataptr_scalar_ocn(:,:) +! real(R8) :: frac_sum +! real(R8) :: ifrac_scaled, ofrac_scaled +! real(R8) :: ifracr_scaled, ofracr_scaled +! logical :: export_swnet_by_bands +! logical :: import_swpen_by_bands +! logical :: export_swnet_afracr +! real(R8) :: precip_fact(1) +! character(CS) :: cvalue +! real(R8) :: fswabsv, fswabsi +! integer :: scalar_id +! integer :: n +! integer :: lsize +! real(R8) :: c1,c2,c3,c4 +! character(len=64), allocatable :: fldnames(:) +! character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' +! !--------------------------------------- +! +! rc = ESMF_SUCCESS +! +! call t_startf('MED:'//subname) +! if (dbug_flag > 20) then +! call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) +! end if +! call memcheck(subname, 5, mastertask) +! +! ! Get the internal state +! nullify(is_local%wrap) +! call ESMF_GridCompGetInternalState(gcomp, is_local, rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! ! !--------------------------------------- ! ! Compute netsw for ocean ! !--------------------------------------- @@ -519,6 +519,6 @@ subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) ! end if ! call t_stopf('MED:'//subname) ! - end subroutine med_phases_prep_wav_custom_cesm +! end subroutine med_phases_prep_wav_custom_cesm end module med_phases_prep_wav_mod From d4b84412a4589038fa65b0aca9c555823676ab06 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 17:53:47 -0400 Subject: [PATCH 12/34] Substituting Foxx_taux for Faox_taux --- mediator/esmFldsExchange_cesm_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 42bb327ee..bf8fe952e 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2986,7 +2986,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') ! call addfld_from(compice , 'Fioi_taux') - call addfld_aoflux('Faox_taux') + call addfld_from(compocn, 'Foxx_taux') +! call addfld_aoflux('Faox_taux') else if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then ! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then @@ -2995,7 +2996,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') ! end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') + mrg_from=compocn, mrg_fld='Foxx_taux', mrg_type='copy') +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if From d666f8340d473f956c41c641bd4b7cbfbb1ace53 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 23:31:25 -0400 Subject: [PATCH 13/34] Revert "Substituting Foxx_taux for Faox_taux" This reverts commit d4b84412a4589038fa65b0aca9c555823676ab06. --- mediator/esmFldsExchange_cesm_mod.F90 | 6 +- mediator/med_phases_prep_wav_mod.F90 | 202 +++++++++++++------------- 2 files changed, 103 insertions(+), 105 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index bf8fe952e..42bb327ee 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2986,8 +2986,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') ! call addfld_from(compice , 'Fioi_taux') - call addfld_from(compocn, 'Foxx_taux') -! call addfld_aoflux('Faox_taux') + call addfld_aoflux('Faox_taux') else if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then ! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then @@ -2996,8 +2995,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') ! end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compocn, mrg_fld='Foxx_taux', mrg_type='copy') -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index eb89bde22..fa6e6617e 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -14,18 +14,18 @@ module med_phases_prep_wav_mod use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose !PSH begin -! use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk -! use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr + use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk + use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr !PSH end use med_methods_mod , only : FB_accum => med_methods_FB_accum use med_methods_mod , only : FB_average => med_methods_FB_average use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset !PSH begin - use esmFlds , only : med_fldList_GetfldListTo - use med_internalstate_mod , only : compwav -! use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type -! use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode +! use esmFlds , only : med_fldList_GetfldListTo +! use med_internalstate_mod , only : compwav + use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type + use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode !PSH end use perf_mod , only : t_startf, t_stopf @@ -37,7 +37,7 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_avg ! called from run sequence !PSH begin -! private :: med_phases_prep_wav_custom_cesm + private :: med_phases_prep_wav_custom_cesm !PSH end character(*), parameter :: u_FILE_u = & @@ -95,7 +95,7 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) type(InternalState) :: is_local integer :: n, ncnt !PSH begin -! type(med_fldlist_type), pointer :: fldList + type(med_fldlist_type), pointer :: fldList !PSH end character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' !--------------------------------------- @@ -112,31 +112,31 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !PSH begin -! fldList => med_fldList_GetfldListTo(compwav) + fldList => med_fldList_GetfldListTo(compwav) !PSH end ! auto merges to wav !PSH begin - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compwav), & - is_local%wrap%FBExp(compwav), & - is_local%wrap%FBFrac(compwav), & - is_local%wrap%FBImp(:,compwav), & - med_fldList_GetfldListTo(compwav), rc=rc) -! call med_merge_auto(& -! is_local%wrap%med_coupling_active(:,compwav), & -! is_local%wrap%FBExp(compwav), & -! is_local%wrap%FBFrac(compwav), & -! is_local%wrap%FBImp(:,compwav), & -! fldList, & -! FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) +! call med_merge_auto(& +! is_local%wrap%med_coupling_active(:,compwav), & +! is_local%wrap%FBExp(compwav), & +! is_local%wrap%FBFrac(compwav), & +! is_local%wrap%FBImp(:,compwav), & +! med_fldList_GetfldListTo(compwav), rc=rc) + call med_merge_auto(& + is_local%wrap%med_coupling_active(:,compwav), & + is_local%wrap%FBExp(compwav), & + is_local%wrap%FBFrac(compwav), & + is_local%wrap%FBImp(:,compwav), & + fldList, & + FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) !PSH end if (ChkErr(rc,__LINE__,u_FILE_u)) return !PSH begin -! ! custom merges to ocean -! if (trim(coupling_mode) == 'cesm') then -! call med_phases_prep_wav_custom_cesm(gcomp, rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if + ! custom merges to ocean + if (trim(coupling_mode) == 'cesm') then + call med_phases_prep_wav_custom_cesm(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if !PSH end ! wave accumulator @@ -224,79 +224,79 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) end subroutine med_phases_prep_wav_avg !----------------------------------------------------------------------------- -! subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) -! -! !--------------------------------------- -! ! custom calculations for cesm -! !--------------------------------------- -! -! use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet -! use ESMF , only : ESMF_VMBroadCast -! use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS -! use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR -! -! ! input/output variables -! type(ESMF_GridComp) :: gcomp -! integer, intent(out) :: rc -! -! ! local variables -! type(InternalState) :: is_local -! type(ESMF_Field) :: lfield -! real(R8), pointer :: ifrac(:) -! real(R8), pointer :: ofrac(:) -! real(R8), pointer :: ifracr(:) -! real(R8), pointer :: ofracr(:) -! real(R8), pointer :: avsdr(:) -! real(R8), pointer :: avsdf(:) -! real(R8), pointer :: anidr(:) -! real(R8), pointer :: anidf(:) -! real(R8), pointer :: Faxa_swvdf(:) -! real(R8), pointer :: Faxa_swndf(:) -! real(R8), pointer :: Faxa_swvdr(:) -! real(R8), pointer :: Faxa_swndr(:) -! real(R8), pointer :: Foxx_swnet(:) -! real(R8), pointer :: Foxx_swnet_afracr(:) -! real(R8), pointer :: Foxx_swnet_vdr(:) -! real(R8), pointer :: Foxx_swnet_vdf(:) -! real(R8), pointer :: Foxx_swnet_idr(:) -! real(R8), pointer :: Foxx_swnet_idf(:) -! real(R8), pointer :: Fioi_swpen_vdr(:) -! real(R8), pointer :: Fioi_swpen_vdf(:) -! real(R8), pointer :: Fioi_swpen_idr(:) -! real(R8), pointer :: Fioi_swpen_idf(:) -! real(R8), pointer :: Fioi_swpen(:) -! real(R8), pointer :: dataptr(:) -! real(R8), pointer :: dataptr_scalar_ocn(:,:) -! real(R8) :: frac_sum -! real(R8) :: ifrac_scaled, ofrac_scaled -! real(R8) :: ifracr_scaled, ofracr_scaled -! logical :: export_swnet_by_bands -! logical :: import_swpen_by_bands -! logical :: export_swnet_afracr -! real(R8) :: precip_fact(1) -! character(CS) :: cvalue -! real(R8) :: fswabsv, fswabsi -! integer :: scalar_id -! integer :: n -! integer :: lsize -! real(R8) :: c1,c2,c3,c4 -! character(len=64), allocatable :: fldnames(:) -! character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' -! !--------------------------------------- -! -! rc = ESMF_SUCCESS -! -! call t_startf('MED:'//subname) -! if (dbug_flag > 20) then -! call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) -! end if -! call memcheck(subname, 5, mastertask) -! -! ! Get the internal state -! nullify(is_local%wrap) -! call ESMF_GridCompGetInternalState(gcomp, is_local, rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! + subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) + + !--------------------------------------- + ! custom calculations for cesm + !--------------------------------------- + + use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet + use ESMF , only : ESMF_VMBroadCast + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + type(ESMF_Field) :: lfield + real(R8), pointer :: ifrac(:) + real(R8), pointer :: ofrac(:) + real(R8), pointer :: ifracr(:) + real(R8), pointer :: ofracr(:) + real(R8), pointer :: avsdr(:) + real(R8), pointer :: avsdf(:) + real(R8), pointer :: anidr(:) + real(R8), pointer :: anidf(:) + real(R8), pointer :: Faxa_swvdf(:) + real(R8), pointer :: Faxa_swndf(:) + real(R8), pointer :: Faxa_swvdr(:) + real(R8), pointer :: Faxa_swndr(:) + real(R8), pointer :: Foxx_swnet(:) + real(R8), pointer :: Foxx_swnet_afracr(:) + real(R8), pointer :: Foxx_swnet_vdr(:) + real(R8), pointer :: Foxx_swnet_vdf(:) + real(R8), pointer :: Foxx_swnet_idr(:) + real(R8), pointer :: Foxx_swnet_idf(:) + real(R8), pointer :: Fioi_swpen_vdr(:) + real(R8), pointer :: Fioi_swpen_vdf(:) + real(R8), pointer :: Fioi_swpen_idr(:) + real(R8), pointer :: Fioi_swpen_idf(:) + real(R8), pointer :: Fioi_swpen(:) + real(R8), pointer :: dataptr(:) + real(R8), pointer :: dataptr_scalar_ocn(:,:) + real(R8) :: frac_sum + real(R8) :: ifrac_scaled, ofrac_scaled + real(R8) :: ifracr_scaled, ofracr_scaled + logical :: export_swnet_by_bands + logical :: import_swpen_by_bands + logical :: export_swnet_afracr + real(R8) :: precip_fact(1) + character(CS) :: cvalue + real(R8) :: fswabsv, fswabsi + integer :: scalar_id + integer :: n + integer :: lsize + real(R8) :: c1,c2,c3,c4 + character(len=64), allocatable :: fldnames(:) + character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > 20) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + end if + call memcheck(subname, 5, mastertask) + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! !--------------------------------------- ! ! Compute netsw for ocean ! !--------------------------------------- @@ -519,6 +519,6 @@ end subroutine med_phases_prep_wav_avg ! end if ! call t_stopf('MED:'//subname) ! -! end subroutine med_phases_prep_wav_custom_cesm + end subroutine med_phases_prep_wav_custom_cesm end module med_phases_prep_wav_mod From 39257106ef55335081c88e14afea0525e7050cfb Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 23:45:36 -0400 Subject: [PATCH 14/34] Removed export of So_ofrac to wav component (unnecessary), and other miscellaneous cleanup --- mediator/esmFldsExchange_cesm_mod.F90 | 38 +++------------------------ 1 file changed, 4 insertions(+), 34 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 42bb327ee..94028de1d 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2964,10 +2964,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !PSH begin - if (phase == 'advertise') then - call addfld_from(compocn, 'So_ofrac') - call addfld_to(compwav, 'So_ofrac') - end if +! if (phase == 'advertise') then +! call addfld_from(compocn, 'So_ofrac') +! call addfld_to(compwav, 'So_ofrac') +! end if ! if (phase == 'advertise') then ! call addfld_from(compocn, 'So_ofrac') ! call addfld_to(compwav, 'So_ofrac') @@ -2999,36 +2999,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if -! if (phase == 'advertise') then -! call addfld_to(compwav , 'Foxx_taux') -! call addfld_from(compice , 'Fioi_taux') -! call addfld_aoflux('Faox_taux') -! else -! if ( fldchk(is_local%wrap%FBexp(compwav), 'Foxx_taux', rc=rc)) then -! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then -! call addmap_from(compice, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') -! call addmrg_to(compwav, 'Foxx_taux', & -! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') -! end if -! call addmrg_to(compwav, 'Foxx_taux', & -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') -! end if -! end if -! if (phase == 'advertise') then -! call addfld_to(compwav , 'Foxx_tauy') -! call addfld_from(compice , 'Fioi_tauy') -! call addfld_aoflux('Faox_tauy') -! else -! if ( fldchk(is_local%wrap%FBexp(compwav), 'Foxx_tauy', rc=rc)) then -! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_tauy', rc=rc)) then -! call addmap_from(compice, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') -! call addmrg_to(compwav, 'Fwxx_tauy', & -! mrg_from=compice, mrg_fld='Fioi_tauy', mrg_type='merge', mrg_fracname='ifrac') -! end if -! call addmrg_to(compwav, 'Fwxx_tauy', & -! mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') -! end if -! end if !PSH end !===================================================================== From e142b2d44b0444b435f0442b2bd047c21d1fcf6e Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 00:35:57 -0400 Subject: [PATCH 15/34] Cleaning up earlier, temporary code --- mediator/med_phases_prep_wav_mod.F90 | 194 +++++++++++++-------------- 1 file changed, 97 insertions(+), 97 deletions(-) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index fa6e6617e..196ca724a 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -22,10 +22,10 @@ module med_phases_prep_wav_mod use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset !PSH begin -! use esmFlds , only : med_fldList_GetfldListTo -! use med_internalstate_mod , only : compwav - use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type - use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode + use esmFlds , only : med_fldList_GetfldListTo + use med_internalstate_mod , only : compwav +! use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type +! use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode !PSH end use perf_mod , only : t_startf, t_stopf @@ -37,7 +37,7 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_avg ! called from run sequence !PSH begin - private :: med_phases_prep_wav_custom_cesm +! private :: med_phases_prep_wav_custom_cesm !PSH end character(*), parameter :: u_FILE_u = & @@ -116,27 +116,27 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) !PSH end ! auto merges to wav !PSH begin -! call med_merge_auto(& -! is_local%wrap%med_coupling_active(:,compwav), & -! is_local%wrap%FBExp(compwav), & -! is_local%wrap%FBFrac(compwav), & -! is_local%wrap%FBImp(:,compwav), & -! med_fldList_GetfldListTo(compwav), rc=rc) - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compwav), & - is_local%wrap%FBExp(compwav), & - is_local%wrap%FBFrac(compwav), & - is_local%wrap%FBImp(:,compwav), & - fldList, & - FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) + call med_merge_auto(& + is_local%wrap%med_coupling_active(:,compwav), & + is_local%wrap%FBExp(compwav), & + is_local%wrap%FBFrac(compwav), & + is_local%wrap%FBImp(:,compwav), & + med_fldList_GetfldListTo(compwav), rc=rc) +! call med_merge_auto(& +! is_local%wrap%med_coupling_active(:,compwav), & +! is_local%wrap%FBExp(compwav), & +! is_local%wrap%FBFrac(compwav), & +! is_local%wrap%FBImp(:,compwav), & +! fldList, & +! FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) !PSH end if (ChkErr(rc,__LINE__,u_FILE_u)) return !PSH begin - ! custom merges to ocean - if (trim(coupling_mode) == 'cesm') then - call med_phases_prep_wav_custom_cesm(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if +! ! custom merges to ocean +! if (trim(coupling_mode) == 'cesm') then +! call med_phases_prep_wav_custom_cesm(gcomp, rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if !PSH end ! wave accumulator @@ -224,79 +224,79 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) end subroutine med_phases_prep_wav_avg !----------------------------------------------------------------------------- - subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) - - !--------------------------------------- - ! custom calculations for cesm - !--------------------------------------- - - use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet - use ESMF , only : ESMF_VMBroadCast - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR - - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(InternalState) :: is_local - type(ESMF_Field) :: lfield - real(R8), pointer :: ifrac(:) - real(R8), pointer :: ofrac(:) - real(R8), pointer :: ifracr(:) - real(R8), pointer :: ofracr(:) - real(R8), pointer :: avsdr(:) - real(R8), pointer :: avsdf(:) - real(R8), pointer :: anidr(:) - real(R8), pointer :: anidf(:) - real(R8), pointer :: Faxa_swvdf(:) - real(R8), pointer :: Faxa_swndf(:) - real(R8), pointer :: Faxa_swvdr(:) - real(R8), pointer :: Faxa_swndr(:) - real(R8), pointer :: Foxx_swnet(:) - real(R8), pointer :: Foxx_swnet_afracr(:) - real(R8), pointer :: Foxx_swnet_vdr(:) - real(R8), pointer :: Foxx_swnet_vdf(:) - real(R8), pointer :: Foxx_swnet_idr(:) - real(R8), pointer :: Foxx_swnet_idf(:) - real(R8), pointer :: Fioi_swpen_vdr(:) - real(R8), pointer :: Fioi_swpen_vdf(:) - real(R8), pointer :: Fioi_swpen_idr(:) - real(R8), pointer :: Fioi_swpen_idf(:) - real(R8), pointer :: Fioi_swpen(:) - real(R8), pointer :: dataptr(:) - real(R8), pointer :: dataptr_scalar_ocn(:,:) - real(R8) :: frac_sum - real(R8) :: ifrac_scaled, ofrac_scaled - real(R8) :: ifracr_scaled, ofracr_scaled - logical :: export_swnet_by_bands - logical :: import_swpen_by_bands - logical :: export_swnet_afracr - real(R8) :: precip_fact(1) - character(CS) :: cvalue - real(R8) :: fswabsv, fswabsi - integer :: scalar_id - integer :: n - integer :: lsize - real(R8) :: c1,c2,c3,c4 - character(len=64), allocatable :: fldnames(:) - character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' - !--------------------------------------- - - rc = ESMF_SUCCESS - - call t_startf('MED:'//subname) - if (dbug_flag > 20) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - end if - call memcheck(subname, 5, mastertask) - - ! Get the internal state - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - +! subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) +! +! !--------------------------------------- +! ! custom calculations for cesm +! !--------------------------------------- +! +! use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet +! use ESMF , only : ESMF_VMBroadCast +! use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS +! use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR +! +! ! input/output variables +! type(ESMF_GridComp) :: gcomp +! integer, intent(out) :: rc +! +! ! local variables +! type(InternalState) :: is_local +! type(ESMF_Field) :: lfield +! real(R8), pointer :: ifrac(:) +! real(R8), pointer :: ofrac(:) +! real(R8), pointer :: ifracr(:) +! real(R8), pointer :: ofracr(:) +! real(R8), pointer :: avsdr(:) +! real(R8), pointer :: avsdf(:) +! real(R8), pointer :: anidr(:) +! real(R8), pointer :: anidf(:) +! real(R8), pointer :: Faxa_swvdf(:) +! real(R8), pointer :: Faxa_swndf(:) +! real(R8), pointer :: Faxa_swvdr(:) +! real(R8), pointer :: Faxa_swndr(:) +! real(R8), pointer :: Foxx_swnet(:) +! real(R8), pointer :: Foxx_swnet_afracr(:) +! real(R8), pointer :: Foxx_swnet_vdr(:) +! real(R8), pointer :: Foxx_swnet_vdf(:) +! real(R8), pointer :: Foxx_swnet_idr(:) +! real(R8), pointer :: Foxx_swnet_idf(:) +! real(R8), pointer :: Fioi_swpen_vdr(:) +! real(R8), pointer :: Fioi_swpen_vdf(:) +! real(R8), pointer :: Fioi_swpen_idr(:) +! real(R8), pointer :: Fioi_swpen_idf(:) +! real(R8), pointer :: Fioi_swpen(:) +! real(R8), pointer :: dataptr(:) +! real(R8), pointer :: dataptr_scalar_ocn(:,:) +! real(R8) :: frac_sum +! real(R8) :: ifrac_scaled, ofrac_scaled +! real(R8) :: ifracr_scaled, ofracr_scaled +! logical :: export_swnet_by_bands +! logical :: import_swpen_by_bands +! logical :: export_swnet_afracr +! real(R8) :: precip_fact(1) +! character(CS) :: cvalue +! real(R8) :: fswabsv, fswabsi +! integer :: scalar_id +! integer :: n +! integer :: lsize +! real(R8) :: c1,c2,c3,c4 +! character(len=64), allocatable :: fldnames(:) +! character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' +! !--------------------------------------- +! +! rc = ESMF_SUCCESS +! +! call t_startf('MED:'//subname) +! if (dbug_flag > 20) then +! call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) +! end if +! call memcheck(subname, 5, mastertask) +! +! ! Get the internal state +! nullify(is_local%wrap) +! call ESMF_GridCompGetInternalState(gcomp, is_local, rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! ! !--------------------------------------- ! ! Compute netsw for ocean ! !--------------------------------------- @@ -519,6 +519,6 @@ subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) ! end if ! call t_stopf('MED:'//subname) ! - end subroutine med_phases_prep_wav_custom_cesm +! end subroutine med_phases_prep_wav_custom_cesm end module med_phases_prep_wav_mod From 14bd205d9234aac9504fb18e214a555363da6047 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 01:02:18 -0400 Subject: [PATCH 16/34] Removed unnecessary fldList variable --- mediator/med_phases_prep_wav_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 196ca724a..3ed57c00d 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -95,7 +95,7 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) type(InternalState) :: is_local integer :: n, ncnt !PSH begin - type(med_fldlist_type), pointer :: fldList +! type(med_fldlist_type), pointer :: fldList !PSH end character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' !--------------------------------------- @@ -112,7 +112,7 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !PSH begin - fldList => med_fldList_GetfldListTo(compwav) +! fldList => med_fldList_GetfldListTo(compwav) !PSH end ! auto merges to wav !PSH begin From abc56586b0e478d2a1d8a6442115a2d6665a6605 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 07:00:36 -0400 Subject: [PATCH 17/34] Adding stress from ice to Fwxx_taux --- mediator/esmFldsExchange_cesm_mod.F90 | 32 ++++++++++++++++++++------- 1 file changed, 24 insertions(+), 8 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 94028de1d..ddf0570ce 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2983,20 +2983,36 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- +! if (phase == 'advertise') then +! call addfld_to(compwav , 'Fwxx_taux') +!! call addfld_from(compice , 'Fioi_taux') +! call addfld_aoflux('Faox_taux') +! else +! if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then +!! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then +!! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') +!! call addmrg_to(compwav, 'Fwxx_taux', & +!! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') +!! end if +! call addmrg_to(compwav, 'Fwxx_taux', & +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') +!! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') +! end if +! end if +!! if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') -! call addfld_from(compice , 'Fioi_taux') + call addfld_from(compice , 'Fioi_taux') call addfld_aoflux('Faox_taux') else if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then -! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then -! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') -! call addmrg_to(compwav, 'Fwxx_taux', & -! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') -! end if + if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then + call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') + call addmrg_to(compwav, 'Fwxx_taux', & + mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if !PSH end From cb585c5852d3701d1eedfe9fe14b42fcf980e7a3 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 09:48:17 -0400 Subject: [PATCH 18/34] Removed mrg_fracname from Fwxx merges --- mediator/esmFldsExchange_cesm_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index ddf0570ce..b3b0f56c5 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -3009,10 +3009,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge') +! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge') +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if !PSH end From 95c518851d7153e6311dfdc40a8bcf247b701681 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 11:28:03 -0400 Subject: [PATCH 19/34] Added ifrac and ofrac to FBFrac for wave component --- mediator/med_fraction_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 521ba0007..7cc5c0203 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -126,8 +126,10 @@ module med_fraction_mod 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 '/) - +!PSH begin +! character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) + character(len=6),parameter,dimension(3) :: fraclist_w = (/'ifrac ','ofrac ','wfrac '/) +!PSH end !--- standard --- real(R8) , parameter :: eps_fraclim = 1.0e-03 ! truncation limit in fractions_a(lfrac) character(*), parameter :: u_FILE_u = & From 5633ff2e4a3f3ce1c3781eec53eab2df520d4ed3 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 11:29:37 -0400 Subject: [PATCH 20/34] Using ifrac and ofrac weights for Fbww merge --- mediator/esmFldsExchange_cesm_mod.F90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index b3b0f56c5..ddf0570ce 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -3009,12 +3009,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge') -! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge') -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if !PSH end From a3c13d2fe9a06f1c4db513ac60078a3c52950bb2 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 14:33:20 -0400 Subject: [PATCH 21/34] Updated comments to include wave component --- mediator/med_fraction_mod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 7cc5c0203..c97fb8994 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -23,6 +23,7 @@ module med_fraction_mod ! character(*),parameter :: fraclist_l = 'lfrac' ! character(*),parameter :: fraclist_g = 'gfrac:lfrac' ! character(*),parameter :: fraclist_r = 'lfrac:rfrac' + ! character(*),parameter :: fraclist_w = 'ifrac:ofrac:wfrac' ! ! we assume ocean and ice are on the same grids, same masks ! we assume ocn2atm and ice2atm are masked maps From 68baf9f3999e48fc8afdcb8ca1f713aa908e9c0b Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 28 Apr 2023 15:33:46 -0400 Subject: [PATCH 22/34] Added new fractions (ifrac, ofrac) for wave component --- mediator/med_fraction_mod.F90 | 188 +++++++++++++++++++++++++++++++++- 1 file changed, 186 insertions(+), 2 deletions(-) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index c97fb8994..ed11d33f1 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -24,8 +24,10 @@ module med_fraction_mod ! character(*),parameter :: fraclist_g = 'gfrac:lfrac' ! character(*),parameter :: fraclist_r = 'lfrac:rfrac' ! character(*),parameter :: fraclist_w = 'ifrac:ofrac:wfrac' - ! - ! we assume ocean and ice are on the same grids, same masks +!PSH begin ! +! ! we assume ocean and ice are on the same grids, same masks + ! we assume ocean, ice, and waves are on the same grids, same masks +!PSH end ! we assume ocn2atm and ice2atm are masked maps ! we assume lnd2atm is a global map ! we assume that the ice fraction evolves in time but that @@ -587,6 +589,86 @@ subroutine med_fraction_init(gcomp, rc) endif endif +!PSH Begin - In progress... +! Note: started this section, based on setting ifrac and ofrac for compatm, but it is not +! clear to me that this approach is correct, since we can assume ocn, ice, wav are all on +! the same grid. Commenting out for now, can delete once I'm confident other approach +! works +! !--------------------------------------- +! ! Set 'ofrac' in FBFrac(compwav) +! !--------------------------------------- +! +! if ( is_local%wrap%comp_present(compocn) .and. & +! is_local%wrap%comp_present(compwav) .and. & +! is_local%wrap%med_coupling_active(compocn,compwav)) then +! +! ! Set 'ofrac' in FBFrac(compwav) - at this point this is the +! ! ocean mask mapped to the atm grid This is mapping the ocean mask to +! ! the wav grid +! +! if (med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),mapfcopy, rc=rc)) then +! ! If ocn and atm are on the same mesh - a redist route handle has already been created +! maptype = mapfcopy +! else +! if (trim(coupling_mode) == 'nems_orig' ) then +! maptype = mapnstod_consd +! else +! maptype = mapconsd +! end if +! if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),maptype, rc=rc)) then +! call med_map_routehandles_init( compocn, compwav, & +! FBSrc=is_local%wrap%FBImp(compocn,compocn), & +! FBDst=is_local%wrap%FBImp(compocn,compwav), & +! mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! end if +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compocn), fieldname='ofrac', field=field_src, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), fieldname='ofrac', 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(compocn,compwav,:), maptype, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return +! +! end if +! +! !--------------------------------------- +! ! Set 'ifrac' in FBFrac(compwav) +! !--------------------------------------- +! +! if ( is_local%wrap%comp_present(compice) .and. & +! is_local%wrap%comp_present(compwav) .and. & +! is_local%wrap%med_coupling_active(compice,compwav)) then +! +! ! Set 'ifrac' in FBFrac(compwav) - at this point this is the ice mask mapped to the wav mesh +! ! This maps the ice mask (which is the same as the ocean mask) to the wav mesh +! if (med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),mapfcopy, rc=rc)) then +! ! If ice and wav are on the same mesh - a redist route handle has already been created +! maptype = mapfcopy +! else +! if (trim(coupling_mode) == 'nems_orig' ) then +! maptype = mapnstod_consd +! else +! maptype = mapconsd +! end if +! if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),maptype, rc=rc)) then +! call med_map_routehandles_init( compice, compwav, & +! FBSrc=is_local%wrap%FBImp(compice,compice), & +! FBDst=is_local%wrap%FBImp(compice,compwav), & +! mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! end if +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ifrac', field=field_src, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ifrac', 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(compice,compwav,:), maptype, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! +!PSH end + !--------------------------------------- ! Create route handles ocn<->ice if not created !--------------------------------------- @@ -622,6 +704,80 @@ subroutine med_fraction_init(gcomp, rc) end if end if +!PSH begin + !--------------------------------------- + ! Create route handles ocn<->wav if not created + !--------------------------------------- + + if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compocn)) then + if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compocn,:),mapfcopy, rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compocn))) then + call fldbun_init(is_local%wrap%FBImp(compwav,compocn), is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compocn), & + STflds=is_local%wrap%NStateImp(compwav), & + name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compocn)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call med_map_routehandles_init(compwav, compocn, & + FBSrc=is_local%wrap%FBImp(compwav,compice), & + FBDst=is_local%wrap%FBImp(compwav,compice), & + mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),mapfcopy, rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compwav))) then + call fldbun_init(is_local%wrap%FBImp(compocn,compwav), is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compwav), & + STflds=is_local%wrap%NStateImp(compocn), & + name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compwav)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call med_map_routehandles_init( compocn, compwav, & + FBSrc=is_local%wrap%FBImp(compocn,compocn), & + FBDst=is_local%wrap%FBImp(compocn,compwav), & + mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + + !--------------------------------------- + ! Create route handles ice<->wav if not created + !--------------------------------------- + + if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compice)) then + if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compice,:),mapfcopy, rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compice))) then + call fldbun_init(is_local%wrap%FBImp(compwav,compice), is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compice), & + STflds=is_local%wrap%NStateImp(compwav), & + name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compice)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call med_map_routehandles_init(compwav, compice, & + FBSrc=is_local%wrap%FBImp(compwav,compice), & + FBDst=is_local%wrap%FBImp(compwav,compice), & + mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),mapfcopy, rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compice,compwav))) then + call fldbun_init(is_local%wrap%FBImp(compice,compwav), is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compwav), & + STflds=is_local%wrap%NStateImp(compice), & + name='FBImp'//trim(compname(compice))//'_'//trim(compname(compwav)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call med_map_routehandles_init( compice, compwav, & + FBSrc=is_local%wrap%FBImp(compice,compice), & + FBDst=is_local%wrap%FBImp(compice,compwav), & + mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + +!PSH end + + !--------------------------------------- ! Diagnostic output !--------------------------------------- @@ -757,6 +913,34 @@ subroutine med_fraction_set(gcomp, rc) endif call t_stopf('MED:'//trim(subname)//' fbfrac(compocn)') +!PSH begin + ! ------------------------------------------- + ! Set FBfrac(compwav) + ! ------------------------------------------- + + ! The following is just a redistribution from FBFrac(compice) + + call t_startf('MED:'//trim(subname)//' fbfrac(compwav)') + if (is_local%wrap%comp_present(compwav)) then + ! Map 'ifrac' from FBfrac(compice) to FBfrac(compwav) + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ifrac', field=field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ifrac', 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(compice,compwav,:), mapfcopy, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Map 'ofrac' from FBfrac(compice) to FBfrac(compwav) + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ofrac', field=field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ofrac', 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(compice,compwav,:), mapfcopy, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + call t_stopf('MED:'//trim(subname)//' fbfrac(compwav)') +!PSH end + ! ------------------------------------------- ! Set FBfrac(compatm) ! ------------------------------------------- From 04296bd52ca7af8e3fb57842b749075b4e1f980f Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 28 Apr 2023 15:53:56 -0400 Subject: [PATCH 23/34] Added compwav declaration to med_fraction_set subroutine --- mediator/med_fraction_mod.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index ed11d33f1..da379de13 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -808,6 +808,10 @@ subroutine med_fraction_set(gcomp, rc) use ESMF , only : ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldBundleIsCreated use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS +!PSH Begin +! use med_internalstate_mod , only : compatm, compocn, compice, compname + use med_internalstate_mod , only : compatm, compocn, compice, compname, compwav +!PSH End use med_internalstate_mod , only : compatm, compocn, compice, compname use med_internalstate_mod , only : mapfcopy, mapconsd, mapnstod_consd use med_internalstate_mod , only : coupling_mode From 5bc4403e393ee9018cf6b2179516a23169d77ed9 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 28 Apr 2023 19:59:35 -0400 Subject: [PATCH 24/34] Corrected two typos where compice was being passed instead of compwav --- mediator/med_fraction_mod.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index da379de13..3a5ac5a26 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -719,8 +719,8 @@ subroutine med_fraction_init(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if call med_map_routehandles_init(compwav, compocn, & - FBSrc=is_local%wrap%FBImp(compwav,compice), & - FBDst=is_local%wrap%FBImp(compwav,compice), & + FBSrc=is_local%wrap%FBImp(compwav,compocn), & + FBDst=is_local%wrap%FBImp(compwav,compocn), & mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -812,7 +812,6 @@ subroutine med_fraction_set(gcomp, rc) ! use med_internalstate_mod , only : compatm, compocn, compice, compname use med_internalstate_mod , only : compatm, compocn, compice, compname, compwav !PSH End - use med_internalstate_mod , only : compatm, compocn, compice, compname use med_internalstate_mod , only : mapfcopy, mapconsd, mapnstod_consd use med_internalstate_mod , only : coupling_mode use med_internalstate_mod , only : InternalState From 69317cbe2fb6f0392997f3fa33f2b7867a5f6108 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 28 Apr 2023 21:13:15 -0400 Subject: [PATCH 25/34] Removing previous additions for wavcomp --- mediator/med_fraction_mod.F90 | 194 +++++++++++++++++----------------- 1 file changed, 97 insertions(+), 97 deletions(-) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 3a5ac5a26..2a410aace 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -130,8 +130,8 @@ module med_fraction_mod character(len=6),parameter,dimension(2) :: fraclist_g = (/'gfrac ','lfrac '/) character(len=6),parameter,dimension(2) :: fraclist_r = (/'rfrac ','lfrac '/) !PSH begin -! character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) - character(len=6),parameter,dimension(3) :: fraclist_w = (/'ifrac ','ofrac ','wfrac '/) + character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) +! character(len=6),parameter,dimension(3) :: fraclist_w = (/'ifrac ','ofrac ','wfrac '/) !PSH end !--- standard --- real(R8) , parameter :: eps_fraclim = 1.0e-03 ! truncation limit in fractions_a(lfrac) @@ -705,76 +705,76 @@ subroutine med_fraction_init(gcomp, rc) end if !PSH begin - !--------------------------------------- - ! Create route handles ocn<->wav if not created - !--------------------------------------- - - if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compocn)) then - if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compocn,:),mapfcopy, rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compocn))) then - call fldbun_init(is_local%wrap%FBImp(compwav,compocn), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compocn), & - STflds=is_local%wrap%NStateImp(compwav), & - name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compocn)), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call med_map_routehandles_init(compwav, compocn, & - FBSrc=is_local%wrap%FBImp(compwav,compocn), & - FBDst=is_local%wrap%FBImp(compwav,compocn), & - mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),mapfcopy, rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compwav))) then - call fldbun_init(is_local%wrap%FBImp(compocn,compwav), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compwav), & - STflds=is_local%wrap%NStateImp(compocn), & - name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compwav)), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call med_map_routehandles_init( compocn, compwav, & - FBSrc=is_local%wrap%FBImp(compocn,compocn), & - FBDst=is_local%wrap%FBImp(compocn,compwav), & - mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end if - - !--------------------------------------- - ! Create route handles ice<->wav if not created - !--------------------------------------- - - if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compice)) then - if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compice,:),mapfcopy, rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compice))) then - call fldbun_init(is_local%wrap%FBImp(compwav,compice), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compice), & - STflds=is_local%wrap%NStateImp(compwav), & - name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compice)), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call med_map_routehandles_init(compwav, compice, & - FBSrc=is_local%wrap%FBImp(compwav,compice), & - FBDst=is_local%wrap%FBImp(compwav,compice), & - mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),mapfcopy, rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compice,compwav))) then - call fldbun_init(is_local%wrap%FBImp(compice,compwav), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compwav), & - STflds=is_local%wrap%NStateImp(compice), & - name='FBImp'//trim(compname(compice))//'_'//trim(compname(compwav)), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call med_map_routehandles_init( compice, compwav, & - FBSrc=is_local%wrap%FBImp(compice,compice), & - FBDst=is_local%wrap%FBImp(compice,compwav), & - mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end if - +! !--------------------------------------- +! ! Create route handles ocn<->wav if not created +! !--------------------------------------- +! +! if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compocn)) then +! if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compocn,:),mapfcopy, rc=rc)) then +! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compocn))) then +! call fldbun_init(is_local%wrap%FBImp(compwav,compocn), is_local%wrap%flds_scalar_name, & +! STgeom=is_local%wrap%NStateImp(compocn), & +! STflds=is_local%wrap%NStateImp(compwav), & +! name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compocn)), rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! call med_map_routehandles_init(compwav, compocn, & +! FBSrc=is_local%wrap%FBImp(compwav,compocn), & +! FBDst=is_local%wrap%FBImp(compwav,compocn), & +! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),mapfcopy, rc=rc)) then +! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compwav))) then +! call fldbun_init(is_local%wrap%FBImp(compocn,compwav), is_local%wrap%flds_scalar_name, & +! STgeom=is_local%wrap%NStateImp(compwav), & +! STflds=is_local%wrap%NStateImp(compocn), & +! name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compwav)), rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! call med_map_routehandles_init( compocn, compwav, & +! FBSrc=is_local%wrap%FBImp(compocn,compocn), & +! FBDst=is_local%wrap%FBImp(compocn,compwav), & +! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! end if +! +! !--------------------------------------- +! ! Create route handles ice<->wav if not created +! !--------------------------------------- +! +! if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compice)) then +! if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compice,:),mapfcopy, rc=rc)) then +! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compice))) then +! call fldbun_init(is_local%wrap%FBImp(compwav,compice), is_local%wrap%flds_scalar_name, & +! STgeom=is_local%wrap%NStateImp(compice), & +! STflds=is_local%wrap%NStateImp(compwav), & +! name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compice)), rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! call med_map_routehandles_init(compwav, compice, & +! FBSrc=is_local%wrap%FBImp(compwav,compice), & +! FBDst=is_local%wrap%FBImp(compwav,compice), & +! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),mapfcopy, rc=rc)) then +! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compice,compwav))) then +! call fldbun_init(is_local%wrap%FBImp(compice,compwav), is_local%wrap%flds_scalar_name, & +! STgeom=is_local%wrap%NStateImp(compwav), & +! STflds=is_local%wrap%NStateImp(compice), & +! name='FBImp'//trim(compname(compice))//'_'//trim(compname(compwav)), rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! call med_map_routehandles_init( compice, compwav, & +! FBSrc=is_local%wrap%FBImp(compice,compice), & +! FBDst=is_local%wrap%FBImp(compice,compwav), & +! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! end if +! !PSH end @@ -917,31 +917,31 @@ subroutine med_fraction_set(gcomp, rc) call t_stopf('MED:'//trim(subname)//' fbfrac(compocn)') !PSH begin - ! ------------------------------------------- - ! Set FBfrac(compwav) - ! ------------------------------------------- - - ! The following is just a redistribution from FBFrac(compice) - - call t_startf('MED:'//trim(subname)//' fbfrac(compwav)') - if (is_local%wrap%comp_present(compwav)) then - ! Map 'ifrac' from FBfrac(compice) to FBfrac(compwav) - call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ifrac', field=field_src, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ifrac', 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(compice,compwav,:), mapfcopy, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Map 'ofrac' from FBfrac(compice) to FBfrac(compwav) - call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ofrac', field=field_src, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ofrac', 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(compice,compwav,:), mapfcopy, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif - call t_stopf('MED:'//trim(subname)//' fbfrac(compwav)') +! ! ------------------------------------------- +! ! Set FBfrac(compwav) +! ! ------------------------------------------- +! +! ! The following is just a redistribution from FBFrac(compice) +! +! call t_startf('MED:'//trim(subname)//' fbfrac(compwav)') +! if (is_local%wrap%comp_present(compwav)) then +! ! Map 'ifrac' from FBfrac(compice) to FBfrac(compwav) +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ifrac', field=field_src, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ifrac', 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(compice,compwav,:), mapfcopy, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! +! ! Map 'ofrac' from FBfrac(compice) to FBfrac(compwav) +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ofrac', field=field_src, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ofrac', 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(compice,compwav,:), mapfcopy, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! endif +! call t_stopf('MED:'//trim(subname)//' fbfrac(compwav)') !PSH end ! ------------------------------------------- From baaf12cfc7f6921358eded55f669dede8c2829fc Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 28 Apr 2023 21:30:48 -0400 Subject: [PATCH 26/34] Removing stress from compice from Fwxx_taux --- mediator/esmFldsExchange_cesm_mod.F90 | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index ddf0570ce..9146ee728 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -3002,17 +3002,18 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !! if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') - call addfld_from(compice , 'Fioi_taux') +! call addfld_from(compice , 'Fioi_taux') call addfld_aoflux('Faox_taux') else if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then - if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then - call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') - end if +! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then +! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') +! call addmrg_to(compwav, 'Fwxx_taux', & +! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') +! end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if !PSH end From f1dedf5899b446b2fede15932eede85d5599b42d Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 9 May 2023 15:08:05 -0400 Subject: [PATCH 27/34] Changed Fwxx_taux merge to use 'wfrac' --- mediator/esmFldsExchange_cesm_mod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 9146ee728..068acb503 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -3012,7 +3012,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') ! end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='wfrac') +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if From 2685626c2c47d6801b72744c0ac90b98ace261a2 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 10 May 2023 12:58:00 -0400 Subject: [PATCH 28/34] Adding merge to wave component Fwxx_taux based on Foxx_taux --- mediator/esmFldsExchange_cesm_mod.F90 | 33 ++++++++++++--------------- 1 file changed, 15 insertions(+), 18 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 068acb503..87fdee38f 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2983,6 +2983,21 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_to(compwav , 'Fwxx_taux') + call addfld_from(compice , 'Fioi_taux') + call addfld_aoflux('Faox_taux') + else + if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then + if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then + call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') + call addmrg_to(compwav, 'Fwxx_taux', & + mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + end if + call addmrg_to(compocn, 'Fwxx_taux', & + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + end if + end if ! if (phase == 'advertise') then ! call addfld_to(compwav , 'Fwxx_taux') !! call addfld_from(compice , 'Fioi_taux') @@ -2999,24 +3014,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') ! end if ! end if -!! - if (phase == 'advertise') then - call addfld_to(compwav , 'Fwxx_taux') -! call addfld_from(compice , 'Fioi_taux') - call addfld_aoflux('Faox_taux') - else - if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then -! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then -! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') -! call addmrg_to(compwav, 'Fwxx_taux', & -! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') -! end if - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='wfrac') -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') - end if - end if !PSH end !===================================================================== From 9d4e81c5169b0a8ca750a063e3340882ab6225d3 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 10 May 2023 14:19:12 -0400 Subject: [PATCH 29/34] Fixed a compocn that should have been compwav --- mediator/esmFldsExchange_cesm_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 87fdee38f..397a92ba1 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2994,7 +2994,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compwav, 'Fwxx_taux', & mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') end if - call addmrg_to(compocn, 'Fwxx_taux', & + call addmrg_to(compwav, 'Fwxx_taux', & mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if From 3ca2795f9febd5422497a2c63f423e57e2cb4aaa Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 10 May 2023 15:21:48 -0400 Subject: [PATCH 30/34] Adding ifrac and ofrac to fraclist_w --- mediator/med_fraction_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 2a410aace..ded0e4e7d 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -130,8 +130,8 @@ module med_fraction_mod character(len=6),parameter,dimension(2) :: fraclist_g = (/'gfrac ','lfrac '/) character(len=6),parameter,dimension(2) :: fraclist_r = (/'rfrac ','lfrac '/) !PSH begin - character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) -! character(len=6),parameter,dimension(3) :: fraclist_w = (/'ifrac ','ofrac ','wfrac '/) +! character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) + character(len=6),parameter,dimension(3) :: fraclist_w = (/'ifrac ','ofrac ','wfrac '/) !PSH end !--- standard --- real(R8) , parameter :: eps_fraclim = 1.0e-03 ! truncation limit in fractions_a(lfrac) From a587023727e73bbdffec5b8daff5bcb93385e670 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 May 2023 14:20:46 -0600 Subject: [PATCH 31/34] updates for new stresses sent to wave --- mediator/esmFldsExchange_cesm_mod.F90 | 34 +-- mediator/med_phases_aofluxes_mod.F90 | 29 ++- mediator/med_phases_prep_wav_mod.F90 | 333 +------------------------- 3 files changed, 44 insertions(+), 352 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 397a92ba1..8ff5f95f4 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2983,28 +2983,28 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- - if (phase == 'advertise') then + if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') - call addfld_from(compice , 'Fioi_taux') - call addfld_aoflux('Faox_taux') - else - if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then - if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then - call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') - end if - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') - end if + ! call addfld_from(compice , 'Fioi_taux') + ! call addfld_aoflux('Faox_taux') + else + ! if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then + ! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then + ! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') + ! call addmrg_to(compwav, 'Fwxx_taux', & + ! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + ! end if + ! call addmrg_to(compwav, 'Fwxx_taux', & + ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + ! end if end if -! if (phase == 'advertise') then +! if (phase == 'advertise') then ! call addfld_to(compwav , 'Fwxx_taux') !! call addfld_from(compice , 'Fioi_taux') ! call addfld_aoflux('Faox_taux') -! else -! if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then -!! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then +! else +! if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then +!! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then !! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') !! call addmrg_to(compwav, 'Fwxx_taux', & !! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index b3acbdeb4..608ad18b0 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -27,7 +27,7 @@ module med_phases_aofluxes_mod use ESMF , only : ESMF_XGridGet, ESMF_MeshCreate, ESMF_MeshWrite, ESMF_KIND_R8 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, mastertask, logunit - use med_internalstate_mod , only : compatm, compocn, coupling_mode, aoflux_code, mapconsd, mapconsf, mapfcopy + use med_internalstate_mod , only : compatm, compocn, compwav, coupling_mode, aoflux_code, mapconsd, mapconsf, mapfcopy use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_chkerr @@ -492,6 +492,7 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) use esmFlds , only : med_fldlist_GetaofluxfldList use esmFlds , only : med_fldList_type use med_map_mod , only : med_map_packed_field_create + use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk ! Arguments type(ESMF_GridComp) , intent(inout) :: gcomp @@ -509,6 +510,7 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Mesh) :: lmesh real(R8), pointer :: garea(:) => null() type(ESMF_CoordSys_Flag) :: coordSys + integer :: maptype character(len=*),parameter :: subname=' (med_aofluxes_init_ocngrid) ' !----------------------------------------------------------------------- @@ -571,7 +573,6 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) if (is_local%wrap%aoflux_grid == 'ogrid') then if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o) .and. & ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a)) then - call med_map_packed_field_create(destcomp=compatm, & flds_scalar_name=is_local%wrap%flds_scalar_name, & fieldsSrc=fldListMed_aoflux, & @@ -579,7 +580,6 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) FBDst=is_local%wrap%FBMed_aoflux_a, & packed_data=is_local%wrap%packed_data_aoflux_o2a(:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if end if @@ -957,6 +957,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) use ESMF , only : ESMF_GridComp use ESMF , only : ESMF_LogWrite, ESMF_LogMsg_Info, ESMF_SUCCESS use med_map_mod , only : med_map_field_packed, med_map_rh_is_created + use med_map_mod , only : med_map_routehandles_init + use med_methods_mod, only : FB_fldchk => med_methods_FB_fldchk + use med_methods_mod, only : FB_diagnose => med_methods_FB_diagnose #ifdef CESMCOUPLED use shr_flux_mod , only : flux_atmocn #else @@ -1129,6 +1132,26 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) end if + ! map aoflux fields to wav grid if stresses are needed on the wave grid + if ( FB_fldchk(is_local%wrap%FBExp(compwav), 'Fwxx_taux', rc=rc)) then + maptype = mapconsf + if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:), maptype, rc=rc)) then + call med_map_routehandles_init( compocn, compwav, & + FBSrc=is_local%wrap%FBImp(compocn,compocn), & + FBDst=is_local%wrap%FBImp(compwav,compwav), & + 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%FBMed_aoflux_o, 'Faox_taux', field=field_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBExp(compwav), 'Fwxx_taux', field=field_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegrid(field_src, field_dst, & + routehandle=is_local%wrap%RH(compocn, compwav, maptype), & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + call t_stopf('MED:'//subname) end subroutine med_aofluxes_update diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 3ed57c00d..4fdd630ea 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -13,20 +13,12 @@ module med_phases_prep_wav_mod use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose -!PSH begin - use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk - use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr -!PSH end use med_methods_mod , only : FB_accum => med_methods_FB_accum use med_methods_mod , only : FB_average => med_methods_FB_average use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset -!PSH begin use esmFlds , only : med_fldList_GetfldListTo use med_internalstate_mod , only : compwav -! use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type -! use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode -!PSH end use perf_mod , only : t_startf, t_stopf implicit none @@ -36,10 +28,6 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_accum ! called from run sequence public :: med_phases_prep_wav_avg ! called from run sequence -!PSH begin -! private :: med_phases_prep_wav_custom_cesm -!PSH end - character(*), parameter :: u_FILE_u = & __FILE__ @@ -94,9 +82,6 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n, ncnt -!PSH begin -! type(med_fldlist_type), pointer :: fldList -!PSH end character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' !--------------------------------------- @@ -111,33 +96,15 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -!PSH begin -! fldList => med_fldList_GetfldListTo(compwav) -!PSH end + ! auto merges to wav -!PSH begin call med_merge_auto(& is_local%wrap%med_coupling_active(:,compwav), & is_local%wrap%FBExp(compwav), & is_local%wrap%FBFrac(compwav), & is_local%wrap%FBImp(:,compwav), & med_fldList_GetfldListTo(compwav), rc=rc) -! call med_merge_auto(& -! is_local%wrap%med_coupling_active(:,compwav), & -! is_local%wrap%FBExp(compwav), & -! is_local%wrap%FBFrac(compwav), & -! is_local%wrap%FBImp(:,compwav), & -! fldList, & -! FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) -!PSH end if (ChkErr(rc,__LINE__,u_FILE_u)) return -!PSH begin -! ! custom merges to ocean -! if (trim(coupling_mode) == 'cesm') then -! call med_phases_prep_wav_custom_cesm(gcomp, rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -!PSH end ! wave accumulator call FB_accum(is_local%wrap%FBExpAccumWav, is_local%wrap%FBExp(compwav), rc=rc) @@ -223,302 +190,4 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_prep_wav_avg - !----------------------------------------------------------------------------- -! subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) -! -! !--------------------------------------- -! ! custom calculations for cesm -! !--------------------------------------- -! -! use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet -! use ESMF , only : ESMF_VMBroadCast -! use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS -! use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR -! -! ! input/output variables -! type(ESMF_GridComp) :: gcomp -! integer, intent(out) :: rc -! -! ! local variables -! type(InternalState) :: is_local -! type(ESMF_Field) :: lfield -! real(R8), pointer :: ifrac(:) -! real(R8), pointer :: ofrac(:) -! real(R8), pointer :: ifracr(:) -! real(R8), pointer :: ofracr(:) -! real(R8), pointer :: avsdr(:) -! real(R8), pointer :: avsdf(:) -! real(R8), pointer :: anidr(:) -! real(R8), pointer :: anidf(:) -! real(R8), pointer :: Faxa_swvdf(:) -! real(R8), pointer :: Faxa_swndf(:) -! real(R8), pointer :: Faxa_swvdr(:) -! real(R8), pointer :: Faxa_swndr(:) -! real(R8), pointer :: Foxx_swnet(:) -! real(R8), pointer :: Foxx_swnet_afracr(:) -! real(R8), pointer :: Foxx_swnet_vdr(:) -! real(R8), pointer :: Foxx_swnet_vdf(:) -! real(R8), pointer :: Foxx_swnet_idr(:) -! real(R8), pointer :: Foxx_swnet_idf(:) -! real(R8), pointer :: Fioi_swpen_vdr(:) -! real(R8), pointer :: Fioi_swpen_vdf(:) -! real(R8), pointer :: Fioi_swpen_idr(:) -! real(R8), pointer :: Fioi_swpen_idf(:) -! real(R8), pointer :: Fioi_swpen(:) -! real(R8), pointer :: dataptr(:) -! real(R8), pointer :: dataptr_scalar_ocn(:,:) -! real(R8) :: frac_sum -! real(R8) :: ifrac_scaled, ofrac_scaled -! real(R8) :: ifracr_scaled, ofracr_scaled -! logical :: export_swnet_by_bands -! logical :: import_swpen_by_bands -! logical :: export_swnet_afracr -! real(R8) :: precip_fact(1) -! character(CS) :: cvalue -! real(R8) :: fswabsv, fswabsi -! integer :: scalar_id -! integer :: n -! integer :: lsize -! real(R8) :: c1,c2,c3,c4 -! character(len=64), allocatable :: fldnames(:) -! character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' -! !--------------------------------------- -! -! rc = ESMF_SUCCESS -! -! call t_startf('MED:'//subname) -! if (dbug_flag > 20) then -! call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) -! end if -! call memcheck(subname, 5, mastertask) -! -! ! Get the internal state -! nullify(is_local%wrap) -! call ESMF_GridCompGetInternalState(gcomp, is_local, rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! -! !--------------------------------------- -! ! Compute netsw for ocean -! !--------------------------------------- -! ! netsw_for_ocn = downsw_from_atm * (1-ocn_albedo) * (1-ice_fraction) + pensw_from_ice * (ice_fraction) -! -! ! Input from atm -! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swvdr', Faxa_swvdr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swndr', Faxa_swndr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swvdf', Faxa_swvdf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swndf', Faxa_swndf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! lsize = size(Faxa_swvdr) -! -! ! Input from mediator, ocean albedos -! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_avsdr' , avsdr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_anidr' , anidr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_avsdf' , avsdf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_anidf' , anidf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! -! ! Output to ocean swnet total -! if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet', Foxx_swnet, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! else -! lsize = size(Faxa_swvdr) -! allocate(Foxx_swnet(lsize)) -! end if -! -! ! Output to ocean swnet by radiation bands -! if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc)) then -! export_swnet_by_bands = .true. -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', Foxx_swnet_vdr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', Foxx_swnet_vdf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', Foxx_swnet_idr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', Foxx_swnet_idf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! else -! export_swnet_by_bands = .false. -! end if -! -! ! ----------------------- -! ! If cice IS NOT PRESENT -! ! ----------------------- -! if (.not. is_local%wrap%comp_present(compice)) then -! ! Compute total swnet to ocean independent of swpen from sea-ice -! do n = 1,lsize -! fswabsv = Faxa_swvdr(n) * (1.0_R8 - avsdr(n)) + Faxa_swvdf(n) * (1.0_R8 - avsdf(n)) -! fswabsi = Faxa_swndr(n) * (1.0_R8 - anidr(n)) + Faxa_swndf(n) * (1.0_R8 - anidf(n)) -! Foxx_swnet(n) = fswabsv + fswabsi -! end do -! ! Compute sw export to ocean bands if required -! if (export_swnet_by_bands) then -! c1 = 0.285; c2 = 0.285; c3 = 0.215; c4 = 0.215 -! Foxx_swnet_vdr(:) = c1 * Foxx_swnet(:) -! Foxx_swnet_vdf(:) = c2 * Foxx_swnet(:) -! Foxx_swnet_idr(:) = c3 * Foxx_swnet(:) -! Foxx_swnet_idf(:) = c4 * Foxx_swnet(:) -! end if -! end if -! -! ! ----------------------- -! ! If cice IS PRESENT -! ! ----------------------- -! if (is_local%wrap%comp_present(compice)) then -! -! ! Input from mediator, ice-covered ocean and open ocean fractions -! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrac' , ifrac, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac' , ofrac, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrad' , ifracr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrad' , ofracr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! -! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen', Fioi_swpen, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! if (FB_fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdr', rc=rc)) then -! import_swpen_by_bands = .true. -! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_vdr', Fioi_swpen_vdr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_vdf', Fioi_swpen_vdf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_idr', Fioi_swpen_idr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_idf', Fioi_swpen_idf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! else -! import_swpen_by_bands = .false. -! end if -! -! if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr',rc=rc)) then -! ! Swnet without swpen from sea-ice -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr', Foxx_swnet_afracr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! export_swnet_afracr = .true. -! else -! export_swnet_afracr = .false. -! end if -! -! do n = 1,lsize -! ! Compute total swnet to ocean independent of swpen from sea-ice -! fswabsv = Faxa_swvdr(n) * (1.0_R8 - avsdr(n)) + Faxa_swvdf(n) * (1.0_R8 - avsdf(n)) -! fswabsi = Faxa_swndr(n) * (1.0_R8 - anidr(n)) + Faxa_swndf(n) * (1.0_R8 - anidf(n)) -! Foxx_swnet(n) = fswabsv + fswabsi -! -! ! Add swpen from sea ice -! ifrac_scaled = ifrac(n) -! ofrac_scaled = ofrac(n) -! frac_sum = ifrac(n) + ofrac(n) -! if (frac_sum /= 0._R8) then -! ifrac_scaled = ifrac(n) / (frac_sum) -! ofrac_scaled = ofrac(n) / (frac_sum) -! endif -! ifracr_scaled = ifracr(n) -! ofracr_scaled = ofracr(n) -! frac_sum = ifracr(n) + ofracr(n) -! if (frac_sum /= 0._R8) then -! ifracr_scaled = ifracr(n) / (frac_sum) -! ofracr_scaled = ofracr(n) / (frac_sum) -! endif -! Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) -! -! if (export_swnet_afracr) then -! Foxx_swnet_afracr(n) = ofracr_scaled*(fswabsv + fswabsi) -! end if -! -! ! Compute sw export to ocean bands if required -! if (export_swnet_by_bands) then -! if (import_swpen_by_bands) then -! ! use each individual band for swpen coming from the sea-ice -! Foxx_swnet_vdr(n) = Faxa_swvdr(n)*(1.0_R8-avsdr(n))*ofracr_scaled + Fioi_swpen_vdr(n)*ifrac_scaled -! Foxx_swnet_vdf(n) = Faxa_swvdf(n)*(1.0_R8-avsdf(n))*ofracr_scaled + Fioi_swpen_vdf(n)*ifrac_scaled -! Foxx_swnet_idr(n) = Faxa_swndr(n)*(1.0_R8-anidr(n))*ofracr_scaled + Fioi_swpen_idr(n)*ifrac_scaled -! Foxx_swnet_idf(n) = Faxa_swndf(n)*(1.0_R8-anidf(n))*ofracr_scaled + Fioi_swpen_idf(n)*ifrac_scaled -! else -! ! scale total Foxx_swnet to get contributions from each band -! c1 = 0.285; c2 = 0.285; c3 = 0.215; c4 = 0.215 -! Foxx_swnet_vdr(n) = c1 * Foxx_swnet(n) -! Foxx_swnet_vdf(n) = c2 * Foxx_swnet(n) -! Foxx_swnet_idr(n) = c3 * Foxx_swnet(n) -! Foxx_swnet_idf(n) = c4 * Foxx_swnet(n) -! end if -! end if -! end do -! -! ! Output to ocean per ice thickness fraction and sw penetrating into ocean -! if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Sf_afrac', rc=rc)) then -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afrac', fldptr1=dataptr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! dataptr(:) = ofrac(:) -! end if -! if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Sf_afracr', rc=rc)) then -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afracr', fldptr1=dataptr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! dataptr(:) = ofracr(:) -! end if -! -! end if ! if sea-ice is present -! -! ! Deallocate Foxx_swnet if it was allocated in this subroutine -! if (.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then -! deallocate(Foxx_swnet) -! end if -! -! ! Apply precipitation factor from ocean (that scales atm rain and snow back to ocn ) if appropriate -! if (trim(coupling_mode) == 'cesm' .and. is_local%wrap%flds_scalar_index_precip_factor /= 0) then -! -! ! Note that in med_internal_mod.F90 all is_local%wrap%flds_scalar_index_precip_factor -! ! is initialized to 0. -! ! In addition, in med.F90, if this attribute is not present as a mediator component attribute, -! ! it is set to 0. -! if (mastertask) then -! call ESMF_StateGet(is_local%wrap%NstateImp(compocn), & -! itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc) -! if (chkerr(rc,__LINE__,u_FILE_u)) return -! call ESMF_FieldGet(lfield, farrayPtr=dataptr_scalar_ocn, rc=rc) -! if (chkerr(rc,__LINE__,u_FILE_u)) return -! scalar_id=is_local%wrap%flds_scalar_index_precip_factor -! precip_fact(1) = dataptr_scalar_ocn(scalar_id,1) -! if (precip_fact(1) /= 1._r8) then -! write(logunit,'(a,f21.13)')& -! '(merge_to_ocn): Scaling rain, snow, liquid and ice runoff by non-unity precip_fact ',& -! precip_fact(1) -! end if -! end if -! call ESMF_VMBroadCast(is_local%wrap%vm, precip_fact, 1, 0, rc=rc) -! if (chkerr(rc,__LINE__,u_FILE_u)) return -! is_local%wrap%flds_scalar_precip_factor = precip_fact(1) -! if (dbug_flag > 5) then -! write(cvalue,*) precip_fact(1) -! call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO) -! end if -! -! ! Scale rain and snow to ocn from atm by the precipitation factor received from the ocean -! allocate(fldnames(4)) -! fldnames = (/'Faxa_rain', 'Faxa_snow', 'Foxx_rofl', 'Foxx_rofi'/) -! do n = 1,size(fldnames) -! if (FB_fldchk(is_local%wrap%FBExp(compocn), trim(fldnames(n)), rc=rc)) then -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), trim(fldnames(n)) , dataptr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! dataptr(:) = dataptr(:) * is_local%wrap%flds_scalar_precip_factor -! end if -! end do -! deallocate(fldnames) -! end if -! -! if (dbug_flag > 20) then -! call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) -! end if -! call t_stopf('MED:'//subname) -! -! end subroutine med_phases_prep_wav_custom_cesm - end module med_phases_prep_wav_mod From ca8ca8bbf7517b130b8fddefd3849eec7f00a856 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 May 2023 14:40:36 -0600 Subject: [PATCH 32/34] udpates needed to pass taux and tauxy to wave --- mediator/esmFldsExchange_cesm_mod.F90 | 48 +------ mediator/fd_cesm.yaml | 18 +-- mediator/med_fraction_mod.F90 | 200 +------------------------- mediator/med_phases_aofluxes_mod.F90 | 15 +- 4 files changed, 26 insertions(+), 255 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 99f362f37..13811aec9 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2985,58 +2985,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compwav, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') end if end if -!PSH begin -! if (phase == 'advertise') then -! call addfld_from(compocn, 'So_ofrac') -! call addfld_to(compwav, 'So_ofrac') -! end if -! if (phase == 'advertise') then -! call addfld_from(compocn, 'So_ofrac') -! call addfld_to(compwav, 'So_ofrac') -! else -! if ( fldchk(is_local%wrap%FBexp(compwav) , 'So_ofrac', rc=rc) .and. & -! fldchk(is_local%wrap%FBImp(compice,compice ), 'So_ofrac', rc=rc)) then -! ! By default will be using a custom map - but if one is not available, use a generated bilinear instead -! call addmap_from(compice, 'Si_ifrac', compwav, mapbilnr, 'one', ice2wav_smap) -! call addmrg_to(compwav, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') -! end if -! end if ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') - ! call addfld_from(compice , 'Fioi_taux') - ! call addfld_aoflux('Faox_taux') - else - ! if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then - ! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then - ! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') - ! call addmrg_to(compwav, 'Fwxx_taux', & - ! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') - ! end if - ! call addmrg_to(compwav, 'Fwxx_taux', & - ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') - ! end if - end if -! if (phase == 'advertise') then -! call addfld_to(compwav , 'Fwxx_taux') -!! call addfld_from(compice , 'Fioi_taux') -! call addfld_aoflux('Faox_taux') -! else -! if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then -!! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then -!! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') -!! call addmrg_to(compwav, 'Fwxx_taux', & -!! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') -!! end if -! call addmrg_to(compwav, 'Fwxx_taux', & -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') -!! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') -! end if -! end if -!PSH end + call addfld_to(compwav , 'Fwxx_tauy') + end if !===================================================================== ! FIELDS TO RIVER (comprof) diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 060015656..c09a63c58 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1176,24 +1176,20 @@ canonical_units: m2/s description: wave elevation spectrum -#PSH begin - # + # #----------------------------------- # section: wave import #----------------------------------- - # - - # + # - standard_name: Fwxx_taux alias: mean_zonal_moment_flx canonical_units: N m-2 description: wave import - zonal surface stress - # -# - standard_name: Fwxx_tauy -# alias: mean_merid_moment_flx -# canonical_units: N m-2 -# description: wave import - meridional surface stress -#PSH end + # + - standard_name: Fwxx_tauy + alias: mean_merid_moment_flx + canonical_units: N m-2 + description: wave import - meridional surface stress #----------------------------------- # mediator fields diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 5331a5452..2fd83972a 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -23,11 +23,8 @@ module med_fraction_mod ! character(*),parameter :: fraclist_l = 'lfrac' ! character(*),parameter :: fraclist_g = 'gfrac:lfrac' ! character(*),parameter :: fraclist_r = 'lfrac:rfrac' - ! character(*),parameter :: fraclist_w = 'ifrac:ofrac:wfrac' -!PSH begin ! -! ! we assume ocean and ice are on the same grids, same masks - ! we assume ocean, ice, and waves are on the same grids, same masks -!PSH end + ! + ! we assume ocean and ice are on the same grids, same masks ! we assume ocn2atm and ice2atm are masked maps ! we assume lnd2atm is a global map ! we assume that the ice fraction evolves in time but that @@ -129,10 +126,8 @@ module med_fraction_mod 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 '/) -!PSH begin -! character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) - character(len=6),parameter,dimension(3) :: fraclist_w = (/'ifrac ','ofrac ','wfrac '/) -!PSH end + character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) + !--- standard --- real(R8) , parameter :: eps_fraclim = 1.0e-03 ! truncation limit in fractions_a(lfrac) character(*), parameter :: u_FILE_u = & @@ -588,86 +583,6 @@ subroutine med_fraction_init(gcomp, rc) endif endif -!PSH Begin - In progress... -! Note: started this section, based on setting ifrac and ofrac for compatm, but it is not -! clear to me that this approach is correct, since we can assume ocn, ice, wav are all on -! the same grid. Commenting out for now, can delete once I'm confident other approach -! works -! !--------------------------------------- -! ! Set 'ofrac' in FBFrac(compwav) -! !--------------------------------------- -! -! if ( is_local%wrap%comp_present(compocn) .and. & -! is_local%wrap%comp_present(compwav) .and. & -! is_local%wrap%med_coupling_active(compocn,compwav)) then -! -! ! Set 'ofrac' in FBFrac(compwav) - at this point this is the -! ! ocean mask mapped to the atm grid This is mapping the ocean mask to -! ! the wav grid -! -! if (med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),mapfcopy, rc=rc)) then -! ! If ocn and atm are on the same mesh - a redist route handle has already been created -! maptype = mapfcopy -! else -! if (trim(coupling_mode) == 'nems_orig' ) then -! maptype = mapnstod_consd -! else -! maptype = mapconsd -! end if -! if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),maptype, rc=rc)) then -! call med_map_routehandles_init( compocn, compwav, & -! FBSrc=is_local%wrap%FBImp(compocn,compocn), & -! FBDst=is_local%wrap%FBImp(compocn,compwav), & -! mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! end if -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compocn), fieldname='ofrac', field=field_src, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), fieldname='ofrac', 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(compocn,compwav,:), maptype, rc=rc) -! if (chkerr(rc,__LINE__,u_FILE_u)) return -! -! end if -! -! !--------------------------------------- -! ! Set 'ifrac' in FBFrac(compwav) -! !--------------------------------------- -! -! if ( is_local%wrap%comp_present(compice) .and. & -! is_local%wrap%comp_present(compwav) .and. & -! is_local%wrap%med_coupling_active(compice,compwav)) then -! -! ! Set 'ifrac' in FBFrac(compwav) - at this point this is the ice mask mapped to the wav mesh -! ! This maps the ice mask (which is the same as the ocean mask) to the wav mesh -! if (med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),mapfcopy, rc=rc)) then -! ! If ice and wav are on the same mesh - a redist route handle has already been created -! maptype = mapfcopy -! else -! if (trim(coupling_mode) == 'nems_orig' ) then -! maptype = mapnstod_consd -! else -! maptype = mapconsd -! end if -! if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),maptype, rc=rc)) then -! call med_map_routehandles_init( compice, compwav, & -! FBSrc=is_local%wrap%FBImp(compice,compice), & -! FBDst=is_local%wrap%FBImp(compice,compwav), & -! mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! end if -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ifrac', field=field_src, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ifrac', 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(compice,compwav,:), maptype, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! -!PSH end - !--------------------------------------- ! Create route handles ocn<->ice if not created !--------------------------------------- @@ -703,80 +618,6 @@ subroutine med_fraction_init(gcomp, rc) end if end if -!PSH begin -! !--------------------------------------- -! ! Create route handles ocn<->wav if not created -! !--------------------------------------- -! -! if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compocn)) then -! if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compocn,:),mapfcopy, rc=rc)) then -! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compocn))) then -! call fldbun_init(is_local%wrap%FBImp(compwav,compocn), is_local%wrap%flds_scalar_name, & -! STgeom=is_local%wrap%NStateImp(compocn), & -! STflds=is_local%wrap%NStateImp(compwav), & -! name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compocn)), rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! call med_map_routehandles_init(compwav, compocn, & -! FBSrc=is_local%wrap%FBImp(compwav,compocn), & -! FBDst=is_local%wrap%FBImp(compwav,compocn), & -! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),mapfcopy, rc=rc)) then -! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compwav))) then -! call fldbun_init(is_local%wrap%FBImp(compocn,compwav), is_local%wrap%flds_scalar_name, & -! STgeom=is_local%wrap%NStateImp(compwav), & -! STflds=is_local%wrap%NStateImp(compocn), & -! name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compwav)), rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! call med_map_routehandles_init( compocn, compwav, & -! FBSrc=is_local%wrap%FBImp(compocn,compocn), & -! FBDst=is_local%wrap%FBImp(compocn,compwav), & -! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! end if -! -! !--------------------------------------- -! ! Create route handles ice<->wav if not created -! !--------------------------------------- -! -! if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compice)) then -! if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compice,:),mapfcopy, rc=rc)) then -! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compice))) then -! call fldbun_init(is_local%wrap%FBImp(compwav,compice), is_local%wrap%flds_scalar_name, & -! STgeom=is_local%wrap%NStateImp(compice), & -! STflds=is_local%wrap%NStateImp(compwav), & -! name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compice)), rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! call med_map_routehandles_init(compwav, compice, & -! FBSrc=is_local%wrap%FBImp(compwav,compice), & -! FBDst=is_local%wrap%FBImp(compwav,compice), & -! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),mapfcopy, rc=rc)) then -! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compice,compwav))) then -! call fldbun_init(is_local%wrap%FBImp(compice,compwav), is_local%wrap%flds_scalar_name, & -! STgeom=is_local%wrap%NStateImp(compwav), & -! STflds=is_local%wrap%NStateImp(compice), & -! name='FBImp'//trim(compname(compice))//'_'//trim(compname(compwav)), rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! call med_map_routehandles_init( compice, compwav, & -! FBSrc=is_local%wrap%FBImp(compice,compice), & -! FBDst=is_local%wrap%FBImp(compice,compwav), & -! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! end if -! -!PSH end - - !--------------------------------------- ! Diagnostic output !--------------------------------------- @@ -807,10 +648,7 @@ subroutine med_fraction_set(gcomp, rc) use ESMF , only : ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldBundleIsCreated use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS -!PSH Begin -! use med_internalstate_mod , only : compatm, compocn, compice, compname - use med_internalstate_mod , only : compatm, compocn, compice, compname, compwav -!PSH End + use med_internalstate_mod , only : compatm, compocn, compice, compname use med_internalstate_mod , only : mapfcopy, mapconsd, mapnstod_consd use med_internalstate_mod , only : coupling_mode use med_internalstate_mod , only : InternalState @@ -913,34 +751,6 @@ subroutine med_fraction_set(gcomp, rc) endif call t_stopf('MED:'//trim(subname)//' fbfrac(compocn)') -!PSH begin -! ! ------------------------------------------- -! ! Set FBfrac(compwav) -! ! ------------------------------------------- -! -! ! The following is just a redistribution from FBFrac(compice) -! -! call t_startf('MED:'//trim(subname)//' fbfrac(compwav)') -! if (is_local%wrap%comp_present(compwav)) then -! ! Map 'ifrac' from FBfrac(compice) to FBfrac(compwav) -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ifrac', field=field_src, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ifrac', 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(compice,compwav,:), mapfcopy, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! -! ! Map 'ofrac' from FBfrac(compice) to FBfrac(compwav) -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ofrac', field=field_src, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ofrac', 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(compice,compwav,:), mapfcopy, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! endif -! call t_stopf('MED:'//trim(subname)//' fbfrac(compwav)') -!PSH end - ! ------------------------------------------- ! Set FBfrac(compatm) ! ------------------------------------------- diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index ae38f995c..de3fd21a5 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -503,8 +503,8 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Field) :: lfield type(ESMF_Mesh) :: lmesh real(R8), pointer :: garea(:) => null() - type(ESMF_CoordSys_Flag) :: coordSys integer :: maptype + type(ESMF_CoordSys_Flag) :: coordSys character(len=*),parameter :: subname=' (med_aofluxes_init_ocngrid) ' !----------------------------------------------------------------------- @@ -1120,8 +1120,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) end if - ! map aoflux fields to wav grid if stresses are needed on the wave grid - if ( FB_fldchk(is_local%wrap%FBExp(compwav), 'Fwxx_taux', rc=rc)) then + ! map taux and tauy from ocean to wave grid if stresses are needed on the wave grid + if ( FB_fldchk(is_local%wrap%FBExp(compwav), 'Fwxx_taux', rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compwav), 'Fwxx_tauy', rc=rc)) then maptype = mapconsf if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:), maptype, rc=rc)) then call med_map_routehandles_init( compocn, compwav, & @@ -1138,6 +1139,14 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) routehandle=is_local%wrap%RH(compocn, compwav, maptype), & termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBMed_aoflux_o, 'Faox_tauy', field=field_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBExp(compwav), 'Fwxx_tauy', field=field_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegrid(field_src, field_dst, & + routehandle=is_local%wrap%RH(compocn, compwav, maptype), & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if call t_stopf('MED:'//subname) From d64ffe9bdf1be421a8bdb7b730355386b81e7cc7 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 May 2023 15:06:49 -0600 Subject: [PATCH 33/34] fixed compile bugs --- mediator/med_phases_aofluxes_mod.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index de3fd21a5..46c7c93f7 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -975,6 +975,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) real(r8), parameter :: p0 = 100000.0_r8 ! reference pressure in Pa real(r8), parameter :: rcp = 0.286_r8 ! gas constant of air / specific heat capacity at a constant pressure real(r8), parameter :: rdair = 287.058_r8 ! dry air gas constant in J/K/kg + integer :: maptype + type(ESMF_Field) :: field_src + type(ESMF_Field) :: field_dst character(*),parameter :: subName = '(med_aofluxes_update) ' !----------------------------------------------------------------------- From 488b8d9f1cd7f25a1c7344bd8b3268ccc2c5dffd Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 May 2023 15:28:07 -0600 Subject: [PATCH 34/34] fixed compile bugs --- mediator/med_phases_aofluxes_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 46c7c93f7..48055e92e 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -503,7 +503,6 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Field) :: lfield type(ESMF_Mesh) :: lmesh real(R8), pointer :: garea(:) => null() - integer :: maptype type(ESMF_CoordSys_Flag) :: coordSys character(len=*),parameter :: subname=' (med_aofluxes_init_ocngrid) ' !-----------------------------------------------------------------------