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/61] 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 149c7791..f53d9e38 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 648a4fed..d6a28124 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/61] 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 f53d9e38..a9e556de 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/61] 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 a9e556de..88123557 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/61] 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 88123557..4ee196f5 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 d6a28124..9d2d873b 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/61] 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 4fdd630e..578b2837 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/61] 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 578b2837..3a99f295 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 f126b9f1c33dc8421a5520289ab3e515a4cd153c Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 19 Apr 2023 16:32:24 -0600 Subject: [PATCH 07/61] update the minimum esmf version requirement --- cime_config/buildnml | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 6b76da00..9d06b0ca 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -620,14 +620,7 @@ def buildnml(case, caseroot, component): major = line[-2] if "MAJOR" in line else major minor = line[-2] if "MINOR" in line else minor logger.debug("ESMF version major {} minor {}".format(major, minor)) - expect(int(major) >= 8, "ESMF version should be 8.1 or newer") - if esmf_aware_threading: - expect( - int(minor) >= 2, - "ESMF version should be 8.2.0 or newer when using ESMF_AWARE_THREADING", - ) - else: - expect(int(minor) >= 1, "ESMF version should be 8.1.0 or newer") + expect(int(major) >= 8 and int(minor) >=4, "ESMF version should be 8.4.1 or newer") confdir = os.path.join(case.get_value("CASEBUILD"), "cplconf") if not os.path.isdir(confdir): 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 08/61] 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 3a99f295..fa6e6617 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 09/61] 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 4ee196f5..56604056 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 10/61] 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 56604056..897e942a 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 11/61] 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 897e942a..42bb327e 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 12/61] 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 fa6e6617..eb89bde2 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 13/61] 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 42bb327e..bf8fe952 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 14/61] 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 bf8fe952..42bb327e 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 eb89bde2..fa6e6617 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 15/61] 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 42bb327e..94028de1 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 16/61] 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 fa6e6617..196ca724 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 17/61] 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 196ca724..3ed57c00 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 18/61] 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 94028de1..ddf0570c 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 19/61] 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 ddf0570c..b3b0f56c 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 20/61] 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 521ba000..7cc5c020 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 21/61] 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 b3b0f56c..ddf0570c 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 22/61] 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 7cc5c020..c97fb899 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 962646ae8d45d94cb83cd27c7f08a4c190a260b8 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 28 Apr 2023 13:07:30 -0600 Subject: [PATCH 23/61] improves the readability of salt budget --- cesm/driver/esm.F90 | 2 +- mediator/med_diag_mod.F90 | 8 +++++--- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index a98976f2..b5207955 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -796,7 +796,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #ifndef NO_MPI2 use mpi , only : MPI_COMM_NULL, mpi_comm_size #endif - use mct_mod , only : mct_world_init + use m_MCTWorld , only : mct_world_init => init #ifdef MED_PRESENT use med_internalstate_mod , only : med_id diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 802334f6..8ea6651e 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -95,6 +95,8 @@ module med_diag_mod character(*), parameter :: FA1 = "(' ',a12,6f15.8)" character(*), parameter :: FA0r = "(' ',12x,8(6x,a8,1x))" character(*), parameter :: FA1r = "(' ',a12,8f15.8)" + character(*), parameter :: FA0s = "(' ',12x,8(7x,a8,2x))" + character(*), parameter :: FA1s = "(' ',a12,8g18.8)" ! --------------------------------- ! C for component @@ -2683,7 +2685,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) write(diagunit,*) ' ' write(diagunit,FAH) subname,'NET SALT BUDGET (kg/m2s): period = ',& trim(budget_diags%periods(ip)%name), ': date = ',date,tod - write(diagunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' + write(diagunit,FA0s) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' do nf = f_salt_beg, f_salt_end net_salt_atm = data(nf, c_atm_recv, ip) + data(nf, c_atm_send, ip) net_salt_lnd = data(nf, c_lnd_recv, ip) + data(nf, c_lnd_send, ip) @@ -2695,7 +2697,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) net_salt_tot = net_salt_atm + net_salt_lnd + net_salt_rof + net_salt_ocn + & net_salt_ice_nh + net_salt_ice_sh + net_salt_glc - write(diagunit,FA1r) budget_diags%fields(nf)%name,& + write(diagunit,FA1s) budget_diags%fields(nf)%name,& net_salt_atm, net_salt_lnd, net_salt_rof, net_salt_ocn, & net_salt_ice_nh, net_salt_ice_sh, net_salt_glc, net_salt_tot enddo @@ -2718,7 +2720,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) sum_net_salt_tot = sum_net_salt_atm + sum_net_salt_lnd + sum_net_salt_rof + sum_net_salt_ocn + & sum_net_salt_ice_nh + sum_net_salt_ice_sh + sum_net_salt_glc - write(diagunit,FA1r)' *SUM*',& + write(diagunit,FA1s)' *SUM*',& sum_net_salt_atm, sum_net_salt_lnd, sum_net_salt_rof, sum_net_salt_ocn, & sum_net_salt_ice_nh, sum_net_salt_ice_sh, sum_net_salt_glc, sum_net_salt_tot end if From f80e7d74337e52a7fb8d4164c78e34cdcdbae6f3 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 28 Apr 2023 13:08:34 -0600 Subject: [PATCH 24/61] undo accidental commit --- cesm/driver/esm.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index b5207955..a98976f2 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -796,7 +796,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #ifndef NO_MPI2 use mpi , only : MPI_COMM_NULL, mpi_comm_size #endif - use m_MCTWorld , only : mct_world_init => init + use mct_mod , only : mct_world_init #ifdef MED_PRESENT use med_internalstate_mod , only : med_id 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 25/61] 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 c97fb899..ed11d33f 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 26/61] 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 ed11d33f..da379de1 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 27/61] 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 da379de1..3a5ac5a2 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 28/61] 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 3a5ac5a2..2a410aac 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 29/61] 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 ddf0570c..9146ee72 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 24f419cd2d54ad57adeefc976d643a89e13a018b Mon Sep 17 00:00:00 2001 From: James Edwards Date: Sat, 29 Apr 2023 12:55:30 -0500 Subject: [PATCH 30/61] turn off HierarchyProtocol, not used in cesm this is a memory and initialization time saver --- cesm/driver/ensemble_driver.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index c79fade4..15bf0e1a 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -340,6 +340,9 @@ subroutine SetModelServices(ensemble_driver, rc) else inst_suffix = '' endif + # CESM does not use this ESMF feature and at large processor counts it can be expensive to have it on. + call NUOPC_CompAttributeSet(driver, name="HierarchyProtocol", value="off", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Set the driver instance attributes call NUOPC_CompAttributeAdd(driver, attrList=(/'read_restart'/), rc=rc) From 9c43424704c8e9dc4d9cb683370190ca05e89f00 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 1 May 2023 10:31:15 -0600 Subject: [PATCH 31/61] correct comment delimiter --- cesm/driver/ensemble_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 15bf0e1a..2656f10f 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -340,7 +340,7 @@ subroutine SetModelServices(ensemble_driver, rc) else inst_suffix = '' endif - # CESM does not use this ESMF feature and at large processor counts it can be expensive to have it on. + ! CESM does not use this ESMF feature and at large processor counts it can be expensive to have it on. call NUOPC_CompAttributeSet(driver, name="HierarchyProtocol", value="off", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From 7bb5053618aca5c4bf146b2e370d9af2a77c70bc Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 5 May 2023 15:03:27 +0200 Subject: [PATCH 32/61] check for nans --- mediator/med_methods_mod.F90 | 108 +++++++++++++++++++++++++++ mediator/med_phases_prep_atm_mod.F90 | 5 ++ mediator/med_phases_prep_glc_mod.F90 | 7 ++ mediator/med_phases_prep_ice_mod.F90 | 5 ++ mediator/med_phases_prep_lnd_mod.F90 | 5 ++ mediator/med_phases_prep_ocn_mod.F90 | 5 ++ mediator/med_phases_prep_rof_mod.F90 | 5 ++ mediator/med_phases_prep_wav_mod.F90 | 5 ++ 8 files changed, 145 insertions(+) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index bd5b6079..710ba51c 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -24,6 +24,11 @@ module med_methods_mod med_methods_FieldPtr_compare2 end interface + interface med_methods_check_for_nans + module procedure med_methods_check_for_nans_1d + module procedure med_methods_check_for_nans_2d + end interface med_methods_check_for_nans + ! used/reused in module logical :: isPresent @@ -49,6 +54,7 @@ module med_methods_mod public med_methods_FB_getdata2d public med_methods_FB_getdata1d public med_methods_FB_getmesh + public med_methods_FB_check_for_nans public med_methods_State_reset public med_methods_State_diagnose @@ -71,6 +77,8 @@ module med_methods_mod #ifdef DIAGNOSE private med_methods_Array_diagnose #endif + private med_methods_check_for_nans + !----------------------------------------------------------------------------- contains !----------------------------------------------------------------------------- @@ -2497,4 +2505,104 @@ subroutine med_methods_FB_getmesh(FB, mesh, rc) end subroutine med_methods_FB_getmesh + !----------------------------------------------------------------------------- + subroutine med_methods_FB_check_for_nans(FB, rc) + + use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet, ESMF_FieldGet + + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + integer , intent(inout) :: rc + + ! local variables + type(ESMF_Field) :: field + integer :: index + integer :: fieldcount + integer :: fieldrank + character(len=CL) :: fieldname + real(r8) , pointer :: dataptr1d(:) + real(r8) , pointer :: dataptr2d(:,:) + ! ---------------------------------------------- + rc = ESMF_SUCCESS + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + do index=1,fieldCount + call med_methods_FB_getNameN(FB, index, fieldname, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(FB, fieldName=fieldname, field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, rank=fieldrank, name=fieldname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (fieldrank == 1) then + call ESMF_FieldGet(field, farrayPtr=dataptr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_FieldGet(field, farrayPtr=dataptr2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end do + + end subroutine med_methods_FB_check_for_nans + + !----------------------------------------------------------------------------- + subroutine med_methods_check_for_nans_1d(dataptr, name, rc) + ! input/output variables + real(r8) , intent(in) :: dataptr(:) + character(len=*) , intent(in) :: name + integer , intent(out) :: rc + + ! local variables + integer :: n + integer :: nancount + character(len=CS) :: nancount_char + character(len=*), parameter :: subname='(med_methods_check_for_nans_1d)' + ! ---------------------------------------------- + rc = ESMF_SUCCESS + + nancount = 0 + do n = 1,size(dataptr) + if (isnan(dataptr(n))) then + nancount = nancount + 1 + end if + end do + if (nancount > 0) then + write(nancount_char, '(i0)') nancount + call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(name), & + ESMF_LOGMSG_ERROR) + return + endif + end subroutine med_methods_check_for_nans_1d + + subroutine med_methods_check_for_nans_2d(dataptr, name, rc) + ! input/output variables + real(r8) , intent(in) :: dataptr(:,:) + character(len=*) , intent(in) :: name + integer , intent(out) :: rc + + ! local variables + integer :: n,k + integer :: nancount + character(len=CS) :: nancount_char + character(len=*), parameter :: subname='(med_methods_check_for_nans_2d)' + ! ---------------------------------------------- + rc = ESMF_SUCCESS + + nancount = 0 + do k = 1,size(dataptr, dim=1) + do n = 1,size(dataptr, dim=2) + if (isnan(dataptr(k,n))) then + nancount = nancount + 1 + end if + end do + end do + if (nancount > 0) then + write(nancount_char, '(i0)') nancount + call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(name), & + ESMF_LOGMSG_ERROR) + return + end if + end subroutine med_methods_check_for_nans_2d + end module med_methods_mod diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 9bb2b059..bccf8e07 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -14,6 +14,7 @@ module med_phases_prep_atm_mod use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose 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_check_for_nans => med_methods_FB_check_for_nans use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, maintask @@ -243,6 +244,10 @@ subroutine med_phases_prep_atm(gcomp, rc) end do end if + ! Check for nans in fields export to atm + call FB_check_for_nans(is_local%wrap%FBExp(compatm), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 311d91c8..2861f332 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -34,6 +34,7 @@ module med_phases_prep_glc_mod use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_init => med_methods_FB_init + use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans use med_methods_mod , only : field_getdata2d => med_methods_Field_getdata2d use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d use med_utils_mod , only : chkerr => med_utils_ChkErr @@ -706,6 +707,12 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) endif end if + ! Check for nans in fields export to atm + do ns = 1,is_local%wrap%num_icesheets + call fldbun_check_for_nans(is_local%wrap%FBExp(compglc(ns)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 428f3afe..1e0496b3 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -34,6 +34,7 @@ subroutine med_phases_prep_ice(gcomp, rc) use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_merge_mod , only : med_merge_auto use med_internalstate_mod , only : InternalState, logunit, maintask @@ -149,6 +150,10 @@ subroutine med_phases_prep_ice(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if + ! Check for nans in fields export to atm + call FB_check_for_nans(is_local%wrap%FBExp(compice), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 0c0bad21..93780c25 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -29,6 +29,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) use ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND use esmFlds , only : med_fldList_GetFldListTo, med_fldList_type use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose + use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : complnd, compatm @@ -127,6 +128,10 @@ subroutine med_phases_prep_lnd(gcomp, rc) ! Set first call logical to false first_call = .false. + ! Check for nans in fields export to atm + call fldbun_check_for_nans(is_local%wrap%FBExp(complnd), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 60e37a95..de989ac4 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -19,6 +19,7 @@ module med_phases_prep_ocn_mod 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 med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type use med_internalstate_mod , only : compocn, compatm, compice, coupling_mode use perf_mod , only : t_startf, t_stopf @@ -295,6 +296,10 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) call FB_copy(is_local%wrap%FBExp(compocn), is_local%wrap%FBExpAccumOcn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check for nans in fields export to atm + call FB_check_for_nans(is_local%wrap%FBExp(compocn), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! zero accumulator is_local%wrap%ExpAccumOcnCnt = 0 call FB_reset(is_local%wrap%FBExpAccumOcn, value=czero, rc=rc) diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 5d603a14..8d690124 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -23,6 +23,7 @@ module med_phases_prep_rof_mod use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_average => med_methods_FB_average use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d + use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans use perf_mod , only : t_startf, t_stopf implicit none @@ -376,6 +377,10 @@ subroutine med_phases_prep_rof(gcomp, rc) FBfrac=is_local%wrap%FBFrac(comprof), FBin=FBlndAccum2rof_r, fldListTo=fldList, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Check for nans in fields export to atm + call fldbun_check_for_nans(is_local%wrap%FBExp(comprof), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then call fldbun_diagnose(is_local%wrap%FBExp(comprof), & string=trim(subname)//' FBexp(comprof) ', rc=rc) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 5fcb9ba7..3028303b 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -17,6 +17,7 @@ module med_phases_prep_wav_mod 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 med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use esmFlds , only : med_fldList_GetfldListTo use med_internalstate_mod , only : compwav use perf_mod , only : t_startf, t_stopf @@ -176,6 +177,10 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) call FB_copy(is_local%wrap%FBExp(compwav), is_local%wrap%FBExpAccumWav, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check for nans in fields export to atm + call FB_check_for_nans(is_local%wrap%FBExp(compwav), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! zero accumulator is_local%wrap%ExpAccumWavCnt = 0 call FB_reset(is_local%wrap%FBExpAccumWav, value=czero, rc=rc) From 9ee4d83648b2939273ee1091cb7d9a12524879ee Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 5 May 2023 15:53:47 +0200 Subject: [PATCH 33/61] refactored logic --- mediator/med_methods_mod.F90 | 53 ++++++++++++++++-------------------- 1 file changed, 23 insertions(+), 30 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 710ba51c..e9d545a9 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2522,12 +2522,17 @@ subroutine med_methods_FB_check_for_nans(FB, rc) character(len=CL) :: fieldname real(r8) , pointer :: dataptr1d(:) real(r8) , pointer :: dataptr2d(:,:) + integer :: nancount + character(len=CS) :: nancount_char + logical :: nanfound + character(len=*), parameter :: subname='(med_methods_FB_check_for_nans)' ! ---------------------------------------------- rc = ESMF_SUCCESS call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + nanfound = .false. do index=1,fieldCount call med_methods_FB_getNameN(FB, index, fieldname, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -2538,57 +2543,51 @@ subroutine med_methods_FB_check_for_nans(FB, rc) if (fieldrank == 1) then call ESMF_FieldGet(field, farrayPtr=dataptr1d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_check_for_nans(dataptr1d, nancount) else call ESMF_FieldGet(field, farrayPtr=dataptr2d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_check_for_nans(dataptr2d, nancount) + end if + if (nancount > 0) then + write(nancount_char, '(i0)') nancount + call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(fieldname), & + ESMF_LOGMSG_WARNING) + nanfound = .true. end if end do + if (nanfound) then + call ESMF_LogWrite(trim(subname)//": ERROR nans found in export field bundle ",ESMF_LOGMSG_ERROR) + return + end if end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- - subroutine med_methods_check_for_nans_1d(dataptr, name, rc) + subroutine med_methods_check_for_nans_1d(dataptr, nancount) ! input/output variables - real(r8) , intent(in) :: dataptr(:) - character(len=*) , intent(in) :: name - integer , intent(out) :: rc + real(r8) , intent(in) :: dataptr(:) + integer , intent(out) :: nancount ! local variables integer :: n - integer :: nancount - character(len=CS) :: nancount_char - character(len=*), parameter :: subname='(med_methods_check_for_nans_1d)' ! ---------------------------------------------- - rc = ESMF_SUCCESS - nancount = 0 do n = 1,size(dataptr) if (isnan(dataptr(n))) then nancount = nancount + 1 end if end do - if (nancount > 0) then - write(nancount_char, '(i0)') nancount - call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(name), & - ESMF_LOGMSG_ERROR) - return - endif end subroutine med_methods_check_for_nans_1d - subroutine med_methods_check_for_nans_2d(dataptr, name, rc) + subroutine med_methods_check_for_nans_2d(dataptr, nancount) ! input/output variables - real(r8) , intent(in) :: dataptr(:,:) - character(len=*) , intent(in) :: name - integer , intent(out) :: rc + real(r8) , intent(in) :: dataptr(:,:) + integer , intent(out) :: nancount ! local variables integer :: n,k - integer :: nancount - character(len=CS) :: nancount_char - character(len=*), parameter :: subname='(med_methods_check_for_nans_2d)' ! ---------------------------------------------- - rc = ESMF_SUCCESS - nancount = 0 do k = 1,size(dataptr, dim=1) do n = 1,size(dataptr, dim=2) @@ -2597,12 +2596,6 @@ subroutine med_methods_check_for_nans_2d(dataptr, name, rc) end if end do end do - if (nancount > 0) then - write(nancount_char, '(i0)') nancount - call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(name), & - ESMF_LOGMSG_ERROR) - return - end if end subroutine med_methods_check_for_nans_2d end module med_methods_mod From 3ad7f1f7e9df8a236a3b2d6ab89b37711bab701f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 5 May 2023 16:00:53 +0200 Subject: [PATCH 34/61] updated med_diag_mod with recent changes from escomp --- mediator/med_diag_mod.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 802334f6..8ea6651e 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -95,6 +95,8 @@ module med_diag_mod character(*), parameter :: FA1 = "(' ',a12,6f15.8)" character(*), parameter :: FA0r = "(' ',12x,8(6x,a8,1x))" character(*), parameter :: FA1r = "(' ',a12,8f15.8)" + character(*), parameter :: FA0s = "(' ',12x,8(7x,a8,2x))" + character(*), parameter :: FA1s = "(' ',a12,8g18.8)" ! --------------------------------- ! C for component @@ -2683,7 +2685,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) write(diagunit,*) ' ' write(diagunit,FAH) subname,'NET SALT BUDGET (kg/m2s): period = ',& trim(budget_diags%periods(ip)%name), ': date = ',date,tod - write(diagunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' + write(diagunit,FA0s) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' do nf = f_salt_beg, f_salt_end net_salt_atm = data(nf, c_atm_recv, ip) + data(nf, c_atm_send, ip) net_salt_lnd = data(nf, c_lnd_recv, ip) + data(nf, c_lnd_send, ip) @@ -2695,7 +2697,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) net_salt_tot = net_salt_atm + net_salt_lnd + net_salt_rof + net_salt_ocn + & net_salt_ice_nh + net_salt_ice_sh + net_salt_glc - write(diagunit,FA1r) budget_diags%fields(nf)%name,& + write(diagunit,FA1s) budget_diags%fields(nf)%name,& net_salt_atm, net_salt_lnd, net_salt_rof, net_salt_ocn, & net_salt_ice_nh, net_salt_ice_sh, net_salt_glc, net_salt_tot enddo @@ -2718,7 +2720,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) sum_net_salt_tot = sum_net_salt_atm + sum_net_salt_lnd + sum_net_salt_rof + sum_net_salt_ocn + & sum_net_salt_ice_nh + sum_net_salt_ice_sh + sum_net_salt_glc - write(diagunit,FA1r)' *SUM*',& + write(diagunit,FA1s)' *SUM*',& sum_net_salt_atm, sum_net_salt_lnd, sum_net_salt_rof, sum_net_salt_ocn, & sum_net_salt_ice_nh, sum_net_salt_ice_sh, sum_net_salt_glc, sum_net_salt_tot end if From 311582ca09f91feca75c7d411e620e3c28648019 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Sat, 6 May 2023 13:29:39 -0600 Subject: [PATCH 35/61] This fails to enable writing of 'daily' files from forecasts shorter than 24 hours --- cime_config/namelist_definition_drv.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index d403caad..d62eacc5 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1526,7 +1526,7 @@ MED_attributes history option type - ndays + nhours @@ -1989,7 +1989,7 @@ MED_attributes history option type - ndays + nhours @@ -1998,7 +1998,7 @@ MED_attributes history option type - 1 + 6 From 83bba42b9671e2c76c73db654d884fcf2f2082b6 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 May 2023 13:51:06 +0200 Subject: [PATCH 36/61] updated counters for nans --- mediator/med_methods_mod.F90 | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index e9d545a9..5188ed9f 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2515,16 +2515,17 @@ subroutine med_methods_FB_check_for_nans(FB, rc) integer , intent(inout) :: rc ! local variables - type(ESMF_Field) :: field - integer :: index - integer :: fieldcount - integer :: fieldrank - character(len=CL) :: fieldname - real(r8) , pointer :: dataptr1d(:) - real(r8) , pointer :: dataptr2d(:,:) - integer :: nancount - character(len=CS) :: nancount_char - logical :: nanfound + type(ESMF_Field) :: field + integer :: index + integer :: fieldcount + integer :: fieldrank + character(len=CL) :: fieldname + real(r8) , pointer :: dataptr1d(:) + real(r8) , pointer :: dataptr2d(:,:) + integer :: nancount + character(len=CS) :: nancount_char + character(len=CL) :: msg_error + logical :: nanfound character(len=*), parameter :: subname='(med_methods_FB_check_for_nans)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -2543,21 +2544,22 @@ subroutine med_methods_FB_check_for_nans(FB, rc) if (fieldrank == 1) then call ESMF_FieldGet(field, farrayPtr=dataptr1d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_check_for_nans(dataptr1d, nancount) + call med_methods_check_for_nans(dataptr1d, nancount) else call ESMF_FieldGet(field, farrayPtr=dataptr2d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_check_for_nans(dataptr2d, nancount) + call med_methods_check_for_nans(dataptr2d, nancount) end if if (nancount > 0) then write(nancount_char, '(i0)') nancount - call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(fieldname), & - ESMF_LOGMSG_WARNING) + msg_error = "ERROR: " // trim(nancount_char) //" nans found in "//trim(fieldname) + call ESMF_LogWrite(trim(msg_error), ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) nanfound = .true. end if end do if (nanfound) then - call ESMF_LogWrite(trim(subname)//": ERROR nans found in export field bundle ",ESMF_LOGMSG_ERROR) + call ESMF_LogWrite('ABORTING JOB', ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE return end if @@ -2565,6 +2567,7 @@ end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- subroutine med_methods_check_for_nans_1d(dataptr, nancount) + use shr_infnan_mod, only: nan => shr_infnan_nan, inf => shr_infnan_inf, assignment(=) ! input/output variables real(r8) , intent(in) :: dataptr(:) integer , intent(out) :: nancount @@ -2581,6 +2584,7 @@ subroutine med_methods_check_for_nans_1d(dataptr, nancount) end subroutine med_methods_check_for_nans_1d subroutine med_methods_check_for_nans_2d(dataptr, nancount) + use shr_infnan_mod, only: nan => shr_infnan_nan, inf => shr_infnan_inf, assignment(=) ! input/output variables real(r8) , intent(in) :: dataptr(:,:) integer , intent(out) :: nancount From 0b59db6514a76cf8369cdbeb5c829e58e44b9df5 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 May 2023 13:55:09 +0200 Subject: [PATCH 37/61] consistent alias of use statements for check_for_nans --- mediator/med_phases_prep_glc_mod.F90 | 4 ++-- mediator/med_phases_prep_lnd_mod.F90 | 4 ++-- mediator/med_phases_prep_rof_mod.F90 | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 2861f332..97049d5b 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -34,7 +34,7 @@ module med_phases_prep_glc_mod use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_init => med_methods_FB_init - use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_methods_mod , only : field_getdata2d => med_methods_Field_getdata2d use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d use med_utils_mod , only : chkerr => med_utils_ChkErr @@ -709,7 +709,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) ! Check for nans in fields export to atm do ns = 1,is_local%wrap%num_icesheets - call fldbun_check_for_nans(is_local%wrap%FBExp(compglc(ns)), rc=rc) + call FB_check_for_nans(is_local%wrap%FBExp(compglc(ns)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 93780c25..b7341293 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -29,7 +29,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) use ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND use esmFlds , only : med_fldList_GetFldListTo, med_fldList_type use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose - use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : complnd, compatm @@ -129,7 +129,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) first_call = .false. ! Check for nans in fields export to atm - call fldbun_check_for_nans(is_local%wrap%FBExp(complnd), rc=rc) + call FB_check_for_nans(is_local%wrap%FBExp(complnd), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 8d690124..cf0ad0f4 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -23,7 +23,7 @@ module med_phases_prep_rof_mod use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_average => med_methods_FB_average use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d - use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use perf_mod , only : t_startf, t_stopf implicit none @@ -378,7 +378,7 @@ subroutine med_phases_prep_rof(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Check for nans in fields export to atm - call fldbun_check_for_nans(is_local%wrap%FBExp(comprof), rc=rc) + call FB_check_for_nans(is_local%wrap%FBExp(comprof), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then From 64439f74578d01ece0f4a87b41f6c25897751321 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 May 2023 14:03:16 +0200 Subject: [PATCH 38/61] fixed compilation bug --- mediator/med_methods_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 5188ed9f..8c781e7c 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2567,7 +2567,8 @@ end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- subroutine med_methods_check_for_nans_1d(dataptr, nancount) - use shr_infnan_mod, only: nan => shr_infnan_nan, inf => shr_infnan_inf, assignment(=) + use shr_infnan_mod, only: nan => isnan + ! input/output variables real(r8) , intent(in) :: dataptr(:) integer , intent(out) :: nancount @@ -2584,7 +2585,8 @@ subroutine med_methods_check_for_nans_1d(dataptr, nancount) end subroutine med_methods_check_for_nans_1d subroutine med_methods_check_for_nans_2d(dataptr, nancount) - use shr_infnan_mod, only: nan => shr_infnan_nan, inf => shr_infnan_inf, assignment(=) + use shr_infnan_mod, only: isnan + ! input/output variables real(r8) , intent(in) :: dataptr(:,:) integer , intent(out) :: nancount From 5e02def6328fc0352cae83e2f366604c712caf8b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 May 2023 14:26:13 +0200 Subject: [PATCH 39/61] add ability to compile without needed shr_infnan - as is the case for UFS --- mediator/med_methods_mod.F90 | 45 ++++++++++++++++++++++++++++-------- 1 file changed, 35 insertions(+), 10 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 8c781e7c..3d29fde6 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2530,6 +2530,11 @@ subroutine med_methods_FB_check_for_nans(FB, rc) ! ---------------------------------------------- rc = ESMF_SUCCESS +#ifndef CESM_COUPLED + ! For now only CESM uses shr_infnan_isnan - so until other models provide this + RETURN +#endif + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2566,42 +2571,62 @@ subroutine med_methods_FB_check_for_nans(FB, rc) end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- - subroutine med_methods_check_for_nans_1d(dataptr, nancount) - use shr_infnan_mod, only: nan => isnan +#ifdef CESM_COUPLED + subroutine med_methods_check_for_nans_1d(dataptr, nancount) + use shr_infnan_mod, only: shr_infnan_isnan ! input/output variables real(r8) , intent(in) :: dataptr(:) integer , intent(out) :: nancount - ! local variables integer :: n - ! ---------------------------------------------- + nancount = 0 do n = 1,size(dataptr) - if (isnan(dataptr(n))) then + if (shr_infnan_isnan(dataptr(n))) then nancount = nancount + 1 end if end do end subroutine med_methods_check_for_nans_1d subroutine med_methods_check_for_nans_2d(dataptr, nancount) - use shr_infnan_mod, only: isnan - + use shr_infnan_mod, only: shr_infan_isnan ! input/output variables real(r8) , intent(in) :: dataptr(:,:) integer , intent(out) :: nancount - ! local variables integer :: n,k - ! ---------------------------------------------- + nancount = 0 do k = 1,size(dataptr, dim=1) do n = 1,size(dataptr, dim=2) - if (isnan(dataptr(k,n))) then + if (shr_infan_isnan(dataptr(k,n))) then nancount = nancount + 1 end if end do end do end subroutine med_methods_check_for_nans_2d +#else + + ! For now only CESM uses shr_infnan_isnan - so until other models provide this + ! nancount will just be set to zero + + subroutine med_methods_check_for_nans_1d(dataptr, nancount) + ! input/output variables + real(r8) , intent(in) :: dataptr(:) + integer , intent(out) :: nancount + + nancount = 0 + end subroutine med_methods_check_for_nans_1d + + subroutine med_methods_check_for_nans_2d(dataptr, nancount) + ! input/output variables + real(r8) , intent(in) :: dataptr(:,:) + integer , intent(out) :: nancount + + nancount = 0 + end subroutine med_methods_check_for_nans_2d +#endif + end module med_methods_mod 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 40/61] 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 9146ee72..068acb50 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 41/61] 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 068acb50..87fdee38 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 42/61] 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 87fdee38..397a92ba 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 43/61] 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 2a410aac..ded0e4e7 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 7ac3ca9a8d331ee6e09e43458478ed29626293f2 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 10 May 2023 13:40:40 -0600 Subject: [PATCH 44/61] make history_n integer variables --- cime_config/namelist_definition_drv.xml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 0ade5db4..501d6896 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1264,7 +1264,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1329,7 +1329,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1396,7 +1396,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1465,7 +1465,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1530,7 +1530,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1748,7 +1748,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1830,7 +1830,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1993,7 +1993,7 @@ - char + integer aux_hist MED_attributes history option type From b22ae222b571f7e5196052d581c74ce6d2611be0 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 10 May 2023 13:44:49 -0600 Subject: [PATCH 45/61] sames should be samples --- cime_config/namelist_definition_drv.xml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 501d6896..5cbf7831 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1294,7 +1294,7 @@ integer aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 24 @@ -1350,7 +1350,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 24 @@ -1417,7 +1417,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 8 @@ -1486,7 +1486,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 8 @@ -1551,7 +1551,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 1 @@ -1769,7 +1769,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 1 @@ -1860,7 +1860,7 @@ integer aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 30 @@ -2014,7 +2014,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 1 From cca94e4b7bf6e39fa19ddfc865749da08f8dccaa Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 10 May 2023 16:09:27 -0600 Subject: [PATCH 46/61] wopen should return rc --- mediator/med_io_mod.F90 | 33 ++++++++++++++--------------- mediator/med_phases_history_mod.F90 | 18 ++++++++++------ mediator/med_phases_restart_mod.F90 | 3 ++- 3 files changed, 30 insertions(+), 24 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 97db9bcc..38ae201f 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -7,7 +7,7 @@ module med_io_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, I8=>SHR_KIND_I8, R8=>SHR_KIND_R8 use med_kind_mod , only : R4=>SHR_KIND_R4 use med_constants_mod , only : fillvalue => SHR_CONST_SPVAL - use ESMF , only : ESMF_VM, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError + use ESMF , only : ESMF_VM, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError, ESMF_LOGMSG_ERROR use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_END_ABORT, ESMF_LOGERR_PASSTHRU use ESMF , only : ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadCast, ESMF_Finalize use NUOPC , only : NUOPC_FieldDictionaryGetEntry @@ -198,7 +198,7 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. '64BIT_DATA') then pio_ioformat = PIO_64BIT_DATA else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_ioformat (CLASSIC|64BIT_OFFSET|64BIT_DATA)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_ioformat (CLASSIC|64BIT_OFFSET|64BIT_DATA)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -223,7 +223,7 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. 'NETCDF4P') then pio_iotype = PIO_IOTYPE_NETCDF4P else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_typename (NETCDF|PNETCDF|NETCDF4C|NETCDF4P)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_typename (NETCDF|PNETCDF|NETCDF4C|NETCDF4P)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -334,13 +334,13 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. 'SUBSET') then pio_rearranger = PIO_REARR_SUBSET else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearranger (BOX|SUBSET)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearranger (BOX|SUBSET)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if else - cvalue = 'BOX' - pio_rearranger = PIO_REARR_BOX + cvalue = 'SUBSET' + pio_rearranger = PIO_REARR_SUBSET end if if (localPet == 0) write(logunit,*) trim(subname), ' : pio_rearranger = ', trim(cvalue), pio_rearranger @@ -357,7 +357,7 @@ subroutine med_io_init(gcomp, rc) if (isPresent .and. isSet) then read(cvalue,*) pio_debug_level if (pio_debug_level < 0 .or. pio_debug_level > 6) then - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_debug_level (0-6)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_debug_level (0-6)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -381,7 +381,7 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. 'COLL') then pio_rearr_comm_type = PIO_REARR_COMM_COLL else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_type (P2P|COLL)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_type (P2P|COLL)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -406,7 +406,7 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. '2DDISABLE') then pio_rearr_comm_fcd = PIO_REARR_COMM_FC_2D_DISABLE else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_fcd (2DENABLE|IO2COMP|COMP2IO|2DDISABLE)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_fcd (2DENABLE|IO2COMP|COMP2IO|2DDISABLE)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -498,7 +498,7 @@ subroutine med_io_init(gcomp, rc) end subroutine med_io_init !=============================================================================== - subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) + subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) !--------------- ! open netcdf file @@ -512,16 +512,15 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) ! input/output arguments character(*), intent(in) :: filename type(ESMF_VM) :: vm + integer, intent(out) :: rc logical, optional, intent(in) :: clobber integer, optional, intent(in) :: file_ind character(CL), optional, intent(in) :: model_doi_url - ! local variables logical :: lclobber integer :: rcode integer :: nmode integer :: lfile_ind - integer :: rc integer :: iam character(CL) :: lversion character(CL) :: lmodel_doi_url @@ -539,10 +538,11 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind - if (.not. pio_file_is_open(io_file(lfile_ind))) then + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (.not. pio_file_is_open(io_file(lfile_ind))) then ! filename not open wfilename(lfile_ind) = trim(filename) @@ -589,7 +589,7 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) write(logunit,'(a)') trim(subname)//' different filename currently open '//trim(filename) write(logunit,'(a)') trim(subname)//' different wfilename currently open '//trim(wfilename(lfile_ind)) end if - call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return @@ -848,7 +848,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif - rc = ESMF_Success return endif diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 2f7c9f06..00444b29 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -292,7 +292,8 @@ subroutine med_phases_history_write(gcomp, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Loop over whead/wdata phases do m = 1,2 @@ -463,7 +464,8 @@ subroutine med_phases_history_write_med(gcomp, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then @@ -596,7 +598,8 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write data to history file do m = 1,2 @@ -749,7 +752,8 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then @@ -953,7 +957,8 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then @@ -1276,7 +1281,8 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! open file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(auxcomp%files(nf)%histfile, vm, file_ind=nf, clobber=.true.) + call med_io_wopen(auxcomp%files(nf)%histfile, vm, rc, file_ind=nf, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! define time variables call ESMF_ClockGet(auxcomp%files(nf)%clock, calendar=calendar, rc=rc) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 6bf5f346..3b276b08 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -309,7 +309,8 @@ subroutine med_phases_restart_write(gcomp, rc) call ESMF_LogWrite(trim(subname)//": write "//trim(restart_file), ESMF_LOGMSG_INFO) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(restart_file, vm, clobber=.true.) + call med_io_wopen(restart_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 if (m == 2) then From a31664644ec8e90d3a53bcc11602fc5e3eb6774f Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 11 May 2023 10:23:32 -0600 Subject: [PATCH 47/61] major refactor of med_io_mod to handle multiple files --- mediator/med_io_mod.F90 | 345 +++++++++++----------------- mediator/med_phases_history_mod.F90 | 116 +++++----- mediator/med_phases_restart_mod.F90 | 53 ++--- 3 files changed, 227 insertions(+), 287 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 38ae201f..9215777c 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -77,8 +77,9 @@ module med_io_mod character(*),parameter :: version = "cmeps0" integer , parameter :: number_strlen = 8 integer , parameter :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now - character(CL) :: wfilename(0:file_desc_t_cnt) = '' - type(file_desc_t) :: io_file(0:file_desc_t_cnt) + +! character(CL) :: wfilename(0:file_desc_t_cnt) = '' + integer :: pio_iotype integer :: pio_ioformat type(iosystem_desc_t), pointer :: io_subsystem @@ -498,7 +499,7 @@ subroutine med_io_init(gcomp, rc) end subroutine med_io_init !=============================================================================== - subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) + subroutine med_io_wopen(filename, io_file, vm, rc, clobber, file_ind, model_doi_url) !--------------- ! open netcdf file @@ -511,6 +512,7 @@ subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) ! input/output arguments character(*), intent(in) :: filename + type(file_desc_t), intent(inout) :: io_file type(ESMF_VM) :: vm integer, intent(out) :: rc logical, optional, intent(in) :: clobber @@ -542,10 +544,10 @@ subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (.not. pio_file_is_open(io_file(lfile_ind))) then + if (.not. pio_file_is_open(io_file)) then ! filename not open - wfilename(lfile_ind) = trim(filename) +! wfilename(lfile_ind) = trim(filename) if (med_io_file_exists(vm, filename)) then if (lclobber) then @@ -554,20 +556,20 @@ subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) if(pio_iotype == PIO_IOTYPE_NETCDF .or. pio_iotype == PIO_IOTYPE_PNETCDF) then nmode = ior(nmode,pio_ioformat) endif - rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) + rcode = pio_createfile(io_subsystem, io_file, pio_iotype, trim(filename), nmode) if(iam==0) write(logunit,'(a)') trim(subname)//' creating file '//trim(filename) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) + rcode = pio_put_att(io_file,pio_global,"file_version",version) + rcode = pio_put_att(io_file,pio_global,"model_doi_url",lmodel_doi_url) else - rcode = pio_openfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), pio_write) + rcode = pio_openfile(io_subsystem, io_file, pio_iotype, trim(filename), pio_write) if (iam==0) write(logunit,'(a)') trim(subname)//' opening file '//trim(filename) - call pio_seterrorhandling(io_file(lfile_ind),PIO_BCAST_ERROR) - rcode = pio_get_att(io_file(lfile_ind),pio_global,"file_version",lversion) - call pio_seterrorhandling(io_file(lfile_ind),PIO_INTERNAL_ERROR) + call pio_seterrorhandling(io_file,PIO_BCAST_ERROR) + rcode = pio_get_att(io_file,pio_global,"file_version",lversion) + call pio_seterrorhandling(io_file,PIO_INTERNAL_ERROR) if (trim(lversion) /= trim(version)) then - rcode = pio_redef(io_file(lfile_ind)) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) - rcode = pio_enddef(io_file(lfile_ind)) + rcode = pio_redef(io_file) + rcode = pio_put_att(io_file,pio_global,"file_version",version) + rcode = pio_enddef(io_file) endif endif else @@ -577,21 +579,21 @@ subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) nmode = ior(nmode,pio_ioformat) endif - rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) + rcode = pio_createfile(io_subsystem, io_file, pio_iotype, trim(filename), nmode) if (iam==0) write(logunit,'(a)') trim(subname) //' creating file '// trim(filename) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) + rcode = pio_put_att(io_file,pio_global,"file_version",version) + rcode = pio_put_att(io_file,pio_global,"model_doi_url",lmodel_doi_url) endif - elseif (trim(wfilename(lfile_ind)) /= trim(filename)) then +! elseif (trim(wfilename(lfile_ind)) /= trim(filename)) then ! filename is open, better match open filename - if (iam==0) then - write(logunit,'(a)') trim(subname)//' different filename currently open '//trim(filename) - write(logunit,'(a)') trim(subname)//' different wfilename currently open '//trim(wfilename(lfile_ind)) - end if - call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return +! if (iam==0) then +! write(logunit,'(a)') trim(subname)//' different filename currently open '//trim(filename) +! write(logunit,'(a)') trim(subname)//' different wfilename currently open '//trim(wfilename(lfile_ind)) +! end if +! call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_ERROR) +! rc = ESMF_FAILURE +! return else ! filename is already open, just return @@ -600,7 +602,7 @@ subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) end subroutine med_io_wopen !=============================================================================== - subroutine med_io_close(filename, vm, file_ind, rc) + subroutine med_io_close(io_file, rc) !--------------- ! close netcdf file @@ -609,85 +611,52 @@ subroutine med_io_close(filename, vm, file_ind, rc) use pio, only: pio_file_is_open, pio_closefile ! input/output variables - character(*) , intent(in) :: filename - type(ESMF_VM) , intent(in) :: vm - integer,optional , intent(in) :: file_ind + type(file_desc_t) :: io_file integer , intent(out) :: rc ! local variables - integer :: lfile_ind + integer :: iam character(*),parameter :: subName = '(med_io_close) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - - if (.not. pio_file_is_open(io_file(lfile_ind))) then - ! filename not open, just return - elseif (trim(wfilename(lfile_ind)) == trim(filename)) then - ! filename matches, close it - call pio_closefile(io_file(lfile_ind)) - !wfilename(lfile_ind) = '' - else - call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! different filename is open, abort - if (iam==0) then - write(logunit,*) subname,' different wfilename and filename currently open, aborting ' - write(logunit,'(a)') 'filename = ',trim(filename) - write(logunit,'(a)') 'wfilename = ',trim(wfilename(lfile_ind)) - write(logunit,'(i6)')'lfile_ind = ',lfile_ind - end if - call ESMF_LogWrite(subname//'different file currently open, aborting '//trim(filename), ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if + if (pio_file_is_open(io_file)) then + call pio_closefile(io_file) endif end subroutine med_io_close !=============================================================================== - subroutine med_io_redef(filename,file_ind) + subroutine med_io_redef(io_file) use pio, only : pio_redef ! input/output variables - character(len=*), intent(in) :: filename - integer,optional,intent(in):: file_ind - + type(file_desc_t) :: io_file ! local variables - integer :: lfile_ind integer :: rcode !------------------------------------------------------------------------------- - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - rcode = pio_redef(io_file(lfile_ind)) + rcode = pio_redef(io_file) end subroutine med_io_redef !=============================================================================== - subroutine med_io_enddef(filename,file_ind) + subroutine med_io_enddef(io_file) use pio, only : pio_enddef ! input/output variables - character(len=*) , intent(in) :: filename - integer,optional , intent(in) :: file_ind + type(file_desc_t) :: io_file ! local variables - integer :: lfile_ind + integer :: rcode !------------------------------------------------------------------------------- - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - rcode = pio_enddef(io_file(lfile_ind)) + rcode = pio_enddef(io_file) end subroutine med_io_enddef @@ -746,8 +715,8 @@ character(len=8) function med_io_sec2hms (seconds, rc) end function med_io_sec2hms !=============================================================================== - subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & - fillval, pre, flds, tavg, use_float, file_ind, tilesize, rc) + subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & + fillval, pre, flds, tavg, use_float, tilesize, rc) !--------------- ! Write FB to netcdf file @@ -765,7 +734,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & use pio , only : pio_syncfile ! input/output variables - character(len=*) , intent(in) :: filename ! file + type(file_desc_t) :: io_file type(ESMF_FieldBundle) , intent(in) :: FB ! data to be written logical , intent(in) :: whead ! write header logical , intent(in) :: wdata ! write data @@ -777,7 +746,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & character(len=*), optional , intent(in) :: flds(:) ! specific fields to write out logical, optional , intent(in) :: tavg ! is this a tavg logical, optional , intent(in) :: use_float ! write output as float rather than double - integer, optional , intent(in) :: file_ind integer, optional , intent(in) :: tilesize ! if non-zero, write atm component on tiles integer , intent(out):: rc @@ -811,7 +779,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & integer, pointer :: maxIndexPTile(:,:) integer :: dimCount, tileCount integer, pointer :: Dof(:) - integer :: lfile_ind real(r8), pointer :: fldptr1(:) real(r8), pointer :: fldptr2(:,:) real(r8), allocatable :: ownedElemCoords(:), ownedElemCoords_x(:), ownedElemCoords_y(:) @@ -835,8 +802,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & if (present(pre)) lpre = trim(pre) luse_float = .false. if (present(use_float)) luse_float = use_float - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind + atmtiles = .false. if (present(tilesize)) then if (tilesize > 0) atmtiles = .true. @@ -953,22 +919,22 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & ! Write header if (whead) then if (atmtiles) then - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_nx', lnx, dimid3(1)) - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_ny', lny, dimid3(2)) - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_ntiles', ntiles, dimid3(3)) + rcode = pio_def_dim(io_file, trim(lpre)//'_nx', lnx, dimid3(1)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ny', lny, dimid3(2)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ntiles', ntiles, dimid3(3)) if (present(nt)) then dimid4(1:3) = dimid3 - rcode = pio_inq_dimid(io_file(lfile_ind), 'time', dimid4(4)) + rcode = pio_inq_dimid(io_file, 'time', dimid4(4)) dimid => dimid4 else dimid => dimid3 endif else - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_nx', lnx, dimid2(1)) - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_ny', lny, dimid2(2)) + rcode = pio_def_dim(io_file, trim(lpre)//'_nx', lnx, dimid2(1)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ny', lny, dimid2(2)) if (present(nt)) then dimid3(1:2) = dimid2 - rcode = pio_inq_dimid(io_file(lfile_ind), 'time', dimid3(3)) + rcode = pio_inq_dimid(io_file, 'time', dimid3(3)) dimid => dimid3 else dimid => dimid2 @@ -1007,21 +973,21 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) call ESMF_LogWrite(trim(subname)//': defining '//trim(name1), ESMF_LOGMSG_INFO) if (luse_float) then - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind), varid,"_FillValue",real(lfillvalue,r4)) + rcode = pio_def_var(io_file, trim(name1), PIO_REAL, dimid, varid) + rcode = pio_put_att(io_file, varid,"_FillValue",real(lfillvalue,r4)) else - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind),varid,"_FillValue",lfillvalue) + rcode = pio_def_var(io_file, trim(name1), PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file,varid,"_FillValue",lfillvalue) end if if (NUOPC_FieldDictionaryHasEntry(trim(itemc))) then call NUOPC_FieldDictionaryGetEntry(itemc, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind), varid, "units" , trim(cunit)) + rcode = pio_put_att(io_file, varid, "units" , trim(cunit)) end if - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(name1)) + rcode = pio_put_att(io_file, varid, "standard_name", trim(name1)) if (present(tavg)) then if (tavg) then - rcode = pio_put_att(io_file(lfile_ind), varid, "cell_methods", "time: mean") + rcode = pio_put_att(io_file, varid, "cell_methods", "time: mean") endif endif end if @@ -1030,21 +996,21 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & name1 = trim(lpre)//'_'//trim(itemc) call ESMF_LogWrite(trim(subname)//':'//trim(itemc)//':'//trim(name1),ESMF_LOGMSG_INFO) if (luse_float) then - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind), varid, "_FillValue", real(lfillvalue, r4)) + rcode = pio_def_var(io_file, trim(name1), PIO_REAL, dimid, varid) + rcode = pio_put_att(io_file, varid, "_FillValue", real(lfillvalue, r4)) else - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind), varid, "_FillValue", lfillvalue) + rcode = pio_def_var(io_file, trim(name1), PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file, varid, "_FillValue", lfillvalue) end if if (NUOPC_FieldDictionaryHasEntry(trim(itemc))) then call NUOPC_FieldDictionaryGetEntry(itemc, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind), varid, "units", trim(cunit)) + rcode = pio_put_att(io_file, varid, "units", trim(cunit)) end if - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(name1)) + rcode = pio_put_att(io_file, varid, "standard_name", trim(name1)) if (present(tavg)) then if (tavg) then - rcode = pio_put_att(io_file(lfile_ind), varid, "cell_methods", "time: mean") + rcode = pio_put_att(io_file, varid, "cell_methods", "time: mean") endif end if end if @@ -1054,13 +1020,13 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & ! Add coordinate information to file do n = 1,ndims if (luse_float) then - rcode = pio_def_var(io_file(lfile_ind), trim(coordvarnames(n)), PIO_REAL, dimid, varid) + rcode = pio_def_var(io_file, trim(coordvarnames(n)), PIO_REAL, dimid, varid) else - rcode = pio_def_var(io_file(lfile_ind), trim(coordvarnames(n)), PIO_DOUBLE, dimid, varid) + rcode = pio_def_var(io_file, trim(coordvarnames(n)), PIO_DOUBLE, dimid, varid) end if - rcode = pio_put_att(io_file(lfile_ind), varid, "long_name", trim(coordnames(n))) - rcode = pio_put_att(io_file(lfile_ind), varid, "units", trim(coordunits(n))) - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(coordnames(n))) + rcode = pio_put_att(io_file, varid, "long_name", trim(coordnames(n))) + rcode = pio_put_att(io_file, varid, "units", trim(coordunits(n))) + rcode = pio_put_att(io_file, varid, "standard_name", trim(coordnames(n))) end do end if @@ -1106,38 +1072,38 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & do n = 1,ungriddedUBound(1) write(cnumber,'(i0)') n name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) - rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) - call pio_setframe(io_file(lfile_ind),varid,frame) + rcode = pio_inq_varid(io_file, trim(name1), varid) + call pio_setframe(io_file,varid,frame) if (gridToFieldMap(1) == 1) then - call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr2(:,n), rcode, fillval=lfillvalue) + call pio_write_darray(io_file, varid, iodesc, fldptr2(:,n), rcode, fillval=lfillvalue) else if (gridToFieldMap(1) == 2) then - call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue) + call pio_write_darray(io_file, varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue) end if end do else if (rank == 1 .or. rank == 0) then name1 = trim(lpre)//'_'//trim(itemc) - rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) - call pio_setframe(io_file(lfile_ind),varid,frame) + rcode = pio_inq_varid(io_file, trim(name1), varid) + call pio_setframe(io_file,varid,frame) ! fix for writing data on exchange grid, which has no data in some PETs if (rank == 0) nullify(fldptr1) - call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr1, rcode, fillval=lfillvalue) + call pio_write_darray(io_file, varid, iodesc, fldptr1, rcode, fillval=lfillvalue) end if ! end if rank is 2 or 1 or 0 end if ! end if not "hgt" end do ! end loop over fields in FB ! Fill coordinate variables - why is this being done each time? - rcode = pio_inq_varid(io_file(lfile_ind), trim(coordvarnames(1)), varid) - call pio_setframe(io_file(lfile_ind),varid,frame) - call pio_write_darray(io_file(lfile_ind), varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue) + rcode = pio_inq_varid(io_file, trim(coordvarnames(1)), varid) + call pio_setframe(io_file,varid,frame) + call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue) - rcode = pio_inq_varid(io_file(lfile_ind), trim(coordvarnames(2)), varid) - call pio_setframe(io_file(lfile_ind),varid,frame) - call pio_write_darray(io_file(lfile_ind), varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue) + rcode = pio_inq_varid(io_file, trim(coordvarnames(2)), varid) + call pio_setframe(io_file,varid,frame) + call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue) - call pio_syncfile(io_file(lfile_ind)) - call pio_freedecomp(io_file(lfile_ind), iodesc) + call pio_syncfile(io_file) + call pio_freedecomp(io_file, iodesc) endif deallocate(ownedElemCoords, ownedElemCoords_x, ownedElemCoords_y) @@ -1148,7 +1114,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & end subroutine med_io_write_FB !=============================================================================== - subroutine med_io_write_int(filename, idata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_int(io_file, idata, dname, whead, wdata, rc) use pio, only : var_desc_t, pio_def_var, pio_put_att, pio_int, pio_inq_varid, pio_put_var @@ -1157,45 +1123,40 @@ subroutine med_io_write_int(filename, idata, dname, whead, wdata, file_ind, rc) !--------------- ! intput/output variables - character(len=*) ,intent(in) :: filename ! file + type(file_desc_t) :: io_file integer ,intent(in) :: idata ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header logical ,intent(in) :: wdata ! write data - integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc ! local variables integer :: rcode type(var_desc_t) :: varid character(CL) :: cunit ! var units - integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_int) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - if (whead) then if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file,varid,"units",trim(cunit)) end if - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_INT,varid) - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_def_var(io_file,trim(dname),PIO_INT,varid) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) endif if (wdata) then - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,idata) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,idata) endif end subroutine med_io_write_int !=============================================================================== - subroutine med_io_write_int1d(filename, idata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_int1d(io_file, idata, dname, whead, wdata, file_ind, rc) !--------------- ! Write 1d integer array to netcdf file @@ -1206,7 +1167,7 @@ subroutine med_io_write_int1d(filename, idata, dname, whead, wdata, file_ind, rc use pio , only : pio_int, pio_def_var ! input/output arguments - character(len=*) ,intent(in) :: filename ! file + type(file_desc_t) :: io_file integer ,intent(in) :: idata(:) ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header @@ -1233,21 +1194,21 @@ subroutine med_io_write_int1d(filename, idata, dname, whead, wdata, file_ind, rc if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file,varid,"units",trim(cunit)) end if lnx = size(idata) - rcode = pio_def_dim(io_file(lfile_ind),trim(dname),lnx,dimid(1)) - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_INT,dimid,varid) - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_def_dim(io_file,trim(dname),lnx,dimid(1)) + rcode = pio_def_var(io_file,trim(dname),PIO_INT,dimid,varid) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) else if (wdata) then - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,idata) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,idata) endif end subroutine med_io_write_int1d !=============================================================================== - subroutine med_io_write_r8(filename, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_r8(io_file, rdata, dname, whead, wdata, rc) !--------------- ! Write scalar double to netcdf file @@ -1257,48 +1218,41 @@ subroutine med_io_write_r8(filename, rdata, dname, whead, wdata, file_ind, rc) use pio , only : pio_double, pio_noerr, pio_inq_varid, pio_put_var ! input/output arguments - character(len=*) ,intent(in) :: filename ! file + type(file_desc_T) :: io_file real(r8) ,intent(in) :: rdata ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header logical ,intent(in) :: wdata ! write data - integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc ! local variables integer :: rcode type(var_desc_t) :: varid character(CL) :: cunit ! var units - integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_r8) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if(present(file_ind)) then - lfile_ind = file_ind - else - lfile_ind = 1 - endif if (whead) then - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,varid) + rcode = pio_def_var(io_file,trim(dname),PIO_DOUBLE,varid) if (rcode==PIO_NOERR) then if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file,varid,"units",trim(cunit)) end if - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) end if else if (wdata) then - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,rdata) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,rdata) endif end subroutine med_io_write_r8 !=============================================================================== - subroutine med_io_write_r81d(filename, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_r81d(io_file, rdata, dname, whead, wdata, rc) !--------------- ! Write 1d double array to netcdf file @@ -1308,12 +1262,11 @@ subroutine med_io_write_r81d(filename, rdata, dname, whead, wdata, file_ind, rc) use pio , only : pio_inq_varid, pio_put_var, pio_double, pio_put_att ! !INPUT/OUTPUT PARAMETERS: - character(len=*) ,intent(in) :: filename ! file + type(file_desc_t) :: io_file real(r8) ,intent(in) :: rdata(:) ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header logical ,intent(in) :: wdata ! write data - integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc ! local variables @@ -1322,38 +1275,32 @@ subroutine med_io_write_r81d(filename, rdata, dname, whead, wdata, file_ind, rc) type(var_desc_t) :: varid character(CL) :: cunit ! var units integer :: lnx - integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_r81d) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if(present(file_ind)) then - lfile_ind = file_ind - else - lfile_ind = 1 - endif if (whead) then lnx = size(rdata) - rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_nx',lnx,dimid(1)) - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,dimid,varid) + rcode = pio_def_dim(io_file,trim(dname)//'_nx',lnx,dimid(1)) + rcode = pio_def_var(io_file,trim(dname),PIO_DOUBLE,dimid,varid) if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file,varid,"units",trim(cunit)) end if - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) endif if (wdata) then - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,rdata) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,rdata) endif end subroutine med_io_write_r81d !=============================================================================== - subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_char(io_file, rdata, dname, whead, wdata, rc) !--------------- ! Write char string to netcdf file @@ -1363,12 +1310,11 @@ subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) use pio , only : pio_char, pio_put_var ! input/output arguments - character(len=*) ,intent(in) :: filename ! file + type(file_desc_t) :: io_file character(len=*) ,intent(in) :: rdata ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header logical ,intent(in) :: wdata ! write data - integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc ! local variables @@ -1377,37 +1323,32 @@ subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) type(var_desc_t) :: varid character(CL) :: cunit ! var units integer :: lnx - integer :: lfile_ind character(CL) :: charvar ! buffer for string read/write character(*),parameter :: subName = '(med_io_write_char) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if(present(file_ind)) then - lfile_ind = file_ind - else - lfile_ind = 1 - endif + if (whead) then lnx = len(charvar) - rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_len',lnx,dimid(1)) - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_CHAR,dimid,varid) + rcode = pio_def_dim(io_file,trim(dname)//'_len',lnx,dimid(1)) + rcode = pio_def_var(io_file,trim(dname),PIO_CHAR,dimid,varid) if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) else if (wdata) then charvar = '' charvar = trim(rdata) - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,charvar) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,charvar) endif end subroutine med_io_write_char !=============================================================================== - subroutine med_io_define_time(time_units, calendar, file_ind, rc) + subroutine med_io_define_time(io_file, time_units, calendar, rc) use ESMF, only : operator(==), operator(/=) use ESMF, only : ESMF_Calendar, ESMF_CalendarIsCreated @@ -1420,9 +1361,9 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) use pio , only : pio_inq_varid, pio_put_var ! input/output variables + type(file_desc_t) :: io_file character(len=*) , intent(in) :: time_units ! units of time type(ESMF_Calendar) , intent(in) :: calendar ! calendar - integer, optional , intent(in) :: file_ind integer , intent(out):: rc ! local variables @@ -1430,16 +1371,12 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) integer :: dimid(1) integer :: dimid2(2) type(var_desc_t) :: varid - integer :: lfile_ind character(CL) :: calname ! calendar name character(*),parameter :: subName = '(med_io_define_time) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - if (.not. ESMF_CalendarIsCreated(calendar)) then call ESMF_LogWrite(trim(subname)//' ERROR: calendar is not created ', & ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) @@ -1448,9 +1385,9 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) end if ! define time and add calendar attribute - rcode = pio_def_dim(io_file(lfile_ind), 'time', PIO_UNLIMITED, dimid(1)) - rcode = pio_def_var(io_file(lfile_ind), 'time', PIO_DOUBLE, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind), varid, 'units', trim(time_units)) + rcode = pio_def_dim(io_file, 'time', PIO_UNLIMITED, dimid(1)) + rcode = pio_def_var(io_file, 'time', PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file, varid, 'units', trim(time_units)) if (calendar == ESMF_CALKIND_360DAY) then calname = '360_day' else if (calendar == ESMF_CALKIND_GREGORIAN) then @@ -1466,18 +1403,18 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) else if (calendar == ESMF_CALKIND_NOLEAP) then calname = 'noleap' end if - rcode = pio_put_att(io_file(lfile_ind), varid, 'calendar', trim(calname)) + rcode = pio_put_att(io_file, varid, 'calendar', trim(calname)) ! define time bounds dimid2(2) = dimid(1) - rcode = pio_def_dim(io_file(lfile_ind), 'ntb', 2, dimid2(1)) - rcode = pio_def_var(io_file(lfile_ind), 'time_bnds', PIO_DOUBLE, dimid2, varid) - rcode = pio_put_att(io_file(lfile_ind), varid, 'bounds', 'time_bnds') + rcode = pio_def_dim(io_file, 'ntb', 2, dimid2(1)) + rcode = pio_def_var(io_file, 'time_bnds', PIO_DOUBLE, dimid2, varid) + rcode = pio_put_att(io_file, varid, 'bounds', 'time_bnds') end subroutine med_io_define_time !=============================================================================== - subroutine med_io_write_time(time_val, tbnds, nt, file_ind, rc) + subroutine med_io_write_time(io_file, time_val, tbnds, nt, rc) !--------------- ! Write time variable to netcdf file @@ -1486,15 +1423,14 @@ subroutine med_io_write_time(time_val, tbnds, nt, file_ind, rc) use pio, only : pio_put_att, pio_inq_varid, pio_put_var ! input/output variables + type(file_desc_t) :: io_file real(r8) , intent(in) :: time_val ! data to be written real(r8) , intent(in) :: tbnds(2) ! time bounds integer , intent(in) :: nt - integer , optional, intent(in) :: file_ind integer , intent(out):: rc ! local variables integer :: rcode - integer :: lfile_ind integer :: varid integer :: start(2),count(2) character(*),parameter :: subName = '(med_io_write_time) ' @@ -1502,19 +1438,16 @@ subroutine med_io_write_time(time_val, tbnds, nt, file_ind, rc) rc = ESMF_SUCCESS - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - ! write time count = 1; start = nt - rcode = pio_inq_varid(io_file(lfile_ind), 'time', varid) - rcode = pio_put_var(io_file(lfile_ind), varid, start(1:1), count(1:1), (/time_val/)) + rcode = pio_inq_varid(io_file, 'time', varid) + rcode = pio_put_var(io_file, varid, start(1:1), count(1:1), (/time_val/)) ! write time bounds - rcode = pio_inq_varid(io_file(lfile_ind), 'time_bnds', varid) + rcode = pio_inq_varid(io_file, 'time_bnds', varid) start(1) = 1; start(2) = nt count(1) = 2; count(2) = 1 - rcode = pio_put_var(io_file(lfile_ind), varid, start(1:2), count(1:2), tbnds) + rcode = pio_put_var(io_file, varid, start(1:2), count(1:2), tbnds) end subroutine med_io_write_time @@ -1537,7 +1470,7 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) use pio , only : pio_read_darray, pio_offset_kind, pio_setframe ! input/output arguments - character(len=*) ,intent(in) :: filename ! file + character(len=*) ,intent(in) :: filename type(ESMF_VM) ,intent(in) :: vm type(ESMF_FieldBundle) ,intent(in) :: FB ! data to be read character(len=*) ,optional ,intent(in) :: pre ! prefix to variable name diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 00444b29..e647dc64 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -24,7 +24,8 @@ module med_phases_history_mod use med_time_mod , only : med_time_alarmInit use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf - + use pio , only : file_desc_t + implicit none private @@ -59,6 +60,7 @@ module med_phases_history_mod ! Instantaneous history files datatypes/variables per component ! ---------------------------- type, public :: instfile_type + type(file_desc_t) :: io_file logical :: write_inst character(CS) :: hist_option integer :: hist_n @@ -74,6 +76,7 @@ module med_phases_history_mod ! Time averaging history files ! ---------------------------- type, public :: avgfile_type + type(file_desc_t) :: io_file logical :: write_avg type(ESMF_FieldBundle) :: FBaccum_import ! field bundle for time averaging integer :: accumcnt_import ! field bundle accumulation counter @@ -93,6 +96,7 @@ module med_phases_history_mod ! Auxiliary history files ! ---------------------------- type, public :: auxfile_type + type(file_desc_t) :: io_file character(CS), allocatable :: flds(:) ! array of aux field names character(CS) :: auxname ! name for history file creation character(CL) :: histfile = '' ! current history file name @@ -155,6 +159,7 @@ subroutine med_phases_history_write(gcomp, rc) integer, intent(out) :: rc ! local variables + type(file_desc_t) :: io_file type(InternalState) :: is_local type(ESMF_Clock) :: mclock type(ESMF_Alarm) :: alarm @@ -292,23 +297,23 @@ subroutine med_phases_history_write(gcomp, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, rc, clobber=.true.) + call med_io_wopen(hist_file, io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Loop over whead/wdata phases do m = 1,2 if (m == 2) then - call med_io_enddef(hist_file) + call med_io_enddef(io_file) end if ! Write time values if (whead(m)) then call ESMF_ClockGet(mclock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_write_time(io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -316,49 +321,49 @@ subroutine med_phases_history_write(gcomp, rc) ! Write import and export field bundles if (is_local%wrap%comp_present(n)) then if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), & is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBexp(n), whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBexp(n), whead(m), wdata(m), & is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif end if ! Write mediator fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBFrac(n), whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBFrac(n), whead(m), wdata(m), & is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='Med_frac_'//trim(compname(n)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write component mediator area field bundles - call med_io_write(hist_file, is_local%wrap%FBArea(n), whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBArea(n), whead(m), wdata(m), & is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='MED_'//trim(compname(n)), rc=rc) end do ! Write atm/ocn fluxes and ocean albedoes if field bundles are created if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_alb_ocn', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_aoflux_ocn', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) end if end do ! end of loop over whead/wdata m index phases ! Close file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! end of write_now if-block @@ -464,44 +469,44 @@ subroutine med_phases_history_write_med(gcomp, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, rc, clobber=.true.) + call med_io_wopen(hist_file, instfiles(compmed)%io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then call ESMF_ClockGet(instfiles(compmed)%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(instfiles(compmed)%io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_enddef(hist_file) - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_enddef(instfiles(compmed)%io_file) + call med_io_write_time(instfiles(compmed)%io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write aoflux fields computed in mediator if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & + call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_aoflux_ocn', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & + call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) end if ! If appropriate - write ocn albedos computed in mediator if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & + call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_alb_ocn', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & + call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', rc=rc) end if end do ! end of loop over m ! Close file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(instfiles(compmed)%io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! end of if-write_now block @@ -525,6 +530,7 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) integer , intent(out) :: rc ! local variables + type(file_desc_t) :: io_file type(InternalState) :: is_local type(ESMF_VM) :: vm type(ESMF_Clock) :: clock @@ -598,7 +604,7 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, rc, clobber=.true.) + call med_io_wopen(hist_file, io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write data to history file @@ -606,20 +612,20 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) if (whead(m)) then call ESMF_ClockGet(clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_enddef(hist_file) - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_enddef(io_file) + call med_io_write_time(io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call med_io_write(hist_file, fldbun, whead(m), wdata(m), is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & + call med_io_write(io_file, fldbun, whead(m), wdata(m), is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & nt=1, pre=trim(compname(complnd))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do ! end of loop over m ! Close history file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine med_phases_history_write_lnd2glc @@ -752,18 +758,18 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, rc, clobber=.true.) + call med_io_wopen(hist_file, instfile%io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then call ESMF_ClockGet(instfile%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(instfile%io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_enddef(hist_file) - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_enddef(instfile%io_file) + call med_io_write_time(instfile%io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -771,19 +777,19 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) ny = is_local%wrap%ny(compid) ! Define/write import field bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBimp(compid,compid), whead(m), wdata(m), nx, ny, & + call med_io_write(instfile%io_file, is_local%wrap%FBimp(compid,compid), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(compid))//'Imp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Define/write import export bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBexp(compid), whead(m), wdata(m), nx, ny, & + call med_io_write(instfile%io_file, is_local%wrap%FBexp(compid), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(compid))//'Exp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Define/Write mediator fractions if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(compid),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBFrac(compid), whead(m), wdata(m), nx, ny, & + call med_io_write(instfile%io_file, is_local%wrap%FBFrac(compid), whead(m), wdata(m), nx, ny, & nt=1, pre='Med_frac_'//trim(compname(compid)), tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -791,7 +797,7 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) end do ! end of loop over m ! Close file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(instfile%io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -957,18 +963,18 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, rc, clobber=.true.) + call med_io_wopen(hist_file, avgfile%io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then call ESMF_ClockGet(avgfile%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(avgfile%io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_enddef(hist_file) - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_enddef(avgfile%io_file) + call med_io_write_time(avgfile%io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -977,7 +983,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) nx = is_local%wrap%nx(compid) ny = is_local%wrap%ny(compid) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then - call med_io_write(hist_file, avgfile%FBaccum_import, whead(m), wdata(m), nx, ny, & + call med_io_write(avgfile%io_file, avgfile%FBaccum_import, whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(compid))//'Imp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (wdata(m)) then @@ -986,7 +992,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) end if endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then - call med_io_write(hist_file, avgfile%FBaccum_export, whead(m), wdata(m), nx, ny, & + call med_io_write(avgfile%io_file, avgfile%FBaccum_export, whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(compid))//'Exp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (wdata(m)) then @@ -998,7 +1004,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) end do ! end of loop over m ! Close file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(avgfile%io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! end of write_now if-block @@ -1281,40 +1287,40 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! open file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(auxcomp%files(nf)%histfile, vm, rc, file_ind=nf, clobber=.true.) + call med_io_wopen(auxcomp%files(nf)%histfile, auxcomp%files(nf)%io_file, vm, rc, file_ind=nf, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! define time variables call ESMF_ClockGet(auxcomp%files(nf)%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, file_ind=nf, rc=rc) + call med_io_define_time(auxcomp%files(nf)%io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! define data variables with a time dimension (include the nt argument below) - call med_io_write(auxcomp%files(nf)%histfile, is_local%wrap%FBimp(compid,compid), & + call med_io_write(auxcomp%files(nf)%io_file, is_local%wrap%FBimp(compid,compid), & whead(1), wdata(1), nx, ny, nt=auxcomp%files(nf)%nt, & pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, & - file_ind=nf, use_float=.true., rc=rc) + use_float=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! end definition phase - call med_io_enddef(auxcomp%files(nf)%histfile, file_ind=nf) + call med_io_enddef(auxcomp%files(nf)%io_file) end if ! Write time variables for time nt - call med_io_write_time(time_val, time_bnds, nt=auxcomp%files(nf)%nt, file_ind=nf, rc=rc) + call med_io_write_time(auxcomp%files(nf)%io_file, time_val, time_bnds, nt=auxcomp%files(nf)%nt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write data variables for time nt if (auxcomp%files(nf)%doavg) then - call med_io_write(auxcomp%files(nf)%histfile, auxcomp%files(nf)%FBaccum, whead(2), wdata(2), nx, ny, & - nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, file_ind=nf, rc=rc) + call med_io_write(auxcomp%files(nf)%io_file, auxcomp%files(nf)%FBaccum, whead(2), wdata(2), nx, ny, & + nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(auxcomp%files(nf)%FBaccum, value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_write(auxcomp%files(nf)%histfile, is_local%wrap%FBimp(compid,compid), whead(2), wdata(2), nx, ny, & - nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, file_ind=nf, rc=rc) + call med_io_write(auxcomp%files(nf)%io_file, is_local%wrap%FBimp(compid,compid), whead(2), wdata(2), nx, ny, & + nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -1322,7 +1328,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) if (auxcomp%files(nf)%nt == auxcomp%files(nf)%ntperfile) then call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_close(auxcomp%files(nf)%histfile, vm, file_ind=nf, rc=rc) + call med_io_close(auxcomp%files(nf)%io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return auxcomp%files(nf)%nt = 0 end if diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 3b276b08..a225ff97 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -13,7 +13,7 @@ module med_phases_restart_mod use med_phases_prep_glc_mod , only : FBlndAccum2glc_l, lndAccum2glc_cnt use med_phases_prep_glc_mod , only : FBocnAccum2glc_o, ocnAccum2glc_cnt use med_phases_prep_rof_mod , only : FBlndAccum2rof_l, lndAccum2rof_cnt - + use pio , only : file_desc_t implicit none private @@ -143,6 +143,7 @@ subroutine med_phases_restart_write(gcomp, rc) integer, intent(out) :: rc ! local variables + type(file_desc_t) :: io_file type(ESMF_VM) :: vm type(ESMF_Clock) :: clock type(ESMF_Time) :: starttime @@ -309,12 +310,12 @@ subroutine med_phases_restart_write(gcomp, rc) call ESMF_LogWrite(trim(subname)//": write "//trim(restart_file), ESMF_LOGMSG_INFO) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(restart_file, vm, rc, clobber=.true.) + call med_io_wopen(restart_file, io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 if (m == 2) then - call med_io_enddef(restart_file) + call med_io_enddef(io_file) end if tbnds = days_since @@ -322,23 +323,23 @@ subroutine med_phases_restart_write(gcomp, rc) if (whead(m)) then call ESMF_ClockGet(clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_write_time(days_since, tbnds=(/days_since,days_since/), nt=1, rc=rc) + call med_io_write_time(io_file, days_since, tbnds=(/days_since,days_since/), nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write out next ymd/tod in place of curr ymd/tod because the ! restart represents the time at end of the current timestep ! and that is where we want to start the next run. - call med_io_write(restart_file, start_ymd, 'start_ymd', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, start_ymd, 'start_ymd', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, start_tod, 'start_tod', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, start_tod, 'start_tod', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, next_ymd , 'curr_ymd' , whead(m), wdata(m), rc=rc) + call med_io_write(io_file, next_ymd , 'curr_ymd' , whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, next_tod , 'curr_tod' , whead(m), wdata(m), rc=rc) + call med_io_write(io_file, next_tod , 'curr_tod' , whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ncomps @@ -347,19 +348,19 @@ subroutine med_phases_restart_write(gcomp, rc) ny = is_local%wrap%ny(n) ! Write import field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - call med_io_write(restart_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(n))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Write export field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then - call med_io_write(restart_file, is_local%wrap%FBexp(n), whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBexp(n), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(n))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Write fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then - call med_io_write(restart_file, is_local%wrap%FBfrac(n), whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBfrac(n), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(n))//'Frac', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -370,10 +371,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccumOcn)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) - call med_io_write(restart_file, is_local%wrap%FBExpAccumOcn, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBExpAccumOcn, whead(m), wdata(m), nx, ny, & nt=1, pre='ocnExpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, is_local%wrap%ExpAccumOcnCnt, 'ocnExpAccum_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, is_local%wrap%ExpAccumOcnCnt, 'ocnExpAccum_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -381,10 +382,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccumWav)) then nx = is_local%wrap%nx(compwav) ny = is_local%wrap%ny(compwav) - call med_io_write(restart_file, is_local%wrap%FBExpAccumWav, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBExpAccumWav, whead(m), wdata(m), nx, ny, & nt=1, pre='wavExpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, is_local%wrap%ExpAccumWavCnt, 'wavExpAccum_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, is_local%wrap%ExpAccumWavCnt, 'wavExpAccum_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -392,10 +393,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(FBlndAccum2rof_l)) then nx = is_local%wrap%nx(complnd) ny = is_local%wrap%ny(complnd) - call med_io_write(restart_file, FBlndAccum2rof_l, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, FBlndAccum2rof_l, whead(m), wdata(m), nx, ny, & nt=1, pre='lndImpAccum2rof', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, lndAccum2rof_cnt, 'lndImpAccum2rof_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, lndAccum2rof_cnt, 'lndImpAccum2rof_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -403,10 +404,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(FBlndAccum2glc_l)) then nx = is_local%wrap%nx(complnd) ny = is_local%wrap%ny(complnd) - call med_io_write(restart_file, FBlndAccum2glc_l, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, FBlndAccum2glc_l, whead(m), wdata(m), nx, ny, & nt=1, pre='lndImpAccum2glc', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, lndAccum2glc_cnt, 'lndImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, lndAccum2glc_cnt, 'lndImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -414,10 +415,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(FBocnAccum2glc_o)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) - call med_io_write(restart_file, FBocnAccum2glc_o, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, FBocnAccum2glc_o, whead(m), wdata(m), nx, ny, & nt=1, pre='ocnImpAccum2glc_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, ocnAccum2glc_cnt, 'ocnImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, ocnAccum2glc_cnt, 'ocnImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -425,7 +426,7 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) - call med_io_write(restart_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), nx, ny, & nt=1, pre='MedOcnAlb_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -438,11 +439,11 @@ subroutine med_phases_restart_write(gcomp, rc) if (auxcomp(nc)%files(nf)%doavg .and. auxcomp(nc)%files(nf)%accumcnt > 0) then nx = is_local%wrap%nx(nc) ny = is_local%wrap%ny(nc) - call med_io_write(restart_file, auxcomp(nc)%files(nf)%FBaccum, & + call med_io_write(io_file, auxcomp(nc)%files(nf)%FBaccum, & whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(nc))//trim(auxcomp(nc)%files(nf)%auxname), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, auxcomp(nc)%files(nf)%accumcnt, & + call med_io_write(io_file, auxcomp(nc)%files(nf)%accumcnt, & trim(compname(nc))//trim(auxcomp(nc)%files(nf)%auxname)//'_accumcnt', & whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -453,7 +454,7 @@ subroutine med_phases_restart_write(gcomp, rc) enddo ! end of whead/wdata loop ! Close file - call med_io_close(restart_file, vm, rc=rc) + call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif From 4490cffdc06f2664022c621034cbd24222ef535d Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 11 May 2023 10:25:37 -0600 Subject: [PATCH 48/61] ntperfile should be type integer --- cime_config/namelist_definition_drv.xml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 5cbf7831..f6e1d444 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1347,7 +1347,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. @@ -1414,7 +1414,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. @@ -1483,7 +1483,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. @@ -1548,7 +1548,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. @@ -1766,7 +1766,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. @@ -2011,7 +2011,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. From 57e1970552fb68d88d7cdf4e3a84d511bd03f006 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 11 May 2023 11:27:08 -0600 Subject: [PATCH 49/61] remove unused variable --- mediator/med_io_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 9215777c..3a8fb2d6 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -616,7 +616,6 @@ subroutine med_io_close(io_file, rc) ! local variables - integer :: iam character(*),parameter :: subName = '(med_io_close) ' !------------------------------------------------------------------------------- From 5d7470d052b391d8fc7bbd57e5e5641a439abad2 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 11 May 2023 13:44:12 -0600 Subject: [PATCH 50/61] CESM_COUPLED should be CESMCOUPLED --- mediator/med_methods_mod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 3d29fde6..faecf47a 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2530,7 +2530,7 @@ subroutine med_methods_FB_check_for_nans(FB, rc) ! ---------------------------------------------- rc = ESMF_SUCCESS -#ifndef CESM_COUPLED +#ifndef CESMCOUPLED ! For now only CESM uses shr_infnan_isnan - so until other models provide this RETURN #endif @@ -2571,7 +2571,7 @@ subroutine med_methods_FB_check_for_nans(FB, rc) end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- -#ifdef CESM_COUPLED +#ifdef CESMCOUPLED subroutine med_methods_check_for_nans_1d(dataptr, nancount) use shr_infnan_mod, only: shr_infnan_isnan @@ -2590,7 +2590,7 @@ subroutine med_methods_check_for_nans_1d(dataptr, nancount) end subroutine med_methods_check_for_nans_1d subroutine med_methods_check_for_nans_2d(dataptr, nancount) - use shr_infnan_mod, only: shr_infan_isnan + use shr_infnan_mod, only: shr_infnan_isnan ! input/output variables real(r8) , intent(in) :: dataptr(:,:) integer , intent(out) :: nancount @@ -2600,7 +2600,7 @@ subroutine med_methods_check_for_nans_2d(dataptr, nancount) nancount = 0 do k = 1,size(dataptr, dim=1) do n = 1,size(dataptr, dim=2) - if (shr_infan_isnan(dataptr(k,n))) then + if (shr_infnan_isnan(dataptr(k,n))) then nancount = nancount + 1 end if end do From b60c9d7f6089de5ecb2e6784a21c84f6906a6d75 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Thu, 11 May 2023 13:58:56 -0600 Subject: [PATCH 51/61] Candidate fixes of descriptions and comments --- cime_config/namelist_definition_drv.xml | 44 ++++++++++++------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index f6e1d444..bfe99138 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1235,7 +1235,7 @@ - + logical aux_hist @@ -1267,7 +1267,7 @@ integer aux_hist MED_attributes - history option type + history option span 1 @@ -1300,7 +1300,7 @@ - + logical aux_hist @@ -1332,7 +1332,7 @@ integer aux_hist MED_attributes - history option type + history option span 1 @@ -1365,7 +1365,7 @@ - + logical aux_hist @@ -1381,7 +1381,7 @@ char aux_hist MED_attributes - Auxiliary mediator atm2med precipitation history output every 3 hours + Auxiliary mediator atm2med precipitation fields history output every 3 hours Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl @@ -1399,7 +1399,7 @@ integer aux_hist MED_attributes - history option type + history option span 3 @@ -1432,13 +1432,13 @@ - + logical aux_hist MED_attributes - Auxiliary mediator a2x precipitation history output every 3 hours + Auxiliary mediator a2x dynamic, radiation, and precipitation history output every 3 hours .false. @@ -1449,7 +1449,7 @@ aux_hist MED_attributes - Auxiliary mediator a2x precipitation history output every 3 hours + Auxiliary mediator a2x dynamic, radiation, and precipitation fields history output every 3 hours Sa_z:Sa_topo:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_dens:Sa_pbot:Sa_pslv:Faxa_lwdn:Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:Sa_co2diag:Sa_co2prog @@ -1468,7 +1468,7 @@ integer aux_hist MED_attributes - history option type + history option span 3 @@ -1501,12 +1501,12 @@ - + logical aux_hist MED_attributes - Auxiliary mediator a2x precipitation history output every 3 hours + Auxiliary mediator a2x aerosol and ghg history output daily or endofrun .false. @@ -1515,7 +1515,7 @@ char aux_hist MED_attributes - Auxiliary mediator a2x precipitation history output every 3 hours + Auxiliary mediator a2x aerosol and ghg history output daily or endofrun Faxa_bcph:Faxa_ocph:Faxa_dstwet:Faxa_dstdry:Sa_co2prog:Sa_co2diag @@ -1533,9 +1533,9 @@ integer aux_hist MED_attributes - history option type + history option span - 1 + 3 @@ -1553,7 +1553,7 @@ MED_attributes Number of time samples per file. - 1 + 2 @@ -1801,7 +1801,7 @@ - + logical aux_hist @@ -1978,7 +1978,7 @@ char aux_hist MED_attributes - Auxiliary mediator rof2med precipitation history output. + Auxiliary mediator rof2med precipitation fields history output. all @@ -1996,9 +1996,9 @@ integer aux_hist MED_attributes - history option type + history option span - 6 + 3 @@ -2016,7 +2016,7 @@ MED_attributes Number of time samples per file. - 1 + 2 From 42a5fd537fd166eea08a8a132cc159c25a471ec6 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 11 May 2023 15:39:03 -0600 Subject: [PATCH 52/61] remove dead code --- mediator/med_io_mod.F90 | 17 ----------------- 1 file changed, 17 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 3a8fb2d6..d55ebc72 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -75,10 +75,6 @@ module med_io_mod character(*),parameter :: prefix = "med_io_" character(*),parameter :: modName = "(med_io_mod) " character(*),parameter :: version = "cmeps0" - integer , parameter :: number_strlen = 8 - integer , parameter :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now - -! character(CL) :: wfilename(0:file_desc_t_cnt) = '' integer :: pio_iotype integer :: pio_ioformat @@ -546,9 +542,6 @@ subroutine med_io_wopen(filename, io_file, vm, rc, clobber, file_ind, model_doi_ if (.not. pio_file_is_open(io_file)) then - ! filename not open -! wfilename(lfile_ind) = trim(filename) - if (med_io_file_exists(vm, filename)) then if (lclobber) then nmode = pio_clobber @@ -585,16 +578,6 @@ subroutine med_io_wopen(filename, io_file, vm, rc, clobber, file_ind, model_doi_ rcode = pio_put_att(io_file,pio_global,"model_doi_url",lmodel_doi_url) endif -! elseif (trim(wfilename(lfile_ind)) /= trim(filename)) then - ! filename is open, better match open filename -! if (iam==0) then -! write(logunit,'(a)') trim(subname)//' different filename currently open '//trim(filename) -! write(logunit,'(a)') trim(subname)//' different wfilename currently open '//trim(wfilename(lfile_ind)) -! end if -! call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_ERROR) -! rc = ESMF_FAILURE -! return - else ! filename is already open, just return endif From 96206b6366dca33da7fe20021c71a5f0db8ace7a Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 12 May 2023 08:54:52 -0600 Subject: [PATCH 53/61] adjust indentation --- mediator/med_phases_history_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index e647dc64..5f150a4b 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -60,7 +60,7 @@ module med_phases_history_mod ! Instantaneous history files datatypes/variables per component ! ---------------------------- type, public :: instfile_type - type(file_desc_t) :: io_file + type(file_desc_t):: io_file logical :: write_inst character(CS) :: hist_option integer :: hist_n @@ -76,7 +76,7 @@ module med_phases_history_mod ! Time averaging history files ! ---------------------------- type, public :: avgfile_type - type(file_desc_t) :: io_file + type(file_desc_t) :: io_file logical :: write_avg type(ESMF_FieldBundle) :: FBaccum_import ! field bundle for time averaging integer :: accumcnt_import ! field bundle accumulation counter @@ -96,7 +96,7 @@ module med_phases_history_mod ! Auxiliary history files ! ---------------------------- type, public :: auxfile_type - type(file_desc_t) :: io_file + type(file_desc_t) :: io_file character(CS), allocatable :: flds(:) ! array of aux field names character(CS) :: auxname ! name for history file creation character(CL) :: histfile = '' ! current history file name From a587023727e73bbdffec5b8daff5bcb93385e670 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 May 2023 14:20:46 -0600 Subject: [PATCH 54/61] 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 397a92ba..8ff5f95f 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 b3acbdeb..608ad18b 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 3ed57c00..4fdd630e 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 55/61] 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 99f362f3..13811aec 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 06001565..c09a63c5 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 5331a545..2fd83972 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 ae38f995..de3fd21a 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 56/61] 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 de3fd21a..46c7c93f 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 57/61] 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 46c7c93f..48055e92 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) ' !----------------------------------------------------------------------- From dabe6d3ae5592adc2520a1203b9d34c0d37df08d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 23 May 2023 14:56:23 -0600 Subject: [PATCH 58/61] make xgrid default (should have been in alpha12c) and fix sw flux to mom ocn --- cime_config/namelist_definition_drv.xml | 2 +- mediator/med_phases_prep_ocn_mod.F90 | 6 +++++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index fdc53d43..57baa922 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -927,7 +927,7 @@ default: xgrid - ogrid + xgrid diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 60e37a95..7d895058 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -383,7 +383,11 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Check that the necessary export field is present - if ( .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then + if ( .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc) .and. & + .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc) .and. & + .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & + .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & + .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc)) then return end if From e94015a90bcee1cea45a6f30f78eab5e292dd6f6 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 23 May 2023 17:56:49 -0600 Subject: [PATCH 59/61] slight change in logic --- mediator/med_phases_prep_ocn_mod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 7d895058..c19a4cf4 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -384,10 +384,10 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) ! Check that the necessary export field is present if ( .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc) .and. & - .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc) .and. & - .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & - .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & - .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc)) then + .not. (FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc))) then return end if From 97ed1fe6523255c40eb460faca74565a9d4a5ffb Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 25 May 2023 09:36:49 +0200 Subject: [PATCH 60/61] addition of BLOM logic to key XML settings like CPL_SEQ_OPTION --- cime_config/config_component_cesm.xml | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index dbf3b11e..18bec3d7 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -190,6 +190,7 @@ 24 24 + 24 @@ -198,6 +199,7 @@ 24 144 24 + 24 24 @@ -236,9 +238,8 @@ 1 - + - 24 48 run_coupling @@ -286,6 +287,8 @@ 48 1 24 + 24 + 48 run_coupling env_run.xml @@ -335,11 +338,13 @@ 1 $ATM_NCPL + $ATM_NCPL $ATM_NCPL $ATM_NCPL 1 8 8 + 8 $ATM_NCPL 1 $ATM_NCPL @@ -361,7 +366,6 @@ where basedt is equal to NCPL_BASE_PERIOD in seconds. - @@ -421,6 +425,7 @@ OPTION2 OPTION2 OPTION1 + OPTION1 OPTION1 OPTION1 OPTION2 From 48c247fbd59a545cbb06f11f451fb9b14c11d816 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 25 May 2023 14:49:08 +0200 Subject: [PATCH 61/61] made ogrid default for aoflux calculation - since xgrid crashes for f19_tnx1v4 --- cime_config/namelist_definition_drv.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 5812542d..bfe99138 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -927,7 +927,7 @@ default: ogrid - xgrid + ogrid