From 710c5874963427f19877c9c8a5963cef5e6538fe Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 19 Dec 2025 15:53:31 -0700 Subject: [PATCH 01/66] Copy shr_lnd2rof_tracers_mod from noresm branch Copying from noresm branch at 6539501e This is needed for https://github.com/ESCOMP/CDEPS/pull/364 Co-authored-by: Mariana Vertenstein --- .../shr_lnd2rof_tracers_mod.F90 | 95 +++++++++++++++++++ 1 file changed, 95 insertions(+) create mode 100644 cesm/nuopc_cap_share/shr_lnd2rof_tracers_mod.F90 diff --git a/cesm/nuopc_cap_share/shr_lnd2rof_tracers_mod.F90 b/cesm/nuopc_cap_share/shr_lnd2rof_tracers_mod.F90 new file mode 100644 index 000000000..079a0a77b --- /dev/null +++ b/cesm/nuopc_cap_share/shr_lnd2rof_tracers_mod.F90 @@ -0,0 +1,95 @@ +module shr_lnd2rof_tracers_mod + + !======================================================================== + ! read lnd2rof_tracers_inparm namelist and sets up driver list of fields for + ! lnd -> river communications + !======================================================================== + + use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet + use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS + use shr_sys_mod , only : shr_sys_abort + use shr_log_mod , only : shr_log_getLogUnit + use shr_kind_mod , only : r8 => shr_kind_r8, cs => shr_kind_cs + use shr_nl_mod , only : shr_nl_find_group_name + use shr_mpi_mod , only : shr_mpi_bcast + + implicit none + private + + ! !PUBLIC MEMBER FUNCTIONS + public :: shr_lnd2rof_tracers_readnl ! Read namelist + + character(len=*), parameter :: & + u_FILE_u=__FILE__ + +!==================================================================================== +CONTAINS +!==================================================================================== + + subroutine shr_lnd2rof_tracers_readnl(NLFilename, lnd2rof_tracer_list) + + ! input/output variables + character(len=*), intent(in) :: NLFilename ! Namelist filename + character(len=*), intent(out) :: lnd2rof_tracer_list ! Colon delimited string of liquid lnd2rof tracers + + !----- local ----- + type(ESMF_VM) :: vm + integer :: i ! Indices + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not + integer :: rc + integer :: localpet + integer :: mpicom + integer :: logunit + character(len=CS) :: lnd2rof_tracers + character(*),parameter :: subName = '(shr_lnd2rof_tracers_readnl) ' + ! ------------------------------------------------------------------ + + namelist /lnd2rof_tracers_inparm/ lnd2rof_tracers + + !----------------------------------------------------------------------------- + ! Read namelist and figure out the lnd2rof_tracers field list to pass + ! First check if file exists and if not, n_lnd2rof_tracers will be zero + !----------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + !--- Open and read namelist --- + if ( len_trim(NLFilename) == 0 ) then + call shr_sys_abort( subName//'ERROR: nlfilename not set' ) + end if + call shr_log_getLogUnit(logunit) + + lnd2rof_tracers = ' ' + lnd2rof_tracer_list = ' ' + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_VMGet(vm, localPet=localPet, mpiCommunicator=mpicom, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (localpet==0) then + inquire(file=trim(NLFileName), exist=exists) + if ( exists ) then + open(newunit=unitn, file=trim(NLFilename), status='old' ) + call shr_nl_find_group_name(unitn, 'lnd2rof_tracers_inparm', ierr) + if (ierr == 0) then + ! Note that if ierr /= 0, no namelist is present. + read(unitn, lnd2rof_tracers_inparm, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort(trim(subName) //'problem of read of lnd2rof_tracers_inparm ') + endif + endif + close( unitn ) + end if + end if + call shr_mpi_bcast( lnd2rof_tracers, mpicom ) + + if (lnd2rof_tracers /= ' ') then + lnd2rof_tracer_list = trim(lnd2rof_tracers) + end if + + end subroutine shr_lnd2rof_tracers_readnl + +end module shr_lnd2rof_tracers_mod From a65279c27c2556ceffebdf02725d4abf63c86385 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Sat, 20 Dec 2025 09:13:53 -0700 Subject: [PATCH 02/66] remove unneeded dependancy on shr_mpi_mod --- cesm/nuopc_cap_share/shr_lnd2rof_tracers_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_lnd2rof_tracers_mod.F90 b/cesm/nuopc_cap_share/shr_lnd2rof_tracers_mod.F90 index 079a0a77b..da79a18f4 100644 --- a/cesm/nuopc_cap_share/shr_lnd2rof_tracers_mod.F90 +++ b/cesm/nuopc_cap_share/shr_lnd2rof_tracers_mod.F90 @@ -11,7 +11,6 @@ module shr_lnd2rof_tracers_mod use shr_log_mod , only : shr_log_getLogUnit use shr_kind_mod , only : r8 => shr_kind_r8, cs => shr_kind_cs use shr_nl_mod , only : shr_nl_find_group_name - use shr_mpi_mod , only : shr_mpi_bcast implicit none private @@ -84,8 +83,9 @@ subroutine shr_lnd2rof_tracers_readnl(NLFilename, lnd2rof_tracer_list) close( unitn ) end if end if - call shr_mpi_bcast( lnd2rof_tracers, mpicom ) - + call ESMF_VMBroadcast(vm, lnd2rof_tracers, CS, 0, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (lnd2rof_tracers /= ' ') then lnd2rof_tracer_list = trim(lnd2rof_tracers) end if From f40f453ff85f46969c5c7b218316d8edae4acd10 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Sat, 20 Dec 2025 09:54:01 -0700 Subject: [PATCH 03/66] sync with cdeps copy --- cesm/nuopc_cap_share/shr_lnd2rof_tracers_mod.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_lnd2rof_tracers_mod.F90 b/cesm/nuopc_cap_share/shr_lnd2rof_tracers_mod.F90 index da79a18f4..e673983b7 100644 --- a/cesm/nuopc_cap_share/shr_lnd2rof_tracers_mod.F90 +++ b/cesm/nuopc_cap_share/shr_lnd2rof_tracers_mod.F90 @@ -5,7 +5,7 @@ module shr_lnd2rof_tracers_mod ! lnd -> river communications !======================================================================== - use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet + use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS use shr_sys_mod , only : shr_sys_abort use shr_log_mod , only : shr_log_getLogUnit @@ -33,7 +33,6 @@ subroutine shr_lnd2rof_tracers_readnl(NLFilename, lnd2rof_tracer_list) !----- local ----- type(ESMF_VM) :: vm - integer :: i ! Indices integer :: unitn ! namelist unit number integer :: ierr ! error code logical :: exists ! if file exists or not From ed0f5c53c6318bd65e0c8b9fcfd5eae35718ac92 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 29 Dec 2025 15:10:14 -0700 Subject: [PATCH 04/66] Remove a duplicate block from esmFldsExchange_cesm_mod --- mediator/esmFldsExchange_cesm_mod.F90 | 87 --------------------------- 1 file changed, 87 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 5872b5b19..1b49bceab 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -994,93 +994,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - ! --------------------------------------------------------------------- - ! to atm: merged reference temperature at 2 meters - ! to atm: merged 10m wind speed - ! to atm: merged reference specific humidity at 2 meters - ! to atm: merged reference specific water isoptope humidity at 2 meters - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(complnd , 'Sl_tref') - call addfld_from(compice , 'Si_tref') - call addfld_aoflux('So_tref') - call addfld_to(compatm , 'Sx_tref') - else - if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_tref', rc=rc)) then - if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_tref', rc=rc)) then - call addmap_from(complnd , 'Sl_tref', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) - call addmrg_to(compatm , 'Sx_tref', & - mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) - end if - if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_tref', rc=rc)) then - call addmap_from(compice , 'Si_tref', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg_to(compatm , 'Sx_tref', & - mrg_from=compice, mrg_fld='Si_tref', mrg_type='merge', mrg_fracname='ifrac') - end if - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_tref', rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux('So_tref', compatm, mapconsf, 'ofrac', ocn2atm_map) - end if - call addmrg_to(compatm , 'Sx_tref', & - mrg_from=compmed, mrg_fld='So_tref', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - end if - - if (phase == 'advertise') then - call addfld_from(complnd , 'Sl_u10') - call addfld_from(compice , 'Si_u10') - call addfld_aoflux('So_u10') - call addfld_to(compatm , 'Sx_u10') - else - if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_u10', rc=rc)) then - if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_u10', rc=rc)) then - call addmap_from(complnd , 'Sl_u10', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) - call addmrg_to(compatm , 'Sx_u10', & - mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) - end if - if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_u10', rc=rc)) then - call addmap_from(compice , 'Si_u10', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg_to(compatm , 'Sx_u10', & - mrg_from=compice, mrg_fld='Si_u10', mrg_type='merge', mrg_fracname='ifrac') - end if - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_u10', rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux('So_u10', compatm, mapconsf, 'ofrac', ocn2atm_map) - end if - call addmrg_to(compatm , 'Sx_u10', & - mrg_from=compmed, mrg_fld='So_u10', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - end if - - if (phase == 'advertise') then - call addfld_from(complnd , 'Sl_qref') - call addfld_from(compice , 'Si_qref') - call addfld_aoflux('So_qref') - call addfld_to(compatm , 'Sx_qref') - else - if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref', rc=rc)) then - if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref', rc=rc)) then - call addmap_from(complnd , 'Sl_qref', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) - call addmrg_to(compatm , 'Sx_qref', & - mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) - end if - if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref', rc=rc)) then - call addmap_from(compice , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg_to(compatm , 'Sx_qref', & - mrg_from=compice, mrg_fld='Si_qref', mrg_type='merge', mrg_fracname='ifrac') - end if - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_qref', rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux('So_qref', compatm, mapconsf, 'ofrac', ocn2atm_map) - end if - call addmrg_to(compatm , 'Sx_qref', & - mrg_from=compmed, mrg_fld='So_qref', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - end if - ! --------------------------------------------------------------------- ! to atm: merged zonal surface stress ! to atm: merged meridional surface stress From 6a10020dc82991bd0fb1c4b859a468a5734aaa5a Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 5 Dec 2025 13:17:32 -0700 Subject: [PATCH 05/66] Remove some unused behavior from med_methods_FB_init --- mediator/med_methods_mod.F90 | 56 +++++++------------------------ mediator/med_phases_cdeps_mod.F90 | 1 - 2 files changed, 12 insertions(+), 45 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index ac059bc7c..613ed0477 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -223,11 +223,12 @@ end subroutine med_methods_FB_init_pointer !----------------------------------------------------------------------------- - subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, STgeom, FBflds, STflds, name, rc) + subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, STgeom, STflds, name, rc) ! ---------------------------------------------- - ! Create FBout from fieldNameList, FBflds, STflds, FBgeom or STgeom in that order or priority - ! Pass in FBgeom OR STgeom, get mesh from that object + ! Create FBout from fieldNameList or STflds (one of those must be present, but not both) + ! + ! Mesh is retrieved from either FBgeom or STgeom (one of those must be present, but not both) ! ---------------------------------------------- use ESMF , only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleGet @@ -241,7 +242,6 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S character(len=*) , intent(in), optional :: fieldNameList(:) ! names of fields to use in output field bundle type(ESMF_FieldBundle), intent(in), optional :: FBgeom ! input field bundle geometry to use type(ESMF_State) , intent(in), optional :: STgeom ! input state geometry to use - type(ESMF_FieldBundle), intent(in), optional :: FBflds ! input field bundle fields type(ESMF_State) , intent(in), optional :: STflds ! input state fields character(len=*) , intent(in), optional :: name ! name to use for output field bundle integer , intent(out) :: rc @@ -278,8 +278,8 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S ! verify that geom argument has a field !--------------------------------- - if (present(fieldNameList) .and. present(FBflds) .and. present(STflds)) then - call shr_log_error(trim(subname)//": ERROR only fieldNameList, FBflds, or STflds can be an argument", rc=rc) + if (present(fieldNameList) .and. present(STflds)) then + call shr_log_error(trim(subname)//": ERROR only one of fieldNameList or STflds can be an argument", rc=rc) return endif @@ -315,15 +315,6 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from argument", ESMF_LOGMSG_INFO) end if - elseif (present(FBflds)) then - call ESMF_FieldBundleGet(FBflds, fieldCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lfieldNameList(fieldCount)) - call ESMF_FieldBundleGet(FBflds, fieldNameList=lfieldNameList, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from FBflds", ESMF_LOGMSG_INFO) - end if elseif (present(STflds)) then call ESMF_StateGet(STflds, itemCount=fieldCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -333,26 +324,8 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from STflds", ESMF_LOGMSG_INFO) end if - elseif (present(FBgeom)) then - call ESMF_FieldBundleGet(FBgeom, fieldCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lfieldNameList(fieldCount)) - call ESMF_FieldBundleGet(FBgeom, fieldNameList=lfieldNameList, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from FBgeom", ESMF_LOGMSG_INFO) - end if - elseif (present(STgeom)) then - call ESMF_StateGet(STgeom, itemCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lfieldNameList(fieldCount)) - call ESMF_StateGet(STgeom, itemNameList=lfieldNameList, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from STgeom", ESMF_LOGMSG_INFO) - end if else - call shr_log_error(trim(subname)//": ERROR fieldNameList, FBflds, STflds, FBgeom, or STgeom must be passed", rc=rc) + call shr_log_error(trim(subname)//": ERROR fieldNameList or STflds must be passed", rc=rc) return endif @@ -426,17 +399,12 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S ! Now loop over all the fields in the field name list do n = 1, fieldCount - ! Note that input fields come from ONE of FBFlds, STflds, or fieldNamelist input argument - if (present(FBFlds) .or. present(STflds)) then + ! Note that input fields come from ONE of STflds or fieldNamelist input argument + if (present(STflds)) then - ! ungridded dimensions might be present in the input states or field bundles - if (present(FBflds)) then - call ESMF_FieldBundleGet(FBflds, fieldName=lfieldnamelist(n), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - elseif (present(STflds)) then - call ESMF_StateGet(STflds, itemName=trim(lfieldnamelist(n)), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + ! ungridded dimensions might be present in the input states + call ESMF_StateGet(STflds, itemName=trim(lfieldnamelist(n)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Determine ungridded lower and upper bounds for lfield call ESMF_AttributeGet(lfield, name="UngriddedUBound", convention="NUOPC", & diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index 4f37b6f79..9fe869bb2 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -20,7 +20,6 @@ module med_phases_cdeps_mod use med_methods_mod , only: FB_FldChk => med_methods_FB_FldChk use med_methods_mod , only: FB_getFieldN => med_methods_FB_getFieldN use med_methods_mod , only: FB_getNumflds => med_methods_FB_getNumflds - use med_methods_mod , only: FB_init => med_methods_FB_Init use med_methods_mod , only: FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only: FB_write => med_methods_FB_write use med_methods_mod , only: FB_GetFldPtr => med_methods_FB_GetFldPtr From 957a93e4e14701d2121a44bf17174b7c791f1bf8 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 23 Dec 2025 14:59:53 -0700 Subject: [PATCH 06/66] Refactor med_methods_FB_init to allow handling of water tracer fields Rather than having med_methods_FB_init accept one of fieldNameList or STflds, now it accepts an array of med_field_info_type objects. med_field_info_type is defined in a new module that also includes some creation methods, making calls to med_methods_FB_init a two-step process: first create field_info_array, then call med_methods_FB_init with this field_info_array. A key new feature is that the creation of a field_info_array from field_names will assume a single ungridded dimension with size given by shr_wtracers_get_num_tracers for any field with the water tracer suffix. This was the main motivation for the refactor here. Some specific notes about the changes in this commit: - Behavior change: if there are only scalar or blank fields, we do some unnecessary work now (retrieving the mesh that we won't end up ever using) - I think I got the gridToFieldMap right: before it was hard-coded to 2, but I think that was only right for a single ungridded dimension; here I'm generalizing that for multiple ungridded dimensions --- mediator/med.F90 | 22 ++- mediator/med_field_info_mod.F90 | 220 +++++++++++++++++++++++++++ mediator/med_fraction_mod.F90 | 26 +++- mediator/med_methods_mod.F90 | 129 ++++------------ mediator/med_phases_aofluxes_mod.F90 | 36 ++++- mediator/med_phases_history_mod.F90 | 24 ++- mediator/med_phases_prep_glc_mod.F90 | 10 +- mediator/med_phases_prep_ocn_mod.F90 | 9 +- mediator/med_phases_prep_wav_mod.F90 | 9 +- 9 files changed, 367 insertions(+), 118 deletions(-) create mode 100644 mediator/med_field_info_mod.F90 diff --git a/mediator/med.F90 b/mediator/med.F90 index d7e0d20f5..1f3507b89 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -37,6 +37,8 @@ module MED use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_getFieldN => med_methods_FB_getFieldN use med_methods_mod , only : clock_timeprint => med_methods_clock_timeprint + use med_field_info_mod , only : med_field_info_type + use med_field_info_mod , only : med_field_info_array_from_names_wtracers_ungridded, med_field_info_array_from_state use med_utils_mod , only : memcheck => med_memcheck use med_internalstate_mod , only : InternalState, med_internalstate_init, med_internalstate_coupling use med_internalstate_mod , only : med_internalstate_defaultmasks, logunit, maintask @@ -1636,6 +1638,7 @@ subroutine DataInitialize(gcomp, rc) ! local variables type(InternalState) :: is_local + type(med_field_info_type), allocatable :: field_info_array(:) type(ESMF_Clock) :: clock type(ESMF_State) :: importState, exportState type(ESMF_Time) :: time @@ -1749,19 +1752,25 @@ subroutine DataInitialize(gcomp, rc) trim(compname(n1))//'_'//trim(compname(n2)) end if + call med_field_info_array_from_state( & + state = is_local%wrap%NStateImp(n1), & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check import FB, if there is no field in it then use export FB ! to provide mesh information call State_GetNumFields(is_local%wrap%NStateImp(n2), fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldCount == 0) then call FB_init(is_local%wrap%FBImp(n1,n2), is_local%wrap%flds_scalar_name, & + field_info_array=field_info_array, & STgeom=is_local%wrap%NStateExp(n2), & - STflds=is_local%wrap%NStateImp(n1), & name='FBImp'//trim(compname(n1))//'_'//trim(compname(n2)), rc=rc) else call FB_init(is_local%wrap%FBImp(n1,n2), is_local%wrap%flds_scalar_name, & + field_info_array=field_info_array, & STgeom=is_local%wrap%NStateImp(n2), & - STflds=is_local%wrap%NStateImp(n1), & name='FBImp'//trim(compname(n1))//'_'//trim(compname(n2)), rc=rc) end if if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1789,14 +1798,19 @@ subroutine DataInitialize(gcomp, rc) allocate(fldnames(fieldCount)) call med_fldList_getfldnames(fldListMed_ocnalb%fields, fldnames, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_field_info_array_from_names_wtracers_ungridded( & + field_names = fldnames, & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_init(is_local%wrap%FBMed_ocnalb_a, is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames, name='FBMed_ocnalb_a', rc=rc) + field_info_array=field_info_array, STgeom=is_local%wrap%NStateImp(compatm), name='FBMed_ocnalb_a', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (maintask) then write(logunit,'(a)') trim(subname)//' initializing FB FBMed_ocnalb_a' end if call FB_init(is_local%wrap%FBMed_ocnalb_o, is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames, name='FBMed_ocnalb_o', rc=rc) + field_info_array = field_info_array, STgeom=is_local%wrap%NStateImp(compocn), name='FBMed_ocnalb_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (maintask) then write(logunit,'(a)') trim(subname)//' initializing FB FBMed_ocnalb_o' diff --git a/mediator/med_field_info_mod.F90 b/mediator/med_field_info_mod.F90 new file mode 100644 index 000000000..0955b3989 --- /dev/null +++ b/mediator/med_field_info_mod.F90 @@ -0,0 +1,220 @@ +module med_field_info_mod + + !----------------------------------------------------------------------------- + ! Defines a type and related operations for storing metadata about fields that can be + ! used to create an ESMF FieldBundle. + !----------------------------------------------------------------------------- + + use ESMF, only : ESMF_MAXSTR, ESMF_SUCCESS + use ESMF, only : ESMF_Field, ESMF_State, ESMF_AttributeGet, ESMF_StateGet + use med_utils_mod, only : ChkErr => med_utils_ChkErr + use shr_log_mod, only : shr_log_error + use shr_string_mod, only : shr_string_withoutSuffix + use shr_wtracers_mod, only : WTRACERS_SUFFIX, shr_wtracers_get_num_tracers + + implicit none + private + + !----------------------------------------------- + ! Public methods + !----------------------------------------------- + + public :: med_field_info_create ! Create a single field + public :: med_field_info_array_from_names_wtracers_ungridded ! Create an array of field_info objects based on an array of names, where water tracers are given an ungridded dimension + public :: med_field_info_array_from_state ! Create an array of field_info objects based on the fields in an ESMF State + + !----------------------------------------------- + ! Types + !----------------------------------------------- + + type, public :: med_field_info_type + character(ESMF_MAXSTR) :: name + integer :: n_ungridded ! number of ungridded dimensions + + ! These arrays will be allocated to be of size ungridded_count + integer, allocatable :: ungridded_lbound(:) + integer, allocatable :: ungridded_ubound(:) + end type med_field_info_type + + character(len=*),parameter :: u_FILE_u = & + __FILE__ + +!================================================================================ +contains +!================================================================================ + + function med_field_info_create(name, ungridded_lbound, ungridded_ubound, rc) result(field_info) + ! Create a single field + + ! input/output variables + character(len=*), intent(in) :: name + + ! ungridded_lbound and ungridded_ubound must either both be present or both be absent; + ! if present, they must be the same size + integer, intent(in), optional :: ungridded_lbound(:) + integer, intent(in), optional :: ungridded_ubound(:) + + integer, intent(out) :: rc + type(med_field_info_type) :: field_info ! function result + + ! local variables + integer :: n_ungridded + character(len=*), parameter :: subname = '(med_field_info_create)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + if (present(ungridded_lbound) .neqv. present(ungridded_ubound)) then + call shr_log_error( & + subname//": ERROR: ungridded_lbound and ungridded_ubound must both be present or both absent.", & + line=__LINE__, file=u_FILE_u, rc=rc) + return + end if + + field_info%name = name + + if (present(ungridded_lbound)) then + n_ungridded = size(ungridded_lbound) + if (size(ungridded_ubound) /= n_ungridded) then + call shr_log_error( & + subname//": ERROR: ungridded_lbound and ungridded_ubound must have the same size.", & + line=__LINE__, file=u_FILE_u, rc=rc) + return + end if + field_info%n_ungridded = n_ungridded + allocate(field_info%ungridded_lbound(n_ungridded)) + allocate(field_info%ungridded_ubound(n_ungridded)) + field_info%ungridded_lbound = ungridded_lbound + field_info%ungridded_ubound = ungridded_ubound + else + field_info%n_ungridded = 0 + end if + + end function med_field_info_create + + !----------------------------------------------------------------------------- + + subroutine med_field_info_array_from_names_wtracers_ungridded(field_names, field_info_array, rc) + ! Create an array of field_info objects based on an array of names, where water + ! tracers are given an ungridded dimension. + ! + ! It is assumed that fields generally have no ungridded dimensions. However, for + ! fields ending with the water tracer suffix, it is instead assumed that they have a + ! single ungridded dimension of size given by shr_wtracers_get_num_tracers. + + ! input/output variables + character(len=*), intent(in) :: field_names(:) + type(med_field_info_type), allocatable, intent(out) :: field_info_array(:) + integer, intent(out) :: rc + + ! local variables + integer :: i, n_fields + logical :: is_tracer + integer :: n_tracers + integer :: localrc + character(len=*), parameter :: subname = '(med_field_info_array_from_names_wtracers_ungridded)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + n_fields = size(field_names) + allocate(field_info_array(n_fields)) + n_tracers = shr_wtracers_get_num_tracers() + + do i = 1, n_fields + call shr_string_withoutSuffix( & + in_str = field_names(i), & + suffix = WTRACERS_SUFFIX, & + has_suffix = is_tracer, & + rc = localrc) + if (localrc /= 0) then + call shr_log_error(subname//": ERROR in shr_string_withoutSuffix", rc=rc) + return + end if + + if (is_tracer) then + ! Field is a water tracer; assume a single ungridded dimension + field_info_array(i) = med_field_info_create( & + name=field_names(i), & + ungridded_lbound=[1], & + ungridded_ubound=[n_tracers], & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + ! Not a water tracer; assume no ungridded dimensions + field_info_array(i) = med_field_info_create( & + name=field_names(i), & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end do + + end subroutine med_field_info_array_from_names_wtracers_ungridded + + subroutine med_field_info_array_from_state(state, field_info_array, rc) + ! Create an array of field_info objects based on the Fields in an ESMF State + + ! input/output variables + type(ESMF_State), intent(in) :: state + type(med_field_info_type), allocatable, intent(out) :: field_info_array(:) + integer, intent(out) :: rc + + ! local variables + integer :: i, n_fields + character(ESMF_MAXSTR), allocatable :: field_names(:) + type(ESMF_Field) :: field + logical :: is_present + integer :: n_ungridded + integer, allocatable :: ungridded_lbound(:) + integer, allocatable :: ungridded_ubound(:) + character(len=*), parameter :: subname = '(med_field_info_array_from_state)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(state, itemCount=n_fields, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(field_names(n_fields)) + allocate(field_info_array(n_fields)) + call ESMF_StateGet(state, itemNameList=field_names, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do i = 1, n_fields + call ESMF_StateGet(state, itemName=trim(field_names(i)), field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_AttributeGet(field, name="UngriddedUBound", convention="NUOPC", & + purpose="Instance", itemCount=n_ungridded, isPresent=is_present, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (.not. is_present) then + n_ungridded = 0 + end if + + if (n_ungridded == 0) then + field_info_array(i) = med_field_info_create( & + name=field_names(i), & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + allocate(ungridded_lbound(n_ungridded)) + allocate(ungridded_ubound(n_ungridded)) + call ESMF_AttributeGet(field, name="UngriddedLBound", convention="NUOPC", & + purpose="Instance", valueList=ungridded_lbound, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_AttributeGet(field, name="UngriddedUBound", convention="NUOPC", & + purpose="Instance", valueList=ungridded_ubound, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + field_info_array(i) = med_field_info_create( & + name=field_names(i), & + ungridded_lbound=ungridded_lbound, & + ungridded_ubound=ungridded_ubound, & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + deallocate(ungridded_lbound) + deallocate(ungridded_ubound) + end if + end do + + end subroutine med_field_info_array_from_state + +end module med_field_info_mod diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 7f9cfb8ba..d4c8968ba 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -135,6 +135,8 @@ module med_fraction_mod use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_map_mod , only : med_map_field use med_internalstate_mod , only : ncomps, samegrid_atmlnd + use med_field_info_mod , only : med_field_info_type + use med_field_info_mod , only : med_field_info_array_from_names_wtracers_ungridded, med_field_info_array_from_state implicit none private @@ -189,6 +191,7 @@ subroutine med_fraction_init(gcomp, rc) type(InternalState) :: is_local type(ESMF_Field) :: field_src type(ESMF_Field) :: field_dst + type(med_field_info_type), allocatable :: field_info_array(:) real(R8), pointer :: frac(:) real(R8), pointer :: ofrac(:) real(R8), pointer :: aofrac(:) @@ -255,13 +258,18 @@ subroutine med_fraction_init(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! create FBFrac + call med_field_info_array_from_names_wtracers_ungridded( & + field_names = fraclist(:,n1), & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldCount == 0) then call fldbun_init(is_local%wrap%FBfrac(n1), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateExp(n1), fieldNameList=fraclist(:,n1), & + field_info_array=field_info_array, STgeom=is_local%wrap%NStateExp(n1), & name='FBfrac'//trim(compname(n1)), rc=rc) else call fldbun_init(is_local%wrap%FBfrac(n1), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(n1), fieldNameList=fraclist(:,n1), & + field_info_array=field_info_array, STgeom=is_local%wrap%NStateImp(n1), & name='FBfrac'//trim(compname(n1)), rc=rc) end if if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -673,9 +681,14 @@ subroutine med_fraction_init(gcomp, rc) if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compocn,:),mapfcopy, rc=rc)) then if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compice,compocn))) then + call med_field_info_array_from_state( & + state = is_local%wrap%NStateImp(compice), & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_init(is_local%wrap%FBImp(compice,compocn), is_local%wrap%flds_scalar_name, & + field_info_array=field_info_array, & STgeom=is_local%wrap%NStateImp(compocn), & - STflds=is_local%wrap%NStateImp(compice), & name='FBImp'//trim(compname(compice))//'_'//trim(compname(compocn)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -687,9 +700,14 @@ subroutine med_fraction_init(gcomp, rc) end if if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compice,:),mapfcopy, rc=rc)) then if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compice))) then + call med_field_info_array_from_state( & + state = is_local%wrap%NStateImp(compocn), & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_init(is_local%wrap%FBImp(compocn,compice), is_local%wrap%flds_scalar_name, & + field_info_array = field_info_array, & STgeom=is_local%wrap%NStateImp(compice), & - STflds=is_local%wrap%NStateImp(compocn), & name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compice)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 613ed0477..26dfa773b 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -15,6 +15,7 @@ module med_methods_mod use med_constants_mod , only : czero => med_constants_czero use med_constants_mod , only : spval_init => med_constants_spval_init use med_utils_mod , only : ChkErr => med_utils_ChkErr + use med_field_info_mod , only : med_field_info_type use shr_log_mod , only : shr_log_error implicit none private @@ -223,12 +224,14 @@ end subroutine med_methods_FB_init_pointer !----------------------------------------------------------------------------- - subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, STgeom, STflds, name, rc) + subroutine med_methods_FB_init(FBout, flds_scalar_name, field_info_array, FBgeom, STgeom, name, rc) ! ---------------------------------------------- - ! Create FBout from fieldNameList or STflds (one of those must be present, but not both) + ! Create FBout from field_info_array (see med_field_info_mod for some convenience + ! functions for creating a field_info array from field names or an ESMF State) ! - ! Mesh is retrieved from either FBgeom or STgeom (one of those must be present, but not both) + ! Mesh is retrieved from either FBgeom or STgeom (one of those must be present, but + ! not both) ! ---------------------------------------------- use ESMF , only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleGet @@ -239,26 +242,19 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S ! input/output variables type(ESMF_FieldBundle), intent(inout) :: FBout ! output field bundle character(len=*) , intent(in) :: flds_scalar_name ! name of scalar fields - character(len=*) , intent(in), optional :: fieldNameList(:) ! names of fields to use in output field bundle + type(med_field_info_type), intent(in) :: field_info_array(:) ! info on the fields to put in the output FieldBundle type(ESMF_FieldBundle), intent(in), optional :: FBgeom ! input field bundle geometry to use type(ESMF_State) , intent(in), optional :: STgeom ! input state geometry to use - type(ESMF_State) , intent(in), optional :: STflds ! input state fields character(len=*) , intent(in), optional :: name ! name to use for output field bundle integer , intent(out) :: rc ! local variables - integer :: n,n1 + integer :: n integer :: fieldCount,fieldCountgeom character(ESMF_MAXSTR) :: lname type(ESMF_Field) :: field,lfield type(ESMF_Mesh) :: lmesh type(ESMF_MeshLoc) :: meshloc - integer :: ungriddedCount - integer :: ungriddedCount_in - integer, allocatable :: ungriddedLBound(:) - integer, allocatable :: ungriddedUBound(:) - logical :: isPresent - character(ESMF_MAXSTR), allocatable :: lfieldNameList(:) character(len=*), parameter :: subname='(med_methods_FB_init)' ! ---------------------------------------------- @@ -278,11 +274,6 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S ! verify that geom argument has a field !--------------------------------- - if (present(fieldNameList) .and. present(STflds)) then - call shr_log_error(trim(subname)//": ERROR only one of fieldNameList or STflds can be an argument", rc=rc) - return - endif - if (present(FBgeom) .and. present(STgeom)) then call shr_log_error(trim(subname)//": ERROR FBgeom and STgeom cannot both be arguments", rc=rc) return @@ -305,43 +296,12 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S endif !--------------------------------- - ! determine the names of fields that will be in FBout + ! Determine number of fields + ! + ! Note that scalars and blank fields will be removed later !--------------------------------- - if (present(fieldNameList)) then - fieldcount = size(fieldNameList) - allocate(lfieldNameList(fieldcount)) - lfieldNameList = fieldNameList - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from argument", ESMF_LOGMSG_INFO) - end if - elseif (present(STflds)) then - call ESMF_StateGet(STflds, itemCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lfieldNameList(fieldCount)) - call ESMF_StateGet(STflds, itemNameList=lfieldNameList, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from STflds", ESMF_LOGMSG_INFO) - end if - else - call shr_log_error(trim(subname)//": ERROR fieldNameList or STflds must be passed", rc=rc) - return - endif - - !--------------------------------- - ! remove scalar field and blank fields from field bundle - !--------------------------------- - - do n = 1, fieldCount - if (trim(lfieldnamelist(n)) == trim(flds_scalar_name) .or. & - trim(lfieldnamelist(n)) == '') then - do n1 = n, fieldCount-1 - lfieldnamelist(n1) = lfieldnamelist(n1+1) - enddo - fieldCount = fieldCount - 1 - endif - enddo ! n + fieldCount = size(field_info_array) !--------------------------------- ! create the mesh(lmesh) that will be used for FBout fields @@ -399,56 +359,31 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S ! Now loop over all the fields in the field name list do n = 1, fieldCount - ! Note that input fields come from ONE of STflds or fieldNamelist input argument - if (present(STflds)) then - - ! ungridded dimensions might be present in the input states - call ESMF_StateGet(STflds, itemName=trim(lfieldnamelist(n)), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Don't add scalar field or blank fields to field bundle + if (field_info_array(n)%name == flds_scalar_name .or. & + len_trim(field_info_array(n)%name) == 0) then + cycle + end if - ! Determine ungridded lower and upper bounds for lfield - call ESMF_AttributeGet(lfield, name="UngriddedUBound", convention="NUOPC", & - purpose="Instance", itemCount=ungriddedCount_in, isPresent=isPresent, rc=rc) + ! Create the field + if (field_info_array(n)%n_ungridded > 0) then + field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, & + name=field_info_array(n)%name, & + ungriddedLbound=field_info_array(n)%ungridded_lbound, & + ungriddedUbound=field_info_array(n)%ungridded_ubound, & + gridToFieldMap=[field_info_array(n)%n_ungridded+1], & + rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - ungriddedCount = ungriddedCount_in - else - ungriddedCount=0 ! initialize in case it was not set - end if - - ! Create the field on a lmesh - if (ungriddedCount > 0) then - ! ungridded dimensions in field - allocate(ungriddedLBound(ungriddedCount), ungriddedUBound(ungriddedCount)) - call ESMF_AttributeGet(lfield, name="UngriddedLBound", convention="NUOPC", & - purpose="Instance", valueList=ungriddedLBound, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_AttributeGet(lfield, name="UngriddedUBound", convention="NUOPC", & - purpose="Instance", valueList=ungriddedUBound, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), & - ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, gridToFieldMap=(/2/)) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - deallocate( ungriddedLbound, ungriddedUbound) - else - ! No ungridded dimensions in field - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - - else if (present(fieldNameList)) then - - ! Assume no ungridded dimensions if just the field name list is give - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), rc=rc) + else + field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, & + name=field_info_array(n)%name, & + rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - ! Add the created field bundle FBout + ! Add the created field to field bundle FBout if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" adding field "//trim(lfieldNameList(n)), & + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" adding field "//trim(field_info_array(n)%name), & ESMF_LOGMSG_INFO) end if call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) @@ -457,8 +392,6 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S enddo ! fieldCount endif ! fieldcountgeom - deallocate(lfieldNameList) - call med_methods_FB_reset(FBout, value=spval_init, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 9417e2528..f4151c5be 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -31,6 +31,8 @@ module med_phases_aofluxes_mod 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 + use med_field_info_mod , only : med_field_info_type + use med_field_info_mod , only : med_field_info_array_from_names_wtracers_ungridded, med_field_info_array_from_state use perf_mod , only : t_startf, t_stopf #ifndef CESMCOUPLED use ufs_const_mod , only : rearth => SHR_CONST_REARTH @@ -173,6 +175,7 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) integer :: fieldcount type(med_fldList_type), pointer :: fldListMed_aoflux type(InternalState) :: is_local + type(med_field_info_type), allocatable :: field_info_array(:) character(len=*),parameter :: subname=' (med_phases_aofluxes_init_fldbuns) ' !--------------------------------------- @@ -190,9 +193,16 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) call med_fldList_getfldnames(fldListMed_aoflux%fields, fldnames_aof_out, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Create field_info_array for FBMed_aoflux_a and FBMed_aoflux_o + call med_field_info_array_from_names_wtracers_ungridded( & + field_names = fldnames_aof_out, & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Initialize FBMed_aoflux_a call FB_init(is_local%wrap%FBMed_aoflux_a, is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames_aof_out, name='FBMed_aoflux_a', rc=rc) + field_info_array=field_info_array, STgeom=is_local%wrap%NStateImp(compatm), name='FBMed_aoflux_a', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (maintask) then write(logunit,*) @@ -201,7 +211,7 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) ! Initialize FBMed_aoflux_o call FB_init(is_local%wrap%FBMed_aoflux_o, is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames_aof_out, name='FBMed_aoflux_o', rc=rc) + field_info_array=field_info_array, STgeom=is_local%wrap%NStateImp(compocn), name='FBMed_aoflux_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (maintask) then write(logunit,'(a)') trim(subname)//' initialized FB FBMed_aoflux_o' @@ -219,8 +229,13 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) if (maintask) then write(logunit,'(a)') trim(subname)//' creating field bundle FBImp(compatm,compocn)' end if + call med_field_info_array_from_state( & + state = is_local%wrap%NStateImp(compatm), & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_init(is_local%wrap%FBImp(compatm,compocn), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compocn), STflds=is_local%wrap%NStateImp(compatm), & + field_info_array=field_info_array, STgeom=is_local%wrap%NStateImp(compocn), & name='FBImp'//trim(compname(compatm))//'_'//trim(compname(compocn)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -234,8 +249,13 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) if (maintask) then write(logunit,'(a)') trim(subname)//' creating field bundle FBImp(compocn,compatm)' end if + call med_field_info_array_from_state( & + state = is_local%wrap%NStateImp(compocn), & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_init(is_local%wrap%FBImp(compocn,compatm), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compatm), STflds=is_local%wrap%NStateImp(compocn), & + field_info_array = field_info_array, STgeom=is_local%wrap%NStateImp(compatm), & name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compatm)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -606,6 +626,7 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) integer :: maptype type(ESMF_Field) :: lfield type(ESMF_Mesh) :: lmesh + type(med_field_info_type), allocatable :: field_info_array(:) real(R8), pointer :: garea(:) => null() type(ESMF_CoordSys_Flag) :: coordSys character(len=*),parameter :: subname=' (med_aofluxes_init_atmgrid) ' @@ -623,8 +644,13 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) allocate(fldnames_ocn_in(4)) fldnames_ocn_in = (/'So_omask','So_t ','So_u ','So_v '/) + call med_field_info_array_from_names_wtracers_ungridded( & + field_names = fldnames_ocn_in, & + field_info_array = field_info_array, & + rc = rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call FB_init(FBocn_a, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBImp(compatm,compatm), fieldnamelist=fldnames_ocn_in, name='FBocn_a', rc=rc) + field_info_array=field_info_array, FBgeom=is_local%wrap%FBImp(compatm,compatm), name='FBocn_a', rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call set_aoflux_in_pointers(is_local%wrap%FBImp(compatm,compatm), FBocn_a, aoflux_in, lsize, rc=rc) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index fd533d70c..d0b049580 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -21,6 +21,7 @@ module med_phases_history_mod use med_internalstate_mod , only : ncomps, compname use med_internalstate_mod , only : InternalState, maintask, logunit use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close + use med_field_info_mod , only : med_field_info_type, med_field_info_array_from_state use perf_mod , only : t_startf, t_stopf use pio , only : file_desc_t use shr_log_mod , only : shr_log_error @@ -843,6 +844,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) ! local variables type(InternalState) :: is_local + type(med_field_info_type), allocatable :: field_info_array(:) character(CL) :: cvalue ! attribute string character(CL) :: hist_option ! freq_option setting (ndays, nsteps, etc) integer :: hist_n ! freq_n setting relative to freq_option @@ -907,8 +909,13 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) scalar_name = trim(is_local%wrap%flds_scalar_name) if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid)) .and. .not. & ESMF_FieldBundleIsCreated(avgfile%FBaccum_import)) then + call med_field_info_array_from_state( & + state = is_local%wrap%NStateImp(compid), & + field_info_array = field_info_array, & + rc = rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_init(avgfile%FBaccum_import, scalar_name, & - STgeom=is_local%wrap%NStateImp(compid), STflds=is_local%wrap%NStateImp(compid), rc=rc) + field_info_array=field_info_array, STgeom=is_local%wrap%NStateImp(compid), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(avgfile%FBaccum_import, czero, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -916,8 +923,13 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) end if if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid)) .and. .not. & ESMF_FieldBundleIsCreated(avgfile%FBaccum_export)) then + call med_field_info_array_from_state( & + state = is_local%wrap%NStateExp(compid), & + field_info_array = field_info_array, & + rc = rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_init(avgfile%FBaccum_export, scalar_name, & - STgeom=is_local%wrap%NStateExp(compid), STflds=is_local%wrap%NStateExp(compid), rc=rc) + field_info_array=field_info_array, STgeom=is_local%wrap%NStateExp(compid), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(avgfile%FBaccum_export, czero, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1050,6 +1062,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! local variables type(InternalState) :: is_local + type(med_field_info_type), allocatable :: field_info_array(:) type(ESMF_VM) :: vm type(ESMF_Calendar) :: calendar ! calendar type logical :: isPresent ! is attribute present @@ -1179,8 +1192,13 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) call ESMF_LogWrite(trim(subname)// ": initializing FBaccum(compid)", ESMF_LOGMSG_INFO) if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compid,compid)) .and. .not. & ESMF_FieldBundleIsCreated(auxcomp%files(nfcnt)%FBaccum)) then + call med_field_info_array_from_state( & + state = is_local%wrap%NStateImp(compid), & + field_info_array = field_info_array, & + rc = rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_init(auxcomp%files(nfcnt)%FBaccum, is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compid), STflds=is_local%wrap%NStateImp(compid), & + field_info_array=field_info_array, STgeom=is_local%wrap%NStateImp(compid), & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(auxcomp%files(nfcnt)%FBaccum, czero, rc=rc) diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index e0e29089a..e218db9d9 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -38,6 +38,7 @@ module med_phases_prep_glc_mod use med_methods_mod , only : field_getdata2d => med_methods_Field_getdata2d use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d use med_methods_mod , only : fldchk => med_methods_FB_FldChk + use med_field_info_mod , only : med_field_info_type, med_field_info_array_from_state use med_utils_mod , only : chkerr => med_utils_ChkErr use nuopc_shr_methods , only : alarmInit use glc_elevclass_mod , only : glc_get_num_elevation_classes @@ -131,6 +132,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) ! local variables type(InternalState) :: is_local + type(med_field_info_type), allocatable :: field_info_array(:) integer :: n,ns,nf type(ESMF_Mesh) :: mesh_l type(ESMF_Mesh) :: mesh_o @@ -286,9 +288,13 @@ subroutine med_phases_prep_glc_init(gcomp, rc) ! Create route handle if it has not been created - this will be needed to map the fractions if (.not. med_map_RH_is_created(is_local%wrap%RH(compglc(ns),complnd,:),mapconsd, rc=rc)) then if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compglc(ns),complnd))) then + call med_field_info_array_from_state( & + state = is_local%wrap%NStateImp(compglc(ns)), & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_init(is_local%wrap%FBImp(compglc(ns),complnd), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(complnd), & - STflds=is_local%wrap%NStateImp(compglc(ns)), & + field_info_array=field_info_array, STgeom=is_local%wrap%NStateImp(complnd), & name='FBImp'//trim(compname(compglc(ns)))//'_'//trim(compname(complnd)), rc=rc) end if call med_map_routehandles_init( compglc(ns), complnd, & diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index e30c4ada5..f4f9bd3b0 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -20,6 +20,7 @@ module med_phases_prep_ocn_mod 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 med_field_info_mod , only : med_field_info_type, med_field_info_array_from_state 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 @@ -51,6 +52,7 @@ subroutine med_phases_prep_ocn_init(gcomp, rc) ! local variables type(InternalState) :: is_local + type(med_field_info_type), allocatable :: field_info_array(:) character(len=*),parameter :: subname=' (med_phases_prep_ocn_init) ' !--------------------------------------- @@ -64,8 +66,13 @@ subroutine med_phases_prep_ocn_init(gcomp, rc) if (maintask) then write(logunit,'(a)') trim(subname)//' initializing ocean export accumulation FB for ' end if + call med_field_info_array_from_state( & + state = is_local%wrap%NStateExp(compocn), & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_init(is_local%wrap%FBExpAccumOcn, is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateExp(compocn), STflds=is_local%wrap%NStateExp(compocn), & + field_info_array=field_info_array, STgeom=is_local%wrap%NStateExp(compocn), & name='FBExpAccumOcn', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_reset(is_local%wrap%FBExpAccumOcn, value=czero, rc=rc) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 1cfd158be..f732f4dc6 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -18,6 +18,7 @@ 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 use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans + use med_field_info_mod , only : med_field_info_type, med_field_info_array_from_state use esmFlds , only : med_fldList_GetfldListTo use med_internalstate_mod , only : compatm, compwav use perf_mod , only : t_startf, t_stopf @@ -47,6 +48,7 @@ subroutine med_phases_prep_wav_init(gcomp, rc) ! local variables type(InternalState) :: is_local + type(med_field_info_type), allocatable :: field_info_array(:) character(len=*),parameter :: subname=' (med_phases_prep_wav_init) ' !--------------------------------------- @@ -60,8 +62,13 @@ subroutine med_phases_prep_wav_init(gcomp, rc) if (maintask) then write(logunit,'(a)') trim(subname)//' initializing wave export accumulation FB for ' end if + call med_field_info_array_from_state( & + state = is_local%wrap%NStateExp(compwav), & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_Init(is_local%wrap%FBExpAccumWav, is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateExp(compwav), STflds=is_local%wrap%NStateExp(compwav), & + field_info_array = field_info_array, STgeom=is_local%wrap%NStateExp(compwav), & name='FBExpAccumWav', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_reset(is_local%wrap%FBExpAccumWav, value=czero, rc=rc) From b27c568568efbb6b90ad2c330bab85b1391bbacb Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 23 Dec 2025 18:15:49 -0700 Subject: [PATCH 07/66] For now, hard-code n_tracers = 0 We haven't set that up here; we'll fix this in an upcoming set of changes. --- mediator/med_field_info_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/med_field_info_mod.F90 b/mediator/med_field_info_mod.F90 index 0955b3989..3856fa93b 100644 --- a/mediator/med_field_info_mod.F90 +++ b/mediator/med_field_info_mod.F90 @@ -10,7 +10,7 @@ module med_field_info_mod use med_utils_mod, only : ChkErr => med_utils_ChkErr use shr_log_mod, only : shr_log_error use shr_string_mod, only : shr_string_withoutSuffix - use shr_wtracers_mod, only : WTRACERS_SUFFIX, shr_wtracers_get_num_tracers + use shr_wtracers_mod, only : WTRACERS_SUFFIX implicit none private @@ -119,7 +119,9 @@ subroutine med_field_info_array_from_names_wtracers_ungridded(field_names, field n_fields = size(field_names) allocate(field_info_array(n_fields)) - n_tracers = shr_wtracers_get_num_tracers() + ! For now, hard-code n_tracers, since we haven't set up the tracer information; we'll + ! fix this in an upcoming set of changes + n_tracers = 0 do i = 1, n_fields call shr_string_withoutSuffix( & From b6247289971ea7c10c670c5dbc3a3fffaab9e5de Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 30 Dec 2025 14:56:49 -0700 Subject: [PATCH 08/66] Add new file to CMakeLists.txt --- mediator/CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/mediator/CMakeLists.txt b/mediator/CMakeLists.txt index 80be3d2e8..b65004c37 100644 --- a/mediator/CMakeLists.txt +++ b/mediator/CMakeLists.txt @@ -1,6 +1,7 @@ project(cmeps Fortran) set(SRCFILES esmFldsExchange_cesm_mod.F90 med_fraction_mod.F90 + med_field_info_mod.F90 med_methods_mod.F90 med_phases_prep_ice_mod.F90 med_phases_restart_mod.F90 esmFldsExchange_hafs_mod.F90 med_internalstate_mod.F90 med_phases_aofluxes_mod.F90 From 36bb56ff9345e74c6ce7892e6899bb116fa9fef4 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 30 Dec 2025 15:03:15 -0700 Subject: [PATCH 09/66] Minor cleanup suggested in review --- mediator/med_field_info_mod.F90 | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/mediator/med_field_info_mod.F90 b/mediator/med_field_info_mod.F90 index 3856fa93b..be8a132bc 100644 --- a/mediator/med_field_info_mod.F90 +++ b/mediator/med_field_info_mod.F90 @@ -5,11 +5,11 @@ module med_field_info_mod ! used to create an ESMF FieldBundle. !----------------------------------------------------------------------------- - use ESMF, only : ESMF_MAXSTR, ESMF_SUCCESS - use ESMF, only : ESMF_Field, ESMF_State, ESMF_AttributeGet, ESMF_StateGet - use med_utils_mod, only : ChkErr => med_utils_ChkErr - use shr_log_mod, only : shr_log_error - use shr_string_mod, only : shr_string_withoutSuffix + use ESMF , only : ESMF_MAXSTR, ESMF_SUCCESS + use ESMF , only : ESMF_Field, ESMF_State, ESMF_AttributeGet, ESMF_StateGet + use med_utils_mod , only : ChkErr => med_utils_ChkErr + use shr_log_mod , only : shr_log_error + use shr_string_mod , only : shr_string_withoutSuffix use shr_wtracers_mod, only : WTRACERS_SUFFIX implicit none @@ -19,9 +19,15 @@ module med_field_info_mod ! Public methods !----------------------------------------------- - public :: med_field_info_create ! Create a single field - public :: med_field_info_array_from_names_wtracers_ungridded ! Create an array of field_info objects based on an array of names, where water tracers are given an ungridded dimension - public :: med_field_info_array_from_state ! Create an array of field_info objects based on the fields in an ESMF State + ! Create a single field + public :: med_field_info_create + + ! Create an array of field_info objects based on an array of names, where water tracers + ! are given an ungridded dimension + public :: med_field_info_array_from_names_wtracers_ungridded + + ! Create an array of field_info objects based on the fields in an ESMF State + public :: med_field_info_array_from_state !----------------------------------------------- ! Types @@ -101,6 +107,8 @@ subroutine med_field_info_array_from_names_wtracers_ungridded(field_names, field ! It is assumed that fields generally have no ungridded dimensions. However, for ! fields ending with the water tracer suffix, it is instead assumed that they have a ! single ungridded dimension of size given by shr_wtracers_get_num_tracers. + ! + ! field_info_array is allocated here ! input/output variables character(len=*), intent(in) :: field_names(:) @@ -153,8 +161,12 @@ subroutine med_field_info_array_from_names_wtracers_ungridded(field_names, field end subroutine med_field_info_array_from_names_wtracers_ungridded + !----------------------------------------------------------------------------- + subroutine med_field_info_array_from_state(state, field_info_array, rc) ! Create an array of field_info objects based on the Fields in an ESMF State + ! + ! field_info_array is allocated here ! input/output variables type(ESMF_State), intent(in) :: state From f93f145033d6895c7b7f322b421c8bd591d8f786 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 30 Dec 2025 16:05:22 -0700 Subject: [PATCH 10/66] Rename a subroutine, as suggested in review --- mediator/med.F90 | 4 ++-- mediator/med_field_info_mod.F90 | 12 ++++++------ mediator/med_fraction_mod.F90 | 4 ++-- mediator/med_phases_aofluxes_mod.F90 | 6 +++--- 4 files changed, 13 insertions(+), 13 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 1f3507b89..81909d012 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -38,7 +38,7 @@ module MED use med_methods_mod , only : FB_getFieldN => med_methods_FB_getFieldN use med_methods_mod , only : clock_timeprint => med_methods_clock_timeprint use med_field_info_mod , only : med_field_info_type - use med_field_info_mod , only : med_field_info_array_from_names_wtracers_ungridded, med_field_info_array_from_state + use med_field_info_mod , only : med_field_info_array_from_names_wtracers, med_field_info_array_from_state use med_utils_mod , only : memcheck => med_memcheck use med_internalstate_mod , only : InternalState, med_internalstate_init, med_internalstate_coupling use med_internalstate_mod , only : med_internalstate_defaultmasks, logunit, maintask @@ -1798,7 +1798,7 @@ subroutine DataInitialize(gcomp, rc) allocate(fldnames(fieldCount)) call med_fldList_getfldnames(fldListMed_ocnalb%fields, fldnames, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_field_info_array_from_names_wtracers_ungridded( & + call med_field_info_array_from_names_wtracers( & field_names = fldnames, & field_info_array = field_info_array, & rc = rc) diff --git a/mediator/med_field_info_mod.F90 b/mediator/med_field_info_mod.F90 index be8a132bc..04e0c59af 100644 --- a/mediator/med_field_info_mod.F90 +++ b/mediator/med_field_info_mod.F90 @@ -23,8 +23,8 @@ module med_field_info_mod public :: med_field_info_create ! Create an array of field_info objects based on an array of names, where water tracers - ! are given an ungridded dimension - public :: med_field_info_array_from_names_wtracers_ungridded + ! are treated specially (being given an ungridded dimension) + public :: med_field_info_array_from_names_wtracers ! Create an array of field_info objects based on the fields in an ESMF State public :: med_field_info_array_from_state @@ -100,9 +100,9 @@ end function med_field_info_create !----------------------------------------------------------------------------- - subroutine med_field_info_array_from_names_wtracers_ungridded(field_names, field_info_array, rc) + subroutine med_field_info_array_from_names_wtracers(field_names, field_info_array, rc) ! Create an array of field_info objects based on an array of names, where water - ! tracers are given an ungridded dimension. + ! tracers are treated specially (being given an ungridded dimension). ! ! It is assumed that fields generally have no ungridded dimensions. However, for ! fields ending with the water tracer suffix, it is instead assumed that they have a @@ -120,7 +120,7 @@ subroutine med_field_info_array_from_names_wtracers_ungridded(field_names, field logical :: is_tracer integer :: n_tracers integer :: localrc - character(len=*), parameter :: subname = '(med_field_info_array_from_names_wtracers_ungridded)' + character(len=*), parameter :: subname = '(med_field_info_array_from_names_wtracers)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -159,7 +159,7 @@ subroutine med_field_info_array_from_names_wtracers_ungridded(field_names, field end if end do - end subroutine med_field_info_array_from_names_wtracers_ungridded + end subroutine med_field_info_array_from_names_wtracers !----------------------------------------------------------------------------- diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index d4c8968ba..9d58a43d1 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -136,7 +136,7 @@ module med_fraction_mod use med_map_mod , only : med_map_field use med_internalstate_mod , only : ncomps, samegrid_atmlnd use med_field_info_mod , only : med_field_info_type - use med_field_info_mod , only : med_field_info_array_from_names_wtracers_ungridded, med_field_info_array_from_state + use med_field_info_mod , only : med_field_info_array_from_names_wtracers, med_field_info_array_from_state implicit none private @@ -258,7 +258,7 @@ subroutine med_fraction_init(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! create FBFrac - call med_field_info_array_from_names_wtracers_ungridded( & + call med_field_info_array_from_names_wtracers( & field_names = fraclist(:,n1), & field_info_array = field_info_array, & rc = rc) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index f4151c5be..c0d0192b5 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -32,7 +32,7 @@ module med_phases_aofluxes_mod use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_chkerr use med_field_info_mod , only : med_field_info_type - use med_field_info_mod , only : med_field_info_array_from_names_wtracers_ungridded, med_field_info_array_from_state + use med_field_info_mod , only : med_field_info_array_from_names_wtracers, med_field_info_array_from_state use perf_mod , only : t_startf, t_stopf #ifndef CESMCOUPLED use ufs_const_mod , only : rearth => SHR_CONST_REARTH @@ -194,7 +194,7 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Create field_info_array for FBMed_aoflux_a and FBMed_aoflux_o - call med_field_info_array_from_names_wtracers_ungridded( & + call med_field_info_array_from_names_wtracers( & field_names = fldnames_aof_out, & field_info_array = field_info_array, & rc = rc) @@ -644,7 +644,7 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) allocate(fldnames_ocn_in(4)) fldnames_ocn_in = (/'So_omask','So_t ','So_u ','So_v '/) - call med_field_info_array_from_names_wtracers_ungridded( & + call med_field_info_array_from_names_wtracers( & field_names = fldnames_ocn_in, & field_info_array = field_info_array, & rc = rc) From bda86ae82e1303afa60b81db82e9e4f046436681 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 31 Dec 2025 14:56:16 -0700 Subject: [PATCH 11/66] Refactor to use new shr_wtracers_is_wtracer_field function --- mediator/med_field_info_mod.F90 | 14 ++------------ 1 file changed, 2 insertions(+), 12 deletions(-) diff --git a/mediator/med_field_info_mod.F90 b/mediator/med_field_info_mod.F90 index 04e0c59af..3d562c6b2 100644 --- a/mediator/med_field_info_mod.F90 +++ b/mediator/med_field_info_mod.F90 @@ -9,8 +9,7 @@ module med_field_info_mod use ESMF , only : ESMF_Field, ESMF_State, ESMF_AttributeGet, ESMF_StateGet use med_utils_mod , only : ChkErr => med_utils_ChkErr use shr_log_mod , only : shr_log_error - use shr_string_mod , only : shr_string_withoutSuffix - use shr_wtracers_mod, only : WTRACERS_SUFFIX + use shr_wtracers_mod, only : shr_wtracers_is_wtracer_field implicit none private @@ -132,16 +131,7 @@ subroutine med_field_info_array_from_names_wtracers(field_names, field_info_arra n_tracers = 0 do i = 1, n_fields - call shr_string_withoutSuffix( & - in_str = field_names(i), & - suffix = WTRACERS_SUFFIX, & - has_suffix = is_tracer, & - rc = localrc) - if (localrc /= 0) then - call shr_log_error(subname//": ERROR in shr_string_withoutSuffix", rc=rc) - return - end if - + is_tracer = shr_wtracers_is_wtracer_field(field_names(i)) if (is_tracer) then ! Field is a water tracer; assume a single ungridded dimension field_info_array(i) = med_field_info_create( & From 54b5968dc56e952cb010c8844ed501a4d302ca89 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 31 Dec 2025 14:57:21 -0700 Subject: [PATCH 12/66] Add some comments --- mediator/med_field_info_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/med_field_info_mod.F90 b/mediator/med_field_info_mod.F90 index 3d562c6b2..4aec00d87 100644 --- a/mediator/med_field_info_mod.F90 +++ b/mediator/med_field_info_mod.F90 @@ -107,7 +107,8 @@ subroutine med_field_info_array_from_names_wtracers(field_names, field_info_arra ! fields ending with the water tracer suffix, it is instead assumed that they have a ! single ungridded dimension of size given by shr_wtracers_get_num_tracers. ! - ! field_info_array is allocated here + ! field_info_array is allocated here (and, since it has intent(out), it is + ! automatically deallocated if it is already allocated on entry to this subroutine) ! input/output variables character(len=*), intent(in) :: field_names(:) @@ -156,7 +157,8 @@ end subroutine med_field_info_array_from_names_wtracers subroutine med_field_info_array_from_state(state, field_info_array, rc) ! Create an array of field_info objects based on the Fields in an ESMF State ! - ! field_info_array is allocated here + ! field_info_array is allocated here (and, since it has intent(out), it is + ! automatically deallocated if it is already allocated on entry to this subroutine) ! input/output variables type(ESMF_State), intent(in) :: state From ce2297a7cb04697c5de2073f4e3920db4f3b28fe Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 31 Dec 2025 15:48:39 -0700 Subject: [PATCH 13/66] Wrap shr_wtracers_mod This way CESM can use shr_wtracers_mod while UFS uses a stub that removes this CESM_share dependency. --- cesm/share_wrappers/wtracers_mod.F90 | 18 +++++++++++++++ cime_config/buildexe | 1 + mediator/med_field_info_mod.F90 | 4 ++-- ufs/CMakeLists.txt | 2 +- ufs/wtracers_mod.F90 | 34 ++++++++++++++++++++++++++++ 5 files changed, 56 insertions(+), 3 deletions(-) create mode 100644 cesm/share_wrappers/wtracers_mod.F90 create mode 100644 ufs/wtracers_mod.F90 diff --git a/cesm/share_wrappers/wtracers_mod.F90 b/cesm/share_wrappers/wtracers_mod.F90 new file mode 100644 index 000000000..860640720 --- /dev/null +++ b/cesm/share_wrappers/wtracers_mod.F90 @@ -0,0 +1,18 @@ +module wtracers_mod + + !----------------------------------------------------------------------------- + ! This module wraps shr_wtracers_mod from the CESM_share repository to avoid direct + ! dependencies on this share code from CMEPS. + ! + ! See also the version of wtracers_mod in the ufs directory for when we do not have + ! access to the CESM_share library. + !----------------------------------------------------------------------------- + + use shr_wtracers_mod, only : wtracers_is_wtracer_field => shr_wtracers_is_wtracer_field + + implicit none + private + + public :: wtracers_is_wtracer_field ! return true if the given field name is a water tracer field + +end module wtracers_mod diff --git a/cime_config/buildexe b/cime_config/buildexe index 4923f016d..c8664d705 100755 --- a/cime_config/buildexe +++ b/cime_config/buildexe @@ -94,6 +94,7 @@ def _main_func(): if not skip_mediator: out.write(os.path.join(cmeps_dir, "mediator") + "\n") out.write(os.path.join(cmeps_dir, "cesm", "flux_atmocn") + "\n") + out.write(os.path.join(cmeps_dir, "cesm", "share_wrappers") + "\n") out.write(os.path.join(cmeps_dir, "cesm", "driver") + "\n") # build model executable diff --git a/mediator/med_field_info_mod.F90 b/mediator/med_field_info_mod.F90 index 4aec00d87..eb8611197 100644 --- a/mediator/med_field_info_mod.F90 +++ b/mediator/med_field_info_mod.F90 @@ -9,7 +9,7 @@ module med_field_info_mod use ESMF , only : ESMF_Field, ESMF_State, ESMF_AttributeGet, ESMF_StateGet use med_utils_mod , only : ChkErr => med_utils_ChkErr use shr_log_mod , only : shr_log_error - use shr_wtracers_mod, only : shr_wtracers_is_wtracer_field + use wtracers_mod , only : wtracers_is_wtracer_field implicit none private @@ -132,7 +132,7 @@ subroutine med_field_info_array_from_names_wtracers(field_names, field_info_arra n_tracers = 0 do i = 1, n_fields - is_tracer = shr_wtracers_is_wtracer_field(field_names(i)) + is_tracer = wtracers_is_wtracer_field(field_names(i)) if (is_tracer) then ! Field is a water tracer; assume a single ungridded dimension field_info_array(i) = med_field_info_create( & diff --git a/ufs/CMakeLists.txt b/ufs/CMakeLists.txt index bb047dabb..19b34b5ae 100644 --- a/ufs/CMakeLists.txt +++ b/ufs/CMakeLists.txt @@ -1,6 +1,6 @@ project(CMEPS_share Fortran) include(ExternalProject) -add_library(cmeps_share flux_atmocn_mod.F90 glc_elevclass_mod.F90 perf_mod.F90 ufs_const_mod.F90 ufs_kind_mod.F90) +add_library(cmeps_share flux_atmocn_mod.F90 glc_elevclass_mod.F90 perf_mod.F90 ufs_const_mod.F90 ufs_kind_mod.F90 wtracers_mod.F90) target_include_directories (cmeps_share PUBLIC ${CMAKE_CURRENT_SOURCE_DIR} ${ESMF_F90COMPILEPATHS} ${PIO_Fortran_INCLUDE_DIRS}) diff --git a/ufs/wtracers_mod.F90 b/ufs/wtracers_mod.F90 new file mode 100644 index 000000000..17d2f3014 --- /dev/null +++ b/ufs/wtracers_mod.F90 @@ -0,0 +1,34 @@ +module wtracers_mod + + !----------------------------------------------------------------------------- + ! This module provides stub implementations for the shr_wtracers_mod code for when we + ! do not have access to the CESM_share library. + ! + ! See also the version of wtracers_mod in the cesm directory for when we have access to + ! the CESM_share library. + !----------------------------------------------------------------------------- + + implicit none + private + + public :: wtracers_is_wtracer_field ! return true if the given field name is a water tracer field + +contains + + !----------------------------------------------------------------------- + function wtracers_is_wtracer_field(fieldname) + ! + ! !DESCRIPTION: + ! Return true if the given field name is a water tracer field + ! + ! In this stub implementation, we always return false, since water tracers are not + ! implemented here. + ! + ! !ARGUMENTS + character(len=*), intent(in) :: fieldname + logical :: wtracers_is_wtracer_field + !----------------------------------------------------------------------- + wtracers_is_wtracer_field = .false. + end function wtracers_is_wtracer_field + +end module wtracers_mod From c049b227f4288afd1f6efda1ea9ff1039e08e0fc Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 31 Dec 2025 16:02:22 -0700 Subject: [PATCH 14/66] Remove unused variable --- mediator/med_field_info_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_field_info_mod.F90 b/mediator/med_field_info_mod.F90 index eb8611197..197f0a1b1 100644 --- a/mediator/med_field_info_mod.F90 +++ b/mediator/med_field_info_mod.F90 @@ -119,7 +119,6 @@ subroutine med_field_info_array_from_names_wtracers(field_names, field_info_arra integer :: i, n_fields logical :: is_tracer integer :: n_tracers - integer :: localrc character(len=*), parameter :: subname = '(med_field_info_array_from_names_wtracers)' ! ---------------------------------------------- From 8a08402426f880824f6397fa69cab6a70f01c684 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Wed, 4 Oct 2023 15:32:59 +1100 Subject: [PATCH 15/66] add access coupling options --- mediator/med.F90 | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/mediator/med.F90 b/mediator/med.F90 index 81909d012..8579f3d94 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -52,6 +52,7 @@ module MED use esmFldsExchange_ufs_mod , only : esmFldsExchange_ufs use esmFldsExchange_cesm_mod , only : esmFldsExchange_cesm use esmFldsExchange_hafs_mod , only : esmFldsExchange_hafs + use esmFldsExchange_access_mod , only : esmFldsExchange_access use med_phases_profile_mod , only : med_phases_profile_finalize use shr_log_mod , only : shr_log_error @@ -842,6 +843,9 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) else if (coupling_mode(1:4) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + else if (trim(coupling_mode(1:4)) == 'access') then + call esmFldsExchange_access(gcomp, phase='advertise', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return else call shr_log_error(trim(coupling_mode)//' is not a valid coupling_mode', rc=rc) return @@ -1859,6 +1863,9 @@ subroutine DataInitialize(gcomp, rc) else if (coupling_mode(1:4) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + else if (trim(coupling_mode) == 'access') then + call esmFldsExchange_access(gcomp, phase='initialize', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (maintask) then From 3f8f3d2cd507814d724892f34bfe7606e13a862e Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Wed, 4 Oct 2023 15:35:15 +1100 Subject: [PATCH 16/66] add access field exchange module --- mediator/esmFldsExchange_access_mod.F90 | 564 ++++++++++++++++++++++++ 1 file changed, 564 insertions(+) create mode 100644 mediator/esmFldsExchange_access_mod.F90 diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 new file mode 100644 index 000000000..01c31d6c9 --- /dev/null +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -0,0 +1,564 @@ +module esmFldsExchange_access_mod + + use ESMF + use NUOPC + use med_utils_mod , only : chkerr => med_utils_chkerr + use med_kind_mod , only : CX=>SHR_KIND_CX + use med_kind_mod , only : CS=>SHR_KIND_CS + use med_kind_mod , only : CL=>SHR_KIND_CL + use med_kind_mod , only : R8=>SHR_KIND_R8 + use med_internalstate_mod , only : compmed, compatm, compocn, compwav, compice + use med_internalstate_mod , only : ncomps + use med_internalstate_mod , only : coupling_mode + use esmflds , only : fldListTo + use esmflds , only : fldListFr + + !--------------------------------------------------------------------- + ! This is a mediator specific routine that determines ALL possible + ! fields exchanged between components and their associated routing, + ! mapping and merging + !--------------------------------------------------------------------- + + implicit none + public + + public :: esmFldsExchange_access + + character(*), parameter :: u_FILE_u = & + __FILE__ + + !=============================================================================== + contains + !=============================================================================== + + subroutine esmFldsExchange_access(gcomp, phase, rc) + + ! input/output parameters: + type(ESMF_GridComp) :: gcomp + character(len=*) , intent(in) :: phase + integer , intent(inout) :: rc + + ! local variables: + character(len=*) , parameter :: subname='(esmFldsExchange_access)' + !-------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + rc = ESMF_SUCCESS + + if (phase == 'advertise') then + call esmFldsExchange_access_advt(gcomp, phase, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + elseif (phase == 'fieldcheck') then + call esmFldsExchange_access_fchk(gcomp, phase, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + elseif (phase == 'initialize') then + call esmFldsExchange_access_init(gcomp, phase, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogSetError(ESMF_FAILURE, & + msg=trim(subname)//": Phase is set to "//trim(phase), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + + end subroutine esmFldsExchange_access + + !----------------------------------------------------------------------------- + + subroutine esmFldsExchange_access_advt(gcomp, phase, rc) + + use esmFlds, only : addfld => med_fldList_AddFld + + ! input/output parameters: + type(ESMF_GridComp) :: gcomp + character(len=*) , intent(in) :: phase + integer , intent(inout) :: rc + + ! local variables: + integer :: num, i, n + logical :: isPresent + character(len=CL) :: cvalue + character(len=CS) :: name, fldname + character(len=CS) :: fldname1, fldname2 + character(len=CS), allocatable :: flds(:) + character(len=CS), allocatable :: S_flds(:) + character(len=CS), allocatable :: F_flds(:,:) + character(len=CS), allocatable :: suffix(:) + character(len=*) , parameter :: subname='(esmFldsExchange_access_advt)' + !-------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + rc = ESMF_SUCCESS + + !===================================================================== + ! scalar information + !===================================================================== + + call NUOPC_CompAttributeGet(gcomp, name='ScalarFieldName', & + isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", & + value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,ncomps + call addfld(fldListFr(n)%flds, trim(cvalue)) + call addfld(fldListTo(n)%flds, trim(cvalue)) + end do + end if + + + !===================================================================== + ! FIELDS TO MEDIATOR component (for fractions and atm/ocn flux calculation) + !===================================================================== + + !---------------------------------------------------------- + ! to med: masks from components + !---------------------------------------------------------- + call addfld(fldListFr(compocn)%flds, 'So_omask') + call addfld(fldListFr(compice)%flds, 'Si_imask') + + !===================================================================== + ! FIELDS TO ATMOSPHERE + !===================================================================== + + call addfld(fldListTo(compatm)%flds, 'So_ofrac') + call addfld(fldListTo(compatm)%flds, 'Si_ifrac') + + ! --------------------------------------------------------------------- + ! to atm: from ocn + ! --------------------------------------------------------------------- + allocate(S_flds(1)) + S_flds = (/'So_t'/) ! sea_surface_temperature + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld(fldListFr(compocn)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) + end do + deallocate(S_flds) + + ! --------------------------------------------------------------------- + ! to atm: from ice + ! --------------------------------------------------------------------- + call addfld(fldListFr(compice)%flds, 'Si_t') + call addfld(fldListTo(compatm)%flds, 'Si_t') + + !===================================================================== + ! FIELDS TO OCEAN (compocn) + !===================================================================== + + ! --------------------------------------------------------------------- + ! to ocn: state fields + ! --------------------------------------------------------------------- + allocate(S_flds(2)) + S_flds = (/'Sa_pslv', & ! inst_zonal_wind_height10m + 'So_duu10n' /) ! inst_temp_height_surface + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compocn)%flds, trim(fldname)) + end do + deallocate(S_flds) + + ! --------------------------------------------------------------------- + ! to ocn: flux fields + ! --------------------------------------------------------------------- + + ! from atm + allocate(F_flds(13, 2)) + F_flds(1,:) = (/'Faxa_taux ', 'Foxx_taux'/) + F_flds(2,:) = (/'Faxa_tauy ', 'Foxx_tauy'/) + F_flds(3,:) = (/'Foxx_sen', 'Foxx_sen'/) + F_flds(4,:) = (/'Foxx_evap', 'Foxx_evap'/) + F_flds(5,:) = (/'Foxx_lwnet', 'Foxx_lwnet'/) + F_flds(6,:) = (/'Foxx_swnet_vdr', 'Foxx_swnet_vdr'/) + F_flds(7,:) = (/'Foxx_swnet_vdf', 'Foxx_swnet_vdf'/) + F_flds(8,:) = (/'Foxx_swnet_idr', 'Foxx_swnet_idr'/) + F_flds(9,:) = (/'Foxx_swnet_idf', 'Foxx_swnet_idf'/) + F_flds(10,:) = (/'Faxa_rainc', 'Faxa_rain'/) + F_flds(11,:) = (/'Faxa_snowc', 'Faxa_snow'/) + F_flds(12,:) = (/'Foxx_rofl', 'Foxx_rofl'/) ! mean runoff rate (liquid) + F_flds(13,:) = (/'Foxx_rofi', 'Foxx_rofi'/) ! mean runnof rate (frozen) + + do n = 1,size(F_flds,1) + fldname1 = trim(F_flds(n,1)) + fldname2 = trim(F_flds(n,2)) + call addfld(fldListFr(compatm)%flds, trim(fldname1)) + call addfld(fldListTo(compocn)%flds, trim(fldname2)) + end do + deallocate(F_flds) + + call addfld(fldListFr(compatm)%flds, 'Faxa_rainc') + call addfld(fldListFr(compatm)%flds, 'Faxa_snowc') + + ! from ice + allocate(F_flds(6, 2)) + F_flds(1,:) = (/'Fioi_salt', 'Fioi_salt'/) + F_flds(2,:) = (/'Si_ifrac', 'Si_ifrac'/) ! ice_fraction + F_flds(3,:) = (/'Fioi_meltw', 'Fioi_meltw'/) + F_flds(4,:) = (/'Fioi_melth', 'Fioi_melth'/) ! heat flux sea-ice to ocean + F_flds(5,:) = (/'Fioi_taux', 'Foxx_taux'/) + F_flds(6,:) = (/'Fioi_tauy', 'Foxx_tauy'/) ! heat flux sea-ice to ocean + do n = 1,size(F_flds,1) + fldname1 = trim(F_flds(n,1)) + fldname2 = trim(F_flds(n,2)) + call addfld(fldListFr(compice)%flds, trim(fldname1)) + call addfld(fldListTo(compocn)%flds, trim(fldname2)) + end do + deallocate(F_flds) + + !===================================================================== + ! FIELDS TO ICE (compice) + !===================================================================== + + ! --------------------------------------------------------------------- + ! to ice: state fields + ! --------------------------------------------------------------------- + + ! from atm + allocate(S_flds(2)) + S_flds = (/'Sa_z', & + 'Sa_u', & + 'Sa_v', & + 'Sa_shum', & + 'Sa_tbot', & + 'Sa_pbot', & + 'Sa_dens', & + 'Sa_ptem'/) + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compice)%flds, trim(fldname)) + end do + deallocate(S_flds) + + ! from ocn + allocate(S_flds(7)) + S_flds = (/'So_dhdx', & + 'So_dhdy', & + 'So_t', & + 'So_s', & + 'So_u', & + 'So_v', & + 'Fioo_q' /) + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld(fldListFr(compocn)%flds, trim(fldname)) + call addfld(fldListTo(compice)%flds, trim(fldname)) + end do + deallocate(S_flds) + + ! --------------------------------------------------------------------- + ! to ice: flux fields + ! --------------------------------------------------------------------- + allocate(F_flds(7, 2)) + F_flds(1,:) = (/'Faxa_swvdr ', 'Faxa_swvdr '/) + F_flds(2,:) = (/'Faxa_swndr ', 'Faxa_swndr '/) + F_flds(3,:) = (/'Faxa_swvdf', 'Faxa_swvdf'/) + F_flds(4,:) = (/'Faxa_swndf', 'Faxa_swndf'/) + F_flds(5,:) = (/'Faxa_lwdn', 'Faxa_lwdn'/) + F_flds(6,:) = (/'Faxa_rainl', 'Faxa_rain'/) + F_flds(7,:) = (/'Faxa_snowl', 'Faxa_snow'/) + do n = 1,size(F_flds,1) + fldname1 = trim(F_flds(n,1)) + fldname2 = trim(F_flds(n,2)) + call addfld(fldListFr(compatm)%flds, trim(fldname1)) + call addfld(fldListTo(compice)%flds, trim(fldname2)) + end do + deallocate(F_flds) + + call addfld(fldListFr(compatm)%flds, 'Faxa_rainc') + call addfld(fldListFr(compatm)%flds, 'Faxa_snowc') + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + + end subroutine esmFldsExchange_access_advt + + !----------------------------------------------------------------------------- + + subroutine esmFldsExchange_access_fchk(gcomp, phase, rc) + + use med_methods_mod , only : fldchk => med_methods_FB_FldChk + use med_internalstate_mod , only : InternalState + + ! input/output parameters: + type(ESMF_GridComp) :: gcomp + character(len=*) , intent(in) :: phase + integer , intent(inout) :: rc + + ! local variables: + type(InternalState) :: is_local + character(len=*) , parameter :: subname='(esmFldsExchange_access_fchk)' + !-------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + rc = ESMF_SUCCESS + + !--------------------------------------- + ! Get the internal state + !--------------------------------------- + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (fldchk(is_local%wrap%FBImp(compocn,compocn),'So_omask',rc=rc)) then + call ESMF_LogWrite(trim(subname)//": Field connected "//"So_omask", & + ESMF_LOGMSG_INFO) + else + call ESMF_LogSetError(ESMF_FAILURE, & + msg=trim(subname)//": Field is not connected "//"So_omask", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + + end subroutine esmFldsExchange_access_fchk + + !----------------------------------------------------------------------------- + + subroutine esmFldsExchange_access_init(gcomp, phase, rc) + + use med_methods_mod , only : fldchk => med_methods_FB_FldChk + use med_internalstate_mod , only : InternalState + use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch + use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd + use med_internalstate_mod , only : mapfillv_bilnr + use med_internalstate_mod , only : mapnstod_consf + use esmFlds , only : med_fldList_type + use esmFlds , only : addmap => med_fldList_AddMap + use esmFlds , only : addmrg => med_fldList_AddMrg + + ! input/output parameters: + type(ESMF_GridComp) :: gcomp + character(len=*) , intent(in) :: phase + integer , intent(inout) :: rc + + ! local variables: + type(InternalState) :: is_local + integer :: num, i, n + integer :: n1, n2, n3, n4 + character(len=CL) :: cvalue + character(len=CS) :: name, fldname + character(len=CS) :: fldname1, fldname2 + character(len=CS), allocatable :: flds(:) + character(len=CS), allocatable :: S_flds(:) + character(len=CS), allocatable :: F_flds(:,:) + character(len=CS), allocatable :: suffix(:) + character(len=*) , parameter :: subname='(esmFldsExchange_access_init)' + !-------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + rc = ESMF_SUCCESS + + !--------------------------------------- + ! Get the internal state + !--------------------------------------- + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + !===================================================================== + ! FIELDS TO ATMOSPHERE + !===================================================================== + + ! --------------------------------------------------------------------- + ! to atm: sea surface temperature + ! --------------------------------------------------------------------- + call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapconsf, 'ofrac', 'unset') + call addmrg(fldListTo(compatm)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + + call addmap(fldListFr(compice)%flds, 'Si_t', compatm, mapconsf, 'ifrac', 'unset') + call addmrg(fldListTo(compatm)%flds, 'Si_t', mrg_from=compice, mrg_fld='Si_t', mrg_type='copy') + + !===================================================================== + ! FIELDS TO OCEAN (compocn) + !===================================================================== + + ! --------------------------------------------------------------------- + ! to ocn: state fields + ! --------------------------------------------------------------------- + allocate(S_flds(2)) + S_flds = (/'Sa_pslv', & ! inst_zonal_wind_height10m + 'So_duu10n' /) ! inst_temp_height_surface + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compocn), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), trim(fldname), rc=rc) & + ) then + + call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, mapbilnr, 'one', 'unset') + call addmrg(fldListTo(compocn)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + + end if + end do + deallocate(S_flds) + + ! --------------------------------------------------------------------- + ! to ocn: flux fields + ! --------------------------------------------------------------------- + + ! from atm + allocate(F_flds(11, 2)) + F_flds(1,:) = (/'Foxx_sen', 'Foxx_sen'/) + F_flds(2,:) = (/'Foxx_evap', 'Foxx_evap'/) + F_flds(3,:) = (/'Foxx_lwnet', 'Foxx_lwnet'/) + F_flds(4,:) = (/'Foxx_swnet_vdr', 'Foxx_swnet_vdr'/) + F_flds(5,:) = (/'Foxx_swnet_vdf', 'Foxx_swnet_vdf'/) + F_flds(6,:) = (/'Foxx_swnet_idr', 'Foxx_swnet_idr'/) + F_flds(7,:) = (/'Foxx_swnet_idf', 'Foxx_swnet_idf'/) + F_flds(8,:) = (/'Foxx_rofl', 'Foxx_rofl'/) ! mean runoff rate (liquid) + F_flds(9,:) = (/'Foxx_rofi', 'Foxx_rofi'/) ! mean runnof rate (frozen) + + do n = 1,size(F_flds,1) + fldname1 = trim(F_flds(n,1)) + fldname2 = trim(F_flds(n,2)) + if (fldchk(is_local%wrap%FBExp(compocn), trim(fldname2), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), trim(fldname1), rc=rc) & + ) then + call addmap(fldListFr(compatm)%flds, trim(fldname1), compocn, mapconsf, 'one', 'unset') + call addmrg(fldListTo(compocn)%flds, trim(fldname2), mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') + end if + end do + deallocate(F_flds) + + ! precip + call addmap(fldListFr(compatm)%flds, 'Faxa_rainc', compocn, mapconsf, 'one', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainc', mrg_type='sum') + call addmap(fldListFr(compatm)%flds, 'Faxa_rainl', compocn, mapconsf, 'one', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainl', mrg_type='sum') + + call addmap(fldListFr(compatm)%flds, 'Faxa_snowc', compocn, mapconsf, 'one', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowc', mrg_type='sum') + call addmap(fldListFr(compatm)%flds, 'Faxa_snowl', compocn, mapconsf, 'one', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowl', mrg_type='sum') + + ! from ice + allocate(F_flds(4, 2)) + F_flds(1,:) = (/'Fioi_salt', 'Fioi_salt'/) + F_flds(2,:) = (/'Si_ifrac', 'Si_ifrac'/) ! ice_fraction + F_flds(3,:) = (/'Fioi_meltw', 'Fioi_meltw'/) + F_flds(4,:) = (/'Fioi_melth', 'Fioi_melth'/) ! heat flux sea-ice to ocean + do n = 1,size(F_flds,1) + fldname1 = trim(F_flds(n,1)) + fldname2 = trim(F_flds(n,2)) + if (fldchk(is_local%wrap%FBExp(compocn), trim(fldname2), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice, compice), trim(fldname1),rc=rc) & + ) then + call addmap(fldListFr(compice)%flds, trim(fldname1), compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, trim(fldname2), mrg_from=compice, mrg_fld=trim(fldname1), mrg_type='copy') + end if + end do + deallocate(F_flds) + + ! momentum transfer + call addmap(fldListFr(compice)%flds, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Foxx_taux', mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + call addmap(fldListFr(compatm)%flds, 'Faxa_taux', compocn, mapconsf, 'one', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Foxx_taux', mrg_from=compatm, mrg_fld='Faxa_taux', mrg_type='merge', mrg_fracname='ofrac') + + call addmap(fldListFr(compice)%flds, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Foxx_tauy', mrg_from=compice, mrg_fld='Fioi_tauy', mrg_type='merge', mrg_fracname='ifrac') + call addmap(fldListFr(compatm)%flds, 'Faxa_tauy', compocn, mapconsf, 'one', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Foxx_tauy', mrg_from=compatm, mrg_fld='Faxa_tauy', mrg_type='merge', mrg_fracname='ofrac') + + !===================================================================== + ! FIELDS TO ICE (compice) + !===================================================================== + + ! --------------------------------------------------------------------- + ! to ice: state fields + ! --------------------------------------------------------------------- + + ! from atm + allocate(S_flds(8)) + S_flds = (/'Sa_z', & ! inst_zonal_wind_height10m + 'Sa_u', & ! inst_merid_wind_height10m + 'Sa_v ', & ! inst_temp_height2m + 'Sa_shum ', & ! inst_spec_humid_height2m + 'Sa_tbot', & ! Sa_pslv + 'Sa_pbot', & + 'Sa_dens', & + 'Sa_ptem' /) ! inst_temp_height_surface + + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compice), trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), trim(fldname),rc=rc) & + ) then + + call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapbilnr, 'one', 'unset') + call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + + end if + end do + deallocate(S_flds) + + ! from ocn + allocate(S_flds(6)) + S_flds = (/'So_dhdx', & ! inst_zonal_wind_height10m + 'So_dhdy', & ! inst_merid_wind_height10m + 'So_t ', & ! inst_temp_height2m + 'So_s ', & ! inst_spec_humid_height2m + 'So_u', & ! Sa_pslv + 'So_v', & ! Sa_pslv + 'Fioo_q' /) ! inst_temp_height_surface + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compice),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn, compocn), trim(fldname),rc=rc) & + ) then + + call addmap(fldListFr(compocn)%flds, trim(fldname), compice, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + + end if + end do + deallocate(S_flds) + + ! --------------------------------------------------------------------- + ! to ice: flux fields + ! --------------------------------------------------------------------- + + ! from atm + allocate(F_flds(5, 2)) + F_flds(1,:) = (/'Faxa_swvdr ', 'Faxa_swvdr '/) + F_flds(2,:) = (/'Faxa_swndr ', 'Faxa_swndr '/) + F_flds(3,:) = (/'Faxa_swvdf', 'Faxa_swvdf'/) + F_flds(4,:) = (/'Faxa_swndf', 'Faxa_swndf'/) + F_flds(5,:) = (/'Faxa_lwdn', 'Faxa_lwdn'/) + + do n = 1,size(F_flds,1) + fldname1 = trim(F_flds(n,1)) + fldname2 = trim(F_flds(n,2)) + if (fldchk(is_local%wrap%FBExp(compice), trim(fldname2), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), trim(fldname1), rc=rc) & + ) then + + call addmap(fldListFr(compatm)%flds, trim(fldname1), compice, mapconsf, 'one', 'unset') + call addmrg(fldListTo(compice)%flds, trim(fldname2), mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') + + end if + end do + deallocate(F_flds) + + ! precip + call addmap(fldListFr(compatm)%flds, 'Faxa_rainc', compice, mapconsf, 'one', 'unset') + call addmrg(fldListTo(compice)%flds, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainc', mrg_type='sum') + call addmap(fldListFr(compatm)%flds, 'Faxa_rainl', compice, mapconsf, 'one', 'unset') + call addmrg(fldListTo(compice)%flds, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainl', mrg_type='sum') + + call addmap(fldListFr(compatm)%flds, 'Faxa_snowc', compice, mapconsf, 'one', 'unset') + call addmrg(fldListTo(compice)%flds, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowc', mrg_type='sum') + call addmap(fldListFr(compatm)%flds, 'Faxa_snowl', compice, mapconsf, 'one', 'unset') + call addmrg(fldListTo(compice)%flds, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowl', mrg_type='sum') + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + + end subroutine esmFldsExchange_access_init + + !----------------------------------------------------------------------------- + + end module esmFldsExchange_access_mod From a08e6c6301f6c92e8c7daa3a864b00191b43cf0f Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Tue, 31 Oct 2023 10:51:37 +1100 Subject: [PATCH 17/66] add ice to um fields --- mediator/esmFldsExchange_access_mod.F90 | 38 ++++++++++++++++++++++--- 1 file changed, 34 insertions(+), 4 deletions(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index 01c31d6c9..e06efadbe 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -142,8 +142,22 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to atm: from ice ! --------------------------------------------------------------------- - call addfld(fldListFr(compice)%flds, 'Si_t') - call addfld(fldListTo(compatm)%flds, 'Si_t') + allocate(S_flds(8)) + S_flds = (/'Si_t', & + 'ia_aicen', & + 'ia_snown', & + 'ia_thikn', & + 'ia_itopt', & + 'ia_itopk', & + 'ia_pndfn', & + 'ia_pndtn', & + /) ! sea_surface_temperature + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld(fldListFr(compice)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) + end do + deallocate(S_flds) !===================================================================== ! FIELDS TO OCEAN (compocn) @@ -370,8 +384,24 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapconsf, 'ofrac', 'unset') call addmrg(fldListTo(compatm)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') - call addmap(fldListFr(compice)%flds, 'Si_t', compatm, mapconsf, 'ifrac', 'unset') - call addmrg(fldListTo(compatm)%flds, 'Si_t', mrg_from=compice, mrg_fld='Si_t', mrg_type='copy') + allocate(S_flds(8)) + S_flds = (/'Si_t', & + 'ia_aicen', & + 'ia_snown', & + 'ia_thikn', & + 'ia_itopt', & + 'ia_itopk', & + 'ia_pndfn', & + 'ia_pndtn', & + /) ! sea_surface_temperature + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addmap(fldListFr(compice)%flds, trim(fldname), compatm, mapconsf, 'ifrac', 'unset') + call addmrg(fldListTo(compatm)%flds, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + end do + deallocate(S_flds) + ! call addmap(fldListFr(compice)%flds, 'Si_t', compatm, mapconsf, 'ifrac', 'unset') + ! call addmrg(fldListTo(compatm)%flds, 'Si_t', mrg_from=compice, mrg_fld='Si_t', mrg_type='copy') !===================================================================== ! FIELDS TO OCEAN (compocn) From 1b029648ffe2a0a0f6a5d5abac9904dd97690aa4 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 9 Oct 2023 15:25:54 +1100 Subject: [PATCH 18/66] update access fld exchange module to new CMEPS --- mediator/CMakeLists.txt | 2 +- mediator/Makefile | 7 +- mediator/esmFldsExchange_access_mod.F90 | 138 ++++++++++++------------ 3 files changed, 73 insertions(+), 74 deletions(-) diff --git a/mediator/CMakeLists.txt b/mediator/CMakeLists.txt index b65004c37..b95c62a18 100644 --- a/mediator/CMakeLists.txt +++ b/mediator/CMakeLists.txt @@ -1,6 +1,6 @@ project(cmeps Fortran) -set(SRCFILES esmFldsExchange_cesm_mod.F90 med_fraction_mod.F90 +set(SRCFILES esmFldsExchange_access_mod.F90 esmFldsExchange_cesm_mod.F90 med_fraction_mod.F90 med_field_info_mod.F90 med_methods_mod.F90 med_phases_prep_ice_mod.F90 med_phases_restart_mod.F90 esmFldsExchange_hafs_mod.F90 diff --git a/mediator/Makefile b/mediator/Makefile index a353ff9a5..d7ad9570c 100644 --- a/mediator/Makefile +++ b/mediator/Makefile @@ -36,13 +36,14 @@ esmFlds.o : med_kind_mod.o esmFldsExchange_cesm_mod.o : med_kind_mod.o med_methods_mod.o esmFlds.o med_internalstate_mod.o med_utils_mod.o esmFldsExchange_ufs_mod.o : med_kind_mod.o med_methods_mod.o esmFlds.o med_internalstate_mod.o med_utils_mod.o esmFldsExchange_hafs_mod.o : med_kind_mod.o med_methods_mod.o esmFlds.o med_internalstate_mod.o med_utils_mod.o +esmFldsExchange_access_mod.o : med_kind_mod.o med_methods_mod.o esmFlds.o med_internalstate_mod.o med_utils_mod.o med.o : med_kind_mod.o med_phases_profile_mod.o med_utils_mod.o med_phases_prep_rof_mod.o med_phases_aofluxes_mod.o \ med_phases_prep_ice_mod.o med_fraction_mod.o med_map_mod.o med_constants_mod.o med_phases_prep_wav_mod.o \ med_phases_prep_lnd_mod.o med_phases_history_mod.o med_phases_ocnalb_mod.o med_phases_restart_mod.o \ med_internalstate_mod.o med_phases_prep_atm_mod.o esmFldsExchange_cesm_mod.o esmFldsExchange_ufs_mod.o \ - esmFldsExchange_hafs_mod.o med_phases_prep_glc_mod.o esmFlds.o med_io_mod.o med_methods_mod.o med_phases_prep_ocn_mod.o \ - med_phases_post_atm_mod.o med_phases_post_ice_mod.o med_phases_post_lnd_mod.o med_phases_post_glc_mod.o med_phases_post_rof_mod.o \ - med_phases_post_wav_mod.o + esmFldsExchange_hafs_mod.o esmFldsExchange_access_mod.o med_phases_prep_glc_mod.o esmFlds.o med_io_mod.o med_methods_mod.o \ + med_phases_prep_ocn_mod.o med_phases_post_atm_mod.o med_phases_post_ice_mod.o med_phases_post_lnd_mod.o med_phases_post_glc_mod.o \ + med_phases_post_rof_mod.o med_phases_post_wav_mod.o med_fraction_mod.o : med_kind_mod.o med_utils_mod.o med_internalstate_mod.o med_constants_mod.o med_map_mod.o med_methods_mod.o esmFlds.o med_internalstate_mod.o : med_kind_mod.o esmFlds.o med_io_mod.o : med_kind_mod.o med_methods_mod.o med_constants_mod.o med_internalstate_mod.o med_utils_mod.o diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index e06efadbe..00d5272a7 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -10,8 +10,11 @@ module esmFldsExchange_access_mod use med_internalstate_mod , only : compmed, compatm, compocn, compwav, compice use med_internalstate_mod , only : ncomps use med_internalstate_mod , only : coupling_mode - use esmflds , only : fldListTo - use esmflds , only : fldListFr + use esmFlds , only : med_fldList_type + use esmFlds , only : addfld_to => med_fldList_addfld_to + use esmFlds , only : addmrg_to => med_fldList_addmrg_to + use esmFlds , only : addfld_from => med_fldList_addfld_from + use esmFlds , only : addmap_from => med_fldList_addmap_from !--------------------------------------------------------------------- ! This is a mediator specific routine that determines ALL possible @@ -69,8 +72,6 @@ end subroutine esmFldsExchange_access subroutine esmFldsExchange_access_advt(gcomp, phase, rc) - use esmFlds, only : addfld => med_fldList_AddFld - ! input/output parameters: type(ESMF_GridComp) :: gcomp character(len=*) , intent(in) :: phase @@ -104,8 +105,8 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ncomps - call addfld(fldListFr(n)%flds, trim(cvalue)) - call addfld(fldListTo(n)%flds, trim(cvalue)) + call addfld_from(n, trim(cvalue)) + call addfld_to(n, trim(cvalue)) end do end if @@ -117,15 +118,15 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) !---------------------------------------------------------- ! to med: masks from components !---------------------------------------------------------- - call addfld(fldListFr(compocn)%flds, 'So_omask') - call addfld(fldListFr(compice)%flds, 'Si_imask') + call addfld_from(compocn, 'So_omask') + call addfld_from(compice, 'Si_imask') !===================================================================== ! FIELDS TO ATMOSPHERE !===================================================================== - call addfld(fldListTo(compatm)%flds, 'So_ofrac') - call addfld(fldListTo(compatm)%flds, 'Si_ifrac') + call addfld_to(compatm, 'So_ofrac') + call addfld_to(compatm, 'Si_ifrac') ! --------------------------------------------------------------------- ! to atm: from ocn @@ -134,8 +135,8 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) S_flds = (/'So_t'/) ! sea_surface_temperature do n = 1,size(S_flds) fldname = trim(S_flds(n)) - call addfld(fldListFr(compocn)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) + call addfld_from(compocn, trim(fldname)) + call addfld_to(compatm, trim(fldname)) end do deallocate(S_flds) @@ -171,8 +172,8 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) 'So_duu10n' /) ! inst_temp_height_surface do n = 1,size(S_flds) fldname = trim(S_flds(n)) - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(compocn)%flds, trim(fldname)) + call addfld_from(compatm, trim(fldname)) + call addfld_to(compocn, trim(fldname)) end do deallocate(S_flds) @@ -199,13 +200,13 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) fldname2 = trim(F_flds(n,2)) - call addfld(fldListFr(compatm)%flds, trim(fldname1)) - call addfld(fldListTo(compocn)%flds, trim(fldname2)) + call addfld_from(compatm, trim(fldname1)) + call addfld_to(compocn, trim(fldname2)) end do deallocate(F_flds) - call addfld(fldListFr(compatm)%flds, 'Faxa_rainc') - call addfld(fldListFr(compatm)%flds, 'Faxa_snowc') + call addfld_from(compatm, 'Faxa_rainc') + call addfld_from(compatm, 'Faxa_snowc') ! from ice allocate(F_flds(6, 2)) @@ -218,8 +219,8 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) fldname2 = trim(F_flds(n,2)) - call addfld(fldListFr(compice)%flds, trim(fldname1)) - call addfld(fldListTo(compocn)%flds, trim(fldname2)) + call addfld_from(compice, trim(fldname1)) + call addfld_to(compocn, trim(fldname2)) end do deallocate(F_flds) @@ -243,8 +244,8 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) 'Sa_ptem'/) do n = 1,size(S_flds) fldname = trim(S_flds(n)) - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(compice)%flds, trim(fldname)) + call addfld_from(compatm, trim(fldname)) + call addfld_to(compice, trim(fldname)) end do deallocate(S_flds) @@ -259,8 +260,8 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) 'Fioo_q' /) do n = 1,size(S_flds) fldname = trim(S_flds(n)) - call addfld(fldListFr(compocn)%flds, trim(fldname)) - call addfld(fldListTo(compice)%flds, trim(fldname)) + call addfld_from(compocn, trim(fldname)) + call addfld_to(compice, trim(fldname)) end do deallocate(S_flds) @@ -278,13 +279,13 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) fldname2 = trim(F_flds(n,2)) - call addfld(fldListFr(compatm)%flds, trim(fldname1)) - call addfld(fldListTo(compice)%flds, trim(fldname2)) + call addfld_from(compatm, trim(fldname1)) + call addfld_to(compice, trim(fldname2)) end do deallocate(F_flds) - call addfld(fldListFr(compatm)%flds, 'Faxa_rainc') - call addfld(fldListFr(compatm)%flds, 'Faxa_snowc') + call addfld_from(compatm, 'Faxa_rainc') + call addfld_from(compatm, 'Faxa_snowc') call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -341,9 +342,6 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd use med_internalstate_mod , only : mapfillv_bilnr use med_internalstate_mod , only : mapnstod_consf - use esmFlds , only : med_fldList_type - use esmFlds , only : addmap => med_fldList_AddMap - use esmFlds , only : addmrg => med_fldList_AddMrg ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -381,8 +379,8 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to atm: sea surface temperature ! --------------------------------------------------------------------- - call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapconsf, 'ofrac', 'unset') - call addmrg(fldListTo(compatm)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + call addmap_from(compocn, 'So_t', compatm, mapconsf, 'ofrac', 'unset') + call addmrg_to(compatm, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') allocate(S_flds(8)) S_flds = (/'Si_t', & @@ -419,8 +417,8 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) fldchk(is_local%wrap%FBImp(compatm, compatm), trim(fldname), rc=rc) & ) then - call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, mapbilnr, 'one', 'unset') - call addmrg(fldListTo(compocn)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + call addmap_from(compatm, trim(fldname), compocn, mapbilnr, 'one', 'unset') + call addmrg_to(compocn, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') end if end do @@ -448,22 +446,22 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) if (fldchk(is_local%wrap%FBExp(compocn), trim(fldname2), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm, compatm), trim(fldname1), rc=rc) & ) then - call addmap(fldListFr(compatm)%flds, trim(fldname1), compocn, mapconsf, 'one', 'unset') - call addmrg(fldListTo(compocn)%flds, trim(fldname2), mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') + call addmap_from(compatm, trim(fldname1), compocn, mapconsf, 'one', 'unset') + call addmrg_to(compocn, trim(fldname2), mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') end if end do deallocate(F_flds) ! precip - call addmap(fldListFr(compatm)%flds, 'Faxa_rainc', compocn, mapconsf, 'one', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainc', mrg_type='sum') - call addmap(fldListFr(compatm)%flds, 'Faxa_rainl', compocn, mapconsf, 'one', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainl', mrg_type='sum') + call addmap_from(compatm, 'Faxa_rainc', compocn, mapconsf, 'one', 'unset') + call addmrg_to(compocn, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainc', mrg_type='sum') + call addmap_from(compatm, 'Faxa_rainl', compocn, mapconsf, 'one', 'unset') + call addmrg_to(compocn, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainl', mrg_type='sum') - call addmap(fldListFr(compatm)%flds, 'Faxa_snowc', compocn, mapconsf, 'one', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowc', mrg_type='sum') - call addmap(fldListFr(compatm)%flds, 'Faxa_snowl', compocn, mapconsf, 'one', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowl', mrg_type='sum') + call addmap_from(compatm, 'Faxa_snowc', compocn, mapconsf, 'one', 'unset') + call addmrg_to(compocn, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowc', mrg_type='sum') + call addmap_from(compatm, 'Faxa_snowl', compocn, mapconsf, 'one', 'unset') + call addmrg_to(compocn, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowl', mrg_type='sum') ! from ice allocate(F_flds(4, 2)) @@ -477,22 +475,22 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) if (fldchk(is_local%wrap%FBExp(compocn), trim(fldname2), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), trim(fldname1),rc=rc) & ) then - call addmap(fldListFr(compice)%flds, trim(fldname1), compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, trim(fldname2), mrg_from=compice, mrg_fld=trim(fldname1), mrg_type='copy') + call addmap_from(compice, trim(fldname1), compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, trim(fldname2), mrg_from=compice, mrg_fld=trim(fldname1), mrg_type='copy') end if end do deallocate(F_flds) ! momentum transfer - call addmap(fldListFr(compice)%flds, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Foxx_taux', mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') - call addmap(fldListFr(compatm)%flds, 'Faxa_taux', compocn, mapconsf, 'one', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Foxx_taux', mrg_from=compatm, mrg_fld='Faxa_taux', mrg_type='merge', mrg_fracname='ofrac') + call addmap_from(compice, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, 'Foxx_taux', mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + call addmap_from(compatm, 'Faxa_taux', compocn, mapconsf, 'one', 'unset') + call addmrg_to(compocn, 'Foxx_taux', mrg_from=compatm, mrg_fld='Faxa_taux', mrg_type='merge', mrg_fracname='ofrac') - call addmap(fldListFr(compice)%flds, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Foxx_tauy', mrg_from=compice, mrg_fld='Fioi_tauy', mrg_type='merge', mrg_fracname='ifrac') - call addmap(fldListFr(compatm)%flds, 'Faxa_tauy', compocn, mapconsf, 'one', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Foxx_tauy', mrg_from=compatm, mrg_fld='Faxa_tauy', mrg_type='merge', mrg_fracname='ofrac') + call addmap_from(compice, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, 'Foxx_tauy', mrg_from=compice, mrg_fld='Fioi_tauy', mrg_type='merge', mrg_fracname='ifrac') + call addmap_from(compatm, 'Faxa_tauy', compocn, mapconsf, 'one', 'unset') + call addmrg_to(compocn, 'Foxx_tauy', mrg_from=compatm, mrg_fld='Faxa_tauy', mrg_type='merge', mrg_fracname='ofrac') !===================================================================== ! FIELDS TO ICE (compice) @@ -519,8 +517,8 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) fldchk(is_local%wrap%FBImp(compatm, compatm), trim(fldname),rc=rc) & ) then - call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapbilnr, 'one', 'unset') - call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + call addmap_from(compatm, trim(fldname), compice, mapbilnr, 'one', 'unset') + call addmrg_to(compice, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') end if end do @@ -541,8 +539,8 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) fldchk(is_local%wrap%FBImp(compocn, compocn), trim(fldname),rc=rc) & ) then - call addmap(fldListFr(compocn)%flds, trim(fldname), compice, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + call addmap_from(compocn, trim(fldname), compice, mapfcopy, 'unset', 'unset') + call addmrg_to(compice, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') end if end do @@ -567,23 +565,23 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) fldchk(is_local%wrap%FBImp(compatm, compatm), trim(fldname1), rc=rc) & ) then - call addmap(fldListFr(compatm)%flds, trim(fldname1), compice, mapconsf, 'one', 'unset') - call addmrg(fldListTo(compice)%flds, trim(fldname2), mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') + call addmap_from(compatm, trim(fldname1), compice, mapconsf, 'one', 'unset') + call addmrg_to(compice, trim(fldname2), mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') end if end do deallocate(F_flds) ! precip - call addmap(fldListFr(compatm)%flds, 'Faxa_rainc', compice, mapconsf, 'one', 'unset') - call addmrg(fldListTo(compice)%flds, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainc', mrg_type='sum') - call addmap(fldListFr(compatm)%flds, 'Faxa_rainl', compice, mapconsf, 'one', 'unset') - call addmrg(fldListTo(compice)%flds, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainl', mrg_type='sum') - - call addmap(fldListFr(compatm)%flds, 'Faxa_snowc', compice, mapconsf, 'one', 'unset') - call addmrg(fldListTo(compice)%flds, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowc', mrg_type='sum') - call addmap(fldListFr(compatm)%flds, 'Faxa_snowl', compice, mapconsf, 'one', 'unset') - call addmrg(fldListTo(compice)%flds, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowl', mrg_type='sum') + call addmap_from(compatm, 'Faxa_rainc', compice, mapconsf, 'one', 'unset') + call addmrg_to(compice, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainc', mrg_type='sum') + call addmap_from(compatm, 'Faxa_rainl', compice, mapconsf, 'one', 'unset') + call addmrg_to(compice, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainl', mrg_type='sum') + + call addmap_from(compatm, 'Faxa_snowc', compice, mapconsf, 'one', 'unset') + call addmrg_to(compice, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowc', mrg_type='sum') + call addmap_from(compatm, 'Faxa_snowl', compice, mapconsf, 'one', 'unset') + call addmrg_to(compice, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowl', mrg_type='sum') call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) From ac717a943b4c5d689c3ec53540b193124f589235 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 9 Oct 2023 17:53:36 +1100 Subject: [PATCH 19/66] typo fix --- mediator/med.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 8579f3d94..bec9766e9 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -843,9 +843,9 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) else if (coupling_mode(1:4) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode(1:4)) == 'access') then - call esmFldsExchange_access(gcomp, phase='advertise', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + else if (trim(coupling_mode) == 'access') then + call esmFldsExchange_access(gcomp, phase='advertise', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return else call shr_log_error(trim(coupling_mode)//' is not a valid coupling_mode', rc=rc) return From cefe6f345589fd4f9259242c9da2da9b58f2b8ad Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Tue, 31 Oct 2023 11:24:29 +1100 Subject: [PATCH 20/66] bufix: fixed syntax errors --- mediator/esmFldsExchange_access_mod.F90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index 00d5272a7..08576bb26 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -151,8 +151,7 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) 'ia_itopt', & 'ia_itopk', & 'ia_pndfn', & - 'ia_pndtn', & - /) ! sea_surface_temperature + 'ia_pndtn'/) ! sea_surface_temperature do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addfld(fldListFr(compice)%flds, trim(fldname)) @@ -390,8 +389,7 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) 'ia_itopt', & 'ia_itopk', & 'ia_pndfn', & - 'ia_pndtn', & - /) ! sea_surface_temperature + 'ia_pndtn'/) ! sea_surface_temperature do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addmap(fldListFr(compice)%flds, trim(fldname), compatm, mapconsf, 'ifrac', 'unset') From 310b532ee8f86241b5052565a4b2ec3c35ae1563 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Tue, 31 Oct 2023 11:30:41 +1100 Subject: [PATCH 21/66] bufix: fixed syntax errors --- mediator/esmFldsExchange_access_mod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index 08576bb26..37ccb673d 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -154,8 +154,8 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) 'ia_pndtn'/) ! sea_surface_temperature do n = 1,size(S_flds) fldname = trim(S_flds(n)) - call addfld(fldListFr(compice)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) + call addfld_from(compice, trim(fldname)) + call addfld_to(compatm, trim(fldname)) end do deallocate(S_flds) @@ -392,8 +392,8 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) 'ia_pndtn'/) ! sea_surface_temperature do n = 1,size(S_flds) fldname = trim(S_flds(n)) - call addmap(fldListFr(compice)%flds, trim(fldname), compatm, mapconsf, 'ifrac', 'unset') - call addmrg(fldListTo(compatm)%flds, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + call addmap_from(compice, trim(fldname), compatm, mapconsf, 'ifrac', 'unset') + call addmrg_to(compatm, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') end do deallocate(S_flds) ! call addmap(fldListFr(compice)%flds, 'Si_t', compatm, mapconsf, 'ifrac', 'unset') From f57e8895125440f459ac9aac483bed1a728680ae Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Tue, 14 Nov 2023 14:24:18 +1100 Subject: [PATCH 22/66] more logging --- mediator/med_merge_mod.F90 | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index 6d12fa929..822346c91 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -335,6 +335,8 @@ subroutine med_merge_auto_field(merge_type, field_out, ungriddedUBound_out, & real(R8), pointer :: dpf2(:,:) ! intput pointers to 1d and 2d fields real(R8), pointer :: dpw1(:) ! weight pointer character(len=*),parameter :: subname=' (med_merge_mod: med_merge_auto_field)' + character(len=CL) :: tmpString + integer :: ungriddedUbound_out1(1) !--------------------------------------- rc = ESMF_SUCCESS @@ -367,6 +369,19 @@ subroutine med_merge_auto_field(merge_type, field_out, ungriddedUBound_out, & ! Get field pointer to output and input fields ! Assume that input and output ungridded upper bounds are the same - this is checked in error check + ! field_in + ! field_out + + call ESMF_FieldGet(field_in, ungriddedUBound=ungriddedUbound_out1, rc=rc) + write (tmpString, *) ungriddedUbound_out1(1) + call ESMF_LogWrite('Input ungridded ubound: ' // trim(tmpString), ESMF_LogMsg_Info, rc=rc) + + call ESMF_FieldGet(field_out, ungriddedUBound=ungriddedUbound_out1, rc=rc) + write (tmpString, *) ungriddedUbound_out1(1) + call ESMF_LogWrite('Output ungridded ubound: ' // trim(tmpString), ESMF_LogMsg_Info, rc=rc) + + + if (ungriddedUBound_out(1) > 0) then call ESMF_FieldGet(field_in, farrayPtr=dpf2, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From 7cbd8904bd88c4463a9bf29f44a1578b8d0daac1 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 22 Jan 2024 16:59:24 +1100 Subject: [PATCH 23/66] update CM3 CMEPS to 1.1.2 --- mediator/esmFldsExchange_access_mod.F90 | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index 37ccb673d..17a6c65fa 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -549,12 +549,19 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) ! --------------------------------------------------------------------- ! from atm - allocate(F_flds(5, 2)) + allocate(F_flds(12, 2)) F_flds(1,:) = (/'Faxa_swvdr ', 'Faxa_swvdr '/) F_flds(2,:) = (/'Faxa_swndr ', 'Faxa_swndr '/) F_flds(3,:) = (/'Faxa_swvdf', 'Faxa_swvdf'/) F_flds(4,:) = (/'Faxa_swndf', 'Faxa_swndf'/) F_flds(5,:) = (/'Faxa_lwdn', 'Faxa_lwdn'/) + F_flds(6,:) = (/'pen_rad', 'pen_rad'/) + F_flds(7,:) = (/'topmelt', 'topmelt'/) + F_flds(8,:) = (/'botmelt', 'botmelt'/) + F_flds(9,:) = (/'tstar_sice', 'tstar_sice'/) + F_flds(10,:) = (/'sublim', 'sublim'/) + F_flds(11,:) = (/'Foxx_sen', 'Foxx_sen'/) + F_flds(12,:) = (/'Faxa_swdn', 'Faxa_swdn'/) do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) From 8775b55378c4822d4331da9fe4b85e7cfda86501 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 4 Mar 2024 12:43:07 +1100 Subject: [PATCH 24/66] fix fields --- mediator/esmFldsExchange_access_mod.F90 | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index 17a6c65fa..669b5b3e1 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -267,14 +267,20 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to ice: flux fields ! --------------------------------------------------------------------- - allocate(F_flds(7, 2)) + + allocate(F_flds(12, 2)) F_flds(1,:) = (/'Faxa_swvdr ', 'Faxa_swvdr '/) F_flds(2,:) = (/'Faxa_swndr ', 'Faxa_swndr '/) F_flds(3,:) = (/'Faxa_swvdf', 'Faxa_swvdf'/) F_flds(4,:) = (/'Faxa_swndf', 'Faxa_swndf'/) F_flds(5,:) = (/'Faxa_lwdn', 'Faxa_lwdn'/) - F_flds(6,:) = (/'Faxa_rainl', 'Faxa_rain'/) - F_flds(7,:) = (/'Faxa_snowl', 'Faxa_snow'/) + F_flds(6,:) = (/'pen_rad', 'pen_rad'/) + F_flds(7,:) = (/'topmelt', 'topmelt'/) + F_flds(8,:) = (/'botmelt', 'botmelt'/) + F_flds(9,:) = (/'tstar_sice', 'tstar_sice'/) + F_flds(10,:) = (/'sublim', 'sublim'/) + F_flds(11,:) = (/'Foxx_sen', 'Foxx_sen'/) + F_flds(12,:) = (/'Faxa_swdn', 'Faxa_swdn'/) do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) fldname2 = trim(F_flds(n,2)) @@ -285,6 +291,11 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) call addfld_from(compatm, 'Faxa_rainc') call addfld_from(compatm, 'Faxa_snowc') + call addfld_from(compatm, 'Faxa_rainl') + call addfld_from(compatm, 'Faxa_snowl') + + call addfld_to(compice, 'Faxa_rain') + call addfld_to(compice, 'Faxa_snow') call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) From e29680523bf4a562fdfeea57ee4c0ea3469a85da Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 20 May 2024 11:50:35 +1000 Subject: [PATCH 25/66] change flux scaling --- mediator/esmFldsExchange_access_mod.F90 | 52 +++++++++++++------------ 1 file changed, 28 insertions(+), 24 deletions(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index 669b5b3e1..485db8767 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -392,9 +392,11 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) call addmap_from(compocn, 'So_t', compatm, mapconsf, 'ofrac', 'unset') call addmrg_to(compatm, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') - allocate(S_flds(8)) - S_flds = (/'Si_t', & - 'ia_aicen', & + call addmap_from(compice, 'Si_t', compatm, mapconsd, 'ifrac', 'unset') + call addmrg_to(compatm, 'Si_t', mrg_from=compice, mrg_fld='Si_t', mrg_type='copy') + + allocate(S_flds(7)) + S_flds = (/'ia_aicen', & 'ia_snown', & 'ia_thikn', & 'ia_itopt', & @@ -403,7 +405,7 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) 'ia_pndtn'/) ! sea_surface_temperature do n = 1,size(S_flds) fldname = trim(S_flds(n)) - call addmap_from(compice, trim(fldname), compatm, mapconsf, 'ifrac', 'unset') + call addmap_from(compice, trim(fldname), compatm, mapconsf, 'none', 'unset') call addmrg_to(compatm, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') end do deallocate(S_flds) @@ -438,7 +440,7 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) ! --------------------------------------------------------------------- ! from atm - allocate(F_flds(11, 2)) + allocate(F_flds(9, 2)) F_flds(1,:) = (/'Foxx_sen', 'Foxx_sen'/) F_flds(2,:) = (/'Foxx_evap', 'Foxx_evap'/) F_flds(3,:) = (/'Foxx_lwnet', 'Foxx_lwnet'/) @@ -462,7 +464,7 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) deallocate(F_flds) ! precip - call addmap_from(compatm, 'Faxa_rainc', compocn, mapconsf, 'one', 'unset') + call addmap_from(compatm, 'Faxa_rainc', compocn, mapconsf, 'one', 'unset') ! TODO: weight by ocean fraction call addmrg_to(compocn, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainc', mrg_type='sum') call addmap_from(compatm, 'Faxa_rainl', compocn, mapconsf, 'one', 'unset') call addmrg_to(compocn, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainl', mrg_type='sum') @@ -471,13 +473,15 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) call addmrg_to(compocn, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowc', mrg_type='sum') call addmap_from(compatm, 'Faxa_snowl', compocn, mapconsf, 'one', 'unset') call addmrg_to(compocn, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowl', mrg_type='sum') - + ! from ice - allocate(F_flds(4, 2)) + call addmap_from(compice, 'Si_ifrac', compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') + + allocate(F_flds(3, 2)) F_flds(1,:) = (/'Fioi_salt', 'Fioi_salt'/) - F_flds(2,:) = (/'Si_ifrac', 'Si_ifrac'/) ! ice_fraction - F_flds(3,:) = (/'Fioi_meltw', 'Fioi_meltw'/) - F_flds(4,:) = (/'Fioi_melth', 'Fioi_melth'/) ! heat flux sea-ice to ocean + F_flds(2,:) = (/'Fioi_meltw', 'Fioi_meltw'/) + F_flds(3,:) = (/'Fioi_melth', 'Fioi_melth'/) ! heat flux sea-ice to ocean do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) fldname2 = trim(F_flds(n,2)) @@ -485,7 +489,7 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) fldchk(is_local%wrap%FBImp(compice, compice), trim(fldname1),rc=rc) & ) then call addmap_from(compice, trim(fldname1), compocn, mapfcopy, 'unset', 'unset') - call addmrg_to(compocn, trim(fldname2), mrg_from=compice, mrg_fld=trim(fldname1), mrg_type='copy') + call addmrg_to(compocn, trim(fldname2), mrg_from=compice, mrg_fld=trim(fldname1), mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end do deallocate(F_flds) @@ -534,7 +538,7 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) deallocate(S_flds) ! from ocn - allocate(S_flds(6)) + allocate(S_flds(7)) S_flds = (/'So_dhdx', & ! inst_zonal_wind_height10m 'So_dhdy', & ! inst_merid_wind_height10m 'So_t ', & ! inst_temp_height2m @@ -561,16 +565,16 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) ! from atm allocate(F_flds(12, 2)) - F_flds(1,:) = (/'Faxa_swvdr ', 'Faxa_swvdr '/) - F_flds(2,:) = (/'Faxa_swndr ', 'Faxa_swndr '/) - F_flds(3,:) = (/'Faxa_swvdf', 'Faxa_swvdf'/) - F_flds(4,:) = (/'Faxa_swndf', 'Faxa_swndf'/) - F_flds(5,:) = (/'Faxa_lwdn', 'Faxa_lwdn'/) - F_flds(6,:) = (/'pen_rad', 'pen_rad'/) - F_flds(7,:) = (/'topmelt', 'topmelt'/) - F_flds(8,:) = (/'botmelt', 'botmelt'/) - F_flds(9,:) = (/'tstar_sice', 'tstar_sice'/) - F_flds(10,:) = (/'sublim', 'sublim'/) + F_flds(1,:) = (/'pen_rad', 'pen_rad'/) + F_flds(2,:) = (/'topmelt', 'topmelt'/) + F_flds(3,:) = (/'botmelt', 'botmelt'/) + F_flds(4,:) = (/'tstar_sice', 'tstar_sice'/) + F_flds(5,:) = (/'sublim', 'sublim'/) + F_flds(6,:) = (/'Faxa_swvdr ', 'Faxa_swvdr '/) + F_flds(7,:) = (/'Faxa_swndr ', 'Faxa_swndr '/) + F_flds(8,:) = (/'Faxa_swvdf', 'Faxa_swvdf'/) + F_flds(9,:) = (/'Faxa_swndf', 'Faxa_swndf'/) + F_flds(10,:) = (/'Faxa_lwdn', 'Faxa_lwdn'/) F_flds(11,:) = (/'Foxx_sen', 'Foxx_sen'/) F_flds(12,:) = (/'Faxa_swdn', 'Faxa_swdn'/) @@ -581,7 +585,7 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) fldchk(is_local%wrap%FBImp(compatm, compatm), trim(fldname1), rc=rc) & ) then - call addmap_from(compatm, trim(fldname1), compice, mapconsf, 'one', 'unset') + call addmap_from(compatm, trim(fldname1), compice, mapconsf, 'one', 'unset') ! mapping with total ifrac, should use category fractions call addmrg_to(compice, trim(fldname2), mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') end if From 2510f5ba8df29ba852efe259bf56ba2a1b19e92a Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 20 May 2024 12:43:12 +1000 Subject: [PATCH 26/66] scale precipitation over ocean by ocean fraction --- mediator/esmFldsExchange_access_mod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index 485db8767..b79aacfa1 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -465,14 +465,14 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) ! precip call addmap_from(compatm, 'Faxa_rainc', compocn, mapconsf, 'one', 'unset') ! TODO: weight by ocean fraction - call addmrg_to(compocn, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainc', mrg_type='sum') + call addmrg_to(compocn, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainc', mrg_type='sum_with_weights', mrg_fracname='ofrac') call addmap_from(compatm, 'Faxa_rainl', compocn, mapconsf, 'one', 'unset') - call addmrg_to(compocn, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainl', mrg_type='sum') + call addmrg_to(compocn, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainl', mrg_type='sum_with_weights', mrg_fracname='ofrac') call addmap_from(compatm, 'Faxa_snowc', compocn, mapconsf, 'one', 'unset') - call addmrg_to(compocn, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowc', mrg_type='sum') + call addmrg_to(compocn, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowc', mrg_type='sum_with_weights', mrg_fracname='ofrac') call addmap_from(compatm, 'Faxa_snowl', compocn, mapconsf, 'one', 'unset') - call addmrg_to(compocn, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowl', mrg_type='sum') + call addmrg_to(compocn, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowl', mrg_type='sum_with_weights', mrg_fracname='ofrac') ! from ice call addmap_from(compice, 'Si_ifrac', compocn, mapfcopy, 'unset', 'unset') From b36d3a57f3444006fd3347f2d2104a8a6fd24324 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Tue, 21 May 2024 11:00:05 +1000 Subject: [PATCH 27/66] remove scaling of ice->ocn fluxes by ice fraction (scaling now in CICE cap) --- mediator/esmFldsExchange_access_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index b79aacfa1..39368db71 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -489,7 +489,7 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) fldchk(is_local%wrap%FBImp(compice, compice), trim(fldname1),rc=rc) & ) then call addmap_from(compice, trim(fldname1), compocn, mapfcopy, 'unset', 'unset') - call addmrg_to(compocn, trim(fldname2), mrg_from=compice, mrg_fld=trim(fldname1), mrg_type='copy_with_weights', mrg_fracname='ifrac') + call addmrg_to(compocn, trim(fldname2), mrg_from=compice, mrg_fld=trim(fldname1), mrg_type='copy') end if end do deallocate(F_flds) From 0d8f3d26c1056b4b96fe961c105d4a6f4f3d0f0e Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Tue, 20 Aug 2024 14:35:50 +1000 Subject: [PATCH 28/66] fix precipitation merge --- mediator/esmFldsExchange_access_mod.F90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index 39368db71..3242b2541 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -465,14 +465,14 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) ! precip call addmap_from(compatm, 'Faxa_rainc', compocn, mapconsf, 'one', 'unset') ! TODO: weight by ocean fraction - call addmrg_to(compocn, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainc', mrg_type='sum_with_weights', mrg_fracname='ofrac') call addmap_from(compatm, 'Faxa_rainl', compocn, mapconsf, 'one', 'unset') - call addmrg_to(compocn, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainl', mrg_type='sum_with_weights', mrg_fracname='ofrac') - + call addmrg_to(compocn, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', & + mrg_type='sum_with_weights', mrg_fracname='ofrac') + call addmap_from(compatm, 'Faxa_snowc', compocn, mapconsf, 'one', 'unset') - call addmrg_to(compocn, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowc', mrg_type='sum_with_weights', mrg_fracname='ofrac') call addmap_from(compatm, 'Faxa_snowl', compocn, mapconsf, 'one', 'unset') - call addmrg_to(compocn, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowl', mrg_type='sum_with_weights', mrg_fracname='ofrac') + call addmrg_to(compocn, 'Faxa_snow' , mrg_from=compatm, mrg_fld='Faxa_snowc:Faxa_snowl', & + mrg_type='sum_with_weights', mrg_fracname='ofrac') ! from ice call addmap_from(compice, 'Si_ifrac', compocn, mapfcopy, 'unset', 'unset') @@ -594,14 +594,14 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) ! precip call addmap_from(compatm, 'Faxa_rainc', compice, mapconsf, 'one', 'unset') - call addmrg_to(compice, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainc', mrg_type='sum') call addmap_from(compatm, 'Faxa_rainl', compice, mapconsf, 'one', 'unset') - call addmrg_to(compice, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rainl', mrg_type='sum') - + call addmrg_to(compice, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', & + mrg_type='sum') + call addmap_from(compatm, 'Faxa_snowc', compice, mapconsf, 'one', 'unset') - call addmrg_to(compice, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowc', mrg_type='sum') call addmap_from(compatm, 'Faxa_snowl', compice, mapconsf, 'one', 'unset') - call addmrg_to(compice, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snowl', mrg_type='sum') + call addmrg_to(compice, 'Faxa_snow' , mrg_from=compatm, mrg_fld='Faxa_snowc:Faxa_snowl', & + mrg_type='sum') call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) From 380c5f182fe6b453efa2783b46ad9e430ae20c5d Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Wed, 4 Sep 2024 11:17:59 +1000 Subject: [PATCH 29/66] add iceberg fluxes --- mediator/esmFldsExchange_access_mod.F90 | 31 ++++++++++++++++--------- 1 file changed, 20 insertions(+), 11 deletions(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index 3242b2541..220c3c467 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -143,7 +143,7 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to atm: from ice ! --------------------------------------------------------------------- - allocate(S_flds(8)) + allocate(S_flds(9)) S_flds = (/'Si_t', & 'ia_aicen', & 'ia_snown', & @@ -151,7 +151,9 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) 'ia_itopt', & 'ia_itopk', & 'ia_pndfn', & - 'ia_pndtn'/) ! sea_surface_temperature + 'ia_pndtn', & + 'sstfrz' & + /) ! sea_surface_temperature do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addfld_from(compice, trim(fldname)) @@ -232,7 +234,7 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- ! from atm - allocate(S_flds(2)) + allocate(S_flds(10)) S_flds = (/'Sa_z', & 'Sa_u', & 'Sa_v', & @@ -240,7 +242,9 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) 'Sa_tbot', & 'Sa_pbot', & 'Sa_dens', & - 'Sa_ptem'/) + 'Sa_ptem', & + 'um_icesth', & + 'um_icenth' /) do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addfld_from(compatm, trim(fldname)) @@ -394,6 +398,9 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) call addmap_from(compice, 'Si_t', compatm, mapconsd, 'ifrac', 'unset') call addmrg_to(compatm, 'Si_t', mrg_from=compice, mrg_fld='Si_t', mrg_type='copy') + + call addmap_from(compice, 'sstfrz', compatm, mapconsf, 'none', 'unset') + call addmrg_to(compatm, 'sstfrz', mrg_from=compice, mrg_fld='sstfrz', mrg_type='copy') allocate(S_flds(7)) S_flds = (/'ia_aicen', & @@ -514,15 +521,17 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) ! --------------------------------------------------------------------- ! from atm - allocate(S_flds(8)) - S_flds = (/'Sa_z', & ! inst_zonal_wind_height10m - 'Sa_u', & ! inst_merid_wind_height10m - 'Sa_v ', & ! inst_temp_height2m - 'Sa_shum ', & ! inst_spec_humid_height2m - 'Sa_tbot', & ! Sa_pslv + allocate(S_flds(10)) + S_flds = (/'Sa_z', & + 'Sa_u', & + 'Sa_v', & + 'Sa_shum', & + 'Sa_tbot', & 'Sa_pbot', & 'Sa_dens', & - 'Sa_ptem' /) ! inst_temp_height_surface + 'Sa_ptem', & + 'um_icesth', & + 'um_icenth' /) do n = 1,size(S_flds) fldname = trim(S_flds(n)) From 3e314ff676f1c845dde6662fba357e5e8c18d032 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Tue, 1 Oct 2024 10:48:56 +1000 Subject: [PATCH 30/66] add ocean current coupling --- mediator/esmFldsExchange_access_mod.F90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index 220c3c467..8f13572c3 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -131,8 +131,8 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to atm: from ocn ! --------------------------------------------------------------------- - allocate(S_flds(1)) - S_flds = (/'So_t'/) ! sea_surface_temperature + allocate(S_flds(3)) + S_flds = (/'So_t', 'So_u', 'So_v'/) ! sea_surface_temperature do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addfld_from(compocn, trim(fldname)) @@ -395,6 +395,10 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) ! --------------------------------------------------------------------- call addmap_from(compocn, 'So_t', compatm, mapconsf, 'ofrac', 'unset') call addmrg_to(compatm, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + call addmap_from(compocn, 'So_u', compatm, mapconsf, 'ofrac', 'unset') + call addmrg_to(compatm, 'So_u', mrg_from=compocn, mrg_fld='So_u', mrg_type='copy') + call addmap_from(compocn, 'So_v', compatm, mapconsf, 'ofrac', 'unset') + call addmrg_to(compatm, 'So_v', mrg_from=compocn, mrg_fld='So_v', mrg_type='copy') call addmap_from(compice, 'Si_t', compatm, mapconsd, 'ifrac', 'unset') call addmrg_to(compatm, 'Si_t', mrg_from=compice, mrg_fld='Si_t', mrg_type='copy') From 43f10291f1c5b823a46d2cb1fc513faa78d5c806 Mon Sep 17 00:00:00 2001 From: Spencer Wong Date: Wed, 19 Feb 2025 17:23:12 +1100 Subject: [PATCH 31/66] Don't run custom CESM calculations for access --- mediator/med_phases_prep_ocn_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index f4f9bd3b0..438335684 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -255,8 +255,10 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) end if ! custom merges to ocean - call med_phases_prep_ocn_custom(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(coupling_mode) /= "access") then + call med_phases_prep_ocn_custom(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if ! ocean accumulator call FB_accum(is_local%wrap%FBExpAccumOcn, is_local%wrap%FBExp(compocn), rc=rc) From b23266aff0becafe9da0fab22e895c3e52fa42f6 Mon Sep 17 00:00:00 2001 From: Spencer Wong <88933912+blimlim@users.noreply.github.com> Date: Tue, 25 Feb 2025 11:02:37 +1100 Subject: [PATCH 32/66] Tidy old logging code and comments Co-authored-by: Kieran Ricardo --- mediator/med_merge_mod.F90 | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index 822346c91..6d12fa929 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -335,8 +335,6 @@ subroutine med_merge_auto_field(merge_type, field_out, ungriddedUBound_out, & real(R8), pointer :: dpf2(:,:) ! intput pointers to 1d and 2d fields real(R8), pointer :: dpw1(:) ! weight pointer character(len=*),parameter :: subname=' (med_merge_mod: med_merge_auto_field)' - character(len=CL) :: tmpString - integer :: ungriddedUbound_out1(1) !--------------------------------------- rc = ESMF_SUCCESS @@ -369,19 +367,6 @@ subroutine med_merge_auto_field(merge_type, field_out, ungriddedUBound_out, & ! Get field pointer to output and input fields ! Assume that input and output ungridded upper bounds are the same - this is checked in error check - ! field_in - ! field_out - - call ESMF_FieldGet(field_in, ungriddedUBound=ungriddedUbound_out1, rc=rc) - write (tmpString, *) ungriddedUbound_out1(1) - call ESMF_LogWrite('Input ungridded ubound: ' // trim(tmpString), ESMF_LogMsg_Info, rc=rc) - - call ESMF_FieldGet(field_out, ungriddedUBound=ungriddedUbound_out1, rc=rc) - write (tmpString, *) ungriddedUbound_out1(1) - call ESMF_LogWrite('Output ungridded ubound: ' // trim(tmpString), ESMF_LogMsg_Info, rc=rc) - - - if (ungriddedUBound_out(1) > 0) then call ESMF_FieldGet(field_in, farrayPtr=dpf2, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From 6f7013e2a5bac9ee0af6450924c388d9e429fa7e Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Tue, 18 Mar 2025 11:10:17 +1100 Subject: [PATCH 33/66] Implement time-travelling ice in post atm --- mediator/med_phases_post_atm_mod.F90 | 75 +++++++++++++++++++++++++++- 1 file changed, 74 insertions(+), 1 deletion(-) diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index 333497a69..e5d23e968 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -33,7 +33,7 @@ subroutine med_phases_post_atm(gcomp, rc) use med_map_mod , only : med_map_field_packed use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_internalstate_mod , only : compocn, compatm, compice, complnd, compwav + use med_internalstate_mod , only : compocn, compatm, compice, complnd, compwav, coupling_mode use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -58,6 +58,11 @@ subroutine med_phases_post_atm(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(coupling_mode) == 'access') then + call med_phases_post_atm_custom_access(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + ! map atm to ocn if (is_local%wrap%med_coupling_active(compatm,compocn)) then call t_startf('MED:'//trim(subname)//' map_atm2ocn') @@ -128,4 +133,72 @@ subroutine med_phases_post_atm(gcomp, rc) end subroutine med_phases_post_atm + subroutine med_phases_post_atm_custom_access(gcomp, rc) + 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 : compocn, compatm, compice, coupling_mode + use med_internalstate_mod , only : InternalState + use ESMF , only : ESMF_GridComp, ESMF_FieldBundleGet + use ESMF , only : ESMF_FieldGet, ESMF_Field + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use perf_mod , only : t_startf, t_stopf + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + real(R8), pointer :: ice_frac_cat_ptr(:, :), ice_flux_cat_ptr(:, :) + type(ESMF_Field) :: ice_frac_cat, ice_flux_cat + integer :: lsize1, lsize2, i, j, n + character(len=*), parameter :: subname='(med_phases_post_atm_custom_access)' + character(len=CS) :: fld_names(4) + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > 20) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + end if + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compice, compatm), fieldName='ia_aicen', field=ice_frac_cat, rc=rc) + call ESMF_FieldGet(ice_frac_cat, farrayptr=ice_frac_cat_ptr) + + lsize1 = size(ice_frac_cat_ptr, dim=1) + lsize2 = size(ice_frac_cat_ptr, dim=2) + + fld_names = [character(len=CS) :: & + 'topmelt', & + 'botmelt', & + 'sublim', & + 'pen_rad'] + + do n = 1,size(fld_names) + + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm, compatm), fieldName=trim(fld_names(n)), field=ice_flux_cat, rc=rc) + call ESMF_FieldGet(ice_flux_cat, farrayptr=ice_flux_cat_ptr) + + do j = 1,lsize2 + do i = 1,lsize1 + if (ice_frac_cat_ptr(i, j) > 0.0) then + ice_flux_cat_ptr(i, j) = ice_flux_cat_ptr(i, j) / ice_frac_cat_ptr(i, j) + end if + end do + end do + + end do + + if (dbug_flag > 20) then + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_post_atm_custom_access + end module med_phases_post_atm_mod From fbe669a30c767c7c54f80520435b3edd34a0c905 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Tue, 23 Dec 2025 11:12:09 +1100 Subject: [PATCH 34/66] map wind stress atm->ocn with patch interpolation --- mediator/esmFldsExchange_access_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index 8f13572c3..872720d4d 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -508,12 +508,12 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) ! momentum transfer call addmap_from(compice, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') call addmrg_to(compocn, 'Foxx_taux', mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') - call addmap_from(compatm, 'Faxa_taux', compocn, mapconsf, 'one', 'unset') + call addmap_from(compatm, 'Faxa_taux', compocn, mappatch, 'one', 'unset') call addmrg_to(compocn, 'Foxx_taux', mrg_from=compatm, mrg_fld='Faxa_taux', mrg_type='merge', mrg_fracname='ofrac') call addmap_from(compice, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') call addmrg_to(compocn, 'Foxx_tauy', mrg_from=compice, mrg_fld='Fioi_tauy', mrg_type='merge', mrg_fracname='ifrac') - call addmap_from(compatm, 'Faxa_tauy', compocn, mapconsf, 'one', 'unset') + call addmap_from(compatm, 'Faxa_tauy', compocn, mappatch, 'one', 'unset') call addmrg_to(compocn, 'Foxx_tauy', mrg_from=compatm, mrg_fld='Faxa_tauy', mrg_type='merge', mrg_fracname='ofrac') !===================================================================== From 7696b751bfde51d7c8e27f56ddd2e1f66d8710d0 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 16 Feb 2026 10:09:41 +1100 Subject: [PATCH 35/66] Update mediator/esmFldsExchange_access_mod.F90 Co-authored-by: Anton Steketee <79179784+anton-seaice@users.noreply.github.com> --- mediator/esmFldsExchange_access_mod.F90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index 872720d4d..830f4bd86 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -3,10 +3,7 @@ module esmFldsExchange_access_mod use ESMF use NUOPC use med_utils_mod , only : chkerr => med_utils_chkerr - use med_kind_mod , only : CX=>SHR_KIND_CX - use med_kind_mod , only : CS=>SHR_KIND_CS - use med_kind_mod , only : CL=>SHR_KIND_CL - use med_kind_mod , only : R8=>SHR_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 : compmed, compatm, compocn, compwav, compice use med_internalstate_mod , only : ncomps use med_internalstate_mod , only : coupling_mode From 2a40bb6e25f8c691ec33772d4f496ddd2543cfff Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 16 Feb 2026 10:10:05 +1100 Subject: [PATCH 36/66] Update mediator/esmFldsExchange_access_mod.F90 Co-authored-by: Anton Steketee <79179784+anton-seaice@users.noreply.github.com> --- mediator/esmFldsExchange_access_mod.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index 830f4bd86..ad69e9aa4 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -4,8 +4,7 @@ module esmFldsExchange_access_mod use NUOPC use med_utils_mod , only : chkerr => med_utils_chkerr 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 : compmed, compatm, compocn, compwav, compice - use med_internalstate_mod , only : ncomps + use med_internalstate_mod , only : compmed, compatm, compocn, compice, ncomps use med_internalstate_mod , only : coupling_mode use esmFlds , only : med_fldList_type use esmFlds , only : addfld_to => med_fldList_addfld_to From 42f646ca91faacdff0fccb49eedf3ebca582f155 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 16 Feb 2026 10:14:54 +1100 Subject: [PATCH 37/66] Update mediator/esmFldsExchange_access_mod.F90 Co-authored-by: Anton Steketee <79179784+anton-seaice@users.noreply.github.com> --- mediator/esmFldsExchange_access_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index ad69e9aa4..0b1166634 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -212,7 +212,7 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) F_flds(3,:) = (/'Fioi_meltw', 'Fioi_meltw'/) F_flds(4,:) = (/'Fioi_melth', 'Fioi_melth'/) ! heat flux sea-ice to ocean F_flds(5,:) = (/'Fioi_taux', 'Foxx_taux'/) - F_flds(6,:) = (/'Fioi_tauy', 'Foxx_tauy'/) ! heat flux sea-ice to ocean + F_flds(6,:) = (/'Fioi_tauy', 'Foxx_tauy'/) ! surface stress sea-ice to ocean do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) fldname2 = trim(F_flds(n,2)) From a03870655d8c202996bbf21a4f1caa27bd8ed8fb Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 16 Feb 2026 14:30:08 +1100 Subject: [PATCH 38/66] - check array in time travelling ice routine - rename tti routine and add description - rename coupling mode to "access-esm" - delete unfinished comments - delete unused fields --- mediator/esmFldsExchange_access_mod.F90 | 58 +++++++++++-------------- mediator/med.F90 | 4 +- mediator/med_phases_post_atm_mod.F90 | 22 +++++++--- 3 files changed, 44 insertions(+), 40 deletions(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index 0b1166634..e67ab7c8d 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -128,7 +128,7 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) ! to atm: from ocn ! --------------------------------------------------------------------- allocate(S_flds(3)) - S_flds = (/'So_t', 'So_u', 'So_v'/) ! sea_surface_temperature + S_flds = (/'So_t', 'So_u', 'So_v'/) do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addfld_from(compocn, trim(fldname)) @@ -141,15 +141,15 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- allocate(S_flds(9)) S_flds = (/'Si_t', & - 'ia_aicen', & - 'ia_snown', & - 'ia_thikn', & + 'Si_ifrac_n', & + 'Si_vsno_n', & + 'Si_vice_n', & 'ia_itopt', & 'ia_itopk', & 'ia_pndfn', & 'ia_pndtn', & 'sstfrz' & - /) ! sea_surface_temperature + /) do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addfld_from(compice, trim(fldname)) @@ -165,8 +165,8 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) ! to ocn: state fields ! --------------------------------------------------------------------- allocate(S_flds(2)) - S_flds = (/'Sa_pslv', & ! inst_zonal_wind_height10m - 'So_duu10n' /) ! inst_temp_height_surface + S_flds = (/'Sa_pslv', & + 'So_duu10n' /) do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addfld_from(compatm, trim(fldname)) @@ -207,9 +207,9 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) ! from ice allocate(F_flds(6, 2)) - F_flds(1,:) = (/'Fioi_salt', 'Fioi_salt'/) + F_flds(1,:) = (/'Fioi_salt', 'Fioi_salt'/) ! salt flux sea-ice to ocean F_flds(2,:) = (/'Si_ifrac', 'Si_ifrac'/) ! ice_fraction - F_flds(3,:) = (/'Fioi_meltw', 'Fioi_meltw'/) + F_flds(3,:) = (/'Fioi_meltw', 'Fioi_meltw'/) ! melt water flux sea-ice to ocean F_flds(4,:) = (/'Fioi_melth', 'Fioi_melth'/) ! heat flux sea-ice to ocean F_flds(5,:) = (/'Fioi_taux', 'Foxx_taux'/) F_flds(6,:) = (/'Fioi_tauy', 'Foxx_tauy'/) ! surface stress sea-ice to ocean @@ -230,7 +230,7 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- ! from atm - allocate(S_flds(10)) + allocate(S_flds(8)) S_flds = (/'Sa_z', & 'Sa_u', & 'Sa_v', & @@ -238,9 +238,7 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) 'Sa_tbot', & 'Sa_pbot', & 'Sa_dens', & - 'Sa_ptem', & - 'um_icesth', & - 'um_icenth' /) + 'Sa_ptem'/) do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addfld_from(compatm, trim(fldname)) @@ -250,13 +248,13 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) ! from ocn allocate(S_flds(7)) - S_flds = (/'So_dhdx', & + S_flds = (/'So_dhdx', & 'So_dhdy', & - 'So_t', & - 'So_s', & - 'So_u', & - 'So_v', & - 'Fioo_q' /) + 'So_t', & + 'So_s', & + 'So_u', & + 'So_v', & + 'Fioo_q' /) do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addfld_from(compocn, trim(fldname)) @@ -296,7 +294,7 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) call addfld_to(compice, 'Faxa_rain') call addfld_to(compice, 'Faxa_snow') - + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine esmFldsExchange_access_advt @@ -401,23 +399,21 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) call addmap_from(compice, 'sstfrz', compatm, mapconsf, 'none', 'unset') call addmrg_to(compatm, 'sstfrz', mrg_from=compice, mrg_fld='sstfrz', mrg_type='copy') - + allocate(S_flds(7)) - S_flds = (/'ia_aicen', & - 'ia_snown', & - 'ia_thikn', & + S_flds = (/'Si_ifrac_n', & + 'Si_vsno_n', & + 'Si_vice_n', & 'ia_itopt', & 'ia_itopk', & 'ia_pndfn', & - 'ia_pndtn'/) ! sea_surface_temperature + 'ia_pndtn'/) do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addmap_from(compice, trim(fldname), compatm, mapconsf, 'none', 'unset') call addmrg_to(compatm, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') end do deallocate(S_flds) - ! call addmap(fldListFr(compice)%flds, 'Si_t', compatm, mapconsf, 'ifrac', 'unset') - ! call addmrg(fldListTo(compatm)%flds, 'Si_t', mrg_from=compice, mrg_fld='Si_t', mrg_type='copy') !===================================================================== ! FIELDS TO OCEAN (compocn) @@ -471,7 +467,7 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) deallocate(F_flds) ! precip - call addmap_from(compatm, 'Faxa_rainc', compocn, mapconsf, 'one', 'unset') ! TODO: weight by ocean fraction + call addmap_from(compatm, 'Faxa_rainc', compocn, mapconsf, 'one', 'unset') call addmap_from(compatm, 'Faxa_rainl', compocn, mapconsf, 'one', 'unset') call addmrg_to(compocn, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', & mrg_type='sum_with_weights', mrg_fracname='ofrac') @@ -521,7 +517,7 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) ! --------------------------------------------------------------------- ! from atm - allocate(S_flds(10)) + allocate(S_flds(8)) S_flds = (/'Sa_z', & 'Sa_u', & 'Sa_v', & @@ -529,9 +525,7 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) 'Sa_tbot', & 'Sa_pbot', & 'Sa_dens', & - 'Sa_ptem', & - 'um_icesth', & - 'um_icenth' /) + 'Sa_ptem' /) do n = 1,size(S_flds) fldname = trim(S_flds(n)) diff --git a/mediator/med.F90 b/mediator/med.F90 index bec9766e9..b2d727270 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -843,7 +843,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) else if (coupling_mode(1:4) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode) == 'access') then + else if (trim(coupling_mode) == 'access-esm') then call esmFldsExchange_access(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else @@ -1863,7 +1863,7 @@ subroutine DataInitialize(gcomp, rc) else if (coupling_mode(1:4) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode) == 'access') then + else if (trim(coupling_mode) == 'access-esm') then call esmFldsExchange_access(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index e5d23e968..5e8104a76 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -58,8 +58,8 @@ subroutine med_phases_post_atm(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(coupling_mode) == 'access') then - call med_phases_post_atm_custom_access(gcomp, rc) + if (trim(coupling_mode) == 'access-esm') then + call med_phases_post_atm_time_travelling_ice(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -133,7 +133,14 @@ subroutine med_phases_post_atm(gcomp, rc) end subroutine med_phases_post_atm - subroutine med_phases_post_atm_custom_access(gcomp, rc) + subroutine med_phases_post_atm_time_travelling_ice(gcomp, rc) + + !--------------------------------------- + ! Scale atmosphere to sea-ice fluxes by the current ice fraction prior to regridding to the sea-ice grid. + ! This converts the fluxes from averages over sea-ice+ocean area to averages over the sea-ice area, + ! and ensures conservation. + !--------------------------------------- + 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 : compocn, compatm, compice, coupling_mode use med_internalstate_mod , only : InternalState @@ -152,7 +159,7 @@ subroutine med_phases_post_atm_custom_access(gcomp, rc) real(R8), pointer :: ice_frac_cat_ptr(:, :), ice_flux_cat_ptr(:, :) type(ESMF_Field) :: ice_frac_cat, ice_flux_cat integer :: lsize1, lsize2, i, j, n - character(len=*), parameter :: subname='(med_phases_post_atm_custom_access)' + character(len=*), parameter :: subname='(med_phases_post_atm_time_travelling_ice)' character(len=CS) :: fld_names(4) !--------------------------------------- @@ -166,8 +173,10 @@ subroutine med_phases_post_atm_custom_access(gcomp, rc) ! Get the internal state nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBImp(compice, compatm), fieldName='ia_aicen', field=ice_frac_cat, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compice, compatm), fieldName='Si_ifrac_n', field=ice_frac_cat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(ice_frac_cat, farrayptr=ice_frac_cat_ptr) lsize1 = size(ice_frac_cat_ptr, dim=1) @@ -182,6 +191,7 @@ subroutine med_phases_post_atm_custom_access(gcomp, rc) do n = 1,size(fld_names) call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm, compatm), fieldName=trim(fld_names(n)), field=ice_flux_cat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(ice_flux_cat, farrayptr=ice_flux_cat_ptr) do j = 1,lsize2 @@ -199,6 +209,6 @@ subroutine med_phases_post_atm_custom_access(gcomp, rc) end if call t_stopf('MED:'//subname) - end subroutine med_phases_post_atm_custom_access + end subroutine med_phases_post_atm_time_travelling_ice end module med_phases_post_atm_mod From da49b38a3ec75ebcd1f9c085b3b5569f831e515b Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Tue, 17 Feb 2026 13:31:59 +1100 Subject: [PATCH 39/66] add missing import --- mediator/med_phases_post_atm_mod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index 5e8104a76..bcae36709 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -148,6 +148,7 @@ subroutine med_phases_post_atm_time_travelling_ice(gcomp, rc) use ESMF , only : ESMF_FieldGet, ESMF_Field use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use med_utils_mod , only : chkerr => med_utils_ChkErr use perf_mod , only : t_startf, t_stopf ! input/output variables From 45cf130dab4bec14627a14c068625640d9a4f93d Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Wed, 25 Feb 2026 16:16:45 +1100 Subject: [PATCH 40/66] field name changes --- mediator/esmFldsExchange_access_mod.F90 | 36 ++++++++++++------------- 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index e67ab7c8d..5c6c8d122 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -144,10 +144,10 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) 'Si_ifrac_n', & 'Si_vsno_n', & 'Si_vice_n', & - 'ia_itopt', & - 'ia_itopk', & - 'ia_pndfn', & - 'ia_pndtn', & + 'Si_topt', & + 'Si_topk', & + 'Si_pndf_n', & + 'Si_pndt_n', & 'sstfrz' & /) do n = 1,size(S_flds) @@ -272,11 +272,11 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) F_flds(3,:) = (/'Faxa_swvdf', 'Faxa_swvdf'/) F_flds(4,:) = (/'Faxa_swndf', 'Faxa_swndf'/) F_flds(5,:) = (/'Faxa_lwdn', 'Faxa_lwdn'/) - F_flds(6,:) = (/'pen_rad', 'pen_rad'/) - F_flds(7,:) = (/'topmelt', 'topmelt'/) - F_flds(8,:) = (/'botmelt', 'botmelt'/) - F_flds(9,:) = (/'tstar_sice', 'tstar_sice'/) - F_flds(10,:) = (/'sublim', 'sublim'/) + F_flds(6,:) = (/'Faxa_swpen_n', 'Faxa_swpen_n'/) + F_flds(7,:) = (/'Faxa_melthtop_n', 'Faxa_melthtop_n'/) + F_flds(8,:) = (/'Faxa_condtop_n', 'Faxa_condtop_n'/) + F_flds(9,:) = (/'Sa_tskn_n', 'Sa_tskn_n'/) + F_flds(10,:) = (/'Faxa_sublim_n', 'Faxa_sublim_n'/) F_flds(11,:) = (/'Foxx_sen', 'Foxx_sen'/) F_flds(12,:) = (/'Faxa_swdn', 'Faxa_swdn'/) do n = 1,size(F_flds,1) @@ -404,10 +404,10 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) S_flds = (/'Si_ifrac_n', & 'Si_vsno_n', & 'Si_vice_n', & - 'ia_itopt', & - 'ia_itopk', & - 'ia_pndfn', & - 'ia_pndtn'/) + 'Si_topt', & + 'Si_topk', & + 'Si_pndf_n', & + 'Si_pndt_n'/) do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addmap_from(compice, trim(fldname), compatm, mapconsf, 'none', 'unset') @@ -568,11 +568,11 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) ! from atm allocate(F_flds(12, 2)) - F_flds(1,:) = (/'pen_rad', 'pen_rad'/) - F_flds(2,:) = (/'topmelt', 'topmelt'/) - F_flds(3,:) = (/'botmelt', 'botmelt'/) - F_flds(4,:) = (/'tstar_sice', 'tstar_sice'/) - F_flds(5,:) = (/'sublim', 'sublim'/) + F_flds(1,:) = (/'Faxa_swpen_n', 'Faxa_swpen_n'/) + F_flds(2,:) = (/'Faxa_melthtop_n', 'Faxa_melthtop_n'/) + F_flds(3,:) = (/'Faxa_condtop_n', 'Faxa_condtop_n'/) + F_flds(4,:) = (/'Sa_tskn_n', 'Sa_tskn_n'/) + F_flds(5,:) = (/'Faxa_sublim_n', 'Faxa_sublim_n'/) F_flds(6,:) = (/'Faxa_swvdr ', 'Faxa_swvdr '/) F_flds(7,:) = (/'Faxa_swndr ', 'Faxa_swndr '/) F_flds(8,:) = (/'Faxa_swvdf', 'Faxa_swvdf'/) From 6fd0f896ecfb69e5d53f0d30c94e7f5f9738d712 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Tue, 3 Mar 2026 12:08:27 +1100 Subject: [PATCH 41/66] revert CMakeLists.txt and Makefile --- mediator/CMakeLists.txt | 2 +- mediator/Makefile | 7 +++---- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/mediator/CMakeLists.txt b/mediator/CMakeLists.txt index b95c62a18..b65004c37 100644 --- a/mediator/CMakeLists.txt +++ b/mediator/CMakeLists.txt @@ -1,6 +1,6 @@ project(cmeps Fortran) -set(SRCFILES esmFldsExchange_access_mod.F90 esmFldsExchange_cesm_mod.F90 med_fraction_mod.F90 +set(SRCFILES esmFldsExchange_cesm_mod.F90 med_fraction_mod.F90 med_field_info_mod.F90 med_methods_mod.F90 med_phases_prep_ice_mod.F90 med_phases_restart_mod.F90 esmFldsExchange_hafs_mod.F90 diff --git a/mediator/Makefile b/mediator/Makefile index d7ad9570c..a353ff9a5 100644 --- a/mediator/Makefile +++ b/mediator/Makefile @@ -36,14 +36,13 @@ esmFlds.o : med_kind_mod.o esmFldsExchange_cesm_mod.o : med_kind_mod.o med_methods_mod.o esmFlds.o med_internalstate_mod.o med_utils_mod.o esmFldsExchange_ufs_mod.o : med_kind_mod.o med_methods_mod.o esmFlds.o med_internalstate_mod.o med_utils_mod.o esmFldsExchange_hafs_mod.o : med_kind_mod.o med_methods_mod.o esmFlds.o med_internalstate_mod.o med_utils_mod.o -esmFldsExchange_access_mod.o : med_kind_mod.o med_methods_mod.o esmFlds.o med_internalstate_mod.o med_utils_mod.o med.o : med_kind_mod.o med_phases_profile_mod.o med_utils_mod.o med_phases_prep_rof_mod.o med_phases_aofluxes_mod.o \ med_phases_prep_ice_mod.o med_fraction_mod.o med_map_mod.o med_constants_mod.o med_phases_prep_wav_mod.o \ med_phases_prep_lnd_mod.o med_phases_history_mod.o med_phases_ocnalb_mod.o med_phases_restart_mod.o \ med_internalstate_mod.o med_phases_prep_atm_mod.o esmFldsExchange_cesm_mod.o esmFldsExchange_ufs_mod.o \ - esmFldsExchange_hafs_mod.o esmFldsExchange_access_mod.o med_phases_prep_glc_mod.o esmFlds.o med_io_mod.o med_methods_mod.o \ - med_phases_prep_ocn_mod.o med_phases_post_atm_mod.o med_phases_post_ice_mod.o med_phases_post_lnd_mod.o med_phases_post_glc_mod.o \ - med_phases_post_rof_mod.o med_phases_post_wav_mod.o + esmFldsExchange_hafs_mod.o med_phases_prep_glc_mod.o esmFlds.o med_io_mod.o med_methods_mod.o med_phases_prep_ocn_mod.o \ + med_phases_post_atm_mod.o med_phases_post_ice_mod.o med_phases_post_lnd_mod.o med_phases_post_glc_mod.o med_phases_post_rof_mod.o \ + med_phases_post_wav_mod.o med_fraction_mod.o : med_kind_mod.o med_utils_mod.o med_internalstate_mod.o med_constants_mod.o med_map_mod.o med_methods_mod.o esmFlds.o med_internalstate_mod.o : med_kind_mod.o esmFlds.o med_io_mod.o : med_kind_mod.o med_methods_mod.o med_constants_mod.o med_internalstate_mod.o med_utils_mod.o From 9c59a4b5460cf0c526fe86af3d30db94e08e0a3c Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Tue, 3 Mar 2026 12:09:37 +1100 Subject: [PATCH 42/66] check ice_frac_cat_ptr > 1e-11 (puny) before division --- mediator/med_phases_post_atm_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index bcae36709..8e8ed383c 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -197,7 +197,7 @@ subroutine med_phases_post_atm_time_travelling_ice(gcomp, rc) do j = 1,lsize2 do i = 1,lsize1 - if (ice_frac_cat_ptr(i, j) > 0.0) then + if (ice_frac_cat_ptr(i, j) > 1e-11) then ice_flux_cat_ptr(i, j) = ice_flux_cat_ptr(i, j) / ice_frac_cat_ptr(i, j) end if end do From 47af1a5eef10b5c2cff0128af01e989cd06eaeb9 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Wed, 11 Mar 2026 10:33:36 +1100 Subject: [PATCH 43/66] update coupled names in post_atm tti --- mediator/med_phases_post_atm_mod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index 8e8ed383c..e7fd1aa06 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -184,10 +184,10 @@ subroutine med_phases_post_atm_time_travelling_ice(gcomp, rc) lsize2 = size(ice_frac_cat_ptr, dim=2) fld_names = [character(len=CS) :: & - 'topmelt', & - 'botmelt', & - 'sublim', & - 'pen_rad'] + 'Faxa_melthtop_n', & + 'Faxa_condtop_n', & + 'Faxa_sublim_n', & + 'Faxa_swpen_n'] do n = 1,size(fld_names) From 3675fa19baa28456f31249159b4c529d4654395f Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Wed, 11 Mar 2026 12:27:54 +1100 Subject: [PATCH 44/66] update coupling mode check --- mediator/med_phases_prep_ocn_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 438335684..e9f4a67bd 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -255,7 +255,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) end if ! custom merges to ocean - if (trim(coupling_mode) /= "access") then + if (trim(coupling_mode) /= "access-esm") then call med_phases_prep_ocn_custom(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if From 56e1a59594b5353f6936610f9a9b04896a6b3197 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 16 Mar 2026 12:06:01 +1100 Subject: [PATCH 45/66] Indent changes Co-authored-by: Anton Steketee <79179784+anton-seaice@users.noreply.github.com> --- mediator/esmFldsExchange_access_mod.F90 | 40 ++++++++++++------------- 1 file changed, 19 insertions(+), 21 deletions(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index 5c6c8d122..4e1222714 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -141,14 +141,14 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- allocate(S_flds(9)) S_flds = (/'Si_t', & - 'Si_ifrac_n', & - 'Si_vsno_n', & - 'Si_vice_n', & - 'Si_topt', & - 'Si_topk', & - 'Si_pndf_n', & - 'Si_pndt_n', & - 'sstfrz' & + 'Si_ifrac_n', & + 'Si_vsno_n', & + 'Si_vice_n', & + 'Si_topt', & + 'Si_topk', & + 'Si_pndf_n', & + 'Si_pndt_n', & + 'Si_Tf' & /) do n = 1,size(S_flds) fldname = trim(S_flds(n)) @@ -166,7 +166,7 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- allocate(S_flds(2)) S_flds = (/'Sa_pslv', & - 'So_duu10n' /) + 'So_duu10n' /) do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addfld_from(compatm, trim(fldname)) @@ -209,7 +209,7 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) allocate(F_flds(6, 2)) F_flds(1,:) = (/'Fioi_salt', 'Fioi_salt'/) ! salt flux sea-ice to ocean F_flds(2,:) = (/'Si_ifrac', 'Si_ifrac'/) ! ice_fraction - F_flds(3,:) = (/'Fioi_meltw', 'Fioi_meltw'/) ! melt water flux sea-ice to ocean + F_flds(3,:) = (/'Fioi_meltw', 'Fioi_meltw'/) ! freshwater flux sea-ice to ocean F_flds(4,:) = (/'Fioi_melth', 'Fioi_melth'/) ! heat flux sea-ice to ocean F_flds(5,:) = (/'Fioi_taux', 'Foxx_taux'/) F_flds(6,:) = (/'Fioi_tauy', 'Foxx_tauy'/) ! surface stress sea-ice to ocean @@ -232,13 +232,14 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) ! from atm allocate(S_flds(8)) S_flds = (/'Sa_z', & - 'Sa_u', & - 'Sa_v', & - 'Sa_shum', & - 'Sa_tbot', & - 'Sa_pbot', & - 'Sa_dens', & - 'Sa_ptem'/) + 'Sa_u', & + 'Sa_v', & + 'Sa_shum', & + 'Sa_tbot', & + 'Sa_pbot', & + 'Sa_dens', & + 'Sa_ptem' & + /) do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addfld_from(compatm, trim(fldname)) @@ -384,9 +385,6 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) ! FIELDS TO ATMOSPHERE !===================================================================== - ! --------------------------------------------------------------------- - ! to atm: sea surface temperature - ! --------------------------------------------------------------------- call addmap_from(compocn, 'So_t', compatm, mapconsf, 'ofrac', 'unset') call addmrg_to(compatm, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') call addmap_from(compocn, 'So_u', compatm, mapconsf, 'ofrac', 'unset') @@ -424,7 +422,7 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) ! --------------------------------------------------------------------- allocate(S_flds(2)) S_flds = (/'Sa_pslv', & ! inst_zonal_wind_height10m - 'So_duu10n' /) ! inst_temp_height_surface + 'So_duu10n' /) ! inst_temp_height_surface do n = 1,size(S_flds) fldname = trim(S_flds(n)) if (fldchk(is_local%wrap%FBExp(compocn), trim(fldname), rc=rc) .and. & From 3a813ae711b1b2e02527634c261a44f6e9abe700 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 16 Mar 2026 12:32:17 +1100 Subject: [PATCH 46/66] Delete duplicate rainc and snowc Co-authored-by: Anton Steketee <79179784+anton-seaice@users.noreply.github.com> --- mediator/esmFldsExchange_access_mod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index 4e1222714..02ab40dca 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -202,8 +202,6 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) end do deallocate(F_flds) - call addfld_from(compatm, 'Faxa_rainc') - call addfld_from(compatm, 'Faxa_snowc') ! from ice allocate(F_flds(6, 2)) From 50da986fda5e5bff4122b0a485c85bb5d080e69a Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 16 Mar 2026 12:34:55 +1100 Subject: [PATCH 47/66] fix comments --- mediator/esmFldsExchange_access_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index 02ab40dca..3205bd9fb 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -542,8 +542,8 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) 'So_dhdy', & ! inst_merid_wind_height10m 'So_t ', & ! inst_temp_height2m 'So_s ', & ! inst_spec_humid_height2m - 'So_u', & ! Sa_pslv - 'So_v', & ! Sa_pslv + 'So_u', & ! ocean surface zonal current + 'So_v', & ! ocean surface meridional current 'Fioo_q' /) ! inst_temp_height_surface do n = 1,size(S_flds) fldname = trim(S_flds(n)) From 92c548627cd9a2fee047c81bf17fb3c06e786156 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 16 Mar 2026 12:37:01 +1100 Subject: [PATCH 48/66] fix indentation --- mediator/esmFldsExchange_access_mod.F90 | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_access_mod.F90 index 3205bd9fb..e5c83d0ef 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_access_mod.F90 @@ -397,13 +397,16 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) call addmrg_to(compatm, 'sstfrz', mrg_from=compice, mrg_fld='sstfrz', mrg_type='copy') allocate(S_flds(7)) - S_flds = (/'Si_ifrac_n', & - 'Si_vsno_n', & - 'Si_vice_n', & - 'Si_topt', & - 'Si_topk', & - 'Si_pndf_n', & - 'Si_pndt_n'/) + S_flds = (/'Si_t', & + 'Si_ifrac_n', & + 'Si_vsno_n', & + 'Si_vice_n', & + 'Si_topt', & + 'Si_topk', & + 'Si_pndf_n', & + 'Si_pndt_n', & + 'Si_Tf' & + /) do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addmap_from(compice, trim(fldname), compatm, mapconsf, 'none', 'unset') From 583384ace28f76b398ce8d41e2f1c98850556c79 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 16 Mar 2026 12:41:36 +1100 Subject: [PATCH 49/66] rename `access->accessesm` --- ....F90 => esmFldsExchange_accessesm_mod.F90} | 36 +++++++++---------- mediator/med.F90 | 2 +- 2 files changed, 19 insertions(+), 19 deletions(-) rename mediator/{esmFldsExchange_access_mod.F90 => esmFldsExchange_accessesm_mod.F90} (96%) diff --git a/mediator/esmFldsExchange_access_mod.F90 b/mediator/esmFldsExchange_accessesm_mod.F90 similarity index 96% rename from mediator/esmFldsExchange_access_mod.F90 rename to mediator/esmFldsExchange_accessesm_mod.F90 index e5c83d0ef..a93c221ce 100644 --- a/mediator/esmFldsExchange_access_mod.F90 +++ b/mediator/esmFldsExchange_accessesm_mod.F90 @@ -1,4 +1,4 @@ -module esmFldsExchange_access_mod +module esmFldsExchange_accessesm_mod use ESMF use NUOPC @@ -21,7 +21,7 @@ module esmFldsExchange_access_mod implicit none public - public :: esmFldsExchange_access + public :: esmFldsExchange_accessesm character(*), parameter :: u_FILE_u = & __FILE__ @@ -30,7 +30,7 @@ module esmFldsExchange_access_mod contains !=============================================================================== - subroutine esmFldsExchange_access(gcomp, phase, rc) + subroutine esmFldsExchange_accessesm(gcomp, phase, rc) ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -38,20 +38,20 @@ subroutine esmFldsExchange_access(gcomp, phase, rc) integer , intent(inout) :: rc ! local variables: - character(len=*) , parameter :: subname='(esmFldsExchange_access)' + character(len=*) , parameter :: subname='(esmFldsExchange_accessesm)' !-------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS if (phase == 'advertise') then - call esmFldsExchange_access_advt(gcomp, phase, rc) + call esmFldsExchange_accessesm_advt(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return elseif (phase == 'fieldcheck') then - call esmFldsExchange_access_fchk(gcomp, phase, rc) + call esmFldsExchange_accessesm_fchk(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return elseif (phase == 'initialize') then - call esmFldsExchange_access_init(gcomp, phase, rc) + call esmFldsExchange_accessesm_init(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else call ESMF_LogSetError(ESMF_FAILURE, & @@ -62,11 +62,11 @@ subroutine esmFldsExchange_access(gcomp, phase, rc) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - end subroutine esmFldsExchange_access + end subroutine esmFldsExchange_accessesm !----------------------------------------------------------------------------- - subroutine esmFldsExchange_access_advt(gcomp, phase, rc) + subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -83,7 +83,7 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) character(len=CS), allocatable :: S_flds(:) character(len=CS), allocatable :: F_flds(:,:) character(len=CS), allocatable :: suffix(:) - character(len=*) , parameter :: subname='(esmFldsExchange_access_advt)' + character(len=*) , parameter :: subname='(esmFldsExchange_accessesm_advt)' !-------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -296,11 +296,11 @@ subroutine esmFldsExchange_access_advt(gcomp, phase, rc) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - end subroutine esmFldsExchange_access_advt + end subroutine esmFldsExchange_accessesm_advt !----------------------------------------------------------------------------- - subroutine esmFldsExchange_access_fchk(gcomp, phase, rc) + subroutine esmFldsExchange_accessesm_fchk(gcomp, phase, rc) use med_methods_mod , only : fldchk => med_methods_FB_FldChk use med_internalstate_mod , only : InternalState @@ -312,7 +312,7 @@ subroutine esmFldsExchange_access_fchk(gcomp, phase, rc) ! local variables: type(InternalState) :: is_local - character(len=*) , parameter :: subname='(esmFldsExchange_access_fchk)' + character(len=*) , parameter :: subname='(esmFldsExchange_accessesm_fchk)' !-------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -337,11 +337,11 @@ subroutine esmFldsExchange_access_fchk(gcomp, phase, rc) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - end subroutine esmFldsExchange_access_fchk + end subroutine esmFldsExchange_accessesm_fchk !----------------------------------------------------------------------------- - subroutine esmFldsExchange_access_init(gcomp, phase, rc) + subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) use med_methods_mod , only : fldchk => med_methods_FB_FldChk use med_internalstate_mod , only : InternalState @@ -366,7 +366,7 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) character(len=CS), allocatable :: S_flds(:) character(len=CS), allocatable :: F_flds(:,:) character(len=CS), allocatable :: suffix(:) - character(len=*) , parameter :: subname='(esmFldsExchange_access_init)' + character(len=*) , parameter :: subname='(esmFldsExchange_accessesm_init)' !-------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -607,8 +607,8 @@ subroutine esmFldsExchange_access_init(gcomp, phase, rc) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - end subroutine esmFldsExchange_access_init + end subroutine esmFldsExchange_accessesm_init !----------------------------------------------------------------------------- - end module esmFldsExchange_access_mod + end module esmFldsExchange_accessesm_mod diff --git a/mediator/med.F90 b/mediator/med.F90 index b2d727270..89c46cc27 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -52,7 +52,7 @@ module MED use esmFldsExchange_ufs_mod , only : esmFldsExchange_ufs use esmFldsExchange_cesm_mod , only : esmFldsExchange_cesm use esmFldsExchange_hafs_mod , only : esmFldsExchange_hafs - use esmFldsExchange_access_mod , only : esmFldsExchange_access + use esmFldsExchange_accessesm_mod , only : esmFldsExchange_accessesm use med_phases_profile_mod , only : med_phases_profile_finalize use shr_log_mod , only : shr_log_error From 82cc47cd58403b7116a7894068e0b404a4acda43 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 16 Mar 2026 12:43:40 +1100 Subject: [PATCH 50/66] delete fieldcheck --- mediator/esmFldsExchange_accessesm_mod.F90 | 44 ---------------------- 1 file changed, 44 deletions(-) diff --git a/mediator/esmFldsExchange_accessesm_mod.F90 b/mediator/esmFldsExchange_accessesm_mod.F90 index a93c221ce..f4792c4af 100644 --- a/mediator/esmFldsExchange_accessesm_mod.F90 +++ b/mediator/esmFldsExchange_accessesm_mod.F90 @@ -47,9 +47,6 @@ subroutine esmFldsExchange_accessesm(gcomp, phase, rc) if (phase == 'advertise') then call esmFldsExchange_accessesm_advt(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - elseif (phase == 'fieldcheck') then - call esmFldsExchange_accessesm_fchk(gcomp, phase, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return elseif (phase == 'initialize') then call esmFldsExchange_accessesm_init(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -300,47 +297,6 @@ end subroutine esmFldsExchange_accessesm_advt !----------------------------------------------------------------------------- - subroutine esmFldsExchange_accessesm_fchk(gcomp, phase, rc) - - use med_methods_mod , only : fldchk => med_methods_FB_FldChk - use med_internalstate_mod , only : InternalState - - ! input/output parameters: - type(ESMF_GridComp) :: gcomp - character(len=*) , intent(in) :: phase - integer , intent(inout) :: rc - - ! local variables: - type(InternalState) :: is_local - character(len=*) , parameter :: subname='(esmFldsExchange_accessesm_fchk)' - !-------------------------------------- - - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - rc = ESMF_SUCCESS - - !--------------------------------------- - ! Get the internal state - !--------------------------------------- - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (fldchk(is_local%wrap%FBImp(compocn,compocn),'So_omask',rc=rc)) then - call ESMF_LogWrite(trim(subname)//": Field connected "//"So_omask", & - ESMF_LOGMSG_INFO) - else - call ESMF_LogSetError(ESMF_FAILURE, & - msg=trim(subname)//": Field is not connected "//"So_omask", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - - end subroutine esmFldsExchange_accessesm_fchk - - !----------------------------------------------------------------------------- - subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) use med_methods_mod , only : fldchk => med_methods_FB_FldChk From 373433624cb3fce3ee4316f6fba328ea7294a026 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 16 Mar 2026 14:57:55 +1100 Subject: [PATCH 51/66] delete unecessary fields going into CICE --- mediator/esmFldsExchange_accessesm_mod.F90 | 43 +++++++++------------- 1 file changed, 17 insertions(+), 26 deletions(-) diff --git a/mediator/esmFldsExchange_accessesm_mod.F90 b/mediator/esmFldsExchange_accessesm_mod.F90 index f4792c4af..baba6b181 100644 --- a/mediator/esmFldsExchange_accessesm_mod.F90 +++ b/mediator/esmFldsExchange_accessesm_mod.F90 @@ -176,7 +176,7 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- ! from atm - allocate(F_flds(13, 2)) + allocate(F_flds(11, 2)) F_flds(1,:) = (/'Faxa_taux ', 'Foxx_taux'/) F_flds(2,:) = (/'Faxa_tauy ', 'Foxx_tauy'/) F_flds(3,:) = (/'Foxx_sen', 'Foxx_sen'/) @@ -186,10 +186,8 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) F_flds(7,:) = (/'Foxx_swnet_vdf', 'Foxx_swnet_vdf'/) F_flds(8,:) = (/'Foxx_swnet_idr', 'Foxx_swnet_idr'/) F_flds(9,:) = (/'Foxx_swnet_idf', 'Foxx_swnet_idf'/) - F_flds(10,:) = (/'Faxa_rainc', 'Faxa_rain'/) - F_flds(11,:) = (/'Faxa_snowc', 'Faxa_snow'/) - F_flds(12,:) = (/'Foxx_rofl', 'Foxx_rofl'/) ! mean runoff rate (liquid) - F_flds(13,:) = (/'Foxx_rofi', 'Foxx_rofi'/) ! mean runnof rate (frozen) + F_flds(10,:) = (/'Foxx_rofl', 'Foxx_rofl'/) ! mean runoff rate (liquid) + F_flds(11,:) = (/'Foxx_rofi', 'Foxx_rofi'/) ! mean runnof rate (frozen) do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) @@ -262,19 +260,12 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) ! to ice: flux fields ! --------------------------------------------------------------------- - allocate(F_flds(12, 2)) - F_flds(1,:) = (/'Faxa_swvdr ', 'Faxa_swvdr '/) - F_flds(2,:) = (/'Faxa_swndr ', 'Faxa_swndr '/) - F_flds(3,:) = (/'Faxa_swvdf', 'Faxa_swvdf'/) - F_flds(4,:) = (/'Faxa_swndf', 'Faxa_swndf'/) - F_flds(5,:) = (/'Faxa_lwdn', 'Faxa_lwdn'/) - F_flds(6,:) = (/'Faxa_swpen_n', 'Faxa_swpen_n'/) - F_flds(7,:) = (/'Faxa_melthtop_n', 'Faxa_melthtop_n'/) - F_flds(8,:) = (/'Faxa_condtop_n', 'Faxa_condtop_n'/) - F_flds(9,:) = (/'Sa_tskn_n', 'Sa_tskn_n'/) - F_flds(10,:) = (/'Faxa_sublim_n', 'Faxa_sublim_n'/) - F_flds(11,:) = (/'Foxx_sen', 'Foxx_sen'/) - F_flds(12,:) = (/'Faxa_swdn', 'Faxa_swdn'/) + allocate(F_flds(5, 2)) + F_flds(1,:) = (/'Faxa_swpen_n', 'Faxa_swpen_n'/) + F_flds(2,:) = (/'Faxa_melthtop_n', 'Faxa_melthtop_n'/) + F_flds(3,:) = (/'Faxa_condtop_n', 'Faxa_condtop_n'/) + F_flds(4,:) = (/'Sa_tskn_n', 'Sa_tskn_n'/) + F_flds(5,:) = (/'Faxa_sublim_n', 'Faxa_sublim_n'/) do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) fldname2 = trim(F_flds(n,2)) @@ -283,11 +274,18 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) end do deallocate(F_flds) + ! --------------------------------------------------------------------- + ! precipitation + ! --------------------------------------------------------------------- + call addfld_from(compatm, 'Faxa_rainc') call addfld_from(compatm, 'Faxa_snowc') call addfld_from(compatm, 'Faxa_rainl') call addfld_from(compatm, 'Faxa_snowl') + call addfld_to(compocn, 'Faxa_rain') + call addfld_to(compocn, 'Faxa_snow') + call addfld_to(compice, 'Faxa_rain') call addfld_to(compice, 'Faxa_snow') @@ -522,19 +520,12 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) ! --------------------------------------------------------------------- ! from atm - allocate(F_flds(12, 2)) + allocate(F_flds(5, 2)) F_flds(1,:) = (/'Faxa_swpen_n', 'Faxa_swpen_n'/) F_flds(2,:) = (/'Faxa_melthtop_n', 'Faxa_melthtop_n'/) F_flds(3,:) = (/'Faxa_condtop_n', 'Faxa_condtop_n'/) F_flds(4,:) = (/'Sa_tskn_n', 'Sa_tskn_n'/) F_flds(5,:) = (/'Faxa_sublim_n', 'Faxa_sublim_n'/) - F_flds(6,:) = (/'Faxa_swvdr ', 'Faxa_swvdr '/) - F_flds(7,:) = (/'Faxa_swndr ', 'Faxa_swndr '/) - F_flds(8,:) = (/'Faxa_swvdf', 'Faxa_swvdf'/) - F_flds(9,:) = (/'Faxa_swndf', 'Faxa_swndf'/) - F_flds(10,:) = (/'Faxa_lwdn', 'Faxa_lwdn'/) - F_flds(11,:) = (/'Foxx_sen', 'Foxx_sen'/) - F_flds(12,:) = (/'Faxa_swdn', 'Faxa_swdn'/) do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) From 4a2c9be4c165a314eccf7a00d4a799a04f4cbaff Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 16 Mar 2026 15:40:58 +1100 Subject: [PATCH 52/66] add fieldchecks around re-mapping --- mediator/esmFldsExchange_accessesm_mod.F90 | 126 ++++++++++++++------- mediator/med_phases_post_atm_mod.F90 | 9 +- 2 files changed, 87 insertions(+), 48 deletions(-) diff --git a/mediator/esmFldsExchange_accessesm_mod.F90 b/mediator/esmFldsExchange_accessesm_mod.F90 index baba6b181..5cf949d23 100644 --- a/mediator/esmFldsExchange_accessesm_mod.F90 +++ b/mediator/esmFldsExchange_accessesm_mod.F90 @@ -337,20 +337,20 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) ! FIELDS TO ATMOSPHERE !===================================================================== - call addmap_from(compocn, 'So_t', compatm, mapconsf, 'ofrac', 'unset') - call addmrg_to(compatm, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') - call addmap_from(compocn, 'So_u', compatm, mapconsf, 'ofrac', 'unset') - call addmrg_to(compatm, 'So_u', mrg_from=compocn, mrg_fld='So_u', mrg_type='copy') - call addmap_from(compocn, 'So_v', compatm, mapconsf, 'ofrac', 'unset') - call addmrg_to(compatm, 'So_v', mrg_from=compocn, mrg_fld='So_v', mrg_type='copy') - - call addmap_from(compice, 'Si_t', compatm, mapconsd, 'ifrac', 'unset') - call addmrg_to(compatm, 'Si_t', mrg_from=compice, mrg_fld='Si_t', mrg_type='copy') - - call addmap_from(compice, 'sstfrz', compatm, mapconsf, 'none', 'unset') - call addmrg_to(compatm, 'sstfrz', mrg_from=compice, mrg_fld='sstfrz', mrg_type='copy') + allocate(S_flds(3)) + S_flds = (/'So_t', 'So_u', 'So_v'/) + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compatm), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn, compocn), trim(fldname), rc=rc) & + ) then + call addmap_from(compocn, trim(fldname), compatm, mapconsf, 'ofrac', 'unset') + call addmrg_to(compatm, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) - allocate(S_flds(7)) + allocate(S_flds(9)) S_flds = (/'Si_t', & 'Si_ifrac_n', & 'Si_vsno_n', & @@ -363,8 +363,12 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) /) do n = 1,size(S_flds) fldname = trim(S_flds(n)) - call addmap_from(compice, trim(fldname), compatm, mapconsf, 'none', 'unset') - call addmrg_to(compatm, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + if (fldchk(is_local%wrap%FBExp(compatm), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice, compice), trim(fldname), rc=rc) & + ) then + call addmap_from(compice, trim(fldname), compatm, mapconsf, 'none', 'unset') + call addmrg_to(compatm, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + end if end do deallocate(S_flds) @@ -420,24 +424,32 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) deallocate(F_flds) ! precip - call addmap_from(compatm, 'Faxa_rainc', compocn, mapconsf, 'one', 'unset') - call addmap_from(compatm, 'Faxa_rainl', compocn, mapconsf, 'one', 'unset') - call addmrg_to(compocn, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', & + if (fldchk(is_local%wrap%FBExp(compocn), trim('Faxa_rain'), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_rainc'),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_rainl'),rc=rc) .and. & + ) then + call addmap_from(compatm, 'Faxa_rainc', compocn, mapconsf, 'one', 'unset') + call addmap_from(compatm, 'Faxa_rainl', compocn, mapconsf, 'one', 'unset') + call addmrg_to(compocn, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', & mrg_type='sum_with_weights', mrg_fracname='ofrac') - - call addmap_from(compatm, 'Faxa_snowc', compocn, mapconsf, 'one', 'unset') - call addmap_from(compatm, 'Faxa_snowl', compocn, mapconsf, 'one', 'unset') - call addmrg_to(compocn, 'Faxa_snow' , mrg_from=compatm, mrg_fld='Faxa_snowc:Faxa_snowl', & + end if + + if (fldchk(is_local%wrap%FBExp(compocn), trim('Faxa_snow'), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_snowc'),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_snowl'),rc=rc) .and. & + ) then + call addmap_from(compatm, 'Faxa_snowc', compocn, mapconsf, 'one', 'unset') + call addmap_from(compatm, 'Faxa_snowl', compocn, mapconsf, 'one', 'unset') + call addmrg_to(compocn, 'Faxa_snow' , mrg_from=compatm, mrg_fld='Faxa_snowc:Faxa_snowl', & mrg_type='sum_with_weights', mrg_fracname='ofrac') + end if ! from ice - call addmap_from(compice, 'Si_ifrac', compocn, mapfcopy, 'unset', 'unset') - call addmrg_to(compocn, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') - - allocate(F_flds(3, 2)) + allocate(F_flds(4, 2)) F_flds(1,:) = (/'Fioi_salt', 'Fioi_salt'/) F_flds(2,:) = (/'Fioi_meltw', 'Fioi_meltw'/) - F_flds(3,:) = (/'Fioi_melth', 'Fioi_melth'/) ! heat flux sea-ice to ocean + F_flds(3,:) = (/'Fioi_melth', 'Fioi_melth'/) + F_flds(4,:) = (/'Si_ifrac', 'Si_ifrac'/) do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) fldname2 = trim(F_flds(n,2)) @@ -451,15 +463,33 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) deallocate(F_flds) ! momentum transfer - call addmap_from(compice, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') - call addmrg_to(compocn, 'Foxx_taux', mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') - call addmap_from(compatm, 'Faxa_taux', compocn, mappatch, 'one', 'unset') - call addmrg_to(compocn, 'Foxx_taux', mrg_from=compatm, mrg_fld='Faxa_taux', mrg_type='merge', mrg_fracname='ofrac') + if (fldchk(is_local%wrap%FBExp(compocn), trim('Foxx_taux'), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice, compice), trim('Fioi_taux'),rc=rc) & + ) then + call addmap_from(compice, trim('Fioi_taux'), compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, trim('Foxx_taux'), mrg_from=compice, mrg_fld=trim('Fioi_taux'), mrg_type='merge', mrg_fracname='ifrac') + end if - call addmap_from(compice, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') - call addmrg_to(compocn, 'Foxx_tauy', mrg_from=compice, mrg_fld='Fioi_tauy', mrg_type='merge', mrg_fracname='ifrac') - call addmap_from(compatm, 'Faxa_tauy', compocn, mappatch, 'one', 'unset') - call addmrg_to(compocn, 'Foxx_tauy', mrg_from=compatm, mrg_fld='Faxa_tauy', mrg_type='merge', mrg_fracname='ofrac') + if (fldchk(is_local%wrap%FBExp(compocn), trim('Foxx_tauy'), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice, compice), trim('Fioi_tauy'),rc=rc) & + ) then + call addmap_from(compice, trim('Fioi_tauy'), compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, trim('Foxx_tauy'), mrg_from=compice, mrg_fld=trim('Fioi_tauy'), mrg_type='merge', mrg_fracname='ifrac') + end if + + if (fldchk(is_local%wrap%FBExp(compocn), trim('Foxx_taux'), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_taux'),rc=rc) & + ) then + call addmap_from(compatm, trim('Faxa_taux'), compocn, mappatch, 'one', 'unset') + call addmrg_to(compocn, trim('Foxx_taux'), mrg_from=compatm, mrg_fld=trim('Faxa_taux'), mrg_type='merge', mrg_fracname='ofrac') + end if + + if (fldchk(is_local%wrap%FBExp(compocn), trim('Foxx_tauy'), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_tauy'),rc=rc) & + ) then + call addmap_from(compatm, trim('Faxa_tauy'), compocn, mappatch, 'one', 'unset') + call addmrg_to(compocn, trim('Foxx_tauy'), mrg_from=compatm, mrg_fld=trim('Faxa_tauy'), mrg_type='merge', mrg_fracname='ofrac') + end if !===================================================================== ! FIELDS TO ICE (compice) @@ -534,7 +564,7 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) fldchk(is_local%wrap%FBImp(compatm, compatm), trim(fldname1), rc=rc) & ) then - call addmap_from(compatm, trim(fldname1), compice, mapconsf, 'one', 'unset') ! mapping with total ifrac, should use category fractions + call addmap_from(compatm, trim(fldname1), compice, mapconsf, 'one', 'unset') call addmrg_to(compice, trim(fldname2), mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') end if @@ -542,15 +572,25 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) deallocate(F_flds) ! precip - call addmap_from(compatm, 'Faxa_rainc', compice, mapconsf, 'one', 'unset') - call addmap_from(compatm, 'Faxa_rainl', compice, mapconsf, 'one', 'unset') - call addmrg_to(compice, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', & + if (fldchk(is_local%wrap%FBExp(compice), trim('Faxa_rain'), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_rainc'),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_rainl'),rc=rc) .and. & + ) then + call addmap_from(compatm, 'Faxa_rainc', compice, mapconsf, 'one', 'unset') + call addmap_from(compatm, 'Faxa_rainl', compice, mapconsf, 'one', 'unset') + call addmrg_to(compice, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', & mrg_type='sum') - - call addmap_from(compatm, 'Faxa_snowc', compice, mapconsf, 'one', 'unset') - call addmap_from(compatm, 'Faxa_snowl', compice, mapconsf, 'one', 'unset') - call addmrg_to(compice, 'Faxa_snow' , mrg_from=compatm, mrg_fld='Faxa_snowc:Faxa_snowl', & + end if + + if (fldchk(is_local%wrap%FBExp(compice), trim('Faxa_snow'), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_snowc'),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_snowl'),rc=rc) .and. & + ) then + call addmap_from(compatm, 'Faxa_snowc', compice, mapconsf, 'one', 'unset') + call addmap_from(compatm, 'Faxa_snowl', compice, mapconsf, 'one', 'unset') + call addmrg_to(compice, 'Faxa_snow' , mrg_from=compatm, mrg_fld='Faxa_snowc:Faxa_snowl', & mrg_type='sum') + end if call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index e7fd1aa06..c275c0ebf 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -58,11 +58,6 @@ subroutine med_phases_post_atm(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(coupling_mode) == 'access-esm') then - call med_phases_post_atm_time_travelling_ice(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - ! map atm to ocn if (is_local%wrap%med_coupling_active(compatm,compocn)) then call t_startf('MED:'//trim(subname)//' map_atm2ocn') @@ -80,6 +75,10 @@ subroutine med_phases_post_atm(gcomp, rc) ! map atm->ice if (is_local%wrap%med_coupling_active(compatm,compice)) then call t_startf('MED:'//trim(subname)//' map_atm2ice') + if (trim(coupling_mode) == 'access-esm') then + call med_phases_post_atm_time_travelling_ice(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if call med_map_field_packed( & FBSrc=is_local%wrap%FBImp(compatm,compatm), & FBDst=is_local%wrap%FBImp(compatm,compice), & From 684e9e0e10f8b601700b672d781886bcd97803c6 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 16 Mar 2026 16:17:15 +1100 Subject: [PATCH 53/66] fix syntax errors --- mediator/esmFldsExchange_accessesm_mod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/mediator/esmFldsExchange_accessesm_mod.F90 b/mediator/esmFldsExchange_accessesm_mod.F90 index 5cf949d23..46cc8cb23 100644 --- a/mediator/esmFldsExchange_accessesm_mod.F90 +++ b/mediator/esmFldsExchange_accessesm_mod.F90 @@ -426,7 +426,7 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) ! precip if (fldchk(is_local%wrap%FBExp(compocn), trim('Faxa_rain'), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_rainc'),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_rainl'),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_rainl'),rc=rc) & ) then call addmap_from(compatm, 'Faxa_rainc', compocn, mapconsf, 'one', 'unset') call addmap_from(compatm, 'Faxa_rainl', compocn, mapconsf, 'one', 'unset') @@ -436,7 +436,7 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) if (fldchk(is_local%wrap%FBExp(compocn), trim('Faxa_snow'), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_snowc'),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_snowl'),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_snowl'),rc=rc) & ) then call addmap_from(compatm, 'Faxa_snowc', compocn, mapconsf, 'one', 'unset') call addmap_from(compatm, 'Faxa_snowl', compocn, mapconsf, 'one', 'unset') @@ -574,7 +574,7 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) ! precip if (fldchk(is_local%wrap%FBExp(compice), trim('Faxa_rain'), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_rainc'),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_rainl'),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_rainl'),rc=rc) & ) then call addmap_from(compatm, 'Faxa_rainc', compice, mapconsf, 'one', 'unset') call addmap_from(compatm, 'Faxa_rainl', compice, mapconsf, 'one', 'unset') @@ -584,7 +584,7 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) if (fldchk(is_local%wrap%FBExp(compice), trim('Faxa_snow'), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_snowc'),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_snowl'),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_snowl'),rc=rc) & ) then call addmap_from(compatm, 'Faxa_snowc', compice, mapconsf, 'one', 'unset') call addmap_from(compatm, 'Faxa_snowl', compice, mapconsf, 'one', 'unset') From 3a2c243a250b5ca08d4542e4b2c517357bdb1316 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 16 Mar 2026 16:29:29 +1100 Subject: [PATCH 54/66] fix import error --- mediator/med.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 89c46cc27..c8bfe2771 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1864,7 +1864,7 @@ subroutine DataInitialize(gcomp, rc) call esmFldsExchange_hafs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'access-esm') then - call esmFldsExchange_access(gcomp, phase='initialize', rc=rc) + call esmFldsExchange_accessesm(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if From 9107e8dfdecdb6022c6d671b5cddf4a6e77264f1 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 16 Mar 2026 16:45:45 +1100 Subject: [PATCH 55/66] fix import error --- mediator/med.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index c8bfe2771..ec79f9b78 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -844,7 +844,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) call esmFldsExchange_hafs(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'access-esm') then - call esmFldsExchange_access(gcomp, phase='advertise', rc=rc) + call esmFldsExchange_accessesm(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else call shr_log_error(trim(coupling_mode)//' is not a valid coupling_mode', rc=rc) From 1a1a029737e7cda77c512085b966a6e0341b4bf0 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 30 Mar 2026 16:49:16 +1100 Subject: [PATCH 56/66] map wind stress to sea-ice and remove atm->ice state fields --- mediator/esmFldsExchange_accessesm_mod.F90 | 60 +++++++--------------- 1 file changed, 18 insertions(+), 42 deletions(-) diff --git a/mediator/esmFldsExchange_accessesm_mod.F90 b/mediator/esmFldsExchange_accessesm_mod.F90 index 46cc8cb23..d3c197c59 100644 --- a/mediator/esmFldsExchange_accessesm_mod.F90 +++ b/mediator/esmFldsExchange_accessesm_mod.F90 @@ -222,24 +222,6 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) ! to ice: state fields ! --------------------------------------------------------------------- - ! from atm - allocate(S_flds(8)) - S_flds = (/'Sa_z', & - 'Sa_u', & - 'Sa_v', & - 'Sa_shum', & - 'Sa_tbot', & - 'Sa_pbot', & - 'Sa_dens', & - 'Sa_ptem' & - /) - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - call addfld_from(compatm, trim(fldname)) - call addfld_to(compice, trim(fldname)) - end do - deallocate(S_flds) - ! from ocn allocate(S_flds(7)) S_flds = (/'So_dhdx', & @@ -289,6 +271,9 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) call addfld_to(compice, 'Faxa_rain') call addfld_to(compice, 'Faxa_snow') + call addfld_to(compice, 'Faii_taux') + call addfld_to(compice, 'Faii_tauy') + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine esmFldsExchange_accessesm_advt @@ -499,30 +484,6 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) ! to ice: state fields ! --------------------------------------------------------------------- - ! from atm - allocate(S_flds(8)) - S_flds = (/'Sa_z', & - 'Sa_u', & - 'Sa_v', & - 'Sa_shum', & - 'Sa_tbot', & - 'Sa_pbot', & - 'Sa_dens', & - 'Sa_ptem' /) - - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - if (fldchk(is_local%wrap%FBExp(compice), trim(fldname),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm, compatm), trim(fldname),rc=rc) & - ) then - - call addmap_from(compatm, trim(fldname), compice, mapbilnr, 'one', 'unset') - call addmrg_to(compice, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') - - end if - end do - deallocate(S_flds) - ! from ocn allocate(S_flds(7)) S_flds = (/'So_dhdx', & ! inst_zonal_wind_height10m @@ -571,6 +532,21 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) end do deallocate(F_flds) + ! wind stress + if (fldchk(is_local%wrap%FBExp(compice), trim('Faii_taux'), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_taux'),rc=rc) & + ) then + call addmap_from(compatm, trim('Faxa_taux'), compice, mappatch, 'one', 'unset') + call addmrg_to(compice, trim('Faii_taux'), mrg_from=compatm, mrg_fld=trim('Faxa_taux'), mrg_type='copy') + end if + + if (fldchk(is_local%wrap%FBExp(compice), trim('Faii_tauy'), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_tauy'),rc=rc) & + ) then + call addmap_from(compatm, trim('Faxa_tauy'), compice, mappatch, 'one', 'unset') + call addmrg_to(compice, trim('Faii_tauy'), mrg_from=compatm, mrg_fld=trim('Faxa_tauy'), mrg_type='copy') + end if + ! precip if (fldchk(is_local%wrap%FBExp(compice), trim('Faxa_rain'), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_rainc'),rc=rc) .and. & From d98dbe2ea97e01787841a73473633a28bc4d759f Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Tue, 21 Apr 2026 10:52:52 +1000 Subject: [PATCH 57/66] rename fields with CMEPs prefixes --- mediator/esmFldsExchange_accessesm_mod.F90 | 40 +++++++++++----------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/mediator/esmFldsExchange_accessesm_mod.F90 b/mediator/esmFldsExchange_accessesm_mod.F90 index d3c197c59..08c26311f 100644 --- a/mediator/esmFldsExchange_accessesm_mod.F90 +++ b/mediator/esmFldsExchange_accessesm_mod.F90 @@ -163,7 +163,7 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- allocate(S_flds(2)) S_flds = (/'Sa_pslv', & - 'So_duu10n' /) + 'Sa_duu10n' /) do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addfld_from(compatm, trim(fldname)) @@ -179,15 +179,15 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) allocate(F_flds(11, 2)) F_flds(1,:) = (/'Faxa_taux ', 'Foxx_taux'/) F_flds(2,:) = (/'Faxa_tauy ', 'Foxx_tauy'/) - F_flds(3,:) = (/'Foxx_sen', 'Foxx_sen'/) - F_flds(4,:) = (/'Foxx_evap', 'Foxx_evap'/) - F_flds(5,:) = (/'Foxx_lwnet', 'Foxx_lwnet'/) - F_flds(6,:) = (/'Foxx_swnet_vdr', 'Foxx_swnet_vdr'/) - F_flds(7,:) = (/'Foxx_swnet_vdf', 'Foxx_swnet_vdf'/) - F_flds(8,:) = (/'Foxx_swnet_idr', 'Foxx_swnet_idr'/) - F_flds(9,:) = (/'Foxx_swnet_idf', 'Foxx_swnet_idf'/) - F_flds(10,:) = (/'Foxx_rofl', 'Foxx_rofl'/) ! mean runoff rate (liquid) - F_flds(11,:) = (/'Foxx_rofi', 'Foxx_rofi'/) ! mean runnof rate (frozen) + F_flds(3,:) = (/'Faoa_sen', 'Foxx_sen'/) + F_flds(4,:) = (/'Faoa_evap', 'Foxx_evap'/) + F_flds(5,:) = (/'Faoa_lwnet', 'Foxx_lwnet'/) + F_flds(6,:) = (/'Faoa_swnet_vdr', 'Foxx_swnet_vdr'/) + F_flds(7,:) = (/'Faoa_swnet_vdf', 'Foxx_swnet_vdf'/) + F_flds(8,:) = (/'Faoa_swnet_idr', 'Foxx_swnet_idr'/) + F_flds(9,:) = (/'Faoa_swnet_idf', 'Foxx_swnet_idf'/) + F_flds(10,:) = (/'Faoa_rofl', 'Foxx_rofl'/) ! mean runoff rate (liquid) + F_flds(11,:) = (/'Faoa_rofi', 'Foxx_rofi'/) ! mean runnof rate (frozen) do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) @@ -366,7 +366,7 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) ! --------------------------------------------------------------------- allocate(S_flds(2)) S_flds = (/'Sa_pslv', & ! inst_zonal_wind_height10m - 'So_duu10n' /) ! inst_temp_height_surface + 'Sa_duu10n' /) ! inst_temp_height_surface do n = 1,size(S_flds) fldname = trim(S_flds(n)) if (fldchk(is_local%wrap%FBExp(compocn), trim(fldname), rc=rc) .and. & @@ -386,15 +386,15 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) ! from atm allocate(F_flds(9, 2)) - F_flds(1,:) = (/'Foxx_sen', 'Foxx_sen'/) - F_flds(2,:) = (/'Foxx_evap', 'Foxx_evap'/) - F_flds(3,:) = (/'Foxx_lwnet', 'Foxx_lwnet'/) - F_flds(4,:) = (/'Foxx_swnet_vdr', 'Foxx_swnet_vdr'/) - F_flds(5,:) = (/'Foxx_swnet_vdf', 'Foxx_swnet_vdf'/) - F_flds(6,:) = (/'Foxx_swnet_idr', 'Foxx_swnet_idr'/) - F_flds(7,:) = (/'Foxx_swnet_idf', 'Foxx_swnet_idf'/) - F_flds(8,:) = (/'Foxx_rofl', 'Foxx_rofl'/) ! mean runoff rate (liquid) - F_flds(9,:) = (/'Foxx_rofi', 'Foxx_rofi'/) ! mean runnof rate (frozen) + F_flds(1,:) = (/'Faoa_sen', 'Foxx_sen'/) + F_flds(2,:) = (/'Faoa_evap', 'Foxx_evap'/) + F_flds(3,:) = (/'Faoa_lwnet', 'Foxx_lwnet'/) + F_flds(4,:) = (/'Faoa_swnet_vdr', 'Foxx_swnet_vdr'/) + F_flds(5,:) = (/'Faoa_swnet_vdf', 'Foxx_swnet_vdf'/) + F_flds(6,:) = (/'Faoa_swnet_idr', 'Foxx_swnet_idr'/) + F_flds(7,:) = (/'Faoa_swnet_idf', 'Foxx_swnet_idf'/) + F_flds(8,:) = (/'Faoa_rofl', 'Foxx_rofl'/) ! mean runoff rate (liquid) + F_flds(9,:) = (/'Faoa_rofi', 'Foxx_rofi'/) ! mean runnof rate (frozen) do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) From 769738b2675a2045373c611d5b71a5b2d61fa5e7 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Wed, 22 Apr 2026 11:01:42 +1000 Subject: [PATCH 58/66] revert Sa_duu10n to So_duu10n --- mediator/esmFldsExchange_accessesm_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/mediator/esmFldsExchange_accessesm_mod.F90 b/mediator/esmFldsExchange_accessesm_mod.F90 index 08c26311f..fb841031b 100644 --- a/mediator/esmFldsExchange_accessesm_mod.F90 +++ b/mediator/esmFldsExchange_accessesm_mod.F90 @@ -163,7 +163,7 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- allocate(S_flds(2)) S_flds = (/'Sa_pslv', & - 'Sa_duu10n' /) + 'So_duu10n' /) do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addfld_from(compatm, trim(fldname)) @@ -365,8 +365,8 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) ! to ocn: state fields ! --------------------------------------------------------------------- allocate(S_flds(2)) - S_flds = (/'Sa_pslv', & ! inst_zonal_wind_height10m - 'Sa_duu10n' /) ! inst_temp_height_surface + S_flds = (/'Sa_pslv', & + 'So_duu10n' /) do n = 1,size(S_flds) fldname = trim(S_flds(n)) if (fldchk(is_local%wrap%FBExp(compocn), trim(fldname), rc=rc) .and. & From 1944cd732b3a1197c002112471aee4fe209689fd Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 4 May 2026 15:49:08 +1000 Subject: [PATCH 59/66] update comments, and ocn->atm mapping of SST and ocn currents --- mediator/esmFldsExchange_accessesm_mod.F90 | 61 +++++++++++++--------- 1 file changed, 37 insertions(+), 24 deletions(-) diff --git a/mediator/esmFldsExchange_accessesm_mod.F90 b/mediator/esmFldsExchange_accessesm_mod.F90 index fb841031b..7fabc932f 100644 --- a/mediator/esmFldsExchange_accessesm_mod.F90 +++ b/mediator/esmFldsExchange_accessesm_mod.F90 @@ -159,7 +159,7 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) !===================================================================== ! --------------------------------------------------------------------- - ! to ocn: state fields + ! to ocn: state fields from atm ! --------------------------------------------------------------------- allocate(S_flds(2)) S_flds = (/'Sa_pslv', & @@ -172,10 +172,9 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) deallocate(S_flds) ! --------------------------------------------------------------------- - ! to ocn: flux fields + ! to ocn: flux fields from atm ! --------------------------------------------------------------------- - ! from atm allocate(F_flds(11, 2)) F_flds(1,:) = (/'Faxa_taux ', 'Foxx_taux'/) F_flds(2,:) = (/'Faxa_tauy ', 'Foxx_tauy'/) @@ -198,7 +197,10 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) deallocate(F_flds) - ! from ice + ! --------------------------------------------------------------------- + ! to ocn: fields from ice + ! --------------------------------------------------------------------- + allocate(F_flds(6, 2)) F_flds(1,:) = (/'Fioi_salt', 'Fioi_salt'/) ! salt flux sea-ice to ocean F_flds(2,:) = (/'Si_ifrac', 'Si_ifrac'/) ! ice_fraction @@ -219,10 +221,9 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) !===================================================================== ! --------------------------------------------------------------------- - ! to ice: state fields + ! to ice: fields from ocn ! --------------------------------------------------------------------- - ! from ocn allocate(S_flds(7)) S_flds = (/'So_dhdx', & 'So_dhdy', & @@ -239,7 +240,7 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) deallocate(S_flds) ! --------------------------------------------------------------------- - ! to ice: flux fields + ! to ice: fields from atm ! --------------------------------------------------------------------- allocate(F_flds(5, 2)) @@ -271,8 +272,12 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) call addfld_to(compice, 'Faxa_rain') call addfld_to(compice, 'Faxa_snow') - call addfld_to(compice, 'Faii_taux') - call addfld_to(compice, 'Faii_tauy') + ! --------------------------------------------------------------------- + ! atm/ice wind stress + ! --------------------------------------------------------------------- + + call addfld_to(compice, 'Faia_taux') + call addfld_to(compice, 'Faia_tauy') call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -322,14 +327,22 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) ! FIELDS TO ATMOSPHERE !===================================================================== - allocate(S_flds(3)) - S_flds = (/'So_t', 'So_u', 'So_v'/) + fldname = trim('So_t') + if (fldchk(is_local%wrap%FBExp(compatm), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn, compocn), trim(fldname), rc=rc) & + ) then + call addmap_from(compocn, trim(fldname), compatm, mapbilnr, 'one', 'unset') + call addmrg_to(compatm, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + end if + + allocate(S_flds(2)) + S_flds = (/'So_u', 'So_v'/) do n = 1,size(S_flds) fldname = trim(S_flds(n)) if (fldchk(is_local%wrap%FBExp(compatm), trim(fldname), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn, compocn), trim(fldname), rc=rc) & ) then - call addmap_from(compocn, trim(fldname), compatm, mapconsf, 'ofrac', 'unset') + call addmap_from(compocn, trim(fldname), compatm, mappatch, 'one', 'unset') call addmrg_to(compatm, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') end if end do @@ -381,10 +394,9 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) deallocate(S_flds) ! --------------------------------------------------------------------- - ! to ocn: flux fields + ! to ocn: flux fields from atm ! --------------------------------------------------------------------- - ! from atm allocate(F_flds(9, 2)) F_flds(1,:) = (/'Faoa_sen', 'Foxx_sen'/) F_flds(2,:) = (/'Faoa_evap', 'Foxx_evap'/) @@ -428,8 +440,11 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) call addmrg_to(compocn, 'Faxa_snow' , mrg_from=compatm, mrg_fld='Faxa_snowc:Faxa_snowl', & mrg_type='sum_with_weights', mrg_fracname='ofrac') end if - - ! from ice + + ! --------------------------------------------------------------------- + ! to ocn: fields from ice + ! --------------------------------------------------------------------- + allocate(F_flds(4, 2)) F_flds(1,:) = (/'Fioi_salt', 'Fioi_salt'/) F_flds(2,:) = (/'Fioi_meltw', 'Fioi_meltw'/) @@ -481,10 +496,9 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) !===================================================================== ! --------------------------------------------------------------------- - ! to ice: state fields + ! to ice: fields from ocn ! --------------------------------------------------------------------- - ! from ocn allocate(S_flds(7)) S_flds = (/'So_dhdx', & ! inst_zonal_wind_height10m 'So_dhdy', & ! inst_merid_wind_height10m @@ -507,10 +521,9 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) deallocate(S_flds) ! --------------------------------------------------------------------- - ! to ice: flux fields + ! to ice: fields from atm ! --------------------------------------------------------------------- - ! from atm allocate(F_flds(5, 2)) F_flds(1,:) = (/'Faxa_swpen_n', 'Faxa_swpen_n'/) F_flds(2,:) = (/'Faxa_melthtop_n', 'Faxa_melthtop_n'/) @@ -533,18 +546,18 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) deallocate(F_flds) ! wind stress - if (fldchk(is_local%wrap%FBExp(compice), trim('Faii_taux'), rc=rc) .and. & + if (fldchk(is_local%wrap%FBExp(compice), trim('Faia_taux'), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_taux'),rc=rc) & ) then call addmap_from(compatm, trim('Faxa_taux'), compice, mappatch, 'one', 'unset') - call addmrg_to(compice, trim('Faii_taux'), mrg_from=compatm, mrg_fld=trim('Faxa_taux'), mrg_type='copy') + call addmrg_to(compice, trim('Faia_taux'), mrg_from=compatm, mrg_fld=trim('Faxa_taux'), mrg_type='copy') end if - if (fldchk(is_local%wrap%FBExp(compice), trim('Faii_tauy'), rc=rc) .and. & + if (fldchk(is_local%wrap%FBExp(compice), trim('Faia_tauy'), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm, compatm), trim('Faxa_tauy'),rc=rc) & ) then call addmap_from(compatm, trim('Faxa_tauy'), compice, mappatch, 'one', 'unset') - call addmrg_to(compice, trim('Faii_tauy'), mrg_from=compatm, mrg_fld=trim('Faxa_tauy'), mrg_type='copy') + call addmrg_to(compice, trim('Faia_tauy'), mrg_from=compatm, mrg_fld=trim('Faxa_tauy'), mrg_type='copy') end if ! precip From 991cf2a32267d7886c0ca66902a9d721f106aeb1 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 4 May 2026 15:24:14 +1000 Subject: [PATCH 60/66] Update mediator/esmFldsExchange_accessesm_mod.F90 Co-authored-by: Spencer Wong <88933912+blimlim@users.noreply.github.com> --- mediator/esmFldsExchange_accessesm_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/esmFldsExchange_accessesm_mod.F90 b/mediator/esmFldsExchange_accessesm_mod.F90 index 7fabc932f..c0640d181 100644 --- a/mediator/esmFldsExchange_accessesm_mod.F90 +++ b/mediator/esmFldsExchange_accessesm_mod.F90 @@ -500,8 +500,8 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) ! --------------------------------------------------------------------- allocate(S_flds(7)) - S_flds = (/'So_dhdx', & ! inst_zonal_wind_height10m - 'So_dhdy', & ! inst_merid_wind_height10m + S_flds = (/'So_dhdx', & ! sea_surface_slope_zonal + 'So_dhdy', & ! sea_surface_slope_merid 'So_t ', & ! inst_temp_height2m 'So_s ', & ! inst_spec_humid_height2m 'So_u', & ! ocean surface zonal current From 0a044692afce74a218306b0c88afccc06c9161f4 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 4 May 2026 15:24:29 +1000 Subject: [PATCH 61/66] Update mediator/esmFldsExchange_accessesm_mod.F90 Co-authored-by: Spencer Wong <88933912+blimlim@users.noreply.github.com> --- mediator/esmFldsExchange_accessesm_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_accessesm_mod.F90 b/mediator/esmFldsExchange_accessesm_mod.F90 index c0640d181..b9ceb1422 100644 --- a/mediator/esmFldsExchange_accessesm_mod.F90 +++ b/mediator/esmFldsExchange_accessesm_mod.F90 @@ -503,7 +503,7 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) S_flds = (/'So_dhdx', & ! sea_surface_slope_zonal 'So_dhdy', & ! sea_surface_slope_merid 'So_t ', & ! inst_temp_height2m - 'So_s ', & ! inst_spec_humid_height2m + 'So_s ', & ! sea surface salinity 'So_u', & ! ocean surface zonal current 'So_v', & ! ocean surface meridional current 'Fioo_q' /) ! inst_temp_height_surface From 75bdb4916ff6bc41f175b85c1782428a64ab3bc5 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 4 May 2026 15:24:43 +1000 Subject: [PATCH 62/66] Update mediator/esmFldsExchange_accessesm_mod.F90 Co-authored-by: Spencer Wong <88933912+blimlim@users.noreply.github.com> --- mediator/esmFldsExchange_accessesm_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_accessesm_mod.F90 b/mediator/esmFldsExchange_accessesm_mod.F90 index b9ceb1422..ef3802cfd 100644 --- a/mediator/esmFldsExchange_accessesm_mod.F90 +++ b/mediator/esmFldsExchange_accessesm_mod.F90 @@ -502,7 +502,7 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) allocate(S_flds(7)) S_flds = (/'So_dhdx', & ! sea_surface_slope_zonal 'So_dhdy', & ! sea_surface_slope_merid - 'So_t ', & ! inst_temp_height2m + 'So_t ', & ! sea_surface_temperature 'So_s ', & ! sea surface salinity 'So_u', & ! ocean surface zonal current 'So_v', & ! ocean surface meridional current From 103ea3fa69af38a305df462697b633eb44246c1b Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 4 May 2026 15:25:28 +1000 Subject: [PATCH 63/66] Update mediator/esmFldsExchange_accessesm_mod.F90 Co-authored-by: Spencer Wong <88933912+blimlim@users.noreply.github.com> --- mediator/esmFldsExchange_accessesm_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_accessesm_mod.F90 b/mediator/esmFldsExchange_accessesm_mod.F90 index ef3802cfd..9f8548331 100644 --- a/mediator/esmFldsExchange_accessesm_mod.F90 +++ b/mediator/esmFldsExchange_accessesm_mod.F90 @@ -506,7 +506,7 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) 'So_s ', & ! sea surface salinity 'So_u', & ! ocean surface zonal current 'So_v', & ! ocean surface meridional current - 'Fioo_q' /) ! inst_temp_height_surface + 'Fioo_q' /) ! Freezing/melting potential do n = 1,size(S_flds) fldname = trim(S_flds(n)) if (fldchk(is_local%wrap%FBExp(compice),trim(fldname),rc=rc) .and. & From cadadfb7dcce1d4b7d6790c78d532eb0e5758310 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Mon, 4 May 2026 15:52:54 +1000 Subject: [PATCH 64/66] comment on mapping methods --- mediator/esmFldsExchange_accessesm_mod.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/mediator/esmFldsExchange_accessesm_mod.F90 b/mediator/esmFldsExchange_accessesm_mod.F90 index 9f8548331..1bdb80682 100644 --- a/mediator/esmFldsExchange_accessesm_mod.F90 +++ b/mediator/esmFldsExchange_accessesm_mod.F90 @@ -16,6 +16,10 @@ module esmFldsExchange_accessesm_mod ! This is a mediator specific routine that determines ALL possible ! fields exchanged between components and their associated routing, ! mapping and merging + + ! In general, first order conservative remapping is used for flux fields + ! and bilinear remapping is used for flux fields. Wind stress is a special case + ! where a higher order patch mapping is used. !--------------------------------------------------------------------- implicit none From 81d165b0f7cc86f55bcc5688ba5362660f2fab66 Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Tue, 5 May 2026 10:20:28 +1000 Subject: [PATCH 65/66] comment on mapping methods --- mediator/esmFldsExchange_accessesm_mod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/mediator/esmFldsExchange_accessesm_mod.F90 b/mediator/esmFldsExchange_accessesm_mod.F90 index 1bdb80682..607d435c3 100644 --- a/mediator/esmFldsExchange_accessesm_mod.F90 +++ b/mediator/esmFldsExchange_accessesm_mod.F90 @@ -18,8 +18,9 @@ module esmFldsExchange_accessesm_mod ! mapping and merging ! In general, first order conservative remapping is used for flux fields - ! and bilinear remapping is used for flux fields. Wind stress is a special case - ! where a higher order patch mapping is used. + ! while bilinear remapping is applied to state fields. + ! Velocity and stress fields are remapped using a higher order patch method. + ! Some sea-ice related fields are conservatively remapped with weighting by ice fraction. !--------------------------------------------------------------------- implicit none From 5a222d0aae447d89f3d4a18aefb8280a1c099a4a Mon Sep 17 00:00:00 2001 From: Kieran Ricardo Date: Tue, 5 May 2026 12:13:04 +1000 Subject: [PATCH 66/66] specify character length in array constructor --- mediator/esmFldsExchange_accessesm_mod.F90 | 108 ++++++++++----------- 1 file changed, 54 insertions(+), 54 deletions(-) diff --git a/mediator/esmFldsExchange_accessesm_mod.F90 b/mediator/esmFldsExchange_accessesm_mod.F90 index 607d435c3..d97b95301 100644 --- a/mediator/esmFldsExchange_accessesm_mod.F90 +++ b/mediator/esmFldsExchange_accessesm_mod.F90 @@ -130,7 +130,7 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) ! to atm: from ocn ! --------------------------------------------------------------------- allocate(S_flds(3)) - S_flds = (/'So_t', 'So_u', 'So_v'/) + S_flds = [character(len=CS) :: 'So_t', 'So_u', 'So_v'] do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addfld_from(compocn, trim(fldname)) @@ -142,7 +142,7 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) ! to atm: from ice ! --------------------------------------------------------------------- allocate(S_flds(9)) - S_flds = (/'Si_t', & + S_flds = [character(len=CS) :: 'Si_t', & 'Si_ifrac_n', & 'Si_vsno_n', & 'Si_vice_n', & @@ -151,7 +151,7 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) 'Si_pndf_n', & 'Si_pndt_n', & 'Si_Tf' & - /) + ] do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addfld_from(compice, trim(fldname)) @@ -167,8 +167,8 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) ! to ocn: state fields from atm ! --------------------------------------------------------------------- allocate(S_flds(2)) - S_flds = (/'Sa_pslv', & - 'So_duu10n' /) + S_flds = [character(len=CS) :: 'Sa_pslv', & + 'So_duu10n' ] do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addfld_from(compatm, trim(fldname)) @@ -181,17 +181,17 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- allocate(F_flds(11, 2)) - F_flds(1,:) = (/'Faxa_taux ', 'Foxx_taux'/) - F_flds(2,:) = (/'Faxa_tauy ', 'Foxx_tauy'/) - F_flds(3,:) = (/'Faoa_sen', 'Foxx_sen'/) - F_flds(4,:) = (/'Faoa_evap', 'Foxx_evap'/) - F_flds(5,:) = (/'Faoa_lwnet', 'Foxx_lwnet'/) - F_flds(6,:) = (/'Faoa_swnet_vdr', 'Foxx_swnet_vdr'/) - F_flds(7,:) = (/'Faoa_swnet_vdf', 'Foxx_swnet_vdf'/) - F_flds(8,:) = (/'Faoa_swnet_idr', 'Foxx_swnet_idr'/) - F_flds(9,:) = (/'Faoa_swnet_idf', 'Foxx_swnet_idf'/) - F_flds(10,:) = (/'Faoa_rofl', 'Foxx_rofl'/) ! mean runoff rate (liquid) - F_flds(11,:) = (/'Faoa_rofi', 'Foxx_rofi'/) ! mean runnof rate (frozen) + F_flds(1,:) = [character(len=CS) :: 'Faxa_taux ', 'Foxx_taux'] + F_flds(2,:) = [character(len=CS) :: 'Faxa_tauy ', 'Foxx_tauy'] + F_flds(3,:) = [character(len=CS) :: 'Faoa_sen', 'Foxx_sen'] + F_flds(4,:) = [character(len=CS) :: 'Faoa_evap', 'Foxx_evap'] + F_flds(5,:) = [character(len=CS) :: 'Faoa_lwnet', 'Foxx_lwnet'] + F_flds(6,:) = [character(len=CS) :: 'Faoa_swnet_vdr', 'Foxx_swnet_vdr'] + F_flds(7,:) = [character(len=CS) :: 'Faoa_swnet_vdf', 'Foxx_swnet_vdf'] + F_flds(8,:) = [character(len=CS) :: 'Faoa_swnet_idr', 'Foxx_swnet_idr'] + F_flds(9,:) = [character(len=CS) :: 'Faoa_swnet_idf', 'Foxx_swnet_idf'] + F_flds(10,:) = [character(len=CS) :: 'Faoa_rofl', 'Foxx_rofl'] ! mean runoff rate (liquid) + F_flds(11,:) = [character(len=CS) :: 'Faoa_rofi', 'Foxx_rofi'] ! mean runnof rate (frozen) do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) @@ -207,12 +207,12 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- allocate(F_flds(6, 2)) - F_flds(1,:) = (/'Fioi_salt', 'Fioi_salt'/) ! salt flux sea-ice to ocean - F_flds(2,:) = (/'Si_ifrac', 'Si_ifrac'/) ! ice_fraction - F_flds(3,:) = (/'Fioi_meltw', 'Fioi_meltw'/) ! freshwater flux sea-ice to ocean - F_flds(4,:) = (/'Fioi_melth', 'Fioi_melth'/) ! heat flux sea-ice to ocean - F_flds(5,:) = (/'Fioi_taux', 'Foxx_taux'/) - F_flds(6,:) = (/'Fioi_tauy', 'Foxx_tauy'/) ! surface stress sea-ice to ocean + F_flds(1,:) = [character(len=CS) :: 'Fioi_salt', 'Fioi_salt'] ! salt flux sea-ice to ocean + F_flds(2,:) = [character(len=CS) :: 'Si_ifrac', 'Si_ifrac'] ! ice_fraction + F_flds(3,:) = [character(len=CS) :: 'Fioi_meltw', 'Fioi_meltw'] ! freshwater flux sea-ice to ocean + F_flds(4,:) = [character(len=CS) :: 'Fioi_melth', 'Fioi_melth'] ! heat flux sea-ice to ocean + F_flds(5,:) = [character(len=CS) :: 'Fioi_taux', 'Foxx_taux'] + F_flds(6,:) = [character(len=CS) :: 'Fioi_tauy', 'Foxx_tauy'] ! surface stress sea-ice to ocean do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) fldname2 = trim(F_flds(n,2)) @@ -230,13 +230,13 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- allocate(S_flds(7)) - S_flds = (/'So_dhdx', & + S_flds = [character(len=CS) :: 'So_dhdx', & 'So_dhdy', & 'So_t', & 'So_s', & 'So_u', & 'So_v', & - 'Fioo_q' /) + 'Fioo_q' ] do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addfld_from(compocn, trim(fldname)) @@ -249,11 +249,11 @@ subroutine esmFldsExchange_accessesm_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- allocate(F_flds(5, 2)) - F_flds(1,:) = (/'Faxa_swpen_n', 'Faxa_swpen_n'/) - F_flds(2,:) = (/'Faxa_melthtop_n', 'Faxa_melthtop_n'/) - F_flds(3,:) = (/'Faxa_condtop_n', 'Faxa_condtop_n'/) - F_flds(4,:) = (/'Sa_tskn_n', 'Sa_tskn_n'/) - F_flds(5,:) = (/'Faxa_sublim_n', 'Faxa_sublim_n'/) + F_flds(1,:) = [character(len=CS) :: 'Faxa_swpen_n', 'Faxa_swpen_n'] + F_flds(2,:) = [character(len=CS) :: 'Faxa_melthtop_n', 'Faxa_melthtop_n'] + F_flds(3,:) = [character(len=CS) :: 'Faxa_condtop_n', 'Faxa_condtop_n'] + F_flds(4,:) = [character(len=CS) :: 'Sa_tskn_n', 'Sa_tskn_n'] + F_flds(5,:) = [character(len=CS) :: 'Faxa_sublim_n', 'Faxa_sublim_n'] do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) fldname2 = trim(F_flds(n,2)) @@ -341,7 +341,7 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) end if allocate(S_flds(2)) - S_flds = (/'So_u', 'So_v'/) + S_flds = [character(len=CS) :: 'So_u', 'So_v'] do n = 1,size(S_flds) fldname = trim(S_flds(n)) if (fldchk(is_local%wrap%FBExp(compatm), trim(fldname), rc=rc) .and. & @@ -354,7 +354,7 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) deallocate(S_flds) allocate(S_flds(9)) - S_flds = (/'Si_t', & + S_flds = [character(len=CS) :: 'Si_t', & 'Si_ifrac_n', & 'Si_vsno_n', & 'Si_vice_n', & @@ -363,7 +363,7 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) 'Si_pndf_n', & 'Si_pndt_n', & 'Si_Tf' & - /) + ] do n = 1,size(S_flds) fldname = trim(S_flds(n)) if (fldchk(is_local%wrap%FBExp(compatm), trim(fldname), rc=rc) .and. & @@ -383,8 +383,8 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) ! to ocn: state fields ! --------------------------------------------------------------------- allocate(S_flds(2)) - S_flds = (/'Sa_pslv', & - 'So_duu10n' /) + S_flds = [character(len=CS) :: 'Sa_pslv', & + 'So_duu10n' ] do n = 1,size(S_flds) fldname = trim(S_flds(n)) if (fldchk(is_local%wrap%FBExp(compocn), trim(fldname), rc=rc) .and. & @@ -403,15 +403,15 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) ! --------------------------------------------------------------------- allocate(F_flds(9, 2)) - F_flds(1,:) = (/'Faoa_sen', 'Foxx_sen'/) - F_flds(2,:) = (/'Faoa_evap', 'Foxx_evap'/) - F_flds(3,:) = (/'Faoa_lwnet', 'Foxx_lwnet'/) - F_flds(4,:) = (/'Faoa_swnet_vdr', 'Foxx_swnet_vdr'/) - F_flds(5,:) = (/'Faoa_swnet_vdf', 'Foxx_swnet_vdf'/) - F_flds(6,:) = (/'Faoa_swnet_idr', 'Foxx_swnet_idr'/) - F_flds(7,:) = (/'Faoa_swnet_idf', 'Foxx_swnet_idf'/) - F_flds(8,:) = (/'Faoa_rofl', 'Foxx_rofl'/) ! mean runoff rate (liquid) - F_flds(9,:) = (/'Faoa_rofi', 'Foxx_rofi'/) ! mean runnof rate (frozen) + F_flds(1,:) = [character(len=CS) :: 'Faoa_sen', 'Foxx_sen'] + F_flds(2,:) = [character(len=CS) :: 'Faoa_evap', 'Foxx_evap'] + F_flds(3,:) = [character(len=CS) :: 'Faoa_lwnet', 'Foxx_lwnet'] + F_flds(4,:) = [character(len=CS) :: 'Faoa_swnet_vdr', 'Foxx_swnet_vdr'] + F_flds(5,:) = [character(len=CS) :: 'Faoa_swnet_vdf', 'Foxx_swnet_vdf'] + F_flds(6,:) = [character(len=CS) :: 'Faoa_swnet_idr', 'Foxx_swnet_idr'] + F_flds(7,:) = [character(len=CS) :: 'Faoa_swnet_idf', 'Foxx_swnet_idf'] + F_flds(8,:) = [character(len=CS) :: 'Faoa_rofl', 'Foxx_rofl'] ! mean runoff rate (liquid) + F_flds(9,:) = [character(len=CS) :: 'Faoa_rofi', 'Foxx_rofi'] ! mean runnof rate (frozen) do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) @@ -451,10 +451,10 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) ! --------------------------------------------------------------------- allocate(F_flds(4, 2)) - F_flds(1,:) = (/'Fioi_salt', 'Fioi_salt'/) - F_flds(2,:) = (/'Fioi_meltw', 'Fioi_meltw'/) - F_flds(3,:) = (/'Fioi_melth', 'Fioi_melth'/) - F_flds(4,:) = (/'Si_ifrac', 'Si_ifrac'/) + F_flds(1,:) = [character(len=CS) :: 'Fioi_salt', 'Fioi_salt'] + F_flds(2,:) = [character(len=CS) :: 'Fioi_meltw', 'Fioi_meltw'] + F_flds(3,:) = [character(len=CS) :: 'Fioi_melth', 'Fioi_melth'] + F_flds(4,:) = [character(len=CS) :: 'Si_ifrac', 'Si_ifrac'] do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) fldname2 = trim(F_flds(n,2)) @@ -505,13 +505,13 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) ! --------------------------------------------------------------------- allocate(S_flds(7)) - S_flds = (/'So_dhdx', & ! sea_surface_slope_zonal + S_flds = [character(len=CS) :: 'So_dhdx', & ! sea_surface_slope_zonal 'So_dhdy', & ! sea_surface_slope_merid 'So_t ', & ! sea_surface_temperature 'So_s ', & ! sea surface salinity 'So_u', & ! ocean surface zonal current 'So_v', & ! ocean surface meridional current - 'Fioo_q' /) ! Freezing/melting potential + 'Fioo_q' ] ! Freezing/melting potential do n = 1,size(S_flds) fldname = trim(S_flds(n)) if (fldchk(is_local%wrap%FBExp(compice),trim(fldname),rc=rc) .and. & @@ -530,11 +530,11 @@ subroutine esmFldsExchange_accessesm_init(gcomp, phase, rc) ! --------------------------------------------------------------------- allocate(F_flds(5, 2)) - F_flds(1,:) = (/'Faxa_swpen_n', 'Faxa_swpen_n'/) - F_flds(2,:) = (/'Faxa_melthtop_n', 'Faxa_melthtop_n'/) - F_flds(3,:) = (/'Faxa_condtop_n', 'Faxa_condtop_n'/) - F_flds(4,:) = (/'Sa_tskn_n', 'Sa_tskn_n'/) - F_flds(5,:) = (/'Faxa_sublim_n', 'Faxa_sublim_n'/) + F_flds(1,:) = [character(len=CS) :: 'Faxa_swpen_n', 'Faxa_swpen_n'] + F_flds(2,:) = [character(len=CS) :: 'Faxa_melthtop_n', 'Faxa_melthtop_n'] + F_flds(3,:) = [character(len=CS) :: 'Faxa_condtop_n', 'Faxa_condtop_n'] + F_flds(4,:) = [character(len=CS) :: 'Sa_tskn_n', 'Sa_tskn_n'] + F_flds(5,:) = [character(len=CS) :: 'Faxa_sublim_n', 'Faxa_sublim_n'] do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1))