From 646ad20b2fee10bf5543d39b86d4a0707b3d294b Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 3 Nov 2021 18:50:13 -0600 Subject: [PATCH 001/395] changes to drydep namelist definitions --- cime_config/namelist_definition_drv_flds.xml | 22 ++++++++------------ 1 file changed, 9 insertions(+), 13 deletions(-) diff --git a/cime_config/namelist_definition_drv_flds.xml b/cime_config/namelist_definition_drv_flds.xml index beceb238c..b8d96bcd6 100644 --- a/cime_config/namelist_definition_drv_flds.xml +++ b/cime_config/namelist_definition_drv_flds.xml @@ -62,27 +62,23 @@ - - char + + char(300) dry-deposition drydep_inparm - xactive_lnd,xactive_atm,table - Where dry deposition is calculated (from land, atmosphere, or from a table) - This specifies the method used to calculate dry - deposition velocities of gas-phase chemical species. The available methods are: - 'table' - prescribed method in CAM - 'xactive_atm' - interactive method in CAM - 'xactive_lnd' - interactive method in CLM + List of species that undergo dry deposition. - - char(300) - dry-deposition + + char + abs + drv_flds_in drydep_inparm - List of species that undergo dry deposition. + Full pathname of file containing gas phase deposition data including effective + Henry's law coefficients. From afd91d448aae738f49ed7483ceb3494f98634f02 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Wed, 24 Nov 2021 15:39:15 -0700 Subject: [PATCH 002/395] add new flux computation for UFS model and add new coupling mode for exchange grid implementation --- mediator/esmFldsExchange_nems_mod.F90 | 36 +- mediator/med.F90 | 2 +- mediator/med_fraction_mod.F90 | 8 +- mediator/med_phases_aofluxes_mod.F90 | 107 +++++- mediator/med_phases_prep_atm_mod.F90 | 8 +- mediator/med_phases_prep_ocn_mod.F90 | 8 +- ufs/flux_atmocn_ccpp_mod.F90 | 535 ++++++++++++++++++++++++++ 7 files changed, 677 insertions(+), 27 deletions(-) create mode 100644 ufs/flux_atmocn_ccpp_mod.F90 diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index f6d88ab46..1a05e2677 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -93,6 +93,29 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end do deallocate(flds) + ! unused fields needed by the atm/ocn flux computation + allocate(flds(13)) + flds = (/'So_tref ', 'So_qref ','So_u10 ', 'So_ustar ','So_ssq ', & + 'So_re ', 'So_duu10n','Faox_lwup', 'Faox_sen ','Faox_lat ', & + 'Faox_evap', 'Faox_taux','Faox_tauy'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + call addfld(fldListMed_aoflux%flds, trim(fldname)) + end do + deallocate(flds) + else if (trim(coupling_mode) == 'nems_frac_aoflux') then + ! to med: atm and ocn fields required for atm/ocn flux calculation + allocate(flds(11)) + flds = (/'Sa_u ', 'Sa_v ', 'Sa_z ', 'Sa_tbot ', 'Sa_pbot ', & + 'Sa_pslv ', 'Sa_shum ', 'Sa_ptem ', 'Sa_dens ', 'Sa_u10m ', & + 'Sa_v10m ', 'Faxa_lwdn'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'one', 'unset') + end do + deallocate(flds) + ! unused fields needed by the atm/ocn flux computation allocate(flds(13)) flds = (/'So_tref ', 'So_qref ','So_u10 ', 'So_ustar ','So_ssq ', & @@ -159,6 +182,17 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call addmap(fldListFr(compocn)%flds, 'So_t', compatm, maptype, 'ofrac', 'unset') call addmrg(fldListTo(compatm)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + ! to atm: surface fluxes from mediator aoflux calculation + if (trim(coupling_mode) == 'nems_frac_aoflux') then + allocate(flds(6)) + flds = (/'taux', 'tauy', 'lat', 'sen', 'lwup', 'evap' /) + do n = 1,size(flds) + call addfld(fldListTo(compatm)%flds, 'Faox_'//trim(flds(n))) + call addmap(fldListMed_aoflux%flds, 'Faox_'//trim(flds(n)), compatm, mapconsf, 'ofrac', 'unset') + end do + deallocate(flds) + end if + !===================================================================== ! FIELDS TO OCEAN (compocn) !===================================================================== @@ -211,7 +245,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end do deallocate(flds) - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then + if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac' .or. trim(coupling_mode) == 'nems_frac_aoflux') then ! to ocn: merge surface stress (custom merge calculation in med_phases_prep_ocn) allocate(flds(2)) flds = (/'taux', 'tauy'/) diff --git a/mediator/med.F90 b/mediator/med.F90 index 8e8c4fdf1..308af3023 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -787,7 +787,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) call esmFldsExchange_cesm(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac' & - .or. trim(coupling_mode) == 'nems_orig_data') then + .or. trim(coupling_mode) == 'nems_orig_data' .or. trim(coupling_mode) == 'nems_frac_aoflux') then call esmFldsExchange_nems(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode(1:4)) == 'hafs') then diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 7b7b7ca4d..a4d44353b 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -364,7 +364,9 @@ subroutine med_fraction_init(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Set 'aofrac' in FBfrac(compatm) - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then + if (trim(coupling_mode) == 'nems_orig' .or. & + trim(coupling_mode) == 'nems_frac' .or. & + trim(coupling_mode) == 'nems_frac_aoflux') then call fldbun_getdata1d(is_local%wrap%FBImp(compatm,compatm), 'Sa_ofrac', Sa_ofrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_getdata1d(is_local%wrap%FBFrac(compatm), 'aofrac', aofrac, rc) @@ -786,7 +788,9 @@ subroutine med_fraction_set(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Set 'aofrac' from FBImp(compatm) to FBfrac(compatm) - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then + if (trim(coupling_mode) == 'nems_orig' .or. & + trim(coupling_mode) == 'nems_frac' .or. & + trim(coupling_mode) == 'nems_frac_aoflux') then call fldbun_getdata1d(is_local%wrap%FBImp(compatm,compatm), 'Sa_ofrac', Sa_ofrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_getdata1d(is_local%wrap%FBFrac(compatm), 'aofrac', aofrac, rc) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index d8aa7acdd..cea0a7f81 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -11,12 +11,13 @@ module med_phases_aofluxes_mod ! map aoflux_out from xgrid to both atm and ocn grid ! -------------------------------------------------------------------------- - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : operator(/=) + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_CoordSys_Flag use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldIsCreated, ESMF_FieldDestroy - use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldRegridGetArea use ESMF , only : ESMF_FieldBundleCreate, ESMF_FieldBundleAdd use ESMF , only : ESMF_RouteHandle, ESMF_FieldRegrid, ESMF_FieldRegridStore - use ESMF , only : ESMF_REGRIDMETHOD_CONSERVE_2ND + use ESMF , only : ESMF_REGRIDMETHOD_CONSERVE_2ND, ESMF_COORDSYS_CART use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_REGION_TOTAL, ESMF_MESHLOC_ELEMENT, ESMF_MAXSTR use ESMF , only : ESMF_XGRIDSIDE_B, ESMF_XGRIDSIDE_A, ESMF_END_ABORT, ESMF_LOGERR_PASSTHRU use ESMF , only : ESMF_Mesh, ESMF_MeshGet, ESMF_XGrid, ESMF_XGridCreate, ESMF_TYPEKIND_R8 @@ -29,6 +30,10 @@ module med_phases_aofluxes_mod use med_utils_mod , only : chkerr => med_utils_chkerr use esmFlds , only : compatm, compocn, coupling_mode, mapconsd, mapconsf, mapfcopy use perf_mod , only : t_startf, t_stopf +#ifndef CESMCOUPLED + use ufs_const_mod , only : rearth => SHR_CONST_REARTH + use ufs_const_mod , only : pi => SHR_CONST_PI +#endif implicit none private @@ -94,18 +99,23 @@ module med_phases_aofluxes_mod real(R8) , pointer :: zbot (:) => null() ! atm level height real(R8) , pointer :: ubot (:) => null() ! atm velocity, zonal real(R8) , pointer :: vbot (:) => null() ! atm velocity, meridional + real(R8) , pointer :: usfc (:) => null() ! atm surface velocity, zonal + real(R8) , pointer :: vsfc (:) => null() ! atm surface velocity, meridional real(R8) , pointer :: thbot (:) => null() ! atm potential T real(R8) , pointer :: shum (:) => null() ! atm specific humidity real(R8) , pointer :: pbot (:) => null() ! atm bottom pressure + real(R8) , pointer :: psfc (:) => null() ! atm surface pressure real(R8) , pointer :: dens (:) => null() ! atm bottom density real(R8) , pointer :: tbot (:) => null() ! atm bottom surface T real(R8) , pointer :: shum_16O (:) => null() ! atm H2O tracer real(R8) , pointer :: shum_HDO (:) => null() ! atm HDO tracer real(R8) , pointer :: shum_18O (:) => null() ! atm H218O tracer - ! local size and computational mask: on aoflux grid + real(R8) , pointer :: lwdn (:) => null() ! atm downward longwave heat flux + ! local size and computational mask and area: on aoflux grid integer :: lsize ! local size integer , pointer :: mask (:) => null() ! integer ocn domain mask: 0 <=> inactive cell real(R8) , pointer :: rmask (:) => null() ! real ocn domain mask: 0 <=> inactive cell + real(R8) , pointer :: garea (:) => null() ! atm grid area end type aoflux_in_type type aoflux_out_type @@ -874,6 +884,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) #else use flux_atmocn_mod, only : flux_atmocn #endif +#ifdef UFS_AOFLUX + use flux_atmocn_ccpp_mod, only : flux_atmocn_ccpp +#endif ! Arguments type(ESMF_GridComp) :: gcomp @@ -882,14 +895,18 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) integer , intent(out) :: rc ! ! Local variables - type(InternalState) :: is_local - type(ESMF_Field) :: field_src - type(ESMF_Field) :: field_dst - integer :: n,i,nf ! indices - real(r8), pointer :: data_normdst(:) - real(r8), pointer :: data_dst(:) - integer :: maptype - character(*),parameter :: subName = '(med_aofluxes_update) ' + type(InternalState) :: is_local + type(ESMF_Field) :: field_src + type(ESMF_Field) :: field_dst + type(ESMF_Field) :: lfield + type(ESMF_Mesh) :: lmesh + type(ESMF_CoordSys_Flag) :: coordSys + integer :: n,i,nf ! indices + real(r8), pointer :: data_normdst(:) + real(r8), pointer :: data_dst(:) + integer :: maptype + real(r8) :: qmin = 1.0e-8_r8 + character(*),parameter :: subName = '(med_aofluxes_update) ' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1005,11 +1022,36 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) end do end if if (compute_atm_dens) then - do n = 1,aoflux_in%lsize - if (aoflux_in%mask(n) /= 0._r8) then - aoflux_in%dens(n) = aoflux_in%pbot(n)/(287.058_R8*(1._R8 + 0.608_R8*aoflux_in%shum(n))*aoflux_in%tbot(n)) - end if - end do + ! Add limiting factor to be consistent with UFS atmosphere-ocean flux calculation + if (trim(coupling_mode) == 'nems_frac_aoflux') then + do n = 1,aoflux_in%lsize + if (aoflux_in%mask(n) /= 0._r8) then + aoflux_in%shum(n) = max(aoflux_in%shum(n), qmin) + aoflux_in%dens(n) = aoflux_in%psfc(n)/(287.058_R8*(1._R8 + 0.608_R8*aoflux_in%shum(n))*aoflux_in%tbot(n)) + end if + end do + else + do n = 1,aoflux_in%lsize + if (aoflux_in%mask(n) /= 0._r8) then + aoflux_in%dens(n) = aoflux_in%pbot(n)/(287.058_R8*(1._R8 + 0.608_R8*aoflux_in%shum(n))*aoflux_in%tbot(n)) + end if + end do + end if + end if + ! Extract area information + if (trim(coupling_mode) == 'nems_frac_aoflux') then + call ESMF_FieldBundleGet(is_local%wrap%FBArea(compatm), 'area', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=aoflux_in%garea, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(lmesh, coordSys=coordSys, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (coordSys /= ESMF_COORDSYS_CART) then + ! Convert square radians to square meters + aoflux_in%garea(:) = aoflux_in%garea(:)*(rearth**2) + end if end if !---------------------------------- @@ -1017,7 +1059,6 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) !---------------------------------- #ifdef CESMCOUPLED - call flux_atmocn (logunit=logunit, & nMax=aoflux_in%lsize, & zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, qbot=aoflux_in%shum, & @@ -1033,7 +1074,18 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) missval=0.0_r8) #else - +#ifdef UFS_AOFLUX + if (trim(coupling_mode) == 'nems_frac_aoflux') then + call flux_atmocn_ccpp(& + nMax=aoflux_in%lsize, psfc=aoflux_in%psfc, & + pbot=aoflux_in%pbot, tbot=aoflux_in%tbot, qbot=aoflux_in%shum, lwdn=aoflux_in%lwdn, & + zbot=aoflux_in%zbot, garea=aoflux_in%garea, ubot=aoflux_in%ubot, usfc=aoflux_in%usfc, vbot=aoflux_in%vbot, & + vsfc=aoflux_in%vsfc, rbot=aoflux_in%dens, ts=aoflux_in%tocn, mask=aoflux_in%mask, & + sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evp=aoflux_out%evap, & + taux=aoflux_out%taux, tauy=aoflux_out%tauy, & + missval=0.0_r8) + else +#endif call flux_atmocn (logunit=logunit, & nMax=aoflux_in%lsize, mask=aoflux_in%mask, & zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, qbot=aoflux_in%shum, & @@ -1042,6 +1094,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evap=aoflux_out%evap, & taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & duu10n=aoflux_out%duu10n, missval=0.0_r8) +#ifdef UFS_AOFLUX + end if +#endif #endif @@ -1176,6 +1231,16 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (chkerr(rc,__LINE__,u_FILE_u)) return end if + ! extra fields for nems_frac_aoflux + if (trim(coupling_mode) == 'nems_frac_aoflux') then + call fldbun_getfldptr(fldbun_a, 'Sa_u10m', aoflux_in%usfc, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun_a, 'Sa_v10m', aoflux_in%vsfc, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun_a, 'Faxa_lwdn', aoflux_in%lwdn, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + ! bottom level potential temperature will need to be computed if not received from the atm if (compute_atm_thbot) then allocate(aoflux_in%thbot(lsize)) @@ -1196,6 +1261,10 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (compute_atm_dens .or. compute_atm_thbot) then call fldbun_getfldptr(fldbun_a, 'Sa_pbot', aoflux_in%pbot, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (trim(coupling_mode) == 'nems_frac_aoflux') then + call fldbun_getfldptr(fldbun_a, 'Sa_pslv', aoflux_in%psfc, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end if if (flds_wiso) then diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 76c8b1e83..7c0beada8 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -107,7 +107,9 @@ subroutine med_phases_prep_atm(gcomp, rc) !--------------------------------------- !--- map atm/ocn fluxes from ocn to atm grid if appropriate !--------------------------------------- - if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'hafs') then + if (trim(coupling_mode) == 'cesm' .or. & + trim(coupling_mode) == 'hafs' .or. & + trim(coupling_mode) == 'nems_frac_aoflux') then if (is_local%wrap%aoflux_grid == 'ogrid') then call med_map_field_packed( & FBSrc=is_local%wrap%FBMed_aoflux_o, & @@ -137,7 +139,9 @@ subroutine med_phases_prep_atm(gcomp, rc) FBMed1=is_local%wrap%FBMed_ocnalb_a, & FBMed2=is_local%wrap%FBMed_aoflux_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode) == 'nems_frac' .or. trim(coupling_mode) == 'nems_orig') then + else if (trim(coupling_mode) == 'nems_frac' .or. & + trim(coupling_mode) == 'nems_orig' .or. & + trim(coupling_mode) == 'nems_frac_aoflux') then call med_merge_auto(& is_local%wrap%med_coupling_active(:,compatm), & is_local%wrap%FBExp(compatm), & diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index ffa029b37..21890d40e 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -116,7 +116,9 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) fldListTo(compocn), & FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode) == 'nems_frac' .or. trim(coupling_mode) == 'nems_orig') then + else if (trim(coupling_mode) == 'nems_frac' .or. & + trim(coupling_mode) == 'nems_orig' .or. & + trim(coupling_mode) == 'nems_frac_aoflux') then call med_merge_auto(& is_local%wrap%med_coupling_active(:,compocn), & is_local%wrap%FBExp(compocn), & @@ -569,7 +571,9 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) lsize = size(ofrac) allocate(customwgt(lsize)) - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then + if (trim(coupling_mode) == 'nems_orig' .or. & + trim(coupling_mode) == 'nems_frac' .or. & + trim(coupling_mode) == 'nems_frac_aoflux') then customwgt(:) = -ofrac(:) / const_lhvap call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_evap', & FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_lat' , wgtA=customwgt, rc=rc) diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 new file mode 100644 index 000000000..10c677c71 --- /dev/null +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -0,0 +1,535 @@ +module flux_atmocn_ccpp_mod + + use machine , only: kp => kind_phys + use funcphys , only: gpvs, fpvs, fpvsx + use physcons , only: eps => con_eps + use physcons , only: epsm1 => con_epsm1 + use physcons , only: grav => con_g + use physcons , only: rvrdm1 => con_fvirt + use physcons , only: cappa => con_rocp + use physcons , only: hvap => con_hvap + use physcons , only: cp => con_cp + use physcons , only: rd => con_rd + use physcons , only: rv => con_rv + use physcons , only: hfus => con_hfus + use physcons , only: p0 => con_p0 + use physcons , only: tice => con_tice + use physcons , only: sbc => con_sbc + use sfc_diff , only: sfc_diff_run + use sfc_ocean, only: sfc_ocean_run + use GFS_surface_composites_pre , only: GFS_surface_composites_pre_run + use GFS_surface_composites_post , only: GFS_surface_composites_post_run + use GFS_surface_loop_control_part1, only: GFS_surface_loop_control_part1_run + use GFS_surface_loop_control_part2, only: GFS_surface_loop_control_part2_run + use ufs_kind_mod + use ufs_const_mod + + implicit none + + private ! default private + + public :: flux_atmOcn_ccpp ! computes atm/ocn fluxes + + !--- rename kinds for local readability only --- + integer,parameter :: r8 = SHR_KIND_R8 ! 8 byte real + + !--- variables that need to carried through the iterations --- + real(kp), allocatable, dimension(:) :: z0rl , z0rl_wav , & + z0rl_wat , z0rl_lnd , z0rl_ice , & + ustar , fm , fh , & + fm10 , hflx , evap + +!=============================================================================== +contains +!=============================================================================== + + subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & + garea, ubot, usfc, vbot, vsfc, rbot, ts, lwdn, sen, lat, & + lwup, evp, taux, tauy, missval) + + implicit none + + !--- input arguments -------------------------------- + integer , intent(in) :: nMax ! data vector length + integer , intent(in) :: mask (nMax) ! ocn domain mask + real(r8), intent(in) :: psfc(nMax) ! atm P (surface) (Pa) + real(r8), intent(in) :: pbot(nMax) ! atm P (bottom) (Pa) + real(r8), intent(in) :: tbot(nMax) ! atm T (bottom) (K) + real(r8), intent(in) :: qbot(nMax) ! atm specific humidity (bottom) (kg/kg) + real(r8), intent(in) :: zbot(nMax) ! atm level height (m) + real(r8), intent(in) :: garea(nMax) ! grid area (m^2) + real(r8), intent(in) :: ubot(nMax) ! atm u wind (bottom) (m/s) + real(r8), intent(in) :: usfc(nMax) ! atm u wind (surface) (m/s) + real(r8), intent(in) :: vbot(nMax) ! atm v wind (bottom) (m/s) + real(r8), intent(in) :: vsfc(nMax) ! atm v wind (surface) (m/s) + real(r8), intent(in) :: rbot(nMax) ! atm density (kg/m^3) + real(r8), intent(in) :: lwdn(nMax) ! atm lw downward (W/m^2) + real(r8), intent(in) :: ts(nMax) ! ocn surface temperature (K) + real(r8), intent(in), optional :: missval ! masked value + + !--- output arguments ------------------------------- + real(r8), intent(out) :: sen(nMax) ! heat flux: sensible (W/m^2) + real(r8), intent(out) :: lat(nMax) ! heat flux: latent (W/m^2) + real(r8), intent(out) :: lwup(nMax) ! heat flux: lw upward (W/m^2) + real(r8), intent(out) :: evp(nMax) ! heat flux: evap ((kg/s)/m^2) + real(r8), intent(out) :: taux(nMax) ! surface stress, zonal (N) + real(r8), intent(out) :: tauy(nMax) ! surface stress, maridional (N) + + !--- local variables -------------------------------- + integer :: n , iter , ivegsrc , & + sfc_z0_type , errflg , nstf_name1, & + lkm , nthreads , kice , & + km , lsm , lsm_noahmp, & + lsm_ruc + real(kp) :: spval , cpinv , hvapi , & + elocp , rch , tem , & + min_lakeice , min_seaice, tgice , & + h0facu , h0facs + logical :: redrag , thsfc_loc , lseaspray , & + flag_restart, frac_grid , cplflx , & + cplice , cplwav2atm, lheatstrg + character(len=1024) :: errmsg + integer, dimension(nMax) :: vegtype , islmsk , islmsk_cice + real(kp), dimension(nMax) :: prsl1 , prslki , prsik1 , & + prslk1 , wind , sigmaf , & + shdmax , z0pert , ztpert , & + tsurf_wat , tsurf_lnd , tsurf_ice , & + zvfun , cm , cm_wat , & + cm_lnd , cm_ice , ch , & + ch_wat , ch_lnd , ch_ice , & + rb , rb_wat , rb_lnd , & + rb_ice , stress , & + stress_wat , stress_lnd, stress_ice, & + ztmax_wat , ztmax_lnd , ztmax_ice , & + landfrac , lakefrac , lakedepth , & + oceanfrac , frland , hice , & + cice , snowd , snowd_lnd , & + snowd_ice , tprcp , tprcp_wat , & + tprcp_lnd , tprcp_ice , weasd , & + weasd_lnd , weasd_ice , hflxq , & + tsfco , tsfcl , tisfc , & + slmsk , hffac , vfrac , & + qss , & + qss_wat , qss_lnd , qss_ice , & + tskin , & + tskin_wat , tskin_lnd , tskin_ice , & + ustar_wat , ustar_lnd , ustar_ice , & + fm_wat , fm_lnd , fm_ice , & + fh_wat , fh_lnd , fh_ice , & + fm10_wat , fm10_lnd , fm10_ice , & + fh2 , & + fh2_wat , fh2_lnd , fh2_ice , & + cmm , & + cmm_wat , cmm_lnd , cmm_ice , & + chh , & + chh_wat , chh_lnd , chh_ice , & + gflx , & + gflx_wat , gflx_lnd , gflx_ice , & + ep1d , & + ep1d_wat , ep1d_lnd , ep1d_ice , & + evap_wat , evap_lnd , evap_ice , & + hflx_wat , hflx_lnd , hflx_ice , & + tsfc , & + tsfc_wat , tsfc_lnd , tsfc_ice , & + semis_rad , emis_lnd , emis_ice , & + semis_wat , semis_lnd , semis_ice + real(kp), dimension(nMax,1) :: tiice , stc + logical, dimension(nMax) :: flag_iter , flag_guess, use_flake , & + wet , dry , icy , & + flag_cice , lake + + !--- local variables that are carried out ----------- + logical, save :: flag_init = .true. + integer, save :: kdt = 0 + + !--- parameters ------------------------------------- + real(kp), parameter :: huge = 9.9692099683868690E36 + real(kp), parameter :: zero = 0.0_kp + real(kp), parameter :: clear_val = zero + + !--- missing value --- + if (present(missval)) then + spval = missval + else + spval = shr_const_spval + endif + + !--- addtional constants --- + cpinv = 1.0_kp/cp + hvapi = 1.0_kp/hvap + elocp = hvap/cp + + !--- compute some needed quantities --- + wind(:) = sqrt(ubot(:)**2+vbot(:)**2) + + !--- compute dimensionless exner function --- + prslk1(:) = (pbot(:)/p0)**cappa ! dimensionless_exner_function_at_surface_adjacent_layer + prsik1(:) = (psfc(:)/p0)**cappa ! surface_dimensionless_exner_function + prslki(:) = prsik1(:)/prslk1(:) ! ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + + !--- initialization of variables --- + kice = 1 ! vertical_dimension_of_sea_ice + km = 1 ! vertical_dimension_of_soil + tiice(:,:) = 0.0_kp ! temperature_in_ice_layer + lheatstrg = .true. ! flag_for_canopy_heat_storage_in_land_surface_scheme + h0facu = 0.25_kp ! multiplicative_tuning_parameter_for_reduced_surface_heat_fluxes_due_to_canopy_heat_storage + h0facs = 1.0 ! multiplicative_tuning_parameter_for_reduced_latent_heat_flux_due_to_canopy_heat_storage + hflxq(:) = 0.0_kp ! kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness_and_vegetation + hffac(:) = 0.0_kp ! surface_upward_sensible_heat_flux_reduction_factor + stc(:,:) = 0.0_kp ! soil_temperature + + flag_restart = .true. ! flag_for_restart, restart run + lkm = 0 ! control_for_lake_surface_scheme + frac_grid = .true. ! flag_for_fractional_landmask + flag_cice(:) = .true. ! flag_for_cice + cplflx = .true. ! flag_for_surface_flux_coupling + cplice = .true. ! flag_for_sea_ice_coupling + cplwav2atm = .false. ! flag_for_one_way_ocean_wave_coupling_to_atmosphere + where (mask(:) /= 0) + landfrac(:) = 0.0_kp ! land_area_fraction + elsewhere + landfrac(:) = 1.0_kp ! land_area_fraction + end where + lakefrac(:) = 0.0_kp ! lake_area_fraction + lakedepth(:) = 0.0_kp ! lake_depth + where (mask(:) /= 0) + oceanfrac(:) = 1.0_kp ! sea_area_fraction + elsewhere + oceanfrac(:) = 0.0_kp ! sea_area_fraction + end where + frland(:) = 0.0_kp ! land_area_fraction_for_microphysics + dry(:) = .false. ! flag_nonzero_land_surface_fraction, no land + icy(:) = .false. ! flag_nonzero_sea_ice_surface_fraction, no sea-ice + lake(:) = .false. ! flag_nonzero_lake_surface_fraction + use_flake(:) = .false. ! flag_for_using_flake + wet(:) = .false. ! flag_nonzero_wet_surface_fraction + hice(:) = 0.0_kp ! sea_ice_thickness + cice(:) = 0.0_kp ! sea_ice_area_fraction_of_sea_area_fraction + + if (flag_init) then + allocate(z0rl(nMax)) + z0rl(:) = 0.0_kp ! surface_roughness_length + allocate(z0rl_wat(nMax)) + z0rl_wat(:) = 0.0_kp ! surface_roughness_length_over_water + allocate(z0rl_lnd(nMax)) + z0rl_lnd(:) = 0.0_kp ! surface_roughness_length_over_land + allocate(z0rl_ice(nMax)) + z0rl_ice(:) = 0.0_kp ! surface_roughness_length_over_ice + allocate(z0rl_wav(nMax)) + z0rl_wav(:) = 0.0_kp ! surface_roughness_length_from_wave_model + end if + + snowd(:) = 0.0_kp ! lwe_surface_snow + snowd_lnd(:) = 0.0_kp ! surface_snow_thickness_water_equivalent_over_land + snowd_ice(:) = 0.0_kp ! surface_snow_thickness_water_equivalent_over_ice + tprcp(:) = 0.0_kp ! nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep + tprcp_wat(:) = 0.0_kp ! nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_water + tprcp_lnd(:) = 0.0_kp ! nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land + tprcp_ice(:) = 0.0_kp ! nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ice + + if (flag_init) then + allocate(ustar(nMax)) + ustar(:) = 0.0_kp ! surface_friction_velocity + end if + + ustar_wat(:) = 0.0_kp ! surface_friction_velocity_over_water + ustar_lnd(:) = 0.0_kp ! surface_friction_velocity_over_land + ustar_ice(:) = 0.0_kp ! surface_friction_velocity_over_ice + weasd(:) = 0.0_kp ! lwe_thickness_of_surface_snow_amount + weasd_lnd(:) = 0.0_kp ! water_equivalent_accumulated_snow_depth_over_land + weasd_ice(:) = 0.0_kp ! water_equivalent_accumulated_snow_depth_over_ice + tskin(:) = 0.0_kp ! surface_skin_temperature + tskin_wat(:) = 0.0_kp ! surface_skin_temperature_over_water + tskin_lnd(:) = 0.0_kp ! surface_skin_temperature_over_land + tskin_ice(:) = 0.0_kp ! surface_skin_temperature_over_ice + tsfc(:) = 0.0_kp ! surface_skin_temperature + tsfc_wat(:) = 0.0_kp ! surface_skin_temperature_over_water_interstitial + tsfc_lnd(:) = 0.0_kp ! surface_skin_temperature_over_land_interstitial + tsfc_ice(:) = 0.0_kp ! surface_skin_temperature_over_ice_interstitial + tsfco(:) = ts(:) ! sea_surface_temperature + tsurf_wat(:) = 0.0_kp ! surface_skin_temperature_after_iteration_over_water + tsurf_lnd(:) = 0.0_kp ! surface_skin_temperature_after_iteration_over_land + tsurf_ice(:) = 0.0_kp ! surface_skin_temperature_after_iteration_over_ice + tisfc(:) = 0.0_kp ! sea_ice_temperature + tgice = tice ! freezing_point_temperature_of_seawater + islmsk(:) = 0 ! sea_land_ice_mask, all sea + islmsk_cice(:) = 0 ! sea_land_ice_mask_cice, all sea + slmsk(:) = 0 ! area_type, all sea + qss(:) = qbot(:) ! surface_specific_humidity ? not the lowest level + qss_wat(:) = qss(:) ! surface_specific_humidity_over_water + qss_lnd(:) = 0.0_kp ! surface_specific_humidity_over_land + qss_ice(:) = 0.0_kp ! surface_specific_humidity_over_ice + min_lakeice = 0.15_kp ! min_lake_ice_area_fraction + min_seaice = 1.0e-11_kp ! min_sea_ice_area_fraction + kdt = kdt+1 ! index_of_timestep + + sigmaf(:) = 0.0_kp ! bounded_vegetation_area_fraction, no veg + vegtype(:) = 0 ! vegetation_type_classification + shdmax(:) = 0.0_kp ! max_vegetation_area_fraction + ivegsrc = 1 ! control_for_vegetation_dataset, IGBP + z0pert(:) = 0.0_kp ! perturbation_of_momentum_roughness_length + ztpert(:) = 0.0_kp ! perturbation_of_heat_to_momentum_roughness_length_ratio + flag_iter(:) = .true. ! flag_for_iteration + redrag = .true. ! flag_for_limited_surface_roughness_length_over_ocean, redrag in input.nml + sfc_z0_type = 0 ! flag_for_surface_roughness_option_over_water, no change + thsfc_loc = .true. ! flag_for_reference_pressure_theta + cm(:) = 0.0_kp ! surface_drag_coefficient_for_momentum + cm_wat(:) = 0.0_kp ! surface_drag_coefficient_for_momentum_in_air_over_water + cm_lnd(:) = 0.0_kp ! surface_drag_coefficient_for_momentum_in_air_over_land + cm_ice(:) = 0.0_kp ! surface_drag_coefficient_for_momentum_in_air_over_ice + ch(:) = 0.0_kp ! surface_drag_coefficient_for_heat_and_moisture + ch_wat(:) = 0.0_kp ! surface_drag_coefficient_for_heat_and_moisture_in_air_over_water + ch_lnd(:) = 0.0_kp ! surface_drag_coefficient_for_heat_and_moisture_in_air_over_land + ch_ice(:) = 0.0_kp ! surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice + rb(:) = 0.0_kp ! bulk_richardson_number_at_lowest_model_level + rb_wat(:) = 0.0_kp ! bulk_richardson_number_at_lowest_model_level_over_water + rb_lnd(:) = 0.0_kp ! bulk_richardson_number_at_lowest_model_level_over_land + rb_ice(:) = 0.0_kp ! bulk_richardson_number_at_lowest_model_level_over_ice + stress(:) = 0.0_kp ! surface_wind_stress + stress_wat(:) = 0.0_kp ! surface_wind_stress_over_water + stress_lnd(:) = 0.0_kp ! surface_wind_stress_over_land + stress_ice(:) = 0.0_kp ! surface_wind_stress_over_ice + + if (flag_init) then + allocate(fm(nMax)) + fm(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_momentum + end if + + fm_wat(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_momentum_over_water + fm_lnd(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_momentum_over_land + fm_ice(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_momentum_over_ice + + if (flag_init) then + allocate(fh(nMax)) + fh(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_heat + end if + + fh_wat(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_heat_over_water + fh_lnd(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_heat_over_land + fh_ice(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_heat_over_ice + + if (flag_init) then + allocate(fm10(nMax)) + fm10(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_momentum + end if + + fm10_wat(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_momentum_at_10m_over_water + fm10_lnd(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_momentum_at_10m_over_land + fm10_ice(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ice + fh2(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_heat + fh2_wat(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_heat_at_2m_over_water + fh2_lnd(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_heat_at_2m_over_land + fh2_ice(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_heat_at_2m_over_ice + ztmax_wat(:) = 0.0_kp ! bounded_surface_roughness_length_for_heat_over_water + ztmax_lnd(:) = 0.0_kp ! bounded_surface_roughness_length_for_heat_over_land + ztmax_ice(:) = 0.0_kp ! bounded_surface_roughness_length_for_heat_over_ice + zvfun(:) = 0.0_kp ! function_of_surface_roughness_length_and_green_vegetation_fraction + + lseaspray = .true. ! flag_for_sea_spray + cmm(:) = 0.0_kp ! surface_drag_wind_speed_for_momentum + cmm_wat(:) = 0.0_kp ! surface_drag_wind_speed_for_momentum_in_air_over_water + cmm_lnd(:) = 0.0_kp ! surface_drag_wind_speed_for_momentum_in_air_over_land + cmm_ice(:) = 0.0_kp ! surface_drag_wind_speed_for_momentum_in_air_over_ice + chh(:) = 0.0_kp ! surface_drag_mass_flux_for_heat_and_moisture + chh_wat(:) = 0.0_kp ! surface_drag_mass_flux_for_heat_and_moisture_in_air_over_water + chh_lnd(:) = 0.0_kp ! surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land + chh_ice(:) = 0.0_kp ! surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice + gflx(:) = 0.0_kp ! upward_heat_flux_in_soil + gflx_wat(:) = 0.0_kp ! upward_heat_flux_in_soil_over_water + gflx_lnd(:) = 0.0_kp ! upward_heat_flux_in_soil_over_lnd + gflx_ice(:) = 0.0_kp ! upward_heat_flux_in_soil_over_ice + + if (flag_init) then + allocate(evap(nMax)) + evap(:) = 0.0_kp ! kinematic_surface_upward_latent_heat_flux + end if + + evap_wat(:) = 0.0_kp ! kinematic_surface_upward_latent_heat_flux_over_water + evap_lnd(:) = 0.0_kp ! kinematic_surface_upward_latent_heat_flux_over_land + evap_ice(:) = 0.0_kp ! kinematic_surface_upward_latent_heat_flux_over_ice + + if (flag_init) then + allocate(hflx(nMax)) + hflx(:) = 0.0_kp ! kinematic_surface_upward_sensible_heat_flux + end if + + hflx_wat(:) = 0.0_kp ! kinematic_surface_upward_sensible_heat_flux_over_water + hflx_lnd(:) = 0.0_kp ! kinematic_surface_upward_sensible_heat_flux_over_land + hflx_ice(:) = 0.0_kp ! kinematic_surface_upward_sensible_heat_flux_over_ice + + ep1d(:) = 0.0_kp ! surface_upward_potential_latent_heat_flux + ep1d_wat(:) = 0.0_kp ! surface_upward_potential_latent_heat_flux_over_water + ep1d_lnd(:) = 0.0_kp ! surface_upward_potential_latent_heat_flux_over_land + ep1d_ice(:) = 0.0_kp ! surface_upward_potential_latent_heat_flux_over_ice + + lsm = 2 ! control_for_land_surface_scheme + lsm_noahmp = 2 ! identifier_for_noahmp_land_surface_scheme + lsm_ruc = 3 ! identifier_for_ruc_land_surface_scheme + semis_rad(:) = 0.0_kp ! surface_longwave_emissivity + semis_lnd(:) = 0.0_kp ! surface_longwave_emissivity_over_land_interstitial + semis_ice(:) = 0.0_kp ! surface_longwave_emissivity_over_ice_interstitial + semis_wat(:) = 0.0_kp ! surface_longwave_emissivity_over_water_interstitial + emis_lnd(:) = 0.0_kp ! surface_longwave_emissivity_over_land + emis_ice(:) = 0.0_kp ! surface_longwave_emissivity_over_ice + + !--- set up surface emissivity for lw radiation --- + !--- semis_wat is constant and set to 0.97 in setemis() call --- + semis_wat(:) = 0.97 + + !--- GFS surface scheme pre --- + call GFS_surface_composites_pre_run( & + nMax , flag_init , flag_restart, & + lkm , lsm , lsm_noahmp , & + lsm_ruc , frac_grid , flag_cice , & + cplflx , cplice , cplwav2atm , & + landfrac , lakefrac , lakedepth , & + oceanfrac , frland , dry , & + icy , lake , use_flake , & + wet , hice , cice , & + z0rl_wat , z0rl_lnd , z0rl_ice , & + snowd , snowd_lnd , snowd_ice , & + tprcp , & + tprcp_wat , tprcp_lnd , tprcp_ice , & + ustar , & + ustar_wat , ustar_lnd , ustar_ice , & + weasd , weasd_lnd , weasd_ice , & + ep1d_ice , tskin , tsfco , & + tskin_lnd , tskin_wat , tskin_ice , & + tisfc , tsurf_wat , tsurf_lnd , & + tsurf_ice , gflx_ice , tgice , & + islmsk , islmsk_cice, slmsk , & + semis_rad , semis_wat , semis_lnd , & + semis_ice , emis_lnd , emis_ice , & + qss , qss_wat , qss_lnd , & + qss_ice , min_lakeice, min_seaice , & + kdt , errmsg , errflg) + + !--- surface iteration loop --- + do iter = 1, 2 + !--- calculate stability parameters --- + call sfc_diff_run( & + nMax , rvrdm1 , eps , & + epsm1 , grav , psfc , & + tbot , qbot , zbot , & + garea , wind , pbot , & + prslki , prsik1 , prslk1 , & + sigmaf , vegtype , shdmax , & + ivegsrc , z0pert , ztpert , & + flag_iter , redrag , usfc , & + vsfc , sfc_z0_type, wet , & + dry , icy , thsfc_loc , & + tskin_wat , tskin_lnd , tskin_ice , & + tsurf_wat , tsurf_lnd , tsurf_ice , & + z0rl_wat , z0rl_lnd , z0rl_ice , & + z0rl_wav , & + ustar_wat , ustar_lnd , ustar_ice , & + cm_wat , cm_lnd , cm_ice , & + ch_wat , ch_lnd , ch_ice , & + rb_wat , rb_lnd , rb_ice , & + stress_wat, stress_lnd , stress_ice , & + fm_wat , fm_lnd , fm_ice , & + fh_wat , fh_lnd , fh_ice , & + fm10_wat , fm10_lnd , fm10_ice , & + fh2_wat , fh2_lnd , fh2_ice , & + ztmax_wat , ztmax_lnd , ztmax_ice , & + zvfun , errmsg , errflg) + + !--- update flag_guess --- + call GFS_surface_loop_control_part1_run( & + nMax , iter , wind , & + flag_guess , errmsg , errflg) + + !--- calculate heat fluxes --- + call sfc_ocean_run( & + nMax , hvap , cp , & + rd , eps , epsm1 , & + rvrdm1 , psfc , ubot , & + vbot , tbot , qbot , & + tskin_wat , cm_wat , ch_wat , & + lseaspray , fm_wat , fm10_wat , & + pbot , prslki , wet , & + use_flake , wind , flag_iter , & + qss_wat , cmm_wat , chh_wat , & + gflx_wat , evap_wat , hflx_wat , & + ep1d_wat , errmsg , errflg) + + !--- update flag_guess and flag_iter --- + call GFS_surface_loop_control_part2_run( & + nMax , iter , wind , & + flag_guess , flag_iter , dry , & + wet , icy , nstf_name1 , & + errmsg , errflg) + end do + + !--- GFS surface scheme post --- + call GFS_surface_composites_post_run( & + nMax , kice , km , & + rd , rvrdm1 , cplflx , & + cplwav2atm, frac_grid , flag_cice , & + thsfc_loc , islmsk , dry , & + wet , icy , wind , & + tbot , qbot , pbot , & + landfrac , lakefrac , oceanfrac , & + z0rl , z0rl_wat , z0rl_lnd , & + z0rl_ice , garea , cm , & + cm_wat , cm_lnd , cm_ice , & + ch , ch_wat , ch_lnd , & + ch_ice , rb , rb_wat , & + rb_lnd , rb_ice , stress , & + stress_wat, stress_lnd , stress_ice , & + fm , fm_wat , fm_lnd , & + fm_ice , fh , fh_wat , & + fh_lnd , fh_ice , ustar , & + ustar_wat , ustar_lnd , ustar_ice , & + fm10 , fm10_wat , fm10_lnd , & + fm10_ice , fh2 , fh2_wat , & + fh2_lnd , fh2_ice , tsurf_wat , & + tsurf_lnd , tsurf_ice , cmm , & + cmm_wat , cmm_lnd , cmm_ice , & + chh , chh_wat , chh_lnd , & + chh_ice , gflx , gflx_wat , & + gflx_lnd , gflx_ice , ep1d , & + ep1d_wat , ep1d_lnd , ep1d_ice , & + weasd , weasd_lnd , weasd_ice , & + snowd , snowd_lnd , snowd_ice , & + tprcp , tprcp_wat , tprcp_lnd , & + tprcp_ice , evap , evap_wat , & + evap_lnd , evap_ice , hflx , & + hflx_wat , hflx_lnd , hflx_ice , & + qss , qss_wat , qss_lnd , & + qss_ice , tskin , tsfco , & + tskin_lnd , tskin_wat , tskin_ice , & + tisfc , hice , cice , & + min_seaice, & + tiice , sigmaf , zvfun , & + lheatstrg , h0facu , h0facs , & + hflxq , hffac , stc , & + grav , prsik1 , prslk1 , & + prslki , zbot , ztmax_wat , & + ztmax_lnd , ztmax_ice , & + errmsg , errflg) + + !--- unit conversion --- + do n = 1, nMax + if (mask(n) /= 0) then + sen(n) = hflx_wat(n)*rbot(n)*cp + lat(n) = evap_wat(n)*rbot(n)*hvap + lwup(n) = semis_wat(n)*sbc*ts(n)**4+(1.0_r8-semis_wat(n))*lwdn(n) + evp(n) = lat(n)/hvap + taux(n) = -1.0_kp*rbot(n)*stress(n)*ubot(n)/wind(n) + tauy(n) = -1.0_kp*rbot(n)*stress(n)*vbot(n)/wind(n) + else + sen(n) = spval + lat(n) = spval + lwup(n) = spval + evap(n) = spval + taux(n) = spval + tauy(n) = spval + end if + end do + + flag_init = .false. + + end subroutine flux_atmOcn_ccpp + +end module flux_atmocn_ccpp_mod From 3758f9fc17ac4b6018e637695c35817a10426c6d Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Mon, 29 Nov 2021 16:25:45 -0700 Subject: [PATCH 003/395] fix area field for new flux algorithm --- mediator/med_phases_aofluxes_mod.F90 | 79 +++++++++++++++++++++------- 1 file changed, 60 insertions(+), 19 deletions(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index cea0a7f81..e242e1965 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -23,6 +23,7 @@ module med_phases_aofluxes_mod use ESMF , only : ESMF_Mesh, ESMF_MeshGet, ESMF_XGrid, ESMF_XGridCreate, ESMF_TYPEKIND_R8 use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LOGMSG_ERROR, ESMF_FAILURE use ESMF , only : ESMF_Finalize, ESMF_LogFoundError + use ESMF , only : ESMF_XGridGet, ESMF_KIND_R8 use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_internalstate_mod , only : InternalState, mastertask, logunit use med_constants_mod , only : dbug_flag => med_constants_dbug_flag @@ -477,6 +478,9 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) character(len=CX) :: tmpstr integer :: lsize integer :: fieldcount + type(ESMF_Field) :: lfield + type(ESMF_Mesh) :: lmesh + type(ESMF_CoordSys_Flag) :: coordSys character(len=*),parameter :: subname=' (med_aofluxes_init_ocngrid) ' !----------------------------------------------------------------------- @@ -512,6 +516,23 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) write(tmpstr,'(i12,g22.12,i12)') lsize,sum(aoflux_in%rmask),sum(aoflux_in%mask) call ESMF_LogWrite(trim(subname)//" : maskB= "//trim(tmpstr), ESMF_LOGMSG_INFO) + ! ------------------------ + ! setup grid area + ! ------------------------ + + call ESMF_FieldBundleGet(is_local%wrap%FBArea(compocn), 'area', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=aoflux_in%garea, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(lmesh, coordSys=coordSys, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (coordSys /= ESMF_COORDSYS_CART) then + ! Convert square radians to square meters + aoflux_in%garea(:) = aoflux_in%garea(:)*(rearth**2) + end if + ! ------------------------ ! create packed mapping from ocn->atm if aoflux_grid is ocn ! ------------------------ @@ -562,6 +583,9 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Mesh) :: mesh_src type(ESMF_Mesh) :: mesh_dst integer :: maptype + type(ESMF_Field) :: lfield + type(ESMF_Mesh) :: lmesh + type(ESMF_CoordSys_Flag) :: coordSys character(len=*),parameter :: subname=' (med_aofluxes_init_atmgrid) ' !----------------------------------------------------------------------- @@ -638,6 +662,23 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) end if enddo + ! ------------------------ + ! setup grid area + ! ------------------------ + + call ESMF_FieldBundleGet(is_local%wrap%FBArea(compatm), 'area', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=aoflux_in%garea, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(lmesh, coordSys=coordSys, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (coordSys /= ESMF_COORDSYS_CART) then + ! Convert square radians to square meters + aoflux_in%garea(:) = aoflux_in%garea(:)*(rearth**2) + end if + ! ------------------------ ! set one normalization for ocn-atm mapping if needed ! ------------------------ @@ -693,7 +734,6 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Field) :: lfield_o type(ESMF_Field) :: lfield_x type(ESMF_Field) :: lfield - integer :: elementCount type(ESMF_Mesh) :: ocn_mesh type(ESMF_Mesh) :: atm_mesh integer, allocatable :: ocn_mask(:) @@ -704,6 +744,8 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Mesh) :: mesh_dst ! needed for normalization real(r8), pointer :: dataptr1d(:) integer :: fieldcount + type(ESMF_CoordSys_Flag) :: coordSys + real(ESMF_KIND_R8) ,allocatable :: area(:) character(ESMF_MAXSTR),allocatable :: fieldNameList(:) character(len=*),parameter :: subname=' (med_aofluxes_init_xgrid) ' !----------------------------------------------------------------------- @@ -810,6 +852,23 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) allocate(aoflux_in%mask(lsize)) aoflux_in%mask(:) = 1 + ! ------------------------ + ! setup grid area + ! ------------------------ + + ! TODO: ESMF_XGridGet() call could return coordSys in newer version of ESMF + allocate(area(lsize)) + !call ESMF_XGridGet(xgrid, coordSys=coordSys, area=area, rc=rc) + call ESMF_XGridGet(xgrid, area=area, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(aoflux_in%garea(lsize)) + aoflux_in%garea(:) = area(:) + deallocate(area) + !if (coordSys /= ESMF_COORDSYS_CART) then + ! Convert square radians to square meters + aoflux_in%garea(:) = aoflux_in%garea(:)*(rearth**2) + !end if + ! ------------------------ ! determine one normalization field for ocn->xgrid ! ------------------------ @@ -898,9 +957,6 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) type(InternalState) :: is_local type(ESMF_Field) :: field_src type(ESMF_Field) :: field_dst - type(ESMF_Field) :: lfield - type(ESMF_Mesh) :: lmesh - type(ESMF_CoordSys_Flag) :: coordSys integer :: n,i,nf ! indices real(r8), pointer :: data_normdst(:) real(r8), pointer :: data_dst(:) @@ -1038,21 +1094,6 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) end do end if end if - ! Extract area information - if (trim(coupling_mode) == 'nems_frac_aoflux') then - call ESMF_FieldBundleGet(is_local%wrap%FBArea(compatm), 'area', field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=aoflux_in%garea, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(lmesh, coordSys=coordSys, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (coordSys /= ESMF_COORDSYS_CART) then - ! Convert square radians to square meters - aoflux_in%garea(:) = aoflux_in%garea(:)*(rearth**2) - end if - end if !---------------------------------- ! Update atmosphere/ocean surface fluxes From 0f635e1249aa57eb5508c99eb6765881332a32b8 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Tue, 7 Dec 2021 14:48:13 -0700 Subject: [PATCH 004/395] send fluxes to atmospheric model --- mediator/esmFldsExchange_nems_mod.F90 | 46 +++++++++++++++++---------- mediator/med_phases_prep_atm_mod.F90 | 7 ++-- mediator/med_phases_prep_ocn_mod.F90 | 4 +-- 3 files changed, 35 insertions(+), 22 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 1a05e2677..c31713c2f 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -34,7 +34,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use esmflds , only : mapconsf_aofrac use esmflds , only : coupling_mode, mapnames use esmflds , only : fldListTo, fldListFr, fldListMed_aoflux, fldListMed_ocnalb - use med_internalstate_mod , only : mastertask, logunit + use med_internalstate_mod , only : InternalState, mastertask, logunit ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -42,6 +42,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) integer , intent(inout) :: rc ! local variables: + type(InternalState) :: is_local integer :: i, n, maptype character(len=CX) :: msgString character(len=CL) :: cvalue @@ -52,7 +53,18 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) 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 + + !--------------------------------------- ! Set maptype according to coupling_mode + !--------------------------------------- + if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then maptype = mapnstod_consf else @@ -92,17 +104,6 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'one', 'unset') end do deallocate(flds) - - ! unused fields needed by the atm/ocn flux computation - allocate(flds(13)) - flds = (/'So_tref ', 'So_qref ','So_u10 ', 'So_ustar ','So_ssq ', & - 'So_re ', 'So_duu10n','Faox_lwup', 'Faox_sen ','Faox_lat ', & - 'Faox_evap', 'Faox_taux','Faox_tauy'/) - do n = 1,size(flds) - fldname = trim(flds(n)) - call addfld(fldListMed_aoflux%flds, trim(fldname)) - end do - deallocate(flds) else if (trim(coupling_mode) == 'nems_frac_aoflux') then ! to med: atm and ocn fields required for atm/ocn flux calculation allocate(flds(11)) @@ -115,7 +116,9 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'one', 'unset') end do deallocate(flds) + end if + if ( trim(coupling_mode) == 'nems_orig_data' .or. trim(coupling_mode) == 'nems_frac_aoflux') then ! unused fields needed by the atm/ocn flux computation allocate(flds(13)) flds = (/'So_tref ', 'So_qref ','So_u10 ', 'So_ustar ','So_ssq ', & @@ -182,13 +185,22 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call addmap(fldListFr(compocn)%flds, 'So_t', compatm, maptype, 'ofrac', 'unset') call addmrg(fldListTo(compatm)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') - ! to atm: surface fluxes from mediator aoflux calculation + ! to atm: unmerged from mediator + ! - zonal surface stress, meridional surface stress + ! - surface latent heat flux, + ! - surface sensible heat flux + ! - surface upward longwave heat flux + ! - evaporation water flux from water, not in the list do we need to send it to atm? if (trim(coupling_mode) == 'nems_frac_aoflux') then - allocate(flds(6)) - flds = (/'taux', 'tauy', 'lat', 'sen', 'lwup', 'evap' /) + allocate(flds(5)) + flds = (/'taux', 'tauy', 'lat', 'sen', 'lwup' /) do n = 1,size(flds) - call addfld(fldListTo(compatm)%flds, 'Faox_'//trim(flds(n))) - call addmap(fldListMed_aoflux%flds, 'Faox_'//trim(flds(n)), compatm, mapconsf, 'ofrac', 'unset') + call addfld(fldListTo(compatm)%flds, 'Faxx_'//trim(flds(n))) + call addfld(fldListMed_aoflux%flds , 'Faox_'//trim(flds(n))) + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds, 'Faox_'//trim(flds(n)), compatm, mapconsf, 'ofrac', 'unset') + end if + call addmrg(fldListTo(compatm)%flds, 'Faxx_'//trim(flds(n)), mrg_from=compmed, mrg_fld='Faox_'//trim(flds(n)), mrg_type='copy') end do deallocate(flds) end if diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 7c0beada8..a598ec169 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -129,7 +129,9 @@ subroutine med_phases_prep_atm(gcomp, rc) !--------------------------------------- !--- merge all fields to atm !--------------------------------------- - if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'hafs') then + if (trim(coupling_mode) == 'cesm' .or. & + trim(coupling_mode) == 'nems_frac_aoflux' .or. & + trim(coupling_mode) == 'hafs') then call med_merge_auto(& is_local%wrap%med_coupling_active(:,compatm), & is_local%wrap%FBExp(compatm), & @@ -140,8 +142,7 @@ subroutine med_phases_prep_atm(gcomp, rc) FBMed2=is_local%wrap%FBMed_aoflux_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'nems_frac' .or. & - trim(coupling_mode) == 'nems_orig' .or. & - trim(coupling_mode) == 'nems_frac_aoflux') then + trim(coupling_mode) == 'nems_orig') then call med_merge_auto(& is_local%wrap%med_coupling_active(:,compatm), & is_local%wrap%FBExp(compatm), & diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 21890d40e..ddf6eaf99 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -107,6 +107,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) ! auto merges to ocn if ( trim(coupling_mode) == 'cesm' .or. & trim(coupling_mode) == 'nems_orig_data' .or. & + trim(coupling_mode) == 'nems_frac_aoflux' .or. & trim(coupling_mode) == 'hafs') then call med_merge_auto(& is_local%wrap%med_coupling_active(:,compocn), & @@ -117,8 +118,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'nems_frac' .or. & - trim(coupling_mode) == 'nems_orig' .or. & - trim(coupling_mode) == 'nems_frac_aoflux') then + trim(coupling_mode) == 'nems_orig') then call med_merge_auto(& is_local%wrap%med_coupling_active(:,compocn), & is_local%wrap%FBExp(compocn), & From 53ebc24344be3bb33e6c0928b2aaaefc6f8ec961 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Sat, 18 Dec 2021 22:02:47 -0700 Subject: [PATCH 005/395] initial implementation for sending fluxes to UFS ATM --- mediator/esmFldsExchange_nems_mod.F90 | 6 ++-- mediator/med_phases_aofluxes_mod.F90 | 21 +++++++------ ufs/flux_atmocn_ccpp_mod.F90 | 43 +++++++++++++++++---------- 3 files changed, 42 insertions(+), 28 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index c31713c2f..2d47ed4a2 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -195,12 +195,12 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) allocate(flds(5)) flds = (/'taux', 'tauy', 'lat', 'sen', 'lwup' /) do n = 1,size(flds) - call addfld(fldListTo(compatm)%flds, 'Faxx_'//trim(flds(n))) call addfld(fldListMed_aoflux%flds , 'Faox_'//trim(flds(n))) + call addfld(fldListTo(compatm)%flds, 'Faox_'//trim(flds(n))) if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%flds, 'Faox_'//trim(flds(n)), compatm, mapconsf, 'ofrac', 'unset') + call addmap(fldListMed_aoflux%flds, 'Faox_'//trim(flds(n)), compatm, maptype, 'ofrac', 'unset') end if - call addmrg(fldListTo(compatm)%flds, 'Faxx_'//trim(flds(n)), mrg_from=compmed, mrg_fld='Faox_'//trim(flds(n)), mrg_type='copy') + call addmrg(fldListTo(compatm)%flds, 'Faox_'//trim(flds(n)), mrg_from=compmed, mrg_fld='Faox_'//trim(flds(n)), mrg_type='copy') end do deallocate(flds) end if diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index e242e1965..f0d905e69 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1078,21 +1078,24 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) end do end if if (compute_atm_dens) then - ! Add limiting factor to be consistent with UFS atmosphere-ocean flux calculation if (trim(coupling_mode) == 'nems_frac_aoflux') then + ! Add limiting factor to humidity to be consistent with UFS aoflux calculation do n = 1,aoflux_in%lsize if (aoflux_in%mask(n) /= 0._r8) then aoflux_in%shum(n) = max(aoflux_in%shum(n), qmin) - aoflux_in%dens(n) = aoflux_in%psfc(n)/(287.058_R8*(1._R8 + 0.608_R8*aoflux_in%shum(n))*aoflux_in%tbot(n)) - end if - end do - else - do n = 1,aoflux_in%lsize - if (aoflux_in%mask(n) /= 0._r8) then - aoflux_in%dens(n) = aoflux_in%pbot(n)/(287.058_R8*(1._R8 + 0.608_R8*aoflux_in%shum(n))*aoflux_in%tbot(n)) end if end do + ! Use pbot as psfc for the initial pass since psfc provided by UFS atm is zero + if (maxval(aoflux_in%psfc, mask=(aoflux_in%mask/= 0._r8)) < 100._r8) then + aoflux_in%psfc(:) = aoflux_in%pbot(:) + call ESMF_LogWrite(trim(subname)//" : using pbot as psfc for initial pass!", ESMF_LOGMSG_INFO) + end if end if + do n = 1,aoflux_in%lsize + if (aoflux_in%mask(n) /= 0._r8) then + aoflux_in%dens(n) = aoflux_in%pbot(n)/(287.058_R8*(1._R8 + 0.608_R8*aoflux_in%shum(n))*aoflux_in%tbot(n)) + end if + end do end if !---------------------------------- @@ -1123,7 +1126,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) zbot=aoflux_in%zbot, garea=aoflux_in%garea, ubot=aoflux_in%ubot, usfc=aoflux_in%usfc, vbot=aoflux_in%vbot, & vsfc=aoflux_in%vsfc, rbot=aoflux_in%dens, ts=aoflux_in%tocn, mask=aoflux_in%mask, & sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evp=aoflux_out%evap, & - taux=aoflux_out%taux, tauy=aoflux_out%tauy, & + taux=aoflux_out%taux, tauy=aoflux_out%tauy, qref=aoflux_out%qref, & missval=0.0_r8) else #endif diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index 10c677c71..b98c91faa 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -45,7 +45,7 @@ module flux_atmocn_ccpp_mod subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & garea, ubot, usfc, vbot, vsfc, rbot, ts, lwdn, sen, lat, & - lwup, evp, taux, tauy, missval) + lwup, evp, taux, tauy, qref, missval) implicit none @@ -74,6 +74,7 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & real(r8), intent(out) :: evp(nMax) ! heat flux: evap ((kg/s)/m^2) real(r8), intent(out) :: taux(nMax) ! surface stress, zonal (N) real(r8), intent(out) :: tauy(nMax) ! surface stress, maridional (N) + real(r8), intent(out) :: qref(nMax) ! diag: 2m ref humidity (kg/kg) !--- local variables -------------------------------- integer :: n , iter , ivegsrc , & @@ -87,7 +88,8 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & h0facu , h0facs logical :: redrag , thsfc_loc , lseaspray , & flag_restart, frac_grid , cplflx , & - cplice , cplwav2atm, lheatstrg + cplice , cplwav2atm, lheatstrg , & + use_med_flux character(len=1024) :: errmsg integer, dimension(nMax) :: vegtype , islmsk , islmsk_cice real(kp), dimension(nMax) :: prsl1 , prslki , prsik1 , & @@ -132,8 +134,11 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & tsfc , & tsfc_wat , tsfc_lnd , tsfc_ice , & semis_rad , emis_lnd , emis_ice , & - semis_wat , semis_lnd , semis_ice + semis_wat , semis_lnd , semis_ice , & + dqsfc , dtsfc real(kp), dimension(nMax,1) :: tiice , stc + !integer :: naux2d + !real(kp), dimension(nMax,2) :: aux2d logical, dimension(nMax) :: flag_iter , flag_guess, use_flake , & wet , dry , icy , & flag_cice , lake @@ -338,6 +343,9 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & gflx_wat(:) = 0.0_kp ! upward_heat_flux_in_soil_over_water gflx_lnd(:) = 0.0_kp ! upward_heat_flux_in_soil_over_lnd gflx_ice(:) = 0.0_kp ! upward_heat_flux_in_soil_over_ice + use_med_flux = .false. ! flag_for_mediator_atmosphere_ocean_fluxes + dqsfc(:) = 0.0_kp ! surface_upward_latent_heat_flux_over_ocean_from_coupled_process + dtsfc(:) = 0.0_kp ! surface_upward_sensible_heat_flux_over_ocean_from_coupled_process if (flag_init) then allocate(evap(nMax)) @@ -441,17 +449,18 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & !--- calculate heat fluxes --- call sfc_ocean_run( & - nMax , hvap , cp , & - rd , eps , epsm1 , & - rvrdm1 , psfc , ubot , & - vbot , tbot , qbot , & - tskin_wat , cm_wat , ch_wat , & - lseaspray , fm_wat , fm10_wat , & - pbot , prslki , wet , & - use_flake , wind , flag_iter , & - qss_wat , cmm_wat , chh_wat , & - gflx_wat , evap_wat , hflx_wat , & - ep1d_wat , errmsg , errflg) + nMax , hvap , cp , & + rd , eps , epsm1 , & + rvrdm1 , psfc , ubot , & + vbot , tbot , qbot , & + tskin_wat , cm_wat , ch_wat , & + lseaspray , fm_wat , fm10_wat , & + pbot , prslki , wet , & + use_flake , wind , flag_iter , & + use_med_flux, dqsfc , dtsfc , & + qss_wat , cmm_wat , chh_wat , & + gflx_wat , evap_wat , hflx_wat , & + ep1d_wat , errmsg , errflg) !--- update flag_guess and flag_iter --- call GFS_surface_loop_control_part2_run( & @@ -512,12 +521,13 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & !--- unit conversion --- do n = 1, nMax if (mask(n) /= 0) then - sen(n) = hflx_wat(n)*rbot(n)*cp - lat(n) = evap_wat(n)*rbot(n)*hvap + sen(n) = -1.0_kp*hflx_wat(n)*rbot(n)*cp + lat(n) = -1.0_kp*evap_wat(n)*rbot(n)*hvap lwup(n) = semis_wat(n)*sbc*ts(n)**4+(1.0_r8-semis_wat(n))*lwdn(n) evp(n) = lat(n)/hvap taux(n) = -1.0_kp*rbot(n)*stress(n)*ubot(n)/wind(n) tauy(n) = -1.0_kp*rbot(n)*stress(n)*vbot(n)/wind(n) + qref(n) = qss_wat(n) else sen(n) = spval lat(n) = spval @@ -525,6 +535,7 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & evap(n) = spval taux(n) = spval tauy(n) = spval + qref(n) = spval end if end do From 77849901f6de90813232c74f923b18f3fc8e755f Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 30 Dec 2021 13:37:03 -0700 Subject: [PATCH 006/395] merge with origin/master --- .github/pull_request_template.md | 23 +- cime_config/buildexe | 3 +- cime_config/buildnml | 26 +- cime_config/config_component.xml | 16 +- cime_config/config_component_ufs.xml | 567 ------------------------ cime_config/namelist_definition_drv.xml | 50 ++- mediator/esmFlds.F90 | 165 +++---- mediator/esmFldsExchange_cesm_mod.F90 | 99 ++--- mediator/esmFldsExchange_hafs_mod.F90 | 36 +- mediator/esmFldsExchange_nems_mod.F90 | 11 +- mediator/med.F90 | 478 ++++---------------- mediator/med_diag_mod.F90 | 16 +- mediator/med_fraction_mod.F90 | 51 ++- mediator/med_internalstate_mod.F90 | 535 ++++++++++++++++++++-- mediator/med_map_mod.F90 | 98 ++-- mediator/med_merge_mod.F90 | 3 +- mediator/med_phases_aofluxes_mod.F90 | 8 +- mediator/med_phases_history_mod.F90 | 27 +- mediator/med_phases_ocnalb_mod.F90 | 2 +- mediator/med_phases_post_atm_mod.F90 | 2 +- mediator/med_phases_post_glc_mod.F90 | 34 +- mediator/med_phases_post_ice_mod.F90 | 2 +- mediator/med_phases_post_lnd_mod.F90 | 7 +- mediator/med_phases_post_ocn_mod.F90 | 17 +- mediator/med_phases_post_rof_mod.F90 | 2 +- mediator/med_phases_post_wav_mod.F90 | 2 +- mediator/med_phases_prep_atm_mod.F90 | 4 +- mediator/med_phases_prep_glc_mod.F90 | 41 +- mediator/med_phases_prep_ice_mod.F90 | 4 +- mediator/med_phases_prep_lnd_mod.F90 | 2 +- mediator/med_phases_prep_ocn_mod.F90 | 3 +- mediator/med_phases_prep_rof_mod.F90 | 2 +- mediator/med_phases_prep_wav_mod.F90 | 2 +- mediator/med_phases_restart_mod.F90 | 2 +- ufs/flux_atmocn_ccpp_mod.F90 | 18 +- 35 files changed, 946 insertions(+), 1412 deletions(-) delete mode 100644 cime_config/config_component_ufs.xml diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index 36cc6403f..438a2f450 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -6,16 +6,13 @@ Contributors other than yourself, if any: CMEPS Issues Fixed (include github issue #): -Are changes expected to change answers? - - [ ] bit for bit - - [ ] different at roundoff level - - [ ] more substantial +Are changes expected to change answers? (specify if bfb, different at roundoff, more substantial) Any User Interface Changes (namelist or namelist defaults changes)? - - [ ] Yes - - [ ] No -Testing performed if application target is CESM:(either UFS-S2S or CESM testing is required): +### Testing performed + +Testing performed if application target is CESM: - [ ] (recommended) CIME_DRIVER=nuopc scripts_regression_tests.py - machines: - details (e.g. failed tests): @@ -39,16 +36,14 @@ Testing performed if application target is UFS-HAFS: - description: - details (e.g. failed tests): -Hashes used for testing: +### Hashes used for testing: + - [ ] CESM: - repository to check out: https://github.com/ESCOMP/CESM.git - - branch: - - hash: + - branch/hash: - [ ] UFS-coupled, then umbrella repostiory to check out and associated hash: - repository to check out: - - branch: - - hash: + - branch/hash: - [ ] UFS-HAFS, then umbrella repostiory to check out and associated hash: - repository to check out: - - branch: - - hash: + - branch/hash: diff --git a/cime_config/buildexe b/cime_config/buildexe index f02d0a399..f2a0c905c 100755 --- a/cime_config/buildexe +++ b/cime_config/buildexe @@ -37,7 +37,6 @@ def _main_func(): cime_model = case.get_value("MODEL") num_esp = case.get_value("NUM_COMP_INST_ESP") ocn_model = case.get_value("COMP_OCN") - atm_model = case.get_value("COMP_ATM") gmake_args = get_standard_makefile_args(case) esmf_aware_threading = case.get_value("ESMF_AWARE_THREADING") @@ -63,7 +62,7 @@ def _main_func(): else: skip_mediator = False - if ocn_model == 'mom' or atm_model == "ufsatm": + if ocn_model == 'mom': gmake_args += "USE_FMS=TRUE" comp_classes = case.get_values("COMP_CLASSES") diff --git a/cime_config/buildnml b/cime_config/buildnml index 11c20e276..2bc7c82b9 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -223,21 +223,21 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): # End if pause is active #-------------------------------- - # (1) Specify input data list file + # Specify input data list file #-------------------------------- data_list_path = os.path.join(case.get_case_root(), "Buildconf", "cpl.input_data_list") if os.path.exists(data_list_path): os.remove(data_list_path) #-------------------------------- - # (2) Write namelist file drv_in and initial input dataset list. + # Write namelist file drv_in and initial input dataset list. #-------------------------------- namelist_file = os.path.join(confdir, "drv_in") drv_namelist_groups = ["papi_inparm", "pio_default_inparm", "prof_inparm", "debug_inparm"] nmlgen.write_output_file(namelist_file, data_list_path=data_list_path, groups=drv_namelist_groups) #-------------------------------- - # (3) Write nuopc.runconfig file and add to input dataset list. + # Write nuopc.runconfig file and add to input dataset list. #-------------------------------- # Determine valid components @@ -291,7 +291,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): nmlgen.write_nuopc_config_file(nuopc_config_file, data_list_path=data_list_path) #-------------------------------- - # (3.1) Update nuopc.runconfig file if component needs it + # Update nuopc.runconfig file if component needs it #-------------------------------- # Read nuopc.runconfig @@ -330,12 +330,12 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): f.write(line) #-------------------------------- - # (4) Write nuopc.runseq + # Write nuopc.runseq #-------------------------------- _create_runseq(case, coupling_times, valid_comps) #-------------------------------- - # (5) Write drv_flds_in + # Write drv_flds_in #-------------------------------- # In thte following, all values come simply from the infiles - no default values need to be added # FIXME - do want to add the possibility that will use a user definition file for drv_flds_in @@ -567,7 +567,6 @@ def buildnml(case, caseroot, component): files.set_value("COMP_ROOT_DIR_CPL", comp_root_dir_cpl) definition_file = [files.get_value("NAMELIST_DEFINITION_FILE", {"component": "cpl"})] - fd_dir = os.path.dirname(definition_file[0]) user_definition = os.path.join(user_xml_dir, "namelist_definition_drv.xml") if os.path.isfile(user_definition): definition_file = [user_definition] @@ -606,15 +605,12 @@ def buildnml(case, caseroot, component): for filename in glob.glob(os.path.join(confdir, "*modelio*")): shutil.copy(filename, rundir) - # copy fd_cesm.yaml to rundir - fd_dir = os.path.join(os.path.dirname(__file__),os.pardir,"mediator") - coupling_mode = case.get_value('COUPLING_MODE') - if coupling_mode == 'cesm': - filename = os.path.join(fd_dir,"fd_cesm.yaml") - elif 'nems' in coupling_mode or coupling_mode == 'hafs': - filename = os.path.join(fd_dir,"fd_nems.yaml") + # copy fd_cesm.yaml to rundir - look in user_xml_dir first + user_yaml_file = os.path.join(user_xml_dir, "fd_cesm.yaml") + if os.path.isfile(user_yaml_file): + filename = user_yaml_file else: - expect(False, "coupling mode currently only supports cesm") + filename = os.path.join(os.path.dirname(__file__), os.pardir, "mediator", "fd_cesm.yaml") shutil.copy(filename, os.path.join(rundir, "fd.yaml")) ############################################################################### diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 49bc7d0d8..aeb7770fc 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -28,7 +28,7 @@ char - cesm,nems_orig,nems_orig_data,nems_frac,hafs + cesm cesm run_coupling env_run.xml @@ -1685,6 +1685,20 @@ $CIMEROOT/machines/config_machines.xml + + char + UNSET + run_din + env_run.xml + + On some systems the filesystem of DIN_LOC_ROOT is not available on compute nodes and + data must be staged to a temporary location. If this variable is defined it will + be used as the root directory of an inputdata staging area. + Default values for the target machine are in the + $CIMEROOT/machines/config_machines.xml + + + char UNSET diff --git a/cime_config/config_component_ufs.xml b/cime_config/config_component_ufs.xml deleted file mode 100644 index bb32df7b5..000000000 --- a/cime_config/config_component_ufs.xml +++ /dev/null @@ -1,567 +0,0 @@ - - - - - - - - - 1972-2004 - 2002-2003 - Historic transient - Twentieth century transient - - CMIP5 rcp 2.6 forcing - CMIP5 rcp 4.5 forcing - CMIP5 rcp 6.0 forcing - CMIP5 rcp 8.5 forcing - Biogeochemistry intercomponent - with diagnostic CO2 - with prognostic CO2 - - - - char - https://doi.org/10.5065/D67H1H0V - run_metadata - env_case.xml - run DOI - - - - logical - TRUE,FALSE - FALSE - run_flags - env_run.xml - logical to save timing files in rundir - - - - integer - 0 - run_flags - env_run.xml - Determines number of times profiler is called over the model run period. - This sets values for tprof_option and tprof_n that determine the timing output file frequency - - - - - integer - 2 - run_flags - env_run.xml - - integer indicating maximum detail level to profile. This xml - variable is used to set the namelist variable - timing_detail_limit. This namelist variable is used by perf_mod - (in $CIMEROOT/src/share/timing/perf_mod.F90) to turn timers off - and on depending on calls to the routine t_adj_detailf. If in the - code a statement appears like t_adj_detailf(+1), then the current - timer detail level is incremented by 1 and compared to the - time_detail_limit obtained from the namelist. If the limit is - exceeded then the timer is turned off. - - - - - integer - 4 - run_flags - env_run.xml - Maximum code stack depth of enabled timers. - - - - logical - TRUE,FALSE - FALSE - run_data_archive - env_run.xml - Logical to archive all interim restart files, not just those at eor - If TRUE, perform short term archiving on all interim restart files, - not just those at the end of the run. By default, this value is TRUE. - The restart files are saved under the specific component directory - ($DOUT_S_ROOT/$CASE/$COMPONENT/rest rather than the top-level $DOUT_S_ROOT/$CASE/rest directory). - Interim restart files are created using the REST_N and REST_OPTION variables. - This is for expert users ONLY and requires expert knowledge. - We will not document this further in this guide. - - - - logical - TRUE,FALSE - FALSE - run_flags - env_run.xml - turns on coupler bit-for-bit reproducibility with varying pe counts - - - - char - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end - never - - ndays - - run_begin_stop_restart - env_run.xml - - sets frequency of full model barrier (same options as STOP_OPTION) for synchronization with BARRIER_N and BARRIER_DATE - - - - - char - none,CO2A,CO2B,CO2C - none - - CO2A - none - CO2A - CO2A - CO2A - CO2C - CO2C - - run_coupling - env_run.xml - Activates additional CO2-related fields to be exchanged between components. Possible values are: - - CO2A: sets the driver namelist variable flds_co2a = .true.; this adds - prognostic CO2 and diagnostic CO2 at the lowest model level to be sent from - the atmosphere to the land and ocean. - - CO2B: sets the driver namelist variable flds_co2b = .true.; this adds - prognostic CO2 and diagnostic CO2 at the lowest model level to be sent from - the atmosphere just to the land, and the surface upward flux of CO2 to be - sent from the land back to the atmosphere - - CO2C: sets the driver namelist variable flds_co2c = .true.; this adds - prognostic CO2 and diagnostic CO2 at the lowest model level to be sent from - the atmosphere to the land and ocean, and the surface upward flux of CO2 - to be sent from the land and the open ocean back to the atmosphere. - - The namelist variables flds_co2a, flds_co2b and flds_co2c are in the - namelist group cpl_flds_inparm. - - - - - char - - - - - - run_component_cpl - env_case.xml - User mods to apply to specific compset matches. - - - - char - hour,day,year,decade - run_coupling - env_run.xml - day - - year - hour - - Base period associated with NCPL coupling frequency. - This xml variable is only used to set the driver namelist variables, - atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt, and esp_dt. - - - - integer - 48 - - 144 - 288 - 288 - 72 - 48 - - - 24 - 24 - 24 - 24 - 24 - 24 - 48 - 48 - 1 - 96 - 96 - 96 - 96 - 192 - 192 - 192 - 192 - 384 - 384 - 384 - 144 - 72 - 144 - 288 - 48 - 48 - 24 - 24 - 1 - - - - run_coupling - env_run.xml - Number of atm coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver namelist atm_cpl_dt, equal to basedt/ATM_NCPL, - where basedt is equal to NCPL_BASE_PERIOD in seconds. - - - - integer - $ATM_NCPL - - 1 - - run_coupling - env_run.xml - Number of land coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver namelist atm_cpl_dt, equal to basedt/LND_NCPL, - where basedt is equal to NCPL_BASE_PERIOD in seconds. - - - - integer - $ATM_NCPL - - 1 - - run_coupling - env_run.xml - Number of ice coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver namelist ice_cpl_dt, equal to basedt/ICE_NCPL - where basedt is equal to NCPL_BASE_PERIOD in seconds. - - - - integer - $ATM_NCPL - - 24 - 24 - 4 - 24 - 24 - - - - - 1 - - run_coupling - env_run.xml - Number of ocn coupling intervals per NCPL_BASE_PERIOD. - Thisn is used to set the driver namelist ocn_cpl_dt, equal to basedt/OCN_NCPL - where basedt is equal to NCPL_BASE_PERIOD in seconds. - - - - integer - 1 - - 1 - $ATM_NCPL - $ATM_NCPL - 1 - - run_coupling - env_run.xml - Number of glc coupling intervals per NCPL_BASE_PERIOD. - - - - char - glc_coupling_period,yearly - yearly - run_coupling - env_run.xml - Period at which coupler averages fields sent to GLC. - This supports doing the averaging to GLC less frequently than GLC is called - (i.e., separating the averaging frequency from the calling frequency). - This is useful because there are benefits to only averaging the GLC inputs - as frequently as they are really needed (yearly for CISM), but GLC needs to - still be called more frequently than that in order to support mid-year restarts. - - Setting GLC_AVG_PERIOD to 'glc_coupling_period' means that the averaging is - done exactly when the GLC is called (governed by GLC_NCPL). - - IMPORTANT: In order to restart mid-year when running with CISM, you MUST specify GLC_AVG_PERIOD = 'yearly'. - If using GLC_AVG_PERIOD = 'glc_coupling_period' with CISM, you can only restart on year boundaries. - - - - - integer - 8 - - $ATM_NCPL - $ATM_NCPL - $ATM_NCPL - $ATM_NCPL - 8 - 8 - $ATM_NCPL - 1 - $ATM_NCPL - - run_coupling - env_run.xml - Number of rof coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver namelist rof_cpl_dt, equal to basedt/ROF_NCPL - where basedt is equal to NCPL_BASE_PERIOD in seconds. - - - - integer - $ATM_NCPL - run_coupling - env_run.xml - Number of wav coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver namelist wav_cpl_dt, equal to basedt/WAV_NCPL - where basedt is equal to NCPL_BASE_PERIOD in seconds. - - - - - - logical - TRUE,FALSE - FALSE - - TRUE - TRUE - TRUE - FALSE - - run_component_cpl - env_run.xml - - Only used for compsets with DATM and POP (currently C, G and J): - If true, compute albedos to work with daily avg SW down - If false (default), albedos are computed with the assumption that downward - solar radiation from the atm component has a diurnal cycle and zenith-angle - dependence. This is normally the case when using an active atm component - If true, albedos are computed with the assumption that downward - solar radiation from the atm component is a daily average quantity and - does not have a zenith-angle dependence. This is often the case when - using a data atm component. Only used for compsets with DATM and POP (currently C, G and J). - NOTE: This should really depend on the datm forcing and not the compset per se. - So, for example, whether it is set in a J compset should depend on - what datm forcing is used. - - - - - char - off,ocn - off - - ocn - off - - run_component_cpl - env_run.xml - - Only used for compsets with DATM and POP (currently C, G and J): - If ocn, ocn provides EP balance factor for precipitation. - Provides EP balance factor for precip for POP. A factor computed by - POP is applied to precipitation so that precipitation balances - evaporation and ocn global salinity does not drift. This is intended - for use when coupling POP to a DATM. Only used for C, G and J compsets. - Default is off - - - - - char - TIGHT,RASM - TIGHT - - RASM - RASM - RASM - RASM - RASM - RASM - RASM - RASM - - run_coupling - env_run.xml - - RASM runs prep ocean before the ocean coupling reducing - most of the lags and field inconsistency but still allowing the ocean to run - concurrently with the ice and atmosphere. - TIGHT are consistent with the old variables ocean_tight_coupling = true in the driver. - - - - - char - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end - never - run_drv_history - env_run.xml - Sets driver snapshot history file frequency (like REST_OPTION) - - - integer - - -999 - run_drv_history - env_run.xml - Sets driver snapshot history file frequency (like REST_N) - - - - integer - - -999 - run_drv_history - env_run.xml - yyyymmdd format, sets coupler snapshot history date (like REST_DATE) - - - - char - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end - never - - nmonths - - run_drv_history - env_run.xml - Sets driver average history file frequency (like REST_OPTION) - - - char - - -999 - - 1 - - run_drv_history - env_run.xml - Sets driver average history file frequency (like REST_N) - - - integer - - -999 - run_drv_history - env_run.xml - yyyymmdd format, sets driver average history date (like REST_DATE) - - - - logical - TRUE,FALSE - FALSE - - TRUE - TRUE - TRUE - - run_budgets - env_run.xml - logical that turns on diagnostic budgets for driver - - - - real - - 284.7 - - 367.0 - 284.7 - - run_co2 - env_run.xml - - Mechanism for setting the CO2 value in ppmv for - CLM if CLM_CO2_TYPE is constant or for - POP if OCN_CO2_TYPE is constant. - - - - - logical - TRUE,FALSE - FALSE - - TRUE - TRUE - - run_flags - env_run.xml - Turn on the passing of water isotope fields through the coupler - - - - integer - 1,3,5,10,36 - 10 - run_glc - env_run.xml - Number of glacier elevation classes used in CLM. - Used by both CLM and the coupler (even if CISM is not running, and only SGLC is used). - - - - logical - TRUE,FALSE - FALSE - - TRUE - - TRUE - - run_glc - env_run.xml - Whether the glacier component feeds back to the rest of the system - This affects: - (1) Whether CLM updates its areas based on glacier areas sent from GLC - (2) Whether GLC sends fluxes (e.g., calving fluxes) to the coupler - Note that this is set to TRUE by default for TG compsets - even though there are - no feedbacks for TG compsets, this enables extra coupler diagnostics for these - compsets. - - - - char - minus1p8,linear_salt,mushy - mushy - run_physics - env_run.xml - Freezing point calculation for salt water. - - - - diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index a38cfed1c..02c8f44ce 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -40,11 +40,10 @@ char expdef DRIVER_attributes - cesm,ufs + cesm cime model - cesm - ufs + cesm @@ -346,6 +345,7 @@ char mapping + abs ALLCOMP_attributes MESH for model mask (used to create masks and fractions at run time if different than model mesh) @@ -2270,11 +2270,9 @@ flds ALLCOMP_attributes - Previously, new fields that were needed to be passed between components - for certain compsets were specified by cpp-variables. This has been - modified to now be use cases. This use cases are specified in the - namelist cpl_flds_inparm and are currently triggered by the xml variable CCSM_BGC. - If CCSM_BGC is set to 'CO2A', then flds_co2a will be set to .true. + Pass CO2 from ATM to surface components + Set this by setting the xml variable BGC_MODE. + If BGC_MODE is set to 'CO2A', then flds_co2a will be set to .true. .false. @@ -2287,11 +2285,9 @@ flds ALLCOMP_attributes - Previously, new fields that were needed to be passed between components - for certain compsets were specified by cpp-variables. This has been - modified to now be use cases. This use cases are specified in the - namelist cpl_flds_inparm and are currently triggered by the xml variable CCSM_BGC. - If CCSM_BGC is set to 'CO2B', then flds_co2b will be set to .true. + Pass CO2 from ATM to LND and back from LND to ATM + Set this by setting the xml variable BGC_MODE. + If BGC_MODE is set to 'CO2B', then flds_co2b will be set to .true. .false. @@ -2304,11 +2300,9 @@ flds ALLCOMP_attributes - Previously, new fields that were needed to be passed between components - for certain compsets were specified by cpp-variables. This has been - modified to now be use cases. This use cases are specified in the - namelist cpl_flds_inparm and are currently triggered by the xml variable CCSM_BGC. - If CCSM_BGC is set to 'CO2C', then flds_co2c will be set to .true. + Pass CO2 from ATM to surface (OCN/LND) and back from them to ATM + Set this by setting the xml variable BGC_MODE. + If BGC_MODE is set to 'CO2C', then flds_co2c will be set to .true. .false. @@ -2343,6 +2337,19 @@ + + logical + flds + ALLCOMP_attributes + + Pass channel depths from river component to land component. This is needed for the hillslope + model in CTSM. + + + .false. + + + integer flds @@ -3813,6 +3820,7 @@ char mapping + abs ATM_attributes MESH description of atm grid @@ -3872,6 +3880,7 @@ char mapping + abs ICE_attributes MESH description of ice grid @@ -3898,6 +3907,7 @@ char mapping + abs ALLCOMP_attributes MESH description of glc grid @@ -3924,6 +3934,7 @@ char mapping + abs LND_attributes MESH description of lnd grid @@ -3950,6 +3961,7 @@ char mapping + abs OCN_attributes MESH description of ocn grid @@ -3976,6 +3988,7 @@ char mapping + abs ROF_attributes MESH description of rof grid @@ -4002,6 +4015,7 @@ char mapping + abs WAV_attributes MESH description of wav grid diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index c2bc91c5b..36dda2519 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -1,111 +1,17 @@ module esmflds 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 : ncomps, compname, compocn, compatm + use med_internalstate_mod, only : mapfcopy, mapnames, mapunset implicit none private - !----------------------------------------------- - ! Set components - !----------------------------------------------- - - integer, public, parameter :: compmed = 1 - integer, public, parameter :: compatm = 2 - integer, public, parameter :: complnd = 3 - integer, public, parameter :: compocn = 4 - integer, public, parameter :: compice = 5 - integer, public, parameter :: comprof = 6 - integer, public, parameter :: compwav = 7 - integer, public, parameter :: compglc1 = 8 - integer, public, parameter :: compglc2 = 9 - integer, public, parameter :: ncomps = 9 - - character(len=*), public, parameter :: compname(ncomps) = & - (/'med ',& - 'atm ',& - 'lnd ',& - 'ocn ',& - 'ice ',& - 'rof ',& - 'wav ',& - 'glc1',& - 'glc2'/) - - integer, public, parameter :: max_icesheets = 2 - integer, public :: compglc(max_icesheets) = (/compglc1,compglc2/) - integer, public :: num_icesheets ! obtained from attribute - logical, public :: ocn2glc_coupling ! obtained from attribute - logical, public :: lnd2glc_coupling ! obtained in med.F90 - logical, public :: accum_lnd2glc ! obtained in med.F90 (this can be true even if lnd2glc_coupling is false) - - logical, public :: dststatus_print = .false. - - !----------------------------------------------- - ! Set mappers - !----------------------------------------------- - - integer , public, parameter :: mapunset = 0 - integer , public, parameter :: mapbilnr = 1 - integer , public, parameter :: mapconsf = 2 - integer , public, parameter :: mapconsd = 3 - integer , public, parameter :: mappatch = 4 - integer , public, parameter :: mapfcopy = 5 - integer , public, parameter :: mapnstod = 6 ! nearest source to destination - integer , public, parameter :: mapnstod_consd = 7 ! nearest source to destination followed by conservative dst - integer , public, parameter :: mapnstod_consf = 8 ! nearest source to destination followed by conservative frac - integer , public, parameter :: mappatch_uv3d = 9 ! rotate u,v to 3d cartesian space, map from src->dest, then rotate back - integer , public, parameter :: mapbilnr_uv3d = 10 ! rotate u,v to 3d cartesian space, map from src->dest, then rotate back - integer , public, parameter :: map_rof2ocn_ice = 11 ! custom smoothing map to map ice from rof->ocn (cesm only) - integer , public, parameter :: map_rof2ocn_liq = 12 ! custom smoothing map to map liq from rof->ocn (cesm only) - integer , public, parameter :: map_glc2ocn_liq = 13 ! custom smoothing map to map liq from glc->ocn (cesm only) - integer , public, parameter :: map_glc2ocn_ice = 14 ! custom smoothing map to map ice from glc->ocn (cesm only) - integer , public, parameter :: mapfillv_bilnr = 15 ! fill value followed by bilinear - integer , public, parameter :: mapbilnr_nstod = 16 ! bilinear with nstod extrapolation - integer , public, parameter :: mapconsf_aofrac = 17 ! conservative with aofrac normalization (ufs only) - integer , public, parameter :: nmappers = 17 - - character(len=*) , public, parameter :: mapnames(nmappers) = & - (/'bilnr ',& - 'consf ',& - 'consd ',& - 'patch ',& - 'fcopy ',& - 'nstod ',& - 'nstod_consd ',& - 'nstod_consf ',& - 'patch_uv3d ',& - 'bilnr_uv3d ',& - 'rof2ocn_ice ',& - 'rof2ocn_liq ',& - 'glc2ocn_ice ',& - 'glc2ocn_liq ',& - 'fillv_bilnr ',& - 'bilnr_nstod ',& - 'consf_aofrac'/) - - !----------------------------------------------- - ! Set coupling mode - !----------------------------------------------- - - character(len=CS), public :: coupling_mode ! valid values are [cesm,nems_orig,nems_frac,nems_orig_data,hafs] - - !----------------------------------------------- - ! Name of model components - !----------------------------------------------- - - character(len=CS), public :: med_name = '' - character(len=CS), public :: atm_name = '' - character(len=CS), public :: lnd_name = '' - character(len=CS), public :: ocn_name = '' - character(len=CS), public :: ice_name = '' - character(len=CS), public :: rof_name = '' - character(len=CS), public :: wav_name = '' - character(len=CS), public :: glc_name = '' - !----------------------------------------------- ! PUblic methods !----------------------------------------------- + public :: med_fldList_init1 public :: med_fldList_AddFld public :: med_fldList_AddMap public :: med_fldList_AddMrg @@ -125,14 +31,14 @@ module esmflds character(CS) :: shortname ! Mapping fldsFr data - for mediator import fields - integer :: mapindex(ncomps) = mapunset - character(CS) :: mapnorm(ncomps) = 'unset' - character(CX) :: mapfile(ncomps) = 'unset' + integer , allocatable :: mapindex(:) + character(CS), allocatable :: mapnorm(:) + character(CX), allocatable :: mapfile(:) ! Merging fldsTo data - for mediator export fields - character(CS) :: merge_fields(ncomps) = 'unset' - character(CS) :: merge_types(ncomps) = 'unset' - character(CS) :: merge_fracnames(ncomps) = 'unset' + character(CS), allocatable :: merge_fields(:) + character(CS), allocatable :: merge_types(:) + character(CS), allocatable :: merge_fracnames(:) end type med_fldList_entry_type ! The above would be the field name to merge from @@ -154,8 +60,8 @@ module esmflds !----------------------------------------------- ! Instantiate derived types !----------------------------------------------- - type (med_fldList_type), public :: fldListTo(ncomps) ! advertise fields to components - type (med_fldList_type), public :: fldListFr(ncomps) ! advertise fields from components + type (med_fldList_type), allocatable, public :: fldListTo(:) ! advertise fields to components + type (med_fldList_type), allocatable, public :: fldListFr(:) ! advertise fields from components type (med_fldList_type), public :: fldListMed_aoflux type (med_fldList_type), public :: fldListMed_ocnalb @@ -169,8 +75,13 @@ module esmflds contains !================================================================================ - subroutine med_fldList_AddFld(flds, stdname, shortname) + subroutine med_fldlist_init1() + allocate(fldlistTo(ncomps)) + allocate(fldlistFr(ncomps)) + end subroutine med_fldlist_init1 + !================================================================================ + subroutine med_fldList_AddFld(flds, stdname, shortname) ! ---------------------------------------------- ! Add an entry to to the flds array ! Use pointers to create an extensible allocatable array. @@ -190,6 +101,7 @@ subroutine med_fldList_AddFld(flds, stdname, shortname) ! local variables integer :: n,oldsize,id logical :: found + integer :: mapsize, mrgsize type(med_fldList_entry_type), pointer :: newflds(:) character(len=*), parameter :: subname='(med_fldList_AddFld)' ! ---------------------------------------------- @@ -211,6 +123,9 @@ subroutine med_fldList_AddFld(flds, stdname, shortname) ! create new entry if fldname is not in original list + mapsize = ncomps + mrgsize = ncomps + if (.not. found) then ! 1) allocate newfld to be size (one element larger than input flds) @@ -220,12 +135,27 @@ subroutine med_fldList_AddFld(flds, stdname, shortname) do n = 1,oldsize newflds(n)%stdname = flds(n)%stdname newflds(n)%shortname = flds(n)%shortname + + allocate(newflds(n)%mapindex(mapsize)) + allocate(newflds(n)%mapnorm(mapsize)) + allocate(newflds(n)%mapfile(mapsize)) + allocate(newflds(n)%merge_fields(mrgsize)) + allocate(newflds(n)%merge_types(mrgsize)) + allocate(newflds(n)%merge_fracnames(mrgsize)) + newflds(n)%mapindex(:) = flds(n)%mapindex(:) newflds(n)%mapnorm(:) = flds(n)%mapnorm(:) newflds(n)%mapfile(:) = flds(n)%mapfile(:) newflds(n)%merge_fields(:) = flds(n)%merge_fields(:) newflds(n)%merge_types(:) = flds(n)%merge_types(:) newflds(n)%merge_fracnames(:) = flds(n)%merge_fracnames(:) + + deallocate(flds(n)%mapindex) + deallocate(flds(n)%mapnorm) + deallocate(flds(n)%mapfile) + deallocate(flds(n)%merge_fields) + deallocate(flds(n)%merge_types) + deallocate(flds(n)%merge_fracnames) end do ! 3) deallocate / nullify flds @@ -244,6 +174,18 @@ subroutine med_fldList_AddFld(flds, stdname, shortname) else flds(id)%shortname = trim(stdname) end if + allocate(flds(id)%mapindex(mapsize)) + allocate(flds(id)%mapnorm(mapsize)) + allocate(flds(id)%mapfile(mapsize)) + allocate(flds(id)%merge_fields(mrgsize)) + allocate(flds(id)%merge_types(mrgsize)) + allocate(flds(id)%merge_fracnames(mrgsize)) + flds(id)%mapindex(:) = mapunset + flds(id)%mapnorm(:) = 'unset' + flds(id)%mapfile(:) = 'unset' + flds(id)%merge_fields(:) = 'unset' + flds(id)%merge_types(:) = 'unset' + flds(id)%merge_fracnames(:) = 'unset' end if end subroutine med_fldList_AddFld @@ -639,11 +581,11 @@ subroutine med_fldList_GetFldInfo_merging(fldList, fldindex, compsrc, merge_fiel ! Get field merge info ! ---------------------------------------------- type(med_fldList_type) , intent(in) :: fldList - integer , intent(in) :: fldindex - integer , intent(in) :: compsrc - character(len=*) , intent(out) :: merge_field - character(len=*) , intent(out) :: merge_type - character(len=*) , intent(out) :: merge_fracname + integer , intent(in) :: fldindex + integer , intent(in) :: compsrc + character(len=*) , intent(out) :: merge_field + character(len=*) , intent(out) :: merge_type + character(len=*) , intent(out) :: merge_fracname ! local variables character(len=*), parameter :: subname='(med_fldList_GetFldInfo_merging)' @@ -652,6 +594,7 @@ subroutine med_fldList_GetFldInfo_merging(fldList, fldindex, compsrc, merge_fiel merge_field = fldList%flds(fldindex)%merge_fields(compsrc) merge_type = fldList%flds(fldindex)%merge_types(compsrc) merge_fracname = fldList%flds(fldindex)%merge_fracnames(compsrc) + end subroutine med_fldList_GetFldInfo_merging !================================================================================ diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 2bb45a90d..a1b1a4897 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -49,12 +49,13 @@ module esmFldsExchange_cesm_mod character(len=CX) :: rof2lnd_map='unset' character(len=CX) :: atm2wav_map='unset' - logical :: mapuv_with_cart3d - logical :: flds_i2o_per_cat - logical :: flds_co2a - logical :: flds_co2b - logical :: flds_co2c - logical :: flds_wiso + logical :: mapuv_with_cart3d ! Map U/V vector wind fields from ATM to OCN/ICE by rotating in Cartesian 3D space and then back + logical :: flds_i2o_per_cat ! Ice thickness category fields passed to OCN + logical :: flds_co2a ! Pass CO2 from ATM to surface components + logical :: flds_co2b ! Pass CO2 from ATM to LND and back from LND to ATM + logical :: flds_co2c ! Pass CO2 from ATM to surface (OCN/LND) and back from them to ATM + logical :: flds_wiso ! Pass water isotop fields + logical :: flds_r2l_stream_channel_depths ! Pass channel depths from ROF to LND character(*), parameter :: u_FILE_u = & __FILE__ @@ -71,17 +72,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) use med_utils_mod , only : chkerr => med_utils_chkerr use med_methods_mod , only : fldchk => med_methods_FB_FldChk use med_internalstate_mod , only : InternalState, logunit, mastertask + use med_internalstate_mod , only : compmed, compatm, complnd, compocn + use med_internalstate_mod , only : compice, comprof, compwav, compglc, ncomps + use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_nstod + use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf + use med_internalstate_mod , only : coupling_mode + use med_internalstate_mod , only : map_glc2ocn_ice, map_glc2ocn_liq, map_rof2ocn_ice, map_rof2ocn_liq use esmFlds , only : addfld => med_fldList_AddFld use esmFlds , only : addmap => med_fldList_AddMap use esmFlds , only : addmrg => med_fldList_AddMrg - use esmflds , only : compmed, compatm, complnd, compocn - use esmflds , only : compice, comprof, compwav, ncomps - use esmflds , only : compglc, num_icesheets, ocn2glc_coupling ! compglc is an array of integers - use esmflds , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_nstod - use esmflds , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf - use esmflds , only : map_glc2ocn_ice, map_glc2ocn_liq, map_rof2ocn_ice, map_rof2ocn_liq use esmflds , only : fldListTo, fldListFr, fldListMed_aoflux, fldListMed_ocnalb - use esmFlds , only : coupling_mode ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -102,11 +102,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Get the internal state !--------------------------------------- - if (phase /= 'advertise') then - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return if (phase == 'advertise') then @@ -200,25 +198,24 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_i2o_per_cat - ! are multiple ocean depths for temperature and salinity sent from the ocn to glc? - call NUOPC_CompAttributeGet(gcomp, name='ocn2glc_coupling', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ocn2glc_coupling - ! are water isotope exchanges enabled? call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_wiso + ! are water isotope exchanges enabled? + call NUOPC_CompAttributeGet(gcomp, name='flds_r2l_stream_channel_depths', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) flds_r2l_stream_channel_depths ! write diagnostic output if (mastertask) then - write(logunit,'(a,l7)') trim(subname)//' flds_co2a = ',flds_co2a - write(logunit,'(a,l7)') trim(subname)//' flds_co2b = ',flds_co2b - write(logunit,'(a,l7)') trim(subname)//' flds_co2c = ',flds_co2b - write(logunit,'(a,l7)') trim(subname)//' flds_wiso = ',flds_wiso - write(logunit,'(a,l7)') trim(subname)//' flds_i2o_per_cat = ',flds_i2o_per_cat - write(logunit,'(a,l7)') trim(subname)//' ocn2glc_coupling = ',ocn2glc_coupling - write(logunit,'(a,l7)') trim(subname)//' mapuv_with_cart3d = ',mapuv_with_cart3d + write(logunit,'(a,l7)') trim(subname)//' flds_co2a = ',flds_co2a + write(logunit,'(a,l7)') trim(subname)//' flds_co2b = ',flds_co2b + write(logunit,'(a,l7)') trim(subname)//' flds_co2c = ',flds_co2c + write(logunit,'(a,l7)') trim(subname)//' flds_wiso = ',flds_wiso + write(logunit,'(a,l7)') trim(subname)//' flds_i2o_per_cat = ',flds_i2o_per_cat + write(logunit,'(a,l7)') trim(subname)//' flds_r2l_stream_channel_depths = ',flds_r2l_stream_channel_depths + write(logunit,'(a,l7)') trim(subname)//' mapuv_with_cart3d = ',mapuv_with_cart3d end if end if @@ -247,7 +244,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld(fldListFr(complnd)%flds, 'Sl_lfrin') call addfld(fldListFr(compocn)%flds, 'So_omask') call addfld(fldListFr(compice)%flds, 'Si_imask') - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets call addfld(fldlistFr(compglc(ns))%flds, 'Sg_area') end do else @@ -716,7 +713,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! fields from med->lnd are in multiple elevation classes if (phase == 'advertise') then - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets call addfld(fldListFr(compglc(ns))%flds, 'Sg_icemask') ! ice sheet grid coverage call addfld(fldListFr(compglc(ns))%flds, 'Sg_icemask_coupled_fluxes') call addfld(fldListFr(compglc(ns))%flds, 'Sg_ice_covered') ! fraction of glacier area @@ -732,7 +729,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! custom merge in med_phases_prep_lnd for Sg_icemask and Sg_icemask_coupled_fluxes ! custom map merge in med_phases_prep_lnd for Sg_ice_covered_elev, Sg_topo_elev and Flgg_hflx_elev if ( fldchk(is_local%wrap%FBExp(complnd), 'Sg_icemask', rc=rc)) then - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Sg_icemask', rc=rc)) then call addmap(fldListFr(compglc(ns))%flds, 'Sg_icemask', & complnd, mapconsd, 'one', 'unset') @@ -740,7 +737,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end do end if if ( fldchk(is_local%wrap%FBExp(complnd), 'Sg_icemask_coupled_fluxes', rc=rc)) then - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Sg_icemask_coupled_fluxes', rc=rc)) then call addmap(fldListFr(compglc(ns))%flds, 'Sg_icemask_coupled_fluxes', & complnd, mapconsd, 'one', 'unset') @@ -2098,13 +2095,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Note that Flrr_flood below needs to be added to ! fldlistFr(comprof) in order to be mapped correctly but the ocean ! does not receive it so it is advertised but it will! not be connected - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets call addfld(fldListFr(compglc(ns))%flds, 'Fogg_rofl') end do call addfld(fldListFr(comprof)%flds, 'Forr_rofl') call addfld(fldListTo(compocn)%flds, 'Foxx_rofl') call addfld(fldListTo(compocn)%flds, 'Flrr_flood') - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets call addfld(fldListFr(compglc(ns))%flds, 'Fogg_rofi') end do call addfld(fldListFr(comprof)%flds, 'Forr_rofi') @@ -2126,7 +2123,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if ! liquid from glc to ocean - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofl' , rc=rc)) then ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? call addmap(fldListFr(compglc(ns))%flds, 'Fogg_rofl', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) @@ -2145,7 +2142,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') end if ! ice from glc to ocean - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofi' , rc=rc)) then ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? call addmap(fldListFr(compglc(ns))%flds, 'Fogg_rofi', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) @@ -2157,13 +2154,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_wiso) then if (phase == 'advertise') then - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets call addfld(fldListFr(compglc(ns))%flds, 'Fogg_rofl_wiso') end do call addfld(fldListFr(comprof)%flds, 'Forr_rofl_wiso') call addfld(fldListTo(compocn)%flds, 'Foxx_rofl_wiso') call addfld(fldListTo(compocn)%flds, 'Flrr_flood_wiso') - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets call addfld(fldListFr(compglc(ns))%flds, 'Fogg_rofi_wiso') end do call addfld(fldListFr(comprof)%flds, 'Forr_rofi_wiso') @@ -2187,7 +2184,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if ! liquid from glc to ocean - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofl_wiso' , rc=rc)) then ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? call addmap(fldListFr(compglc(ns))%flds, 'Fogg_rofl_wiso', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) @@ -2207,7 +2204,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi_wiso', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') end if ! ice from glc to ocean - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofi_wiso' , rc=rc)) then ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? call addmap(fldListFr(compglc(ns))%flds, 'Fogg_rofi_wiso', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) @@ -2741,7 +2738,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- if (phase == 'advertise') then call addfld(fldListFr(comprof)%flds, 'Firr_rofi') ! water flux into sea ice due to runoff (frozen) - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets call addfld(fldListFr(compglc(ns))%flds, 'Figg_rofi') ! glc frozen runoff_iceberg flux to ice end do call addfld(fldListTo(compice)%flds, 'Fixx_rofi') ! total frozen water flux into sea ice @@ -2751,7 +2748,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap(fldListFr(comprof)%flds, 'Forr_rofi', compice, mapconsf, 'none', rof2ocn_ice_rmap) call addmrg(fldListTo(compice)%flds, 'Fixx_rofi', mrg_from=comprof, mrg_fld='Firr_rofi', mrg_type='sum') end if - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Figg_rofi', rc=rc)) then call addmap(fldListFr(compglc(ns))%flds, 'Figg_rofi', compice, mapconsf, 'one' , glc2ice_rmap) call addmrg(fldListTo(compice)%flds, 'Fixx_rofi', mrg_from=compglc(ns), mrg_fld='Figg_rofi', mrg_type='sum') @@ -2762,7 +2759,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_wiso) then if (phase == 'advertise') then call addfld(fldListFr(comprof)%flds, 'Firr_rofi_wiso') ! water flux into sea ice due to runoff (frozen) - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets call addfld(fldListFr(compglc(ns))%flds, 'Figg_rofi_wiso') ! glc frozen runoff_iceberg flux to ice end do call addfld(fldListTo(compice)%flds, 'Fixx_rofi_wiso') ! total frozen water flux into sea ice @@ -2773,7 +2770,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg(fldListTo(compice)%flds, 'Fixx_rofi_wiso', & mrg_from=comprof, mrg_fld='Firr_rofi_wiso', mrg_type='sum') end if - do ns = 1, num_icesheets + do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Figg_rofi_wiso', rc=rc)) then call addmap(fldListFr(compglc(ns))%flds, 'Figg_rofi_wiso', compice, mapconsf, 'one' , glc2ice_rmap) call addmrg(fldListTo(compice)%flds, 'Fixx_rofi_wiso', & @@ -2994,13 +2991,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld(fldListFr(complnd)%flds, 'Sl_tsrf_elev') ! surface temperature of glacier (1->glc_nec+1) call addfld(fldListFr(complnd)%flds, 'Sl_topo_elev') ! surface heights of glacier (1->glc_nec+1) call addfld(fldListFr(complnd)%flds, 'Flgl_qice_elev') ! glacier ice flux (1->glc_nec+1) - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets call addfld(fldListTo(compglc(ns))%flds, 'Sl_tsrf') call addfld(fldListTo(compglc(ns))%flds, 'Flgl_qice') end do else ! custom mapping, accumulation and merging will be done in prep_glc_mod.F90 - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Flgl_qice_elev', rc=rc)) then call addmap(FldListFr(complnd)%flds, 'Flgl_qice_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') end if @@ -3017,18 +3014,18 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------- ! to glc: from ocn !----------------------------- - if (ocn2glc_coupling) then + if (is_local%wrap%ocn2glc_coupling) then if (phase == 'advertise') then call addfld(fldListFr(compocn)%flds, 'So_t_depth') call addfld(fldListFr(compocn)%flds, 'So_s_depth') - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets call addfld(fldListTo(compglc(ns))%flds, 'So_t_depth') call addfld(fldListTo(compglc(ns))%flds, 'So_s_depth') end do else ! custom mapping, accumulation and merging will be done in prep_glc_mod.F90 ! the following is used to create the route handle - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if ( fldchk(is_local%wrap%FBImp(compocn,compocn) , 'So_t_depth', rc=rc)) then call addmap(FldListFr(compocn)%flds, 'So_t_depth', compglc(ns), mapbilnr, 'none', 'unset') end if diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 5f8537221..605e8d080 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -2,19 +2,19 @@ module esmFldsExchange_hafs_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 esmflds, only : compmed - use esmflds, only : compatm - use esmflds, only : compocn - use esmflds, only : compwav - use esmflds, only : ncomps - use esmflds, only : fldListTo - use esmflds, only : fldListFr - use esmFlds, only : coupling_mode + 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 + use med_internalstate_mod , only : compatm + use med_internalstate_mod , only : compocn + use med_internalstate_mod , only : compwav + 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 @@ -88,7 +88,7 @@ end subroutine esmFldsExchange_hafs subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) - use esmFlds , only : addfld => med_fldList_AddFld + use esmFlds, only : addfld => med_fldList_AddFld ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -294,13 +294,13 @@ subroutine esmFldsExchange_hafs_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 - use esmflds , only : mapbilnr, mapconsf, mapconsd, mappatch - use esmflds , only : mapfcopy, mapnstod, mapnstod_consd - use esmflds , only : mapfillv_bilnr - use esmflds , only : mapnstod_consf ! input/output parameters: type(ESMF_GridComp) :: gcomp diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 2d47ed4a2..47e045635 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -24,15 +24,16 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use NUOPC use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_utils_mod , only : chkerr => med_utils_chkerr + use med_internalstate_mod , only : mastertask, logunit + use med_internalstate_mod , only : compmed, compatm, compocn, compice, comprof, ncomps + use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch + use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf + use med_internalstate_mod , only : mapconsf_aofrac + use med_internalstate_mod , only : coupling_mode, mapnames use esmFlds , only : med_fldList_type use esmFlds , only : addfld => med_fldList_AddFld use esmFlds , only : addmap => med_fldList_AddMap use esmFlds , only : addmrg => med_fldList_AddMrg - use esmflds , only : compmed, compatm, compocn, compice, comprof, ncomps - use esmflds , only : mapbilnr, mapconsf, mapconsd, mappatch - use esmflds , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf - use esmflds , only : mapconsf_aofrac - use esmflds , only : coupling_mode, mapnames use esmflds , only : fldListTo, fldListFr, fldListMed_aoflux, fldListMed_ocnalb use med_internalstate_mod , only : InternalState, mastertask, logunit diff --git a/mediator/med.F90 b/mediator/med.F90 index 308af3023..130774c4c 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -41,24 +41,19 @@ module MED use med_methods_mod , only : clock_timeprint => med_methods_clock_timeprint use med_utils_mod , only : memcheck => med_memcheck use med_time_mod , only : med_time_alarmInit - use med_internalstate_mod , only : InternalState - use med_internalstate_mod , only : med_coupling_allowed, logunit, mastertask - use med_phases_profile_mod , only : med_phases_profile_finalize - use esmFlds , only : ncomps, compname - use esmFlds , only : fldListFr, fldListTo, med_fldList_Realize - use esmFlds , only : ncomps, compname, ncomps - use esmFlds , only : compmed, compatm, compocn, compice, complnd, comprof, compwav ! not arrays - use esmFlds , only : num_icesheets, max_icesheets, compglc ! compglc is an array - use esmFlds , only : ocn2glc_coupling, lnd2glc_coupling, accum_lnd2glc + use med_internalstate_mod , only : InternalState, med_internalstate_init, med_internalstate_coupling + use med_internalstate_mod , only : logunit, mastertask + use med_internalstate_mod , only : ncomps, compname + use med_internalstate_mod , only : compmed, compatm, compocn, compice, complnd, comprof, compwav, compglc + use med_internalstate_mod , only : coupling_mode use esmFlds , only : fldListMed_ocnalb use esmFlds , only : med_fldList_GetNumFlds, med_fldList_GetFldNames, med_fldList_GetFldInfo use esmFlds , only : med_fldList_Document_Mapping, med_fldList_Document_Merging - use esmFlds , only : coupling_mode - use esmFlds , only : med_name, atm_name, lnd_name, ocn_name - use esmFlds , only : ice_name, rof_name, wav_name, glc_name + use esmFlds , only : fldListFr, fldListTo, med_fldList_Realize use esmFldsExchange_nems_mod , only : esmFldsExchange_nems use esmFldsExchange_cesm_mod , only : esmFldsExchange_cesm use esmFldsExchange_hafs_mod , only : esmFldsExchange_hafs + use med_phases_profile_mod , only : med_phases_profile_finalize implicit none private @@ -76,15 +71,12 @@ module MED private med_grid_write private med_finalize - character(len=*), parameter :: grid_arbopt = "grid_reg" ! grid_reg or grid_arb character(len=*), parameter :: u_FILE_u = & __FILE__ + logical :: profile_memory = .false. - character(len=8) :: atm_present, lnd_present - character(len=8) :: ice_present, rof_present - character(len=8) :: glc_present, med_present - character(len=8) :: ocn_present, wav_present + logical, allocatable :: compDone(:) ! component done flag !----------------------------------------------------------------------------- contains @@ -547,7 +539,6 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_METHOD_INITIALIZE use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_CompAttributeGet use med_internalstate_mod, only : mastertask, logunit, diagunit - use esmFlds, only : dststatus_print type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -630,13 +621,6 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) write(msgString,'(A,i6)') trim(subname)//': Mediator dbug_flag is ',dbug_flag call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - ! Obtain dststatus_print setting if present - call NUOPC_CompAttributeGet(gcomp, name='dststatus_print', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) dststatus_print=(trim(cvalue)=="true") - write(msgString,*) trim(subname)//': Mediator dststatus_print is ',dststatus_print - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - ! Switch to IPDv03 by filtering all other phaseMap entries call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, acceptStringList=(/"IPDv03p"/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -654,11 +638,13 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) ! TransferOfferGeomObject Attribute. use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_SUCCESS, ESMF_LogFoundAllocError - use ESMF , only : ESMF_StateIsCreated + use ESMF , only : ESMF_StateIsCreated use ESMF , only : ESMF_LogMsg_Info, ESMF_LogWrite use ESMF , only : ESMF_END_ABORT, ESMF_Finalize, ESMF_MAXSTR use NUOPC , only : NUOPC_AddNamespace, NUOPC_Advertise, NUOPC_AddNestedState use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd + use esmFlds, only : med_fldlist_init1 + use med_phases_history_mod, only : med_phases_history_init ! input/output variables type(ESMF_GridComp) :: gcomp @@ -675,9 +661,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) character(len=8) :: cnum type(InternalState) :: is_local integer :: stat - character(len=CS) :: attrList(8) - character(len=ESMF_MAXSTR) :: mesh_glc - character(len=*),parameter :: subname=' (InitializeIPDv03p1) ' + character(len=*),parameter :: subname=' (Advertise Fields) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -685,7 +669,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) if (profile_memory) call ESMF_VMLogMemInfo("Entering "//trim(subname)) !------------------ - ! Allocate memory for the internal state and set it in the Component. + ! Allocate memory for the internal state !------------------ allocate(is_local%wrap, stat=stat) @@ -697,6 +681,14 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) call ESMF_GridCompSetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_internalstate_init(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! Allocate memory for history module variables + !------------------ + call med_phases_history_init() + !------------------ ! add a namespace (i.e. nested state) for each import and export component state in the mediator's InternalState !------------------ @@ -735,23 +727,8 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) call NUOPC_AddNamespace(exportState, namespace="WAV", nestedStateName="WavExp", & nestedState=is_local%wrap%NStateExp(compwav), rc=rc) - ! Only create nested states for active ice sheets - call NUOPC_CompAttributeGet(gcomp, name='mesh_glc', value=mesh_glc, isPresent=isPresent, isSet=isSet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - num_icesheets = 0 - if (isPresent .and. isSet) then - ! determine number of ice sheets - search in mesh_glc for colon deliminted strings - if (len_trim(cvalue) > 0) then - do n = 1, len_trim(mesh_glc) - if (mesh_glc(n:n) == ':') num_icesheets = num_icesheets + 1 - end do - num_icesheets = num_icesheets + 1 - endif - if (mastertask) then - write(logunit,'(a,i8)') trim(subname)//' number of ice sheets is ',num_icesheets - end if - end if - do ns = 1,num_icesheets + ! Only create nested states for active land-ice sheets + do ns = 1,is_local%wrap%num_icesheets write(cnum,'(i0)') ns call NUOPC_AddNestedState(importState, CplSet="GLC"//trim(cnum), & nestedState=is_local%wrap%NStateImp(compglc(ns)), rc=rc) @@ -783,6 +760,10 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) write(logunit,*) end if + ! Initialize memory for fldlistTo and fldlistFr - this is need for the calls below for the + ! advertise phase + call med_fldlist_init1() + if (trim(coupling_mode) == 'cesm') then call esmFldsExchange_cesm(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -802,112 +783,6 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) ! Determine component present indices !------------------ - call NUOPC_CompAttributeAdd(gcomp, & - attrList=(/'atm_present','lnd_present','ocn_present','ice_present',& - 'rof_present','wav_present','glc_present','med_present'/), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - med_present = "false" - atm_present = "false" - lnd_present = "false" - ocn_present = "false" - ice_present = "false" - rof_present = "false" - wav_present = "false" - glc_present = "false" - - ! Note that the present flag is set to true if the component is not stub - call NUOPC_CompAttributeGet(gcomp, name='ATM_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - if (trim(cvalue) /= 'satm') atm_present = "true" - atm_name = trim(cvalue) - end if - - call NUOPC_CompAttributeGet(gcomp, name='LND_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - if (trim(cvalue) /= 'slnd') lnd_present = "true" - lnd_name = trim(cvalue) - end if - - call NUOPC_CompAttributeGet(gcomp, name='OCN_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - if (trim(cvalue) /= 'socn') ocn_present = "true" - ocn_name = trim(cvalue) - end if - - call NUOPC_CompAttributeGet(gcomp, name='ICE_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - if (trim(cvalue) /= 'sice') ice_present = "true" - ice_name = trim(cvalue) - end if - - call NUOPC_CompAttributeGet(gcomp, name='ROF_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - if (trim(cvalue) /= 'srof') rof_present = "true" - rof_name = trim(cvalue) - end if - - call NUOPC_CompAttributeGet(gcomp, name='WAV_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - if (trim(cvalue) /= 'swav') wav_present = "true" - wav_name = trim(cvalue) - end if - - call NUOPC_CompAttributeGet(gcomp, name='GLC_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - if (trim(cvalue) /= 'sglc') glc_present = "true" - glc_name = trim(cvalue) - end if - - call NUOPC_CompAttributeGet(gcomp, name='MED_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - med_name = trim(cvalue) - end if - - call NUOPC_CompAttributeGet(gcomp, name='mediator_present', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - med_present = trim(cvalue) - end if - - call NUOPC_CompAttributeSet(gcomp, name="atm_present", value=atm_present, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="lnd_present", value=lnd_present, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="ocn_present", value=ocn_present, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="ice_present", value=ice_present, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="rof_present", value=rof_present, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="wav_present", value=trim(wav_present), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="glc_present", value=trim(glc_present), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="med_present", value=med_present, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (mastertask) then - write(logunit,*) - if (trim(atm_present).eq."true") write(logunit,*) "atm_name="//trim(atm_name) - if (trim(lnd_present).eq."true") write(logunit,*) "lnd_name="//trim(lnd_name) - if (trim(ocn_present).eq."true") write(logunit,*) "ocn_name="//trim(ocn_name) - if (trim(ice_present).eq."true") write(logunit,*) "ice_name="//trim(ice_name) - if (trim(rof_present).eq."true") write(logunit,*) "rof_name="//trim(rof_name) - if (trim(wav_present).eq."true") write(logunit,*) "wav_name="//trim(wav_name) - if (trim(glc_present).eq."true") write(logunit,*) "glc_name="//trim(glc_name) - if (trim(med_present).eq."true") write(logunit,*) "med_name="//trim(med_name) - write(logunit,*) - end if - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return is_local%wrap%flds_scalar_name = trim(cvalue) @@ -948,44 +823,40 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) do ncomp = 1,ncomps if (ncomp /= compmed) then if (mastertask) write(logunit,*) - if (ESMF_StateIsCreated(is_local%wrap%NStateImp(ncomp))) then - nflds = med_fldList_GetNumFlds(fldListFr(ncomp)) - do n = 1,nflds - call med_fldList_GetFldInfo(fldListFr(ncomp), n, stdname, shortname) - if (mastertask) then - write(logunit,'(a)') trim(subname)//':Fr_'//trim(compname(ncomp))//': '//trim(shortname) - end if - if (trim(shortname) == is_local%wrap%flds_scalar_name) then - transferOffer = 'will provide' - else - transferOffer = 'cannot provide' - end if - call NUOPC_Advertise(is_local%wrap%NStateImp(ncomp), & - standardName=stdname, shortname=shortname, name=shortname, & - TransferOfferGeomObject=transferOffer, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//':Fr_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) - end do - end if - if (ESMF_StateIsCreated(is_local%wrap%NStateExp(ncomp))) then - nflds = med_fldList_GetNumFlds(fldListTo(ncomp)) - do n = 1,nflds - call med_fldList_GetFldInfo(fldListTo(ncomp), n, stdname, shortname) - if (mastertask) then - write(logunit,'(a)') trim(subname)//':To_'//trim(compname(ncomp))//': '//trim(shortname) - end if - if (trim(shortname) == is_local%wrap%flds_scalar_name) then - transferOffer = 'will provide' - else - transferOffer = 'cannot provide' - end if - call NUOPC_Advertise(is_local%wrap%NStateExp(ncomp), & - standardName=stdname, shortname=shortname, name=shortname, & - TransferOfferGeomObject=transferOffer, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//':To_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) - end do - end if + nflds = med_fldList_GetNumFlds(fldListFr(ncomp)) + do n = 1,nflds + call med_fldList_GetFldInfo(fldListFr(ncomp), n, stdname, shortname) + if (mastertask) then + write(logunit,'(a)') trim(subname)//':Fr_'//trim(compname(ncomp))//': '//trim(shortname) + end if + if (trim(shortname) == is_local%wrap%flds_scalar_name) then + transferOffer = 'will provide' + else + transferOffer = 'cannot provide' + end if + call NUOPC_Advertise(is_local%wrap%NStateImp(ncomp), & + standardName=stdname, shortname=shortname, name=shortname, & + TransferOfferGeomObject=transferOffer, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//':Fr_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) + end do + nflds = med_fldList_GetNumFlds(fldListTo(ncomp)) + do n = 1,nflds + call med_fldList_GetFldInfo(fldListTo(ncomp), n, stdname, shortname) + if (mastertask) then + write(logunit,'(a)') trim(subname)//':To_'//trim(compname(ncomp))//': '//trim(shortname) + end if + if (trim(shortname) == is_local%wrap%flds_scalar_name) then + transferOffer = 'will provide' + else + transferOffer = 'cannot provide' + end if + call NUOPC_Advertise(is_local%wrap%NStateExp(ncomp), & + standardName=stdname, shortname=shortname, name=shortname, & + TransferOfferGeomObject=transferOffer, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//':To_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) + end do end if end do ! end of ncomps loop @@ -1016,7 +887,7 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) type(InternalState) :: is_local type(ESMF_VM) :: vm integer :: n - character(len=*),parameter :: subname=' (InitializeIPDv03p3) ' + character(len=*),parameter :: subname=' (Realize Fields with Transfer Provide) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1077,7 +948,7 @@ subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) ! local variables type(InternalState) :: is_local integer :: n1,n2 - character(len=*),parameter :: subname=' (InitalizeIPDv03p4) ' + character(len=*),parameter :: subname=' (Modify Decomp of Mesh/Grid) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1405,7 +1276,7 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) ! local variables type(InternalState) :: is_local integer :: n1,n2 - character(len=*),parameter :: subname=' (module_MED:InitializeIPDv03p5) ' + character(len=*),parameter :: subname=' (Realize Fields with Transfer Accept) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1477,7 +1348,7 @@ subroutine completeFieldInitialization(State,rc) integer, allocatable :: ungriddedLBound(:), ungriddedUBound(:) logical :: isPresent logical :: meshcreated - character(len=*),parameter :: subname=' (module_MED:completeFieldInitialization) ' + character(len=*),parameter :: subname=' (Complete Field Initialization) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1665,16 +1536,14 @@ subroutine DataInitialize(gcomp, rc) character(ESMF_MAXSTR),allocatable :: fieldNameList(:) character(CL), pointer :: fldnames(:) character(CL) :: cvalue - character(CL) :: cname character(CL) :: start_type logical :: read_restart logical :: isPresent, isSet logical :: allDone = .false. - logical,save :: compDone(ncomps) logical,save :: first_call = .true. real(r8) :: real_nx, real_ny character(len=CX) :: msgString - character(len=*), parameter :: subname=' (DataInitialize) ' + character(len=*), parameter :: subname=' (Data Initialization) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1703,168 +1572,12 @@ subroutine DataInitialize(gcomp, rc) if (first_call) then - !---------------------------------------------------------- - ! Initialize mediator present flags - !---------------------------------------------------------- - - if (mastertask) then - write(logunit,'(a)') trim(subname) // "Initializing present flags" - end if - - do n1 = 1,ncomps - cname = trim(compname(n1)) - if (cname(1:3) == 'glc') then - ! Special logic for glc since there can be multiple ice sheets - call ESMF_AttributeGet(gcomp, name="glc_present", value=cvalue, & - convention="NUOPC", purpose="Instance", rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do ns = 1,max_icesheets - if (ns <= num_icesheets) then - if (trim(cvalue) == 'true') then - is_local%wrap%comp_present(compglc(ns)) = .true. - else - is_local%wrap%comp_present(compglc(ns)) = .false. - end if - end if - end do - else - call ESMF_AttributeGet(gcomp, name=trim(compname(n1))//"_present", value=cvalue, & - convention="NUOPC", purpose="Instance", rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(cvalue) == "true") then - is_local%wrap%comp_present(n1) = .true. - else - is_local%wrap%comp_present(n1) = .false. - end if - end if - if (mastertask) then - write(msgString,'(A,L4)') trim(subname)//' comp_present(comp'//trim(compname(n1))//') = ',& - is_local%wrap%comp_present(n1) - write(logunit,'(a)') trim(subname) // trim(msgString) - end if - end do - - !---------------------------------------------------------- - ! Check for active coupling interactions - ! must be allowed, bundles created, and both sides have some fields - !---------------------------------------------------------- - - ! This defines the med_coupling_allowed is a starting point for what is - ! allowed in this coupled system. It will be revised further after the system - ! starts, but any coupling set to false will never be allowed. - ! are allowed, just update the table below. - - if (mastertask) then - write(logunit,'(a)') trim(subname) // "Initializing active coupling flags" - end if + ! Allocate module variable + allocate(compDone(ncomps)) - ! Initialize med_coupling_allowed - med_coupling_allowed(:,:) = .false. - - ! to atmosphere - med_coupling_allowed(complnd,compatm) = .true. - med_coupling_allowed(compice,compatm) = .true. - med_coupling_allowed(compocn,compatm) = .true. - med_coupling_allowed(compwav,compatm) = .true. - - ! to land - med_coupling_allowed(compatm,complnd) = .true. - med_coupling_allowed(comprof,complnd) = .true. - do ns = 1,num_icesheets - med_coupling_allowed(compglc(ns),complnd) = .true. - end do - - ! to ocean - med_coupling_allowed(compatm,compocn) = .true. - med_coupling_allowed(compice,compocn) = .true. - med_coupling_allowed(comprof,compocn) = .true. - med_coupling_allowed(compwav,compocn) = .true. - do ns = 1,num_icesheets - med_coupling_allowed(compglc(ns),compocn) = .true. - end do - - ! to ice - med_coupling_allowed(compatm,compice) = .true. - med_coupling_allowed(compocn,compice) = .true. - med_coupling_allowed(comprof,compice) = .true. - med_coupling_allowed(compwav,compice) = .true. - do ns = 1,num_icesheets - med_coupling_allowed(compglc(ns),compice) = .true. - end do - - ! to river - med_coupling_allowed(complnd,comprof) = .true. - - ! to wave - med_coupling_allowed(compatm,compwav) = .true. - med_coupling_allowed(compocn,compwav) = .true. - med_coupling_allowed(compice,compwav) = .true. - - ! to land-ice - do ns = 1,num_icesheets - med_coupling_allowed(complnd,compglc(ns)) = .true. - med_coupling_allowed(compocn,compglc(ns)) = .true. - end do - - ! initialize med_coupling_active table - is_local%wrap%med_coupling_active(:,:) = .false. - do n1 = 1,ncomps - if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then - call State_GetNumFields(is_local%wrap%NStateImp(n1), cntn1, rc=rc) ! Import Field Count - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (cntn1 > 0) then - do n2 = 1,ncomps - if (is_local%wrap%comp_present(n2) .and. ESMF_StateIsCreated(is_local%wrap%NStateExp(n2),rc=rc) .and. & - med_coupling_allowed(n1,n2)) then - call State_GetNumFields(is_local%wrap%NStateExp(n2), cntn2, rc=rc) ! Import Field Count - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (cntn2 > 0) then - is_local%wrap%med_coupling_active(n1,n2) = .true. - endif - endif - enddo - end if - endif - enddo - - ! Reset ocn2glc active coupling based in input attribute - if (.not. ocn2glc_coupling) then - do ns = 1,num_icesheets - is_local%wrap%med_coupling_active(compocn,compglc(ns)) = .false. - end do - end if - - ! create tables of allowed and active coupling flags - ! - the rows are the destination of coupling - ! - the columns are the source of coupling - ! - So, the second column indicates which models the atm is coupled to. - ! - And the second row indicates which models are coupled to the atm. - if (mastertask) then - write(logunit,*) ' ' - write(logunit,'(A)') trim(subname)//' Allowed coupling flags' - write(logunit,'(2x,A10,20(A5))') '|from to->',(compname(n2),n2=1,ncomps) - do n1 = 1,ncomps - write(msgString,'(2x,a1,A,5x,20(L5))') '|',trim(compname(n1)), & - (med_coupling_allowed(n1,n2),n2=1,ncomps) - do n2 = 1,len_trim(msgString) - if (msgString(n2:n2) == 'F') msgString(n2:n2)='-' - enddo - write(logunit,'(A)') trim(msgString) - enddo - - write(logunit,*) ' ' - write(logunit,'(A)') subname//' Active coupling flags' - write(logunit,'(2x,A10,20(A5))') '|from to->',(compname(n2),n2=1,ncomps) - do n1 = 1,ncomps - write(msgString,'(2x,a1,A,5x,20(L5))') '|',trim(compname(n1)), & - (is_local%wrap%med_coupling_active(n1,n2),n2=1,ncomps) - do n2 = 1,len_trim(msgString) - if (msgString(n2:n2) == 'F') msgString(n2:n2)='-' - enddo - write(logunit,'(A)') trim(msgString) - enddo - write(logunit,*) ' ' - endif + ! Determine active coupling logical flags + call med_internalstate_coupling(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------- ! Create field bundles FBImp, FBExp @@ -2010,6 +1723,9 @@ subroutine DataInitialize(gcomp, rc) ! Determine mapping and merging info for field exchanges in mediator !--------------------------------------- + ! Initialize memory for fldlistFr(:)%flds(:) and fldlistTo(:)%flds(:) - this is needed for + ! call below for the initialize phase + if (trim(coupling_mode) == 'cesm') then call esmFldsExchange_cesm(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2071,27 +1787,7 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- ! Initialize glc module field bundles here if appropriate !--------------------------------------- - do ns = 1,num_icesheets - if (is_local%wrap%med_coupling_active(complnd,compglc(ns))) then - lnd2glc_coupling = .true. - exit - end if - end do - if (lnd2glc_coupling) then - accum_lnd2glc = .true. - else - ! Determine if will create auxiliary history file that contains - ! lnd2glc data averaged over the year - call NUOPC_CompAttributeGet(gcomp, name="histaux_l2x1yrg", value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) accum_lnd2glc - else - accum_lnd2glc = .false. - end if - end if - if (lnd2glc_coupling .or. ocn2glc_coupling .or. accum_lnd2glc) then + if (is_local%wrap%lnd2glc_coupling .or. is_local%wrap%ocn2glc_coupling .or. is_local%wrap%accum_lnd2glc) then call med_phases_prep_glc_init(gcomp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -2107,7 +1803,6 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- ! Set the data initialize flag to false !--------------------------------------- - call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2226,7 +1921,7 @@ subroutine DataInitialize(gcomp, rc) deallocate(fieldNameList) if (.not. compDone(compatm)) then ! atmdone is not true - if (trim(lnd_present) == 'true') then + if (is_local%wrap%comp_present(complnd)) then ! map initial lnd->atm call med_phases_post_lnd(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2363,37 +2058,37 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- ! Call post routines as part of initialization !--------------------------------------- - if (trim(atm_present) == 'true') then + if (is_local%wrap%comp_present(compatm)) then ! map atm->ocn, atm->ice, atm->lnd call med_phases_post_atm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (trim(ice_present) == 'true') then + if (is_local%wrap%comp_present(compice)) then ! call set ice_frac and map ice->atm and ice->ocn call med_phases_post_ice(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (trim(glc_present) == 'true') then + if (allocated(compglc)) then ! map initial glc->lnd, glc->ocn and glc->ice call med_phases_post_glc(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (trim(lnd_present) == 'true') then + if (is_local%wrap%comp_present(complnd)) then ! map initial lnd->atm call med_phases_post_lnd(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (trim(ocn_present) == 'true') then + if (is_local%wrap%comp_present(compocn)) then ! map initial ocn->ice call med_phases_post_ocn(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (trim(rof_present) == 'true') then + if (is_local%wrap%comp_present(comprof)) then ! map initial rof->lnd, rof->ocn and rof->ice call med_phases_post_rof(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (trim(wav_present) == 'true') then + if (is_local%wrap%comp_present(compwav)) then ! map initial wav->ocn and wav->ice call med_phases_post_wav(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2401,6 +2096,7 @@ subroutine DataInitialize(gcomp, rc) call med_phases_profile(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + else ! Not all done call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2444,7 +2140,7 @@ subroutine SetRunClock(gcomp, rc) logical, save :: stopalarmcreated=.false. integer :: alarmcount - character(len=*),parameter :: subname=' (module_MED:SetRunClock) ' + character(len=*),parameter :: subname=' (Set Run Clock) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -2602,7 +2298,7 @@ subroutine med_grid_write(grid, fileName, rc) type(ESMF_ArrayBundle) :: arrayBundle integer :: tileCount logical :: isPresent - character(len=*), parameter :: subname=' (module_MED_map:med_grid_write) ' + character(len=*), parameter :: subname=' (Grid Write) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 8f15f625e..ca8583803 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -617,7 +617,7 @@ subroutine med_phases_diag_atm(gcomp, rc) ! Compute global atm input/output flux diagnostics ! ------------------------------------------------------------------ - use esmFlds, only : compatm + use med_internalstate_mod, only : compatm ! input/output variables type(ESMF_GridComp) :: gcomp @@ -946,7 +946,7 @@ subroutine med_phases_diag_lnd( gcomp, rc) ! Compute global lnd input/output flux diagnostics ! ------------------------------------------------------------------ - use esmFlds, only : complnd + use med_internalstate_mod, only : complnd ! intput/output variables type(ESMF_GridComp) :: gcomp @@ -1147,7 +1147,7 @@ subroutine med_phases_diag_rof( gcomp, rc) ! Compute global river input/output ! ------------------------------------------------------------------ - use esmFlds, only : comprof + use med_internalstate_mod, only : comprof ! input/output variables type(ESMF_GridComp) :: gcomp @@ -1308,7 +1308,7 @@ subroutine med_phases_diag_glc( gcomp, rc) ! Compute global glc output ! ------------------------------------------------------------------ - use esmFlds, only : compglc, num_icesheets + use med_internalstate_mod, only : compglc ! input/output variables type(ESMF_GridComp) :: gcomp @@ -1337,7 +1337,7 @@ subroutine med_phases_diag_glc( gcomp, rc) ic = c_glc_recv ip = period_inst - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets areas => is_local%wrap%mesh_info(compglc(ns))%areas call diag_glc(is_local%wrap%FBImp(compglc(ns),compglc(ns)), 'Fogg_rofl', f_watr_roff, ic, areas, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1389,7 +1389,7 @@ subroutine med_phases_diag_ocn( gcomp, rc) ! Compute global ocn input from mediator ! ------------------------------------------------------------------ - use esmFlds, only : compocn, compatm + use med_internalstate_mod, only : compocn, compatm ! input/output variables type(ESMF_GridComp) :: gcomp @@ -1627,7 +1627,7 @@ subroutine med_phases_diag_ice_ice2med( gcomp, rc) ! Compute global ice input/output flux diagnostics ! ------------------------------------------------------------------ - use esmFlds, only : compice + use med_internalstate_mod, only : compice ! input/output variables type(ESMF_GridComp) :: gcomp @@ -1825,7 +1825,7 @@ subroutine med_phases_diag_ice_med2ice( gcomp, rc) ! Compute global ice input/output flux diagnostics ! ------------------------------------------------------------------ - use esmFlds, only : compice + use med_internalstate_mod, only : compice ! input/output variables type(ESMF_GridComp) :: gcomp diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index a4d44353b..a4cc06052 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -97,19 +97,19 @@ module med_fraction_mod ! !----------------------------------------------------------------------------- - use med_kind_mod , only : CX =>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_constants_mod , only : czero => med_constants_czero - use med_utils_mod , only : chkErr => med_utils_ChkErr - use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose - use med_methods_mod , only : fldbun_fldchk => med_methods_FB_fldchk - use med_methods_mod , only : fldbun_getmesh => med_methods_FB_getmesh - use med_methods_mod , only : fldbun_getdata2d => med_methods_FB_getdata2d - use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d - use med_methods_mod , only : fldbun_init => med_methods_FB_init - use med_methods_mod , only : fldbun_reset => med_methods_FB_reset - use med_map_mod , only : med_map_field - use esmFlds , only : ncomps, max_icesheets, num_icesheets + use med_kind_mod , only : CX =>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use med_constants_mod , only : czero => med_constants_czero + use med_utils_mod , only : chkErr => med_utils_ChkErr + use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose + use med_methods_mod , only : fldbun_fldchk => med_methods_FB_fldchk + use med_methods_mod , only : fldbun_getmesh => med_methods_FB_getmesh + use med_methods_mod , only : fldbun_getdata2d => med_methods_FB_getdata2d + use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d + use med_methods_mod , only : fldbun_init => med_methods_FB_init + 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 implicit none private @@ -119,7 +119,7 @@ module med_fraction_mod public med_fraction_set integer, parameter :: nfracs = 5 - character(len=6) :: fraclist(nfracs,ncomps) + character(len=6),allocatable :: fraclist(:,:) character(len=6),parameter,dimension(4) :: fraclist_a = (/'ifrac ','ofrac ','lfrac ','aofrac'/) character(len=6),parameter,dimension(4) :: fraclist_o = (/'ifrac ','ofrac ','ifrad ','ofrad '/) character(len=6),parameter,dimension(2) :: fraclist_i = (/'ifrac ','ofrac '/) @@ -148,13 +148,13 @@ subroutine med_fraction_init(gcomp, rc) use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleDestroy use ESMF , only : ESMF_FieldBundleGet use ESMF , only : ESMF_Field, ESMF_FieldGet - use esmFlds , only : coupling_mode - use esmFlds , only : compatm, compocn, compice, complnd - use esmFlds , only : comprof, compglc, compwav, compname - use esmFlds , only : mapfcopy, mapconsd, mapnstod_consd + use med_internalstate_mod , only : coupling_mode + use med_internalstate_mod , only : compatm, compocn, compice, complnd + use med_internalstate_mod , only : comprof, compglc, compwav, compname + use med_internalstate_mod , only : mapfcopy, mapconsd, mapnstod_consd + use med_internalstate_mod , only : InternalState, logunit, mastertask use med_map_mod , only : med_map_routehandles_init, med_map_rh_is_created use med_methods_mod , only : State_getNumFields => med_methods_State_getNumFields - use med_internalstate_mod , only : InternalState, logunit, mastertask use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -198,6 +198,9 @@ subroutine med_fraction_init(gcomp, rc) if (first_call) then + ! allocate module variable + allocate(fraclist(nfracs,ncomps)) + !--------------------------------------- ! Initialize the fraclist arrays !--------------------------------------- @@ -209,7 +212,7 @@ subroutine med_fraction_init(gcomp, rc) fraclist(1:size(fraclist_l),complnd) = fraclist_l fraclist(1:size(fraclist_r),comprof) = fraclist_r fraclist(1:size(fraclist_w),compwav) = fraclist_w - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets fraclist(1:size(fraclist_g),compglc(ns)) = fraclist_g end do @@ -525,7 +528,7 @@ subroutine med_fraction_init(gcomp, rc) ! Set 'gfrac' and 'lfrac' for FBFrac(compglc) !--------------------------------------- - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%comp_present(compglc(ns))) then ! Set 'gfrac' in FBFrac(compglc(ns)) @@ -645,9 +648,9 @@ subroutine med_fraction_set(gcomp, rc) use ESMF , only : ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldBundleIsCreated use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use esmFlds , only : compatm, compocn, compice, compname - use esmFlds , only : mapfcopy, mapconsd, mapnstod_consd - use esmFlds , only : coupling_mode + use med_internalstate_mod , only : compatm, compocn, compice, compname + use med_internalstate_mod , only : mapfcopy, mapconsd, mapnstod_consd + use med_internalstate_mod , only : coupling_mode use med_internalstate_mod , only : InternalState use med_map_mod , only : med_map_RH_is_created use perf_mod , only : t_startf, t_stopf diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index bc5287a61..0ae5dcaf0 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -4,28 +4,88 @@ module med_internalstate_mod ! Mediator Internal State Datatype. !----------------------------------------------------------------------------- - use ESMF , only : ESMF_RouteHandle, ESMF_FieldBundle, ESMF_State, ESMF_Field - use ESMF , only : ESMF_VM - use esmFlds , only : ncomps, nmappers + use ESMF , only : ESMF_RouteHandle, ESMF_FieldBundle, ESMF_State, ESMF_Field, ESMF_VM + use ESMF , only : ESMF_GridComp, ESMF_MAXSTR, ESMF_LOGMSG_INFO, ESMF_LOGWRITE use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use med_utils_mod, only : chkerr => med_utils_ChkErr implicit none private + ! public routines + public :: med_internalstate_init + public :: med_internalstate_coupling + integer, public :: logunit ! logunit for mediator log output integer, public :: diagunit ! diagunit for budget output (med master only) - integer, public :: loglevel ! loglevel for mediator log output logical, public :: mastertask=.false. ! is this the mastertask integer, public :: med_id ! needed currently in med_io_mod and set in esm.F90 - ! Active coupling definitions (will be initialize in med.F90) - logical, public :: med_coupling_allowed(ncomps, ncomps) + ! Components + integer, public :: compmed = 1 + integer, public :: compatm = 2 + integer, public :: complnd = 3 + integer, public :: compocn = 4 + integer, public :: compice = 5 + integer, public :: comprof = 6 + integer, public :: compwav = 7 + integer, public :: ncomps = 7 ! this will be incremented if the size of compglc is > 0 + integer, public, allocatable :: compglc(:) - type, public :: mesh_info_type - real(r8), pointer :: areas(:) => null() - real(r8), pointer :: lats(:) => null() - real(r8), pointer :: lons(:) => null() - end type mesh_info_type + ! Generic component name (e.g. atm, ocn...) + character(len=CS), public, allocatable :: compname(:) + + ! Specific component name (e.g. datm, mom6, etc...) + character(len=CS), public :: med_name = '' + character(len=CS), public :: atm_name = '' + character(len=CS), public :: lnd_name = '' + character(len=CS), public :: ocn_name = '' + character(len=CS), public :: ice_name = '' + character(len=CS), public :: rof_name = '' + character(len=CS), public :: wav_name = '' + character(len=CS), public :: glc_name = '' + + ! Coupling mode + character(len=CS), public :: coupling_mode ! valid values are [cesm,nems_orig,nems_frac,nems_orig_data,hafs] + + ! Mapping + integer , public, parameter :: mapunset = 0 + integer , public, parameter :: mapbilnr = 1 + integer , public, parameter :: mapconsf = 2 + integer , public, parameter :: mapconsd = 3 + integer , public, parameter :: mappatch = 4 + integer , public, parameter :: mapfcopy = 5 + integer , public, parameter :: mapnstod = 6 ! nearest source to destination + integer , public, parameter :: mapnstod_consd = 7 ! nearest source to destination followed by conservative dst + integer , public, parameter :: mapnstod_consf = 8 ! nearest source to destination followed by conservative frac + integer , public, parameter :: mappatch_uv3d = 9 ! rotate u,v to 3d cartesian space, map from src->dest, then rotate back + integer , public, parameter :: mapbilnr_uv3d = 10 ! rotate u,v to 3d cartesian space, map from src->dest, then rotate back + integer , public, parameter :: map_rof2ocn_ice = 11 ! custom smoothing map to map ice from rof->ocn (cesm only) + integer , public, parameter :: map_rof2ocn_liq = 12 ! custom smoothing map to map liq from rof->ocn (cesm only) + integer , public, parameter :: map_glc2ocn_liq = 13 ! custom smoothing map to map liq from glc->ocn (cesm only) + integer , public, parameter :: map_glc2ocn_ice = 14 ! custom smoothing map to map ice from glc->ocn (cesm only) + integer , public, parameter :: mapfillv_bilnr = 15 ! fill value followed by bilinear + integer , public, parameter :: mapbilnr_nstod = 16 ! bilinear with nstod extrapolation + integer , public, parameter :: mapconsf_aofrac = 17 ! conservative with aofrac normalization (ufs only) + integer , public, parameter :: nmappers = 17 + character(len=*) , public, parameter :: mapnames(nmappers) = & + (/'bilnr ',& + 'consf ',& + 'consd ',& + 'patch ',& + 'fcopy ',& + 'nstod ',& + 'nstod_consd ',& + 'nstod_consf ',& + 'patch_uv3d ',& + 'bilnr_uv3d ',& + 'rof2ocn_ice ',& + 'rof2ocn_liq ',& + 'glc2ocn_ice ',& + 'glc2ocn_liq ',& + 'fillv_bilnr ',& + 'bilnr_nstod ',& + 'consf_aofrac'/) type, public :: packed_data_type integer, allocatable :: fldindex(:) ! size of number of packed fields @@ -36,67 +96,79 @@ module med_internalstate_mod type(ESMF_Field) :: field_fracdst end type packed_data_type + logical, public :: dststatus_print = .false. + + ! Mesh info + type, public :: mesh_info_type + real(r8), pointer :: areas(:) => null() + real(r8), pointer :: lats(:) => null() + real(r8), pointer :: lons(:) => null() + end type mesh_info_type + ! private internal state to keep instance data type InternalStateStruct - ! NState_Imp and NState_Exp are the standard NUOPC coupling datatypes - ! FBImp and FBExp are the internal mediator datatypes - ! NState_Exp(n) = FBExp(n), copied in the connector prep phase - ! FBImp(n,n) = NState_Imp(n), copied in connector post phase - ! FBImp(n,k) is the FBImp(n,n) interpolated to grid k - ! RH(n,k,m) is a RH from grid n to grid k, map type m - - ! Present/Active logical flags - logical :: comp_present(ncomps) ! comp present flag - logical :: med_coupling_active(ncomps,ncomps) ! computes the active coupling + ! Present/allowed coupling/active coupling logical flags + logical, pointer :: comp_present(:) ! comp present flag + logical, pointer :: med_coupling_active(:,:) ! computes the active coupling + integer :: num_icesheets ! obtained from attribute + logical :: ocn2glc_coupling = .false. ! obtained from attribute + logical :: lnd2glc_coupling = .false. + logical :: accum_lnd2glc = .false. ! Mediator vm - type(ESMF_VM) :: vm + type(ESMF_VM) :: vm ! Global nx,ny dimensions of input arrays (needed for mediator history output) - integer :: nx(ncomps), ny(ncomps) + integer, pointer :: nx(:), ny(:) ! Import/Export Scalars - character(len=CL) :: flds_scalar_name = '' - integer :: flds_scalar_num = 0 - integer :: flds_scalar_index_nx = 0 - integer :: flds_scalar_index_ny = 0 - integer :: flds_scalar_index_nextsw_cday = 0 - integer :: flds_scalar_index_precip_factor = 0 - real(r8) :: flds_scalar_precip_factor = 1._r8 ! actual value of precip factor from ocn + character(len=CL) :: flds_scalar_name = '' + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + integer :: flds_scalar_index_nextsw_cday = 0 + integer :: flds_scalar_index_precip_factor = 0 + real(r8) :: flds_scalar_precip_factor = 1._r8 ! actual value of precip factor from ocn + ! NState_Imp and NState_Exp are the standard NUOPC coupling datatypes + ! FBImp and FBExp are the internal mediator datatypes + ! NState_Exp(n) = FBExp(n), copied in the connector prep phase + ! FBImp(n,n) = NState_Imp(n), copied in connector post phase + ! FBImp(n,k) is the FBImp(n,n) interpolated to grid k ! Import/export States and field bundles (the field bundles have the scalar fields removed) - type(ESMF_State) :: NStateImp(ncomps) ! Import data from various component, on their grid - type(ESMF_State) :: NStateExp(ncomps) ! Export data to various component, on their grid - type(ESMF_FieldBundle) :: FBImp(ncomps,ncomps) ! Import data from various components interpolated to various grids - type(ESMF_FieldBundle) :: FBExp(ncomps) ! Export data for various components, on their grid + type(ESMF_State) , pointer :: NStateImp(:) ! Import data from various component, on their grid + type(ESMF_State) , pointer :: NStateExp(:) ! Export data to various component, on their grid + type(ESMF_FieldBundle) , pointer :: FBImp(:,:) ! Import data from various components interpolated to various grids + type(ESMF_FieldBundle) , pointer :: FBExp(:) ! Export data for various components, on their grid ! Mediator field bundles for ocean albedo - type(ESMF_FieldBundle) :: FBMed_ocnalb_o ! Ocn albedo on ocn grid - type(ESMF_FieldBundle) :: FBMed_ocnalb_a ! Ocn albedo on atm grid - type(packed_data_type) :: packed_data_ocnalb_o2a(nmappers) ! packed data for mapping ocn->atm + type(ESMF_FieldBundle) :: FBMed_ocnalb_o ! Ocn albedo on ocn grid + type(ESMF_FieldBundle) :: FBMed_ocnalb_a ! Ocn albedo on atm grid + type(packed_data_type), pointer :: packed_data_ocnalb_o2a(:) ! packed data for mapping ocn->atm ! Mediator field bundles and other info for atm/ocn flux computation + character(len=CS) :: aoflux_grid ! 'ogrid', 'agrid' or 'xgrid' type(ESMF_FieldBundle) :: FBMed_aoflux_a ! Ocn/Atm flux output fields on atm grid type(ESMF_FieldBundle) :: FBMed_aoflux_o ! Ocn/Atm flux output fields on ocn grid - type(packed_data_type) :: packed_data_aoflux_o2a(nmappers) ! packed data for mapping ocn->atm - character(len=CS) :: aoflux_grid ! 'ogrid', 'agrid' or 'xgrid' + type(packed_data_type), pointer :: packed_data_aoflux_o2a(:) ! packed data for mapping ocn->atm ! Mapping - type(ESMF_RouteHandle) :: RH(ncomps,ncomps,nmappers) ! Routehandles for pairs of components and different mappers - type(ESMF_Field) :: field_NormOne(ncomps,ncomps,nmappers) ! Unity static normalization - type(packed_data_type) :: packed_data(ncomps,ncomps,nmappers) ! Packed data structure needed to efficiently map field bundles + ! RH(n,k,m) is a RH from grid n to grid k, map type m + type(ESMF_RouteHandle) , pointer :: RH(:,:,:) ! Routehandles for pairs of components and different mappers + type(ESMF_Field) , pointer :: field_NormOne(:,:,:) ! Unity static normalization + type(packed_data_type) , pointer :: packed_data(:,:,:) ! Packed data structure needed to efficiently map field bundles ! Fractions - type(ESMF_FieldBundle) :: FBfrac(ncomps) ! Fraction data for various components, on their grid + type(ESMF_FieldBundle), pointer :: FBfrac(:) ! Fraction data for various components, on their grid ! Accumulators for export field bundles type(ESMF_FieldBundle) :: FBExpAccumOcn ! Accumulator for various components export on their grid integer :: ExpAccumOcnCnt = 0 ! Accumulator counter for each FBExpAccum ! Component Mesh info - type(mesh_info_type) :: mesh_info(ncomps) - type(ESMF_FieldBundle) :: FBArea(ncomps) ! needed for mediator history writes + type(mesh_info_type) , pointer :: mesh_info(:) + type(ESMF_FieldBundle) , pointer :: FBArea(:) ! needed for mediator history writes end type InternalStateStruct @@ -104,4 +176,377 @@ module med_internalstate_mod type(InternalStateStruct), pointer :: wrap end type InternalState + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!===================================================================== +contains +!===================================================================== + + subroutine med_internalstate_init(gcomp, rc) + + use ESMF , only : ESMF_LogFoundAllocError, ESMF_AttributeGet + use NUOPC_Comp , only : NUOPC_CompAttributeGet + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + logical :: ispresent, isset + integer :: n, ns, n1, n2 + integer :: stat + logical :: glc_present + character(len=8) :: cnum + character(len=CS) :: cvalue + character(len=CL) :: cname + character(len=ESMF_MAXSTR) :: mesh_glc + character(len=CX) :: msgString + character(len=3) :: name + integer :: num_icesheets + character(len=*),parameter :: subname=' (internalstate init) ' + !----------------------------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine if glc is present + call NUOPC_CompAttributeGet(gcomp, name='GLC_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + num_icesheets = 0 + if (isPresent .and. isSet) then + if (trim(cvalue) /= 'sglc') then + call NUOPC_CompAttributeGet(gcomp, name='mesh_glc', value=mesh_glc, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + glc_name = trim(cvalue) + if (isPresent .and. isSet) then + ! determine number of ice sheets - search in mesh_glc for colon deliminted strings + if (len_trim(cvalue) > 0) then + do n = 1, len_trim(mesh_glc) + if (mesh_glc(n:n) == ':') num_icesheets = num_icesheets + 1 + end do + num_icesheets = num_icesheets + 1 + endif + if (mastertask) then + write(logunit,'(a,i8)') trim(subname)//' number of ice sheets is ',num_icesheets + end if + end if + ! now determing the number of multiple ice sheets and increment ncomps accordingly + allocate(compglc(num_icesheets)) + compglc(:) = 0 + do ns = 1,num_icesheets + ncomps = ncomps + 1 + compglc(ns) = ncomps + end do + end if + end if + + ! Determine present flags starting with glc component + allocate(is_local%wrap%comp_present(ncomps)) + is_local%wrap%comp_present(:) = .false. + if (num_icesheets > 0) then + do ns = 1,num_icesheets + is_local%wrap%comp_present(compglc(ns)) = .true. + end do + end if + is_local%wrap%num_icesheets = num_icesheets + + call NUOPC_CompAttributeGet(gcomp, name='mediator_present', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) is_local%wrap%comp_present(compmed) + end if + call NUOPC_CompAttributeGet(gcomp, name='MED_model', value=med_name, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name='ATM_model', value=atm_name, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(atm_name) /= 'satm') is_local%wrap%comp_present(compatm) = .true. + end if + call NUOPC_CompAttributeGet(gcomp, name='LND_model', value=lnd_name, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(lnd_name) /= 'slnd') is_local%wrap%comp_present(complnd) = .true. + end if + call NUOPC_CompAttributeGet(gcomp, name='OCN_model', value=ocn_name, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(ocn_name) /= 'socn') is_local%wrap%comp_present(compocn) = .true. + end if + call NUOPC_CompAttributeGet(gcomp, name='ICE_model', value=ice_name, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(ice_name) /= 'sice') is_local%wrap%comp_present(compice) = .true. + end if + call NUOPC_CompAttributeGet(gcomp, name='ROF_model', value=rof_name, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(rof_name) /= 'srof') is_local%wrap%comp_present(comprof) = .true. + end if + call NUOPC_CompAttributeGet(gcomp, name='WAV_model', value=wav_name, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(wav_name) /= 'swav') is_local%wrap%comp_present(compwav) = .true. + end if + + ! Allocate memory now that ncomps is determined + allocate(is_local%wrap%med_coupling_active(ncomps,ncomps)) + allocate(is_local%wrap%nx(ncomps)) + allocate(is_local%wrap%ny(ncomps)) + allocate(is_local%wrap%NStateImp(ncomps)) + allocate(is_local%wrap%NStateExp(ncomps)) + allocate(is_local%wrap%FBImp(ncomps,ncomps)) + allocate(is_local%wrap%FBExp(ncomps)) + allocate(is_local%wrap%packed_data_ocnalb_o2a(nmappers)) + allocate(is_local%wrap%packed_data_aoflux_o2a(nmappers)) + allocate(is_local%wrap%RH(ncomps,ncomps,nmappers)) + allocate(is_local%wrap%field_NormOne(ncomps,ncomps,nmappers)) + allocate(is_local%wrap%packed_data(ncomps,ncomps,nmappers)) + allocate(is_local%wrap%FBfrac(ncomps)) + allocate(is_local%wrap%FBArea(ncomps)) + allocate(is_local%wrap%mesh_info(ncomps)) + + ! Determine component names + allocate(compname(ncomps)) + compname(compmed) = 'med' + compname(compatm) = 'atm' + compname(complnd) = 'lnd' + compname(compocn) = 'ocn' + compname(compice) = 'ice' + compname(comprof) = 'rof' + compname(compwav) = 'wav' + do ns = 1,is_local%wrap%num_icesheets + write(cnum,'(i0)') ns + compname(compglc(ns)) = 'glc' // trim(cnum) + end do + + if (mastertask) then + ! Write out present flags + write(logunit,*) + do n1 = 1,ncomps + name = trim(compname(n1)) ! this trims the ice sheets index from the glc name + write(msgString,'(A,L4)') trim(subname)//' comp_present(comp'//name//') = ',& + is_local%wrap%comp_present(n1) + write(logunit,'(a)') trim(msgString) + end do + + ! Write out model names if they are present + write(logunit,*) + if (is_local%wrap%comp_present(compatm)) write(logunit,'(a)') trim(subname) // " atm model= "//trim(atm_name) + if (is_local%wrap%comp_present(complnd)) write(logunit,'(a)') trim(subname) // " lnd model= "//trim(lnd_name) + if (is_local%wrap%comp_present(compocn)) write(logunit,'(a)') trim(subname) // " ocn model= "//trim(ocn_name) + if (is_local%wrap%comp_present(compice)) write(logunit,'(a)') trim(subname) // " ice model= "//trim(ice_name) + if (is_local%wrap%comp_present(comprof)) write(logunit,'(a)') trim(subname) // " rof model= "//trim(rof_name) + if (is_local%wrap%comp_present(compwav)) write(logunit,'(a)') trim(subname) // " wav model= "//trim(wav_name) + if (is_local%wrap%comp_present(compmed)) write(logunit,'(a)') trim(subname) // " med model= "//trim(med_name) + if (is_local%wrap%num_icesheets > 0) then + if (is_local%wrap%comp_present(compglc(1))) write(logunit,'(a)') trim(subname) // " glc model= "//trim(glc_name) + end if + write(logunit,*) + end if + + ! Obtain dststatus_print setting if present + call NUOPC_CompAttributeGet(gcomp, name='dststatus_print', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) dststatus_print=(trim(cvalue)=="true") + write(msgString,*) trim(subname)//': Mediator dststatus_print is ',dststatus_print + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + + end subroutine med_internalstate_init + + !===================================================================== + subroutine med_internalstate_coupling(gcomp, rc) + + !---------------------------------------------------------- + ! Check for active coupling interactions + ! must be allowed, bundles created, and both sides have some fields + ! This is called from med.F90 in the DataInitialize routine + !---------------------------------------------------------- + + use ESMF , only : ESMF_StateIsCreated + use NUOPC , only : NUOPC_CompAttributeGet + use med_methods_mod , only : State_getNumFields => med_methods_State_getNumFields + + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: gcomp + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: n1, n2, ns + integer :: cntn1, cntn2 + logical, allocatable :: med_coupling_allowed(:,:) + character(len=CL) :: cvalue + character(len=CX) :: msgString + logical :: isPresent, isSet + character(len=*),parameter :: subname=' (internalstate allowed coupling) ' + !----------------------------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! This defines the med_coupling_allowed a starting point for what is + ! allowed in this coupled system. It will be revised further after the system + ! starts, but any coupling set to false will never be allowed. + ! are allowed, just update the table below. + + if (mastertask) then + write(logunit,'(a)') trim(subname) // "Initializing active coupling flags" + end if + + ! Initialize med_coupling_allowed + allocate(med_coupling_allowed(ncomps,ncomps)) + med_coupling_allowed(:,:) = .false. + is_local%wrap%med_coupling_active(:,:) = .false. + + ! to atmosphere + med_coupling_allowed(complnd,compatm) = .true. + med_coupling_allowed(compice,compatm) = .true. + med_coupling_allowed(compocn,compatm) = .true. + med_coupling_allowed(compwav,compatm) = .true. + + ! to land + med_coupling_allowed(compatm,complnd) = .true. + med_coupling_allowed(comprof,complnd) = .true. + do ns = 1,is_local%wrap%num_icesheets + med_coupling_allowed(compglc(ns),complnd) = .true. + end do + + ! to ocean + med_coupling_allowed(compatm,compocn) = .true. + med_coupling_allowed(compice,compocn) = .true. + med_coupling_allowed(comprof,compocn) = .true. + med_coupling_allowed(compwav,compocn) = .true. + do ns = 1,is_local%wrap%num_icesheets + med_coupling_allowed(compglc(ns),compocn) = .true. + end do + + ! to ice + med_coupling_allowed(compatm,compice) = .true. + med_coupling_allowed(compocn,compice) = .true. + med_coupling_allowed(comprof,compice) = .true. + med_coupling_allowed(compwav,compice) = .true. + do ns = 1,is_local%wrap%num_icesheets + med_coupling_allowed(compglc(ns),compice) = .true. + end do + + ! to river + med_coupling_allowed(complnd,comprof) = .true. + + ! to wave + med_coupling_allowed(compatm,compwav) = .true. + med_coupling_allowed(compocn,compwav) = .true. + med_coupling_allowed(compice,compwav) = .true. + + ! to land-ice + call NUOPC_CompAttributeGet(gcomp, name='ocn2glc_coupling', value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + ! are multiple ocean depths for temperature and salinity sent from the ocn to glc? + read(cvalue,*) is_local%wrap%ocn2glc_coupling + else + is_local%wrap%ocn2glc_coupling = .false. + end if + do ns = 1,is_local%wrap%num_icesheets + med_coupling_allowed(complnd,compglc(ns)) = .true. + med_coupling_allowed(compocn,compglc(ns)) = is_local%wrap%ocn2glc_coupling + end do + + ! initialize med_coupling_active table + is_local%wrap%med_coupling_active(:,:) = .false. + do n1 = 1,ncomps + if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then + call State_GetNumFields(is_local%wrap%NStateImp(n1), cntn1, rc=rc) ! Import Field Count + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (cntn1 > 0) then + do n2 = 1,ncomps + if (is_local%wrap%comp_present(n2) .and. ESMF_StateIsCreated(is_local%wrap%NStateExp(n2),rc=rc) .and. & + med_coupling_allowed(n1,n2)) then + call State_GetNumFields(is_local%wrap%NStateExp(n2), cntn2, rc=rc) ! Import Field Count + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (cntn2 > 0) is_local%wrap%med_coupling_active(n1,n2) = .true. + endif + enddo + end if + endif + enddo + + ! create tables of allowed and active coupling flags + ! - the rows are the destination of coupling + ! - the columns are the source of coupling + ! - So, the second column indicates which models the atm is coupled to. + ! - And the second row indicates which models are coupled to the atm. + if (mastertask) then + write(logunit,*) ' ' + write(logunit,'(A)') trim(subname)//' Allowed coupling flags' + write(logunit,'(2x,A10,20(A5))') '|from to -> ',(compname(n2),n2=1,ncomps) + do n1 = 1,ncomps + write(msgString,'(2x,a1,A,5x,20(L5))') '|',trim(compname(n1)), & + (med_coupling_allowed(n1,n2),n2=1,ncomps) + do n2 = 1,len_trim(msgString) + if (msgString(n2:n2) == 'F') msgString(n2:n2)='-' + enddo + write(logunit,'(A)') trim(msgString) + enddo + + write(logunit,*) ' ' + write(logunit,'(A)') subname//' Active coupling flags' + write(logunit,'(2x,A10,20(A5))') '|from to -> ',(compname(n2),n2=1,ncomps) + do n1 = 1,ncomps + write(msgString,'(2x,a1,A,5x,20(L5))') '|',trim(compname(n1)), & + (is_local%wrap%med_coupling_active(n1,n2),n2=1,ncomps) + do n2 = 1,len_trim(msgString) + if (msgString(n2:n2) == 'F') msgString(n2:n2)='-' + enddo + write(logunit,'(A)') trim(msgString) + enddo + write(logunit,*) ' ' + endif + + ! Determine lnd2glc_coupling flag + do ns = 1,is_local%wrap%num_icesheets + if (is_local%wrap%med_coupling_active(complnd,compglc(ns))) then + is_local%wrap%lnd2glc_coupling = .true. + exit + end if + end do + + ! Determine accum_lnd2glc flag + if (is_local%wrap%lnd2glc_coupling) then + is_local%wrap%accum_lnd2glc = .true. + else + ! Determine if will create auxiliary history file that contains + ! lnd2glc data averaged over the year + call NUOPC_CompAttributeGet(gcomp, name="histaux_l2x1yrg", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) is_local%wrap%accum_lnd2glc + end if + end if + + ! Determine ocn2glc_coupling flag + do ns = 1,is_local%wrap%num_icesheets + if (is_local%wrap%med_coupling_active(compocn,compglc(ns))) then + is_local%wrap%ocn2glc_coupling = .true. + exit + end if + end do + if (.not. is_local%wrap%ocn2glc_coupling) then + ! Reset ocn2glc active coupling based in input attribute + do ns = 1,is_local%wrap%num_icesheets + is_local%wrap%med_coupling_active(compocn,compglc(ns)) = .false. + end do + end if + + ! Dealloate memory + deallocate(med_coupling_allowed) + + end subroutine med_internalstate_coupling + end module med_internalstate_mod diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 0e4a3974b..628ddc7aa 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -75,16 +75,17 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun ! for the field !--------------------------------------------- - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFlush - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_Field - use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldBundleCreate - use ESMF , only : ESMF_FieldBundleIsCreated - use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldDestroy - use ESMF , only : ESMF_Mesh, ESMF_TYPEKIND_R8, ESMF_MESHLOC_ELEMENT - use med_methods_mod , only : med_methods_FB_getFieldN, med_methods_FB_getNameN - use med_constants_mod , only : czero => med_constants_czero - use esmFlds , only : fldListFr, ncomps, mapunset, compname, compocn, compatm - use esmFlds , only : ncomps, nmappers, compname, mapnames, mapfcopy + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFlush + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_Field + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldBundleCreate + use ESMF , only : ESMF_FieldBundleIsCreated + use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldDestroy + use ESMF , only : ESMF_Mesh, ESMF_TYPEKIND_R8, ESMF_MESHLOC_ELEMENT + use med_methods_mod , only : med_methods_FB_getFieldN, med_methods_FB_getNameN + use med_constants_mod , only : czero => med_constants_czero + use esmFlds , only : fldListFr + use med_internalstate_mod , only : mapunset, compname, compocn, compatm + use med_internalstate_mod , only : ncomps, nmappers, compname, mapnames, mapfcopy ! input/output variables type(ESMF_GridComp) :: gcomp @@ -324,25 +325,25 @@ end subroutine med_map_routehandles_initfrom_fieldbundle !================================================================================ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, routehandles, mapfile, rc) - use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandlePrint, ESMF_Field, ESMF_MAXSTR - use ESMF , only : ESMF_PoleMethod_Flag, ESMF_POLEMETHOD_ALLAVG, ESMF_POLEMETHOD_NONE - use ESMF , only : ESMF_FieldSMMStore, ESMF_FieldRedistStore, ESMF_FieldRegridStore - use ESMF , only : ESMF_RouteHandleIsCreated, ESMF_RouteHandleCreate - use ESMF , only : ESMF_REGRIDMETHOD_BILINEAR, ESMF_REGRIDMETHOD_PATCH - use ESMF , only : ESMF_REGRIDMETHOD_CONSERVE, ESMF_NORMTYPE_DSTAREA, ESMF_NORMTYPE_FRACAREA - use ESMF , only : ESMF_UNMAPPEDACTION_IGNORE, ESMF_REGRIDMETHOD_NEAREST_STOD - use ESMF , only : ESMF_EXTRAPMETHOD_NEAREST_STOD - use ESMF , only : ESMF_Mesh, ESMF_MeshLoc, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_I4 - use ESMF , only : ESMF_MeshGet, ESMF_DistGridGet, ESMF_DistGrid, ESMF_TYPEKIND_R8 - use ESMF , only : ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldWrite, ESMF_FieldDestroy - use esmFlds , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_uv3d, mapfcopy - use esmFlds , only : mapunset, mapnames, nmappers - use esmFlds , only : mapnstod, mapnstod_consd, mapnstod_consf, mapnstod_consd - use esmFlds , only : mapfillv_bilnr, mapbilnr_nstod, mapconsf_aofrac - use esmFlds , only : ncomps, compatm, compice, compocn, compwav, compname - use esmFlds , only : coupling_mode, dststatus_print - use esmFlds , only : atm_name - use med_constants_mod , only : ispval_mask => med_constants_ispval_mask + use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandlePrint, ESMF_Field, ESMF_MAXSTR + use ESMF , only : ESMF_PoleMethod_Flag, ESMF_POLEMETHOD_ALLAVG, ESMF_POLEMETHOD_NONE + use ESMF , only : ESMF_FieldSMMStore, ESMF_FieldRedistStore, ESMF_FieldRegridStore + use ESMF , only : ESMF_RouteHandleIsCreated, ESMF_RouteHandleCreate + use ESMF , only : ESMF_REGRIDMETHOD_BILINEAR, ESMF_REGRIDMETHOD_PATCH + use ESMF , only : ESMF_REGRIDMETHOD_CONSERVE, ESMF_NORMTYPE_DSTAREA, ESMF_NORMTYPE_FRACAREA + use ESMF , only : ESMF_UNMAPPEDACTION_IGNORE, ESMF_REGRIDMETHOD_NEAREST_STOD + use ESMF , only : ESMF_EXTRAPMETHOD_NEAREST_STOD + use ESMF , only : ESMF_Mesh, ESMF_MeshLoc, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_I4 + use ESMF , only : ESMF_MeshGet, ESMF_DistGridGet, ESMF_DistGrid, ESMF_TYPEKIND_R8 + use ESMF , only : ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldWrite, ESMF_FieldDestroy + use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_uv3d, mapfcopy + use med_internalstate_mod , only : mapunset, mapnames, nmappers + use med_internalstate_mod , only : mapnstod, mapnstod_consd, mapnstod_consf, mapnstod_consd + use med_internalstate_mod , only : mapfillv_bilnr, mapbilnr_nstod, mapconsf_aofrac + use med_internalstate_mod , only : ncomps, compatm, compice, compocn, compwav, compname + use med_internalstate_mod , only : coupling_mode, dststatus_print + use med_internalstate_mod , only : atm_name + use med_constants_mod , only : ispval_mask => med_constants_ispval_mask ! input/output variables integer , intent(in) :: n1 @@ -672,9 +673,9 @@ end function med_map_RH_is_created_RH3d logical function med_map_RH_is_created_RH1d(RHs,mapindex,rc) - use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated - use esmFlds , only : mapconsd, mapconsf, mapnstod - use esmFlds , only : mapnstod_consd, mapnstod_consf + use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated + use med_internalstate_mod , only : mapconsd, mapconsf, mapnstod + use med_internalstate_mod , only : mapnstod_consd, mapnstod_consf ! input/output varaibes type(ESMF_RouteHandle) , intent(in) :: RHs(:) @@ -722,8 +723,9 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & fldsSrc, FBSrc, FBDst, packed_data, rc) use ESMF - use esmFlds , only : med_fldList_entry_type, nmappers - use esmFlds , only : ncomps, compatm, compice, compocn, compname, mapnames + use esmFlds , only : med_fldList_entry_type + use med_internalstate_mod , only : nmappers + use med_internalstate_mod , only : ncomps, compatm, compice, compocn, compname, mapnames use med_internalstate_mod , only : packed_data_type ! input/output variables @@ -925,8 +927,8 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet use ESMF , only : ESMF_FieldBundleIsCreated use ESMF , only : ESMF_FieldRedist, ESMF_RouteHandle - use esmFlds , only : nmappers, mapfcopy - use esmFlds , only : mappatch_uv3d, mappatch, mapbilnr_uv3d, mapbilnr + use med_internalstate_mod , only : nmappers, mapfcopy + use med_internalstate_mod , only : mappatch_uv3d, mappatch, mapbilnr_uv3d, mapbilnr use med_internalstate_mod , only : packed_data_type ! input/output variables @@ -1254,18 +1256,18 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r ! map the source field to the destination field !--------------------------------------------------- - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_MAXSTR - use ESMF , only : ESMF_KIND_R8 - use ESMF , only : ESMF_Field, ESMF_FieldRegrid - use ESMF , only : ESMF_FieldFill - use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_Region_Flag, ESMF_REGION_TOTAL - use ESMF , only : ESMF_REGION_SELECT - use ESMF , only : ESMF_RouteHandle - use esmFlds , only : mapnstod_consd, mapnstod_consf, mapnstod_consd, mapnstod - use esmFlds , only : mapconsd, mapconsf - use esmFlds , only : mapfillv_bilnr - use med_methods_mod , only : Field_diagnose => med_methods_Field_diagnose + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_MAXSTR + use ESMF , only : ESMF_KIND_R8 + use ESMF , only : ESMF_Field, ESMF_FieldRegrid + use ESMF , only : ESMF_FieldFill + use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_Region_Flag, ESMF_REGION_TOTAL + use ESMF , only : ESMF_REGION_SELECT + use ESMF , only : ESMF_RouteHandle + use med_internalstate_mod , only : mapnstod_consd, mapnstod_consf, mapnstod_consd, mapnstod + use med_internalstate_mod , only : mapconsd, mapconsf + use med_internalstate_mod , only : mapfillv_bilnr + use med_methods_mod , only : Field_diagnose => med_methods_Field_diagnose ! input/output variables type(ESMF_Field) , intent(in) :: field_src diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index c226b1ab9..bd1aa4f80 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -5,13 +5,12 @@ module med_merge_mod !----------------------------------------------------------------------------- use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use med_internalstate_mod , only : logunit + use med_internalstate_mod , only : logunit, compmed, compname use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_constants_mod , only : czero => med_constants_czero use med_utils_mod , only : ChkErr => med_utils_ChkErr use med_methods_mod , only : FB_FldChk => med_methods_FB_FldChk use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr - use esmFlds , only : compmed, compname use esmFlds , only : med_fldList_type use esmFlds , only : med_fldList_GetNumFlds use esmFlds , only : med_fldList_GetFldInfo diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index f0d905e69..ff6d41cc7 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -26,10 +26,10 @@ module med_phases_aofluxes_mod use ESMF , only : ESMF_XGridGet, ESMF_KIND_R8 use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : compatm, compocn, coupling_mode, mapconsd, mapconsf, mapfcopy use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_chkerr - use esmFlds , only : compatm, compocn, coupling_mode, mapconsd, mapconsf, mapfcopy use perf_mod , only : t_startf, t_stopf #ifndef CESMCOUPLED use ufs_const_mod , only : rearth => SHR_CONST_REARTH @@ -150,9 +150,11 @@ module med_phases_aofluxes_mod subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) use ESMF , only : ESMF_FieldBundleIsCreated - use esmFlds , only : med_fldList_GetNumFlds, med_fldList_GetFldNames, compname + use esmFlds , only : med_fldList_GetNumFlds + use esmFlds , only : med_fldList_GetFldNames use esmFlds , only : fldListMed_aoflux use med_methods_mod , only : FB_init => med_methods_FB_init + use med_internalstate_mod, only : compname ! input/output variables type(ESMF_GridComp) :: gcomp @@ -321,13 +323,13 @@ subroutine med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc) use ESMF , only : ESMF_SUCCESS, ESMF_LOGERR_PASSTHRU use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldBundle - use esmFlds , only : coupling_mode use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk #ifdef CESMCOUPLED use shr_flux_mod , only : shr_flux_adjust_constants #else use flux_atmocn_mod , only : flux_adjust_constants #endif + !----------------------------------------------------------------------- ! Initialize pointers to the module variables !----------------------------------------------------------------------- diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 5bf3c3a53..7cfc6fc89 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -18,8 +18,8 @@ module med_phases_history_mod use ESMF , only : operator(-), operator(+) use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet - use esmFlds , only : ncomps, compname use med_utils_mod , only : chkerr => med_utils_ChkErr + use med_internalstate_mod , only : ncomps, compname use med_internalstate_mod , only : InternalState, mastertask, logunit use med_time_mod , only : med_time_alarmInit use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close @@ -28,6 +28,9 @@ module med_phases_history_mod implicit none private + ! Public routine called from med_internal_state_init + public :: med_phases_history_init + ! Public routine called from the run sequence public :: med_phases_history_write ! inst only - for all variables @@ -65,7 +68,7 @@ module med_phases_history_mod logical :: is_clockset = .false. logical :: is_active = .false. end type instfile_type - type(instfile_type) , public :: instfiles(ncomps) + type(instfile_type) , allocatable, public :: instfiles(:) ! ---------------------------- ! Time averaging history files @@ -84,7 +87,7 @@ module med_phases_history_mod logical :: is_clockset = .false. logical :: is_active = .false. end type avgfile_type - type(avgfile_type) :: avgfiles(ncomps) + type(avgfile_type), allocatable :: avgfiles(:) ! ---------------------------- ! Auxiliary history files @@ -109,9 +112,7 @@ module med_phases_history_mod integer :: num_auxfiles = 0 ! actual number of auxiliary files logical :: init_auxfiles = .false. ! if auxfile initial has occured end type auxcomp_type - type(auxcomp_type) , public :: auxcomp(ncomps) - - !logical :: init_auxfiles(ncomps) = .false. ! if true, auxfiles has been initialized for the component + type(auxcomp_type), allocatable, public :: auxcomp(:) ! ---------------------------- ! Other private module variables @@ -130,6 +131,14 @@ module med_phases_history_mod contains !=============================================================================== + subroutine med_phases_history_init() + ! allocate module memory + allocate(instfiles(ncomps)) + allocate(avgfiles(ncomps)) + allocate(auxcomp(ncomps)) + end subroutine med_phases_history_init + + !=============================================================================== subroutine med_phases_history_write(gcomp, rc) ! -------------------------------------- @@ -139,7 +148,7 @@ subroutine med_phases_history_write(gcomp, rc) use med_io_mod, only : med_io_write_time, med_io_define_time use ESMF , only : ESMF_Alarm, ESMF_AlarmSet use ESMF , only : ESMF_FieldBundleIsCreated - use esmflds , only : compocn, compatm + use med_internalstate_mod, only : compocn, compatm ! input/output variables type(ESMF_GridComp) :: gcomp @@ -369,7 +378,7 @@ subroutine med_phases_history_write_med(gcomp, rc) use ESMF , only : ESMF_FieldBundleIsCreated use med_io_mod, only : med_io_write_time, med_io_define_time - use esmFlds , only : compmed, compocn, compatm + use med_internalstate_mod, only : compmed, compocn, compatm ! input/output variables type(ESMF_GridComp) :: gcomp @@ -506,7 +515,7 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) ! Write yearly average of lnd -> glc fields - use esmFlds , only : complnd + use med_internalstate_mod, only : complnd use med_constants_mod , only : SecPerDay => med_constants_SecPerDay use med_io_mod , only : med_io_write_time, med_io_define_time use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index ce3ef2a82..1fe8fb502 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -6,7 +6,7 @@ module med_phases_ocnalb_mod use med_utils_mod , only : chkerr => med_utils_chkerr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : State_GetScalar => med_methods_State_GetScalar - use esmFlds , only : mapconsf, mapnames, compatm, compocn + use med_internalstate_mod , only : mapconsf, mapnames, compatm, compocn use perf_mod , only : t_startf, t_stopf #ifdef CESMCOUPLED use shr_orb_mod , only : shr_orb_cosz, shr_orb_decl diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index acf1c2298..8f528becc 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -32,7 +32,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 esmFlds , only : compocn, compatm, compice, complnd + use med_internalstate_mod , only : compocn, compatm, compice, complnd use perf_mod , only : t_startf, t_stopf ! input/output variables diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index 5987ee355..14610e710 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -14,9 +14,9 @@ module med_phases_post_glc_mod use ESMF , only : ESMF_Mesh, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8 use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated - use esmFlds , only : compatm, compice, complnd, comprof, compocn, ncomps, compname - use esmFlds , only : max_icesheets, num_icesheets, compglc - use esmFlds , only : mapbilnr, mapconsd, compname + use med_internalstate_mod , only : compatm, compice, complnd, comprof, compocn, compname, compglc + use med_internalstate_mod , only : mapbilnr, mapconsd, compname + use med_internalstate_mod , only : InternalState, mastertask, logunit use esmFlds , only : fldListTo use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_methods_mod , only : fldbun_fldchk => med_methods_FB_fldchk @@ -27,7 +27,6 @@ module med_phases_post_glc_mod use med_methods_mod , only : field_getdata2d => med_methods_Field_getdata2d use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_internalstate_mod , only : InternalState, mastertask, logunit use med_map_mod , only : med_map_rh_is_created, med_map_routehandles_init use med_map_mod , only : med_map_field_packed, med_map_field_normalized, med_map_field use glc_elevclass_mod , only : glc_mean_elevation_virtual, glc_get_fractional_icecov @@ -58,7 +57,7 @@ module med_phases_post_glc_mod type(ESMF_Field) :: field_topo_x_icemask_g_ec ! elevation classes type(ESMF_Mesh) :: mesh_g end type ice_sheet_tolnd_type - type(ice_sheet_tolnd_type) :: ice_sheet_tolnd(max_icesheets) + type(ice_sheet_tolnd_type), allocatable :: ice_sheet_tolnd(:) type(ESMF_field) :: field_icemask_l ! no elevation classes type(ESMF_Field) :: field_frac_l_ec ! elevation classes @@ -116,21 +115,21 @@ subroutine med_phases_post_glc(gcomp, rc) if (first_call) then ! determine if there will be any glc to lnd coupling - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),complnd)) then glc2lnd_coupling = .true. exit end if end do ! determine if there will be any glc to ocn coupling - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),compocn)) then glc2ocn_coupling = .true. exit end if end do ! determine if there will be any glc to ice coupling - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),compice)) then glc2ice_coupling = .true. exit @@ -160,7 +159,7 @@ subroutine med_phases_post_glc(gcomp, rc) ! merging with rof->ocn fields is done in med_phases_prep_ocn !--------------------------------------- if (glc2ocn_coupling) then - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),compocn)) then call med_map_field_packed( & FBSrc=is_local%wrap%FBImp(compglc(ns),compglc(ns)), & @@ -187,7 +186,7 @@ subroutine med_phases_post_glc(gcomp, rc) if (glc2lnd_coupling) then ! The will following will map and merge Sg_frac and Sg_topo (and in the future Flgg_hflx) call t_startf('MED:'//trim(subname)//' glc2lnd ') - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),complnd)) then call med_map_field_packed( & FBSrc=is_local%wrap%FBImp(compglc(ns),compglc(ns)), & @@ -219,7 +218,7 @@ subroutine med_phases_post_glc(gcomp, rc) call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ESMF_ClockIsCreated(dclock)) then - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets call med_phases_history_write_comp(gcomp, compglc(ns), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do @@ -298,7 +297,10 @@ subroutine map_glc2lnd_init(gcomp, rc) ! create module fields on glc mesh !--------------------------------------- - do ns = 1,max_icesheets + ! allocate module variable + allocate(ice_sheet_tolnd(is_local%wrap%num_icesheets)) + + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),complnd)) then call fldbun_getmesh(is_local%wrap%FBImp(compglc(ns),compglc(ns)), ice_sheet_tolnd(ns)%mesh_g, rc) @@ -415,7 +417,7 @@ subroutine map_glc2lnd( gcomp, rc) !--------------------------------- ! Map Sg_icemask and Sg_icemask_coupled_fluxes (no elevation classes) - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),complnd)) then call t_startf('MED:'//trim(subname)//' glc2lnd ') call med_map_field_packed( & @@ -433,7 +435,7 @@ subroutine map_glc2lnd( gcomp, rc) ! Get Sg_icemask on land as sum of all ice sheets (no elevation classes) call fldbun_getdata1d(is_local%wrap%FBExp(complnd), Sg_icemask, dataptr1d_dst, rc) dataptr1d_dst(:) = 0._r8 - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),complnd)) then call fldbun_getdata1d(is_local%wrap%FBImp(compglc(ns),complnd), Sg_icemask, dataptr1d_src, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -445,7 +447,7 @@ subroutine map_glc2lnd( gcomp, rc) call fldbun_getdata1d(is_local%wrap%FBExp(complnd), Sg_icemask_coupled_fluxes, dataptr1d_dst, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return dataptr1d_dst(:) = 0._r8 - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),complnd)) then call fldbun_getdata1d(is_local%wrap%FBImp(compglc(ns),complnd), Sg_icemask_coupled_fluxes, dataptr1d_src, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -453,7 +455,7 @@ subroutine map_glc2lnd( gcomp, rc) end if end do - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),complnd)) then ! Set (fractional ice coverage for each elevation class on the glc grid) diff --git a/mediator/med_phases_post_ice_mod.F90 b/mediator/med_phases_post_ice_mod.F90 index 2daa4c358..637cd2917 100644 --- a/mediator/med_phases_post_ice_mod.F90 +++ b/mediator/med_phases_post_ice_mod.F90 @@ -30,7 +30,7 @@ subroutine med_phases_post_ice(gcomp, rc) use med_fraction_mod , only : med_fraction_set use med_internalstate_mod , only : InternalState, mastertask use med_phases_history_mod, only : med_phases_history_write_comp - use esmFlds , only : compice, compatm, compocn, compwav + use med_internalstate_mod , only : compice, compatm, compocn, compwav use perf_mod , only : t_startf, t_stopf ! input/output variables diff --git a/mediator/med_phases_post_lnd_mod.F90 b/mediator/med_phases_post_lnd_mod.F90 index 1bd416c77..559e67345 100644 --- a/mediator/med_phases_post_lnd_mod.F90 +++ b/mediator/med_phases_post_lnd_mod.F90 @@ -27,8 +27,7 @@ subroutine med_phases_post_lnd(gcomp, rc) use med_phases_prep_rof_mod , only : med_phases_prep_rof_accum use med_phases_prep_glc_mod , only : med_phases_prep_glc_accum_lnd, med_phases_prep_glc_avg use med_phases_history_mod , only : med_phases_history_write_comp - use esmFlds , only : complnd, compatm, comprof, compglc, num_icesheets - use esmFlds , only : lnd2glc_coupling, accum_lnd2glc + use med_internalstate_mod , only : complnd, compatm, comprof use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -78,12 +77,12 @@ subroutine med_phases_post_lnd(gcomp, rc) end if ! accumulate lnd input for glc (note that lnd2glc_coupling and accum_lnd2glc is determined in med.F90) - if (lnd2glc_coupling) then + if (is_local%wrap%lnd2glc_coupling) then call med_phases_prep_glc_accum_lnd(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Note that in this case med_phases_prep_glc_avg is called ! from med_phases_prep_glc in the run sequence - else if (accum_lnd2glc) then + else if (is_local%wrap%accum_lnd2glc) then call med_phases_prep_glc_accum_lnd(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_phases_prep_glc_avg(gcomp, rc) diff --git a/mediator/med_phases_post_ocn_mod.F90 b/mediator/med_phases_post_ocn_mod.F90 index c51f9eecf..5f72cc5ea 100644 --- a/mediator/med_phases_post_ocn_mod.F90 +++ b/mediator/med_phases_post_ocn_mod.F90 @@ -9,8 +9,6 @@ module med_phases_post_ocn_mod public :: med_phases_post_ocn - logical :: ocn2glc_coupling - character(*), parameter :: u_FILE_u = & __FILE__ @@ -29,9 +27,9 @@ subroutine med_phases_post_ocn(gcomp, rc) use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, logunit, mastertask + use med_internalstate_mod , only : compice, compocn use med_phases_history_mod , only : med_phases_history_write_comp use med_phases_prep_glc_mod , only : med_phases_prep_glc_accum_ocn - use esmFlds , only : compice, compglc, compocn, num_icesheets use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -40,9 +38,7 @@ subroutine med_phases_post_ocn(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: ns type(ESMF_Clock) :: dClock - logical :: first_call = .true. character(len=*),parameter :: subname='(med_phases_post_ocn)' !--------------------------------------- @@ -73,16 +69,7 @@ subroutine med_phases_post_ocn(gcomp, rc) end if ! Accumulate ocn input for glc if there is ocn->glc coupling - if (first_call) then - do ns = 1,num_icesheets - if (is_local%wrap%med_coupling_active(compocn,compglc(ns))) then - ocn2glc_coupling = .true. - exit - end if - end do - first_call = .false. - end if - if (ocn2glc_coupling) then + if (is_local%wrap%ocn2glc_coupling) then call med_phases_prep_glc_accum_ocn(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index 10ca7bfc7..ea478b0cc 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -21,7 +21,7 @@ subroutine med_phases_post_rof(gcomp, rc) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use esmFlds , only : complnd, compocn, compice, compatm, comprof, ncomps, compname + use med_internalstate_mod , only : complnd, compocn, compice, compatm, comprof, compname use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : InternalState, mastertask, logunit diff --git a/mediator/med_phases_post_wav_mod.F90 b/mediator/med_phases_post_wav_mod.F90 index a1bf805ef..31abf004c 100644 --- a/mediator/med_phases_post_wav_mod.F90 +++ b/mediator/med_phases_post_wav_mod.F90 @@ -24,8 +24,8 @@ subroutine med_phases_post_wav(gcomp, rc) use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, mastertask + use med_internalstate_mod , only : compwav, compatm, compocn, compice use med_phases_history_mod, only : med_phases_history_write_comp - use esmFlds , only : compwav, compatm, compocn, compice use perf_mod , only : t_startf, t_stopf ! input/output variables diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index a598ec169..3c16b93dc 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -16,8 +16,8 @@ module med_phases_prep_atm_mod use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, mastertask - use esmFlds , only : compatm, compocn, compice, ncomps, compname - use esmFlds , only : fldListTo, fldListMed_aoflux, coupling_mode + use med_internalstate_mod , only : compatm, compocn, compice, compname, coupling_mode + use esmFlds , only : fldListTo, fldListMed_aoflux use perf_mod , only : t_startf, t_stopf implicit none diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 8098d4106..d47bbf46c 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -4,8 +4,6 @@ module med_phases_prep_glc_mod ! Mediator phases for preparing glc export from mediator !----------------------------------------------------------------------------- - ! TODO: determine the number of ice sheets that are present - use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet @@ -23,9 +21,7 @@ module med_phases_prep_glc_mod use ESMF , only : ESMF_Mesh, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8, ESMF_KIND_R8 use ESMF , only : ESMF_DYNAMICMASK, ESMF_DynamicMaskSetR8R8R8, ESMF_DYNAMICMASKELEMENTR8R8R8 use ESMF , only : ESMF_FieldRegrid - use esmFlds , only : complnd, compocn, mapbilnr, mapconsd, compname - use esmFlds , only : max_icesheets, num_icesheets, compglc - use esmFlds , only : ocn2glc_coupling, lnd2glc_coupling, accum_lnd2glc + use med_internalstate_mod , only : complnd, compocn, mapbilnr, mapconsd, compname, compglc use med_internalstate_mod , only : InternalState, mastertask, logunit use med_map_mod , only : med_map_routehandles_init, med_map_rh_is_created use med_map_mod , only : med_map_field_normalized, med_map_field @@ -88,7 +84,7 @@ module med_phases_prep_glc_mod type(ESMF_Field) :: field_lfrac_g type(ESMF_Mesh) :: mesh_g end type toglc_frlnd_type - type(toglc_frlnd_type) :: toglc_frlnd(max_icesheets) ! TODO: make this allocatable for number of actual ice sheets + type(toglc_frlnd_type), allocatable :: toglc_frlnd(:) type(ESMF_Field) :: field_normdst_l type(ESMF_Field) :: field_icemask_l @@ -165,11 +161,14 @@ subroutine med_phases_prep_glc_init(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return + ! allocate module variables + allocate(toglc_frlnd(is_local%wrap%num_icesheets)) + ! ------------------------------- ! If will accumulate lnd2glc input on land grid ! ------------------------------- - if (accum_lnd2glc) then + if (is_local%wrap%accum_lnd2glc) then ! Create field bundles for the fldnames_fr_lnd that have an ! undistributed dimension corresponding to elevation classes (including bare land) call ESMF_FieldBundleGet(is_local%wrap%FBImp(complnd,complnd), fldnames_fr_lnd(1), field=lfield, rc=rc) @@ -203,11 +202,11 @@ subroutine med_phases_prep_glc_init(gcomp, rc) ! If lnd->glc couplng is active ! ------------------------------- - if (lnd2glc_coupling) then + if (is_local%wrap%lnd2glc_coupling) then ! Create accumulation field bundles from land on each glc ice sheet mesh ! Determine glc mesh from the mesh from the first export field to glc ! However FBlndAccum2glc_g has the fields fldnames_fr_lnd BUT ON the glc grid - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets ! get mesh on glc grid call fldbun_getmesh(is_local%wrap%FBExp(compglc(ns)), toglc_frlnd(ns)%mesh_g, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -293,7 +292,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Loop over ice sheets - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets ! ice mask without elevation classes on glc toglc_frlnd(ns)%field_icemask_g = ESMF_FieldCreate(toglc_frlnd(ns)%mesh_g, & ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) @@ -333,7 +332,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) ! If ocn->glc couplng is active ! ------------------------------- - if (ocn2glc_coupling) then + if (is_local%wrap%ocn2glc_coupling) then ! Get ocean mesh call fldbun_getmesh(is_local%wrap%FBImp(compocn,compocn), mesh_o, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -354,7 +353,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! create route handle if it has not been created - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compglc(ns),:),mapbilnr,rc=rc)) then call ESMF_LogWrite(trim(subname)//" mapbilnr is not created for ocn->glc mapping", & ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) @@ -661,7 +660,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) end if end if - if (ocn2glc_coupling) then + if (is_local%wrap%ocn2glc_coupling) then ! Average import from accumulated ocn import data do n = 1, size(fldnames_fr_ocn) call fldbun_getdata2d(FBocnAccum2glc_o, fldnames_fr_ocn(n), data2d, rc) @@ -687,7 +686,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) do n = 1,size(fldnames_fr_ocn) call ESMF_FieldBundleGet(FBocnAccum2glc_o, fldnames_fr_ocn(n), field=lfield_src, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets call ESMF_FieldBundleGet(is_local%wrap%FBExp(compglc(ns)), fldnames_fr_ocn(n), field=lfield_dst, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return ! Do mapping of ocn to glc with dynamic masking @@ -701,7 +700,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return end if - if (lnd2glc_coupling) then + if (is_local%wrap%lnd2glc_coupling) then ! Map accumulated field bundle from land grid (with elevation classes) to glc grid (without elevation classes) ! and set FBExp(compglc(ns)) data ! Zero land accumulator and accumulated field bundles on land grid @@ -713,7 +712,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) end if if (dbug_flag > 1) then - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets call fldbun_diagnose(is_local%wrap%FBExp(compglc(ns)), string=trim(subname)//' FBexp(compglc) ', rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return end do @@ -786,7 +785,7 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) ! ------------------------------------------------------------------------ ! Initialize accumulated field bundle on the glc grid to zero before doing the mapping - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets call fldbun_reset(toglc_frlnd(ns)%FBlndAccum2glc_g, value=0.0_r8, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end do @@ -810,11 +809,11 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! map accumlated land fields to each ice sheet (normalize by the land fraction in the mapping) - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets call fldbun_reset(toglc_frlnd(ns)%FBlndAccum2glc_g, value=0.0_r8, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return end do - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets call ESMF_FieldBundleGet(toglc_frlnd(ns)%FBlndAccum2glc_g, fieldlist=fieldlist_glc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do nfld = 1,fieldcount @@ -837,7 +836,7 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return call fldbun_diagnose(is_local%wrap%FBfrac(complnd), string=trim(subname)//' FBFrac ', rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets call fldbun_diagnose(toglc_frlnd(ns)%FBlndAccum2glc_g, string=trim(subname)//& ' FBlndAccum2glc_glc '//compname(compglc(ns)), rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return @@ -849,7 +848,7 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) ! ------------------------------------------------------------------------ ! Loop over ice sheets - do ns = 1,num_icesheets + do ns = 1,is_local%wrap%num_icesheets if (dbug_flag > 1) then write(cnum,'(a3)') ns call fldbun_diagnose(is_local%wrap%FBImp(compglc(ns),compglc(ns)), & diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 1f6424bf1..0d78bbed0 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -37,9 +37,9 @@ subroutine med_phases_prep_ice(gcomp, rc) use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_merge_mod , only : med_merge_auto use med_internalstate_mod , only : InternalState, logunit, mastertask - use esmFlds , only : compatm, compice, compocn, comprof, compglc, ncomps, compname + use med_internalstate_mod , only : compatm, compice, compocn, comprof + use med_internalstate_mod , only : coupling_mode use esmFlds , only : fldListTo - use esmFlds , only : coupling_mode use perf_mod , only : t_startf, t_stopf ! input/output variables diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index d60ac6dcf..81114c1bf 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -26,11 +26,11 @@ subroutine med_phases_prep_lnd(gcomp, rc) use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND - use esmFlds , only : complnd, compatm, ncomps use esmFlds , only : fldListTo use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use med_internalstate_mod , only : complnd, compatm use med_internalstate_mod , only : InternalState, mastertask, logunit use med_merge_mod , only : med_merge_auto use perf_mod , only : t_startf, t_stopf diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index ddf6eaf99..9084ad38e 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -20,8 +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 esmFlds , only : fldListTo - use esmFlds , only : compocn, compatm, compice - use esmFlds , only : coupling_mode + use med_internalstate_mod , only : compocn, compatm, compice, coupling_mode use perf_mod , only : t_startf, t_stopf implicit none diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index f54da223b..e64eea43b 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -12,7 +12,7 @@ module med_phases_prep_rof_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use ESMF , only : ESMF_FieldBundle, ESMF_Field - use esmFlds , only : ncomps, complnd, comprof, compname, mapconsf, mapconsd, mapfcopy + use med_internalstate_mod , only : complnd, comprof, mapconsf, mapconsd, mapfcopy use med_internalstate_mod , only : InternalState, mastertask, logunit use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_constants_mod , only : czero => med_constants_czero diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 8ff29e432..ba3d710d8 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -11,7 +11,7 @@ module med_phases_prep_wav_mod use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, mastertask - use esmFlds , only : compwav, ncomps, compname + use med_internalstate_mod , only : compwav, ncomps, compname use esmFlds , only : fldListFr, fldListTo use perf_mod , only : t_startf, t_stopf diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index d87cfba80..fc202a570 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -8,7 +8,7 @@ module med_phases_restart_mod 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 : mastertask, logunit, InternalState - use esmFlds , only : ncomps, compname, compocn, complnd + use med_internalstate_mod , only : ncomps, compname, compocn, complnd use perf_mod , only : t_startf, t_stopf use med_phases_prep_glc_mod , only : FBlndAccum2glc_l, lndAccum2glc_cnt use med_phases_prep_glc_mod , only : FBocnAccum2glc_o, ocnAccum2glc_cnt diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index b98c91faa..7b64bf6c5 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -88,8 +88,8 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & h0facu , h0facs logical :: redrag , thsfc_loc , lseaspray , & flag_restart, frac_grid , cplflx , & - cplice , cplwav2atm, lheatstrg , & - use_med_flux + cplice , cplwav2atm, lheatstrg !, & + !use_med_flux character(len=1024) :: errmsg integer, dimension(nMax) :: vegtype , islmsk , islmsk_cice real(kp), dimension(nMax) :: prsl1 , prslki , prsik1 , & @@ -134,8 +134,8 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & tsfc , & tsfc_wat , tsfc_lnd , tsfc_ice , & semis_rad , emis_lnd , emis_ice , & - semis_wat , semis_lnd , semis_ice , & - dqsfc , dtsfc + semis_wat , semis_lnd , semis_ice !, & + !dqsfc , dtsfc real(kp), dimension(nMax,1) :: tiice , stc !integer :: naux2d !real(kp), dimension(nMax,2) :: aux2d @@ -343,9 +343,9 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & gflx_wat(:) = 0.0_kp ! upward_heat_flux_in_soil_over_water gflx_lnd(:) = 0.0_kp ! upward_heat_flux_in_soil_over_lnd gflx_ice(:) = 0.0_kp ! upward_heat_flux_in_soil_over_ice - use_med_flux = .false. ! flag_for_mediator_atmosphere_ocean_fluxes - dqsfc(:) = 0.0_kp ! surface_upward_latent_heat_flux_over_ocean_from_coupled_process - dtsfc(:) = 0.0_kp ! surface_upward_sensible_heat_flux_over_ocean_from_coupled_process + !use_med_flux = .false. ! flag_for_mediator_atmosphere_ocean_fluxes + !dqsfc(:) = 0.0_kp ! surface_upward_latent_heat_flux_over_ocean_from_coupled_process + !dtsfc(:) = 0.0_kp ! surface_upward_sensible_heat_flux_over_ocean_from_coupled_process if (flag_init) then allocate(evap(nMax)) @@ -457,7 +457,7 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & lseaspray , fm_wat , fm10_wat , & pbot , prslki , wet , & use_flake , wind , flag_iter , & - use_med_flux, dqsfc , dtsfc , & + !use_med_flux, dqsfc , dtsfc , & qss_wat , cmm_wat , chh_wat , & gflx_wat , evap_wat , hflx_wat , & ep1d_wat , errmsg , errflg) @@ -523,7 +523,7 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & if (mask(n) /= 0) then sen(n) = -1.0_kp*hflx_wat(n)*rbot(n)*cp lat(n) = -1.0_kp*evap_wat(n)*rbot(n)*hvap - lwup(n) = semis_wat(n)*sbc*ts(n)**4+(1.0_r8-semis_wat(n))*lwdn(n) + lwup(n) = -1.0_kp*semis_wat(n)*sbc*ts(n)**4+(1.0_r8-semis_wat(n))*lwdn(n) evp(n) = lat(n)/hvap taux(n) = -1.0_kp*rbot(n)*stress(n)*ubot(n)/wind(n) tauy(n) = -1.0_kp*rbot(n)*stress(n)*vbot(n)/wind(n) From eebde7fc2220b370a5f0da9d90d8bee2e32aca3e Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Mon, 3 Jan 2022 23:14:44 -0700 Subject: [PATCH 007/395] add support for external land component --- mediator/esmFldsExchange_nems_mod.F90 | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index f9a24166e..c9f537301 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -25,7 +25,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_utils_mod , only : chkerr => med_utils_chkerr use med_internalstate_mod , only : mastertask, logunit - use med_internalstate_mod , only : compmed, compatm, compocn, compice, comprof, ncomps + use med_internalstate_mod , only : compmed, compatm, compocn, compice, complnd, ncomps use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf use med_internalstate_mod , only : mapconsf_aofrac @@ -353,6 +353,24 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end do deallocate(flds) + !===================================================================== + ! FIELDS TO LAND (complnd) + !===================================================================== + + ! to lnd - states and fluxes from atm + allocate(flds(11)) + flds = (/'Sa_z ', 'Sa_topo ', 'Sa_tbot ', 'Sa_pbot ', & + 'Sa_shum ', 'Sa_u ', 'Sa_v ', 'Faxa_lwdn ', & + 'Faxa_swdn ', 'Faxa_rainc', 'Faxa_rainl' /) + do n = 1,size(flds) + fldname = trim(flds(n)) + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(complnd)%flds, trim(fldname)) + call addmap(fldListFr(compatm)%flds, trim(fldname), complnd, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(complnd)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end do + deallocate(flds) + end subroutine esmFldsExchange_nems end module esmFldsExchange_nems_mod From d1e0e08cbf9458e8f88bdaa604aa635ff7e17598 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Tue, 4 Jan 2022 10:30:10 -0700 Subject: [PATCH 008/395] update exchange fields for nems to include land --- mediator/esmFldsExchange_nems_mod.F90 | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index c9f537301..7684923e7 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -77,6 +77,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) !===================================================================== ! masks from components + call addfld(fldListFr(complnd)%flds, 'Sl_lfrin') call addfld(fldListFr(compice)%flds, 'Si_imask') call addfld(fldListFr(compocn)%flds, 'So_omask') call addmap(fldListFr(compocn)%flds, 'So_omask', compice, mapfcopy, 'unset', 'unset') @@ -118,6 +119,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call addfld(fldListTo(compatm)%flds, 'Si_ifrac') ! ofrac used by atm call addfld(fldListFr(compatm)%flds, 'Sa_ofrac') + ! lfrac used by atm + call addfld(fldListTo(compatm)%flds, 'Sl_lfrac') ! to atm: unmerged from ice ! - zonal surface stress, meridional surface stress @@ -159,6 +162,12 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call addmap(fldListFr(compocn)%flds, 'So_t', compatm, maptype, 'ofrac', 'unset') call addmrg(fldListTo(compatm)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + ! to atm: unmerged surface temperatures from lnd + call addfld(fldListFr(complnd)%flds, 'Sl_t') + call addfld(fldListTo(compatm)%flds, 'Sl_t') + call addmap(fldListFr(complnd)%flds, 'Sl_t', compatm, maptype, 'lfrac', 'unset') + call addmrg(fldListTo(compatm)%flds, 'Sl_t', mrg_from=complnd, mrg_fld='', mrg_type='copy') + !===================================================================== ! FIELDS TO OCEAN (compocn) !===================================================================== @@ -358,15 +367,16 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) !===================================================================== ! to lnd - states and fluxes from atm - allocate(flds(11)) + allocate(flds(16)) flds = (/'Sa_z ', 'Sa_topo ', 'Sa_tbot ', 'Sa_pbot ', & 'Sa_shum ', 'Sa_u ', 'Sa_v ', 'Faxa_lwdn ', & - 'Faxa_swdn ', 'Faxa_rainc', 'Faxa_rainl' /) + 'Sa_ptem ', 'Sa_dens ', 'Faxa_swdn ', 'Faxa_swnet', & + 'Faxa_snowc', 'Faxa_snowl', 'Faxa_rainc', 'Faxa_rainl' /) do n = 1,size(flds) fldname = trim(flds(n)) call addfld(fldListFr(compatm)%flds, trim(fldname)) call addfld(fldListTo(complnd)%flds, trim(fldname)) - call addmap(fldListFr(compatm)%flds, trim(fldname), complnd, mapfcopy , 'unset', 'unset') + call addmap(fldListFr(compatm)%flds, trim(fldname), complnd, maptype, 'one', 'unset') call addmrg(fldListTo(complnd)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') end do deallocate(flds) From cdfbb356475d202ddf4a75f2a319a4bfb139beee Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Sat, 8 Jan 2022 00:12:02 -0700 Subject: [PATCH 009/395] update ccpp aoflux code --- ufs/flux_atmocn_ccpp_mod.F90 | 165 +++++++++++++++++------------------ 1 file changed, 79 insertions(+), 86 deletions(-) diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index 7b64bf6c5..ac655b68f 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -80,16 +80,15 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & integer :: n , iter , ivegsrc , & sfc_z0_type , errflg , nstf_name1, & lkm , nthreads , kice , & - km , lsm , lsm_noahmp, & - lsm_ruc + lsm , lsm_noahmp, km real(kp) :: spval , cpinv , hvapi , & elocp , rch , tem , & min_lakeice , min_seaice, tgice , & h0facu , h0facs logical :: redrag , thsfc_loc , lseaspray , & flag_restart, frac_grid , cplflx , & - cplice , cplwav2atm, lheatstrg !, & - !use_med_flux + cplice , cplwav2atm, lheatstrg , & + use_med_flux character(len=1024) :: errmsg integer, dimension(nMax) :: vegtype , islmsk , islmsk_cice real(kp), dimension(nMax) :: prsl1 , prslki , prsik1 , & @@ -134,11 +133,9 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & tsfc , & tsfc_wat , tsfc_lnd , tsfc_ice , & semis_rad , emis_lnd , emis_ice , & - semis_wat , semis_lnd , semis_ice !, & - !dqsfc , dtsfc + semis_wat , semis_lnd , semis_ice , & + dqsfc , dtsfc real(kp), dimension(nMax,1) :: tiice , stc - !integer :: naux2d - !real(kp), dimension(nMax,2) :: aux2d logical, dimension(nMax) :: flag_iter , flag_guess, use_flake , & wet , dry , icy , & flag_cice , lake @@ -343,9 +340,9 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & gflx_wat(:) = 0.0_kp ! upward_heat_flux_in_soil_over_water gflx_lnd(:) = 0.0_kp ! upward_heat_flux_in_soil_over_lnd gflx_ice(:) = 0.0_kp ! upward_heat_flux_in_soil_over_ice - !use_med_flux = .false. ! flag_for_mediator_atmosphere_ocean_fluxes - !dqsfc(:) = 0.0_kp ! surface_upward_latent_heat_flux_over_ocean_from_coupled_process - !dtsfc(:) = 0.0_kp ! surface_upward_sensible_heat_flux_over_ocean_from_coupled_process + use_med_flux = .false. ! flag_for_mediator_atmosphere_ocean_fluxes + dqsfc(:) = 0.0_kp ! surface_upward_latent_heat_flux_over_ocean_from_coupled_process + dtsfc(:) = 0.0_kp ! surface_upward_sensible_heat_flux_over_ocean_from_coupled_process if (flag_init) then allocate(evap(nMax)) @@ -372,7 +369,6 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & lsm = 2 ! control_for_land_surface_scheme lsm_noahmp = 2 ! identifier_for_noahmp_land_surface_scheme - lsm_ruc = 3 ! identifier_for_ruc_land_surface_scheme semis_rad(:) = 0.0_kp ! surface_longwave_emissivity semis_lnd(:) = 0.0_kp ! surface_longwave_emissivity_over_land_interstitial semis_ice(:) = 0.0_kp ! surface_longwave_emissivity_over_ice_interstitial @@ -386,31 +382,28 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & !--- GFS surface scheme pre --- call GFS_surface_composites_pre_run( & - nMax , flag_init , flag_restart, & - lkm , lsm , lsm_noahmp , & - lsm_ruc , frac_grid , flag_cice , & - cplflx , cplice , cplwav2atm , & - landfrac , lakefrac , lakedepth , & - oceanfrac , frland , dry , & - icy , lake , use_flake , & - wet , hice , cice , & - z0rl_wat , z0rl_lnd , z0rl_ice , & - snowd , snowd_lnd , snowd_ice , & - tprcp , & - tprcp_wat , tprcp_lnd , tprcp_ice , & - ustar , & - ustar_wat , ustar_lnd , ustar_ice , & - weasd , weasd_lnd , weasd_ice , & - ep1d_ice , tskin , tsfco , & - tskin_lnd , tskin_wat , tskin_ice , & - tisfc , tsurf_wat , tsurf_lnd , & - tsurf_ice , gflx_ice , tgice , & - islmsk , islmsk_cice, slmsk , & - semis_rad , semis_wat , semis_lnd , & - semis_ice , emis_lnd , emis_ice , & - qss , qss_wat , qss_lnd , & - qss_ice , min_lakeice, min_seaice , & - kdt , errmsg , errflg) + nMax , flag_init , flag_restart, & + lkm , frac_grid , flag_cice , & + cplflx , cplice , cplwav2atm , & + landfrac , lakefrac , lakedepth , & + oceanfrac , frland , dry , & + icy , lake , use_flake , & + wet , hice , cice , & + z0rl_wat , z0rl_lnd , z0rl_ice , & + snowd , snowd_lnd , snowd_ice , & + tprcp , & + tprcp_wat , tprcp_lnd , tprcp_ice , & + ustar , & + ustar_wat , ustar_lnd , ustar_ice , & + weasd , weasd_lnd , weasd_ice , & + ep1d_ice , tskin , tsfco , & + tskin_lnd , tskin_wat , tisfc , & + tsurf_wat , tsurf_lnd , tsurf_ice , & + gflx_ice , tgice , islmsk , & + islmsk_cice, slmsk , qss , & + qss_wat , qss_lnd , qss_ice , & + min_lakeice, min_seaice , kdt , & + huge , errmsg , errflg) !--- surface iteration loop --- do iter = 1, 2 @@ -457,66 +450,66 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & lseaspray , fm_wat , fm10_wat , & pbot , prslki , wet , & use_flake , wind , flag_iter , & - !use_med_flux, dqsfc , dtsfc , & + use_med_flux, dqsfc , dtsfc , & qss_wat , cmm_wat , chh_wat , & gflx_wat , evap_wat , hflx_wat , & ep1d_wat , errmsg , errflg) !--- update flag_guess and flag_iter --- call GFS_surface_loop_control_part2_run( & - nMax , iter , wind , & - flag_guess , flag_iter , dry , & - wet , icy , nstf_name1 , & + nMax , lsm , lsm_noahmp, & + iter , wind , & + flag_guess , flag_iter , dry , & + wet , icy , nstf_name1, & errmsg , errflg) end do !--- GFS surface scheme post --- call GFS_surface_composites_post_run( & - nMax , kice , km , & - rd , rvrdm1 , cplflx , & - cplwav2atm, frac_grid , flag_cice , & - thsfc_loc , islmsk , dry , & - wet , icy , wind , & - tbot , qbot , pbot , & - landfrac , lakefrac , oceanfrac , & - z0rl , z0rl_wat , z0rl_lnd , & - z0rl_ice , garea , cm , & - cm_wat , cm_lnd , cm_ice , & - ch , ch_wat , ch_lnd , & - ch_ice , rb , rb_wat , & - rb_lnd , rb_ice , stress , & - stress_wat, stress_lnd , stress_ice , & - fm , fm_wat , fm_lnd , & - fm_ice , fh , fh_wat , & - fh_lnd , fh_ice , ustar , & - ustar_wat , ustar_lnd , ustar_ice , & - fm10 , fm10_wat , fm10_lnd , & - fm10_ice , fh2 , fh2_wat , & - fh2_lnd , fh2_ice , tsurf_wat , & - tsurf_lnd , tsurf_ice , cmm , & - cmm_wat , cmm_lnd , cmm_ice , & - chh , chh_wat , chh_lnd , & - chh_ice , gflx , gflx_wat , & - gflx_lnd , gflx_ice , ep1d , & - ep1d_wat , ep1d_lnd , ep1d_ice , & - weasd , weasd_lnd , weasd_ice , & - snowd , snowd_lnd , snowd_ice , & - tprcp , tprcp_wat , tprcp_lnd , & - tprcp_ice , evap , evap_wat , & - evap_lnd , evap_ice , hflx , & - hflx_wat , hflx_lnd , hflx_ice , & - qss , qss_wat , qss_lnd , & - qss_ice , tskin , tsfco , & - tskin_lnd , tskin_wat , tskin_ice , & - tisfc , hice , cice , & - min_seaice, & - tiice , sigmaf , zvfun , & - lheatstrg , h0facu , h0facs , & - hflxq , hffac , stc , & - grav , prsik1 , prslk1 , & - prslki , zbot , ztmax_wat , & - ztmax_lnd , ztmax_ice , & - errmsg , errflg) + nMax , kice , km , & + rd , rvrdm1 , cplflx , & + cplwav2atm, frac_grid , flag_cice , & + thsfc_loc , islmsk , dry , & + wet , icy , wind , & + tbot , qbot , pbot , & + landfrac , lakefrac , oceanfrac , & + z0rl , z0rl_wat , z0rl_lnd , & + z0rl_ice , garea , cm , & + cm_wat , cm_lnd , cm_ice , & + ch , ch_wat , ch_lnd , & + ch_ice , rb , rb_wat , & + rb_lnd , rb_ice , stress , & + stress_wat, stress_lnd , stress_ice, & + fm , fm_wat , fm_lnd , & + fm_ice , fh , fh_wat , & + fh_lnd , fh_ice , ustar , & + ustar_wat , ustar_lnd , ustar_ice , & + fm10 , fm10_wat , fm10_lnd , & + fm10_ice , fh2 , fh2_wat , & + fh2_lnd , fh2_ice , tsurf_wat , & + tsurf_lnd , tsurf_ice , cmm , & + cmm_wat , cmm_lnd , cmm_ice , & + chh , chh_wat , chh_lnd , & + chh_ice , gflx , gflx_wat , & + gflx_lnd , gflx_ice , ep1d , & + ep1d_wat , ep1d_lnd , ep1d_ice , & + weasd , weasd_lnd , weasd_ice , & + snowd , snowd_lnd , snowd_ice , & + tprcp , tprcp_wat , tprcp_lnd , & + tprcp_ice , evap , evap_wat , & + evap_lnd , evap_ice , hflx , & + hflx_wat , hflx_lnd , hflx_ice , & + qss , qss_wat , qss_lnd , & + qss_ice , tskin , tsfco , & + tskin_lnd , tskin_wat , tisfc , & + hice , cice , tiice , & + sigmaf , zvfun , lheatstrg , & + h0facu , h0facs , hflxq , & + hffac , stc , grav , & + prsik1 , prslk1 , prslki , & + zbot , ztmax_wat , ztmax_lnd , & + ztmax_ice , huge , errmsg , & + errflg) !--- unit conversion --- do n = 1, nMax From a80db60fae60a5ce4dd99e528e796e2b6b3c4154 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Mon, 10 Jan 2022 22:16:10 -0700 Subject: [PATCH 010/395] fix upward longwave sign issue --- ufs/flux_atmocn_ccpp_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index ac655b68f..8eeeac894 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -516,7 +516,7 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & if (mask(n) /= 0) then sen(n) = -1.0_kp*hflx_wat(n)*rbot(n)*cp lat(n) = -1.0_kp*evap_wat(n)*rbot(n)*hvap - lwup(n) = -1.0_kp*semis_wat(n)*sbc*ts(n)**4+(1.0_r8-semis_wat(n))*lwdn(n) + lwup(n) = -1.0_kp*(semis_wat(n)*sbc*ts(n)**4+(1.0_r8-semis_wat(n))*lwdn(n)) evp(n) = lat(n)/hvap taux(n) = -1.0_kp*rbot(n)*stress(n)*ubot(n)/wind(n) tauy(n) = -1.0_kp*rbot(n)*stress(n)*vbot(n)/wind(n) From 2d57af504b69d985e9b690057353eaf9ba035018 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Wed, 12 Jan 2022 11:03:31 -0700 Subject: [PATCH 011/395] mods to solve sign issue in the fluxes --- mediator/esmFldsExchange_nems_mod.F90 | 16 ++++- mediator/med_phases_prep_atm_mod.F90 | 89 +++++++++++++++++++++++++-- ufs/flux_atmocn_ccpp_mod.F90 | 10 +-- 3 files changed, 102 insertions(+), 13 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 47e045635..b477309d5 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -193,8 +193,20 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! - surface upward longwave heat flux ! - evaporation water flux from water, not in the list do we need to send it to atm? if (trim(coupling_mode) == 'nems_frac_aoflux') then - allocate(flds(5)) - flds = (/'taux', 'tauy', 'lat', 'sen', 'lwup' /) + ! custom merge in med_phases_prep_atm (sign changes) + allocate(flds(3)) + flds = (/ 'lat', 'sen', 'lwup' /) + do n = 1,size(flds) + call addfld(fldListMed_aoflux%flds , 'Faox_'//trim(flds(n))) + call addfld(fldListTo(compatm)%flds, 'Faox_'//trim(flds(n))) + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds, 'Faox_'//trim(flds(n)), compatm, maptype, 'ofrac', 'unset') + end if + end do + deallocate(flds) + + allocate(flds(2)) + flds = (/ 'taux', 'tauy' /) do n = 1,size(flds) call addfld(fldListMed_aoflux%flds , 'Faox_'//trim(flds(n))) call addfld(fldListTo(compatm)%flds, 'Faox_'//trim(flds(n))) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 3c16b93dc..f1e49af68 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -8,12 +8,13 @@ module med_phases_prep_atm_mod use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldBundleGet use ESMF , only : ESMF_GridComp, ESMF_GridCompGet - 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_methods_mod , only : FB_diagnose => med_methods_FB_diagnose - use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk - use med_merge_mod , only : med_merge_auto + 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_methods_mod , only : FB_diagnose => med_methods_FB_diagnose + use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk + use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr + use med_merge_mod , only : med_merge_auto, med_merge_field use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, mastertask use med_internalstate_mod , only : compatm, compocn, compice, compname, coupling_mode @@ -25,6 +26,8 @@ module med_phases_prep_atm_mod public :: med_phases_prep_atm + private :: med_phases_prep_atm_custom_nems + character(*), parameter :: u_FILE_u = & __FILE__ @@ -229,6 +232,12 @@ subroutine med_phases_prep_atm(gcomp, rc) end do end if + ! custom merges to atmosphere + if (trim(coupling_mode(1:5)) == 'nems_') then + call med_phases_prep_atm_custom_nems(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if @@ -236,4 +245,72 @@ subroutine med_phases_prep_atm(gcomp, rc) end subroutine med_phases_prep_atm + !----------------------------------------------------------------------------- + subroutine med_phases_prep_atm_custom_nems(gcomp, rc) + + ! ---------------------------------------------- + ! Custom calculation for nems_frac_aoflux + ! ---------------------------------------------- + + use ESMF , only : ESMF_GridComp + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + real(r8), pointer :: customwgt(:) + real(r8), pointer :: field(:) + integer :: lsize + character(len=*), parameter :: subname='(med_phases_prep_atm_custom_nems)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > 20) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + end if + call memcheck(subname, 5, mastertask) + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! get field on the atm mesh to query lsize + call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Faox_sen' , field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + lsize = size(field) + allocate(customwgt(lsize)) + + if (trim(coupling_mode) == 'nems_frac_aoflux') then + ! change signs + customwgt(:) = -1.0_r8 + call med_merge_field(is_local%wrap%FBExp(compatm), 'Faox_sen', & + FBinA=is_local%wrap%FBMed_aoflux_a, fnameA='Faox_sen', wgtA=customwgt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call med_merge_field(is_local%wrap%FBExp(compatm), 'Faox_lat', & + FBinA=is_local%wrap%FBMed_aoflux_a, fnameA='Faox_lat', wgtA=customwgt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call med_merge_field(is_local%wrap%FBExp(compatm), 'Faox_lwup', & + FBinA=is_local%wrap%FBMed_aoflux_a, fnameA='Faox_lwup', wgtA=customwgt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + deallocate(customwgt) + + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_prep_atm_custom_nems + end module med_phases_prep_atm_mod diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index 8eeeac894..313f83da9 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -514,12 +514,12 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & !--- unit conversion --- do n = 1, nMax if (mask(n) /= 0) then - sen(n) = -1.0_kp*hflx_wat(n)*rbot(n)*cp - lat(n) = -1.0_kp*evap_wat(n)*rbot(n)*hvap - lwup(n) = -1.0_kp*(semis_wat(n)*sbc*ts(n)**4+(1.0_r8-semis_wat(n))*lwdn(n)) + sen(n) = hflx_wat(n)*rbot(n)*cp + lat(n) = evap_wat(n)*rbot(n)*hvap + lwup(n) = semis_wat(n)*sbc*ts(n)**4+(1.0_r8-semis_wat(n))*lwdn(n) evp(n) = lat(n)/hvap - taux(n) = -1.0_kp*rbot(n)*stress(n)*ubot(n)/wind(n) - tauy(n) = -1.0_kp*rbot(n)*stress(n)*vbot(n)/wind(n) + taux(n) = rbot(n)*stress(n)*ubot(n)/wind(n) + tauy(n) = rbot(n)*stress(n)*vbot(n)/wind(n) qref(n) = qss_wat(n) else sen(n) = spval From 747105531c496c0b4bf3d76df7b6c49d5cfa1a39 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 13 Jan 2022 11:57:39 -0700 Subject: [PATCH 012/395] update to use both flux scheme (cesm, ccpp) under UFS --- mediator/esmFldsExchange_nems_mod.F90 | 24 +++++---------- mediator/med.F90 | 16 +++++++++- mediator/med_internalstate_mod.F90 | 3 ++ mediator/med_phases_aofluxes_mod.F90 | 44 ++++++++++++++------------- mediator/med_phases_prep_atm_mod.F90 | 30 +++++++++--------- mediator/med_phases_prep_ocn_mod.F90 | 20 +++++++----- ufs/flux_atmocn_ccpp_mod.F90 | 8 ++--- 7 files changed, 79 insertions(+), 66 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index b477309d5..2fd599123 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -193,20 +193,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! - surface upward longwave heat flux ! - evaporation water flux from water, not in the list do we need to send it to atm? if (trim(coupling_mode) == 'nems_frac_aoflux') then - ! custom merge in med_phases_prep_atm (sign changes) - allocate(flds(3)) - flds = (/ 'lat', 'sen', 'lwup' /) - do n = 1,size(flds) - call addfld(fldListMed_aoflux%flds , 'Faox_'//trim(flds(n))) - call addfld(fldListTo(compatm)%flds, 'Faox_'//trim(flds(n))) - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%flds, 'Faox_'//trim(flds(n)), compatm, maptype, 'ofrac', 'unset') - end if - end do - deallocate(flds) - - allocate(flds(2)) - flds = (/ 'taux', 'tauy' /) + allocate(flds(5)) + flds = (/ 'lat', 'sen', 'lwup', 'taux', 'tauy' /) do n = 1,size(flds) call addfld(fldListMed_aoflux%flds , 'Faox_'//trim(flds(n))) call addfld(fldListTo(compatm)%flds, 'Faox_'//trim(flds(n))) @@ -270,7 +258,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end do deallocate(flds) - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac' .or. trim(coupling_mode) == 'nems_frac_aoflux') then + if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then ! to ocn: merge surface stress (custom merge calculation in med_phases_prep_ocn) allocate(flds(2)) flds = (/'taux', 'tauy'/) @@ -299,8 +287,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call addfld(fldListTo(compocn)%flds, 'Faxa_evap') call addfld(fldListFr(compatm)%flds, 'Faxa_lat') call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, mapconsf_aofrac, 'aofrac', 'unset') - else - ! nems_orig_data + else if (trim(coupling_mode) == 'nems_orig_data' .or. trim(coupling_mode) == 'nems_frac_aoflux') then ! to ocn: surface stress from mediator and ice stress via auto merge allocate(flds(2)) flds = (/'taux', 'tauy'/) @@ -333,6 +320,9 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call addfld(fldListTo(compocn)%flds, 'Faox_evap') call addmrg(fldListTo(compocn)%flds, 'Faox_evap', & mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='copy_with_weights', mrg_fracname='ofrac') + !else if (trim(coupling_mode) == 'nems_frac_aoflux') then + ! ! to ocn: sensible heat flux from mediator (custom merge in med_phases_prep_ocn) + ! call addfld(fldListTo(compocn)%flds, 'Foxx_sen') end if ! to ocn: water flux due to melting ice from ice diff --git a/mediator/med.F90 b/mediator/med.F90 index 130774c4c..315d71b04 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -45,7 +45,7 @@ module MED use med_internalstate_mod , only : logunit, mastertask use med_internalstate_mod , only : ncomps, compname use med_internalstate_mod , only : compmed, compatm, compocn, compice, complnd, comprof, compwav, compglc - use med_internalstate_mod , only : coupling_mode + use med_internalstate_mod , only : coupling_mode, aoflux_code use esmFlds , only : fldListMed_ocnalb use esmFlds , only : med_fldList_GetNumFlds, med_fldList_GetFldNames, med_fldList_GetFldInfo use esmFlds , only : med_fldList_Document_Mapping, med_fldList_Document_Merging @@ -746,6 +746,20 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) end if is_local%wrap%aoflux_grid = trim(cvalue) + ! Determine aoflux scheme that will be used to compute atmosphere-ocean fluxes [cesm|ccpp] + ! TODO: If ccpp is not available it will be always run in cesm mode independent from aoflux_code option + call NUOPC_CompAttributeGet(gcomp, name='aoflux_code', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (.not. isPresent .and. .not. isSet) then + cvalue = 'cesm' + end if + aoflux_code = trim(cvalue) + if (mastertask) then + write(logunit,*) '========================================================' + write(logunit,'(a)')trim(subname)//' Mediator aoflux scheme is '//trim(aoflux_code) + write(logunit,*) '========================================================' + end if + !------------------ ! Initialize mediator flds !------------------ diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 0ae5dcaf0..4991c28fe 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -48,6 +48,9 @@ module med_internalstate_mod ! Coupling mode character(len=CS), public :: coupling_mode ! valid values are [cesm,nems_orig,nems_frac,nems_orig_data,hafs] + ! Atmosphere-ocean flux algorithm + character(len=CS), public :: aoflux_code ! valid values are [cesm,ccpp] + ! Mapping integer , public, parameter :: mapunset = 0 integer , public, parameter :: mapbilnr = 1 diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index ff6d41cc7..75154ecb8 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -26,7 +26,7 @@ module med_phases_aofluxes_mod use ESMF , only : ESMF_XGridGet, ESMF_KIND_R8 use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_internalstate_mod , only : InternalState, mastertask, logunit - use med_internalstate_mod , only : compatm, compocn, coupling_mode, mapconsd, mapconsf, mapfcopy + use med_internalstate_mod , only : compatm, compocn, coupling_mode, aoflux_code, mapconsd, mapconsf, mapfcopy use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_chkerr @@ -1080,7 +1080,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) end do end if if (compute_atm_dens) then - if (trim(coupling_mode) == 'nems_frac_aoflux') then + if (trim(aoflux_code) == 'ccpp' .and. trim(coupling_mode) == 'nems_frac_aoflux') then ! Add limiting factor to humidity to be consistent with UFS aoflux calculation do n = 1,aoflux_in%lsize if (aoflux_in%mask(n) /= 0._r8) then @@ -1120,29 +1120,31 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) missval=0.0_r8) #else -#ifdef UFS_AOFLUX if (trim(coupling_mode) == 'nems_frac_aoflux') then - call flux_atmocn_ccpp(& - nMax=aoflux_in%lsize, psfc=aoflux_in%psfc, & - pbot=aoflux_in%pbot, tbot=aoflux_in%tbot, qbot=aoflux_in%shum, lwdn=aoflux_in%lwdn, & - zbot=aoflux_in%zbot, garea=aoflux_in%garea, ubot=aoflux_in%ubot, usfc=aoflux_in%usfc, vbot=aoflux_in%vbot, & - vsfc=aoflux_in%vsfc, rbot=aoflux_in%dens, ts=aoflux_in%tocn, mask=aoflux_in%mask, & - sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evp=aoflux_out%evap, & - taux=aoflux_out%taux, tauy=aoflux_out%tauy, qref=aoflux_out%qref, & - missval=0.0_r8) - else +#ifdef UFS_AOFLUX + if (trim(aoflux_code) == 'ccpp') then + call flux_atmocn_ccpp(& + nMax=aoflux_in%lsize, psfc=aoflux_in%psfc, & + pbot=aoflux_in%pbot, tbot=aoflux_in%tbot, qbot=aoflux_in%shum, lwdn=aoflux_in%lwdn, & + zbot=aoflux_in%zbot, garea=aoflux_in%garea, ubot=aoflux_in%ubot, usfc=aoflux_in%usfc, vbot=aoflux_in%vbot, & + vsfc=aoflux_in%vsfc, rbot=aoflux_in%dens, ts=aoflux_in%tocn, mask=aoflux_in%mask, & + sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evp=aoflux_out%evap, & + taux=aoflux_out%taux, tauy=aoflux_out%tauy, qref=aoflux_out%qref, & + missval=0.0_r8) + else #endif - call flux_atmocn (logunit=logunit, & - nMax=aoflux_in%lsize, mask=aoflux_in%mask, & - zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, qbot=aoflux_in%shum, & - rbot=aoflux_in%dens, tbot=aoflux_in%tbot, us=aoflux_in%uocn, vs=aoflux_in%vocn, ts=aoflux_in%tocn, & - ocn_surface_flux_scheme=ocn_surface_flux_scheme, & - sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evap=aoflux_out%evap, & - taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & - duu10n=aoflux_out%duu10n, missval=0.0_r8) + call flux_atmocn (logunit=logunit, & + nMax=aoflux_in%lsize, mask=aoflux_in%mask, & + zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, qbot=aoflux_in%shum, & + rbot=aoflux_in%dens, tbot=aoflux_in%tbot, us=aoflux_in%uocn, vs=aoflux_in%vocn, ts=aoflux_in%tocn, & + ocn_surface_flux_scheme=ocn_surface_flux_scheme, & + sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evap=aoflux_out%evap, & + taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & + duu10n=aoflux_out%duu10n, missval=0.0_r8) #ifdef UFS_AOFLUX - end if + end if #endif + end if #endif diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index f1e49af68..2354e04f4 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -288,21 +288,21 @@ subroutine med_phases_prep_atm_custom_nems(gcomp, rc) lsize = size(field) allocate(customwgt(lsize)) - if (trim(coupling_mode) == 'nems_frac_aoflux') then - ! change signs - customwgt(:) = -1.0_r8 - call med_merge_field(is_local%wrap%FBExp(compatm), 'Faox_sen', & - FBinA=is_local%wrap%FBMed_aoflux_a, fnameA='Faox_sen', wgtA=customwgt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call med_merge_field(is_local%wrap%FBExp(compatm), 'Faox_lat', & - FBinA=is_local%wrap%FBMed_aoflux_a, fnameA='Faox_lat', wgtA=customwgt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call med_merge_field(is_local%wrap%FBExp(compatm), 'Faox_lwup', & - FBinA=is_local%wrap%FBMed_aoflux_a, fnameA='Faox_lwup', wgtA=customwgt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + !if (trim(coupling_mode) == 'nems_frac_aoflux') then + ! ! change signs + ! customwgt(:) = -1.0_r8 + ! call med_merge_field(is_local%wrap%FBExp(compatm), 'Faox_sen', & + ! FBinA=is_local%wrap%FBMed_aoflux_a, fnameA='Faox_sen', wgtA=customwgt, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! + ! call med_merge_field(is_local%wrap%FBExp(compatm), 'Faox_lat', & + ! FBinA=is_local%wrap%FBMed_aoflux_a, fnameA='Faox_lat', wgtA=customwgt, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! + ! call med_merge_field(is_local%wrap%FBExp(compatm), 'Faox_lwup', & + ! FBinA=is_local%wrap%FBMed_aoflux_a, fnameA='Faox_lwup', wgtA=customwgt, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + !end if deallocate(customwgt) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 9084ad38e..db11c0c0a 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -571,8 +571,7 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) allocate(customwgt(lsize)) if (trim(coupling_mode) == 'nems_orig' .or. & - trim(coupling_mode) == 'nems_frac' .or. & - trim(coupling_mode) == 'nems_frac_aoflux') then + trim(coupling_mode) == 'nems_frac') then customwgt(:) = -ofrac(:) / const_lhvap call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_evap', & FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_lat' , wgtA=customwgt, rc=rc) @@ -584,14 +583,19 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return customwgt(:) = -ofrac(:) - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_taux', & - FBinA=is_local%wrap%FBImp(compice,compocn), fnameA='Fioi_taux' , wgtA=ifrac, & - FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_taux' , wgtB=customwgt, rc=rc) + call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_taux', & + FBinA=is_local%wrap%FBImp(compice,compocn), fnameA='Fioi_taux', wgtA=ifrac, & + FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_taux', wgtB=customwgt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_tauy', & - FBinA=is_local%wrap%FBImp(compice,compocn), fnameA='Fioi_tauy' , wgtA=ifrac, & - FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_tauy' , wgtB=customwgt, rc=rc) + call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_tauy', & + FBinA=is_local%wrap%FBImp(compice,compocn), fnameA='Fioi_tauy', wgtA=ifrac, & + FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_tauy', wgtB=customwgt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !else if (trim(coupling_mode) == 'nems_frac_aoflux') then + ! customwgt(:) = -ofrac(:) + ! call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_sen', & + ! FBinA=is_local%wrap%FBMed_aoflux_o, fnameA='Faox_sen', wgtA=customwgt, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! netsw_for_ocn = [downsw_from_atm*(1-ice_fraction)*(1-ocn_albedo)] + [pensw_from_ice*(ice_fraction)] diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index 313f83da9..93ce20c41 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -511,12 +511,12 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & ztmax_ice , huge , errmsg , & errflg) - !--- unit conversion --- + !--- unit and sign conversion to be consistent with other flux scheme --- do n = 1, nMax if (mask(n) /= 0) then - sen(n) = hflx_wat(n)*rbot(n)*cp - lat(n) = evap_wat(n)*rbot(n)*hvap - lwup(n) = semis_wat(n)*sbc*ts(n)**4+(1.0_r8-semis_wat(n))*lwdn(n) + sen(n) = -1.0_r8*hflx_wat(n)*rbot(n)*cp + lat(n) = -1.0_r8*evap_wat(n)*rbot(n)*hvap + lwup(n) = -1.0_r8*(semis_wat(n)*sbc*ts(n)**4+(1.0_r8-semis_wat(n))*lwdn(n)) evp(n) = lat(n)/hvap taux(n) = rbot(n)*stress(n)*ubot(n)/wind(n) tauy(n) = rbot(n)*stress(n)*vbot(n)/wind(n) From 5fec3a0f0cc4607cdae6737b3d8db9943ebb1d4a Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 13 Jan 2022 16:26:38 -0700 Subject: [PATCH 013/395] revert mods in prep atm phase --- mediator/med_phases_prep_atm_mod.F90 | 81 +--------------------------- 1 file changed, 2 insertions(+), 79 deletions(-) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 2354e04f4..10351a8ee 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -13,8 +13,7 @@ module med_phases_prep_atm_mod use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk - use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr - use med_merge_mod , only : med_merge_auto, med_merge_field + use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, mastertask use med_internalstate_mod , only : compatm, compocn, compice, compname, coupling_mode @@ -26,8 +25,6 @@ module med_phases_prep_atm_mod public :: med_phases_prep_atm - private :: med_phases_prep_atm_custom_nems - character(*), parameter :: u_FILE_u = & __FILE__ @@ -111,7 +108,7 @@ subroutine med_phases_prep_atm(gcomp, rc) !--- map atm/ocn fluxes from ocn to atm grid if appropriate !--------------------------------------- if (trim(coupling_mode) == 'cesm' .or. & - trim(coupling_mode) == 'hafs' .or. & + trim(coupling_mode) == 'hafs' .or. & trim(coupling_mode) == 'nems_frac_aoflux') then if (is_local%wrap%aoflux_grid == 'ogrid') then call med_map_field_packed( & @@ -232,12 +229,6 @@ subroutine med_phases_prep_atm(gcomp, rc) end do end if - ! custom merges to atmosphere - if (trim(coupling_mode(1:5)) == 'nems_') then - call med_phases_prep_atm_custom_nems(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if @@ -245,72 +236,4 @@ subroutine med_phases_prep_atm(gcomp, rc) end subroutine med_phases_prep_atm - !----------------------------------------------------------------------------- - subroutine med_phases_prep_atm_custom_nems(gcomp, rc) - - ! ---------------------------------------------- - ! Custom calculation for nems_frac_aoflux - ! ---------------------------------------------- - - use ESMF , only : ESMF_GridComp - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR - - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(InternalState) :: is_local - real(r8), pointer :: customwgt(:) - real(r8), pointer :: field(:) - integer :: lsize - character(len=*), parameter :: subname='(med_phases_prep_atm_custom_nems)' - !--------------------------------------- - - rc = ESMF_SUCCESS - - call t_startf('MED:'//subname) - if (dbug_flag > 20) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - end if - call memcheck(subname, 5, mastertask) - - ! Get the internal state - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! get field on the atm mesh to query lsize - call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Faox_sen' , field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - lsize = size(field) - allocate(customwgt(lsize)) - - !if (trim(coupling_mode) == 'nems_frac_aoflux') then - ! ! change signs - ! customwgt(:) = -1.0_r8 - ! call med_merge_field(is_local%wrap%FBExp(compatm), 'Faox_sen', & - ! FBinA=is_local%wrap%FBMed_aoflux_a, fnameA='Faox_sen', wgtA=customwgt, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! - ! call med_merge_field(is_local%wrap%FBExp(compatm), 'Faox_lat', & - ! FBinA=is_local%wrap%FBMed_aoflux_a, fnameA='Faox_lat', wgtA=customwgt, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! - ! call med_merge_field(is_local%wrap%FBExp(compatm), 'Faox_lwup', & - ! FBinA=is_local%wrap%FBMed_aoflux_a, fnameA='Faox_lwup', wgtA=customwgt, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - !end if - - deallocate(customwgt) - - if (dbug_flag > 20) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - end if - call t_stopf('MED:'//subname) - - end subroutine med_phases_prep_atm_custom_nems - end module med_phases_prep_atm_mod From 35fb61bf1bd3afcec86bdf52c3ec0c2303771669 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 20 Jan 2022 22:47:09 -0700 Subject: [PATCH 014/395] update exchnage field to work with fully coupled application --- mediator/esmFldsExchange_nems_mod.F90 | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 7684923e7..cb504680c 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -367,11 +367,18 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) !===================================================================== ! to lnd - states and fluxes from atm - allocate(flds(16)) - flds = (/'Sa_z ', 'Sa_topo ', 'Sa_tbot ', 'Sa_pbot ', & - 'Sa_shum ', 'Sa_u ', 'Sa_v ', 'Faxa_lwdn ', & - 'Sa_ptem ', 'Sa_dens ', 'Faxa_swdn ', 'Faxa_swnet', & - 'Faxa_snowc', 'Faxa_snowl', 'Faxa_rainc', 'Faxa_rainl' /) + if ( trim(coupling_mode) == 'nems_orig_data') then + allocate(flds(16)) + flds = (/'Sa_z ', 'Sa_topo ', 'Sa_tbot ', 'Sa_pbot ', & + 'Sa_shum ', 'Sa_u ', 'Sa_v ', 'Faxa_lwdn ', & + 'Sa_ptem ', 'Sa_dens ', 'Faxa_swdn ', 'Faxa_swnet', & + 'Faxa_snowc', 'Faxa_snowl', 'Faxa_rainc', 'Faxa_rainl' /) + else + allocate(flds(9)) + flds = (/'Sa_z ', 'Sa_tbot ', 'Sa_pbot ', 'Sa_shum ', & + 'Sa_u ', 'Sa_v ', 'Faxa_swdn ', 'Faxa_lwdn ', & + 'Faxa_rain ' /) + end if do n = 1,size(flds) fldname = trim(flds(n)) call addfld(fldListFr(compatm)%flds, trim(fldname)) From 22af6e51344366554d017c14af364b646ac62c51 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Fri, 28 Jan 2022 12:49:24 -0700 Subject: [PATCH 015/395] initial attempt to have host model for CCPP --- mediator/med_phases_aofluxes_mod.F90 | 20 +- ufs/ccpp/config/ccpp_prebuild_config.py | 207 +++++++++ ufs/ccpp/data/GFS_typedefs.F90 | 41 ++ ufs/ccpp/data/GFS_typedefs.meta | 61 +++ ufs/ccpp/data/med_typedefs.F90 | 21 + ufs/ccpp/data/med_typedefs.meta | 42 ++ ufs/ccpp/driver/ccpp_driver.F90 | 51 +++ ufs/flux_atmocn_ccpp_mod.F90 | 539 ++---------------------- 8 files changed, 459 insertions(+), 523 deletions(-) create mode 100644 ufs/ccpp/config/ccpp_prebuild_config.py create mode 100644 ufs/ccpp/data/GFS_typedefs.F90 create mode 100644 ufs/ccpp/data/GFS_typedefs.meta create mode 100644 ufs/ccpp/data/med_typedefs.F90 create mode 100644 ufs/ccpp/data/med_typedefs.meta create mode 100644 ufs/ccpp/driver/ccpp_driver.F90 diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 75154ecb8..26b55066c 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -946,7 +946,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) use flux_atmocn_mod, only : flux_atmocn #endif #ifdef UFS_AOFLUX - use flux_atmocn_ccpp_mod, only : flux_atmocn_ccpp + use flux_atmocn_ccpp_mod, only : flux_atmOcn_init + use flux_atmocn_ccpp_mod, only : flux_atmOcn_run + use flux_atmocn_ccpp_mod, only : flux_atmOcn_finalize #endif ! Arguments @@ -1123,14 +1125,8 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) if (trim(coupling_mode) == 'nems_frac_aoflux') then #ifdef UFS_AOFLUX if (trim(aoflux_code) == 'ccpp') then - call flux_atmocn_ccpp(& - nMax=aoflux_in%lsize, psfc=aoflux_in%psfc, & - pbot=aoflux_in%pbot, tbot=aoflux_in%tbot, qbot=aoflux_in%shum, lwdn=aoflux_in%lwdn, & - zbot=aoflux_in%zbot, garea=aoflux_in%garea, ubot=aoflux_in%ubot, usfc=aoflux_in%usfc, vbot=aoflux_in%vbot, & - vsfc=aoflux_in%vsfc, rbot=aoflux_in%dens, ts=aoflux_in%tocn, mask=aoflux_in%mask, & - sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evp=aoflux_out%evap, & - taux=aoflux_out%taux, tauy=aoflux_out%tauy, qref=aoflux_out%qref, & - missval=0.0_r8) + ! TODO: call ccpp + print*, "calling ccpp" else #endif call flux_atmocn (logunit=logunit, & @@ -1144,9 +1140,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) #ifdef UFS_AOFLUX end if #endif - end if - -#endif +! end if +! +!#endif do n = 1,aoflux_in%lsize if (aoflux_in%mask(n) /= 0) then diff --git a/ufs/ccpp/config/ccpp_prebuild_config.py b/ufs/ccpp/config/ccpp_prebuild_config.py new file mode 100644 index 000000000..0e1ca932f --- /dev/null +++ b/ufs/ccpp/config/ccpp_prebuild_config.py @@ -0,0 +1,207 @@ +#!/usr/bin/env python + +############################################################################### +# Used modules # +############################################################################### + +import os + +############################################################################### +# Query required information/s # +############################################################################### + +fv3_path = os.environ['FV3_PATH'] + +############################################################################### +# Definitions # +############################################################################### + +HOST_MODEL_IDENTIFIER = "CMEPS" + +# Add all files with metadata tables on the host model side and in CCPP, +# relative to basedir = top-level directory of host model. This includes +# kind and type definitions used in CCPP physics. Also add any internal +# dependencies of these files to the list. +VARIABLE_DEFINITION_FILES = [ + # actual variable definition files + '{}/ccpp/framework/src/ccpp_types.F90'.format(fv3_path), + '{}/ccpp/physics/physics/machine.F'.format(fv3_path), + 'CMEPS/ufs/ccpp/data/GFS_typedefs.F90', + 'CMEPS/ufs/ccpp/data/med_typedefs.F90' + ] + +TYPEDEFS_NEW_METADATA = { + 'ccpp_types' : { + 'ccpp_t' : 'cdata', + 'ccpp_types' : '', + }, + 'machine' : { + 'machine' : '', + }, + 'GFS_typedefs' : { + 'GFS_statein_type' : 'physics%Statein', + 'GFS_typedefs' : '', + }, + 'med_typedefs' : { + 'med_typedefs' : '', + 'physics_type' : 'physics', + } + } + +# Add all physics scheme files relative to basedir +SCHEME_FILES = ['{}/ccpp/physics/physics/sfc_ocean.F'.format(fv3_path)] + # Relative path to source (from where ccpp_prebuild.py is called) : [ list of physics sets in which scheme may be called ]; + # current restrictions are that each scheme can only belong to one physics set, and all schemes within one group in the + # suite definition file have to belong to the same physics set + #'{}/ccpp/physics/physics/GFS_DCNV_generic.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_GWD_generic.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_MP_generic.F90'.format(fv3_pathmt(fv3_path), + #'{}/ccpp/physics/physics/GFS_PBL_generic.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_SCNV_generic.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_debug.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_phys_time_vary.fv3.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_rad_time_vary.fv3.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_radiation_surface.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_rrtmg_post.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_rrtmg_pre.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_rrtmg_setup.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_stochastics.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_suite_interstitial.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_surface_generic.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_surface_composites.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_surface_loop_control.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_time_vary_pre.fv3.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/cires_ugwp.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/cires_ugwp_post.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/unified_ugwp.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/unified_ugwp_post.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/ugwpv1_gsldrag.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/ugwpv1_gsldrag_post.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/cnvc90.f'.format(fv3_path), + #'{}/ccpp/physics/physics/cs_conv.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/cs_conv_aw_adj.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/cu_ntiedtke_pre.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/cu_ntiedtke.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/cu_ntiedtke_post.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/dcyc2.f'.format(fv3_path), + #'{}/ccpp/physics/physics/drag_suite.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/gcm_shoc.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/get_prs_fv3.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/gfdl_cloud_microphys.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/gfdl_fv_sat_adj.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/gfdl_sfc_layer.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/gscond.f'.format(fv3_path), + #'{}/ccpp/physics/physics/gwdc.f'.format(fv3_path), + #'{}/ccpp/physics/physics/gwdps.f'.format(fv3_path), + #'{}/ccpp/physics/physics/h2ophys.f'.format(fv3_path), + #'{}/ccpp/physics/physics/samfdeepcnv.f'.format(fv3_path), + #'{}/ccpp/physics/physics/samfshalcnv.f', + #'{}/ccpp/physics/physics/sascnvn.F'.format(fv3_path), + #'{}/ccpp/physics/physics/shalcnv.F'.format(fv3_path), + #'{}/ccpp/physics/physics/maximum_hourly_diagnostics.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/m_micro.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/m_micro_interstitial.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/cu_gf_driver_pre.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/cu_gf_driver.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/cu_gf_driver_post.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/moninedmf.f'.format(fv3_path), + #'{}/ccpp/physics/physics/moninshoc.f'.format(fv3_path), + #'{}/ccpp/physics/physics/satmedmfvdif.F'.format(fv3_path), + #'{}/ccpp/physics/physics/satmedmfvdifq.F'.format(fv3_path), + #'{}/ccpp/physics/physics/shinhongvdif.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/ysuvdif.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/module_MYNNPBL_wrapper.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/module_MYNNSFC_wrapper.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/module_SGSCloud_RadPre.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/module_SGSCloud_RadPost.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/module_MYJSFC_wrapper.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/module_MYJPBL_wrapper.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/mp_thompson_pre.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/mp_thompson.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/mp_thompson_post.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/ozphys.f'.format(fv3_path), + #'{}/ccpp/physics/physics/ozphys_2015.f'.format(fv3_path), + #'{}/ccpp/physics/physics/precpd.f'.format(fv3_path), + #'{}/ccpp/physics/physics/phys_tend.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/radlw_main.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/radsw_main.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/rascnv.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/rayleigh_damp.f'.format(fv3_path), + #'{}/ccpp/physics/physics/rrtmg_lw_post.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/rrtmg_lw_pre.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/rrtmg_sw_post.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/rrtmg_sw_pre.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/sfc_diag.f'.format(fv3_path), + #'{}/ccpp/physics/physics/sfc_diag_post.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/sfc_drv_ruc.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/sfc_cice.f'.format(fv3_path), + #'{}/ccpp/physics/physics/sfc_diff.f'.format(fv3_path), + #'{}/ccpp/physics/physics/sfc_drv.f'.format(fv3_path), + #'{}/ccpp/physics/physics/sfc_noahmp_drv.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/flake_driver.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/sfc_nst.f'.format(fv3_path), + #'{}/ccpp/physics/physics/sfc_ocean.F'.format(fv3_path), + #'{}/ccpp/physics/physics/sfc_sice.f'.format(fv3_path), + ## HAFS FER_HIRES + #'{}/ccpp/physics/physics/mp_fer_hires.F90'.format(fv3_path), + ## RRTMGP + #'{}/ccpp/physics/physics/rrtmgp_lw_gas_optics.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/rrtmgp_lw_cloud_optics.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/rrtmgp_sw_gas_optics.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/rrtmgp_sw_cloud_optics.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/rrtmgp_sw_aerosol_optics.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/rrtmgp_lw_rte.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/rrtmgp_sw_rte.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/rrtmgp_lw_aerosol_optics.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_rrtmgp_setup.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_rrtmgp_pre.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/rrtmgp_lw_pre.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_rrtmgp_sw_pre.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_rrtmgp_lw_post.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/rrtmgp_lw_cloud_sampling.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/rrtmgp_sw_cloud_sampling.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_cloud_diagnostics.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_rrtmgp_thompsonmp_pre.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_rrtmgp_gfdlmp_pre.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_rrtmgp_zhaocarr_pre.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_rrtmgp_cloud_overlap_pre.F90'.format(fv3_path), + #'{}/ccpp/physics/physics/GFS_rrtmgp_sw_post.F90'.format(fv3_path) + #] + +# Default build dir, relative to current working directory, +# if not specified as command-line argument +DEFAULT_BUILD_DIR = 'CMEPS' + +# Auto-generated makefile/cmakefile snippets that contain all type definitions +TYPEDEFS_MAKEFILE = '{build_dir}/physics/CCPP_TYPEDEFS.mk' +TYPEDEFS_CMAKEFILE = '{build_dir}/physics/CCPP_TYPEDEFS.cmake' +TYPEDEFS_SOURCEFILE = '{build_dir}/physics/CCPP_TYPEDEFS.sh' + +# Auto-generated makefile/cmakefile snippets that contain all schemes +SCHEMES_MAKEFILE = '{build_dir}/physics/CCPP_SCHEMES.mk' +SCHEMES_CMAKEFILE = '{build_dir}/physics/CCPP_SCHEMES.cmake' +SCHEMES_SOURCEFILE = '{build_dir}/physics/CCPP_SCHEMES.sh' + +# Auto-generated makefile/cmakefile snippets that contain all caps +CAPS_MAKEFILE = '{build_dir}/physics/CCPP_CAPS.mk' +CAPS_CMAKEFILE = '{build_dir}/physics/CCPP_CAPS.cmake' +CAPS_SOURCEFILE = '{build_dir}/physics/CCPP_CAPS.sh' + +# Directory where to put all auto-generated physics caps +CAPS_DIR = '{build_dir}/physics' + +# Directory where the suite definition files are stored +SUITES_DIR = '{}/ccpp/suites'.format(fv3_path) + +# Directory where to write static API to +STATIC_API_DIR = '{build_dir}/physics' +STATIC_API_SRCFILE = '{build_dir}/physics/CCPP_STATIC_API.sh' + +# Directory for writing HTML pages generated from metadata files +METADATA_HTML_OUTPUT_DIR = '{build_dir}/physics/physics/docs' + +# HTML document containing the model-defined CCPP variables +HTML_VARTABLE_FILE = '{build_dir}/physics/CCPP_VARIABLES_CMEPS.html' + +# LaTeX document containing the provided vs requested CCPP variables +LATEX_VARTABLE_FILE = '{build_dir}/framework/doc/DevelopersGuide/CCPP_VARIABLES_CMEPS.tex' diff --git a/ufs/ccpp/data/GFS_typedefs.F90 b/ufs/ccpp/data/GFS_typedefs.F90 new file mode 100644 index 000000000..755d7575f --- /dev/null +++ b/ufs/ccpp/data/GFS_typedefs.F90 @@ -0,0 +1,41 @@ +module GFS_typedefs + use machine, only: kind_phys + + implicit none + + !--- parameter constants used for default initializations + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys + real(kind=kind_phys), parameter :: clear_val = zero + + !--- data containers + type GFS_statein_type + real (kind=kind_phys), pointer :: prsl(:) => null() !< model layer mean pressure Pa + real (kind=kind_phys), pointer :: tgrs(:) => null() !< model layer mean temperature in k + contains + procedure :: create => statein_create !< allocate array data + end type GFS_statein_type + +!------------------------------------------------------------------------------------ +! combined type of all of the above except GFS_control_type and GFS_interstitial_type +!------------------------------------------------------------------------------------ +!! \section arg_table_GFS_data_type +!! \htmlinclude GFS_data_type.html +!! + type GFS_data_type + type(GFS_statein_type) :: statein + end type GFS_data_type + + contains + + subroutine statein_create(statein, im) + class(GFS_statein_type) :: statein + integer, intent(in) :: im + + allocate(statein%prsl(im)) + statein%prsl = clear_val + allocate(statein%tgrs(im)) + statein%tgrs = clear_val + + end subroutine statein_create + +end module GFS_typedefs diff --git a/ufs/ccpp/data/GFS_typedefs.meta b/ufs/ccpp/data/GFS_typedefs.meta new file mode 100644 index 000000000..8c63994c6 --- /dev/null +++ b/ufs/ccpp/data/GFS_typedefs.meta @@ -0,0 +1,61 @@ +[ccpp-table-properties] + name = GFS_statein_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = GFS_statein_type + type = ddt +[prsl] + standard_name = air_pressure_at_surface_adjacent_layer + long_name = mean pressure at lowest model layer + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tgrs] + standard_name = air_temperature_at_surface_adjacent_layer + long_name = mean temperature at lowest model layer + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + +######################################################################## +[ccpp-table-properties] + name = GFS_data_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = GFS_data_type + type = ddt +[Statein] + standard_name = GFS_statein_type_instance + long_name = prognostic state data in from dycore + units = DDT + dimensions = () + type = GFS_statein_type + +######################################################################## +[ccpp-table-properties] + name = GFS_typedefs + type = module + relative_path = ../FV3/ccpp/physics/physics + dependencies = machine.F + +[ccpp-arg-table] + name = GFS_typedefs + type = module +[GFS_data_type] + standard_name = GFS_data_type + long_name = definition of type GFS_data_type + units = DDT + dimensions = () + type = GFS_data_type +[GFS_statein_type] + standard_name = GFS_statein_type + long_name = definition of type GFS_statein_type + units = DDT + dimensions = () + type = GFS_statein_type diff --git a/ufs/ccpp/data/med_typedefs.F90 b/ufs/ccpp/data/med_typedefs.F90 new file mode 100644 index 000000000..c9611dac1 --- /dev/null +++ b/ufs/ccpp/data/med_typedefs.F90 @@ -0,0 +1,21 @@ +!> \file med_type_defs.F90 +!! Contains type definitions for CMEPS-related and physics-related variables + +module med_type_defs + + use GFS_typedefs, only: GFS_statein_type + use machine, only: kind_phys + use ccpp_api, only: ccpp_t + + implicit none + + type physics_type + ype(GFS_statein_type) :: statein + end type physics_type + + type(physics_type), target :: physics + type(ccpp_t), target :: cdata + +contains + +end module med_type_defs diff --git a/ufs/ccpp/data/med_typedefs.meta b/ufs/ccpp/data/med_typedefs.meta new file mode 100644 index 000000000..5861ce0e4 --- /dev/null +++ b/ufs/ccpp/data/med_typedefs.meta @@ -0,0 +1,42 @@ +[ccpp-table-properties] + name = physics_type + type = ddt + dependencies = GFS_typedefs.F90 + +[ccpp-arg-table] + name = physics_type + type = ddt +[Statein] + standard_name = GFS_statein_type_instance + long_name = instance of derived type GFS_statein_type + units = DDT + dimensions = () + type = GFS_statein_type + +######################################################################## +[ccpp-table-properties] + name = med_typedefs + type = module + dependencies =GFS_typedefs.F90,../FV3/ccpp/physics/physics/machine.F,../FV3/ccpp/framework/src/ccpp_api.F90 + +[ccpp-arg-table] + name = med_typedefs + type = module +[physics_type] + standard_name = physics_type + long_name = definition of type physics_type + units = DDT + dimensions = () + type = physics_type +[physics] + standard_name = physics_type_instance + long_name = instance of derived data type physics_type + units = DDT + dimensions = () + type = physics_type +[cdata] + standard_name = ccpp_t_instance + long_name = instance of derived data type ccpp_t + units = DDT + dimensions = () + type = ccpp_t diff --git a/ufs/ccpp/driver/ccpp_driver.F90 b/ufs/ccpp/driver/ccpp_driver.F90 new file mode 100644 index 000000000..9e0477b63 --- /dev/null +++ b/ufs/ccpp/driver/ccpp_driver.F90 @@ -0,0 +1,51 @@ +module ccpp_driver + + use ccpp_api, only: ccpp_t + + implicit none + private + + public ccpp_step + + type(ccpp_t), pointer :: cdata => null() + integer :: nthrds + +!----------------------------------------------------------------------------- +contains +!----------------------------------------------------------------------------- + + subroutine ccpp_step(step, nblks, ierr) + + ! input/output variables + character(len=*), intent(in) :: step + integer, intent(in) :: nblks + integer, intent(out) :: ierr + + ! local variables + integer :: nb, nt + character(len=*), parameter :: subname='(ccpp_step)' + !----------------------------------------------------------- + + ierr = 0 + + if (trim(step)=="init") then + ! set number of threads + ! TODO: also support OpenMP threading + nthrds = 1 + + ! allocate cdata structures for blocks and threads + if (.not. allocated(cdata_block)) allocate(cdata_block(1:nblks,1:nthrds)) + + ! loop over all blocks and threads + do nt=1, nthrds + do nb=1, nblks + ! assign the correct block and thread numbers + cdata_block(nb,nt)%blk_no = nb + cdata_block(nb,nt)%thrd_no = nt + end do + end do + end if + + end subroutine ccpp_step + +end module ccpp_driver diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index 93ce20c41..6fb209ab4 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -1,539 +1,56 @@ module flux_atmocn_ccpp_mod - use machine , only: kp => kind_phys - use funcphys , only: gpvs, fpvs, fpvsx - use physcons , only: eps => con_eps - use physcons , only: epsm1 => con_epsm1 - use physcons , only: grav => con_g - use physcons , only: rvrdm1 => con_fvirt - use physcons , only: cappa => con_rocp - use physcons , only: hvap => con_hvap - use physcons , only: cp => con_cp - use physcons , only: rd => con_rd - use physcons , only: rv => con_rv - use physcons , only: hfus => con_hfus - use physcons , only: p0 => con_p0 - use physcons , only: tice => con_tice - use physcons , only: sbc => con_sbc - use sfc_diff , only: sfc_diff_run - use sfc_ocean, only: sfc_ocean_run - use GFS_surface_composites_pre , only: GFS_surface_composites_pre_run - use GFS_surface_composites_post , only: GFS_surface_composites_post_run - use GFS_surface_loop_control_part1, only: GFS_surface_loop_control_part1_run - use GFS_surface_loop_control_part2, only: GFS_surface_loop_control_part2_run - use ufs_kind_mod - use ufs_const_mod + use ccpp_api, only: ccpp_t + use ccpp_static_api, only: ccpp_physics_init + use ccpp_static_api, only: ccpp_physics_run + use ccpp_static_api, only: ccpp_physics_finalize implicit none private ! default private - public :: flux_atmOcn_ccpp ! computes atm/ocn fluxes - - !--- rename kinds for local readability only --- - integer,parameter :: r8 = SHR_KIND_R8 ! 8 byte real - - !--- variables that need to carried through the iterations --- - real(kp), allocatable, dimension(:) :: z0rl , z0rl_wav , & - z0rl_wat , z0rl_lnd , z0rl_ice , & - ustar , fm , fh , & - fm10 , hflx , evap + public :: flux_atmOcn_init + public :: flux_atmOcn_run + public :: flux_atmOcn_finalize !=============================================================================== contains !=============================================================================== - subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & - garea, ubot, usfc, vbot, vsfc, rbot, ts, lwdn, sen, lat, & - lwup, evp, taux, tauy, qref, missval) - + subroutine flux_atmOcn_init(ccpp_suite_name) implicit none !--- input arguments -------------------------------- - integer , intent(in) :: nMax ! data vector length - integer , intent(in) :: mask (nMax) ! ocn domain mask - real(r8), intent(in) :: psfc(nMax) ! atm P (surface) (Pa) - real(r8), intent(in) :: pbot(nMax) ! atm P (bottom) (Pa) - real(r8), intent(in) :: tbot(nMax) ! atm T (bottom) (K) - real(r8), intent(in) :: qbot(nMax) ! atm specific humidity (bottom) (kg/kg) - real(r8), intent(in) :: zbot(nMax) ! atm level height (m) - real(r8), intent(in) :: garea(nMax) ! grid area (m^2) - real(r8), intent(in) :: ubot(nMax) ! atm u wind (bottom) (m/s) - real(r8), intent(in) :: usfc(nMax) ! atm u wind (surface) (m/s) - real(r8), intent(in) :: vbot(nMax) ! atm v wind (bottom) (m/s) - real(r8), intent(in) :: vsfc(nMax) ! atm v wind (surface) (m/s) - real(r8), intent(in) :: rbot(nMax) ! atm density (kg/m^3) - real(r8), intent(in) :: lwdn(nMax) ! atm lw downward (W/m^2) - real(r8), intent(in) :: ts(nMax) ! ocn surface temperature (K) - real(r8), intent(in), optional :: missval ! masked value - - !--- output arguments ------------------------------- - real(r8), intent(out) :: sen(nMax) ! heat flux: sensible (W/m^2) - real(r8), intent(out) :: lat(nMax) ! heat flux: latent (W/m^2) - real(r8), intent(out) :: lwup(nMax) ! heat flux: lw upward (W/m^2) - real(r8), intent(out) :: evp(nMax) ! heat flux: evap ((kg/s)/m^2) - real(r8), intent(out) :: taux(nMax) ! surface stress, zonal (N) - real(r8), intent(out) :: tauy(nMax) ! surface stress, maridional (N) - real(r8), intent(out) :: qref(nMax) ! diag: 2m ref humidity (kg/kg) + character(len=*), intent(in) :: ccpp_suite_name !--- local variables -------------------------------- - integer :: n , iter , ivegsrc , & - sfc_z0_type , errflg , nstf_name1, & - lkm , nthreads , kice , & - lsm , lsm_noahmp, km - real(kp) :: spval , cpinv , hvapi , & - elocp , rch , tem , & - min_lakeice , min_seaice, tgice , & - h0facu , h0facs - logical :: redrag , thsfc_loc , lseaspray , & - flag_restart, frac_grid , cplflx , & - cplice , cplwav2atm, lheatstrg , & - use_med_flux - character(len=1024) :: errmsg - integer, dimension(nMax) :: vegtype , islmsk , islmsk_cice - real(kp), dimension(nMax) :: prsl1 , prslki , prsik1 , & - prslk1 , wind , sigmaf , & - shdmax , z0pert , ztpert , & - tsurf_wat , tsurf_lnd , tsurf_ice , & - zvfun , cm , cm_wat , & - cm_lnd , cm_ice , ch , & - ch_wat , ch_lnd , ch_ice , & - rb , rb_wat , rb_lnd , & - rb_ice , stress , & - stress_wat , stress_lnd, stress_ice, & - ztmax_wat , ztmax_lnd , ztmax_ice , & - landfrac , lakefrac , lakedepth , & - oceanfrac , frland , hice , & - cice , snowd , snowd_lnd , & - snowd_ice , tprcp , tprcp_wat , & - tprcp_lnd , tprcp_ice , weasd , & - weasd_lnd , weasd_ice , hflxq , & - tsfco , tsfcl , tisfc , & - slmsk , hffac , vfrac , & - qss , & - qss_wat , qss_lnd , qss_ice , & - tskin , & - tskin_wat , tskin_lnd , tskin_ice , & - ustar_wat , ustar_lnd , ustar_ice , & - fm_wat , fm_lnd , fm_ice , & - fh_wat , fh_lnd , fh_ice , & - fm10_wat , fm10_lnd , fm10_ice , & - fh2 , & - fh2_wat , fh2_lnd , fh2_ice , & - cmm , & - cmm_wat , cmm_lnd , cmm_ice , & - chh , & - chh_wat , chh_lnd , chh_ice , & - gflx , & - gflx_wat , gflx_lnd , gflx_ice , & - ep1d , & - ep1d_wat , ep1d_lnd , ep1d_ice , & - evap_wat , evap_lnd , evap_ice , & - hflx_wat , hflx_lnd , hflx_ice , & - tsfc , & - tsfc_wat , tsfc_lnd , tsfc_ice , & - semis_rad , emis_lnd , emis_ice , & - semis_wat , semis_lnd , semis_ice , & - dqsfc , dtsfc - real(kp), dimension(nMax,1) :: tiice , stc - logical, dimension(nMax) :: flag_iter , flag_guess, use_flake , & - wet , dry , icy , & - flag_cice , lake - - !--- local variables that are carried out ----------- - logical, save :: flag_init = .true. - integer, save :: kdt = 0 - - !--- parameters ------------------------------------- - real(kp), parameter :: huge = 9.9692099683868690E36 - real(kp), parameter :: zero = 0.0_kp - real(kp), parameter :: clear_val = zero - - !--- missing value --- - if (present(missval)) then - spval = missval - else - spval = shr_const_spval - endif - - !--- addtional constants --- - cpinv = 1.0_kp/cp - hvapi = 1.0_kp/hvap - elocp = hvap/cp - - !--- compute some needed quantities --- - wind(:) = sqrt(ubot(:)**2+vbot(:)**2) - - !--- compute dimensionless exner function --- - prslk1(:) = (pbot(:)/p0)**cappa ! dimensionless_exner_function_at_surface_adjacent_layer - prsik1(:) = (psfc(:)/p0)**cappa ! surface_dimensionless_exner_function - prslki(:) = prsik1(:)/prslk1(:) ! ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer - - !--- initialization of variables --- - kice = 1 ! vertical_dimension_of_sea_ice - km = 1 ! vertical_dimension_of_soil - tiice(:,:) = 0.0_kp ! temperature_in_ice_layer - lheatstrg = .true. ! flag_for_canopy_heat_storage_in_land_surface_scheme - h0facu = 0.25_kp ! multiplicative_tuning_parameter_for_reduced_surface_heat_fluxes_due_to_canopy_heat_storage - h0facs = 1.0 ! multiplicative_tuning_parameter_for_reduced_latent_heat_flux_due_to_canopy_heat_storage - hflxq(:) = 0.0_kp ! kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness_and_vegetation - hffac(:) = 0.0_kp ! surface_upward_sensible_heat_flux_reduction_factor - stc(:,:) = 0.0_kp ! soil_temperature - - flag_restart = .true. ! flag_for_restart, restart run - lkm = 0 ! control_for_lake_surface_scheme - frac_grid = .true. ! flag_for_fractional_landmask - flag_cice(:) = .true. ! flag_for_cice - cplflx = .true. ! flag_for_surface_flux_coupling - cplice = .true. ! flag_for_sea_ice_coupling - cplwav2atm = .false. ! flag_for_one_way_ocean_wave_coupling_to_atmosphere - where (mask(:) /= 0) - landfrac(:) = 0.0_kp ! land_area_fraction - elsewhere - landfrac(:) = 1.0_kp ! land_area_fraction - end where - lakefrac(:) = 0.0_kp ! lake_area_fraction - lakedepth(:) = 0.0_kp ! lake_depth - where (mask(:) /= 0) - oceanfrac(:) = 1.0_kp ! sea_area_fraction - elsewhere - oceanfrac(:) = 0.0_kp ! sea_area_fraction - end where - frland(:) = 0.0_kp ! land_area_fraction_for_microphysics - dry(:) = .false. ! flag_nonzero_land_surface_fraction, no land - icy(:) = .false. ! flag_nonzero_sea_ice_surface_fraction, no sea-ice - lake(:) = .false. ! flag_nonzero_lake_surface_fraction - use_flake(:) = .false. ! flag_for_using_flake - wet(:) = .false. ! flag_nonzero_wet_surface_fraction - hice(:) = 0.0_kp ! sea_ice_thickness - cice(:) = 0.0_kp ! sea_ice_area_fraction_of_sea_area_fraction - - if (flag_init) then - allocate(z0rl(nMax)) - z0rl(:) = 0.0_kp ! surface_roughness_length - allocate(z0rl_wat(nMax)) - z0rl_wat(:) = 0.0_kp ! surface_roughness_length_over_water - allocate(z0rl_lnd(nMax)) - z0rl_lnd(:) = 0.0_kp ! surface_roughness_length_over_land - allocate(z0rl_ice(nMax)) - z0rl_ice(:) = 0.0_kp ! surface_roughness_length_over_ice - allocate(z0rl_wav(nMax)) - z0rl_wav(:) = 0.0_kp ! surface_roughness_length_from_wave_model - end if - - snowd(:) = 0.0_kp ! lwe_surface_snow - snowd_lnd(:) = 0.0_kp ! surface_snow_thickness_water_equivalent_over_land - snowd_ice(:) = 0.0_kp ! surface_snow_thickness_water_equivalent_over_ice - tprcp(:) = 0.0_kp ! nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep - tprcp_wat(:) = 0.0_kp ! nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_water - tprcp_lnd(:) = 0.0_kp ! nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land - tprcp_ice(:) = 0.0_kp ! nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ice - - if (flag_init) then - allocate(ustar(nMax)) - ustar(:) = 0.0_kp ! surface_friction_velocity - end if - - ustar_wat(:) = 0.0_kp ! surface_friction_velocity_over_water - ustar_lnd(:) = 0.0_kp ! surface_friction_velocity_over_land - ustar_ice(:) = 0.0_kp ! surface_friction_velocity_over_ice - weasd(:) = 0.0_kp ! lwe_thickness_of_surface_snow_amount - weasd_lnd(:) = 0.0_kp ! water_equivalent_accumulated_snow_depth_over_land - weasd_ice(:) = 0.0_kp ! water_equivalent_accumulated_snow_depth_over_ice - tskin(:) = 0.0_kp ! surface_skin_temperature - tskin_wat(:) = 0.0_kp ! surface_skin_temperature_over_water - tskin_lnd(:) = 0.0_kp ! surface_skin_temperature_over_land - tskin_ice(:) = 0.0_kp ! surface_skin_temperature_over_ice - tsfc(:) = 0.0_kp ! surface_skin_temperature - tsfc_wat(:) = 0.0_kp ! surface_skin_temperature_over_water_interstitial - tsfc_lnd(:) = 0.0_kp ! surface_skin_temperature_over_land_interstitial - tsfc_ice(:) = 0.0_kp ! surface_skin_temperature_over_ice_interstitial - tsfco(:) = ts(:) ! sea_surface_temperature - tsurf_wat(:) = 0.0_kp ! surface_skin_temperature_after_iteration_over_water - tsurf_lnd(:) = 0.0_kp ! surface_skin_temperature_after_iteration_over_land - tsurf_ice(:) = 0.0_kp ! surface_skin_temperature_after_iteration_over_ice - tisfc(:) = 0.0_kp ! sea_ice_temperature - tgice = tice ! freezing_point_temperature_of_seawater - islmsk(:) = 0 ! sea_land_ice_mask, all sea - islmsk_cice(:) = 0 ! sea_land_ice_mask_cice, all sea - slmsk(:) = 0 ! area_type, all sea - qss(:) = qbot(:) ! surface_specific_humidity ? not the lowest level - qss_wat(:) = qss(:) ! surface_specific_humidity_over_water - qss_lnd(:) = 0.0_kp ! surface_specific_humidity_over_land - qss_ice(:) = 0.0_kp ! surface_specific_humidity_over_ice - min_lakeice = 0.15_kp ! min_lake_ice_area_fraction - min_seaice = 1.0e-11_kp ! min_sea_ice_area_fraction - kdt = kdt+1 ! index_of_timestep - - sigmaf(:) = 0.0_kp ! bounded_vegetation_area_fraction, no veg - vegtype(:) = 0 ! vegetation_type_classification - shdmax(:) = 0.0_kp ! max_vegetation_area_fraction - ivegsrc = 1 ! control_for_vegetation_dataset, IGBP - z0pert(:) = 0.0_kp ! perturbation_of_momentum_roughness_length - ztpert(:) = 0.0_kp ! perturbation_of_heat_to_momentum_roughness_length_ratio - flag_iter(:) = .true. ! flag_for_iteration - redrag = .true. ! flag_for_limited_surface_roughness_length_over_ocean, redrag in input.nml - sfc_z0_type = 0 ! flag_for_surface_roughness_option_over_water, no change - thsfc_loc = .true. ! flag_for_reference_pressure_theta - cm(:) = 0.0_kp ! surface_drag_coefficient_for_momentum - cm_wat(:) = 0.0_kp ! surface_drag_coefficient_for_momentum_in_air_over_water - cm_lnd(:) = 0.0_kp ! surface_drag_coefficient_for_momentum_in_air_over_land - cm_ice(:) = 0.0_kp ! surface_drag_coefficient_for_momentum_in_air_over_ice - ch(:) = 0.0_kp ! surface_drag_coefficient_for_heat_and_moisture - ch_wat(:) = 0.0_kp ! surface_drag_coefficient_for_heat_and_moisture_in_air_over_water - ch_lnd(:) = 0.0_kp ! surface_drag_coefficient_for_heat_and_moisture_in_air_over_land - ch_ice(:) = 0.0_kp ! surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice - rb(:) = 0.0_kp ! bulk_richardson_number_at_lowest_model_level - rb_wat(:) = 0.0_kp ! bulk_richardson_number_at_lowest_model_level_over_water - rb_lnd(:) = 0.0_kp ! bulk_richardson_number_at_lowest_model_level_over_land - rb_ice(:) = 0.0_kp ! bulk_richardson_number_at_lowest_model_level_over_ice - stress(:) = 0.0_kp ! surface_wind_stress - stress_wat(:) = 0.0_kp ! surface_wind_stress_over_water - stress_lnd(:) = 0.0_kp ! surface_wind_stress_over_land - stress_ice(:) = 0.0_kp ! surface_wind_stress_over_ice - - if (flag_init) then - allocate(fm(nMax)) - fm(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_momentum - end if - - fm_wat(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_momentum_over_water - fm_lnd(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_momentum_over_land - fm_ice(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_momentum_over_ice - - if (flag_init) then - allocate(fh(nMax)) - fh(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_heat - end if + integer :: ierr - fh_wat(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_heat_over_water - fh_lnd(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_heat_over_land - fh_ice(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_heat_over_ice + end subroutine flux_atmOcn_init - if (flag_init) then - allocate(fm10(nMax)) - fm10(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_momentum - end if - - fm10_wat(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_momentum_at_10m_over_water - fm10_lnd(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_momentum_at_10m_over_land - fm10_ice(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ice - fh2(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_heat - fh2_wat(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_heat_at_2m_over_water - fh2_lnd(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_heat_at_2m_over_land - fh2_ice(:) = 0.0_kp ! Monin_Obukhov_similarity_function_for_heat_at_2m_over_ice - ztmax_wat(:) = 0.0_kp ! bounded_surface_roughness_length_for_heat_over_water - ztmax_lnd(:) = 0.0_kp ! bounded_surface_roughness_length_for_heat_over_land - ztmax_ice(:) = 0.0_kp ! bounded_surface_roughness_length_for_heat_over_ice - zvfun(:) = 0.0_kp ! function_of_surface_roughness_length_and_green_vegetation_fraction - - lseaspray = .true. ! flag_for_sea_spray - cmm(:) = 0.0_kp ! surface_drag_wind_speed_for_momentum - cmm_wat(:) = 0.0_kp ! surface_drag_wind_speed_for_momentum_in_air_over_water - cmm_lnd(:) = 0.0_kp ! surface_drag_wind_speed_for_momentum_in_air_over_land - cmm_ice(:) = 0.0_kp ! surface_drag_wind_speed_for_momentum_in_air_over_ice - chh(:) = 0.0_kp ! surface_drag_mass_flux_for_heat_and_moisture - chh_wat(:) = 0.0_kp ! surface_drag_mass_flux_for_heat_and_moisture_in_air_over_water - chh_lnd(:) = 0.0_kp ! surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land - chh_ice(:) = 0.0_kp ! surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice - gflx(:) = 0.0_kp ! upward_heat_flux_in_soil - gflx_wat(:) = 0.0_kp ! upward_heat_flux_in_soil_over_water - gflx_lnd(:) = 0.0_kp ! upward_heat_flux_in_soil_over_lnd - gflx_ice(:) = 0.0_kp ! upward_heat_flux_in_soil_over_ice - use_med_flux = .false. ! flag_for_mediator_atmosphere_ocean_fluxes - dqsfc(:) = 0.0_kp ! surface_upward_latent_heat_flux_over_ocean_from_coupled_process - dtsfc(:) = 0.0_kp ! surface_upward_sensible_heat_flux_over_ocean_from_coupled_process - - if (flag_init) then - allocate(evap(nMax)) - evap(:) = 0.0_kp ! kinematic_surface_upward_latent_heat_flux - end if - - evap_wat(:) = 0.0_kp ! kinematic_surface_upward_latent_heat_flux_over_water - evap_lnd(:) = 0.0_kp ! kinematic_surface_upward_latent_heat_flux_over_land - evap_ice(:) = 0.0_kp ! kinematic_surface_upward_latent_heat_flux_over_ice - - if (flag_init) then - allocate(hflx(nMax)) - hflx(:) = 0.0_kp ! kinematic_surface_upward_sensible_heat_flux - end if - - hflx_wat(:) = 0.0_kp ! kinematic_surface_upward_sensible_heat_flux_over_water - hflx_lnd(:) = 0.0_kp ! kinematic_surface_upward_sensible_heat_flux_over_land - hflx_ice(:) = 0.0_kp ! kinematic_surface_upward_sensible_heat_flux_over_ice - - ep1d(:) = 0.0_kp ! surface_upward_potential_latent_heat_flux - ep1d_wat(:) = 0.0_kp ! surface_upward_potential_latent_heat_flux_over_water - ep1d_lnd(:) = 0.0_kp ! surface_upward_potential_latent_heat_flux_over_land - ep1d_ice(:) = 0.0_kp ! surface_upward_potential_latent_heat_flux_over_ice - - lsm = 2 ! control_for_land_surface_scheme - lsm_noahmp = 2 ! identifier_for_noahmp_land_surface_scheme - semis_rad(:) = 0.0_kp ! surface_longwave_emissivity - semis_lnd(:) = 0.0_kp ! surface_longwave_emissivity_over_land_interstitial - semis_ice(:) = 0.0_kp ! surface_longwave_emissivity_over_ice_interstitial - semis_wat(:) = 0.0_kp ! surface_longwave_emissivity_over_water_interstitial - emis_lnd(:) = 0.0_kp ! surface_longwave_emissivity_over_land - emis_ice(:) = 0.0_kp ! surface_longwave_emissivity_over_ice - - !--- set up surface emissivity for lw radiation --- - !--- semis_wat is constant and set to 0.97 in setemis() call --- - semis_wat(:) = 0.97 - - !--- GFS surface scheme pre --- - call GFS_surface_composites_pre_run( & - nMax , flag_init , flag_restart, & - lkm , frac_grid , flag_cice , & - cplflx , cplice , cplwav2atm , & - landfrac , lakefrac , lakedepth , & - oceanfrac , frland , dry , & - icy , lake , use_flake , & - wet , hice , cice , & - z0rl_wat , z0rl_lnd , z0rl_ice , & - snowd , snowd_lnd , snowd_ice , & - tprcp , & - tprcp_wat , tprcp_lnd , tprcp_ice , & - ustar , & - ustar_wat , ustar_lnd , ustar_ice , & - weasd , weasd_lnd , weasd_ice , & - ep1d_ice , tskin , tsfco , & - tskin_lnd , tskin_wat , tisfc , & - tsurf_wat , tsurf_lnd , tsurf_ice , & - gflx_ice , tgice , islmsk , & - islmsk_cice, slmsk , qss , & - qss_wat , qss_lnd , qss_ice , & - min_lakeice, min_seaice , kdt , & - huge , errmsg , errflg) - - !--- surface iteration loop --- - do iter = 1, 2 - !--- calculate stability parameters --- - call sfc_diff_run( & - nMax , rvrdm1 , eps , & - epsm1 , grav , psfc , & - tbot , qbot , zbot , & - garea , wind , pbot , & - prslki , prsik1 , prslk1 , & - sigmaf , vegtype , shdmax , & - ivegsrc , z0pert , ztpert , & - flag_iter , redrag , usfc , & - vsfc , sfc_z0_type, wet , & - dry , icy , thsfc_loc , & - tskin_wat , tskin_lnd , tskin_ice , & - tsurf_wat , tsurf_lnd , tsurf_ice , & - z0rl_wat , z0rl_lnd , z0rl_ice , & - z0rl_wav , & - ustar_wat , ustar_lnd , ustar_ice , & - cm_wat , cm_lnd , cm_ice , & - ch_wat , ch_lnd , ch_ice , & - rb_wat , rb_lnd , rb_ice , & - stress_wat, stress_lnd , stress_ice , & - fm_wat , fm_lnd , fm_ice , & - fh_wat , fh_lnd , fh_ice , & - fm10_wat , fm10_lnd , fm10_ice , & - fh2_wat , fh2_lnd , fh2_ice , & - ztmax_wat , ztmax_lnd , ztmax_ice , & - zvfun , errmsg , errflg) + !============================================================================= + subroutine flux_atmOcn_run(ccpp_suite_name, group) + implicit none - !--- update flag_guess --- - call GFS_surface_loop_control_part1_run( & - nMax , iter , wind , & - flag_guess , errmsg , errflg) + !--- input arguments -------------------------------- + character(len=*), intent(in) :: ccpp_suite_name + character(len=*), optional, intent(in) :: group - !--- calculate heat fluxes --- - call sfc_ocean_run( & - nMax , hvap , cp , & - rd , eps , epsm1 , & - rvrdm1 , psfc , ubot , & - vbot , tbot , qbot , & - tskin_wat , cm_wat , ch_wat , & - lseaspray , fm_wat , fm10_wat , & - pbot , prslki , wet , & - use_flake , wind , flag_iter , & - use_med_flux, dqsfc , dtsfc , & - qss_wat , cmm_wat , chh_wat , & - gflx_wat , evap_wat , hflx_wat , & - ep1d_wat , errmsg , errflg) + !--- local variables -------------------------------- + integer :: ierr - !--- update flag_guess and flag_iter --- - call GFS_surface_loop_control_part2_run( & - nMax , lsm , lsm_noahmp, & - iter , wind , & - flag_guess , flag_iter , dry , & - wet , icy , nstf_name1, & - errmsg , errflg) - end do + end subroutine flux_atmOcn_run - !--- GFS surface scheme post --- - call GFS_surface_composites_post_run( & - nMax , kice , km , & - rd , rvrdm1 , cplflx , & - cplwav2atm, frac_grid , flag_cice , & - thsfc_loc , islmsk , dry , & - wet , icy , wind , & - tbot , qbot , pbot , & - landfrac , lakefrac , oceanfrac , & - z0rl , z0rl_wat , z0rl_lnd , & - z0rl_ice , garea , cm , & - cm_wat , cm_lnd , cm_ice , & - ch , ch_wat , ch_lnd , & - ch_ice , rb , rb_wat , & - rb_lnd , rb_ice , stress , & - stress_wat, stress_lnd , stress_ice, & - fm , fm_wat , fm_lnd , & - fm_ice , fh , fh_wat , & - fh_lnd , fh_ice , ustar , & - ustar_wat , ustar_lnd , ustar_ice , & - fm10 , fm10_wat , fm10_lnd , & - fm10_ice , fh2 , fh2_wat , & - fh2_lnd , fh2_ice , tsurf_wat , & - tsurf_lnd , tsurf_ice , cmm , & - cmm_wat , cmm_lnd , cmm_ice , & - chh , chh_wat , chh_lnd , & - chh_ice , gflx , gflx_wat , & - gflx_lnd , gflx_ice , ep1d , & - ep1d_wat , ep1d_lnd , ep1d_ice , & - weasd , weasd_lnd , weasd_ice , & - snowd , snowd_lnd , snowd_ice , & - tprcp , tprcp_wat , tprcp_lnd , & - tprcp_ice , evap , evap_wat , & - evap_lnd , evap_ice , hflx , & - hflx_wat , hflx_lnd , hflx_ice , & - qss , qss_wat , qss_lnd , & - qss_ice , tskin , tsfco , & - tskin_lnd , tskin_wat , tisfc , & - hice , cice , tiice , & - sigmaf , zvfun , lheatstrg , & - h0facu , h0facs , hflxq , & - hffac , stc , grav , & - prsik1 , prslk1 , prslki , & - zbot , ztmax_wat , ztmax_lnd , & - ztmax_ice , huge , errmsg , & - errflg) + !============================================================================= + subroutine flux_atmOcn_finalize(ccpp_suite_name) + implicit none - !--- unit and sign conversion to be consistent with other flux scheme --- - do n = 1, nMax - if (mask(n) /= 0) then - sen(n) = -1.0_r8*hflx_wat(n)*rbot(n)*cp - lat(n) = -1.0_r8*evap_wat(n)*rbot(n)*hvap - lwup(n) = -1.0_r8*(semis_wat(n)*sbc*ts(n)**4+(1.0_r8-semis_wat(n))*lwdn(n)) - evp(n) = lat(n)/hvap - taux(n) = rbot(n)*stress(n)*ubot(n)/wind(n) - tauy(n) = rbot(n)*stress(n)*vbot(n)/wind(n) - qref(n) = qss_wat(n) - else - sen(n) = spval - lat(n) = spval - lwup(n) = spval - evap(n) = spval - taux(n) = spval - tauy(n) = spval - qref(n) = spval - end if - end do + !--- input arguments -------------------------------- + character(len=*), intent(in) :: ccpp_suite_name - flag_init = .false. + !--- local variables -------------------------------- + integer :: ierr - end subroutine flux_atmOcn_ccpp + end subroutine flux_atmOcn_finalize end module flux_atmocn_ccpp_mod From 84be1383dfafa13dbba85f6c8babc19138ab267b Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sun, 30 Jan 2022 19:52:42 -0700 Subject: [PATCH 016/395] Minor updates to get CCPP handshake right --- ufs/ccpp/data/GFS_typedefs.F90 | 13 +++---------- ufs/ccpp/data/GFS_typedefs.meta | 22 ---------------------- ufs/ccpp/data/med_typedefs.F90 | 2 +- 3 files changed, 4 insertions(+), 33 deletions(-) diff --git a/ufs/ccpp/data/GFS_typedefs.F90 b/ufs/ccpp/data/GFS_typedefs.F90 index 755d7575f..02d88850f 100644 --- a/ufs/ccpp/data/GFS_typedefs.F90 +++ b/ufs/ccpp/data/GFS_typedefs.F90 @@ -8,6 +8,9 @@ module GFS_typedefs real(kind=kind_phys), parameter :: clear_val = zero !--- data containers +!! \section arg_table_GFS_statein_type +!! \htmlinclude GFS_statein_type.html +!! type GFS_statein_type real (kind=kind_phys), pointer :: prsl(:) => null() !< model layer mean pressure Pa real (kind=kind_phys), pointer :: tgrs(:) => null() !< model layer mean temperature in k @@ -15,16 +18,6 @@ module GFS_typedefs procedure :: create => statein_create !< allocate array data end type GFS_statein_type -!------------------------------------------------------------------------------------ -! combined type of all of the above except GFS_control_type and GFS_interstitial_type -!------------------------------------------------------------------------------------ -!! \section arg_table_GFS_data_type -!! \htmlinclude GFS_data_type.html -!! - type GFS_data_type - type(GFS_statein_type) :: statein - end type GFS_data_type - contains subroutine statein_create(statein, im) diff --git a/ufs/ccpp/data/GFS_typedefs.meta b/ufs/ccpp/data/GFS_typedefs.meta index 8c63994c6..015bcea2f 100644 --- a/ufs/ccpp/data/GFS_typedefs.meta +++ b/ufs/ccpp/data/GFS_typedefs.meta @@ -21,22 +21,6 @@ type = real kind = kind_phys -######################################################################## -[ccpp-table-properties] - name = GFS_data_type - type = ddt - dependencies = - -[ccpp-arg-table] - name = GFS_data_type - type = ddt -[Statein] - standard_name = GFS_statein_type_instance - long_name = prognostic state data in from dycore - units = DDT - dimensions = () - type = GFS_statein_type - ######################################################################## [ccpp-table-properties] name = GFS_typedefs @@ -47,12 +31,6 @@ [ccpp-arg-table] name = GFS_typedefs type = module -[GFS_data_type] - standard_name = GFS_data_type - long_name = definition of type GFS_data_type - units = DDT - dimensions = () - type = GFS_data_type [GFS_statein_type] standard_name = GFS_statein_type long_name = definition of type GFS_statein_type diff --git a/ufs/ccpp/data/med_typedefs.F90 b/ufs/ccpp/data/med_typedefs.F90 index c9611dac1..8f92fa897 100644 --- a/ufs/ccpp/data/med_typedefs.F90 +++ b/ufs/ccpp/data/med_typedefs.F90 @@ -10,7 +10,7 @@ module med_type_defs implicit none type physics_type - ype(GFS_statein_type) :: statein + type(GFS_statein_type) :: statein end type physics_type type(physics_type), target :: physics From cdb20250048a423d39f62e6d3ce7f7995fac16f1 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Tue, 1 Feb 2022 14:10:39 -0700 Subject: [PATCH 017/395] more work for CCPP host model --- ufs/ccpp/config/ccpp_prebuild_config.py | 4 + ufs/ccpp/data/GFS_typedefs.F90 | 147 +++++++++++- ufs/ccpp/data/GFS_typedefs.meta | 290 +++++++++++++++++++++++- ufs/ccpp/data/med_typedefs.F90 | 10 +- ufs/ccpp/data/med_typedefs.meta | 28 ++- 5 files changed, 466 insertions(+), 13 deletions(-) diff --git a/ufs/ccpp/config/ccpp_prebuild_config.py b/ufs/ccpp/config/ccpp_prebuild_config.py index 0e1ca932f..e2b4ec675 100644 --- a/ufs/ccpp/config/ccpp_prebuild_config.py +++ b/ufs/ccpp/config/ccpp_prebuild_config.py @@ -39,7 +39,11 @@ 'machine' : '', }, 'GFS_typedefs' : { + 'GFS_init_type' : 'physics%init', 'GFS_statein_type' : 'physics%Statein', + 'GFS_interstitial_type' : 'physics%Interstitial', + 'GFS_control_type' : 'physics%Model', + 'GFS_coupling_type' : 'physics%Coupling', 'GFS_typedefs' : '', }, 'med_typedefs' : { diff --git a/ufs/ccpp/data/GFS_typedefs.F90 b/ufs/ccpp/data/GFS_typedefs.F90 index 02d88850f..a0d302a29 100644 --- a/ufs/ccpp/data/GFS_typedefs.F90 +++ b/ufs/ccpp/data/GFS_typedefs.F90 @@ -1,34 +1,167 @@ module GFS_typedefs - use machine, only: kind_phys + use machine, only: kind_phys + use physcons, only: con_hvap, con_cp, con_rd, con_eps + use physcons, only: con_epsm1, con_fvirt implicit none !--- parameter constants used for default initializations real(kind=kind_phys), parameter :: zero = 0.0_kind_phys real(kind=kind_phys), parameter :: clear_val = zero + real(kind=kind_phys), parameter :: huge = 9.9692099683868690E36 !--- data containers + +!! \section arg_table_GFS_init_type +!! \htmlinclude GFS_init_type.html +!! + type GFS_init_type + integer, pointer :: im !< horizontal loop extent + end type GFS_init_type + !! \section arg_table_GFS_statein_type !! \htmlinclude GFS_statein_type.html !! type GFS_statein_type - real (kind=kind_phys), pointer :: prsl(:) => null() !< model layer mean pressure Pa - real (kind=kind_phys), pointer :: tgrs(:) => null() !< model layer mean temperature in k - contains - procedure :: create => statein_create !< allocate array data + real(kind=kind_phys), pointer :: pgr(:) => null() !< surface pressure (Pa) + real(kind=kind_phys), pointer :: ugrs(:) => null() !< u component of layer wind (m/s) + real(kind=kind_phys), pointer :: vgrs(:) => null() !< v component of layer wind (m/s) + real(kind=kind_phys), pointer :: tgrs(:) => null() !< model layer mean temperature (K) + real(kind=kind_phys), pointer :: qgrs(:) => null() !< layer mean tracer concentration (kg/kg) + real(kind=kind_phys), pointer :: prsl(:) => null() !< model layer mean pressure (Pa) + contains + procedure :: create => statein_create !< allocate array data end type GFS_statein_type +!! \section arg_table_GFS_interstitial_type +!! \htmlinclude GFS_interstitial_type.html +!! + type GFS_interstitial_type + real(kind=kind_phys), pointer :: tsfc_water(:) => null() !< surface skin temperature over water (K) + real(kind=kind_phys), pointer :: cd_water(:) => null() !< surface exchange coeff for momentum over water + real(kind=kind_phys), pointer :: cdq_water(:) => null() !< surface exchange coeff heat surface exchange coeff heat & moisture over ocean moisture over water + real(kind=kind_phys), pointer :: ffmm_water(:) => null() !< Monin-Obukhov similarity function for momentum over water + real(kind=kind_phys), pointer :: fm10_water(:) => null() !< Monin-Obukhov similarity parameter for momentum at 10m over water + real(kind=kind_phys), pointer :: prslki(:) => null() !< Exner function ratio bt midlayer and interface at 1st layer + real(kind=kind_phys), pointer :: wet(:) => null() !< flag indicating presence of some ocean or lake surface area fraction + real(kind=kind_phys), pointer :: use_flake(:) => null() !< flag indicating lake points using flake model + real(kind=kind_phys), pointer :: wind(:) => null() !< wind speed at lowest model level (m/s) + logical, pointer :: flag_iter(:) => null() !< flag for iteration + real(kind=kind_phys), pointer :: qss_water(:) => null() !< surface air saturation specific humidity over water (kg/kg) + real(kind=kind_phys), pointer :: cmm_water(:) => null() !< momentum exchange coefficient over water (m/s) + real(kind=kind_phys), pointer :: chh_water(:) => null() !< thermal exchange coefficient over water (kg/m2s) + real(kind=kind_phys), pointer :: gflx_water(:) => null() !< soil heat flux over water (W/m2) + real(kind=kind_phys), pointer :: evap_water(:) => null() !< kinematic surface upward latent heat flux over water (m/s) + real(kind=kind_phys), pointer :: hflx_water(:) => null() !< kinematic surface upward sensible heat flux over water (Km/s) + real(kind=kind_phys), pointer :: ep1d_water(:) => null() !< surface upward potential latent heat flux over water (W/m2) + contains + procedure :: create => interstitial_create !< allocate array data + end type GFS_interstitial_type + +!! \section arg_table_GFS_control_type +!! \htmlinclude GFS_control_type.html +!! + type GFS_control_type + !--- tuning parameters for physical parameterizations + logical :: lseaspray !< flag for sea spray parameterization + !--- coupling parameters + logical :: use_med_flux !< flag for using atmosphere-ocean fluxes form mediator + contains + procedure :: init => control_initialize + end type GFS_control_type + +!! \section arg_table_GFS_coupling_type +!! \htmlinclude GFS_coupling_type.html +!! + type GFS_coupling_type + real(kind=kind_phys), pointer :: dtsfcino_cpl(:) => null() !< sfc latent heat flux over ocean + real(kind=kind_phys), pointer :: dqsfcino_cpl(:) => null() !< sfc sensible heat flux over ocean + contains + procedure :: create => coupling_create !< allocate array data + end type GFS_coupling_type + contains subroutine statein_create(statein, im) + implicit none class(GFS_statein_type) :: statein integer, intent(in) :: im - allocate(statein%prsl(im)) - statein%prsl = clear_val + allocate(statein%pgr(im)) + statein%pgr = clear_val + allocate(statein%ugrs(im)) + statein%ugrs = clear_val + allocate(statein%vgrs(im)) + statein%vgrs = clear_val allocate(statein%tgrs(im)) statein%tgrs = clear_val + allocate(statein%qgrs(im)) + statein%qgrs = clear_val + allocate(statein%prsl(im)) + statein%prsl = clear_val end subroutine statein_create + subroutine interstitial_create(interstitial, im) + implicit none + class(GFS_interstitial_type) :: interstitial + integer, intent(in) :: im + + allocate(interstitial%tsfc_water(im)) + interstitial%tsfc_water = huge + allocate(interstitial%cd_water(im)) + interstitial%cd_water = huge + allocate(interstitial%cdq_water(im)) + interstitial%cdq_water = huge + allocate(interstitial%ffmm_water(im)) + interstitial%ffmm_water = huge + allocate(interstitial%fm10_water(im)) + interstitial%fm10_water = huge + allocate(interstitial%prslki(im)) + interstitial%prslki = clear_val + allocate(interstitial%wet(im)) + interstitial%wet = .false. + allocate(interstitial%use_flake(im)) + interstitial%use_flake = .false. + allocate(interstitial%wind(im)) + interstitial%wind = huge + allocate(interstitial%flag_iter(im)) + interstitial%flag_iter = .true. + allocate(interstitial%qss_water(im)) + interstitial%qss_water = huge + allocate(interstitial%cmm_water(im)) + interstitial%cmm_water = huge + allocate(interstitial%chh_water(im)) + interstitial%chh_water = huge + allocate(interstitial%gflx_water(im)) + interstitial%gflx_water = clear_val + allocate(interstitial%evap_water(im)) + interstitial%evap_water = huge + allocate(interstitial%hflx_water(im)) + interstitial%hflx_water = huge + allocate(interstitial%ep1d_water(im)) + interstitial%ep1d_water = huge + + end subroutine interstitial_create + + subroutine control_initialize(model) + implicit none + class(GFS_control_type) :: model + + logical :: lseaspray = .false. + logical :: use_med_flux = .false. + + end subroutine control_initialize + + subroutine coupling_create(coupling, im) + implicit none + class(GFS_coupling_type) :: coupling + integer, intent(in) :: im + + allocate(coupling%dtsfcino_cpl(im)) + coupling%dtsfcino_cpl = clear_val + allocate(coupling%dqsfcino_cpl(im)) + coupling%dqsfcino_cpl = clear_val + + end subroutine coupling_create end module GFS_typedefs diff --git a/ufs/ccpp/data/GFS_typedefs.meta b/ufs/ccpp/data/GFS_typedefs.meta index 015bcea2f..3ff2d4fc7 100644 --- a/ufs/ccpp/data/GFS_typedefs.meta +++ b/ufs/ccpp/data/GFS_typedefs.meta @@ -1,3 +1,19 @@ +[ccpp-table-properties] + name = GFS_init_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = GFS_init_type + type = ddt +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + +######################################################################## [ccpp-table-properties] name = GFS_statein_type type = ddt @@ -6,13 +22,27 @@ [ccpp-arg-table] name = GFS_statein_type type = ddt -[prsl] - standard_name = air_pressure_at_surface_adjacent_layer - long_name = mean pressure at lowest model layer +[pgr] + standard_name = surface_air_pressure + long_name = surface pressure units = Pa dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[ugrs] + standard_name = x_wind_at_surface_adjacent_layer + long_name = zonal wind at lowest model layer + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[vgrs] + standard_name = y_wind_at_surface_adjacent_layer + long_name = meridional wind at lowest model layer + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [tgrs] standard_name = air_temperature_at_surface_adjacent_layer long_name = mean temperature at lowest model layer @@ -20,20 +50,272 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[qgrs] + standard_name = specific_humidity_at_surface_adjacent_layer + long_name = water vapor specific humidity at lowest model layer + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[prsl] + standard_name = air_pressure_at_surface_adjacent_layer + long_name = mean pressure at lowest model layer + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + +######################################################################## +[ccpp-table-properties] + name = GFS_interstitial_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = GFS_interstitial_type + type = ddt +[tsfc_water] + standard_name = surface_skin_temperature_over_water + long_name = surface skin temperature over water + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cd_water] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_water + long_name = surface exchange coeff for momentum over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cdq_water] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_water + long_name = surface exchange coeff heat surface exchange coeff heat & moisture over ocean moisture over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ffmm_water] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_water + long_name = Monin-Obukhov similarity function for momentum over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fm10_water] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_water + long_name = Monin-Obukhov similarity parameter for momentum at 10m over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[prslki] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[use_flake] + standard_name = flag_for_using_flake + long_name = flag indicating lake points using flake model + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[qss_water] + standard_name = surface_specific_humidity_over_water + long_name = surface air saturation specific humidity over water + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cmm_water] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_water + long_name = momentum exchange coefficient over water + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[chh_water] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_water + long_name = thermal exchange coefficient over water + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gflx_water] + standard_name = upward_heat_flux_in_soil_over_water + long_name = soil heat flux over water + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[evap_water] + standard_name = kinematic_surface_upward_latent_heat_flux_over_water + long_name = kinematic surface upward latent heat flux over water + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[hflx_water] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_water + long_name = kinematic surface upward sensible heat flux over water + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ep1d_water] + standard_name = surface_upward_potential_latent_heat_flux_over_water + long_name = surface upward potential latent heat flux over water + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + +######################################################################## +[ccpp-table-properties] + name = GFS_control_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = GFS_control_type + type = ddt +[lseaspray] + standard_name = flag_for_sea_spray + long_name = flag for sea spray parameterization + units = flag + dimensions = () + type = logical +[use_med_flux] + standard_name = flag_for_mediator_atmosphere_ocean_fluxes + long_name = flag for using atmosphere-ocean fluxes form mediator (default false) + units = flag + dimensions = () + type = logical + +######################################################################## +[ccpp-table-properties] + name = GFS_coupling_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = GFS_coupling_type + type = ddt +[dtsfcino_cpl] + standard_name = surface_upward_sensible_heat_flux_over_ocean_from_coupled_process + long_name = sfc sensible heat flux input over ocean for coupling + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[dqsfcino_cpl] + standard_name = surface_upward_latent_heat_flux_over_ocean_from_coupled_process + long_name = sfc latent heat flux input over ocean for coupling + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys ######################################################################## [ccpp-table-properties] name = GFS_typedefs type = module relative_path = ../FV3/ccpp/physics/physics - dependencies = machine.F + dependencies = machine.F,physcons.F90 [ccpp-arg-table] name = GFS_typedefs type = module +[GFS_init_type] + standard_name = GFS_init_type + long_name = definition of type GFS_init_type + units = DDT + dimensions = () + type = GFS_init_type [GFS_statein_type] standard_name = GFS_statein_type long_name = definition of type GFS_statein_type units = DDT dimensions = () type = GFS_statein_type +[GFS_interstitial_type] + standard_name = GFS_interstitial_type + long_name = definition of type GFS_interstitial_type + units = DDT + dimensions = () + type = GFS_interstitial_type +[GFS_control_type] + standard_name = GFS_control_type + long_name = definition of type GFS_control_type + units = DDT + dimensions = () + type = GFS_control_type +[GFS_coupling_type] + standard_name = GFS_coupling_type + long_name = definition of type GFS_coupling_type + units = DDT + dimensions = () + type = GFS_coupling_type +[con_hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys +[con_rd] + standard_name = gas_constant_of_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys +[con_epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys diff --git a/ufs/ccpp/data/med_typedefs.F90 b/ufs/ccpp/data/med_typedefs.F90 index 8f92fa897..e4481d797 100644 --- a/ufs/ccpp/data/med_typedefs.F90 +++ b/ufs/ccpp/data/med_typedefs.F90 @@ -4,13 +4,21 @@ module med_type_defs use GFS_typedefs, only: GFS_statein_type + use GFS_typedefs, only: GFS_init_type + use GFS_typedefs, only: GFS_interstitial_type + use GFS_typedefs, only: GFS_control_type + use GFS_typedefs, only: GFS_coupling_type use machine, only: kind_phys use ccpp_api, only: ccpp_t implicit none type physics_type - type(GFS_statein_type) :: statein + type(GFS_init_type) :: init + type(GFS_statein_type) :: statein + type(GFS_interstitial_type) :: interstitial + type(GFS_control_type) :: model + type(GFS_coupling_type) :: coupling end type physics_type type(physics_type), target :: physics diff --git a/ufs/ccpp/data/med_typedefs.meta b/ufs/ccpp/data/med_typedefs.meta index 5861ce0e4..5afaccd76 100644 --- a/ufs/ccpp/data/med_typedefs.meta +++ b/ufs/ccpp/data/med_typedefs.meta @@ -6,18 +6,44 @@ [ccpp-arg-table] name = physics_type type = ddt +[Init] + standard_name = GFS_init_type_instance + long_name = instance of derived type GFS_init_type + units = DDT + dimensions = () + type = GFS_init_type [Statein] standard_name = GFS_statein_type_instance long_name = instance of derived type GFS_statein_type units = DDT dimensions = () type = GFS_statein_type +[Interstitial] + standard_name = GFS_interstitial_type + long_name = definition of type GFS_interstitial_type + units = DDT + dimensions = () + type = GFS_interstitial_type +[Model] + standard_name = GFS_control_type + long_name = definition of type GFS_control_type + units = DDT + dimensions = () + type = GFS_control_type +[Coupling] + standard_name = GFS_coupling_type + long_name = definition of type GFS_coupling_type + units = DDT + dimensions = () + type = GFS_coupling_type ######################################################################## [ccpp-table-properties] name = med_typedefs type = module - dependencies =GFS_typedefs.F90,../FV3/ccpp/physics/physics/machine.F,../FV3/ccpp/framework/src/ccpp_api.F90 + dependencies = GFS_typedefs.F90 + dependencies = ../FV3/ccpp/physics/physics/machine.F + dependencies = ../FV3/ccpp/framework/src/ccpp_api.F90 [ccpp-arg-table] name = med_typedefs From 6237d131b18ece6768e1a2d01acadf53401cfc42 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 2 Feb 2022 21:02:24 -0700 Subject: [PATCH 018/395] Updates and bug fixes to complete ccpp_prebuild.py call --- ufs/ccpp/config/ccpp_prebuild_config.py | 5 +++-- ufs/ccpp/data/GFS_typedefs.F90 | 4 ++++ ufs/ccpp/data/GFS_typedefs.meta | 2 +- ufs/ccpp/data/med_typedefs.F90 | 8 +++++++- ufs/ccpp/data/med_typedefs.meta | 19 +++++++++---------- ufs/ccpp/suites/suite_FV3_sfc_ocean.xml | 9 +++++++++ 6 files changed, 33 insertions(+), 14 deletions(-) mode change 100644 => 100755 ufs/ccpp/config/ccpp_prebuild_config.py create mode 100644 ufs/ccpp/suites/suite_FV3_sfc_ocean.xml diff --git a/ufs/ccpp/config/ccpp_prebuild_config.py b/ufs/ccpp/config/ccpp_prebuild_config.py old mode 100644 new mode 100755 index e2b4ec675..a70bf7f73 --- a/ufs/ccpp/config/ccpp_prebuild_config.py +++ b/ufs/ccpp/config/ccpp_prebuild_config.py @@ -195,11 +195,12 @@ CAPS_DIR = '{build_dir}/physics' # Directory where the suite definition files are stored -SUITES_DIR = '{}/ccpp/suites'.format(fv3_path) +SUITES_DIR = 'CMEPS/ufs/ccpp/suites' # Directory where to write static API to STATIC_API_DIR = '{build_dir}/physics' -STATIC_API_SRCFILE = '{build_dir}/physics/CCPP_STATIC_API.sh' +STATIC_API_CMAKEFILE = '{build_dir}/physics/CCPP_STATIC_API.cmake' +STATIC_API_SOURCEFILE = '{build_dir}/physics/CCPP_STATIC_API.sh' # Directory for writing HTML pages generated from metadata files METADATA_HTML_OUTPUT_DIR = '{build_dir}/physics/physics/docs' diff --git a/ufs/ccpp/data/GFS_typedefs.F90 b/ufs/ccpp/data/GFS_typedefs.F90 index a0d302a29..077a09bc1 100644 --- a/ufs/ccpp/data/GFS_typedefs.F90 +++ b/ufs/ccpp/data/GFS_typedefs.F90 @@ -1,4 +1,8 @@ module GFS_typedefs + +!> \section arg_table_GFS_typedefs +!! \htmlinclude GFS_typedefs.html +!! use machine, only: kind_phys use physcons, only: con_hvap, con_cp, con_rd, con_eps use physcons, only: con_epsm1, con_fvirt diff --git a/ufs/ccpp/data/GFS_typedefs.meta b/ufs/ccpp/data/GFS_typedefs.meta index 3ff2d4fc7..b77c0085e 100644 --- a/ufs/ccpp/data/GFS_typedefs.meta +++ b/ufs/ccpp/data/GFS_typedefs.meta @@ -241,7 +241,7 @@ [ccpp-table-properties] name = GFS_typedefs type = module - relative_path = ../FV3/ccpp/physics/physics + relative_path = ../../../../../FV3/ccpp/physics/physics dependencies = machine.F,physcons.F90 [ccpp-arg-table] diff --git a/ufs/ccpp/data/med_typedefs.F90 b/ufs/ccpp/data/med_typedefs.F90 index e4481d797..985626e60 100644 --- a/ufs/ccpp/data/med_typedefs.F90 +++ b/ufs/ccpp/data/med_typedefs.F90 @@ -3,16 +3,22 @@ module med_type_defs +!> \section arg_table_med_type_defs +!! \htmlinclude med_type_defs.html +!! + use GFS_typedefs, only: GFS_statein_type use GFS_typedefs, only: GFS_init_type use GFS_typedefs, only: GFS_interstitial_type use GFS_typedefs, only: GFS_control_type use GFS_typedefs, only: GFS_coupling_type - use machine, only: kind_phys use ccpp_api, only: ccpp_t implicit none +!! \section arg_table_physics_type +!! \htmlinclude physics_type.html +!! type physics_type type(GFS_init_type) :: init type(GFS_statein_type) :: statein diff --git a/ufs/ccpp/data/med_typedefs.meta b/ufs/ccpp/data/med_typedefs.meta index 5afaccd76..28ff74f57 100644 --- a/ufs/ccpp/data/med_typedefs.meta +++ b/ufs/ccpp/data/med_typedefs.meta @@ -19,34 +19,33 @@ dimensions = () type = GFS_statein_type [Interstitial] - standard_name = GFS_interstitial_type - long_name = definition of type GFS_interstitial_type + standard_name = GFS_interstitial_type_instance + long_name = instance of derived type GFS_interstitial_type units = DDT dimensions = () type = GFS_interstitial_type [Model] - standard_name = GFS_control_type - long_name = definition of type GFS_control_type + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type units = DDT dimensions = () type = GFS_control_type [Coupling] - standard_name = GFS_coupling_type - long_name = definition of type GFS_coupling_type + standard_name = GFS_coupling_type_instance + long_name = instance of derived type GFS_coupling_type units = DDT dimensions = () type = GFS_coupling_type ######################################################################## [ccpp-table-properties] - name = med_typedefs + name = med_type_defs type = module dependencies = GFS_typedefs.F90 - dependencies = ../FV3/ccpp/physics/physics/machine.F - dependencies = ../FV3/ccpp/framework/src/ccpp_api.F90 + dependencies = ../../../../../FV3/ccpp/framework/src/ccpp_api.F90 [ccpp-arg-table] - name = med_typedefs + name = med_type_defs type = module [physics_type] standard_name = physics_type diff --git a/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml b/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml new file mode 100644 index 000000000..2d93d4242 --- /dev/null +++ b/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml @@ -0,0 +1,9 @@ + + + + + + sfc_ocean + + + From 0c9b47060e561484f3cfbe138380600c396473f5 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 3 Feb 2022 21:51:03 -0700 Subject: [PATCH 019/395] Include Sl_soilw field exchange for CAM CARMA aerosol configurations (#268) New field exchanges needed for CESM/CAM CARMA --- mediator/esmFldsExchange_cesm_mod.F90 | 20 ++++++++++++++------ mediator/fd_cesm.yaml | 5 ++++- 2 files changed, 18 insertions(+), 7 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index a1b1a4897..9e41a2459 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -73,7 +73,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) use med_methods_mod , only : fldchk => med_methods_FB_FldChk use med_internalstate_mod , only : InternalState, logunit, mastertask use med_internalstate_mod , only : compmed, compatm, complnd, compocn - use med_internalstate_mod , only : compice, comprof, compwav, compglc, ncomps + use med_internalstate_mod , only : compice, comprof, compwav, compglc, ncomps use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_nstod use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf use med_internalstate_mod , only : coupling_mode @@ -1451,6 +1451,19 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if ! --------------------------------------------------------------------- + ! CARMA fields (volumetric soil water) + !----------------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Sl_soilw') + call addfld(fldListTo(compatm)%flds, 'Sl_soilw') + else + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_soilw', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_soilw', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Sl_soilw', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Sl_soilw', mrg_from=complnd, mrg_fld='Sl_soilw', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to atm: dust fluxes from land (4 sizes) ! --------------------------------------------------------------------- if (phase == 'advertise') then @@ -3188,11 +3201,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if endif - !----------------------------------------------------------------------------- - ! CARMA fields (volumetric soil water) - !----------------------------------------------------------------------------- - ! TODO (mvertens, 2021-07-25): add this - end subroutine esmFldsExchange_cesm end module esmFldsExchange_cesm_mod diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 55da80619..689ee03ac 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1,7 +1,6 @@ field_dictionary: version_number: 0.0.0 institution: National ESPC, CSC & MCL Working Groups - source: automatically generated by the NUOPC Layer description: Community-based dictionary for shared coupling fields entries: # @@ -155,6 +154,10 @@ canonical_units: m description: land export # + - standard_name: Sl_soilw + canonical_units: m3/m3 + description: land export + # - standard_name: Sl_t canonical_units: K description: land export From 4297d0bca87d1a6e32bb969193cb117e070c2427 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 3 Feb 2022 23:44:03 -0700 Subject: [PATCH 020/395] minor fixes --- mediator/med_phases_aofluxes_mod.F90 | 6 +++--- ufs/ccpp/data/GFS_typedefs.F90 | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 26b55066c..e84cd76fc 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1140,9 +1140,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) #ifdef UFS_AOFLUX end if #endif -! end if -! -!#endif + end if + +#endif do n = 1,aoflux_in%lsize if (aoflux_in%mask(n) /= 0) then diff --git a/ufs/ccpp/data/GFS_typedefs.F90 b/ufs/ccpp/data/GFS_typedefs.F90 index 077a09bc1..95dbb0de8 100644 --- a/ufs/ccpp/data/GFS_typedefs.F90 +++ b/ufs/ccpp/data/GFS_typedefs.F90 @@ -47,8 +47,8 @@ module GFS_typedefs real(kind=kind_phys), pointer :: ffmm_water(:) => null() !< Monin-Obukhov similarity function for momentum over water real(kind=kind_phys), pointer :: fm10_water(:) => null() !< Monin-Obukhov similarity parameter for momentum at 10m over water real(kind=kind_phys), pointer :: prslki(:) => null() !< Exner function ratio bt midlayer and interface at 1st layer - real(kind=kind_phys), pointer :: wet(:) => null() !< flag indicating presence of some ocean or lake surface area fraction - real(kind=kind_phys), pointer :: use_flake(:) => null() !< flag indicating lake points using flake model + logical, pointer :: wet(:) => null() !< flag indicating presence of some ocean or lake surface area fraction + logical, pointer :: use_flake(:) => null() !< flag indicating lake points using flake model real(kind=kind_phys), pointer :: wind(:) => null() !< wind speed at lowest model level (m/s) logical, pointer :: flag_iter(:) => null() !< flag for iteration real(kind=kind_phys), pointer :: qss_water(:) => null() !< surface air saturation specific humidity over water (kg/kg) From 699c1778e9229b1ad7b346d1b3adb75b83eae451 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Fri, 4 Feb 2022 23:30:19 -0700 Subject: [PATCH 021/395] add support for sfc_diff --- mediator/med_phases_aofluxes_mod.F90 | 15 +- ufs/ccpp/config/ccpp_prebuild_config.py | 124 +------- ufs/ccpp/data/GFS_typedefs.F90 | 266 ++++++++++++++-- ufs/ccpp/data/GFS_typedefs.meta | 402 ++++++++++++++++++++++++ ufs/ccpp/data/med_typedefs.F90 | 20 +- ufs/ccpp/data/med_typedefs.meta | 16 +- ufs/ccpp/driver/ccpp_driver.F90 | 51 --- ufs/ccpp/driver/med_ccpp_driver.F90 | 67 ++++ ufs/ccpp/suites/suite_FV3_sfc_ocean.xml | 1 + ufs/flux_atmocn_ccpp_mod.F90 | 118 ++++--- 10 files changed, 841 insertions(+), 239 deletions(-) delete mode 100644 ufs/ccpp/driver/ccpp_driver.F90 create mode 100644 ufs/ccpp/driver/med_ccpp_driver.F90 diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index e84cd76fc..0c16ba4b3 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -284,6 +284,7 @@ subroutine med_phases_aofluxes_run(gcomp, rc) else aoflux_created = .false. end if + ! Now set first_call to .false. first_call = .false. end if @@ -946,9 +947,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) use flux_atmocn_mod, only : flux_atmocn #endif #ifdef UFS_AOFLUX - use flux_atmocn_ccpp_mod, only : flux_atmOcn_init - use flux_atmocn_ccpp_mod, only : flux_atmOcn_run - use flux_atmocn_ccpp_mod, only : flux_atmOcn_finalize + use flux_atmocn_ccpp_mod, only : flux_atmocn_ccpp #endif ! Arguments @@ -1125,8 +1124,14 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) if (trim(coupling_mode) == 'nems_frac_aoflux') then #ifdef UFS_AOFLUX if (trim(aoflux_code) == 'ccpp') then - ! TODO: call ccpp - print*, "calling ccpp" + call flux_atmocn_ccpp( & + nMax=aoflux_in%lsize, psfc=aoflux_in%psfc, & + pbot=aoflux_in%pbot, tbot=aoflux_in%tbot, qbot=aoflux_in%shum, lwdn=aoflux_in%lwdn, & + zbot=aoflux_in%zbot, garea=aoflux_in%garea, ubot=aoflux_in%ubot, usfc=aoflux_in%usfc, vbot=aoflux_in%vbot, & + vsfc=aoflux_in%vsfc, rbot=aoflux_in%dens, ts=aoflux_in%tocn, mask=aoflux_in%mask, & + sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evp=aoflux_out%evap, & + taux=aoflux_out%taux, tauy=aoflux_out%tauy, qref=aoflux_out%qref, & + missval=0.0_r8) else #endif call flux_atmocn (logunit=logunit, & diff --git a/ufs/ccpp/config/ccpp_prebuild_config.py b/ufs/ccpp/config/ccpp_prebuild_config.py index a70bf7f73..b9d7ca1f8 100755 --- a/ufs/ccpp/config/ccpp_prebuild_config.py +++ b/ufs/ccpp/config/ccpp_prebuild_config.py @@ -44,6 +44,8 @@ 'GFS_interstitial_type' : 'physics%Interstitial', 'GFS_control_type' : 'physics%Model', 'GFS_coupling_type' : 'physics%Coupling', + 'GFS_grid_type' : 'physics%Grid', + 'GFS_sfcprop_type' : 'physics%Sfcprop', 'GFS_typedefs' : '', }, 'med_typedefs' : { @@ -53,124 +55,10 @@ } # Add all physics scheme files relative to basedir -SCHEME_FILES = ['{}/ccpp/physics/physics/sfc_ocean.F'.format(fv3_path)] - # Relative path to source (from where ccpp_prebuild.py is called) : [ list of physics sets in which scheme may be called ]; - # current restrictions are that each scheme can only belong to one physics set, and all schemes within one group in the - # suite definition file have to belong to the same physics set - #'{}/ccpp/physics/physics/GFS_DCNV_generic.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_GWD_generic.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_MP_generic.F90'.format(fv3_pathmt(fv3_path), - #'{}/ccpp/physics/physics/GFS_PBL_generic.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_SCNV_generic.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_debug.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_phys_time_vary.fv3.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_rad_time_vary.fv3.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_radiation_surface.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_rrtmg_post.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_rrtmg_pre.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_rrtmg_setup.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_stochastics.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_suite_interstitial.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_surface_generic.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_surface_composites.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_surface_loop_control.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_time_vary_pre.fv3.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/cires_ugwp.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/cires_ugwp_post.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/unified_ugwp.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/unified_ugwp_post.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/ugwpv1_gsldrag.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/ugwpv1_gsldrag_post.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/cnvc90.f'.format(fv3_path), - #'{}/ccpp/physics/physics/cs_conv.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/cs_conv_aw_adj.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/cu_ntiedtke_pre.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/cu_ntiedtke.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/cu_ntiedtke_post.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/dcyc2.f'.format(fv3_path), - #'{}/ccpp/physics/physics/drag_suite.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/gcm_shoc.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/get_prs_fv3.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/gfdl_cloud_microphys.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/gfdl_fv_sat_adj.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/gfdl_sfc_layer.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/gscond.f'.format(fv3_path), - #'{}/ccpp/physics/physics/gwdc.f'.format(fv3_path), - #'{}/ccpp/physics/physics/gwdps.f'.format(fv3_path), - #'{}/ccpp/physics/physics/h2ophys.f'.format(fv3_path), - #'{}/ccpp/physics/physics/samfdeepcnv.f'.format(fv3_path), - #'{}/ccpp/physics/physics/samfshalcnv.f', - #'{}/ccpp/physics/physics/sascnvn.F'.format(fv3_path), - #'{}/ccpp/physics/physics/shalcnv.F'.format(fv3_path), - #'{}/ccpp/physics/physics/maximum_hourly_diagnostics.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/m_micro.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/m_micro_interstitial.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/cu_gf_driver_pre.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/cu_gf_driver.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/cu_gf_driver_post.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/moninedmf.f'.format(fv3_path), - #'{}/ccpp/physics/physics/moninshoc.f'.format(fv3_path), - #'{}/ccpp/physics/physics/satmedmfvdif.F'.format(fv3_path), - #'{}/ccpp/physics/physics/satmedmfvdifq.F'.format(fv3_path), - #'{}/ccpp/physics/physics/shinhongvdif.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/ysuvdif.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/module_MYNNPBL_wrapper.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/module_MYNNSFC_wrapper.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/module_SGSCloud_RadPre.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/module_SGSCloud_RadPost.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/module_MYJSFC_wrapper.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/module_MYJPBL_wrapper.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/mp_thompson_pre.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/mp_thompson.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/mp_thompson_post.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/ozphys.f'.format(fv3_path), - #'{}/ccpp/physics/physics/ozphys_2015.f'.format(fv3_path), - #'{}/ccpp/physics/physics/precpd.f'.format(fv3_path), - #'{}/ccpp/physics/physics/phys_tend.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/radlw_main.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/radsw_main.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/rascnv.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/rayleigh_damp.f'.format(fv3_path), - #'{}/ccpp/physics/physics/rrtmg_lw_post.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/rrtmg_lw_pre.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/rrtmg_sw_post.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/rrtmg_sw_pre.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/sfc_diag.f'.format(fv3_path), - #'{}/ccpp/physics/physics/sfc_diag_post.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/sfc_drv_ruc.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/sfc_cice.f'.format(fv3_path), - #'{}/ccpp/physics/physics/sfc_diff.f'.format(fv3_path), - #'{}/ccpp/physics/physics/sfc_drv.f'.format(fv3_path), - #'{}/ccpp/physics/physics/sfc_noahmp_drv.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/flake_driver.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/sfc_nst.f'.format(fv3_path), - #'{}/ccpp/physics/physics/sfc_ocean.F'.format(fv3_path), - #'{}/ccpp/physics/physics/sfc_sice.f'.format(fv3_path), - ## HAFS FER_HIRES - #'{}/ccpp/physics/physics/mp_fer_hires.F90'.format(fv3_path), - ## RRTMGP - #'{}/ccpp/physics/physics/rrtmgp_lw_gas_optics.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/rrtmgp_lw_cloud_optics.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/rrtmgp_sw_gas_optics.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/rrtmgp_sw_cloud_optics.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/rrtmgp_sw_aerosol_optics.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/rrtmgp_lw_rte.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/rrtmgp_sw_rte.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/rrtmgp_lw_aerosol_optics.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_rrtmgp_setup.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_rrtmgp_pre.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/rrtmgp_lw_pre.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_rrtmgp_sw_pre.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_rrtmgp_lw_post.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/rrtmgp_lw_cloud_sampling.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/rrtmgp_sw_cloud_sampling.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_cloud_diagnostics.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_rrtmgp_thompsonmp_pre.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_rrtmgp_gfdlmp_pre.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_rrtmgp_zhaocarr_pre.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_rrtmgp_cloud_overlap_pre.F90'.format(fv3_path), - #'{}/ccpp/physics/physics/GFS_rrtmgp_sw_post.F90'.format(fv3_path) - #] +SCHEME_FILES = [ + '{}/ccpp/physics/physics/sfc_ocean.F'.format(fv3_path), + '{}/ccpp/physics/physics/sfc_diff.f'.format(fv3_path), + ] # Default build dir, relative to current working directory, # if not specified as command-line argument diff --git a/ufs/ccpp/data/GFS_typedefs.F90 b/ufs/ccpp/data/GFS_typedefs.F90 index 95dbb0de8..aeb795e14 100644 --- a/ufs/ccpp/data/GFS_typedefs.F90 +++ b/ufs/ccpp/data/GFS_typedefs.F90 @@ -5,7 +5,7 @@ module GFS_typedefs !! use machine, only: kind_phys use physcons, only: con_hvap, con_cp, con_rd, con_eps - use physcons, only: con_epsm1, con_fvirt + use physcons, only: con_epsm1, con_fvirt, con_g implicit none @@ -33,6 +33,11 @@ module GFS_typedefs real(kind=kind_phys), pointer :: tgrs(:) => null() !< model layer mean temperature (K) real(kind=kind_phys), pointer :: qgrs(:) => null() !< layer mean tracer concentration (kg/kg) real(kind=kind_phys), pointer :: prsl(:) => null() !< model layer mean pressure (Pa) + real(kind=kind_phys), pointer :: zlvl(:) => null() !< layer 1 height above ground (m) + real(kind=kind_phys), pointer :: prsik(:) => null() !< dimensionless Exner function at lowest model interface + real(kind=kind_phys), pointer :: prslk(:) => null() !< dimensionless Exner function at lowest model layer + real(kind=kind_phys), pointer :: u10m(:) => null() !< 10 meter u wind speed + real(kind=kind_phys), pointer :: v10m(:) => null() !< 10 meter v wind speed contains procedure :: create => statein_create !< allocate array data end type GFS_statein_type @@ -41,23 +46,67 @@ module GFS_typedefs !! \htmlinclude GFS_interstitial_type.html !! type GFS_interstitial_type - real(kind=kind_phys), pointer :: tsfc_water(:) => null() !< surface skin temperature over water (K) - real(kind=kind_phys), pointer :: cd_water(:) => null() !< surface exchange coeff for momentum over water - real(kind=kind_phys), pointer :: cdq_water(:) => null() !< surface exchange coeff heat surface exchange coeff heat & moisture over ocean moisture over water - real(kind=kind_phys), pointer :: ffmm_water(:) => null() !< Monin-Obukhov similarity function for momentum over water - real(kind=kind_phys), pointer :: fm10_water(:) => null() !< Monin-Obukhov similarity parameter for momentum at 10m over water - real(kind=kind_phys), pointer :: prslki(:) => null() !< Exner function ratio bt midlayer and interface at 1st layer - logical, pointer :: wet(:) => null() !< flag indicating presence of some ocean or lake surface area fraction - logical, pointer :: use_flake(:) => null() !< flag indicating lake points using flake model - real(kind=kind_phys), pointer :: wind(:) => null() !< wind speed at lowest model level (m/s) - logical, pointer :: flag_iter(:) => null() !< flag for iteration - real(kind=kind_phys), pointer :: qss_water(:) => null() !< surface air saturation specific humidity over water (kg/kg) - real(kind=kind_phys), pointer :: cmm_water(:) => null() !< momentum exchange coefficient over water (m/s) - real(kind=kind_phys), pointer :: chh_water(:) => null() !< thermal exchange coefficient over water (kg/m2s) - real(kind=kind_phys), pointer :: gflx_water(:) => null() !< soil heat flux over water (W/m2) - real(kind=kind_phys), pointer :: evap_water(:) => null() !< kinematic surface upward latent heat flux over water (m/s) - real(kind=kind_phys), pointer :: hflx_water(:) => null() !< kinematic surface upward sensible heat flux over water (Km/s) - real(kind=kind_phys), pointer :: ep1d_water(:) => null() !< surface upward potential latent heat flux over water (W/m2) + ! water + real(kind=kind_phys), pointer :: tsfc_water(:) => null() !< surface skin temperature over water (K) + real(kind=kind_phys), pointer :: cd_water(:) => null() !< surface exchange coeff for momentum over water + real(kind=kind_phys), pointer :: cdq_water(:) => null() !< surface exchange coeff heat surface exchange coeff heat & moisture over ocean moisture over water + real(kind=kind_phys), pointer :: ffmm_water(:) => null() !< Monin-Obukhov similarity function for momentum over water + real(kind=kind_phys), pointer :: fm10_water(:) => null() !< Monin-Obukhov similarity parameter for momentum at 10m over water + real(kind=kind_phys), pointer :: prslki(:) => null() !< Exner function ratio bt midlayer and interface at 1st layer + logical, pointer :: wet(:) => null() !< flag indicating presence of some ocean or lake surface area fraction + logical, pointer :: use_flake(:) => null() !< flag indicating lake points using flake model + real(kind=kind_phys), pointer :: wind(:) => null() !< wind speed at lowest model level (m/s) + logical, pointer :: flag_iter(:) => null() !< flag for iteration + real(kind=kind_phys), pointer :: qss_water(:) => null() !< surface air saturation specific humidity over water (kg/kg) + real(kind=kind_phys), pointer :: cmm_water(:) => null() !< momentum exchange coefficient over water (m/s) + real(kind=kind_phys), pointer :: chh_water(:) => null() !< thermal exchange coefficient over water (kg/m2s) + real(kind=kind_phys), pointer :: gflx_water(:) => null() !< soil heat flux over water (W/m2) + real(kind=kind_phys), pointer :: evap_water(:) => null() !< kinematic surface upward latent heat flux over water (m/s) + real(kind=kind_phys), pointer :: hflx_water(:) => null() !< kinematic surface upward sensible heat flux over water (Km/s) + real(kind=kind_phys), pointer :: ep1d_water(:) => null() !< surface upward potential latent heat flux over water (W/m2) + real(kind=kind_phys), pointer :: tsurf_water(:) => null() !< surface skin temperature after iteration over water (K) + real(kind=kind_phys), pointer :: uustar_water(:) => null() !< surface friction velocity over water (m/s) + real(kind=kind_phys), pointer :: rb_water(:) => null() !< bulk Richardson number at the surface over water + real(kind=kind_phys), pointer :: stress_water(:) => null() !< surface wind stress over water + real(kind=kind_phys), pointer :: ffhh_water(:) => null() !< Monin-Obukhov similarity function for heat over water + real(kind=kind_phys), pointer :: fh2_water(:) => null() !< Monin-Obukhov similarity parameter for heat at 2m over water + real(kind=kind_phys), pointer :: ztmax_water(:) => null() !< bounded surface roughness length for heat over water (m) + + ! land, not used to calculate aofluxes + real(kind=kind_phys), pointer :: zvfun(:) => null() !< function of surface roughness length and green vegetation fraction + real(kind=kind_phys), pointer :: sigmaf(:) => null() !< areal fractional cover of green vegetation bounded on the bottom + logical, pointer :: dry(:) => null() !< flag indicating presence of some land surface area fraction + real(kind=kind_phys), pointer :: tsfcl(:) => null() !< surface skin temperature over land (K) + real(kind=kind_phys), pointer :: tsurf_land(:) => null() !< surface skin temperature after iteration over land (K) + real(kind=kind_phys), pointer :: uustar_land(:) => null() !< surface friction velocity over land (m/s) + real(kind=kind_phys), pointer :: cd_land(:) => null() !< surface exchange coeff for momentum over land + real(kind=kind_phys), pointer :: cdq_land(:) => null() !< surface exchange coeff heat surface exchange coeff heat & moisture over ocean moisture over land + real(kind=kind_phys), pointer :: rb_land(:) => null() !< bulk Richardson number at the surface over land + real(kind=kind_phys), pointer :: stress_land(:) => null() !< surface wind stress over land + real(kind=kind_phys), pointer :: ffmm_land(:) => null() !< Monin-Obukhov similarity function for momentum over land + real(kind=kind_phys), pointer :: ffhh_land(:) => null() !< Monin-Obukhov similarity function for heat over land + real(kind=kind_phys), pointer :: fm10_land(:) => null() !< Monin-Obukhov similarity parameter for momentum at 10m over land + real(kind=kind_phys), pointer :: fh2_land(:) => null() !< Monin-Obukhov similarity parameter for heat at 2m over land + real(kind=kind_phys), pointer :: ztmax_land(:) => null() !< bounded surface roughness length for heat over land (m) + + ! ice, not used to calculate aofluxes + logical, pointer :: icy(:) => null() !< flag indicating presence of some sea ice surface area fraction + real(kind=kind_phys), pointer :: tisfc(:) => null() !< surface skin temperature over ice (K) + real(kind=kind_phys), pointer :: tsurf_ice(:) => null() !< surface skin temperature after iteration over ice (K) + real(kind=kind_phys), pointer :: uustar_ice(:) => null() !< surface friction velocity over ice (m/s) + real(kind=kind_phys), pointer :: cd_ice(:) => null() !< surface exchange coeff for momentum over ice + real(kind=kind_phys), pointer :: cdq_ice(:) => null() !< surface exchange coeff heat surface exchange coeff heat & moisture over ocean moisture over ice + real(kind=kind_phys), pointer :: rb_ice(:) => null() !< bulk Richardson number at the surface over ice + real(kind=kind_phys), pointer :: stress_ice(:) => null() !< surface wind stress over ice + real(kind=kind_phys), pointer :: ffmm_ice(:) => null() !< Monin-Obukhov similarity function for momentum over ice + real(kind=kind_phys), pointer :: ffhh_ice(:) => null() !< Monin-Obukhov similarity function for heat over ice + real(kind=kind_phys), pointer :: fm10_ice(:) => null() !< Monin-Obukhov similarity parameter for momentum at 10m over ice + real(kind=kind_phys), pointer :: fh2_ice(:) => null() !< Monin-Obukhov similarity parameter for heat at 2m over ice + real(kind=kind_phys), pointer :: ztmax_ice(:) => null() !< bounded surface roughness length for heat over ice (m) + + ! others + real(kind=kind_phys), pointer :: z01d(:) => null() !< perturbation of momentum roughness length + real(kind=kind_phys), pointer :: zt1d(:) => null() !< perturbation of heat to momentum roughness length ratio contains procedure :: create => interstitial_create !< allocate array data end type GFS_interstitial_type @@ -70,6 +119,14 @@ module GFS_typedefs logical :: lseaspray !< flag for sea spray parameterization !--- coupling parameters logical :: use_med_flux !< flag for using atmosphere-ocean fluxes form mediator + !--- land/surface model parameters, not used to calculate aofluxes + integer :: ivegsrc !< land use dataset choice 0 => USGS, 1 => IGBP, 2 => UMD + !--- tuning parameters for physical parameterizations + logical :: redrag !< flag for reduced drag coeff. over sea + !--- surface layer z0 scheme + integer :: sfc_z0_type !< surface roughness options over water + !--- potential temperature definition in surface layer physics + logical :: thsfc_loc !< flag for reference pressure in theta calculation contains procedure :: init => control_initialize end type GFS_control_type @@ -84,6 +141,47 @@ module GFS_typedefs procedure :: create => coupling_create !< allocate array data end type GFS_coupling_type +!! \section arg_table_GFS_grid_type +!! \htmlinclude GFS_grid_type.html +!! + type GFS_grid_type + real(kind=kind_phys), pointer :: area(:) => null() !< area of the grid cell + contains + procedure :: create => grid_create !< allocate array data + end type GFS_grid_type + +!! \section arg_table_GFS_sfcprop_type +!! \htmlinclude GFS_sfcprop_type.html +!! + type GFS_sfcprop_type + ! water + real(kind=kind_phys), pointer :: zorlw(:) => null() !< surface roughness length over water (cm) + + ! land, not used to calculate aofluxes + integer, pointer :: vtype(:) => null() !< vegetation type + real(kind=kind_phys), pointer :: shdmax(:) => null() !< max fractional coverage of green vegetation + real(kind=kind_phys), pointer :: zorll(:) => null() !< surface roughness length over land (cm) + + ! ice, not used to calculate aofluxes + real(kind=kind_phys), pointer :: zorli(:) => null() !< surface roughness length over ice (cm) + + ! wave + real(kind=kind_phys), pointer :: zorlwav(:) => null() !< surface roughness length from wave model (cm) + + ! other + real(kind=kind_phys), pointer :: zorl(:) => null() !< surface roughness length (cm) + + contains + procedure :: create => sfcprop_create !< allocate array data + end type GFS_sfcprop_type + + public GFS_init_type + public GFS_statein_type + public GFS_coupling_type + public GFS_control_type + public GFS_interstitial_type + public GFS_grid_type + contains subroutine statein_create(statein, im) @@ -103,6 +201,16 @@ subroutine statein_create(statein, im) statein%qgrs = clear_val allocate(statein%prsl(im)) statein%prsl = clear_val + allocate(statein%zlvl(im)) + statein%zlvl = clear_val + allocate(statein%prsik(im)) + statein%prsik = clear_val + allocate(statein%prslk(im)) + statein%prslk = clear_val + allocate(statein%u10m(im)) + statein%u10m = clear_val + allocate(statein%v10m(im)) + statein%v10m = clear_val end subroutine statein_create @@ -111,6 +219,7 @@ subroutine interstitial_create(interstitial, im) class(GFS_interstitial_type) :: interstitial integer, intent(in) :: im + ! water allocate(interstitial%tsfc_water(im)) interstitial%tsfc_water = huge allocate(interstitial%cd_water(im)) @@ -145,6 +254,86 @@ subroutine interstitial_create(interstitial, im) interstitial%hflx_water = huge allocate(interstitial%ep1d_water(im)) interstitial%ep1d_water = huge + allocate(interstitial%tsurf_water(im)) + interstitial%tsurf_water = huge + allocate(interstitial%uustar_water(im)) + interstitial%uustar_water = huge + allocate(interstitial%rb_water(im)) + interstitial%rb_water = huge + allocate(interstitial%stress_water(im)) + interstitial%stress_water = huge + allocate(interstitial%ffmm_water(im)) + interstitial%ffmm_water = huge + allocate(interstitial%fh2_water(im)) + interstitial%fh2_water = huge + allocate(interstitial%ztmax_water(im)) + interstitial%ztmax_water = clear_val + + ! land + allocate(interstitial%zvfun(im)) + interstitial%zvfun = clear_val + allocate(interstitial%sigmaf(im)) + interstitial%sigmaf = clear_val + allocate(interstitial%dry(im)) + interstitial%dry = .false. + allocate(interstitial%tsfcl(im)) + interstitial%tsfcl = clear_val + allocate(interstitial%tsurf_land(im)) + interstitial%tsurf_land = huge + allocate(interstitial%uustar_land(im)) + interstitial%uustar_land = huge + allocate(interstitial%cd_land(im)) + interstitial%cd_land = huge + allocate(interstitial%cdq_land(im)) + interstitial%cdq_land = huge + allocate(interstitial%rb_land(im)) + interstitial%rb_land = huge + allocate(interstitial%stress_land(im)) + interstitial%stress_land = huge + allocate(interstitial%ffmm_land(im)) + interstitial%ffmm_land = huge + allocate(interstitial%ffhh_land(im)) + interstitial%ffhh_land = huge + allocate(interstitial%fm10_land(im)) + interstitial%fm10_land = huge + allocate(interstitial%fh2_land(im)) + interstitial%fh2_land = huge + allocate(interstitial%ztmax_land(im)) + interstitial%ztmax_land = clear_val + + ! ice + allocate(interstitial%icy(im)) + interstitial%icy = .false. + allocate(interstitial%tisfc(im)) + interstitial%tisfc = clear_val + allocate(interstitial%tsurf_ice(im)) + interstitial%tsurf_ice = huge + allocate(interstitial%uustar_ice(im)) + interstitial%uustar_ice = huge + allocate(interstitial%cd_ice(im)) + interstitial%cd_ice = huge + allocate(interstitial%cdq_ice(im)) + interstitial%cdq_ice = huge + allocate(interstitial%rb_ice(im)) + interstitial%rb_ice = huge + allocate(interstitial%stress_ice(im)) + interstitial%stress_ice = huge + allocate(interstitial%ffmm_ice(im)) + interstitial%ffmm_ice = huge + allocate(interstitial%ffmm_ice(im)) + interstitial%ffmm_ice = huge + allocate(interstitial%fm10_ice(im)) + interstitial%fm10_ice = huge + allocate(interstitial%fh2_ice(im)) + interstitial%fh2_ice = huge + allocate(interstitial%ztmax_ice(im)) + interstitial%ztmax_ice = clear_val + + ! others + allocate(interstitial%z01d(im)) + interstitial%z01d = clear_val + allocate(interstitial%zt1d(im)) + interstitial%zt1d = clear_val end subroutine interstitial_create @@ -152,8 +341,12 @@ subroutine control_initialize(model) implicit none class(GFS_control_type) :: model - logical :: lseaspray = .false. - logical :: use_med_flux = .false. + model%lseaspray = .false. + model%use_med_flux = .false. + model%ivegsrc = 2 + model%redrag = .false. + model%sfc_z0_type = 0 + model%thsfc_loc = .true. end subroutine control_initialize @@ -168,4 +361,37 @@ subroutine coupling_create(coupling, im) coupling%dqsfcino_cpl = clear_val end subroutine coupling_create + + subroutine grid_create(grid, im) + implicit none + class(GFS_grid_type) :: grid + integer, intent(in) :: im + + allocate(grid%area(im)) + grid%area = clear_val + + end subroutine grid_create + + subroutine sfcprop_create(sfcprop, im) + implicit none + class(GFS_sfcprop_type) :: sfcprop + integer, intent(in) :: im + + allocate(sfcprop%vtype(im)) + sfcprop%vtype = zero + allocate(sfcprop%shdmax(im)) + sfcprop%shdmax = clear_val + allocate(sfcprop%zorl(im)) + sfcprop%zorl = clear_val + allocate(sfcprop%zorlw(im)) + sfcprop%zorlw = clear_val + allocate(sfcprop%zorll(im)) + sfcprop%zorll = clear_val + allocate(sfcprop%zorli(im)) + sfcprop%zorli = clear_val + allocate(sfcprop%zorlwav(im)) + sfcprop%zorlwav = clear_val + + end subroutine sfcprop_create + end module GFS_typedefs diff --git a/ufs/ccpp/data/GFS_typedefs.meta b/ufs/ccpp/data/GFS_typedefs.meta index b77c0085e..80f61cd00 100644 --- a/ufs/ccpp/data/GFS_typedefs.meta +++ b/ufs/ccpp/data/GFS_typedefs.meta @@ -64,6 +64,41 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[zlvl] + standard_name = height_above_ground_at_lowest_model_layer + long_name = layer 1 height above ground (not MSL) + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[prsik] + standard_name = surface_dimensionless_exner_function + long_name = dimensionless Exner function at lowest model interface + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[prslk] + standard_name = dimensionless_exner_function_at_surface_adjacent_layer + long_name = dimensionless Exner function at lowest model layer + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[u10m] + standard_name = x_wind_at_10m + long_name = 10 meter u wind speed + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[v10m] + standard_name = y_wind_at_10m + long_name = 10 meter v wind speed + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys ######################################################################## [ccpp-table-properties] @@ -190,6 +225,263 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[zvfun] + standard_name = function_of_surface_roughness_length_and_green_vegetation_fraction + long_name = function of surface roughness length and green vegetation fraction + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[sigmaf] + standard_name = bounded_vegetation_area_fraction + long_name = areal fractional cover of green vegetation bounded on the bottom + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[z01d] + standard_name = perturbation_of_momentum_roughness_length + long_name = perturbation of momentum roughness length + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[zt1d] + standard_name = perturbation_of_heat_to_momentum_roughness_length_ratio + long_name = perturbation of heat to momentum roughness length ratio + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[tsfcl] + standard_name = surface_skin_temperature_over_land + long_name = surface skin temperature over land + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tisfc] + standard_name = surface_skin_temperature_over_ice + long_name = surface skin temperature over ice + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tsurf_water] + standard_name = surface_skin_temperature_after_iteration_over_water + long_name = surface skin temperature after iteration over water + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tsurf_land] + standard_name = surface_skin_temperature_after_iteration_over_land + long_name = surface skin temperature after iteration over land + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tsurf_ice] + standard_name = surface_skin_temperature_after_iteration_over_ice + long_name = surface skin temperature after iteration over ice + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[uustar_water] + standard_name = surface_friction_velocity_over_water + long_name = surface friction velocity over water + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[uustar_land] + standard_name = surface_friction_velocity_over_land + long_name = surface friction velocity over land + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[uustar_ice] + standard_name = surface_friction_velocity_over_ice + long_name = surface friction velocity over ice + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cd_land] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_land + long_name = surface exchange coeff for momentum over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cd_ice] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_ice + long_name = surface exchange coeff for momentum over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cdq_land] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land + long_name = surface exchange coeff heat & moisture over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cdq_ice] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice + long_name = surface exchange coeff heat & moisture over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[rb_water] + standard_name = bulk_richardson_number_at_lowest_model_level_over_water + long_name = bulk Richardson number at the surface over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[rb_land] + standard_name = bulk_richardson_number_at_lowest_model_level_over_land + long_name = bulk Richardson number at the surface over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[rb_ice] + standard_name = bulk_richardson_number_at_lowest_model_level_over_ice + long_name = bulk Richardson number at the surface over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[stress_water] + standard_name = surface_wind_stress_over_water + long_name = surface wind stress over water + units = m2 s-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[stress_land] + standard_name = surface_wind_stress_over_land + long_name = surface wind stress over land + units = m2 s-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[stress_ice] + standard_name = surface_wind_stress_over_ice + long_name = surface wind stress over ice + units = m2 s-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ffmm_land] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_land + long_name = Monin-Obukhov similarity function for momentum over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ffmm_ice] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ice + long_name = Monin-Obukhov similarity function for momentum over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ffhh_water] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_water + long_name = Monin-Obukhov similarity function for heat over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ffhh_land] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_land + long_name = Monin-Obukhov similarity function for heat over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ffhh_ice] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_ice + long_name = Monin-Obukhov similarity function for heat over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fm10_land] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_land + long_name = Monin-Obukhov similarity parameter for momentum at 10m over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fm10_ice] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ice + long_name = Monin-Obukhov similarity parameter for momentum at 10m over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fh2_water] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_water + long_name = Monin-Obukhov similarity parameter for heat at 2m over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fh2_land] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_land + long_name = Monin-Obukhov similarity parameter for heat at 2m over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fh2_ice] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ice + long_name = Monin-Obukhov similarity parameter for heat at 2m over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ztmax_water] + standard_name = bounded_surface_roughness_length_for_heat_over_water + long_name = bounded surface roughness length for heat over water + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ztmax_land] + standard_name = bounded_surface_roughness_length_for_heat_over_land + long_name = bounded surface roughness length for heat over land + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ztmax_ice] + standard_name = bounded_surface_roughness_length_for_heat_over_ice + long_name = bounded surface roughness length for heat over ice + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys ######################################################################## [ccpp-table-properties] @@ -212,6 +504,30 @@ units = flag dimensions = () type = logical +[ivegsrc] + standard_name = control_for_vegetation_dataset + long_name = land use dataset choice + units = index + dimensions = () + type = integer +[redrag] + standard_name = flag_for_limited_surface_roughness_length_over_ocean + long_name = flag for reduced drag coeff. over sea + units = flag + dimensions = () + type = logical +[sfc_z0_type] + standard_name = flag_for_surface_roughness_option_over_water + long_name = surface roughness options over water + units = flag + dimensions = () + type = integer +[thsfc_loc] + standard_name = flag_for_reference_pressure_theta + long_name = flag for reference pressure in theta calculation + units = flag + dimensions = () + type = logical ######################################################################## [ccpp-table-properties] @@ -237,6 +553,73 @@ type = real kind = kind_phys +######################################################################## +[ccpp-table-properties] + name = GFS_grid_type + type = ddt + dependencies = +[ccpp-arg-table] + name = GFS_grid_type + type = ddt +[area] + standard_name = cell_area + long_name = area of the grid cell + units = m2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + +######################################################################## +[ccpp-table-properties] + name = GFS_sfcprop_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = GFS_sfcprop_type + type = ddt +[vtype] + standard_name = vegetation_type_classification + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_loop_extent) + type = integer +[shdmax] + standard_name = max_vegetation_area_fraction + long_name = max fractional coverage of green vegetation + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[zorlw] + standard_name = surface_roughness_length_over_water + long_name = surface roughness length over water + units = cm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[zorll] + standard_name = surface_roughness_length_over_land + long_name = surface roughness length over land + units = cm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[zorli] + standard_name = surface_roughness_length_over_ice + long_name = surface roughness length over ice + units = cm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[zorlwav] + standard_name = surface_roughness_length_from_wave_model + long_name = surface roughness length from wave model + units = cm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + ######################################################################## [ccpp-table-properties] name = GFS_typedefs @@ -277,6 +660,18 @@ units = DDT dimensions = () type = GFS_coupling_type +[GFS_grid_type] + standard_name = GFS_grid_type + long_name = definition of type GFS_grid_type + units = DDT + dimensions = () + type = GFS_grid_type +[GFS_sfcprop_type] + standard_name = GFS_sfcprop_type + long_name = definition of type GFS_sfcprop_type + units = DDT + dimensions = () + type = GFS_sfcprop_type [con_hvap] standard_name = latent_heat_of_vaporization_of_water_at_0C long_name = latent heat of evaporation/sublimation @@ -319,3 +714,10 @@ dimensions = () type = real kind = kind_phys +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys diff --git a/ufs/ccpp/data/med_typedefs.F90 b/ufs/ccpp/data/med_typedefs.F90 index 985626e60..f58232029 100644 --- a/ufs/ccpp/data/med_typedefs.F90 +++ b/ufs/ccpp/data/med_typedefs.F90 @@ -1,10 +1,10 @@ -!> \file med_type_defs.F90 +!> \file med_typedefs.F90 !! Contains type definitions for CMEPS-related and physics-related variables -module med_type_defs +module med_typedefs -!> \section arg_table_med_type_defs -!! \htmlinclude med_type_defs.html +!> \section arg_table_med_typedefs +!! \htmlinclude med_typedefs.html !! use GFS_typedefs, only: GFS_statein_type @@ -12,10 +12,14 @@ module med_type_defs use GFS_typedefs, only: GFS_interstitial_type use GFS_typedefs, only: GFS_control_type use GFS_typedefs, only: GFS_coupling_type + use GFS_typedefs, only: GFS_grid_type + use GFS_typedefs, only: GFS_sfcprop_type use ccpp_api, only: ccpp_t implicit none + public physics + !! \section arg_table_physics_type !! \htmlinclude physics_type.html !! @@ -25,11 +29,13 @@ module med_type_defs type(GFS_interstitial_type) :: interstitial type(GFS_control_type) :: model type(GFS_coupling_type) :: coupling + type(GFS_grid_type) :: grid + type(GFS_sfcprop_type) :: sfcprop end type physics_type - type(physics_type), target :: physics - type(ccpp_t), target :: cdata + type(physics_type), save, target :: physics + type(ccpp_t), save, target :: cdata contains -end module med_type_defs +end module med_typedefs diff --git a/ufs/ccpp/data/med_typedefs.meta b/ufs/ccpp/data/med_typedefs.meta index 28ff74f57..290d3cf73 100644 --- a/ufs/ccpp/data/med_typedefs.meta +++ b/ufs/ccpp/data/med_typedefs.meta @@ -36,16 +36,28 @@ units = DDT dimensions = () type = GFS_coupling_type +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of derived type GFS_grid_type + units = DDT + dimensions = () + type = GFS_grid_type +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = instance of derived type GFS_sfcprop_type + units = DDT + dimensions = () + type = GFS_sfcprop_type ######################################################################## [ccpp-table-properties] - name = med_type_defs + name = med_typedefs type = module dependencies = GFS_typedefs.F90 dependencies = ../../../../../FV3/ccpp/framework/src/ccpp_api.F90 [ccpp-arg-table] - name = med_type_defs + name = med_typedefs type = module [physics_type] standard_name = physics_type diff --git a/ufs/ccpp/driver/ccpp_driver.F90 b/ufs/ccpp/driver/ccpp_driver.F90 deleted file mode 100644 index 9e0477b63..000000000 --- a/ufs/ccpp/driver/ccpp_driver.F90 +++ /dev/null @@ -1,51 +0,0 @@ -module ccpp_driver - - use ccpp_api, only: ccpp_t - - implicit none - private - - public ccpp_step - - type(ccpp_t), pointer :: cdata => null() - integer :: nthrds - -!----------------------------------------------------------------------------- -contains -!----------------------------------------------------------------------------- - - subroutine ccpp_step(step, nblks, ierr) - - ! input/output variables - character(len=*), intent(in) :: step - integer, intent(in) :: nblks - integer, intent(out) :: ierr - - ! local variables - integer :: nb, nt - character(len=*), parameter :: subname='(ccpp_step)' - !----------------------------------------------------------- - - ierr = 0 - - if (trim(step)=="init") then - ! set number of threads - ! TODO: also support OpenMP threading - nthrds = 1 - - ! allocate cdata structures for blocks and threads - if (.not. allocated(cdata_block)) allocate(cdata_block(1:nblks,1:nthrds)) - - ! loop over all blocks and threads - do nt=1, nthrds - do nb=1, nblks - ! assign the correct block and thread numbers - cdata_block(nb,nt)%blk_no = nb - cdata_block(nb,nt)%thrd_no = nt - end do - end do - end if - - end subroutine ccpp_step - -end module ccpp_driver diff --git a/ufs/ccpp/driver/med_ccpp_driver.F90 b/ufs/ccpp/driver/med_ccpp_driver.F90 new file mode 100644 index 000000000..21a930f0f --- /dev/null +++ b/ufs/ccpp/driver/med_ccpp_driver.F90 @@ -0,0 +1,67 @@ +module med_ccpp_driver + + use ccpp_api, only: ccpp_t + use ccpp_static_api, only: ccpp_physics_init + use ccpp_static_api, only: ccpp_physics_run + use ccpp_static_api, only: ccpp_physics_finalize + + use med_typedefs , only: physics, cdata + + implicit none + + private ! default private + + public :: med_ccpp_driver_init + public :: med_ccpp_driver_run + public :: med_ccpp_driver_finalize + +!=============================================================================== +contains +!=============================================================================== + + subroutine med_ccpp_driver_init(ccpp_suite) + implicit none + + !--- input arguments -------------------------------- + character(len=*), intent(in) :: ccpp_suite + + !--- local variables -------------------------------- + integer :: ierr + + ! init + print*, "call ccpp_physics_init for suite "//trim(ccpp_suite) + call ccpp_physics_init(cdata, suite_name=trim(ccpp_suite), ierr=ierr) + if (ierr /= 0) then + write(0,'(a)') "An error occurred in ccpp_physics_init" + write(0,'(a)') trim(cdata%errmsg) + return + end if + + end subroutine med_ccpp_driver_init + + !============================================================================= + subroutine med_ccpp_driver_run(ccpp_suite_name, group) + implicit none + + !--- input arguments -------------------------------- + character(len=*), intent(in) :: ccpp_suite_name + character(len=*), optional, intent(in) :: group + + !--- local variables -------------------------------- + integer :: ierr + + end subroutine med_ccpp_driver_run + + !============================================================================= + subroutine med_ccpp_driver_finalize(ccpp_suite_name) + implicit none + + !--- input arguments -------------------------------- + character(len=*), intent(in) :: ccpp_suite_name + + !--- local variables -------------------------------- + integer :: ierr + + end subroutine med_ccpp_driver_finalize + +end module med_ccpp_driver diff --git a/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml b/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml index 2d93d4242..4eb437e43 100644 --- a/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml +++ b/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml @@ -3,6 +3,7 @@ + sfc_diff sfc_ocean diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index 6fb209ab4..1e9c7bfcb 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -1,56 +1,102 @@ module flux_atmocn_ccpp_mod - use ccpp_api, only: ccpp_t - use ccpp_static_api, only: ccpp_physics_init - use ccpp_static_api, only: ccpp_physics_run - use ccpp_static_api, only: ccpp_physics_finalize + use med_kind_mod, only : R8=>SHR_KIND_R8 + use physcons, only : p0 => con_p0 + use physcons, only : cappa => con_rocp + use med_typedefs, only : physics + use med_ccpp_driver, only : med_ccpp_driver_init + use med_ccpp_driver, only : med_ccpp_driver_run + use med_ccpp_driver, only : med_ccpp_driver_finalize implicit none private ! default private - public :: flux_atmOcn_init - public :: flux_atmOcn_run - public :: flux_atmOcn_finalize + public :: flux_atmOcn_ccpp ! computes atm/ocn fluxes !=============================================================================== contains !=============================================================================== - subroutine flux_atmOcn_init(ccpp_suite_name) - implicit none - - !--- input arguments -------------------------------- - character(len=*), intent(in) :: ccpp_suite_name - - !--- local variables -------------------------------- - integer :: ierr - - end subroutine flux_atmOcn_init - - !============================================================================= - subroutine flux_atmOcn_run(ccpp_suite_name, group) - implicit none - - !--- input arguments -------------------------------- - character(len=*), intent(in) :: ccpp_suite_name - character(len=*), optional, intent(in) :: group + subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & + garea, ubot, usfc, vbot, vsfc, rbot, ts, lwdn, sen, lat, & + lwup, evp, taux, tauy, qref, missval) - !--- local variables -------------------------------- - integer :: ierr - - end subroutine flux_atmOcn_run - - !============================================================================= - subroutine flux_atmOcn_finalize(ccpp_suite_name) implicit none !--- input arguments -------------------------------- - character(len=*), intent(in) :: ccpp_suite_name + integer , intent(in) :: nMax ! data vector length + integer , intent(in) :: mask (nMax) ! ocn domain mask + real(r8), intent(in) :: psfc(nMax) ! atm P (surface) (Pa) + real(r8), intent(in) :: pbot(nMax) ! atm P (bottom) (Pa) + real(r8), intent(in) :: tbot(nMax) ! atm T (bottom) (K) + real(r8), intent(in) :: qbot(nMax) ! atm specific humidity (bottom) (kg/kg) + real(r8), intent(in) :: zbot(nMax) ! atm level height (m) + real(r8), intent(in) :: garea(nMax) ! grid area (m^2) + real(r8), intent(in) :: ubot(nMax) ! atm u wind (bottom) (m/s) + real(r8), intent(in) :: usfc(nMax) ! atm u wind (surface) (m/s) + real(r8), intent(in) :: vbot(nMax) ! atm v wind (bottom) (m/s) + real(r8), intent(in) :: vsfc(nMax) ! atm v wind (surface) (m/s) + real(r8), intent(in) :: rbot(nMax) ! atm density (kg/m^3) + real(r8), intent(in) :: lwdn(nMax) ! atm lw downward (W/m^2) + real(r8), intent(in) :: ts(nMax) ! ocn surface temperature (K) + real(r8), intent(in), optional :: missval ! masked value + + !--- output arguments ------------------------------- + real(r8), intent(out) :: sen(nMax) ! heat flux: sensible (W/m^2) + real(r8), intent(out) :: lat(nMax) ! heat flux: latent (W/m^2) + real(r8), intent(out) :: lwup(nMax) ! heat flux: lw upward (W/m^2) + real(r8), intent(out) :: evp(nMax) ! heat flux: evap ((kg/s)/m^2) + real(r8), intent(out) :: taux(nMax) ! surface stress, zonal (N) + real(r8), intent(out) :: tauy(nMax) ! surface stress, maridional (N) + real(r8), intent(out) :: qref(nMax) ! diag: 2m ref humidity (kg/kg) !--- local variables -------------------------------- - integer :: ierr - - end subroutine flux_atmOcn_finalize + logical, save :: first_call = .true. + character(len=*),parameter :: subname=' (flux_atmOcn_ccpp) ' + !--------------------------------------- + + if (first_call) then + ! allocate and initalize data structures + call physics%statein%create(nMax) + call physics%interstitial%create(nMax) + call physics%coupling%create(nMax) + call physics%grid%create(nMax) + call physics%sfcprop%create(nMax) + + ! initalize dimension + physics%init%im = nMax + + ! initalize model related parameters + ! TODO: part of these need to be ingested from FV3 input.nml or configured through ESMF config file + call physics%model%init() + + ! call CCPP init + ! TODO: suite name need to be provided by ESMF config file + call med_ccpp_driver_init('FV3_sfc_ocean') + first_call = .false. + end if + + ! fill in atmospheric forcing + physics%statein%pgr(:) = psfc(:) + physics%statein%ugrs(:) = ubot(:) + physics%statein%vgrs(:) = vbot(:) + physics%statein%qgrs(:) = qbot(:) + physics%statein%prsl(:) = pbot(:) + physics%statein%zlvl(:) = zbot(:) + physics%statein%prsik(:) = (psfc(:)/p0)**cappa + physics%statein%prslk(:) = (pbot(:)/p0)**cappa + physics%statein%u10m(:) = usfc(:) + physics%statein%v10m(:) = vsfc(:) + + ! fill in grid related variables + physics%grid%area(:) = garea(:) + + ! customization of host model options to calculate the fluxes + physics%model%lseaspray = .true. + physics%model%ivegsrc = 1 + physics%model%redrag = .true. + + end subroutine flux_atmOcn_ccpp end module flux_atmocn_ccpp_mod From e1dead10a18a95c60302ccb3716fdb07a1a3dec6 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Sun, 6 Feb 2022 00:09:00 -0700 Subject: [PATCH 022/395] fix namespace collision --- ufs/ccpp/config/ccpp_prebuild_config.py | 26 +++--- ufs/ccpp/data/MED_data.F90 | 41 +++++++++ .../data/{med_typedefs.meta => MED_data.meta} | 50 +++++------ .../{GFS_typedefs.F90 => MED_typedefs.F90} | 90 +++++++++---------- .../{GFS_typedefs.meta => MED_typedefs.meta} | 88 +++++++++--------- ufs/ccpp/data/med_typedefs.F90 | 41 --------- ufs/ccpp/driver/med_ccpp_driver.F90 | 2 +- ufs/flux_atmocn_ccpp_mod.F90 | 2 +- 8 files changed, 170 insertions(+), 170 deletions(-) create mode 100644 ufs/ccpp/data/MED_data.F90 rename ufs/ccpp/data/{med_typedefs.meta => MED_data.meta} (51%) rename ufs/ccpp/data/{GFS_typedefs.F90 => MED_typedefs.F90} (92%) rename ufs/ccpp/data/{GFS_typedefs.meta => MED_typedefs.meta} (93%) delete mode 100644 ufs/ccpp/data/med_typedefs.F90 diff --git a/ufs/ccpp/config/ccpp_prebuild_config.py b/ufs/ccpp/config/ccpp_prebuild_config.py index b9d7ca1f8..4ff52a3b6 100755 --- a/ufs/ccpp/config/ccpp_prebuild_config.py +++ b/ufs/ccpp/config/ccpp_prebuild_config.py @@ -26,8 +26,8 @@ # actual variable definition files '{}/ccpp/framework/src/ccpp_types.F90'.format(fv3_path), '{}/ccpp/physics/physics/machine.F'.format(fv3_path), - 'CMEPS/ufs/ccpp/data/GFS_typedefs.F90', - 'CMEPS/ufs/ccpp/data/med_typedefs.F90' + 'CMEPS/ufs/ccpp/data/MED_typedefs.F90', + 'CMEPS/ufs/ccpp/data/MED_data.F90' ] TYPEDEFS_NEW_METADATA = { @@ -38,18 +38,18 @@ 'machine' : { 'machine' : '', }, - 'GFS_typedefs' : { - 'GFS_init_type' : 'physics%init', - 'GFS_statein_type' : 'physics%Statein', - 'GFS_interstitial_type' : 'physics%Interstitial', - 'GFS_control_type' : 'physics%Model', - 'GFS_coupling_type' : 'physics%Coupling', - 'GFS_grid_type' : 'physics%Grid', - 'GFS_sfcprop_type' : 'physics%Sfcprop', - 'GFS_typedefs' : '', + 'MED_typedefs' : { + 'MED_init_type' : 'physics%init', + 'MED_statein_type' : 'physics%Statein', + 'MED_interstitial_type' : 'physics%Interstitial', + 'MED_control_type' : 'physics%Model', + 'MED_coupling_type' : 'physics%Coupling', + 'MED_grid_type' : 'physics%Grid', + 'MED_sfcprop_type' : 'physics%Sfcprop', + 'MED_typedefs' : '', }, - 'med_typedefs' : { - 'med_typedefs' : '', + 'MED_data' : { + 'MED_data' : '', 'physics_type' : 'physics', } } diff --git a/ufs/ccpp/data/MED_data.F90 b/ufs/ccpp/data/MED_data.F90 new file mode 100644 index 000000000..b86475d44 --- /dev/null +++ b/ufs/ccpp/data/MED_data.F90 @@ -0,0 +1,41 @@ +!> \file MED_data.F90 +!! Contains type definitions for CMEPS-related and physics-related variables + +module MED_data + +!> \section arg_table_MED_data +!! \htmlinclude MED_data.html +!! + + use MED_typedefs, only: MED_statein_type + use MED_typedefs, only: MED_init_type + use MED_typedefs, only: MED_interstitial_type + use MED_typedefs, only: MED_control_type + use MED_typedefs, only: MED_coupling_type + use MED_typedefs, only: MED_grid_type + use MED_typedefs, only: MED_sfcprop_type + use ccpp_api, only: ccpp_t + + implicit none + + public physics + +!! \section arg_table_physics_type +!! \htmlinclude physics_type.html +!! + type physics_type + type(MED_init_type) :: init + type(MED_statein_type) :: statein + type(MED_interstitial_type) :: interstitial + type(MED_control_type) :: model + type(MED_coupling_type) :: coupling + type(MED_grid_type) :: grid + type(MED_sfcprop_type) :: sfcprop + end type physics_type + + type(physics_type), save, target :: physics + type(ccpp_t), save, target :: cdata + +contains + +end module MED_data diff --git a/ufs/ccpp/data/med_typedefs.meta b/ufs/ccpp/data/MED_data.meta similarity index 51% rename from ufs/ccpp/data/med_typedefs.meta rename to ufs/ccpp/data/MED_data.meta index 290d3cf73..151abce4c 100644 --- a/ufs/ccpp/data/med_typedefs.meta +++ b/ufs/ccpp/data/MED_data.meta @@ -1,63 +1,63 @@ [ccpp-table-properties] name = physics_type type = ddt - dependencies = GFS_typedefs.F90 + dependencies = MED_typedefs.F90 [ccpp-arg-table] name = physics_type type = ddt [Init] - standard_name = GFS_init_type_instance - long_name = instance of derived type GFS_init_type + standard_name = MED_init_type_instance + long_name = instance of derived type MED_init_type units = DDT dimensions = () - type = GFS_init_type + type = MED_init_type [Statein] - standard_name = GFS_statein_type_instance - long_name = instance of derived type GFS_statein_type + standard_name = MED_statein_type_instance + long_name = instance of derived type MED_statein_type units = DDT dimensions = () - type = GFS_statein_type + type = MED_statein_type [Interstitial] - standard_name = GFS_interstitial_type_instance - long_name = instance of derived type GFS_interstitial_type + standard_name = MED_interstitial_type_instance + long_name = instance of derived type MED_interstitial_type units = DDT dimensions = () - type = GFS_interstitial_type + type = MED_interstitial_type [Model] - standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type + standard_name = MED_control_type_instance + long_name = instance of derived type MED_control_type units = DDT dimensions = () - type = GFS_control_type + type = MED_control_type [Coupling] - standard_name = GFS_coupling_type_instance - long_name = instance of derived type GFS_coupling_type + standard_name = MED_coupling_type_instance + long_name = instance of derived type MED_coupling_type units = DDT dimensions = () - type = GFS_coupling_type + type = MED_coupling_type [Grid] - standard_name = GFS_grid_type_instance - long_name = instance of derived type GFS_grid_type + standard_name = MED_grid_type_instance + long_name = instance of derived type MED_grid_type units = DDT dimensions = () - type = GFS_grid_type + type = MED_grid_type [Sfcprop] - standard_name = GFS_sfcprop_type_instance - long_name = instance of derived type GFS_sfcprop_type + standard_name = MED_sfcprop_type_instance + long_name = instance of derived type MED_sfcprop_type units = DDT dimensions = () - type = GFS_sfcprop_type + type = MED_sfcprop_type ######################################################################## [ccpp-table-properties] - name = med_typedefs + name = MED_data type = module - dependencies = GFS_typedefs.F90 + dependencies = MED_typedefs.F90 dependencies = ../../../../../FV3/ccpp/framework/src/ccpp_api.F90 [ccpp-arg-table] - name = med_typedefs + name = MED_data type = module [physics_type] standard_name = physics_type diff --git a/ufs/ccpp/data/GFS_typedefs.F90 b/ufs/ccpp/data/MED_typedefs.F90 similarity index 92% rename from ufs/ccpp/data/GFS_typedefs.F90 rename to ufs/ccpp/data/MED_typedefs.F90 index aeb795e14..675df45c1 100644 --- a/ufs/ccpp/data/GFS_typedefs.F90 +++ b/ufs/ccpp/data/MED_typedefs.F90 @@ -1,7 +1,7 @@ -module GFS_typedefs +module MED_typedefs -!> \section arg_table_GFS_typedefs -!! \htmlinclude GFS_typedefs.html +!> \section arg_table_MED_typedefs +!! \htmlinclude MED_typedefs.html !! use machine, only: kind_phys use physcons, only: con_hvap, con_cp, con_rd, con_eps @@ -16,17 +16,17 @@ module GFS_typedefs !--- data containers -!! \section arg_table_GFS_init_type -!! \htmlinclude GFS_init_type.html +!! \section arg_table_MED_init_type +!! \htmlinclude MED_init_type.html !! - type GFS_init_type - integer, pointer :: im !< horizontal loop extent - end type GFS_init_type + type MED_init_type + integer :: im !< horizontal loop extent + end type MED_init_type -!! \section arg_table_GFS_statein_type -!! \htmlinclude GFS_statein_type.html +!! \section arg_table_MED_statein_type +!! \htmlinclude MED_statein_type.html !! - type GFS_statein_type + type MED_statein_type real(kind=kind_phys), pointer :: pgr(:) => null() !< surface pressure (Pa) real(kind=kind_phys), pointer :: ugrs(:) => null() !< u component of layer wind (m/s) real(kind=kind_phys), pointer :: vgrs(:) => null() !< v component of layer wind (m/s) @@ -40,12 +40,12 @@ module GFS_typedefs real(kind=kind_phys), pointer :: v10m(:) => null() !< 10 meter v wind speed contains procedure :: create => statein_create !< allocate array data - end type GFS_statein_type + end type MED_statein_type -!! \section arg_table_GFS_interstitial_type -!! \htmlinclude GFS_interstitial_type.html +!! \section arg_table_MED_interstitial_type +!! \htmlinclude MED_interstitial_type.html !! - type GFS_interstitial_type + type MED_interstitial_type ! water real(kind=kind_phys), pointer :: tsfc_water(:) => null() !< surface skin temperature over water (K) real(kind=kind_phys), pointer :: cd_water(:) => null() !< surface exchange coeff for momentum over water @@ -109,12 +109,12 @@ module GFS_typedefs real(kind=kind_phys), pointer :: zt1d(:) => null() !< perturbation of heat to momentum roughness length ratio contains procedure :: create => interstitial_create !< allocate array data - end type GFS_interstitial_type + end type MED_interstitial_type -!! \section arg_table_GFS_control_type -!! \htmlinclude GFS_control_type.html +!! \section arg_table_MED_control_type +!! \htmlinclude MED_control_type.html !! - type GFS_control_type + type MED_control_type !--- tuning parameters for physical parameterizations logical :: lseaspray !< flag for sea spray parameterization !--- coupling parameters @@ -129,31 +129,31 @@ module GFS_typedefs logical :: thsfc_loc !< flag for reference pressure in theta calculation contains procedure :: init => control_initialize - end type GFS_control_type + end type MED_control_type -!! \section arg_table_GFS_coupling_type -!! \htmlinclude GFS_coupling_type.html +!! \section arg_table_MED_coupling_type +!! \htmlinclude MED_coupling_type.html !! - type GFS_coupling_type + type MED_coupling_type real(kind=kind_phys), pointer :: dtsfcino_cpl(:) => null() !< sfc latent heat flux over ocean real(kind=kind_phys), pointer :: dqsfcino_cpl(:) => null() !< sfc sensible heat flux over ocean contains procedure :: create => coupling_create !< allocate array data - end type GFS_coupling_type + end type MED_coupling_type -!! \section arg_table_GFS_grid_type -!! \htmlinclude GFS_grid_type.html +!! \section arg_table_MED_grid_type +!! \htmlinclude MED_grid_type.html !! - type GFS_grid_type + type MED_grid_type real(kind=kind_phys), pointer :: area(:) => null() !< area of the grid cell contains procedure :: create => grid_create !< allocate array data - end type GFS_grid_type + end type MED_grid_type -!! \section arg_table_GFS_sfcprop_type -!! \htmlinclude GFS_sfcprop_type.html +!! \section arg_table_MED_sfcprop_type +!! \htmlinclude MED_sfcprop_type.html !! - type GFS_sfcprop_type + type MED_sfcprop_type ! water real(kind=kind_phys), pointer :: zorlw(:) => null() !< surface roughness length over water (cm) @@ -173,20 +173,20 @@ module GFS_typedefs contains procedure :: create => sfcprop_create !< allocate array data - end type GFS_sfcprop_type + end type MED_sfcprop_type - public GFS_init_type - public GFS_statein_type - public GFS_coupling_type - public GFS_control_type - public GFS_interstitial_type - public GFS_grid_type + public MED_init_type + public MED_statein_type + public MED_coupling_type + public MED_control_type + public MED_interstitial_type + public MED_grid_type contains subroutine statein_create(statein, im) implicit none - class(GFS_statein_type) :: statein + class(MED_statein_type) :: statein integer, intent(in) :: im allocate(statein%pgr(im)) @@ -216,7 +216,7 @@ end subroutine statein_create subroutine interstitial_create(interstitial, im) implicit none - class(GFS_interstitial_type) :: interstitial + class(MED_interstitial_type) :: interstitial integer, intent(in) :: im ! water @@ -339,7 +339,7 @@ end subroutine interstitial_create subroutine control_initialize(model) implicit none - class(GFS_control_type) :: model + class(MED_control_type) :: model model%lseaspray = .false. model%use_med_flux = .false. @@ -352,7 +352,7 @@ end subroutine control_initialize subroutine coupling_create(coupling, im) implicit none - class(GFS_coupling_type) :: coupling + class(MED_coupling_type) :: coupling integer, intent(in) :: im allocate(coupling%dtsfcino_cpl(im)) @@ -364,7 +364,7 @@ end subroutine coupling_create subroutine grid_create(grid, im) implicit none - class(GFS_grid_type) :: grid + class(MED_grid_type) :: grid integer, intent(in) :: im allocate(grid%area(im)) @@ -374,7 +374,7 @@ end subroutine grid_create subroutine sfcprop_create(sfcprop, im) implicit none - class(GFS_sfcprop_type) :: sfcprop + class(MED_sfcprop_type) :: sfcprop integer, intent(in) :: im allocate(sfcprop%vtype(im)) @@ -394,4 +394,4 @@ subroutine sfcprop_create(sfcprop, im) end subroutine sfcprop_create -end module GFS_typedefs +end module MED_typedefs diff --git a/ufs/ccpp/data/GFS_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta similarity index 93% rename from ufs/ccpp/data/GFS_typedefs.meta rename to ufs/ccpp/data/MED_typedefs.meta index 80f61cd00..3da511097 100644 --- a/ufs/ccpp/data/GFS_typedefs.meta +++ b/ufs/ccpp/data/MED_typedefs.meta @@ -1,10 +1,10 @@ [ccpp-table-properties] - name = GFS_init_type + name = MED_init_type type = ddt dependencies = [ccpp-arg-table] - name = GFS_init_type + name = MED_init_type type = ddt [im] standard_name = horizontal_loop_extent @@ -15,12 +15,12 @@ ######################################################################## [ccpp-table-properties] - name = GFS_statein_type + name = MED_statein_type type = ddt dependencies = [ccpp-arg-table] - name = GFS_statein_type + name = MED_statein_type type = ddt [pgr] standard_name = surface_air_pressure @@ -102,12 +102,12 @@ ######################################################################## [ccpp-table-properties] - name = GFS_interstitial_type + name = MED_interstitial_type type = ddt dependencies = [ccpp-arg-table] - name = GFS_interstitial_type + name = MED_interstitial_type type = ddt [tsfc_water] standard_name = surface_skin_temperature_over_water @@ -485,12 +485,12 @@ ######################################################################## [ccpp-table-properties] - name = GFS_control_type + name = MED_control_type type = ddt dependencies = [ccpp-arg-table] - name = GFS_control_type + name = MED_control_type type = ddt [lseaspray] standard_name = flag_for_sea_spray @@ -531,12 +531,12 @@ ######################################################################## [ccpp-table-properties] - name = GFS_coupling_type + name = MED_coupling_type type = ddt dependencies = [ccpp-arg-table] - name = GFS_coupling_type + name = MED_coupling_type type = ddt [dtsfcino_cpl] standard_name = surface_upward_sensible_heat_flux_over_ocean_from_coupled_process @@ -555,11 +555,11 @@ ######################################################################## [ccpp-table-properties] - name = GFS_grid_type + name = MED_grid_type type = ddt dependencies = [ccpp-arg-table] - name = GFS_grid_type + name = MED_grid_type type = ddt [area] standard_name = cell_area @@ -571,12 +571,12 @@ ######################################################################## [ccpp-table-properties] - name = GFS_sfcprop_type + name = MED_sfcprop_type type = ddt dependencies = [ccpp-arg-table] - name = GFS_sfcprop_type + name = MED_sfcprop_type type = ddt [vtype] standard_name = vegetation_type_classification @@ -622,56 +622,56 @@ ######################################################################## [ccpp-table-properties] - name = GFS_typedefs + name = MED_typedefs type = module relative_path = ../../../../../FV3/ccpp/physics/physics dependencies = machine.F,physcons.F90 [ccpp-arg-table] - name = GFS_typedefs + name = MED_typedefs type = module -[GFS_init_type] - standard_name = GFS_init_type - long_name = definition of type GFS_init_type +[MED_init_type] + standard_name = MED_init_type + long_name = definition of type MED_init_type units = DDT dimensions = () - type = GFS_init_type -[GFS_statein_type] - standard_name = GFS_statein_type - long_name = definition of type GFS_statein_type + type = MED_init_type +[MED_statein_type] + standard_name = MED_statein_type + long_name = definition of type MED_statein_type units = DDT dimensions = () - type = GFS_statein_type -[GFS_interstitial_type] - standard_name = GFS_interstitial_type - long_name = definition of type GFS_interstitial_type + type = MED_statein_type +[MED_interstitial_type] + standard_name = MED_interstitial_type + long_name = definition of type MED_interstitial_type units = DDT dimensions = () - type = GFS_interstitial_type -[GFS_control_type] - standard_name = GFS_control_type - long_name = definition of type GFS_control_type + type = MED_interstitial_type +[MED_control_type] + standard_name = MED_control_type + long_name = definition of type MED_control_type units = DDT dimensions = () - type = GFS_control_type -[GFS_coupling_type] - standard_name = GFS_coupling_type - long_name = definition of type GFS_coupling_type + type = MED_control_type +[MED_coupling_type] + standard_name = MED_coupling_type + long_name = definition of type MED_coupling_type units = DDT dimensions = () - type = GFS_coupling_type -[GFS_grid_type] - standard_name = GFS_grid_type - long_name = definition of type GFS_grid_type + type = MED_coupling_type +[MED_grid_type] + standard_name = MED_grid_type + long_name = definition of type MED_grid_type units = DDT dimensions = () - type = GFS_grid_type -[GFS_sfcprop_type] - standard_name = GFS_sfcprop_type - long_name = definition of type GFS_sfcprop_type + type = MED_grid_type +[MED_sfcprop_type] + standard_name = MED_sfcprop_type + long_name = definition of type MED_sfcprop_type units = DDT dimensions = () - type = GFS_sfcprop_type + type = MED_sfcprop_type [con_hvap] standard_name = latent_heat_of_vaporization_of_water_at_0C long_name = latent heat of evaporation/sublimation diff --git a/ufs/ccpp/data/med_typedefs.F90 b/ufs/ccpp/data/med_typedefs.F90 deleted file mode 100644 index f58232029..000000000 --- a/ufs/ccpp/data/med_typedefs.F90 +++ /dev/null @@ -1,41 +0,0 @@ -!> \file med_typedefs.F90 -!! Contains type definitions for CMEPS-related and physics-related variables - -module med_typedefs - -!> \section arg_table_med_typedefs -!! \htmlinclude med_typedefs.html -!! - - use GFS_typedefs, only: GFS_statein_type - use GFS_typedefs, only: GFS_init_type - use GFS_typedefs, only: GFS_interstitial_type - use GFS_typedefs, only: GFS_control_type - use GFS_typedefs, only: GFS_coupling_type - use GFS_typedefs, only: GFS_grid_type - use GFS_typedefs, only: GFS_sfcprop_type - use ccpp_api, only: ccpp_t - - implicit none - - public physics - -!! \section arg_table_physics_type -!! \htmlinclude physics_type.html -!! - type physics_type - type(GFS_init_type) :: init - type(GFS_statein_type) :: statein - type(GFS_interstitial_type) :: interstitial - type(GFS_control_type) :: model - type(GFS_coupling_type) :: coupling - type(GFS_grid_type) :: grid - type(GFS_sfcprop_type) :: sfcprop - end type physics_type - - type(physics_type), save, target :: physics - type(ccpp_t), save, target :: cdata - -contains - -end module med_typedefs diff --git a/ufs/ccpp/driver/med_ccpp_driver.F90 b/ufs/ccpp/driver/med_ccpp_driver.F90 index 21a930f0f..0a5630bd4 100644 --- a/ufs/ccpp/driver/med_ccpp_driver.F90 +++ b/ufs/ccpp/driver/med_ccpp_driver.F90 @@ -5,7 +5,7 @@ module med_ccpp_driver use ccpp_static_api, only: ccpp_physics_run use ccpp_static_api, only: ccpp_physics_finalize - use med_typedefs , only: physics, cdata + use MED_data, only: physics, cdata implicit none diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index 1e9c7bfcb..e81731396 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -3,7 +3,7 @@ module flux_atmocn_ccpp_mod use med_kind_mod, only : R8=>SHR_KIND_R8 use physcons, only : p0 => con_p0 use physcons, only : cappa => con_rocp - use med_typedefs, only : physics + use MED_data, only : physics use med_ccpp_driver, only : med_ccpp_driver_init use med_ccpp_driver, only : med_ccpp_driver_run use med_ccpp_driver, only : med_ccpp_driver_finalize From 792be4c30b1ea969a3ca18bc95a2282cd8e42dd1 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Tue, 8 Feb 2022 16:38:38 -0700 Subject: [PATCH 023/395] update CCPP host model --- ufs/ccpp/config/ccpp_prebuild_config.py | 3 + ufs/ccpp/data/MED_typedefs.F90 | 81 +++++++++++++++++++++++-- ufs/ccpp/data/MED_typedefs.meta | 24 ++++++++ ufs/ccpp/driver/med_ccpp_driver.F90 | 39 +++++++++--- ufs/ccpp/suites/suite_FV3_sfc_ocean.xml | 8 +++ ufs/flux_atmocn_ccpp_mod.F90 | 56 +++++++++++++++++ 6 files changed, 197 insertions(+), 14 deletions(-) diff --git a/ufs/ccpp/config/ccpp_prebuild_config.py b/ufs/ccpp/config/ccpp_prebuild_config.py index 4ff52a3b6..9d7fc7f5e 100755 --- a/ufs/ccpp/config/ccpp_prebuild_config.py +++ b/ufs/ccpp/config/ccpp_prebuild_config.py @@ -58,7 +58,10 @@ SCHEME_FILES = [ '{}/ccpp/physics/physics/sfc_ocean.F'.format(fv3_path), '{}/ccpp/physics/physics/sfc_diff.f'.format(fv3_path), + '{}/ccpp/physics/physics/GFS_surface_loop_control.F90'.format(fv3_path), ] + #'{}/ccpp/physics/physics/GFS_suite_interstitial.F90'.format(fv3_path) + #'{}/ccpp/physics/physics/GFS_surface_composites.F90'.format(fv3_path) # Default build dir, relative to current working directory, # if not specified as command-line argument diff --git a/ufs/ccpp/data/MED_typedefs.F90 b/ufs/ccpp/data/MED_typedefs.F90 index 675df45c1..0bf903ced 100644 --- a/ufs/ccpp/data/MED_typedefs.F90 +++ b/ufs/ccpp/data/MED_typedefs.F90 @@ -107,8 +107,10 @@ module MED_typedefs ! others real(kind=kind_phys), pointer :: z01d(:) => null() !< perturbation of momentum roughness length real(kind=kind_phys), pointer :: zt1d(:) => null() !< perturbation of heat to momentum roughness length ratio + logical, pointer :: flag_guess(:) => null() !< flag for guess run contains procedure :: create => interstitial_create !< allocate array data + procedure :: phys_reset => interstitial_phys_reset !< reset array data for physics end type MED_interstitial_type !! \section arg_table_MED_control_type @@ -121,12 +123,16 @@ module MED_typedefs logical :: use_med_flux !< flag for using atmosphere-ocean fluxes form mediator !--- land/surface model parameters, not used to calculate aofluxes integer :: ivegsrc !< land use dataset choice 0 => USGS, 1 => IGBP, 2 => UMD + integer :: lsm !< flag for land surface model + integer :: lsm_noahmp !< flag for NOAH MP land surface model !--- tuning parameters for physical parameterizations logical :: redrag !< flag for reduced drag coeff. over sea !--- surface layer z0 scheme integer :: sfc_z0_type !< surface roughness options over water !--- potential temperature definition in surface layer physics logical :: thsfc_loc !< flag for reference pressure in theta calculation + !--- near surface temperature model + integer :: nstf_name(5) !< NSSTM flag: off/uncoupled/coupled=0/1/2 contains procedure :: init => control_initialize end type MED_control_type @@ -262,8 +268,8 @@ subroutine interstitial_create(interstitial, im) interstitial%rb_water = huge allocate(interstitial%stress_water(im)) interstitial%stress_water = huge - allocate(interstitial%ffmm_water(im)) - interstitial%ffmm_water = huge + allocate(interstitial%ffhh_water(im)) + interstitial%ffhh_water = huge allocate(interstitial%fh2_water(im)) interstitial%fh2_water = huge allocate(interstitial%ztmax_water(im)) @@ -320,8 +326,8 @@ subroutine interstitial_create(interstitial, im) interstitial%stress_ice = huge allocate(interstitial%ffmm_ice(im)) interstitial%ffmm_ice = huge - allocate(interstitial%ffmm_ice(im)) - interstitial%ffmm_ice = huge + allocate(interstitial%ffhh_ice(im)) + interstitial%ffhh_ice = huge allocate(interstitial%fm10_ice(im)) interstitial%fm10_ice = huge allocate(interstitial%fh2_ice(im)) @@ -334,9 +340,73 @@ subroutine interstitial_create(interstitial, im) interstitial%z01d = clear_val allocate(interstitial%zt1d(im)) interstitial%zt1d = clear_val + allocate(interstitial%flag_guess(im)) + interstitial%flag_guess = .false. end subroutine interstitial_create + subroutine interstitial_phys_reset(interstitial) + implicit none + class(MED_interstitial_type) :: interstitial + + interstitial%cd_ice = huge + interstitial%cd_land = huge + interstitial%cd_water = huge + interstitial%cdq_ice = huge + interstitial%cdq_land = huge + interstitial%cdq_water = huge + interstitial%chh_water = huge + interstitial%cmm_water = huge + interstitial%dry = .false. + interstitial%ep1d_water = huge + interstitial%evap_water = huge + interstitial%ffhh_ice = huge + interstitial%ffhh_land = huge + interstitial%ffhh_water = huge + interstitial%ffmm_ice = huge + interstitial%ffmm_land = huge + interstitial%ffmm_water = huge + interstitial%fh2_ice = huge + interstitial%fh2_land = huge + interstitial%fh2_water = huge + interstitial%flag_guess = .false. + interstitial%flag_iter = .true. + interstitial%fm10_ice = huge + interstitial%fm10_land = huge + interstitial%fm10_water = huge + interstitial%gflx_water = clear_val + interstitial%hflx_water = huge + interstitial%icy = .false. + interstitial%prslki = clear_val + interstitial%qss_water = huge + interstitial%rb_ice = huge + interstitial%rb_land = huge + interstitial%rb_water = huge + interstitial%sigmaf = clear_val + interstitial%stress_ice = huge + interstitial%stress_land = huge + interstitial%stress_water = huge + interstitial%tisfc = clear_val + interstitial%tsfc_water = huge + interstitial%tsfcl = clear_val + interstitial%tsurf_ice = huge + interstitial%tsurf_land = huge + interstitial%tsurf_water = huge + interstitial%use_flake = .false. + interstitial%uustar_ice = huge + interstitial%uustar_land = huge + interstitial%uustar_water = huge + interstitial%wet = .false. + interstitial%wind = huge + interstitial%z01d = clear_val + interstitial%zt1d = clear_val + interstitial%ztmax_ice = clear_val + interstitial%ztmax_land = clear_val + interstitial%ztmax_water = clear_val + interstitial%zvfun = clear_val + + end subroutine interstitial_phys_reset + subroutine control_initialize(model) implicit none class(MED_control_type) :: model @@ -347,6 +417,9 @@ subroutine control_initialize(model) model%redrag = .false. model%sfc_z0_type = 0 model%thsfc_loc = .true. + model%lsm = 1 + model%lsm_noahmp = 2 + model%nstf_name = (/0,0,1,0,5/) end subroutine control_initialize diff --git a/ufs/ccpp/data/MED_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta index 3da511097..f93ccd476 100644 --- a/ufs/ccpp/data/MED_typedefs.meta +++ b/ufs/ccpp/data/MED_typedefs.meta @@ -482,6 +482,12 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[flag_guess] + standard_name = flag_for_guess_run + long_name = flag for guess run + units = flag + dimensions = (horizontal_loop_extent) + type = logical ######################################################################## [ccpp-table-properties] @@ -528,6 +534,24 @@ units = flag dimensions = () type = logical +[lsm] + standard_name = control_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer +[lsm_noahmp] + standard_name = identifier_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer +[nstf_name(1)] + standard_name = control_for_nsstm + long_name = NSSTM flag: off/uncoupled/coupled=0/1/2 + units = flag + dimensions = () + type = integer ######################################################################## [ccpp-table-properties] diff --git a/ufs/ccpp/driver/med_ccpp_driver.F90 b/ufs/ccpp/driver/med_ccpp_driver.F90 index 0a5630bd4..aa50062b5 100644 --- a/ufs/ccpp/driver/med_ccpp_driver.F90 +++ b/ufs/ccpp/driver/med_ccpp_driver.F90 @@ -1,9 +1,9 @@ module med_ccpp_driver - use ccpp_api, only: ccpp_t - use ccpp_static_api, only: ccpp_physics_init - use ccpp_static_api, only: ccpp_physics_run - use ccpp_static_api, only: ccpp_physics_finalize + use ccpp_api, only: ccpp_t + use ccpp_static_api_med, only: ccpp_physics_init + use ccpp_static_api_med, only: ccpp_physics_run + use ccpp_static_api_med, only: ccpp_physics_finalize use MED_data, only: physics, cdata @@ -28,8 +28,7 @@ subroutine med_ccpp_driver_init(ccpp_suite) !--- local variables -------------------------------- integer :: ierr - ! init - print*, "call ccpp_physics_init for suite "//trim(ccpp_suite) + ! initialize CCPP physics (run all _init routines) call ccpp_physics_init(cdata, suite_name=trim(ccpp_suite), ierr=ierr) if (ierr /= 0) then write(0,'(a)') "An error occurred in ccpp_physics_init" @@ -40,28 +39,48 @@ subroutine med_ccpp_driver_init(ccpp_suite) end subroutine med_ccpp_driver_init !============================================================================= - subroutine med_ccpp_driver_run(ccpp_suite_name, group) + subroutine med_ccpp_driver_run(ccpp_suite, group) implicit none !--- input arguments -------------------------------- - character(len=*), intent(in) :: ccpp_suite_name + character(len=*), intent(in) :: ccpp_suite character(len=*), optional, intent(in) :: group !--- local variables -------------------------------- integer :: ierr + ! run CCPP physics (run all _run routines) + if (present(group)) then + call ccpp_physics_run(cdata, suite_name=trim(ccpp_suite), group_name=trim(group), ierr=ierr) + else + call ccpp_physics_run(cdata, suite_name=trim(ccpp_suite), ierr=ierr) + end if + if (ierr /= 0) then + write(0,'(a)') "An error occurred in ccpp_physics_run" + write(0,'(a)') trim(cdata%errmsg) + return + end if + end subroutine med_ccpp_driver_run !============================================================================= - subroutine med_ccpp_driver_finalize(ccpp_suite_name) + subroutine med_ccpp_driver_finalize(ccpp_suite) implicit none !--- input arguments -------------------------------- - character(len=*), intent(in) :: ccpp_suite_name + character(len=*), intent(in) :: ccpp_suite !--- local variables -------------------------------- integer :: ierr + ! finalize CCPP physics (run all _finalize routines) + call ccpp_physics_finalize(cdata, suite_name=trim(ccpp_suite), ierr=ierr) + if (ierr /= 0) then + write(0,'(a)') "An error occurred in ccpp_physics_finalize" + write(0,'(a)') trim(cdata%errmsg) + return + end if + end subroutine med_ccpp_driver_finalize end module med_ccpp_driver diff --git a/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml b/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml index 4eb437e43..0336cb2b5 100644 --- a/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml +++ b/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml @@ -2,9 +2,17 @@ + + sfc_diff + GFS_surface_loop_control_part1 sfc_ocean + GFS_surface_loop_control_part2 + diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index e81731396..aec469fba 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -3,10 +3,14 @@ module flux_atmocn_ccpp_mod use med_kind_mod, only : R8=>SHR_KIND_R8 use physcons, only : p0 => con_p0 use physcons, only : cappa => con_rocp + use physcons, only : cp => con_cp + use physcons, only : hvap => con_hvap + use physcons, only : sbc => con_sbc use MED_data, only : physics use med_ccpp_driver, only : med_ccpp_driver_init use med_ccpp_driver, only : med_ccpp_driver_run use med_ccpp_driver, only : med_ccpp_driver_finalize + use ufs_const_mod implicit none @@ -52,10 +56,23 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & real(r8), intent(out) :: qref(nMax) ! diag: 2m ref humidity (kg/kg) !--- local variables -------------------------------- + integer :: n + real(r8) :: spval, semis_water logical, save :: first_call = .true. character(len=*),parameter :: subname=' (flux_atmOcn_ccpp) ' !--------------------------------------- + !--- missing value --- + if (present(missval)) then + spval = missval + else + spval = shr_const_spval + endif + + !--- set up surface emissivity for lw radiation --- + !--- semis_wat is constant and set to 0.97 in setemis() call --- + semis_water = 0.97 + if (first_call) then ! allocate and initalize data structures call physics%statein%create(nMax) @@ -93,9 +110,48 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & physics%grid%area(:) = garea(:) ! customization of host model options to calculate the fluxes + ! TODO: this needs to be provided by config physics%model%lseaspray = .true. physics%model%ivegsrc = 1 physics%model%redrag = .true. + physics%model%lsm = 2 + + ! run physics + print*, "*** call med_ccpp_driver_run ***" + + call physics%interstitial%phys_reset() + + where (mask(:) /= 0) + physics%interstitial%wet = .true. + end where + + physics%interstitial%wind = sqrt(ubot(:)**2+vbot(:)**2) + physics%interstitial%prslki = physics%statein%prsik(:)/physics%statein%prslk(:) + physics%interstitial%tsurf_water = ts + physics%interstitial%tsfc_water = ts + + call med_ccpp_driver_run('FV3_sfc_ocean', 'physics') + + !--- unit and sign conversion to be consistent with other flux scheme --- + do n = 1, nMax + if (mask(n) /= 0) then + sen(n) = -1.0_r8*physics%interstitial%hflx_water(n)*rbot(n)*cp + lat(n) = -1.0_r8*physics%interstitial%evap_water(n)*rbot(n)*hvap + lwup(n) = -1.0_r8*(semis_water*sbc*ts(n)**4+(1.0_r8-semis_water)*lwdn(n)) + evp(n) = lat(n)/hvap + taux(n) = rbot(n)*physics%interstitial%stress_water(n)*ubot(n)/physics%interstitial%wind(n) + tauy(n) = rbot(n)*physics%interstitial%stress_water(n)*vbot(n)/physics%interstitial%wind(n) + qref(n) = physics%interstitial%qss_water(n) + else + sen(n) = spval + lat(n) = spval + lwup(n) = spval + evp(n) = spval + taux(n) = spval + tauy(n) = spval + qref(n) = spval + end if + end do end subroutine flux_atmOcn_ccpp From 2a3cb9e31a7fae9210fe4799efe95f876b1bca87 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Wed, 9 Feb 2022 00:19:50 -0700 Subject: [PATCH 024/395] fix latent and sensible heat fluxes and clean code --- mediator/esmFldsExchange_nems_mod.F90 | 3 --- mediator/med_phases_prep_ocn_mod.F90 | 5 ----- ufs/flux_atmocn_ccpp_mod.F90 | 20 +++++++++++--------- 3 files changed, 11 insertions(+), 17 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 2fd599123..597a03397 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -320,9 +320,6 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call addfld(fldListTo(compocn)%flds, 'Faox_evap') call addmrg(fldListTo(compocn)%flds, 'Faox_evap', & mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='copy_with_weights', mrg_fracname='ofrac') - !else if (trim(coupling_mode) == 'nems_frac_aoflux') then - ! ! to ocn: sensible heat flux from mediator (custom merge in med_phases_prep_ocn) - ! call addfld(fldListTo(compocn)%flds, 'Foxx_sen') end if ! to ocn: water flux due to melting ice from ice diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index db11c0c0a..aa6b3b189 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -591,11 +591,6 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) FBinA=is_local%wrap%FBImp(compice,compocn), fnameA='Fioi_tauy', wgtA=ifrac, & FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_tauy', wgtB=customwgt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !else if (trim(coupling_mode) == 'nems_frac_aoflux') then - ! customwgt(:) = -ofrac(:) - ! call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_sen', & - ! FBinA=is_local%wrap%FBMed_aoflux_o, fnameA='Faox_sen', wgtA=customwgt, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! netsw_for_ocn = [downsw_from_atm*(1-ice_fraction)*(1-ocn_albedo)] + [pensw_from_ice*(ice_fraction)] diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index aec469fba..941a0954b 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -62,15 +62,16 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & character(len=*),parameter :: subname=' (flux_atmOcn_ccpp) ' !--------------------------------------- - !--- missing value --- + ! missing value if (present(missval)) then spval = missval else spval = shr_const_spval endif - !--- set up surface emissivity for lw radiation --- - !--- semis_wat is constant and set to 0.97 in setemis() call --- + ! set up surface emissivity for lw radiation + ! semis_wat is constant and set to 0.97 in setemis() call + ! TODO: This could be a part of CCPP suite or provided by ESMF config semis_water = 0.97 if (first_call) then @@ -88,7 +89,7 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & ! TODO: part of these need to be ingested from FV3 input.nml or configured through ESMF config file call physics%model%init() - ! call CCPP init + ! run CCPP init ! TODO: suite name need to be provided by ESMF config file call med_ccpp_driver_init('FV3_sfc_ocean') first_call = .false. @@ -98,6 +99,7 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & physics%statein%pgr(:) = psfc(:) physics%statein%ugrs(:) = ubot(:) physics%statein%vgrs(:) = vbot(:) + physics%statein%tgrs(:) = tbot(:) physics%statein%qgrs(:) = qbot(:) physics%statein%prsl(:) = pbot(:) physics%statein%zlvl(:) = zbot(:) @@ -116,23 +118,23 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & physics%model%redrag = .true. physics%model%lsm = 2 - ! run physics - print*, "*** call med_ccpp_driver_run ***" - + ! reset physics variables call physics%interstitial%phys_reset() + ! fill in required interstitial variables where (mask(:) /= 0) physics%interstitial%wet = .true. end where - physics%interstitial%wind = sqrt(ubot(:)**2+vbot(:)**2) physics%interstitial%prslki = physics%statein%prsik(:)/physics%statein%prslk(:) physics%interstitial%tsurf_water = ts physics%interstitial%tsfc_water = ts + ! run CCPP physics + ! TODO: suite name need to be provided by ESMF config file call med_ccpp_driver_run('FV3_sfc_ocean', 'physics') - !--- unit and sign conversion to be consistent with other flux scheme --- + ! unit and sign conversion to be consistent with other flux scheme (CESM) do n = 1, nMax if (mask(n) /= 0) then sen(n) = -1.0_r8*physics%interstitial%hflx_water(n)*rbot(n)*cp From f127fa6a326ef9cd562214296653a8f7db66e218 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Wed, 9 Feb 2022 13:45:58 -0700 Subject: [PATCH 025/395] add new coupling mode for side by side flux comparison --- mediator/esmFldsExchange_nems_mod.F90 | 10 ++++++---- mediator/med.F90 | 5 +++-- mediator/med_fraction_mod.F90 | 6 ++++-- mediator/med_internalstate_mod.F90 | 2 +- mediator/med_phases_aofluxes_mod.F90 | 9 +++++---- mediator/med_phases_prep_atm_mod.F90 | 3 ++- mediator/med_phases_prep_ocn_mod.F90 | 6 ++++-- 7 files changed, 25 insertions(+), 16 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 597a03397..e23824949 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -94,7 +94,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call addfld(fldListFr(compocn)%flds, 'So_omask') call addmap(fldListFr(compocn)%flds, 'So_omask', compice, mapfcopy, 'unset', 'unset') - if ( trim(coupling_mode) == 'nems_orig_data') then + if (trim(coupling_mode) == 'nems_orig_data') then ! atm and ocn fields required for atm/ocn flux calculation' allocate(flds(10)) flds = (/'Sa_u ','Sa_v ', 'Sa_z ', 'Sa_tbot', 'Sa_pbot', 'Sa_shum', & @@ -105,7 +105,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'one', 'unset') end do deallocate(flds) - else if (trim(coupling_mode) == 'nems_frac_aoflux') then + else if (trim(coupling_mode) == 'nems_frac_aoflux' .or. trim(coupling_mode) == 'nems_frac_aoflux_sbs') then ! to med: atm and ocn fields required for atm/ocn flux calculation allocate(flds(11)) flds = (/'Sa_u ', 'Sa_v ', 'Sa_z ', 'Sa_tbot ', 'Sa_pbot ', & @@ -119,7 +119,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) deallocate(flds) end if - if ( trim(coupling_mode) == 'nems_orig_data' .or. trim(coupling_mode) == 'nems_frac_aoflux') then + if (trim(coupling_mode) == 'nems_orig_data' .or. & + trim(coupling_mode) == 'nems_frac_aoflux' .or. trim(coupling_mode) == 'nems_frac_aoflux_sbs') then ! unused fields needed by the atm/ocn flux computation allocate(flds(13)) flds = (/'So_tref ', 'So_qref ','So_u10 ', 'So_ustar ','So_ssq ', & @@ -258,7 +259,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end do deallocate(flds) - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then + if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac' .or. & + trim(coupling_mode) == 'nems_frac_aoflux_sbs') then ! to ocn: merge surface stress (custom merge calculation in med_phases_prep_ocn) allocate(flds(2)) flds = (/'taux', 'tauy'/) diff --git a/mediator/med.F90 b/mediator/med.F90 index 315d71b04..2ba4eb28b 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -781,8 +781,9 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) if (trim(coupling_mode) == 'cesm') then call esmFldsExchange_cesm(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac' & - .or. trim(coupling_mode) == 'nems_orig_data' .or. trim(coupling_mode) == 'nems_frac_aoflux') then + else if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac' .or. & + trim(coupling_mode) == 'nems_orig_data' .or. trim(coupling_mode) == 'nems_frac_aoflux' .or. & + trim(coupling_mode) == 'nems_frac_aoflux_sbs') then call esmFldsExchange_nems(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode(1:4)) == 'hafs') then diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index a4cc06052..521ba0007 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -369,7 +369,8 @@ subroutine med_fraction_init(gcomp, rc) ! Set 'aofrac' in FBfrac(compatm) if (trim(coupling_mode) == 'nems_orig' .or. & trim(coupling_mode) == 'nems_frac' .or. & - trim(coupling_mode) == 'nems_frac_aoflux') then + trim(coupling_mode) == 'nems_frac_aoflux' .or. & + trim(coupling_mode) == 'nems_frac_aoflux_sbs') then call fldbun_getdata1d(is_local%wrap%FBImp(compatm,compatm), 'Sa_ofrac', Sa_ofrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_getdata1d(is_local%wrap%FBFrac(compatm), 'aofrac', aofrac, rc) @@ -793,7 +794,8 @@ subroutine med_fraction_set(gcomp, rc) ! Set 'aofrac' from FBImp(compatm) to FBfrac(compatm) if (trim(coupling_mode) == 'nems_orig' .or. & trim(coupling_mode) == 'nems_frac' .or. & - trim(coupling_mode) == 'nems_frac_aoflux') then + trim(coupling_mode) == 'nems_frac_aoflux' .or. & + trim(coupling_mode) == 'nems_frac_aoflux_sbs') then call fldbun_getdata1d(is_local%wrap%FBImp(compatm,compatm), 'Sa_ofrac', Sa_ofrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_getdata1d(is_local%wrap%FBFrac(compatm), 'aofrac', aofrac, rc) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 4991c28fe..c6408eb78 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -46,7 +46,7 @@ module med_internalstate_mod character(len=CS), public :: glc_name = '' ! Coupling mode - character(len=CS), public :: coupling_mode ! valid values are [cesm,nems_orig,nems_frac,nems_orig_data,hafs] + character(len=CS), public :: coupling_mode ! valid values are [cesm,nems_orig,nems_frac,nems_orig_data,hafs,nems_frac_aoflux,nems_frac_aoflux_sbs] ! Atmosphere-ocean flux algorithm character(len=CS), public :: aoflux_code ! valid values are [cesm,ccpp] diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 0c16ba4b3..603e7f2f4 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1081,7 +1081,8 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) end do end if if (compute_atm_dens) then - if (trim(aoflux_code) == 'ccpp' .and. trim(coupling_mode) == 'nems_frac_aoflux') then + if (trim(aoflux_code) == 'ccpp' .and. & + (trim(coupling_mode) == 'nems_frac_aoflux' .or. trim(coupling_mode) == 'nems_frac_aoflux_sbs')) then ! Add limiting factor to humidity to be consistent with UFS aoflux calculation do n = 1,aoflux_in%lsize if (aoflux_in%mask(n) /= 0._r8) then @@ -1121,7 +1122,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) missval=0.0_r8) #else - if (trim(coupling_mode) == 'nems_frac_aoflux') then + if (trim(coupling_mode) == 'nems_frac_aoflux' .or. trim(coupling_mode) == 'nems_frac_aoflux_sbs') then #ifdef UFS_AOFLUX if (trim(aoflux_code) == 'ccpp') then call flux_atmocn_ccpp( & @@ -1281,7 +1282,7 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r end if ! extra fields for nems_frac_aoflux - if (trim(coupling_mode) == 'nems_frac_aoflux') then + if (trim(coupling_mode) == 'nems_frac_aoflux' .or. trim(coupling_mode) == 'nems_frac_aoflux_sbs') then call fldbun_getfldptr(fldbun_a, 'Sa_u10m', aoflux_in%usfc, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun_a, 'Sa_v10m', aoflux_in%vsfc, xgrid=xgrid, rc=rc) @@ -1310,7 +1311,7 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (compute_atm_dens .or. compute_atm_thbot) then call fldbun_getfldptr(fldbun_a, 'Sa_pbot', aoflux_in%pbot, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (trim(coupling_mode) == 'nems_frac_aoflux') then + if (trim(coupling_mode) == 'nems_frac_aoflux' .or. trim(coupling_mode) == 'nems_frac_aoflux_sbs') then call fldbun_getfldptr(fldbun_a, 'Sa_pslv', aoflux_in%psfc, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 10351a8ee..e9666cd78 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -142,7 +142,8 @@ subroutine med_phases_prep_atm(gcomp, rc) FBMed2=is_local%wrap%FBMed_aoflux_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'nems_frac' .or. & - trim(coupling_mode) == 'nems_orig') then + trim(coupling_mode) == 'nems_orig' .or. & + trim(coupling_mode) == 'nems_frac_aoflux_sbs') then call med_merge_auto(& is_local%wrap%med_coupling_active(:,compatm), & is_local%wrap%FBExp(compatm), & diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index aa6b3b189..0ae1b80e9 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -117,7 +117,8 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'nems_frac' .or. & - trim(coupling_mode) == 'nems_orig') then + trim(coupling_mode) == 'nems_orig' .or. & + trim(coupling_mode) == 'nems_frac_aoflux_sbs') then call med_merge_auto(& is_local%wrap%med_coupling_active(:,compocn), & is_local%wrap%FBExp(compocn), & @@ -571,7 +572,8 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) allocate(customwgt(lsize)) if (trim(coupling_mode) == 'nems_orig' .or. & - trim(coupling_mode) == 'nems_frac') then + trim(coupling_mode) == 'nems_frac' .or. & + trim(coupling_mode) == 'nems_frac_aoflux_sbs') then customwgt(:) = -ofrac(:) / const_lhvap call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_evap', & FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_lat' , wgtA=customwgt, rc=rc) From e204b949566030976ab10baa8f5662c0f4863a50 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Wed, 16 Feb 2022 09:56:57 -0700 Subject: [PATCH 026/395] fix for the cases if flds_scalar_index_nextsw_cday is not available --- mediator/med_phases_prep_lnd_mod.F90 | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 81114c1bf..ed1181f99 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -4,7 +4,8 @@ module med_phases_prep_lnd_mod ! Mediator phases for preparing land export from mediator !----------------------------------------------------------------------------- - use med_kind_mod, only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, 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_methods_mod, only : fldchk => med_methods_FB_FldChk implicit none private @@ -21,7 +22,7 @@ module med_phases_prep_lnd_mod subroutine med_phases_prep_lnd(gcomp, rc) use NUOPC , only : NUOPC_CompAttributeGet - use ESMF , only : operator(/=) + use ESMF , only : operator(/=), operator(==) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_GridComp, ESMF_GridCompGet @@ -49,6 +50,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) real(r8) :: tmp(1) real(r8), pointer :: dataptr2d(:,:) logical :: first_call = .true. + logical :: field_found real(r8), pointer :: dataptr_scalar_lnd(:,:) real(r8), pointer :: dataptr_scalar_atm(:,:) character(len=*), parameter :: subname='(med_phases_prep_lnd)' @@ -91,9 +93,15 @@ subroutine med_phases_prep_lnd(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//trim(subname)//' merge') + ! check cpl_scalars is in the state or not? fix for land components that do not have cpl_scalars + call ESMF_StateGet(is_local%wrap%NStateExp(complnd), trim(is_local%wrap%flds_scalar_name), itemType, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + field_found = .true. + if (itemType == ESMF_STATEITEM_NOTFOUND) field_found = .false. + ! obtain nextsw_cday from atm if it is in the import state and send it to lnd scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday - if (scalar_id > 0 .and. mastertask) then + if (scalar_id > 0 .and. field_found .and. mastertask) then call ESMF_StateGet(is_local%wrap%NstateImp(compatm), & itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From e813a97ed7078eea559e194d3a3ee0f62ee9fbc1 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Tue, 22 Feb 2022 14:39:02 -0700 Subject: [PATCH 027/395] fix CCPP host model for latent and sensible heat fluxes --- ufs/ccpp/config/ccpp_prebuild_config.py | 4 +- ufs/ccpp/data/MED_data.F90 | 2 + ufs/ccpp/data/MED_data.meta | 6 + ufs/ccpp/data/MED_typedefs.F90 | 302 +++++++++++-- ufs/ccpp/data/MED_typedefs.meta | 535 +++++++++++++++++++++++- ufs/ccpp/suites/suite_FV3_sfc_ocean.xml | 6 +- ufs/flux_atmocn_ccpp_mod.F90 | 21 +- 7 files changed, 838 insertions(+), 38 deletions(-) diff --git a/ufs/ccpp/config/ccpp_prebuild_config.py b/ufs/ccpp/config/ccpp_prebuild_config.py index 9d7fc7f5e..7ee42bf48 100755 --- a/ufs/ccpp/config/ccpp_prebuild_config.py +++ b/ufs/ccpp/config/ccpp_prebuild_config.py @@ -46,6 +46,7 @@ 'MED_coupling_type' : 'physics%Coupling', 'MED_grid_type' : 'physics%Grid', 'MED_sfcprop_type' : 'physics%Sfcprop', + 'MED_diag_type' : 'physics%Diag', 'MED_typedefs' : '', }, 'MED_data' : { @@ -59,9 +60,8 @@ '{}/ccpp/physics/physics/sfc_ocean.F'.format(fv3_path), '{}/ccpp/physics/physics/sfc_diff.f'.format(fv3_path), '{}/ccpp/physics/physics/GFS_surface_loop_control.F90'.format(fv3_path), + '{}/ccpp/physics/physics/GFS_surface_composites.F90'.format(fv3_path) ] - #'{}/ccpp/physics/physics/GFS_suite_interstitial.F90'.format(fv3_path) - #'{}/ccpp/physics/physics/GFS_surface_composites.F90'.format(fv3_path) # Default build dir, relative to current working directory, # if not specified as command-line argument diff --git a/ufs/ccpp/data/MED_data.F90 b/ufs/ccpp/data/MED_data.F90 index b86475d44..bd81da972 100644 --- a/ufs/ccpp/data/MED_data.F90 +++ b/ufs/ccpp/data/MED_data.F90 @@ -14,6 +14,7 @@ module MED_data use MED_typedefs, only: MED_coupling_type use MED_typedefs, only: MED_grid_type use MED_typedefs, only: MED_sfcprop_type + use MED_typedefs, only: MED_diag_type use ccpp_api, only: ccpp_t implicit none @@ -31,6 +32,7 @@ module MED_data type(MED_coupling_type) :: coupling type(MED_grid_type) :: grid type(MED_sfcprop_type) :: sfcprop + type(MED_diag_type) :: diag end type physics_type type(physics_type), save, target :: physics diff --git a/ufs/ccpp/data/MED_data.meta b/ufs/ccpp/data/MED_data.meta index 151abce4c..053118660 100644 --- a/ufs/ccpp/data/MED_data.meta +++ b/ufs/ccpp/data/MED_data.meta @@ -48,6 +48,12 @@ units = DDT dimensions = () type = MED_sfcprop_type +[Diag] + standard_name = MED_diag_type_instance + long_name = fields targeted for diagnostic output + units = DDT + dimensions = () + type = MED_diag_type ######################################################################## [ccpp-table-properties] diff --git a/ufs/ccpp/data/MED_typedefs.F90 b/ufs/ccpp/data/MED_typedefs.F90 index 0bf903ced..725a0bea5 100644 --- a/ufs/ccpp/data/MED_typedefs.F90 +++ b/ufs/ccpp/data/MED_typedefs.F90 @@ -6,6 +6,7 @@ module MED_typedefs use machine, only: kind_phys use physcons, only: con_hvap, con_cp, con_rd, con_eps use physcons, only: con_epsm1, con_fvirt, con_g + use physcons, only: con_tice implicit none @@ -36,8 +37,9 @@ module MED_typedefs real(kind=kind_phys), pointer :: zlvl(:) => null() !< layer 1 height above ground (m) real(kind=kind_phys), pointer :: prsik(:) => null() !< dimensionless Exner function at lowest model interface real(kind=kind_phys), pointer :: prslk(:) => null() !< dimensionless Exner function at lowest model layer - real(kind=kind_phys), pointer :: u10m(:) => null() !< 10 meter u wind speed - real(kind=kind_phys), pointer :: v10m(:) => null() !< 10 meter v wind speed + real(kind=kind_phys), pointer :: u10m(:) => null() !< 10 meter u wind speed (m/s) + real(kind=kind_phys), pointer :: v10m(:) => null() !< 10 meter v wind speed (m/s) + real(kind=kind_phys), pointer :: stc(:,:) => null() !< soil temperature (K) contains procedure :: create => statein_create !< allocate array data end type MED_statein_type @@ -71,6 +73,8 @@ module MED_typedefs real(kind=kind_phys), pointer :: ffhh_water(:) => null() !< Monin-Obukhov similarity function for heat over water real(kind=kind_phys), pointer :: fh2_water(:) => null() !< Monin-Obukhov similarity parameter for heat at 2m over water real(kind=kind_phys), pointer :: ztmax_water(:) => null() !< bounded surface roughness length for heat over water (m) + logical, pointer :: lake(:) => null() !< flag indicating presence of some lake surface area fraction + real(kind=kind_phys), pointer :: tprcp_water(:) => null() !< total precipitation amount in each time step over water ! land, not used to calculate aofluxes real(kind=kind_phys), pointer :: zvfun(:) => null() !< function of surface roughness length and green vegetation fraction @@ -88,6 +92,16 @@ module MED_typedefs real(kind=kind_phys), pointer :: fm10_land(:) => null() !< Monin-Obukhov similarity parameter for momentum at 10m over land real(kind=kind_phys), pointer :: fh2_land(:) => null() !< Monin-Obukhov similarity parameter for heat at 2m over land real(kind=kind_phys), pointer :: ztmax_land(:) => null() !< bounded surface roughness length for heat over land (m) + real(kind=kind_phys), pointer :: frland(:) => null() !< land area fraction used in microphysics schemes + real(kind=kind_phys), pointer :: tprcp_land(:) => null() !< total precipitation amount in each time step over land + real(kind=kind_phys), pointer :: qss_land(:) => null() !< surface air saturation specific humidity over land (kg/kg) + real(kind=kind_phys), pointer :: evap_land(:) => null() !< kinematic surface upward latent heat flux over land (m/s) + real(kind=kind_phys), pointer :: hflx_land(:) => null() !< kinematic surface upward sensible heat flux over land (Km/s) + real(kind=kind_phys), pointer :: hflxq(:) => null() !< kinematic surface upward sensible heat flux reduced by surface roughness and vegetation + real(kind=kind_phys), pointer :: chh_land(:) => null() !< thermal exchange coefficient over land (kg/m2s) + real(kind=kind_phys), pointer :: cmm_land(:) => null() !< momentum exchange coefficient over land (m/s) + real(kind=kind_phys), pointer :: gflx_land(:) => null() !< soil heat flux over land (W/m2) + real(kind=kind_phys), pointer :: ep1d_land(:) => null() !< surface upward potential latent heat flux over land (W/m2) ! ice, not used to calculate aofluxes logical, pointer :: icy(:) => null() !< flag indicating presence of some sea ice surface area fraction @@ -103,11 +117,31 @@ module MED_typedefs real(kind=kind_phys), pointer :: fm10_ice(:) => null() !< Monin-Obukhov similarity parameter for momentum at 10m over ice real(kind=kind_phys), pointer :: fh2_ice(:) => null() !< Monin-Obukhov similarity parameter for heat at 2m over ice real(kind=kind_phys), pointer :: ztmax_ice(:) => null() !< bounded surface roughness length for heat over ice (m) + logical, pointer :: flag_cice(:) => null() !< flag for cice + real(kind=kind_phys), pointer :: tprcp_ice(:) => null() !< total precipitation amount in each time step over ice + integer, pointer :: islmsk(:) => null() !< sea/land/ice mask (=0/1/2) + integer, pointer :: islmsk_cice(:) => null() !< sea/land/ice mask cice (=0/1/2) + real(kind=kind_phys), pointer :: ep1d_ice(:) => null() !< surface upward potential latent heat flux over ice (W/m2) + real(kind=kind_phys), pointer :: gflx_ice(:) => null() !< soil heat flux over ice + real(kind=kind_phys), pointer :: qss_ice(:) => null() !< surface air saturation specific humidity over ice (kg/kg) + real(kind=kind_phys), pointer :: evap_ice(:) => null() !< kinematic surface upward latent heat flux over ice (m/s) + real(kind=kind_phys), pointer :: hflx_ice(:) => null() !< kinematic surface upward sensible heat flux over ice (Km/s) + real(kind=kind_phys), pointer :: chh_ice(:) => null() !< thermal exchange coefficient over ice (kg/m2s) + real(kind=kind_phys), pointer :: cmm_ice(:) => null() !< momentum exchange coefficient over ice (m/s) ! others real(kind=kind_phys), pointer :: z01d(:) => null() !< perturbation of momentum roughness length real(kind=kind_phys), pointer :: zt1d(:) => null() !< perturbation of heat to momentum roughness length ratio logical, pointer :: flag_guess(:) => null() !< flag for guess run + real(kind=kind_phys), pointer :: rb(:) => null() !< bulk Richardson number at the surface + real(kind=kind_phys), pointer :: fh2(:) => null() !< Monin-Obukhov similarity parameter for heat at 2m + real(kind=kind_phys), pointer :: fm10(:) => null() !< Monin-Obukhov similarity parameter for momentum at 10m + real(kind=kind_phys), pointer :: cdq(:) => null() !< surface exchange coeff heat & moisture + real(kind=kind_phys), pointer :: cd(:) => null() !< surface exchange coeff for momentum + real(kind=kind_phys), pointer :: hffac(:) => null() !< surface upward sensible heat flux reduction factor from canopy heat storage + real(kind=kind_phys), pointer :: stress(:) => null() !< surface wind stress + real(kind=kind_phys), pointer :: gflx(:) => null() !< soil heat flux + real(kind=kind_phys), pointer :: ep1d(:) => null() !< surface upward potential latent heat flux contains procedure :: create => interstitial_create !< allocate array data procedure :: phys_reset => interstitial_phys_reset !< reset array data for physics @@ -117,22 +151,31 @@ module MED_typedefs !! \htmlinclude MED_control_type.html !! type MED_control_type - !--- tuning parameters for physical parameterizations - logical :: lseaspray !< flag for sea spray parameterization - !--- coupling parameters - logical :: use_med_flux !< flag for using atmosphere-ocean fluxes form mediator - !--- land/surface model parameters, not used to calculate aofluxes - integer :: ivegsrc !< land use dataset choice 0 => USGS, 1 => IGBP, 2 => UMD - integer :: lsm !< flag for land surface model - integer :: lsm_noahmp !< flag for NOAH MP land surface model - !--- tuning parameters for physical parameterizations - logical :: redrag !< flag for reduced drag coeff. over sea - !--- surface layer z0 scheme - integer :: sfc_z0_type !< surface roughness options over water - !--- potential temperature definition in surface layer physics - logical :: thsfc_loc !< flag for reference pressure in theta calculation - !--- near surface temperature model - integer :: nstf_name(5) !< NSSTM flag: off/uncoupled/coupled=0/1/2 + logical :: lseaspray !< flag for sea spray parameterization + logical :: use_med_flux !< flag for using atmosphere-ocean fluxes form mediator + integer :: ivegsrc !< land use dataset choice 0 => USGS, 1 => IGBP, 2 => UMD + integer :: lsm !< flag for land surface model + integer :: lsm_noahmp !< flag for NOAH MP land surface model + logical :: redrag !< flag for reduced drag coeff. over sea + integer :: sfc_z0_type !< surface roughness options over water + logical :: thsfc_loc !< flag for reference pressure in theta calculation + integer :: nstf_name(5) !< NSSTM flag: off/uncoupled/coupled=0/1/2 + integer :: lkm !< flag for flake model + logical :: first_time_step !< flag signaling first time step for time integration routine + logical :: frac_grid !< flag for fractional grid + logical :: cplwav2atm !< default no wav->atm coupling + logical :: restart !< flag whether this is a coldstart (.false.) or a warmstart/restart (.true.) + logical :: cplice !< default no cplice collection (used together with cplflx) + logical :: cplflx !< flag controlling cplflx collection (default off) + integer :: kdt !< current forecast iteration + real(kind=kind_phys) :: min_lakeice !< minimum lake ice value + real(kind=kind_phys) :: min_seaice !< minimum sea ice value + real(kind=kind_phys) :: huge !< definition of NetCDF float FillValue + logical :: lheatstrg !< flag for canopy heat storage parameterization + real(kind=kind_phys) :: h0facu !< canopy heat storage factor for sensible heat flux in unstable surface layer + real(kind=kind_phys) :: h0facs !< canopy heat storage factor for sensible heat flux in stable surface layer + integer :: lsoil !< number of soil layers + integer :: kice !< vertical loop extent for ice levels, start at 1 contains procedure :: init => control_initialize end type MED_control_type @@ -160,40 +203,66 @@ module MED_typedefs !! \htmlinclude MED_sfcprop_type.html !! type MED_sfcprop_type - ! water real(kind=kind_phys), pointer :: zorlw(:) => null() !< surface roughness length over water (cm) - - ! land, not used to calculate aofluxes integer, pointer :: vtype(:) => null() !< vegetation type real(kind=kind_phys), pointer :: shdmax(:) => null() !< max fractional coverage of green vegetation real(kind=kind_phys), pointer :: zorll(:) => null() !< surface roughness length over land (cm) - - ! ice, not used to calculate aofluxes real(kind=kind_phys), pointer :: zorli(:) => null() !< surface roughness length over ice (cm) - - ! wave real(kind=kind_phys), pointer :: zorlwav(:) => null() !< surface roughness length from wave model (cm) - - ! other real(kind=kind_phys), pointer :: zorl(:) => null() !< surface roughness length (cm) - + real(kind=kind_phys), pointer :: slmsk(:) => null() !< sea/land mask array (sea:0,land:1,sea-ice:2) + real(kind=kind_phys), pointer :: lakefrac(:) => null() !< lake fraction [0:1] + real(kind=kind_phys), pointer :: lakedepth(:) => null() !< lake depth (m) + real(kind=kind_phys), pointer :: landfrac(:) => null() !< fraction of horizontal grid area occupied by land + real(kind=kind_phys), pointer :: snowd(:) => null() !< snow depth water equivalent in mm ; same as snwdph + real(kind=kind_phys), pointer :: weasd(:) => null() !< water equiv of acc snow depth over land and sea ice + real(kind=kind_phys), pointer :: tprcp(:) => null() !< total precipitation amount in each time step + real(kind=kind_phys), pointer :: oceanfrac(:) => null() !< ocean fraction [0:1] + real(kind=kind_phys), pointer :: fice(:) => null() !< ice fraction over open water + real(kind=kind_phys), pointer :: hice(:) => null() !< sea ice thickness (m) + real(kind=kind_phys), pointer :: tsfco(:) => null() !< sea surface temperature + real(kind=kind_phys), pointer :: uustar(:) => null() !< boundary layer parameter + real(kind=kind_phys), pointer :: tsfc(:) => null() !< surface skin temperature + real(kind=kind_phys), pointer :: snodi(:) => null() !< water equivalent snow depth over ice (mm) + real(kind=kind_phys), pointer :: snodl(:) => null() !< water equivalent snow depth over land (mm) + real(kind=kind_phys), pointer :: qss(:) => null() !< surface air saturation specific humidity (kg/kg) + real(kind=kind_phys), pointer :: weasdi(:) => null() !< water equiv of acc snow depth over ice (mm) + real(kind=kind_phys), pointer :: weasdl(:) => null() !< water equiv of acc snow depth over land (mm) + real(kind=kind_phys), pointer :: ffhh(:) => null() !< Monin-Obukhov similarity function for heat + real(kind=kind_phys), pointer :: ffmm(:) => null() !< Monin-Obukhov similarity function for momentum + real(kind=kind_phys), pointer :: evap(:) => null() !< kinematic surface upward latent heat flux (kg kg-1 m s-1) + real(kind=kind_phys), pointer :: hflx(:) => null() !< kinematic surface upward sensible heat flux (K m/s) + real(kind=kind_phys), pointer :: tiice(:,:) => null() !< sea ice internal temperature contains procedure :: create => sfcprop_create !< allocate array data end type MED_sfcprop_type +!! \section arg_table_MED_diag_type +!! \htmlinclude MED_diag_type.html +!! + type MED_diag_type + real(kind=kind_phys), pointer :: chh(:) => null() !< thermal exchange coefficient (kg m-2 s-1) + real(kind=kind_phys), pointer :: cmm(:) => null() !< momentum exchange coefficient (m/s) + contains + procedure :: create => diag_create !< allocate array data + end type MED_diag_type + public MED_init_type public MED_statein_type public MED_coupling_type public MED_control_type public MED_interstitial_type public MED_grid_type + public MED_sfcprop_type + public MED_diag_type contains - subroutine statein_create(statein, im) + subroutine statein_create(statein, im, model) implicit none class(MED_statein_type) :: statein integer, intent(in) :: im + type(MED_control_type), intent(in) :: model allocate(statein%pgr(im)) statein%pgr = clear_val @@ -217,6 +286,8 @@ subroutine statein_create(statein, im) statein%u10m = clear_val allocate(statein%v10m(im)) statein%v10m = clear_val + allocate(statein%stc(im,model%lsoil)) + statein%stc = clear_val end subroutine statein_create @@ -248,8 +319,16 @@ subroutine interstitial_create(interstitial, im) interstitial%flag_iter = .true. allocate(interstitial%qss_water(im)) interstitial%qss_water = huge + allocate(interstitial%cmm_ice(im)) + interstitial%cmm_ice = huge + allocate(interstitial%cmm_land(im)) + interstitial%cmm_land = huge allocate(interstitial%cmm_water(im)) interstitial%cmm_water = huge + allocate(interstitial%chh_ice(im)) + interstitial%chh_ice = huge + allocate(interstitial%chh_land(im)) + interstitial%chh_land = huge allocate(interstitial%chh_water(im)) interstitial%chh_water = huge allocate(interstitial%gflx_water(im)) @@ -258,6 +337,10 @@ subroutine interstitial_create(interstitial, im) interstitial%evap_water = huge allocate(interstitial%hflx_water(im)) interstitial%hflx_water = huge + allocate(interstitial%hflx_land(im)) + interstitial%hflx_land = huge + allocate(interstitial%hflx_ice(im)) + interstitial%hflx_ice = huge allocate(interstitial%ep1d_water(im)) interstitial%ep1d_water = huge allocate(interstitial%tsurf_water(im)) @@ -274,6 +357,10 @@ subroutine interstitial_create(interstitial, im) interstitial%fh2_water = huge allocate(interstitial%ztmax_water(im)) interstitial%ztmax_water = clear_val + allocate(interstitial%lake(im)) + interstitial%lake = .false. + allocate(interstitial%tprcp_water(im)) + interstitial%tprcp_water = huge ! land allocate(interstitial%zvfun(im)) @@ -306,6 +393,20 @@ subroutine interstitial_create(interstitial, im) interstitial%fh2_land = huge allocate(interstitial%ztmax_land(im)) interstitial%ztmax_land = clear_val + allocate(interstitial%frland(im)) + interstitial%frland = clear_val + allocate(interstitial%tprcp_land(im)) + interstitial%tprcp_land = huge + allocate(interstitial%qss_land(im)) + interstitial%qss_land = huge + allocate(interstitial%evap_land(im)) + interstitial%evap_land = huge + allocate(interstitial%hflxq(im)) + interstitial%hflxq = clear_val + allocate(interstitial%ep1d_land(im)) + interstitial%ep1d_land = huge + allocate(interstitial%gflx_land(im)) + interstitial%gflx_land = clear_val ! ice allocate(interstitial%icy(im)) @@ -334,6 +435,22 @@ subroutine interstitial_create(interstitial, im) interstitial%fh2_ice = huge allocate(interstitial%ztmax_ice(im)) interstitial%ztmax_ice = clear_val + allocate(interstitial%flag_cice(im)) + interstitial%flag_cice = .false. + allocate(interstitial%tprcp_ice(im)) + interstitial%tprcp_ice = huge + allocate(interstitial%islmsk(im)) + interstitial%islmsk = 0 + allocate(interstitial%islmsk_cice(im)) + interstitial%islmsk_cice = 0 + allocate(interstitial%qss_ice(im)) + interstitial%qss_ice = huge + allocate(interstitial%ep1d_ice(im)) + interstitial%ep1d_ice = huge + allocate(interstitial%gflx_ice(im)) + interstitial%gflx_ice = clear_val + allocate(interstitial%evap_ice(im)) + interstitial%evap_ice = huge ! others allocate(interstitial%z01d(im)) @@ -342,6 +459,24 @@ subroutine interstitial_create(interstitial, im) interstitial%zt1d = clear_val allocate(interstitial%flag_guess(im)) interstitial%flag_guess = .false. + allocate(interstitial%rb(im)) + interstitial%rb = clear_val + allocate(interstitial%fh2(im)) + interstitial%fh2 = clear_val + allocate(interstitial%fm10(im)) + interstitial%fm10 = clear_val + allocate(interstitial%cdq(im)) + interstitial%cdq_water = clear_val + allocate(interstitial%cd(im)) + interstitial%cd = clear_val + allocate(interstitial%ep1d(im)) + interstitial%ep1d = clear_val + allocate(interstitial%hffac(im)) + interstitial%hffac = clear_val + allocate(interstitial%stress(im)) + interstitial%stress = clear_val + allocate(interstitial%gflx(im)) + interstitial%gflx = clear_val end subroutine interstitial_create @@ -349,44 +484,76 @@ subroutine interstitial_phys_reset(interstitial) implicit none class(MED_interstitial_type) :: interstitial + interstitial%cd = clear_val interstitial%cd_ice = huge interstitial%cd_land = huge interstitial%cd_water = huge + interstitial%cdq = clear_val interstitial%cdq_ice = huge interstitial%cdq_land = huge interstitial%cdq_water = huge + interstitial%chh_ice = huge + interstitial%chh_land = huge interstitial%chh_water = huge + interstitial%cmm_ice = huge + interstitial%cmm_land = huge interstitial%cmm_water = huge interstitial%dry = .false. + interstitial%ep1d = clear_val + interstitial%ep1d_ice = huge + interstitial%ep1d_land = huge interstitial%ep1d_water = huge interstitial%evap_water = huge + interstitial%evap_land = huge + interstitial%evap_ice = huge interstitial%ffhh_ice = huge interstitial%ffhh_land = huge interstitial%ffhh_water = huge interstitial%ffmm_ice = huge interstitial%ffmm_land = huge interstitial%ffmm_water = huge + Interstitial%fh2 = clear_val interstitial%fh2_ice = huge interstitial%fh2_land = huge interstitial%fh2_water = huge + Interstitial%fm10 = clear_val + interstitial%flag_cice = .false. interstitial%flag_guess = .false. interstitial%flag_iter = .true. interstitial%fm10_ice = huge interstitial%fm10_land = huge interstitial%fm10_water = huge + interstitial%frland = clear_val + interstitial%gflx = clear_val + interstitial%gflx_ice = clear_val + interstitial%gflx_land = clear_val interstitial%gflx_water = clear_val + interstitial%hffac = clear_val + interstitial%hflx_ice = huge + interstitial%hflx_land = huge interstitial%hflx_water = huge + interstitial%hflxq = clear_val interstitial%icy = .false. + interstitial%islmsk = 0 + interstitial%islmsk_cice = 0 + interstitial%lake = .false. interstitial%prslki = clear_val + interstitial%rb = clear_val + interstitial%qss_ice = huge + interstitial%qss_land = huge interstitial%qss_water = huge interstitial%rb_ice = huge interstitial%rb_land = huge interstitial%rb_water = huge interstitial%sigmaf = clear_val + interstitial%stress = clear_val interstitial%stress_ice = huge interstitial%stress_land = huge interstitial%stress_water = huge interstitial%tisfc = clear_val + interstitial%tprcp_water = huge + interstitial%tprcp_land = huge + interstitial%tprcp_ice = huge interstitial%tsfc_water = huge interstitial%tsfcl = clear_val interstitial%tsurf_ice = huge @@ -420,6 +587,22 @@ subroutine control_initialize(model) model%lsm = 1 model%lsm_noahmp = 2 model%nstf_name = (/0,0,1,0,5/) + model%lkm = 0 + model%first_time_step = .true. + model%frac_grid = .false. + model%cplwav2atm = .false. + model%restart = .false. + model%cplice = .false. + model%cplflx = .false. + model%kdt = 0 ! nint(Model%fhour*con_hr/Model%dtp) + model%min_lakeice = 0.15d0 + model%min_seaice = 1.0d-11 + model%huge = 9.9692099683868690e36 + model%lheatstrg = .false. + model%h0facu = 0.25 + model%h0facs = 1.0 + model%lsoil = 4 + model%kice = 2 end subroutine control_initialize @@ -445,10 +628,11 @@ subroutine grid_create(grid, im) end subroutine grid_create - subroutine sfcprop_create(sfcprop, im) + subroutine sfcprop_create(sfcprop, im, model) implicit none class(MED_sfcprop_type) :: sfcprop integer, intent(in) :: im + type(MED_control_type), intent(in) :: model allocate(sfcprop%vtype(im)) sfcprop%vtype = zero @@ -464,7 +648,65 @@ subroutine sfcprop_create(sfcprop, im) sfcprop%zorli = clear_val allocate(sfcprop%zorlwav(im)) sfcprop%zorlwav = clear_val + allocate(sfcprop%slmsk(im)) + sfcprop%slmsk = clear_val + allocate(sfcprop%lakefrac(im)) + sfcprop%lakefrac = clear_val + allocate(sfcprop%lakedepth(im)) + sfcprop%lakedepth = clear_val + allocate(sfcprop%landfrac(im)) + sfcprop%landfrac = clear_val + allocate(sfcprop%snowd(im)) + sfcprop%snowd = clear_val + allocate(sfcprop%weasd(im)) + sfcprop%weasd = clear_val + allocate(sfcprop%tprcp(im)) + sfcprop%tprcp = clear_val + allocate(sfcprop%oceanfrac(im)) + sfcprop%oceanfrac = clear_val + allocate(sfcprop%fice(im)) + sfcprop%fice = clear_val + allocate(sfcprop%hice(im)) + sfcprop%hice = clear_val + allocate(sfcprop%tsfco(im)) + sfcprop%tsfco = clear_val + allocate(sfcprop%uustar(im)) + sfcprop%uustar = clear_val + allocate(sfcprop%tsfc(im)) + sfcprop%tsfc = clear_val + allocate(sfcprop%snodi(im)) + sfcprop%snodi = clear_val + allocate(sfcprop%snodl(im)) + sfcprop%snodl = clear_val + allocate(sfcprop%qss(im)) + sfcprop%qss = clear_val + allocate(sfcprop%weasdi(im)) + sfcprop%weasdi = clear_val + allocate(sfcprop%weasdl(im)) + sfcprop%weasdl = clear_val + allocate(sfcprop%ffhh(im)) + sfcprop%ffhh = clear_val + allocate(sfcprop%ffmm(im)) + sfcprop%ffmm = clear_val + allocate(sfcprop%evap(im)) + sfcprop%evap = clear_val + allocate(sfcprop%hflx(im)) + sfcprop%hflx = clear_val + allocate(sfcprop%tiice(im,model%kice)) + sfcprop%tiice = clear_val end subroutine sfcprop_create + subroutine diag_create(diag, im) + implicit none + class(MED_diag_type) :: diag + integer, intent(in) :: im + + allocate(diag%chh(im)) + diag%chh = clear_val + allocate(diag%cmm(im)) + diag%cmm = clear_val + + end subroutine diag_create + end module MED_typedefs diff --git a/ufs/ccpp/data/MED_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta index f93ccd476..7d4f8cbcb 100644 --- a/ufs/ccpp/data/MED_typedefs.meta +++ b/ufs/ccpp/data/MED_typedefs.meta @@ -99,6 +99,13 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_loop_extent,vertical_dimension_of_soil) + type = real + kind = kind_phys ######################################################################## [ccpp-table-properties] @@ -211,6 +218,20 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[evap_land] + standard_name = kinematic_surface_upward_latent_heat_flux_over_land + long_name = kinematic surface upward latent heat flux over land + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[evap_ice] + standard_name = kinematic_surface_upward_latent_heat_flux_over_ice + long_name = kinematic surface upward latent heat flux over ice + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [hflx_water] standard_name = kinematic_surface_upward_sensible_heat_flux_over_water long_name = kinematic surface upward sensible heat flux over water @@ -218,6 +239,20 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[hflx_land] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_land + long_name = kinematic surface upward sensible heat flux over land + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[hflx_ice] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_ice + long_name = kinematic surface upward sensible heat flux over ice + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [ep1d_water] standard_name = surface_upward_potential_latent_heat_flux_over_water long_name = surface upward potential latent heat flux over water @@ -321,6 +356,13 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[cd] + standard_name = surface_drag_coefficient_for_momentum_in_air + long_name = surface exchange coeff for momentum + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [cd_land] standard_name = surface_drag_coefficient_for_momentum_in_air_over_land long_name = surface exchange coeff for momentum over land @@ -335,6 +377,13 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[cdq] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air + long_name = surface exchange coeff heat & moisture + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [cdq_land] standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land long_name = surface exchange coeff heat & moisture over land @@ -488,6 +537,184 @@ units = flag dimensions = (horizontal_loop_extent) type = logical +[flag_cice] + standard_name = flag_for_cice + long_name = flag for cice + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[lake] + standard_name = flag_nonzero_lake_surface_fraction + long_name = flag indicating presence of some lake surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[frland] + standard_name = land_area_fraction_for_microphysics + long_name = land area fraction used in microphysics schemes + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tprcp_water] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_water + long_name = total precipitation amount in each time step over water + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tprcp_land] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land + long_name = total precipitation amount in each time step over land + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tprcp_ice] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ice + long_name = total precipitation amount in each time step over ice + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[islmsk] + standard_name = sea_land_ice_mask + long_name = sea/land/ice mask (=0/1/2) + units = flag + dimensions = (horizontal_loop_extent) + type = integer +[islmsk_cice] + standard_name = sea_land_ice_mask_cice + long_name = sea/land/ice mask cice (=0/1/2) + units = flag + dimensions = (horizontal_loop_extent) + type = integer +[qss_land] + standard_name = surface_specific_humidity_over_land + long_name = surface air saturation specific humidity over land + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[qss_ice] + standard_name = surface_specific_humidity_over_ice + long_name = surface air saturation specific humidity over ice + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ep1d_ice] + standard_name = surface_upward_potential_latent_heat_flux_over_ice + long_name = surface upward potential latent heat flux over ice + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gflx_ice] + standard_name = upward_heat_flux_in_soil_over_ice + long_name = soil heat flux over ice + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[rb] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[hflxq] + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness_and_vegetation + long_name = kinematic surface upward sensible heat flux reduced by surface roughness and vegetation + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fh2] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m + long_name = Monin-Obukhov similarity parameter for heat at 2m + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fm10] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m + long_name = Monin-Obukhov similarity parameter for momentum at 10m + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[chh_land] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land + long_name = thermal exchange coefficient over land + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[chh_ice] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice + long_name = thermal exchange coefficient over ice + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cmm_land] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land + long_name = momentum exchange coefficient over land + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cmm_ice] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ice + long_name = momentum exchange coefficient over ice + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ep1d] + standard_name = surface_upward_potential_latent_heat_flux + long_name = surface upward potential latent heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ep1d_land] + standard_name = surface_upward_potential_latent_heat_flux_over_land + long_name = surface upward potential latent heat flux over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[hffac] + standard_name = surface_upward_sensible_heat_flux_reduction_factor + long_name = surface upward sensible heat flux reduction factor from canopy heat storage + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[stress] + standard_name = surface_wind_stress + long_name = surface wind stress + units = m2 s-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gflx] + standard_name = upward_heat_flux_in_soil + long_name = soil heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gflx_land] + standard_name = upward_heat_flux_in_soil_over_land + long_name = soil heat flux over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys ######################################################################## [ccpp-table-properties] @@ -552,6 +779,107 @@ units = flag dimensions = () type = integer +[lkm] + standard_name = control_for_lake_surface_scheme + long_name = flag for lake surface model + units = flag + dimensions = () + type = integer +[first_time_step] + standard_name = flag_for_first_timestep + long_name = flag for first time step for time integration loop (cold/warmstart) + units = flag + dimensions = () + type = logical +[frac_grid] + standard_name = flag_for_fractional_landmask + long_name = flag for fractional grid + units = flag + dimensions = () + type = logical +[cplwav2atm] + standard_name = flag_for_one_way_ocean_wave_coupling_to_atmosphere + long_name = flag controlling ocean wave coupling to the atmosphere (default off) + units = flag + dimensions = () + type = logical +[restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical +[cplice] + standard_name = flag_for_sea_ice_coupling + long_name = flag controlling cplice collection (default on) + units = flag + dimensions = () + type = logical +[cplflx] + standard_name = flag_for_surface_flux_coupling + long_name = flag controlling cplflx collection (default off) + units = flag + dimensions = () + type = logical +[kdt] + standard_name = index_of_timestep + long_name = current forecast iteration + units = index + dimensions = () + type = integer +[min_lakeice] + standard_name = min_lake_ice_area_fraction + long_name = minimum lake ice value + units = frac + dimensions = () + type = real + kind = kind_phys +[min_seaice] + standard_name = min_sea_ice_area_fraction + long_name = minimum sea ice value + units = frac + dimensions = () + type = real + kind = kind_phys +[huge] + standard_name = netcdf_float_fillvalue + long_name = definition of NetCDF float FillValue + units = none + dimensions = () + type = real + kind = kind_phys +[lheatstrg] + standard_name = flag_for_canopy_heat_storage_in_land_surface_scheme + long_name = flag for canopy heat storage parameterization + units = flag + dimensions = () + type = logical +[h0facu] + standard_name = multiplicative_tuning_parameter_for_reduced_surface_heat_fluxes_due_to_canopy_heat_storage + long_name = canopy heat storage factor for sensible heat flux in unstable surface layer + units = none + dimensions = () + type = real + kind = kind_phys +[h0facs] + standard_name = multiplicative_tuning_parameter_for_reduced_latent_heat_flux_due_to_canopy_heat_storage + long_name = canopy heat storage factor for sensible heat flux in stable surface layer + units = none + dimensions = () + type = real + kind = kind_phys +[lsoil] + standard_name = vertical_dimension_of_soil + long_name = number of soil layers + units = count + dimensions = () + type = integer +[kice] + standard_name = vertical_dimension_of_sea_ice + long_name = vertical loop extent for ice levels, start at 1 + units = count + dimensions = () + type = integer ######################################################################## [ccpp-table-properties] @@ -643,13 +971,205 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[slmsk] + standard_name = area_type + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[lakefrac] + standard_name = lake_area_fraction + long_name = fraction of horizontal grid area occupied by lake + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[lakedepth] + standard_name = lake_depth + long_name = lake depth + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tprcp] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep + long_name = total precipitation amount in each time step + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[oceanfrac] + standard_name = sea_area_fraction + long_name = fraction of horizontal grid area occupied by ocean + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fice] + standard_name = sea_ice_area_fraction_of_sea_area_fraction + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[hice] + standard_name = sea_ice_thickness + long_name = sea ice thickness + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tsfco] + standard_name = sea_surface_temperature + long_name = sea surface temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[uustar] + standard_name = surface_friction_velocity + long_name = boundary layer parameter + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tsfc] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[snodi] + standard_name = surface_snow_thickness_water_equivalent_over_ice + long_name = water equivalent snow depth over ice + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[snodl] + standard_name = surface_snow_thickness_water_equivalent_over_land + long_name = water equivalent snow depth over land + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[qss] + standard_name = surface_specific_humidity + long_name = surface air saturation specific humidity + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[weasdi] + standard_name = water_equivalent_accumulated_snow_depth_over_ice + long_name = water equiv of acc snow depth over land + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[weasdl] + standard_name = water_equivalent_accumulated_snow_depth_over_land + long_name = water equiv of acc snow depth over land + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[snowd] + standard_name = lwe_surface_snow + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[weasd] + standard_name = lwe_thickness_of_surface_snow_amount + long_name = water equiv of acc snow depth over land and sea ice + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ffhh] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin-Obukhov similarity function for heat + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ffmm] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin-Obukhov similarity function for momentum + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length + units = cm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[evap] + standard_name = surface_upward_specific_humidity_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[hflx] + standard_name = surface_upward_temperature_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tiice] + standard_name = temperature_in_ice_layer + long_name = sea ice internal temperature + units = K + dimensions = (horizontal_loop_extent,vertical_dimension_of_sea_ice) + type = real + kind = kind_phys + +######################################################################## +[ccpp-table-properties] + name = MED_diag_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = MED_diag_type + type = ddt +[chh] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air + long_name = thermal exchange coefficient + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cmm] + standard_name = surface_drag_wind_speed_for_momentum_in_air + long_name = momentum exchange coefficient + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys ######################################################################## [ccpp-table-properties] name = MED_typedefs type = module relative_path = ../../../../../FV3/ccpp/physics/physics - dependencies = machine.F,physcons.F90 + dependencies = machine.F,physcons.F90,physparam.f [ccpp-arg-table] name = MED_typedefs @@ -696,6 +1216,12 @@ units = DDT dimensions = () type = MED_sfcprop_type +[MED_diag_type] + standard_name = MED_diag_type + long_name = definition of type MED_diag_type + units = DDT + dimensions = () + type = MED_diag_type [con_hvap] standard_name = latent_heat_of_vaporization_of_water_at_0C long_name = latent heat of evaporation/sublimation @@ -745,3 +1271,10 @@ dimensions = () type = real kind = kind_phys +[con_tice] + standard_name = freezing_point_temperature_of_seawater + long_name = freezing point temperature of seawater + units = K + dimensions = () + type = real + kind = kind_phys diff --git a/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml b/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml index 0336cb2b5..af99985a1 100644 --- a/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml +++ b/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml @@ -2,17 +2,17 @@ - sfc_diff GFS_surface_loop_control_part1 sfc_ocean GFS_surface_loop_control_part2 - + + GFS_surface_composites_post + diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index 941a0954b..aecc65519 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -76,11 +76,12 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & if (first_call) then ! allocate and initalize data structures - call physics%statein%create(nMax) + call physics%statein%create(nMax,physics%model) call physics%interstitial%create(nMax) call physics%coupling%create(nMax) call physics%grid%create(nMax) - call physics%sfcprop%create(nMax) + call physics%sfcprop%create(nMax,physics%model) + call physics%diag%create(nMax) ! initalize dimension physics%init%im = nMax @@ -117,6 +118,12 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & physics%model%ivegsrc = 1 physics%model%redrag = .true. physics%model%lsm = 2 + physics%model%frac_grid = .true. + physics%model%restart = .true. + physics%model%cplice = .true. + physics%model%cplflx = .true. + physics%model%kdt = physics%model%kdt+1 + physics%model%lheatstrg = .true. ! reset physics variables call physics%interstitial%phys_reset() @@ -129,6 +136,16 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & physics%interstitial%prslki = physics%statein%prsik(:)/physics%statein%prslk(:) physics%interstitial%tsurf_water = ts physics%interstitial%tsfc_water = ts + physics%interstitial%qss_water = qbot + + ! fill in required sfcprop variables + where (mask(:) /= 0) + physics%sfcprop%oceanfrac = 1.0d0 + elsewhere + physics%sfcprop%oceanfrac = 0.0d0 + end where + physics%sfcprop%tsfco = ts + physics%sfcprop%qss = qbot ! run CCPP physics ! TODO: suite name need to be provided by ESMF config file From 4f931827a4924f48ef3f5faabbbcf9e890420c20 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Wed, 23 Feb 2022 22:25:53 -0700 Subject: [PATCH 028/395] fix aoflux calculation on agrid and add missing error checks --- mediator/med_phases_aofluxes_mod.F90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 2b28164ac..794b84293 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1102,6 +1102,7 @@ subroutine med_aofluxes_map_agrid2xgrid_input(gcomp, rc) call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_agrid2xgrid_bilinr, & termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) end if + if (chkerr(rc,__LINE__,u_FILE_u)) return end do end subroutine med_aofluxes_map_agrid2xgrid_input @@ -1144,6 +1145,7 @@ subroutine med_aofluxes_map_ogrid2xgrid_input(gcomp, rc) call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_ogrid2xgrid, & termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) end if + if (chkerr(rc,__LINE__,u_FILE_u)) return end do end subroutine med_aofluxes_map_ogrid2xgrid_input @@ -1198,6 +1200,12 @@ subroutine med_aofluxes_map_agrid2ogrid_output(gcomp, rc) character(*),parameter :: subName = '(med_aofluxes_map_agrid2ogrid_output) ' !----------------------------------------------------------------------- + rc = ESMF_SUCCESS + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do nf = 1,size(fldnames_aof_out) ! Create source field call ESMF_FieldBundleGet(is_local%wrap%FBMed_aoflux_a, fldnames_aof_out(nf), field=field_src, rc=rc) @@ -1220,6 +1228,7 @@ subroutine med_aofluxes_map_agrid2ogrid_output(gcomp, rc) call ESMF_FieldRegrid(field_src, field_dst, & routehandle=is_local%wrap%RH(compatm, compocn, maptype), & termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end do end subroutine med_aofluxes_map_agrid2ogrid_output @@ -1262,6 +1271,7 @@ subroutine med_aofluxes_map_xgrid2agrid_output(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegrid(field_o, field_x, routehandle=rh_ogrid2xgrid, & termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(field_x, farrayptr=ofrac_x, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1283,6 +1293,7 @@ subroutine med_aofluxes_map_xgrid2agrid_output(gcomp, rc) end do call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_xgrid2agrid, & termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return data_src(:) = data_src_save(:) deallocate(data_src_save) call ESMF_FieldGet(field_dst, farrayptr=data_dst, rc=rc) @@ -1338,6 +1349,7 @@ subroutine med_aofluxes_map_xgrid2ogrid_output(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_xgrid2ogrid, & termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end do end subroutine med_aofluxes_map_xgrid2ogrid_output From bf9e4b31a677aa534f16d65415fcd32767094e40 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 24 Feb 2022 23:40:04 -0700 Subject: [PATCH 029/395] add support to get ccpp suite from config file --- mediator/med.F90 | 18 +++++++++++++++++- mediator/med_internalstate_mod.F90 | 3 +++ ufs/flux_atmocn_ccpp_mod.F90 | 5 +++-- 3 files changed, 23 insertions(+), 3 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index c6cea423b..a32544f3e 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -45,7 +45,7 @@ module MED use med_internalstate_mod , only : logunit, mastertask use med_internalstate_mod , only : ncomps, compname use med_internalstate_mod , only : compmed, compatm, compocn, compice, complnd, comprof, compwav, compglc - use med_internalstate_mod , only : coupling_mode, aoflux_code + use med_internalstate_mod , only : coupling_mode, aoflux_code, aoflux_ccpp_suite use esmFlds , only : fldListMed_ocnalb use esmFlds , only : med_fldList_GetNumFlds, med_fldList_GetFldNames, med_fldList_GetFldInfo use esmFlds , only : med_fldList_Document_Mapping, med_fldList_Document_Merging @@ -771,6 +771,22 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) write(logunit,*) '========================================================' end if + ! Determine CCPP suite if aoflux scheme set to 'ccpp' + if (trim(aoflux_code) == 'ccpp') then + call NUOPC_CompAttributeGet(gcomp, name='aoflux_ccpp_suite', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (.not. isPresent .and. .not. isSet) then + call ESMF_LogWrite("aoflux_ccpp_suite need to be provided when aoflux_code is set to 'ccpp'", ESMF_LOGMSG_INFO) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + aoflux_ccpp_suite = trim(cvalue) + if (mastertask) then + write(logunit,*) '========================================================' + write(logunit,'(a)')trim(subname)//' Mediator aoflux CCPP suite is '//trim(aoflux_ccpp_suite) + write(logunit,*) '========================================================' + end if + end if + !------------------ ! Initialize mediator flds !------------------ diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 74c16aad8..fe4980b60 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -51,6 +51,9 @@ module med_internalstate_mod ! Atmosphere-ocean flux algorithm character(len=CS), public :: aoflux_code ! valid values are [cesm,ccpp] + ! Atmosphere-ocean CCPP suite name + character(len=CL), public :: aoflux_ccpp_suite + ! Mapping integer , public, parameter :: mapunset = 0 integer , public, parameter :: mapbilnr = 1 diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index aecc65519..10dbde4d2 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -11,6 +11,7 @@ module flux_atmocn_ccpp_mod use med_ccpp_driver, only : med_ccpp_driver_run use med_ccpp_driver, only : med_ccpp_driver_finalize use ufs_const_mod + use med_internalstate_mod, only : aoflux_ccpp_suite implicit none @@ -92,7 +93,7 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & ! run CCPP init ! TODO: suite name need to be provided by ESMF config file - call med_ccpp_driver_init('FV3_sfc_ocean') + call med_ccpp_driver_init(trim(aoflux_ccpp_suite)) first_call = .false. end if @@ -149,7 +150,7 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & ! run CCPP physics ! TODO: suite name need to be provided by ESMF config file - call med_ccpp_driver_run('FV3_sfc_ocean', 'physics') + call med_ccpp_driver_run(trim(aoflux_ccpp_suite), 'physics') ! unit and sign conversion to be consistent with other flux scheme (CESM) do n = 1, nMax From c719817ec14e63b067fc7f3e79f6d4413ef11d10 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Mon, 28 Feb 2022 15:08:30 -0700 Subject: [PATCH 030/395] initialize count --- cesm/nuopc_cap_share/seq_drydep_mod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/cesm/nuopc_cap_share/seq_drydep_mod.F90 b/cesm/nuopc_cap_share/seq_drydep_mod.F90 index 34bb1423c..0d98f5c85 100644 --- a/cesm/nuopc_cap_share/seq_drydep_mod.F90 +++ b/cesm/nuopc_cap_share/seq_drydep_mod.F90 @@ -893,6 +893,7 @@ subroutine seq_drydep_readnl(NLFilename, drydep_nflds) !----------------------------------------------------------------------------- rc = ESMF_SUCCESS + drydep_nflds = 0 !--- Open and read namelist --- if ( len_trim(NLFilename) == 0 )then From abce72519d462499696496085cf6d132dd8bd971 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 30 Mar 2022 15:41:43 -0600 Subject: [PATCH 031/395] clean version of add_container_support (#276) --- cime_config/buildexe | 2 +- cime_config/config_component.xml | 9 +++++++++ 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/cime_config/buildexe b/cime_config/buildexe index f2a0c905c..e331f4c0e 100755 --- a/cime_config/buildexe +++ b/cime_config/buildexe @@ -105,7 +105,7 @@ def _main_func(): if os.path.isfile(exename): os.remove(exename) - cmd = "{} exec_se -j {} EXEC_SE={} MODEL=driver {} -f {} "\ + cmd = "{} exec_se -j {} EXEC_SE={} CIME_COMP=driver {} -f {} "\ .format(gmake, gmake_j, exename, gmake_args, makefile) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index aeb7770fc..9e35a763a 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -17,6 +17,15 @@ List of component classes supported by this driver + + char + + + case_comp + env_case.xml + Container environment to invoke, if any + + char cpl From a332fc8acc24b4b888afb30130a53fe8d0dc1d77 Mon Sep 17 00:00:00 2001 From: mvertens Date: Fri, 1 Apr 2022 10:44:07 -0600 Subject: [PATCH 032/395] Addition of enthalpy fluxes in CESM (#278) Add ability to send enthalpy fluxes back to MOM6 and at the same time adding a correction term to the sensible heat flux sent back to CAM. --- cime_config/config_component_cesm.xml | 2 + mediator/esmFldsExchange_cesm_mod.F90 | 40 ++++++------ mediator/fd_cesm.yaml | 52 +++++++++++---- mediator/med.F90 | 1 - mediator/med_diag_mod.F90 | 47 ++++++++++++-- mediator/med_phases_prep_atm_mod.F90 | 57 +++++++++++++++++ mediator/med_phases_prep_ocn_mod.F90 | 92 ++++++++++++++++++++++++++- 7 files changed, 250 insertions(+), 41 deletions(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index ba4bb69c0..b3becd832 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -503,6 +503,8 @@ FALSE TRUE + TRUE + TRUE TRUE TRUE diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 9e41a2459..4ee15aba1 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1305,6 +1305,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if end if + ! --------------------------------------------------------------------- ! to atm: merged surface temperature and unmerged temperatures from ice and ocn ! --------------------------------------------------------------------- @@ -1751,13 +1752,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (phase == 'advertise') then call addfld(fldListFr(compatm)%flds, 'Faxa_rainc') call addfld(fldListFr(compatm)%flds, 'Faxa_rainl') - call addfld(fldListFr(compatm)%flds, 'Faxa_rain' ) call addfld(fldListTo(compocn)%flds, 'Faxa_rain' ) call addfld(fldListFr(compatm)%flds, 'Faxa_snowc') call addfld(fldListFr(compatm)%flds, 'Faxa_snowl') - call addfld(fldListFr(compatm)%flds, 'Faxa_snow' ) call addfld(fldListTo(compocn)%flds, 'Faxa_snow' ) else + ! TODO: why are we not merging Faxa_rain and Faxa_snow if they are sent from atm wiht ofrac ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization ! which by default is not actually used if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', rc=rc) .and. & @@ -1767,10 +1767,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap(fldListFr(compatm)%flds, 'Faxa_rainc', compocn, mapconsf, 'one', atm2ocn_map) call addmrg(fldListTo(compocn)%flds, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', & mrg_type='sum_with_weights', mrg_fracname='ofrac') - else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rain', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rain', mrg_type='copy') end if if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', rc=rc) .and. & @@ -1779,10 +1775,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap(fldListFr(compatm)%flds, 'Faxa_snowc', compocn, mapconsf, 'one', atm2ocn_map) call addmrg(fldListTo(compocn)%flds, 'Faxa_snow' , & mrg_from=compatm, mrg_fld='Faxa_snowc:Faxa_snowl', mrg_type='sum_with_weights', mrg_fracname='ofrac') - else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snow', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snow', mrg_type='copy') end if end if @@ -1790,12 +1782,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (phase == 'advertise') then call addfld(fldListFr(compatm)%flds, 'Faxa_rainc_wiso') call addfld(fldListFr(compatm)%flds, 'Faxa_rainl_wiso') - call addfld(fldListFr(compatm)%flds, 'Faxa_rain_wiso' ) call addfld(fldListTo(compocn)%flds, 'Faxa_rain_wiso' ) call addfld(fldListFr(compatm)%flds, 'Faxa_snowc_wiso') call addfld(fldListFr(compatm)%flds, 'Faxa_snowl_wiso') call addfld(fldListFr(compatm)%flds, 'Faxa_snow_wiso' ) - call addfld(fldListTo(compocn)%flds, 'Faxa_snow_wiso' ) else ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization ! which by default is not actually used @@ -1807,11 +1797,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg(fldListTo(compocn)%flds, 'Faxa_rain_wiso' , & mrg_from=compatm, mrg_fld=trim('Faxa_rainc_wiso')//':'//trim('Faxa_rainl_wiso'), & mrg_type='sum_with_weights', mrg_fracname='ofrac') - else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rain_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_rain_wiso', & - mrg_from=compatm, mrg_fld='Faxa_rain_wiso', mrg_type='copy') end if if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl_wiso', rc=rc) .and. & @@ -1821,11 +1806,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg(fldListTo(compocn)%flds, 'Faxa_snow_wiso', & mrg_from=compatm, mrg_fld=trim('Faxa_snowc_wiso')//':'//trim('Faxa_snowl_wiso'), & mrg_type='sum_with_weights', mrg_fracname='ofrac') - else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snow_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_snow_wiso', & - mrg_from=compatm, mrg_fld='Faxa_snow_wiso', mrg_type='copy') end if end if end if @@ -1967,6 +1947,22 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if + ! --------------------------------------------------------------------- + ! to ocn: enthalpy from atm rain, snow, evaporation + ! to ocn: enthalpy from liquid and ice river runoff + ! to ocn: enthalpy from ice melt + ! --------------------------------------------------------------------- + ! Note - do not need to add addmap or addmrg for the following since they + ! will be computed directly in med_phases_prep_ocn + if (phase == 'advertise') then + call addfld(fldListTo(compocn)%flds, 'Foxx_hrain') + call addfld(fldListTo(compocn)%flds, 'Foxx_hsnow') + call addfld(fldListTo(compocn)%flds, 'Foxx_hevap') + call addfld(fldListTo(compocn)%flds, 'Foxx_hcond') + call addfld(fldListTo(compocn)%flds, 'Foxx_hrofl') + call addfld(fldListTo(compocn)%flds, 'Foxx_hrofi') + end if + ! --------------------------------------------------------------------- ! to ocn: merge zonal and meridional surface stress from ice and (atm or med) ! --------------------------------------------------------------------- diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 689ee03ac..9196090d8 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -415,52 +415,52 @@ # - standard_name: Faxx_evap canonical_units: kg m-2 s-1 - description: atmosphere import + description: to atm merged water evaporation flux # - standard_name: Faxx_evap_wiso canonical_units: kg m-2 s-1 - description: atmosphere import + description: to atm merged water evaporation flux for 16O, 18O and HDO # - standard_name: Faxx_lat alias: mean_laten_heat_flx canonical_units: W m-2 - description: atmosphere import + description: to to atm merged latent heat flux # - standard_name: Faxx_lwup canonical_units: W m-2 - description: atmosphere import + description: to atm merged outgoing longwave radiation # - standard_name: Faxx_sen alias: mean_sensi_heat_flx canonical_units: W m-2 - description: atmosphere import + description: to atm merged sensible heat flux # - standard_name: Faxx_taux alias: mean_zonal_moment_flx canonical_units: N m-2 - description: atmosphere import - zonal component of momentum flux + description: to atm merged zonal surface stress # - standard_name: Faxx_tauy alias: mean_merid_moment_flx canonical_units: N m-2 - description: atmosphere import - meridional component of momentum flux + description: to atm merged meridional surface stress # - standard_name: Sx_anidf canonical_units: 1 description: atmosphere import + description: to atm merged surface diffuse albedo (near-infrared radiation) # - standard_name: Sx_anidr canonical_units: 1 - description: atmosphere import + description: to atm merged direct surface albedo (near-infrared radiation) # - standard_name: Sx_avsdf canonical_units: 1 - description: atmosphere import + description: to atm merged surface diffuse albedo (visible radation) # - standard_name: Sx_avsdr canonical_units: 1 - description: atmosphere import + description: to atm merged direct surface albedo (visible radiation) # - standard_name: Sx_qref canonical_units: kg kg-1 @@ -983,6 +983,36 @@ # section: ocean import #----------------------------------- # + - standard_name: Foxx_hrain + alias: heat_content_lprec + canonical_units: W m-2 + description: to ocn heat content of rain + # + - standard_name: Foxx_hsnow + alias: heat_content_fprec + canonical_units: W m-2 + description: to ocn heat content of snow + # + - standard_name: Foxx_hevap + alias: heat_content_evap + canonical_units: W m-2 + description: to ocn heat content of evaporation + # + - standard_name: Foxx_hcond + alias: heat_content_cond + canonical_units: W m-2 + description: to ocn heat content of condensation + # + - standard_name: Foxx_hrofl + alias: heat_content_rofl + canonical_units: W m-2 + description: to ocn heat content of liquid runoff + # + - standard_name: Foxx_hrofi + alias: heat_content_rofi + canonical_units: W m-2 + description: to ocn heat content of ice runoff + # - standard_name: Foxx_evap alias: mean_evap_rate canonical_units: kg m-2 s-1 diff --git a/mediator/med.F90 b/mediator/med.F90 index 4ac79c4cf..67b2785c8 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -35,7 +35,6 @@ module MED use med_methods_mod , only : FB_Init => med_methods_FB_init use med_methods_mod , only : FB_Init_pointer => med_methods_FB_Init_pointer use med_methods_mod , only : FB_Reset => med_methods_FB_Reset - use med_methods_mod , only : FB_FldChk => med_methods_FB_FldChk use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_getFieldN => med_methods_FB_getFieldN use med_methods_mod , only : clock_timeprint => med_methods_clock_timeprint diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index ca8583803..2792d0a26 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -142,6 +142,13 @@ module med_diag_mod integer :: f_heat_latf = unset_index ! heat : latent, fusion, snow integer :: f_heat_ioff = unset_index ! heat : latent, fusion, frozen runoff integer :: f_heat_sen = unset_index ! heat : sensible + integer :: f_heat_rain = unset_index ! heat : heat content of rain + integer :: f_heat_snow = unset_index ! heat : heat content of snow + integer :: f_heat_evap = unset_index ! heat : heat content of evaporation + integer :: f_heat_cond = unset_index ! heat : heat content of evaporation + integer :: f_heat_rofl = unset_index ! heat : heat content of liquid runoff + integer :: f_heat_rofi = unset_index ! heat : heat content of ice runoff + integer :: f_watr_frz = unset_index ! water: freezing integer :: f_watr_melt = unset_index ! water: melting integer :: f_watr_rain = unset_index ! water: precip, liquid @@ -264,6 +271,10 @@ subroutine med_diag_init(gcomp, rc) rc = ESMF_SUCCESS + if(mastertask) then + write(logunit,'(a)') ' Creating budget_diags%comps ' + end if + call NUOPC_CompAttributeGet(gcomp, name="budget_table_version", value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (isPresent .and. isSet) then @@ -314,8 +325,19 @@ subroutine med_diag_init(gcomp, rc) call add_to_budget_diag(budget_diags%fields, f_heat_latf ,'hlatfus' ) ! field heat : latent, fusion, snow call add_to_budget_diag(budget_diags%fields, f_heat_ioff ,'hiroff' ) ! field heat : latent, fusion, frozen runoff call add_to_budget_diag(budget_diags%fields, f_heat_sen ,'hsen' ) ! field heat : sensible - f_heat_beg = f_heat_frz ! field first index for heat - f_heat_end = f_heat_sen ! field last index for heat + if (trim(budget_table_version) == 'v0') then + f_heat_beg = f_heat_frz ! field first index for heat + f_heat_end = f_heat_sen ! field last index for heat + else if (trim(budget_table_version) == 'v1') then + call add_to_budget_diag(budget_diags%fields, f_heat_rain ,'hrain' ) ! field heat : enthalpy of rain + call add_to_budget_diag(budget_diags%fields, f_heat_snow ,'hsnow' ) ! field heat : enthalpy of snow + call add_to_budget_diag(budget_diags%fields, f_heat_evap ,'hevap' ) ! field heat : enthalpy of evaporation + call add_to_budget_diag(budget_diags%fields, f_heat_cond ,'hcond' ) ! field heat : enthalpy of evaporation + call add_to_budget_diag(budget_diags%fields, f_heat_rofl ,'hrofl' ) ! field heat : enthalpy of liquid runoff + call add_to_budget_diag(budget_diags%fields, f_heat_rofi ,'hrofi' ) ! field heat : enthalpy of ice runoff + f_heat_beg = f_heat_frz ! field first index for heat + f_heat_end = f_heat_rofi ! field last index for heat + end if ! ----------------------------------------- ! Water fluxes budget terms @@ -1549,6 +1571,19 @@ subroutine med_phases_diag_ocn( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrain', f_heat_rain , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', f_heat_snow , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hevap', f_heat_evap , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hcond', f_heat_cond , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', f_heat_rofl , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', f_heat_rofi , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice @@ -1897,12 +1932,16 @@ subroutine med_phases_diag_ice_med2ice( gcomp, rc) ic = c_inh_send budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice - budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX + if (trim(budget_table_version) == 'v0') then + budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX + end if ic = c_ish_send budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice - budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX + if (trim(budget_table_version) == 'v0') then + budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX + end if if (flds_wiso) then call diag_ice_send_wiso(is_local%wrap%FBExp(compice), 'Faxa_rain_wiso', & diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index d3af6163d..c2e9b4ef5 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -13,6 +13,7 @@ module med_phases_prep_atm_mod use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk + use med_methods_mod , only : FB_getfldptr=> med_methods_FB_GetFldPtr use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, mastertask @@ -26,6 +27,9 @@ module med_phases_prep_atm_mod private public :: med_phases_prep_atm + public :: med_phases_prep_atm_enthalpy_correction + + real(r8), public :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn character(*), parameter :: u_FILE_u = & __FILE__ @@ -221,6 +225,15 @@ subroutine med_phases_prep_atm(gcomp, rc) end do end if + ! Add enthalpy correction to sensible heat if appropriate + if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then + call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_sen', dataptr1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(dataptr1) + dataptr1(n) = dataptr1(n) + global_htot_corr(1) + end do + end if + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if @@ -228,4 +241,48 @@ subroutine med_phases_prep_atm(gcomp, rc) end subroutine med_phases_prep_atm + !----------------------------------------------------------------------------- + subroutine med_phases_prep_atm_enthalpy_correction (gcomp, hcorr, rc) + + ! Enthalpy correction term calculation called by med_phases_prep_ocn_accum in + ! med_phases_prep_ocn_mod + ! Note that this is only called if the following fields are in FBExp(compocn) + ! 'Faxa_rain','Foxx_hrain','Faxa_snow' ,'Foxx_hsnow', + ! 'Foxx_evap','Foxx_hevap','Foxx_hcond','Foxx_rofl', + ! 'Foxx_hrofl','Foxx_rofi','Foxx_hrofi' + + use ESMF , only : ESMF_VMAllreduce, ESMF_GridCompGet, ESMF_REDUCE_SUM + use ESMF , only : ESMF_VM + + ! input/output variables + type(ESMF_GridComp) , intent(in) :: gcomp + real(r8) , intent(in) :: hcorr(:) + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: n + real(r8) :: local_htot_corr(1) + type(ESMF_VM) :: vm + !--------------------------------------- + + rc = ESMF_SUCCESS + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine sum of enthalpy correction for each hcorr index locally + local_htot_corr(1) = 0._r8 + do n = 1,size(hcorr) + local_htot_corr(1) = local_htot_corr(1) + hcorr(n) + end do + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_htot_corr, recvdata=global_htot_corr, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine med_phases_prep_atm_enthalpy_correction + end module med_phases_prep_atm_mod diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 0858462bc..de4599ffb 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -76,9 +76,11 @@ end subroutine med_phases_prep_ocn_init !----------------------------------------------------------------------------- subroutine med_phases_prep_ocn_accum(gcomp, rc) - use ESMF , only : ESMF_GridComp, ESMF_FieldBundleGet - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_GridComp, ESMF_FieldBundleGet + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR + use med_constants_mod , only : shr_const_cpsw, shr_const_tkfrz, shr_const_pi + use med_phases_prep_atm_mod , only : med_phases_prep_atm_enthalpy_correction ! input/output variables type(ESMF_GridComp) :: gcomp @@ -87,6 +89,16 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n, ncnt + real(r8) :: glob_area_inv + real(r8), pointer :: tocn(:) + real(r8), pointer :: rain(:), hrain(:) + real(r8), pointer :: snow(:), hsnow(:) + real(r8), pointer :: evap(:), hevap(:) + real(r8), pointer :: hcond(:) + real(r8), pointer :: rofl(:), hrofl(:) + real(r8), pointer :: rofi(:), hrofi(:) + real(r8), pointer :: areas(:) + real(r8), allocatable :: hcorr(:) character(len=*), parameter :: subname='(med_phases_prep_ocn_accum)' !--------------------------------------- @@ -124,6 +136,80 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + ! compute enthaly associated with rain, snow, condensation and liquid river runoff + ! the sea-ice model already accounts for the enthalpy flux (as part of melth), so + ! enthalpy from meltw **is not** included below + if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrain' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hsnow' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hevap' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hcond' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi' , rc=rc)) then + + call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rain, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrain', hrain, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_evap' , evap, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hevap', hevap, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hcond', hcond, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_snow' , snow, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', hsnow, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rofl, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', hrofl, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rofi, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', hrofi, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1,size(tocn) + ! Need max to ensure that will not have an enthalpy contribution if the water is below 0C + hrain(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rain(n) * shr_const_cpsw + hsnow(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * snow(n) * shr_const_cpsw + hevap(n) = (tocn(n) - shr_const_tkfrz) * min(evap(n), 0._r8) * shr_const_cpsw + hcond(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * max(evap(n), 0._r8) * shr_const_cpsw + hrofl(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rofl(n) * shr_const_cpsw + hrofi(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * rofi(n) * shr_const_cpsw + end do + + ! Determine enthalpy correction factor that will be added to the sensible heat flux sent to the atm + ! Areas here in radians**2 - this is an instantaneous snapshot that will be sent to the atm - only + ! need to calculate this if data is sent back to the atm + + if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then + allocate(hcorr(size(tocn))) + glob_area_inv = 1._r8 / (4._r8 * shr_const_pi) + areas => is_local%wrap%mesh_info(compocn)%areas + do n = 1,size(tocn) + hcorr(n) = (hrain(n) + hsnow(n) + hcond(n) + hevap(n) + hrofl(n) + hrofi(n)) * & + areas(n) * glob_area_inv + end do + call med_phases_prep_atm_enthalpy_correction(gcomp, hcorr, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(hcorr) + end if + + end if + ! custom merges to ocean if (trim(coupling_mode) == 'cesm') then call med_phases_prep_ocn_custom_cesm(gcomp, rc) From f6c8f0be6c631f5f545fa3528fef8c198b6f9d1d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 4 Apr 2022 07:43:04 -0600 Subject: [PATCH 033/395] correct COMP_NAME (was CIME_COMP) --- cime_config/buildexe | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/buildexe b/cime_config/buildexe index e331f4c0e..7f1a64471 100755 --- a/cime_config/buildexe +++ b/cime_config/buildexe @@ -105,7 +105,7 @@ def _main_func(): if os.path.isfile(exename): os.remove(exename) - cmd = "{} exec_se -j {} EXEC_SE={} CIME_COMP=driver {} -f {} "\ + cmd = "{} exec_se -j {} EXEC_SE={} COMP_NAME=driver {} -f {} "\ .format(gmake, gmake_j, exename, gmake_args, makefile) From f12b1d91688ec98c857c2332d346a4ddd0341f75 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Tue, 5 Apr 2022 23:05:20 -0600 Subject: [PATCH 034/395] fix for data configurations --- mediator/med_phases_aofluxes_mod.F90 | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 87e936e81..5c386612f 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1032,9 +1032,8 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) missval=0.0_r8) #else - if (trim(coupling_mode) == 'nems_frac_aoflux' .or. trim(coupling_mode) == 'nems_frac_aoflux_sbs') then #ifdef UFS_AOFLUX - if (trim(aoflux_code) == 'ccpp') then + if (trim(aoflux_code) == 'ccpp') then call flux_atmocn_ccpp( & nMax=aoflux_in%lsize, psfc=aoflux_in%psfc, & pbot=aoflux_in%pbot, tbot=aoflux_in%tbot, qbot=aoflux_in%shum, lwdn=aoflux_in%lwdn, & @@ -1043,7 +1042,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evp=aoflux_out%evap, & taux=aoflux_out%taux, tauy=aoflux_out%tauy, qref=aoflux_out%qref, & missval=0.0_r8) - else + else #endif call flux_atmocn (logunit=logunit, & nMax=aoflux_in%lsize, mask=aoflux_in%mask, & @@ -1054,9 +1053,8 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & duu10n=aoflux_out%duu10n, missval=0.0_r8) #ifdef UFS_AOFLUX - end if + end if #endif - end if #endif From 27dd3d0760254c353e4c197ec1ecf4a38fd957b5 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 7 Feb 2022 15:50:54 -0700 Subject: [PATCH 035/395] move pio parameters to nuopc.runconfig input file --- cime_config/buildnml | 152 +++++++------- cime_config/config_component.xml | 28 ++- cime_config/namelist_definition_drv.xml | 211 +++++++++++++++++--- cime_config/namelist_definition_modelio.xml | 207 ------------------- 4 files changed, 273 insertions(+), 325 deletions(-) delete mode 100644 cime_config/namelist_definition_modelio.xml diff --git a/cime_config/buildnml b/cime_config/buildnml index 2bc7c82b9..72e9bb48f 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -100,7 +100,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): #---------------------------------------------------- # Initialize namelist defaults #---------------------------------------------------- - nmlgen.init_defaults(infile, config) + nmlgen.init_defaults(infile, config, skip_default_for_groups=["modelio"]) #-------------------------------- # Overwrite: set brnch_retain_casename @@ -233,7 +233,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): # Write namelist file drv_in and initial input dataset list. #-------------------------------- namelist_file = os.path.join(confdir, "drv_in") - drv_namelist_groups = ["papi_inparm", "pio_default_inparm", "prof_inparm", "debug_inparm"] + drv_namelist_groups = ["papi_inparm", "prof_inparm", "debug_inparm"] nmlgen.write_output_file(namelist_file, data_list_path=data_list_path, groups=drv_namelist_groups) #-------------------------------- @@ -288,7 +288,67 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): logger.info("Writing nuopc_runconfig for components {}".format(valid_comps)) nuopc_config_file = os.path.join(confdir, "nuopc.runconfig") - nmlgen.write_nuopc_config_file(nuopc_config_file, data_list_path=data_list_path) + + if os.path.exists(nuopc_config_file): + os.unlink(nuopc_config_file) + + lid = os.environ["LID"] if "LID" in os.environ else get_timestamp("%y%m%d-%H%M%S") + + #if we are in multi-coupler mode the number of instances of mediator will be the max + # of any NINST_* value + maxinst = 1 + if case.get_value("MULTI_DRIVER"): + maxinst = case.get_value("NINST_MAX") + multi_driver = True + with open(nuopc_config_file, 'a', encoding="utf-8") as conffile: + nmlgen.write_nuopc_config_file(conffile, data_list_path=data_list_path) + + for model in case.get_values("COMP_CLASSES"): + model = model.lower() + config = {} + config['component'] = model + nmlgen.init_defaults(infile, config, skip_entry_loop=True) + if model == 'cpl': + newgroup = "MED_modelio" + else: + newgroup = model.upper()+"_modelio" + nmlgen._definition.rename_group("modelio", newgroup) + + if maxinst == 1 and model != 'cpl' and not multi_driver: + inst_count = case.get_value("NINST_" + model.upper()) + else: + inst_count = maxinst + + for entry in ["pio_async_interface", + "pio_netcdf_format", + "pio_numiotasks", + "pio_rearranger", + "pio_root", + "pio_stride", + "pio_typename"]: + nmlgen.add_default(entry) + + + inst_string = "" + inst_index = 1 + while inst_index <= inst_count: + # determine instance string + if inst_count > 1: + inst_string = '_{:04d}'.format(inst_index) + + # Output the following to nuopc.runconfig + nmlgen.set_value("diro", case.get_value('RUNDIR')) + if model == 'cpl': + logfile = 'med' + inst_string + ".log." + str(lid) + else: + logfile = model + inst_string + ".log." + str(lid) + nmlgen.set_value("logfile", logfile) + inst_index = inst_index + 1 + nmlgen.write_nuopc_config_file(conffile) + + + + #-------------------------------- # Update nuopc.runconfig file if component needs it @@ -441,7 +501,7 @@ def compare_drv_flds_in(first, second, infile1, infile2): % (infile1, infile2)) ############################################################################### -def _create_component_modelio_namelists(confdir, case, files): +def _create_component_modelio_namelists(case, confdir, nmlgen, files): ############################################################################### # will need to create a new namelist generator @@ -450,78 +510,6 @@ def _create_component_modelio_namelists(confdir, case, files): definition_file = [os.path.join(definition_dir, "namelist_definition_modelio.xml")] confdir = os.path.join(case.get_value("CASEBUILD"), "cplconf") - lid = os.environ["LID"] if "LID" in os.environ else get_timestamp("%y%m%d-%H%M%S") - - #if we are in multi-coupler mode the number of instances of mediator will be the max - # of any NINST_* value - maxinst = 1 - if case.get_value("MULTI_DRIVER"): - maxinst = case.get_value("NINST_MAX") - multi_driver = True - - nuopc_config_file = os.path.join(confdir, "nuopc.runconfig") - for model in case.get_values("COMP_CLASSES"): - model = model.lower() - with NamelistGenerator(case, definition_file) as nmlgen: - config = {} - config['component'] = model - entries = nmlgen.init_defaults(infiles, config, skip_entry_loop=True) - if maxinst == 1 and model != 'cpl' and not multi_driver: - inst_count = case.get_value("NINST_" + model.upper()) - else: - inst_count = maxinst - - inst_string = "" - inst_index = 1 - while inst_index <= inst_count: - # determine instance string - if inst_count > 1: - inst_string = '_{:04d}'.format(inst_index) - - # Write out just the pio_inparm to the output file - for entry in entries: - nmlgen.add_default(entry) - - if inst_index == 1: - if model == "cpl": - modelio_file = "med_modelio.nml" - else: - modelio_file = model + "_modelio.nml" - nmlgen.write_nuopc_modelio_file(os.path.join(confdir, modelio_file)) - - # Output the following to nuopc.runconfig - moddiro = case.get_value('RUNDIR') - if model == 'cpl': - logfile = 'med' + inst_string + ".log." + str(lid) - else: - logfile = model + inst_string + ".log." + str(lid) - - with open(nuopc_config_file, 'a', encoding="utf-8") as outfile: - if model == 'cpl': - name = "MED" - else: - name = model.upper() - if inst_string: - outfile.write("{}_modelio{}::\n".format(name,inst_string)) - else: - outfile.write("{}_modelio::\n".format(name)) - outfile.write(" {}{}{}".format("diro = ", moddiro,"\n")) - outfile.write(" {}{}{}".format("logfile = ", logfile,"\n")) - outfile.write("::\n\n") - - # also write out a driver log file - if model == 'cpl': - name = "DRV" - logfile = 'drv' + inst_string + ".log." + str(lid) - if inst_string: - outfile.write("{}_modelio{}::\n".format(name,inst_string)) - else: - outfile.write("{}_modelio::\n".format(name)) - outfile.write(" {}{}{}".format("diro = ", moddiro,"\n")) - outfile.write(" {}{}{}".format("logfile = ", logfile,"\n")) - outfile.write("::\n\n") - - inst_index = inst_index + 1 ############################################################################### @@ -566,13 +554,13 @@ def buildnml(case, caseroot, component): comp_root_dir_cpl = files.get_value( "COMP_ROOT_DIR_CPL",{"component":"cpl"}, resolved=False) files.set_value("COMP_ROOT_DIR_CPL", comp_root_dir_cpl) - definition_file = [files.get_value("NAMELIST_DEFINITION_FILE", {"component": "cpl"})] - user_definition = os.path.join(user_xml_dir, "namelist_definition_drv.xml") - if os.path.isfile(user_definition): - definition_file = [user_definition] + definition_files = [files.get_value("NAMELIST_DEFINITION_FILE", {"component": "cpl"})] + user_drv_definition = os.path.join(user_xml_dir, "namelist_definition_drv.xml") + if os.path.isfile(user_drv_definition): + definition_files.append(user_drv_definition) # create the namelist generator object - independent of instance - nmlgen = NamelistGenerator(case, definition_file) + nmlgen = NamelistGenerator(case, definition_files) # create cplconf/namelist infile_text = "" @@ -587,7 +575,7 @@ def buildnml(case, caseroot, component): _create_drv_namelists(case, infile, confdir, nmlgen, files) # create the files comp_modelio.nml where comp = [atm, lnd...] - _create_component_modelio_namelists(confdir, case, files) +# _create_component_modelio_namelists(case, confdir, nmlgen, files) # set rundir rundir = case.get_value("RUNDIR") diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 9e35a763a..b8909947b 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -1928,15 +1928,6 @@ PIO configure options, see PIO configure utility for details - - logical - TRUE,FALSE - FALSE - run_pio - env_run.xml - TRUE implies perform asynchronous i/o - - char p2p,coll,default @@ -2040,6 +2031,25 @@ pio buffer size limit for pnetcdf output + + logical + TRUE,FALSE + run_pio + env_run.xml + TRUE implies perform asynchronous i/o + + FALSE + FALSE + FALSE + FALSE + FALSE + FALSE + FALSE + FALSE + FALSE + + + char netcdf,pnetcdf,netcdf4p,netcdf4c,default diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 02c8f44ce..611c36619 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -3537,28 +3537,13 @@ - + - - logical - pio - pio_default_inparm - - future asynchronous IO capability (not currently supported). - If pio_async_interface is .true. or {component}_PIO_* variable is not set or set to -99 - the component variable will be set using the pio_* value. - default: .false. - - - $PIO_ASYNC_INTERFACE - - - integer pio - pio_default_inparm + DRIVER_attributes 0,1,2,3,4,5,6 pio debug level @@ -3572,7 +3557,7 @@ integer pio - pio_default_inparm + DRIVER_attributes blocksize for pio box rearranger @@ -3584,7 +3569,7 @@ integer pio - pio_default_inparm + DRIVER_attributes pio buffer size limit @@ -3596,7 +3581,7 @@ char pio - pio_default_inparm + DRIVER_attributes p2p,coll,default pio rearranger communication type. @@ -3610,7 +3595,7 @@ char pio - pio_default_inparm + DRIVER_attributes 2denable,io2comp,comp2io,disable,default pio rearranger communication flow control direction. @@ -3623,7 +3608,7 @@ integer pio - pio_default_inparm + DRIVER_attributes pio rearranger communication max pending req (comp2io) @@ -3635,7 +3620,7 @@ logical pio - pio_default_inparm + DRIVER_attributes pio rearranger communication option: Enable handshake (comp2io) @@ -3647,7 +3632,7 @@ logical pio - pio_default_inparm + DRIVER_attributes pio rearranger communication option: Enable isends (comp2io) @@ -3659,7 +3644,7 @@ integer pio - pio_default_inparm + DRIVER_attributes pio rearranger communication max pending req (io2comp) @@ -3671,7 +3656,7 @@ logical pio - pio_default_inparm + DRIVER_attributes pio rearranger communication option: Enable handshake (io2comp) @@ -3683,7 +3668,7 @@ logical pio - pio_default_inparm + DRIVER_attributes pio rearranger communication option: Enable isends (io2comp) default: .false. @@ -4026,4 +4011,176 @@ + + + + + + logical + pio + modelio + + future asynchronous IO capability (not currently supported). + If pio_async_interface is .true. or {component}_PIO_* variable is not set or set to -99 + the component variable will be set using the pio_* value. + default: .false. + + + $CPL_PIO_ASYNC_INTERFACE + $ATM_PIO_ASYNC_INTERFACE + $LND_PIO_ASYNC_INTERFACE + $OCN_PIO_ASYNC_INTERFACE + $ICE_PIO_ASYNC_INTERFACE + $ROF_PIO_ASYNC_INTERFACE + $GLC_PIO_ASYNC_INTERFACE + $WAV_PIO_ASYNC_INTERFACE + .false. + + + + + integer + pio + modelio + + stride of tasks in pio used generically, component based value takes precedent. + + + $CPL_PIO_STRIDE + $ATM_PIO_STRIDE + $LND_PIO_STRIDE + $OCN_PIO_STRIDE + $ICE_PIO_STRIDE + $ROF_PIO_STRIDE + $GLC_PIO_STRIDE + $WAV_PIO_STRIDE + -99 + + + + + integer + pio + modelio + + io task root in pio used generically, component based value takes precedent. + + + $CPL_PIO_ROOT + $ATM_PIO_ROOT + $LND_PIO_ROOT + $OCN_PIO_ROOT + $ICE_PIO_ROOT + $ROF_PIO_ROOT + $GLC_PIO_ROOT + $WAV_PIO_ROOT + -99 + + + + + integer + pio + modelio + -99,1,2 + + Rearranger method for pio 1=box, 2=subset. + + + $CPL_PIO_REARRANGER + $ATM_PIO_REARRANGER + $LND_PIO_REARRANGER + $OCN_PIO_REARRANGER + $ICE_PIO_REARRANGER + $ROF_PIO_REARRANGER + $GLC_PIO_REARRANGER + $WAV_PIO_REARRANGER + -99 + + + + + integer + pio + modelio + + number of io tasks in pio used generically, component based value takes precedent. + + + $CPL_PIO_NUMTASKS + $ATM_PIO_NUMTASKS + $LND_PIO_NUMTASKS + $OCN_PIO_NUMTASKS + $ICE_PIO_NUMTASKS + $ROF_PIO_NUMTASKS + $GLC_PIO_NUMTASKS + $WAV_PIO_NUMTASKS + -99 + + + + + char*64 + pio + modelio + netcdf,pnetcdf,netcdf4p,netcdf4c,default,nothing + + io type in pio used generically, component based value takes precedent. + valid values: netcdf, pnetcdf, netcdf4p, netcdf4c, default + + + $CPL_PIO_TYPENAME + $ATM_PIO_TYPENAME + $LND_PIO_TYPENAME + $OCN_PIO_TYPENAME + $ICE_PIO_TYPENAME + $ROF_PIO_TYPENAME + $GLC_PIO_TYPENAME + $WAV_PIO_TYPENAME + nothing + + + + + char*64 + pio + modelio + classic,64bit_offset,64bit_data + + format of netcdf files created by pio, ignored if + PIO_TYPENAME is netcdf4p or netcdf4c. 64bit_data only + supported in netcdf 4.4.0 or newer + + + $CPL_PIO_NETCDF_FORMAT + $ATM_PIO_NETCDF_FORMAT + $LND_PIO_NETCDF_FORMAT + $OCN_PIO_NETCDF_FORMAT + $ICE_PIO_NETCDF_FORMAT + $ROF_PIO_NETCDF_FORMAT + $GLC_PIO_NETCDF_FORMAT + $WAV_PIO_NETCDF_FORMAT + $ESP_PIO_NETCDF_FORMAT + + + + + char*256 + modelio + modelio + directory for output log files + + UNSET + + + + + char*256 + modelio + modelio + name of component output log file + + UNSET + + diff --git a/cime_config/namelist_definition_modelio.xml b/cime_config/namelist_definition_modelio.xml deleted file mode 100644 index 35af19567..000000000 --- a/cime_config/namelist_definition_modelio.xml +++ /dev/null @@ -1,207 +0,0 @@ - - - - - - - - - - - - - - integer - pio - pio_inparm - - stride of tasks in pio used generically, component based value takes precedent. - - - $CPL_PIO_STRIDE - $ATM_PIO_STRIDE - $LND_PIO_STRIDE - $OCN_PIO_STRIDE - $ICE_PIO_STRIDE - $ROF_PIO_STRIDE - $GLC_PIO_STRIDE - $WAV_PIO_STRIDE - -99 - - - - - integer - pio - pio_inparm - - io task root in pio used generically, component based value takes precedent. - - - $CPL_PIO_ROOT - $ATM_PIO_ROOT - $LND_PIO_ROOT - $OCN_PIO_ROOT - $ICE_PIO_ROOT - $ROF_PIO_ROOT - $GLC_PIO_ROOT - $WAV_PIO_ROOT - -99 - - - - - integer - pio - pio_inparm - -99,1,2 - - Rearranger method for pio 1=box, 2=subset. - - - $CPL_PIO_REARRANGER - $ATM_PIO_REARRANGER - $LND_PIO_REARRANGER - $OCN_PIO_REARRANGER - $ICE_PIO_REARRANGER - $ROF_PIO_REARRANGER - $GLC_PIO_REARRANGER - $WAV_PIO_REARRANGER - -99 - - - - - integer - pio - pio_inparm - - number of io tasks in pio used generically, component based value takes precedent. - - - $CPL_PIO_NUMTASKS - $ATM_PIO_NUMTASKS - $LND_PIO_NUMTASKS - $OCN_PIO_NUMTASKS - $ICE_PIO_NUMTASKS - $ROF_PIO_NUMTASKS - $GLC_PIO_NUMTASKS - $WAV_PIO_NUMTASKS - -99 - - - - - char*64 - pio - pio_inparm - netcdf,pnetcdf,netcdf4p,netcdf4c,default - - io type in pio used generically, component based value takes precedent. - valid values: netcdf, pnetcdf, netcdf4p, netcdf4c, default - - - $CPL_PIO_TYPENAME - $ATM_PIO_TYPENAME - $LND_PIO_TYPENAME - $OCN_PIO_TYPENAME - $ICE_PIO_TYPENAME - $ROF_PIO_TYPENAME - $GLC_PIO_TYPENAME - $WAV_PIO_TYPENAME - nothing - - - - - char*64 - pio - pio_inparm - classic,64bit_offset,64bit_data - - format of netcdf files created by pio, ignored if - PIO_TYPENAME is netcdf4p or netcdf4c. 64bit_data only - supported in netcdf 4.4.0 or newer - - - $CPL_PIO_NETCDF_FORMAT - $ATM_PIO_NETCDF_FORMAT - $LND_PIO_NETCDF_FORMAT - $OCN_PIO_NETCDF_FORMAT - $ICE_PIO_NETCDF_FORMAT - $ROF_PIO_NETCDF_FORMAT - $GLC_PIO_NETCDF_FORMAT - $WAV_PIO_NETCDF_FORMAT - $ESP_PIO_NETCDF_FORMAT - - - - - - - - - char*256 - modelio - modelio - input directory (no longer needed) - - UNSET - - - - - char*256 - modelio - modelio - directory for output log files - - UNSET - - - - - char*256 - modelio - modelio - name of component output log file - - UNSET - - - - From a21f70b0c485ce42c98e9096d58102e5d507bd5d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 7 Feb 2022 16:25:03 -0700 Subject: [PATCH 036/395] X case compiles --- cesm/driver/esm.F90 | 4 +- cesm/driver/esmApp.F90 | 3 +- .../esm_utils_mod.F90 | 0 cesm/nuopc_cap_share/shr_pio_mod.F90 | 879 ++++++++++++++++++ 4 files changed, 882 insertions(+), 4 deletions(-) rename cesm/{driver => nuopc_cap_share}/esm_utils_mod.F90 (100%) create mode 100644 cesm/nuopc_cap_share/shr_pio_mod.F90 diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index d28ddacb0..dfc74fadc 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -807,7 +807,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) use mpi , only : MPI_COMM_NULL, mpi_comm_size #endif use mct_mod , only : mct_world_init - use shr_pio_mod , only : shr_pio_init2 + use shr_pio_mod , only : shr_pio_init #ifdef MED_PRESENT use med_internalstate_mod , only : med_id @@ -1179,7 +1179,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) call mct_world_init(componentCount+1, GLOBAL_COMM, comms, comps) ! Initialize PIO - call shr_pio_init2(comps(2:), compLabels, comp_iamin, comms(2:), comp_comm_iam) + call shr_pio_init(driver, size(comps)) deallocate(petlist, comms, comps, comp_iamin, comp_comm_iam) diff --git a/cesm/driver/esmApp.F90 b/cesm/driver/esmApp.F90 index 1516ffa10..5314e043e 100644 --- a/cesm/driver/esmApp.F90 +++ b/cesm/driver/esmApp.F90 @@ -15,7 +15,6 @@ program esmApp use mpi use NUOPC, only : NUOPC_FieldDictionarySetup use ensemble_driver, only : SetServices - use shr_pio_mod, only : shr_pio_init1 use shr_sys_mod, only : shr_sys_abort implicit none @@ -53,7 +52,7 @@ program esmApp ! the model completes. All other tasks call ESMF_Initialize. 8 is the maximum number of component models ! supported - call shr_pio_init1(8, "drv_in", COMP_COMM) +! call shr_pio_init1(8, "drv_in", COMP_COMM) !----------------------------------------------------------------------------- ! Initialize ESMF diff --git a/cesm/driver/esm_utils_mod.F90 b/cesm/nuopc_cap_share/esm_utils_mod.F90 similarity index 100% rename from cesm/driver/esm_utils_mod.F90 rename to cesm/nuopc_cap_share/esm_utils_mod.F90 diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/shr_pio_mod.F90 new file mode 100644 index 000000000..820093c0f --- /dev/null +++ b/cesm/nuopc_cap_share/shr_pio_mod.F90 @@ -0,0 +1,879 @@ +module shr_pio_mod + use pio + use shr_kind_mod, only : shr_kind_CS, shr_kind_cl, shr_kind_in + use shr_file_mod, only : shr_file_getunit, shr_file_freeunit + use shr_log_mod, only : shr_log_unit + use shr_mpi_mod, only : shr_mpi_bcast, shr_mpi_chkerr + use shr_sys_mod, only : shr_sys_abort +#ifndef NO_MPI2 + use mpi, only : mpi_comm_null, mpi_comm_world, mpi_finalize +#endif + use esm_utils_mod, only : chkerr + implicit none +#ifdef NO_MPI2 +#include +#endif + private + public :: shr_pio_init + public :: shr_pio_getiosys + public :: shr_pio_getiotype + public :: shr_pio_getioroot + public :: shr_pio_finalize + public :: shr_pio_getioformat + public :: shr_pio_getrearranger + + interface shr_pio_getiotype + module procedure shr_pio_getiotype_fromid, shr_pio_getiotype_fromname + end interface + interface shr_pio_getioformat + module procedure shr_pio_getioformat_fromid, shr_pio_getioformat_fromname + end interface + interface shr_pio_getiosys + module procedure shr_pio_getiosys_fromid, shr_pio_getiosys_fromname + end interface + interface shr_pio_getioroot + module procedure shr_pio_getioroot_fromid, shr_pio_getioroot_fromname + end interface + interface shr_pio_getindex + module procedure shr_pio_getindex_fromid, shr_pio_getindex_fromname + end interface + interface shr_pio_getrearranger + module procedure shr_pio_getrearranger_fromid, shr_pio_getrearranger_fromname + end interface + + type pio_comp_t + integer :: compid + integer :: pio_root + integer :: pio_stride + integer :: pio_numiotasks + integer :: pio_iotype + integer :: pio_rearranger + integer :: pio_netcdf_ioformat + end type pio_comp_t + + character(len=16), allocatable :: io_compname(:) + type(pio_comp_t), allocatable :: pio_comp_settings(:) + type (iosystem_desc_t), allocatable, target :: iosystems(:) + integer :: io_comm + logical :: pio_async_interface + integer, allocatable :: io_compid(:) + integer :: pio_debug_level=0, pio_blocksize=0 + integer(kind=pio_offset_kind) :: pio_buffer_size_limit=-1 + integer :: pio_rearr_opt_comm_type, pio_rearr_opt_fcd + logical :: pio_rearr_opt_c2i_enable_hs, pio_rearr_opt_c2i_enable_isend + integer :: pio_rearr_opt_c2i_max_pend_req + logical :: pio_rearr_opt_i2c_enable_hs, pio_rearr_opt_i2c_enable_isend + integer :: pio_rearr_opt_i2c_max_pend_req + integer :: total_comps + logical :: mastertask +#define DEBUGI 1 + +#ifdef DEBUGI + integer :: drank +#endif + + character(*), parameter :: u_FILE_u = & + __FILE__ + +contains + +!> +!! @public +!! @brief if pio_async_interface is true, tasks in io_comm do not return from this subroutine. +!! +!! if pio_async_interface is false each component namelist pio_inparm is read from compname_modelio.nml +!! Then a subset of each components compute tasks are Identified as IO tasks using the root, stride and count +!! variables to select the tasks. +!! +!< + + subroutine shr_pio_init(driver, total_comps) + use ESMF, only : ESMF_GridComp, ESMF_VM, ESMF_Config, ESMF_GridCompGet + use ESMF, only : ESMF_VMGet + use NUOPC, only: NUOPC_CompAttributeGet + use shr_string_mod, only : shr_string_toLower + type(ESMF_GridComp) :: driver + integer, intent(in) :: total_comps + + type(ESMF_VM) :: vm + integer :: i + character(len=shr_kind_cl) :: nlfilename, cname + integer :: ret, rc + integer :: localPet + character(*), parameter :: subName = '(shr_pio_init) ' + + call ESMF_GridCompGet(driver, vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=localPet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + mastertask = (localPet == 0) + + call NUOPC_CompAttributeGet(driver, name="pio_buffer_size_limit", value=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cname,*) pio_buffer_size_limit + + ! 0 is a valid value of pio_buffer_size_limit + if(pio_buffer_size_limit>=0) then + if(mastertask) write(shr_log_unit,*) 'Setting pio_buffer_size_limit : ',pio_buffer_size_limit + call pio_set_buffer_size_limit(pio_buffer_size_limit) + endif + + call NUOPC_CompAttributeGet(driver, name="pio_blocksize", value=pio_blocksize, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if(pio_blocksize>0) then + if(mastertask) write(shr_log_unit,*) 'Setting pio_blocksize : ',pio_blocksize + call pio_set_blocksize(pio_blocksize) + endif + + allocate(iosystems(total_comps)) +#ifdef DOTHIS + do i=1,total_comps + + if(comp_iamin(i)) then + cname = comp_name(i) + if(len_trim(cname) <= 3) then + nlfilename=trim(shr_string_toLower(cname))//'_modelio.nml' + else + nlfilename=trim(shr_string_toLower(cname(1:3)))//'_modelio.nml_'//cname(4:8) + endif + + call shr_pio_read_component_namelist(nlfilename , comp_comm(i), pio_comp_settings(i)%pio_stride, & + pio_comp_settings(i)%pio_root, pio_comp_settings(i)%pio_numiotasks, & + pio_comp_settings(i)%pio_iotype, pio_comp_settings(i)%pio_rearranger, & + pio_comp_settings(i)%pio_netcdf_ioformat) + + call pio_init(comp_comm_iam(i), comp_comm(i), pio_comp_settings(i)%pio_numiotasks, 0, & + pio_comp_settings(i)%pio_stride, & + pio_comp_settings(i)%pio_rearranger, iosystems(i), & + base=pio_comp_settings(i)%pio_root) + ret = pio_set_rearr_opts(iosystems(i), pio_rearr_opt_comm_type,& + pio_rearr_opt_fcd,& + pio_rearr_opt_c2i_enable_hs, pio_rearr_opt_c2i_enable_isend,& + pio_rearr_opt_c2i_max_pend_req,& + pio_rearr_opt_i2c_enable_hs, pio_rearr_opt_i2c_enable_isend,& + pio_rearr_opt_i2c_max_pend_req) + if(ret /= PIO_NOERR) then + write(shr_log_unit,*) "ERROR: Setting rearranger options failed" + end if + end if + end do + + allocate(io_compid(total_comps), io_compname(total_comps)) + + io_compid = comp_id + io_compname = comp_name + do i=1,total_comps + if(comp_iamin(i) .and. (comp_comm_iam(i) == 0)) then + write(shr_log_unit,*) io_compname(i),' : pio_numiotasks = ',pio_comp_settings(i)%pio_numiotasks + write(shr_log_unit,*) io_compname(i),' : pio_stride = ',pio_comp_settings(i)%pio_stride + write(shr_log_unit,*) io_compname(i),' : pio_rearranger = ',pio_comp_settings(i)%pio_rearranger + write(shr_log_unit,*) io_compname(i),' : pio_root = ',pio_comp_settings(i)%pio_root + write(shr_log_unit,*) io_compname(i),' : pio_iotype = ',pio_comp_settings(i)%pio_iotype + end if + enddo +#endif + end subroutine shr_pio_init + + + +!=============================================================================== + subroutine shr_pio_finalize( ) + integer :: ierr + integer :: i +! do i=1,total_comps + call pio_finalize(iosystems(i), ierr) +! end do + + end subroutine shr_pio_finalize + +!=============================================================================== + function shr_pio_getiotype_fromid(compid) result(io_type) + integer, intent(in) :: compid + integer :: io_type + + io_type = pio_comp_settings(shr_pio_getindex(compid))%pio_iotype + + end function shr_pio_getiotype_fromid + + + function shr_pio_getiotype_fromname(component) result(io_type) + ! 'component' must be equal to some element of io_compname(:) + ! (but it is case-insensitive) + character(len=*), intent(in) :: component + integer :: io_type + + io_type = pio_comp_settings(shr_pio_getindex(component))%pio_iotype + + end function shr_pio_getiotype_fromname + + function shr_pio_getrearranger_fromid(compid) result(io_type) + integer, intent(in) :: compid + integer :: io_type + + io_type = pio_comp_settings(shr_pio_getindex(compid))%pio_rearranger + + end function shr_pio_getrearranger_fromid + + + function shr_pio_getrearranger_fromname(component) result(io_type) + ! 'component' must be equal to some element of io_compname(:) + ! (but it is case-insensitive) + character(len=*), intent(in) :: component + integer :: io_type + + io_type = pio_comp_settings(shr_pio_getindex(component))%pio_rearranger + + end function shr_pio_getrearranger_fromname + + function shr_pio_getioformat_fromid(compid) result(io_format) + integer, intent(in) :: compid + integer :: io_format + + io_format = pio_comp_settings(shr_pio_getindex(compid))%pio_netcdf_ioformat + + end function shr_pio_getioformat_fromid + + + function shr_pio_getioformat_fromname(component) result(io_format) + ! 'component' must be equal to some element of io_compname(:) + ! (but it is case-insensitive) + character(len=*), intent(in) :: component + integer :: io_format + + io_format = pio_comp_settings(shr_pio_getindex(component))%pio_netcdf_ioformat + + end function shr_pio_getioformat_fromname + +!=============================================================================== + function shr_pio_getioroot_fromid(compid) result(io_root) + ! 'component' must be equal to some element of io_compname(:) + ! (but it is case-insensitive) + integer, intent(in) :: compid + integer :: io_root + + io_root = pio_comp_settings(shr_pio_getindex(compid))%pio_root + + end function shr_pio_getioroot_fromid + + function shr_pio_getioroot_fromname(component) result(io_root) + ! 'component' must be equal to some element of io_compname(:) + ! (but it is case-insensitive) + character(len=*), intent(in) :: component + integer :: io_root + + io_root = pio_comp_settings(shr_pio_getindex(component))%pio_root + + + end function shr_pio_getioroot_fromname + + +!=============================================================================== + + !! Given a component name, return the index of that component. + !! This is the index into io_compid, io_compname, comp_pio_iotype, etc. + !! If the given component is not found, return -1 + + integer function shr_pio_getindex_fromid(compid) result(index) + implicit none + integer, intent(in) :: compid + integer :: i + + index = -1 + do i=1,total_comps + if(io_compid(i)==compid) then + index = i + exit + end if + end do + + if(index<0) then + call shr_sys_abort('shr_pio_getindex :: compid out of allowed range') + end if + end function shr_pio_getindex_fromid + + + integer function shr_pio_getindex_fromname(component) result(index) + use shr_string_mod, only : shr_string_toupper + + implicit none + + ! 'component' must be equal to some element of io_compname(:) + ! (but it is case-insensitive) + character(len=*), intent(in) :: component + + character(len=len(component)) :: component_ucase + integer :: i + + ! convert component name to upper case in order to match case in io_compname + component_ucase = shr_string_toUpper(component) + + index = -1 ! flag for not found + do i=1,size(io_compname) + if (trim(component_ucase) == trim(io_compname(i))) then + index = i + exit + end if + end do + if(index<0) then + call shr_sys_abort(' shr_pio_getindex:: compid out of allowed range') + end if + end function shr_pio_getindex_fromname + + function shr_pio_getiosys_fromid(compid) result(iosystem) + ! 'component' must be equal to some element of io_compname(:) + ! (but it is case-insensitive) + integer, intent(in) :: compid + type(iosystem_desc_t), pointer :: iosystem + + + iosystem => iosystems(shr_pio_getindex(compid)) + + end function shr_pio_getiosys_fromid + + function shr_pio_getiosys_fromname(component) result(iosystem) + ! 'component' must be equal to some element of io_compname(:) + ! (but it is case-insensitive) + character(len=*), intent(in) :: component + type(iosystem_desc_t), pointer :: iosystem + + iosystem => iosystems(shr_pio_getindex(component)) + + end function shr_pio_getiosys_fromname + +!=============================================================================== + + + + subroutine shr_pio_read_default_namelist(nlfilename, Comm, pio_stride, pio_root, pio_numiotasks, & + pio_iotype, pio_async_interface, pio_rearranger) + + character(len=*), intent(in) :: nlfilename + integer, intent(in) :: Comm + logical, intent(out) :: pio_async_interface + integer, intent(out) :: pio_stride, pio_root, pio_numiotasks, pio_iotype, pio_rearranger + + character(len=shr_kind_cs) :: pio_typename + character(len=shr_kind_cs) :: pio_rearr_comm_type, pio_rearr_comm_fcd + integer :: pio_netcdf_ioformat + integer :: pio_rearr_comm_max_pend_req_comp2io + logical :: pio_rearr_comm_enable_hs_comp2io, pio_rearr_comm_enable_isend_comp2io + integer :: pio_rearr_comm_max_pend_req_io2comp + logical :: pio_rearr_comm_enable_hs_io2comp, pio_rearr_comm_enable_isend_io2comp + character(*),parameter :: subName = '(shr_pio_read_default_namelist) ' + + integer :: iam, ierr, npes, unitn + logical :: iamroot + namelist /pio_default_inparm/ & + pio_async_interface, pio_debug_level, pio_blocksize, & + pio_buffer_size_limit, pio_root, pio_numiotasks, pio_stride, & + pio_rearr_comm_type, pio_rearr_comm_fcd, & + pio_rearr_comm_max_pend_req_comp2io, pio_rearr_comm_enable_hs_comp2io, & + pio_rearr_comm_enable_isend_comp2io, & + pio_rearr_comm_max_pend_req_io2comp, pio_rearr_comm_enable_hs_io2comp, & + pio_rearr_comm_enable_isend_io2comp + + + call mpi_comm_rank(Comm, iam , ierr) + call shr_mpi_chkerr(ierr,subname//' mpi_comm_rank comm_world') + call mpi_comm_size(Comm, npes, ierr) + call shr_mpi_chkerr(ierr,subname//' mpi_comm_size comm_world') + + if(iam==0) then + iamroot=.true. + else + iamroot=.false. + end if + + !-------------------------------------------------------------------------- + ! read io nml parameters + !-------------------------------------------------------------------------- + pio_stride = -99 ! set based on pio_numiotasks value when initialized < 0 + pio_numiotasks = -99 ! set based on pio_stride value when initialized < 0 + pio_root = -99 + pio_typename = 'nothing' + pio_blocksize= -99 ! io blocking size set internally in pio when < 0 + pio_buffer_size_limit = -99 ! io task memory buffer maximum set internally in pio when < 0 + pio_debug_level = 0 ! no debug info by default + pio_async_interface = .false. ! pio tasks are a subset of component tasks + pio_rearranger = PIO_REARR_SUBSET + pio_netcdf_ioformat = PIO_64BIT_OFFSET + pio_rearr_comm_type = 'p2p' + pio_rearr_comm_fcd = '2denable' + pio_rearr_comm_max_pend_req_comp2io = 0 + pio_rearr_comm_enable_hs_comp2io = .true. + pio_rearr_comm_enable_isend_comp2io = .false. + pio_rearr_comm_max_pend_req_io2comp = 0 + pio_rearr_comm_enable_hs_io2comp = .true. + pio_rearr_comm_enable_isend_io2comp = .false. + + if(iamroot) then + unitn=shr_file_getunit() + open( unitn, file=trim(nlfilename), status='old' , iostat=ierr) + if(ierr/=0) then + write(shr_log_unit,*) 'File ',trim(nlfilename),' not found, setting default values.' + else + ierr = 1 + do while( ierr /= 0 ) + read(unitn,nml=pio_default_inparm,iostat=ierr) + if (ierr < 0) then + call shr_sys_abort( subname//':: namelist read returns an'// & + ' end of file or end of record condition '//trim(nlfilename) ) + end if + end do + close(unitn) + call shr_file_freeUnit( unitn ) + + call shr_pio_getiotypefromname(pio_typename, pio_iotype, pio_iotype_netcdf) + end if + end if + + call shr_pio_namelist_set(npes, Comm, pio_stride, pio_root, pio_numiotasks, pio_iotype, & + iamroot, pio_rearranger, pio_netcdf_ioformat) + call shr_mpi_bcast(pio_debug_level, Comm) + call shr_mpi_bcast(pio_root, Comm) + call shr_mpi_bcast(pio_numiotasks, Comm) + call shr_mpi_bcast(pio_blocksize, Comm) + call shr_mpi_bcast(pio_buffer_size_limit, Comm) + call shr_mpi_bcast(pio_async_interface, Comm) + call shr_mpi_bcast(pio_rearranger, Comm) + call shr_mpi_bcast(pio_stride, Comm) + if (npes == 1) then + pio_rearr_comm_max_pend_req_comp2io = 0 + pio_rearr_comm_max_pend_req_io2comp = 0 + endif + + + call shr_pio_rearr_opts_set(Comm, pio_rearr_comm_type, pio_rearr_comm_fcd, & + pio_rearr_comm_max_pend_req_comp2io, pio_rearr_comm_enable_hs_comp2io, & + pio_rearr_comm_enable_isend_comp2io, & + pio_rearr_comm_max_pend_req_io2comp, pio_rearr_comm_enable_hs_io2comp, & + pio_rearr_comm_enable_isend_io2comp, pio_numiotasks) + + end subroutine shr_pio_read_default_namelist + + subroutine shr_pio_read_component_namelist(nlfilename, Comm, pio_stride, pio_root, & + pio_numiotasks, pio_iotype, pio_rearranger, pio_netcdf_ioformat) + character(len=*), intent(in) :: nlfilename + integer, intent(in) :: Comm + + integer, intent(inout) :: pio_stride, pio_root, pio_numiotasks + integer, intent(inout) :: pio_iotype, pio_rearranger, pio_netcdf_ioformat + character(len=SHR_KIND_CS) :: pio_typename + character(len=SHR_KIND_CS) :: pio_netcdf_format + integer :: unitn + + integer :: iam, ierr, npes + logical :: iamroot + character(*),parameter :: subName = '(shr_pio_read_component_namelist) ' + integer :: pio_default_stride, pio_default_root, pio_default_numiotasks, pio_default_iotype + integer :: pio_default_rearranger, pio_default_netcdf_ioformat + + namelist /pio_inparm/ pio_stride, pio_root, pio_numiotasks, & + pio_typename, pio_rearranger, pio_netcdf_format + + + + call mpi_comm_rank(Comm, iam , ierr) + call shr_mpi_chkerr(ierr,subname//' mpi_comm_rank comm_world') + call mpi_comm_size(Comm, npes, ierr) + call shr_mpi_chkerr(ierr,subname//' mpi_comm_size comm_world') + + if(iam==0) then + iamroot=.true. + else + iamroot=.false. + end if + + pio_default_stride = pio_stride + pio_default_root = pio_root + pio_default_numiotasks = pio_numiotasks + pio_default_iotype = pio_iotype + pio_default_rearranger = pio_rearranger + pio_default_netcdf_ioformat = PIO_64BIT_DATA + + !-------------------------------------------------------------------------- + ! read io nml parameters + !-------------------------------------------------------------------------- + pio_stride = -99 ! set based on pio_numiotasks value when initialized < 0 + pio_numiotasks = -99 ! set based on pio_stride value when initialized < 0 + pio_root = -99 + pio_typename = 'nothing' + pio_rearranger = -99 + pio_netcdf_format = '64bit_offset' + + if(iamroot) then + unitn=shr_file_getunit() + open( unitn, file=trim(nlfilename), status='old' , iostat=ierr) + if( ierr /= 0) then + write(shr_log_unit,*) 'No ',trim(nlfilename),' found, using defaults for pio settings' + pio_stride = pio_default_stride + pio_root = pio_default_root + pio_numiotasks = pio_default_numiotasks + pio_iotype = pio_default_iotype + pio_rearranger = pio_default_rearranger + pio_netcdf_ioformat = pio_default_netcdf_ioformat + else + ierr = 1 + do while( ierr /= 0 ) + read(unitn,nml=pio_inparm,iostat=ierr) + if (ierr < 0) then + call shr_sys_abort( subname//':: namelist read returns an'// & + ' end of file or end of record condition' ) + end if + end do + close(unitn) + call shr_file_freeUnit( unitn ) + + call shr_pio_getiotypefromname(pio_typename, pio_iotype, pio_default_iotype) + call shr_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, pio_default_netcdf_ioformat) + end if + if(pio_stride== -99) then + if (pio_numiotasks > 0) then + pio_stride = npes/pio_numiotasks + else + pio_stride = pio_default_stride + endif + endif + if(pio_root == -99) pio_root = pio_default_root + if(pio_rearranger == -99) pio_rearranger = pio_default_rearranger + if(pio_numiotasks == -99) then + pio_numiotasks = npes/pio_stride + endif + endif + + + + call shr_pio_namelist_set(npes, Comm, pio_stride, pio_root, pio_numiotasks, pio_iotype, & + iamroot, pio_rearranger, pio_netcdf_ioformat) + + + end subroutine shr_pio_read_component_namelist + + subroutine shr_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, pio_default_netcdf_ioformat) + use shr_string_mod, only : shr_string_toupper + character(len=*), intent(inout) :: pio_netcdf_format + integer, intent(out) :: pio_netcdf_ioformat + integer, intent(in) :: pio_default_netcdf_ioformat + + pio_netcdf_format = shr_string_toupper(pio_netcdf_format) + if ( pio_netcdf_format .eq. 'CLASSIC' ) then + pio_netcdf_ioformat = 0 + elseif ( pio_netcdf_format .eq. '64BIT_OFFSET' ) then + pio_netcdf_ioformat = PIO_64BIT_OFFSET + elseif ( pio_netcdf_format .eq. '64BIT_DATA' ) then + pio_netcdf_ioformat = PIO_64BIT_DATA + else + pio_netcdf_ioformat = pio_default_netcdf_ioformat + endif + + end subroutine shr_pio_getioformatfromname + + + subroutine shr_pio_getiotypefromname(typename, iotype, defaulttype) + use shr_string_mod, only : shr_string_toupper + character(len=*), intent(inout) :: typename + integer, intent(out) :: iotype + integer, intent(in) :: defaulttype + + typename = shr_string_toupper(typename) + if ( typename .eq. 'NETCDF' ) then + iotype = pio_iotype_netcdf + else if ( typename .eq. 'PNETCDF') then + iotype = pio_iotype_pnetcdf + else if ( typename .eq. 'NETCDF4P') then + iotype = pio_iotype_netcdf4p + else if ( typename .eq. 'NETCDF4C') then + iotype = pio_iotype_netcdf4c + else if ( typename .eq. 'NOTHING') then + iotype = defaulttype + else if ( typename .eq. 'DEFAULT') then + iotype = defaulttype + else + write(shr_log_unit,*) 'shr_pio_mod: WARNING Bad io_type argument - using iotype_netcdf' + iotype=pio_iotype_netcdf + end if + + end subroutine shr_pio_getiotypefromname + +!=============================================================================== + subroutine shr_pio_namelist_set(npes,mycomm, pio_stride, pio_root, pio_numiotasks, & + pio_iotype, iamroot, pio_rearranger, pio_netcdf_ioformat) + integer, intent(in) :: npes, mycomm + integer, intent(inout) :: pio_stride, pio_root, pio_numiotasks + integer, intent(inout) :: pio_iotype, pio_rearranger, pio_netcdf_ioformat + logical, intent(in) :: iamroot + character(*),parameter :: subName = '(shr_pio_namelist_set) ' + + call shr_mpi_bcast(pio_iotype , mycomm) + call shr_mpi_bcast(pio_stride , mycomm) + call shr_mpi_bcast(pio_root , mycomm) + call shr_mpi_bcast(pio_numiotasks, mycomm) + call shr_mpi_bcast(pio_rearranger, mycomm) + call shr_mpi_bcast(pio_netcdf_ioformat, mycomm) + + if (pio_root<0) then + pio_root = 1 + endif + if(.not. pio_async_interface) then + pio_root = min(pio_root,npes-1) +! If you are asking for parallel IO then you should use at least two io pes + if(npes > 1 .and. pio_numiotasks == 1 .and. & + (pio_iotype .eq. PIO_IOTYPE_PNETCDF .or. & + pio_iotype .eq. PIO_IOTYPE_NETCDF4P)) then + pio_numiotasks = 2 + pio_stride = min(pio_stride, npes/2) + endif + endif + + !-------------------------------------------------------------------------- + ! check/set/correct io pio parameters + !-------------------------------------------------------------------------- + if (pio_stride>0.and.pio_numiotasks<0) then + pio_numiotasks = max(1,npes/pio_stride) + else if(pio_numiotasks>0 .and. pio_stride<0) then + pio_stride = max(1,npes/pio_numiotasks) + else if(pio_numiotasks<0 .and. pio_stride<0) then + pio_stride = max(1,npes/4) + pio_numiotasks = max(1,npes/pio_stride) + end if + if(pio_stride == 1 .and. .not. pio_async_interface) then + pio_root = 0 + endif + if(pio_rearranger .ne. PIO_REARR_SUBSET .and. pio_rearranger .ne. PIO_REARR_BOX) then + write(shr_log_unit,*) 'pio_rearranger value, ',pio_rearranger,& + ', not supported - using PIO_REARR_BOX' + pio_rearranger = PIO_REARR_BOX + + endif + + + if (.not. pio_async_interface .and. & + pio_root + (pio_stride)*(pio_numiotasks-1) >= npes .or. & + pio_stride<=0 .or. pio_numiotasks<=0 .or. pio_root < 0 .or. & + pio_root > npes-1 ) then + if(npes<100) then + pio_stride = max(1,npes/4) + else if(npes<1000) then + pio_stride = max(1,npes/8) + else + pio_stride = max(1,npes/16) + end if + if(pio_stride>1) then + pio_numiotasks = npes/pio_stride + pio_root = min(1,npes-1) + else + pio_numiotasks = npes + pio_root = 0 + end if + if( iamroot) then + write(shr_log_unit,*) 'pio_stride, iotasks or root out of bounds - resetting to defaults: ',& + pio_stride,pio_numiotasks, pio_root + end if + end if + + end subroutine shr_pio_namelist_set + + ! This subroutine sets the global PIO rearranger options + ! The input args that represent the rearranger options are valid only + ! on the root proc of comm + ! The rearranger options are passed to PIO_Init() in shr_pio_init2() + subroutine shr_pio_rearr_opts_set(comm, pio_rearr_comm_type, pio_rearr_comm_fcd, & + pio_rearr_comm_max_pend_req_comp2io, pio_rearr_comm_enable_hs_comp2io, & + pio_rearr_comm_enable_isend_comp2io, & + pio_rearr_comm_max_pend_req_io2comp, pio_rearr_comm_enable_hs_io2comp, & + pio_rearr_comm_enable_isend_io2comp, & + pio_numiotasks) + integer(SHR_KIND_IN), intent(in) :: comm + character(len=shr_kind_cs), intent(in) :: pio_rearr_comm_type, pio_rearr_comm_fcd + integer, intent(in) :: pio_rearr_comm_max_pend_req_comp2io + logical, intent(in) :: pio_rearr_comm_enable_hs_comp2io + logical, intent(in) :: pio_rearr_comm_enable_isend_comp2io + integer, intent(in) :: pio_rearr_comm_max_pend_req_io2comp + logical, intent(in) :: pio_rearr_comm_enable_hs_io2comp + logical, intent(in) :: pio_rearr_comm_enable_isend_io2comp + integer, intent(in) :: pio_numiotasks + + character(*), parameter :: subname = '(shr_pio_rearr_opts_set) ' + integer, parameter :: NUM_REARR_COMM_OPTS = 8 + integer, parameter :: PIO_REARR_COMM_DEF_MAX_PEND_REQ = 64 + ! Automatically reset if the number of maximum pending requests is set to 0 + integer, parameter :: REARR_COMM_DEF_MAX_PEND_REQ_RESET = 0 + integer(SHR_KIND_IN), dimension(NUM_REARR_COMM_OPTS) :: buf + integer :: rank, ierr + + call mpi_comm_rank(comm, rank, ierr) + call shr_mpi_chkerr(ierr,subname//' mpi_comm_rank comm_world') + + buf = 0 + ! buf(1) = comm_type + ! buf(2) = comm_fcd + ! buf(3) = max_pend_req_comp2io + ! buf(4) = enable_hs_comp2io + ! buf(5) = enable_isend_comp2io + ! buf(6) = max_pend_req_io2comp + ! buf(7) = enable_hs_io2comp + ! buf(8) = enable_isend_io2comp + if(rank == 0) then + ! buf(1) = comm_type + select case(pio_rearr_comm_type) + case ("p2p") + case ("default") + buf(1) = pio_rearr_comm_p2p + case ("coll") + buf(1) = pio_rearr_comm_coll + case default + write(shr_log_unit,*) "Invalid PIO rearranger comm type, ", pio_rearr_comm_type + write(shr_log_unit,*) "Resetting PIO rearrange comm type to p2p" + buf(1) = pio_rearr_comm_p2p + end select + + ! buf(2) = comm_fcd + select case(pio_rearr_comm_fcd) + case ("2denable") + case ("default") + buf(2) = pio_rearr_comm_fc_2d_enable + case ("io2comp") + buf(2) = pio_rearr_comm_fc_1d_io2comp + case ("comp2io") + buf(2) = pio_rearr_comm_fc_1d_comp2io + case ("disable") + buf(2) = pio_rearr_comm_fc_2d_disable + case default + write(shr_log_unit,*) "Invalid PIO rearranger comm flow control direction, ", pio_rearr_comm_fcd + write(shr_log_unit,*) "Resetting PIO rearrange comm flow control direction to 2denable" + buf(2) = pio_rearr_comm_fc_2d_enable + end select + + ! buf(3) = max_pend_req_comp2io + if((pio_rearr_comm_max_pend_req_comp2io <= 0) .and. & + (pio_rearr_comm_max_pend_req_comp2io /= PIO_REARR_COMM_UNLIMITED_PEND_REQ)) then + + if(pio_rearr_comm_max_pend_req_comp2io /= REARR_COMM_DEF_MAX_PEND_REQ_RESET) then + write(shr_log_unit, *) "Invalid PIO rearranger comm max pend req (comp2io), ",& + pio_rearr_comm_max_pend_req_comp2io + else + write(shr_log_unit, *) "User-specified PIO rearranger comm max pend req (comp2io), ",& + pio_rearr_comm_max_pend_req_comp2io, " (value will be reset as requested) " + end if + + ! Small multiple of pio_numiotasks has proven to perform + ! well empirically, and we do not want to allow maximum for + ! very large process count runs. Can improve this by + ! communicating between iotasks first, and then non-iotasks + ! to iotasks (TO DO) + write(shr_log_unit, *) "Resetting PIO rearranger comm max pend req (comp2io) to ", & + max(PIO_REARR_COMM_DEF_MAX_PEND_REQ, 2 * pio_numiotasks) + buf(3) = max(PIO_REARR_COMM_DEF_MAX_PEND_REQ, 2 * pio_numiotasks) + else + buf(3) = pio_rearr_comm_max_pend_req_comp2io + end if + + ! buf(4) = enable_hs_comp2io + if(pio_rearr_comm_enable_hs_comp2io) then + buf(4) = 1 + else + buf(4) = 0 + end if + + ! buf(5) = enable_isend_comp2io + if(pio_rearr_comm_enable_isend_comp2io) then + buf(5) = 1 + else + buf(5) = 0 + end if + + ! buf(6) = max_pend_req_io2comp + if((pio_rearr_comm_max_pend_req_io2comp <= 0) .and. & + (pio_rearr_comm_max_pend_req_io2comp /= PIO_REARR_COMM_UNLIMITED_PEND_REQ)) then + + if(pio_rearr_comm_max_pend_req_io2comp /= REARR_COMM_DEF_MAX_PEND_REQ_RESET) then + write(shr_log_unit, *) "Invalid PIO rearranger comm max pend req (io2comp), ",& + pio_rearr_comm_max_pend_req_io2comp + else + write(shr_log_unit, *) "User-specified PIO rearranger comm max pend req (io2comp), ",& + pio_rearr_comm_max_pend_req_io2comp, " (value will be reset as requested) " + end if + + write(shr_log_unit, *) "Resetting PIO rearranger comm max pend req (io2comp) to ", PIO_REARR_COMM_DEF_MAX_PEND_REQ + buf(6) = PIO_REARR_COMM_DEF_MAX_PEND_REQ + else + buf(6) = pio_rearr_comm_max_pend_req_io2comp + end if + + ! buf(7) = enable_hs_io2comp + if(pio_rearr_comm_enable_hs_io2comp) then + buf(7) = 1 + else + buf(7) = 0 + end if + + ! buf(8) = enable_isend_io2comp + if(pio_rearr_comm_enable_isend_io2comp) then + buf(8) = 1 + else + buf(8) = 0 + end if + + end if + + call shr_mpi_bcast(buf, comm) + + ! buf(1) = comm_type + ! buf(2) = comm_fcd + ! buf(3) = max_pend_req_comp2io + ! buf(4) = enable_hs_comp2io + ! buf(5) = enable_isend_comp2io + ! buf(6) = max_pend_req_io2comp + ! buf(7) = enable_hs_io2comp + ! buf(8) = enable_isend_io2comp + pio_rearr_opt_comm_type = buf(1) + pio_rearr_opt_fcd = buf(2) + pio_rearr_opt_c2i_max_pend_req = buf(3) + if(buf(4) == 0) then + pio_rearr_opt_c2i_enable_hs = .false. + else + pio_rearr_opt_c2i_enable_hs = .true. + end if + if(buf(5) == 0) then + pio_rearr_opt_c2i_enable_isend = .false. + else + pio_rearr_opt_c2i_enable_isend = .true. + end if + pio_rearr_opt_i2c_max_pend_req = buf(6) + if(buf(7) == 0) then + pio_rearr_opt_i2c_enable_hs = .false. + else + pio_rearr_opt_i2c_enable_hs = .true. + end if + if(buf(8) == 0) then + pio_rearr_opt_i2c_enable_isend = .false. + else + pio_rearr_opt_i2c_enable_isend = .true. + end if + + if(rank == 0) then + ! Log the rearranger options + write(shr_log_unit, *) "PIO rearranger options:" + write(shr_log_unit, *) " comm type = ", trim(pio_rearr_comm_type) + write(shr_log_unit, *) " comm fcd = ", trim(pio_rearr_comm_fcd) + if(pio_rearr_opt_c2i_max_pend_req == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + write(shr_log_unit, *) " max pend req (comp2io) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" + else + write(shr_log_unit, *) " max pend req (comp2io) = ", pio_rearr_opt_c2i_max_pend_req + end if + write(shr_log_unit, *) " enable_hs (comp2io) = ", pio_rearr_opt_c2i_enable_hs + write(shr_log_unit, *) " enable_isend (comp2io) = ", pio_rearr_opt_c2i_enable_isend + if(pio_rearr_opt_i2c_max_pend_req == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + write(shr_log_unit, *) " max pend req (io2comp) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" + else + write(shr_log_unit, *) " max pend req (io2comp) = ", pio_rearr_opt_i2c_max_pend_req + end if + write(shr_log_unit, *) " enable_hs (io2comp) = ", pio_rearr_opt_i2c_enable_hs + write(shr_log_unit, *) " enable_isend (io2comp) = ", pio_rearr_opt_i2c_enable_isend + end if + end subroutine +!=============================================================================== + +end module shr_pio_mod From a3e3f8752a4d9812b7413e90ab0313ba3c562c2a Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 18 Feb 2022 16:19:38 -0700 Subject: [PATCH 037/395] ongoing work --- cesm/driver/esm.F90 | 11 +- cesm/nuopc_cap_share/shr_pio_mod.F90 | 482 +++++++++------------------ cime_config/buildnml | 20 +- 3 files changed, 167 insertions(+), 346 deletions(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index dfc74fadc..c1eebd065 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -807,7 +807,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) use mpi , only : MPI_COMM_NULL, mpi_comm_size #endif use mct_mod , only : mct_world_init - use shr_pio_mod , only : shr_pio_init + use shr_pio_mod , only : shr_pio_init, shr_pio_component_init #ifdef MED_PRESENT use med_internalstate_mod , only : med_id @@ -931,6 +931,10 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) inst_suffix = "" endif + ! Initialize PIO + call shr_pio_init(driver, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(comms(componentCount+1), comps(componentCount+1)) comps(1) = 1 comms = MPI_COMM_NULL @@ -1175,11 +1179,12 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) enddo + call shr_pio_component_init(driver, size(comps), rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Initialize MCT (this is needed for data models and cice prescribed capability) call mct_world_init(componentCount+1, GLOBAL_COMM, comms, comps) - ! Initialize PIO - call shr_pio_init(driver, size(comps)) deallocate(petlist, comms, comps, comp_iamin, comp_comm_iam) diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/shr_pio_mod.F90 index 820093c0f..159322c0a 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/shr_pio_mod.F90 @@ -15,6 +15,7 @@ module shr_pio_mod #endif private public :: shr_pio_init + public :: shr_pio_component_init public :: shr_pio_getiosys public :: shr_pio_getiotype public :: shr_pio_getioroot @@ -49,6 +50,7 @@ module shr_pio_mod integer :: pio_iotype integer :: pio_rearranger integer :: pio_netcdf_ioformat + logical :: pio_async_interface end type pio_comp_t character(len=16), allocatable :: io_compname(:) @@ -59,11 +61,13 @@ module shr_pio_mod integer, allocatable :: io_compid(:) integer :: pio_debug_level=0, pio_blocksize=0 integer(kind=pio_offset_kind) :: pio_buffer_size_limit=-1 - integer :: pio_rearr_opt_comm_type, pio_rearr_opt_fcd - logical :: pio_rearr_opt_c2i_enable_hs, pio_rearr_opt_c2i_enable_isend - integer :: pio_rearr_opt_c2i_max_pend_req - logical :: pio_rearr_opt_i2c_enable_hs, pio_rearr_opt_i2c_enable_isend - integer :: pio_rearr_opt_i2c_max_pend_req + + character(len=shr_kind_cs) :: pio_rearr_comm_type, pio_rearr_comm_fcd + integer :: pio_rearr_comm_max_pend_req_comp2io + logical :: pio_rearr_comm_enable_hs_comp2io, pio_rearr_comm_enable_isend_comp2io + integer :: pio_rearr_comm_max_pend_req_io2comp + logical :: pio_rearr_comm_enable_hs_io2comp, pio_rearr_comm_enable_isend_io2comp + integer :: total_comps logical :: mastertask #define DEBUGI 1 @@ -87,18 +91,18 @@ module shr_pio_mod !! !< - subroutine shr_pio_init(driver, total_comps) + subroutine shr_pio_init(driver, rc) use ESMF, only : ESMF_GridComp, ESMF_VM, ESMF_Config, ESMF_GridCompGet use ESMF, only : ESMF_VMGet use NUOPC, only: NUOPC_CompAttributeGet use shr_string_mod, only : shr_string_toLower type(ESMF_GridComp) :: driver - integer, intent(in) :: total_comps + integer, intent(out) :: rc type(ESMF_VM) :: vm integer :: i character(len=shr_kind_cl) :: nlfilename, cname - integer :: ret, rc + integer :: ret integer :: localPet character(*), parameter :: subName = '(shr_pio_init) ' @@ -119,72 +123,162 @@ subroutine shr_pio_init(driver, total_comps) call pio_set_buffer_size_limit(pio_buffer_size_limit) endif - call NUOPC_CompAttributeGet(driver, name="pio_blocksize", value=pio_blocksize, rc=rc) + call NUOPC_CompAttributeGet(driver, name="pio_blocksize", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + read(cname, *) pio_blocksize + if(pio_blocksize>0) then if(mastertask) write(shr_log_unit,*) 'Setting pio_blocksize : ',pio_blocksize call pio_set_blocksize(pio_blocksize) endif - allocate(iosystems(total_comps)) -#ifdef DOTHIS - do i=1,total_comps + call NUOPC_CompAttributeGet(driver, name="pio_debug_level", value=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cname, *) pio_debug_level - if(comp_iamin(i)) then - cname = comp_name(i) - if(len_trim(cname) <= 3) then - nlfilename=trim(shr_string_toLower(cname))//'_modelio.nml' - else - nlfilename=trim(shr_string_toLower(cname(1:3)))//'_modelio.nml_'//cname(4:8) - endif - - call shr_pio_read_component_namelist(nlfilename , comp_comm(i), pio_comp_settings(i)%pio_stride, & - pio_comp_settings(i)%pio_root, pio_comp_settings(i)%pio_numiotasks, & - pio_comp_settings(i)%pio_iotype, pio_comp_settings(i)%pio_rearranger, & - pio_comp_settings(i)%pio_netcdf_ioformat) - - call pio_init(comp_comm_iam(i), comp_comm(i), pio_comp_settings(i)%pio_numiotasks, 0, & - pio_comp_settings(i)%pio_stride, & - pio_comp_settings(i)%pio_rearranger, iosystems(i), & - base=pio_comp_settings(i)%pio_root) - ret = pio_set_rearr_opts(iosystems(i), pio_rearr_opt_comm_type,& - pio_rearr_opt_fcd,& - pio_rearr_opt_c2i_enable_hs, pio_rearr_opt_c2i_enable_isend,& - pio_rearr_opt_c2i_max_pend_req,& - pio_rearr_opt_i2c_enable_hs, pio_rearr_opt_i2c_enable_isend,& - pio_rearr_opt_i2c_max_pend_req) - if(ret /= PIO_NOERR) then - write(shr_log_unit,*) "ERROR: Setting rearranger options failed" - end if - end if - end do + if(pio_debug_level > 0) then + if(mastertask) write(shr_log_unit,*) 'Setting pio_debug_level : ',pio_debug_level + ret = pio_set_log_level(pio_debug_level) + endif + + call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_type", value=pio_rearr_comm_type, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_fcd", value=pio_rearr_comm_fcd, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_hs_comp2io", value=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(io_compid(total_comps), io_compname(total_comps)) + pio_rearr_comm_enable_hs_comp2io = (trim(cname) .eq. '.true.') - io_compid = comp_id - io_compname = comp_name - do i=1,total_comps - if(comp_iamin(i) .and. (comp_comm_iam(i) == 0)) then - write(shr_log_unit,*) io_compname(i),' : pio_numiotasks = ',pio_comp_settings(i)%pio_numiotasks - write(shr_log_unit,*) io_compname(i),' : pio_stride = ',pio_comp_settings(i)%pio_stride - write(shr_log_unit,*) io_compname(i),' : pio_rearranger = ',pio_comp_settings(i)%pio_rearranger - write(shr_log_unit,*) io_compname(i),' : pio_root = ',pio_comp_settings(i)%pio_root - write(shr_log_unit,*) io_compname(i),' : pio_iotype = ',pio_comp_settings(i)%pio_iotype + call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_hs_io2comp", value=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + pio_rearr_comm_enable_hs_io2comp = (trim(cname) .eq. '.true.') + + call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_isend_comp2io", value=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + pio_rearr_comm_enable_isend_comp2io = (trim(cname) .eq. '.true.') + + call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_isend_io2comp", value=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + pio_rearr_comm_enable_isend_io2comp = (trim(cname) .eq. '.true.') + + call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_max_pend_req_comp2io", value=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cname, *) pio_rearr_comm_max_pend_req_comp2io + + call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_max_pend_req_io2comp", value=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cname, *) pio_rearr_comm_max_pend_req_io2comp + + if(mastertask) then + ! Log the rearranger options + write(shr_log_unit, *) "PIO rearranger options:" + write(shr_log_unit, *) " comm type = ", trim(pio_rearr_comm_type) + write(shr_log_unit, *) " comm fcd = ", trim(pio_rearr_comm_fcd) + if(pio_rearr_comm_max_pend_req_comp2io == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + write(shr_log_unit, *) " max pend req (comp2io) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" + else + write(shr_log_unit, *) " max pend req (comp2io) = ", pio_rearr_comm_max_pend_req_comp2io end if - enddo -#endif + write(shr_log_unit, *) " enable_hs (comp2io) = ", pio_rearr_comm_enable_hs_comp2io + write(shr_log_unit, *) " enable_isend (comp2io) = ", pio_rearr_comm_enable_isend_comp2io + if(pio_rearr_comm_max_pend_req_io2comp == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + write(shr_log_unit, *) " max pend req (io2comp) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" + else + write(shr_log_unit, *) " max pend req (io2comp) = ", pio_rearr_comm_max_pend_req_io2comp + end if + write(shr_log_unit, *) " enable_hs (io2comp) = ", pio_rearr_comm_enable_hs_io2comp + write(shr_log_unit, *) " enable_isend (io2comp) = ", pio_rearr_comm_enable_isend_io2comp + end if + end subroutine shr_pio_init + subroutine shr_pio_component_init(driver, ncomps, rc) + use ESMF, only : ESMF_GridComp, ESMF_LogSetError, ESMF_RC_NOT_VALID, ESMF_GridCompIsCreated + use NUOPC, only : NUOPC_CompAttributeGet + use NUOPC_Driver, only : NUOPC_DriverGetComp + use shr_kind_mod, only : CS=>shr_kind_cs + + type(ESMF_GridComp) :: driver + integer, intent(in) :: ncomps + integer, intent(out) :: rc + + integer :: i + type(ESMF_GridComp), pointer :: gcomp(:) + character(CS) :: cval + character(CS) :: msgstr + allocate(pio_comp_settings(ncomps)) + allocate(gcomp(ncomps)) + nullify(gcomp) + + call NUOPC_DriverGetComp(driver, compList=gcomp, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + total_comps = ncomps + + do i=1,ncomps + if (ESMF_GridCompIsCreated(gcomp(i), rc=rc)) then + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_stride", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_stride + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_rearranger", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_rearranger + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_numiotasks", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_numiotasks + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_root", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_root + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_typename", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + select case (trim(cval)) + case ('pnetcdf') + pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_PNETCDF + case ('netcdf') + pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF + case ('netcdf4p') + pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF4P + case ('netcdf4c') + pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF4C + case DEFAULT + write (msgstr, *) "Invalid PIO_TYPENAME Setting for component ", trim(cval) + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return + end select + + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + pio_comp_settings(i)%pio_async_interface = (trim(cval) == '.true.') + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_netcdf_format", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) + endif + enddo + deallocate(gcomp) + end subroutine shr_pio_component_init !=============================================================================== subroutine shr_pio_finalize( ) integer :: ierr integer :: i -! do i=1,total_comps + do i=1,total_comps call pio_finalize(iosystems(i), ierr) -! end do + end do end subroutine shr_pio_finalize @@ -342,116 +436,6 @@ function shr_pio_getiosys_fromname(component) result(iosystem) end function shr_pio_getiosys_fromname -!=============================================================================== - - - - subroutine shr_pio_read_default_namelist(nlfilename, Comm, pio_stride, pio_root, pio_numiotasks, & - pio_iotype, pio_async_interface, pio_rearranger) - - character(len=*), intent(in) :: nlfilename - integer, intent(in) :: Comm - logical, intent(out) :: pio_async_interface - integer, intent(out) :: pio_stride, pio_root, pio_numiotasks, pio_iotype, pio_rearranger - - character(len=shr_kind_cs) :: pio_typename - character(len=shr_kind_cs) :: pio_rearr_comm_type, pio_rearr_comm_fcd - integer :: pio_netcdf_ioformat - integer :: pio_rearr_comm_max_pend_req_comp2io - logical :: pio_rearr_comm_enable_hs_comp2io, pio_rearr_comm_enable_isend_comp2io - integer :: pio_rearr_comm_max_pend_req_io2comp - logical :: pio_rearr_comm_enable_hs_io2comp, pio_rearr_comm_enable_isend_io2comp - character(*),parameter :: subName = '(shr_pio_read_default_namelist) ' - - integer :: iam, ierr, npes, unitn - logical :: iamroot - namelist /pio_default_inparm/ & - pio_async_interface, pio_debug_level, pio_blocksize, & - pio_buffer_size_limit, pio_root, pio_numiotasks, pio_stride, & - pio_rearr_comm_type, pio_rearr_comm_fcd, & - pio_rearr_comm_max_pend_req_comp2io, pio_rearr_comm_enable_hs_comp2io, & - pio_rearr_comm_enable_isend_comp2io, & - pio_rearr_comm_max_pend_req_io2comp, pio_rearr_comm_enable_hs_io2comp, & - pio_rearr_comm_enable_isend_io2comp - - - call mpi_comm_rank(Comm, iam , ierr) - call shr_mpi_chkerr(ierr,subname//' mpi_comm_rank comm_world') - call mpi_comm_size(Comm, npes, ierr) - call shr_mpi_chkerr(ierr,subname//' mpi_comm_size comm_world') - - if(iam==0) then - iamroot=.true. - else - iamroot=.false. - end if - - !-------------------------------------------------------------------------- - ! read io nml parameters - !-------------------------------------------------------------------------- - pio_stride = -99 ! set based on pio_numiotasks value when initialized < 0 - pio_numiotasks = -99 ! set based on pio_stride value when initialized < 0 - pio_root = -99 - pio_typename = 'nothing' - pio_blocksize= -99 ! io blocking size set internally in pio when < 0 - pio_buffer_size_limit = -99 ! io task memory buffer maximum set internally in pio when < 0 - pio_debug_level = 0 ! no debug info by default - pio_async_interface = .false. ! pio tasks are a subset of component tasks - pio_rearranger = PIO_REARR_SUBSET - pio_netcdf_ioformat = PIO_64BIT_OFFSET - pio_rearr_comm_type = 'p2p' - pio_rearr_comm_fcd = '2denable' - pio_rearr_comm_max_pend_req_comp2io = 0 - pio_rearr_comm_enable_hs_comp2io = .true. - pio_rearr_comm_enable_isend_comp2io = .false. - pio_rearr_comm_max_pend_req_io2comp = 0 - pio_rearr_comm_enable_hs_io2comp = .true. - pio_rearr_comm_enable_isend_io2comp = .false. - - if(iamroot) then - unitn=shr_file_getunit() - open( unitn, file=trim(nlfilename), status='old' , iostat=ierr) - if(ierr/=0) then - write(shr_log_unit,*) 'File ',trim(nlfilename),' not found, setting default values.' - else - ierr = 1 - do while( ierr /= 0 ) - read(unitn,nml=pio_default_inparm,iostat=ierr) - if (ierr < 0) then - call shr_sys_abort( subname//':: namelist read returns an'// & - ' end of file or end of record condition '//trim(nlfilename) ) - end if - end do - close(unitn) - call shr_file_freeUnit( unitn ) - - call shr_pio_getiotypefromname(pio_typename, pio_iotype, pio_iotype_netcdf) - end if - end if - - call shr_pio_namelist_set(npes, Comm, pio_stride, pio_root, pio_numiotasks, pio_iotype, & - iamroot, pio_rearranger, pio_netcdf_ioformat) - call shr_mpi_bcast(pio_debug_level, Comm) - call shr_mpi_bcast(pio_root, Comm) - call shr_mpi_bcast(pio_numiotasks, Comm) - call shr_mpi_bcast(pio_blocksize, Comm) - call shr_mpi_bcast(pio_buffer_size_limit, Comm) - call shr_mpi_bcast(pio_async_interface, Comm) - call shr_mpi_bcast(pio_rearranger, Comm) - call shr_mpi_bcast(pio_stride, Comm) - if (npes == 1) then - pio_rearr_comm_max_pend_req_comp2io = 0 - pio_rearr_comm_max_pend_req_io2comp = 0 - endif - - - call shr_pio_rearr_opts_set(Comm, pio_rearr_comm_type, pio_rearr_comm_fcd, & - pio_rearr_comm_max_pend_req_comp2io, pio_rearr_comm_enable_hs_comp2io, & - pio_rearr_comm_enable_isend_comp2io, & - pio_rearr_comm_max_pend_req_io2comp, pio_rearr_comm_enable_hs_io2comp, & - pio_rearr_comm_enable_isend_io2comp, pio_numiotasks) - - end subroutine shr_pio_read_default_namelist subroutine shr_pio_read_component_namelist(nlfilename, Comm, pio_stride, pio_root, & pio_numiotasks, pio_iotype, pio_rearranger, pio_netcdf_ioformat) @@ -703,176 +687,8 @@ subroutine shr_pio_rearr_opts_set(comm, pio_rearr_comm_type, pio_rearr_comm_fcd, integer(SHR_KIND_IN), dimension(NUM_REARR_COMM_OPTS) :: buf integer :: rank, ierr - call mpi_comm_rank(comm, rank, ierr) - call shr_mpi_chkerr(ierr,subname//' mpi_comm_rank comm_world') - buf = 0 - ! buf(1) = comm_type - ! buf(2) = comm_fcd - ! buf(3) = max_pend_req_comp2io - ! buf(4) = enable_hs_comp2io - ! buf(5) = enable_isend_comp2io - ! buf(6) = max_pend_req_io2comp - ! buf(7) = enable_hs_io2comp - ! buf(8) = enable_isend_io2comp - if(rank == 0) then - ! buf(1) = comm_type - select case(pio_rearr_comm_type) - case ("p2p") - case ("default") - buf(1) = pio_rearr_comm_p2p - case ("coll") - buf(1) = pio_rearr_comm_coll - case default - write(shr_log_unit,*) "Invalid PIO rearranger comm type, ", pio_rearr_comm_type - write(shr_log_unit,*) "Resetting PIO rearrange comm type to p2p" - buf(1) = pio_rearr_comm_p2p - end select - - ! buf(2) = comm_fcd - select case(pio_rearr_comm_fcd) - case ("2denable") - case ("default") - buf(2) = pio_rearr_comm_fc_2d_enable - case ("io2comp") - buf(2) = pio_rearr_comm_fc_1d_io2comp - case ("comp2io") - buf(2) = pio_rearr_comm_fc_1d_comp2io - case ("disable") - buf(2) = pio_rearr_comm_fc_2d_disable - case default - write(shr_log_unit,*) "Invalid PIO rearranger comm flow control direction, ", pio_rearr_comm_fcd - write(shr_log_unit,*) "Resetting PIO rearrange comm flow control direction to 2denable" - buf(2) = pio_rearr_comm_fc_2d_enable - end select - - ! buf(3) = max_pend_req_comp2io - if((pio_rearr_comm_max_pend_req_comp2io <= 0) .and. & - (pio_rearr_comm_max_pend_req_comp2io /= PIO_REARR_COMM_UNLIMITED_PEND_REQ)) then - - if(pio_rearr_comm_max_pend_req_comp2io /= REARR_COMM_DEF_MAX_PEND_REQ_RESET) then - write(shr_log_unit, *) "Invalid PIO rearranger comm max pend req (comp2io), ",& - pio_rearr_comm_max_pend_req_comp2io - else - write(shr_log_unit, *) "User-specified PIO rearranger comm max pend req (comp2io), ",& - pio_rearr_comm_max_pend_req_comp2io, " (value will be reset as requested) " - end if - - ! Small multiple of pio_numiotasks has proven to perform - ! well empirically, and we do not want to allow maximum for - ! very large process count runs. Can improve this by - ! communicating between iotasks first, and then non-iotasks - ! to iotasks (TO DO) - write(shr_log_unit, *) "Resetting PIO rearranger comm max pend req (comp2io) to ", & - max(PIO_REARR_COMM_DEF_MAX_PEND_REQ, 2 * pio_numiotasks) - buf(3) = max(PIO_REARR_COMM_DEF_MAX_PEND_REQ, 2 * pio_numiotasks) - else - buf(3) = pio_rearr_comm_max_pend_req_comp2io - end if - - ! buf(4) = enable_hs_comp2io - if(pio_rearr_comm_enable_hs_comp2io) then - buf(4) = 1 - else - buf(4) = 0 - end if - - ! buf(5) = enable_isend_comp2io - if(pio_rearr_comm_enable_isend_comp2io) then - buf(5) = 1 - else - buf(5) = 0 - end if - - ! buf(6) = max_pend_req_io2comp - if((pio_rearr_comm_max_pend_req_io2comp <= 0) .and. & - (pio_rearr_comm_max_pend_req_io2comp /= PIO_REARR_COMM_UNLIMITED_PEND_REQ)) then - - if(pio_rearr_comm_max_pend_req_io2comp /= REARR_COMM_DEF_MAX_PEND_REQ_RESET) then - write(shr_log_unit, *) "Invalid PIO rearranger comm max pend req (io2comp), ",& - pio_rearr_comm_max_pend_req_io2comp - else - write(shr_log_unit, *) "User-specified PIO rearranger comm max pend req (io2comp), ",& - pio_rearr_comm_max_pend_req_io2comp, " (value will be reset as requested) " - end if - write(shr_log_unit, *) "Resetting PIO rearranger comm max pend req (io2comp) to ", PIO_REARR_COMM_DEF_MAX_PEND_REQ - buf(6) = PIO_REARR_COMM_DEF_MAX_PEND_REQ - else - buf(6) = pio_rearr_comm_max_pend_req_io2comp - end if - - ! buf(7) = enable_hs_io2comp - if(pio_rearr_comm_enable_hs_io2comp) then - buf(7) = 1 - else - buf(7) = 0 - end if - - ! buf(8) = enable_isend_io2comp - if(pio_rearr_comm_enable_isend_io2comp) then - buf(8) = 1 - else - buf(8) = 0 - end if - - end if - - call shr_mpi_bcast(buf, comm) - - ! buf(1) = comm_type - ! buf(2) = comm_fcd - ! buf(3) = max_pend_req_comp2io - ! buf(4) = enable_hs_comp2io - ! buf(5) = enable_isend_comp2io - ! buf(6) = max_pend_req_io2comp - ! buf(7) = enable_hs_io2comp - ! buf(8) = enable_isend_io2comp - pio_rearr_opt_comm_type = buf(1) - pio_rearr_opt_fcd = buf(2) - pio_rearr_opt_c2i_max_pend_req = buf(3) - if(buf(4) == 0) then - pio_rearr_opt_c2i_enable_hs = .false. - else - pio_rearr_opt_c2i_enable_hs = .true. - end if - if(buf(5) == 0) then - pio_rearr_opt_c2i_enable_isend = .false. - else - pio_rearr_opt_c2i_enable_isend = .true. - end if - pio_rearr_opt_i2c_max_pend_req = buf(6) - if(buf(7) == 0) then - pio_rearr_opt_i2c_enable_hs = .false. - else - pio_rearr_opt_i2c_enable_hs = .true. - end if - if(buf(8) == 0) then - pio_rearr_opt_i2c_enable_isend = .false. - else - pio_rearr_opt_i2c_enable_isend = .true. - end if - - if(rank == 0) then - ! Log the rearranger options - write(shr_log_unit, *) "PIO rearranger options:" - write(shr_log_unit, *) " comm type = ", trim(pio_rearr_comm_type) - write(shr_log_unit, *) " comm fcd = ", trim(pio_rearr_comm_fcd) - if(pio_rearr_opt_c2i_max_pend_req == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then - write(shr_log_unit, *) " max pend req (comp2io) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" - else - write(shr_log_unit, *) " max pend req (comp2io) = ", pio_rearr_opt_c2i_max_pend_req - end if - write(shr_log_unit, *) " enable_hs (comp2io) = ", pio_rearr_opt_c2i_enable_hs - write(shr_log_unit, *) " enable_isend (comp2io) = ", pio_rearr_opt_c2i_enable_isend - if(pio_rearr_opt_i2c_max_pend_req == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then - write(shr_log_unit, *) " max pend req (io2comp) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" - else - write(shr_log_unit, *) " max pend req (io2comp) = ", pio_rearr_opt_i2c_max_pend_req - end if - write(shr_log_unit, *) " enable_hs (io2comp) = ", pio_rearr_opt_i2c_enable_hs - write(shr_log_unit, *) " enable_isend (io2comp) = ", pio_rearr_opt_i2c_enable_isend - end if end subroutine !=============================================================================== diff --git a/cime_config/buildnml b/cime_config/buildnml index 72e9bb48f..18cf5b4a8 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -303,7 +303,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): with open(nuopc_config_file, 'a', encoding="utf-8") as conffile: nmlgen.write_nuopc_config_file(conffile, data_list_path=data_list_path) - for model in case.get_values("COMP_CLASSES"): + for model in case.get_values("COMP_CLASSES") + ['DRV']: model = model.lower() config = {} config['component'] = model @@ -318,15 +318,15 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): inst_count = case.get_value("NINST_" + model.upper()) else: inst_count = maxinst - - for entry in ["pio_async_interface", - "pio_netcdf_format", - "pio_numiotasks", - "pio_rearranger", - "pio_root", - "pio_stride", - "pio_typename"]: - nmlgen.add_default(entry) + if not model == 'drv': + for entry in ["pio_async_interface", + "pio_netcdf_format", + "pio_numiotasks", + "pio_rearranger", + "pio_root", + "pio_stride", + "pio_typename"]: + nmlgen.add_default(entry) inst_string = "" From aab10fc093cf64279126afae198912e5218eee1b Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 14 Mar 2022 13:43:30 -0600 Subject: [PATCH 038/395] more read config --- cesm/nuopc_cap_share/shr_pio_mod.F90 | 251 ++++++++++----------------- mediator/med_io_mod.F90 | 2 + 2 files changed, 94 insertions(+), 159 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/shr_pio_mod.F90 index 159322c0a..444db69ad 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/shr_pio_mod.F90 @@ -1,6 +1,6 @@ module shr_pio_mod use pio - use shr_kind_mod, only : shr_kind_CS, shr_kind_cl, shr_kind_in + use shr_kind_mod, only : CS=>shr_kind_CS, shr_kind_cl, shr_kind_in use shr_file_mod, only : shr_file_getunit, shr_file_freeunit use shr_log_mod, only : shr_log_unit use shr_mpi_mod, only : shr_mpi_bcast, shr_mpi_chkerr @@ -62,11 +62,7 @@ module shr_pio_mod integer :: pio_debug_level=0, pio_blocksize=0 integer(kind=pio_offset_kind) :: pio_buffer_size_limit=-1 - character(len=shr_kind_cs) :: pio_rearr_comm_type, pio_rearr_comm_fcd - integer :: pio_rearr_comm_max_pend_req_comp2io - logical :: pio_rearr_comm_enable_hs_comp2io, pio_rearr_comm_enable_isend_comp2io - integer :: pio_rearr_comm_max_pend_req_io2comp - logical :: pio_rearr_comm_enable_hs_io2comp, pio_rearr_comm_enable_isend_io2comp + type(pio_rearr_opt_t) :: pio_rearr_opts integer :: total_comps logical :: mastertask @@ -93,7 +89,7 @@ module shr_pio_mod subroutine shr_pio_init(driver, rc) use ESMF, only : ESMF_GridComp, ESMF_VM, ESMF_Config, ESMF_GridCompGet - use ESMF, only : ESMF_VMGet + use ESMF, only : ESMF_VMGet, ESMF_RC_NOT_VALID, ESMF_LogSetError use NUOPC, only: NUOPC_CompAttributeGet use shr_string_mod, only : shr_string_toLower type(ESMF_GridComp) :: driver @@ -104,6 +100,9 @@ subroutine shr_pio_init(driver, rc) character(len=shr_kind_cl) :: nlfilename, cname integer :: ret integer :: localPet + character(len=CS) :: pio_rearr_comm_type, pio_rearr_comm_fcd + character(CS) :: msgstr + character(*), parameter :: subName = '(shr_pio_init) ' call ESMF_GridCompGet(driver, vm=vm, rc=rc) @@ -143,6 +142,12 @@ subroutine shr_pio_init(driver, rc) call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_type", value=pio_rearr_comm_type, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + + if(trim(pio_rearr_comm_type) .eq. 'p2p') then + pio_rearr_opts.comm_type = PIO_REARR_COMM_P2P + else + pio_rearr_opts.comm_type = PIO_REARR_COMM_COLL + endif call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_fcd", value=pio_rearr_comm_fcd, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -150,83 +155,104 @@ subroutine shr_pio_init(driver, rc) call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_hs_comp2io", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_rearr_comm_enable_hs_comp2io = (trim(cname) .eq. '.true.') + call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_hs_comp2io", value=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + pio_rearr_opts.comm_fc_opts_comp2io.enable_hs = (trim(cname) .eq. '.true.') call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_hs_io2comp", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_rearr_comm_enable_hs_io2comp = (trim(cname) .eq. '.true.') + pio_rearr_opts.comm_fc_opts_io2comp.enable_hs = (trim(cname) .eq. '.true.') call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_isend_comp2io", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_rearr_comm_enable_isend_comp2io = (trim(cname) .eq. '.true.') + pio_rearr_opts.comm_fc_opts_comp2io.enable_isend = (trim(cname) .eq. '.true.') call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_isend_io2comp", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_rearr_comm_enable_isend_io2comp = (trim(cname) .eq. '.true.') + pio_rearr_opts.comm_fc_opts_io2comp.enable_isend = (trim(cname) .eq. '.true.') call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_max_pend_req_comp2io", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cname, *) pio_rearr_comm_max_pend_req_comp2io + read(cname, *) pio_rearr_opts.comm_fc_opts_comp2io.max_pend_req call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_max_pend_req_io2comp", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cname, *) pio_rearr_comm_max_pend_req_io2comp + read(cname, *) pio_rearr_opts.comm_fc_opts_io2comp.max_pend_req if(mastertask) then ! Log the rearranger options write(shr_log_unit, *) "PIO rearranger options:" - write(shr_log_unit, *) " comm type = ", trim(pio_rearr_comm_type) - write(shr_log_unit, *) " comm fcd = ", trim(pio_rearr_comm_fcd) - if(pio_rearr_comm_max_pend_req_comp2io == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + write(shr_log_unit, *) " comm type = ", pio_rearr_opts.comm_type, " (",trim(pio_rearr_comm_type),")" + write(shr_log_unit, *) " comm fcd = ", pio_rearr_opts.fcd, " (",trim(pio_rearr_comm_fcd),")" + if(pio_rearr_opts.comm_fc_opts_comp2io.max_pend_req == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then write(shr_log_unit, *) " max pend req (comp2io) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" else - write(shr_log_unit, *) " max pend req (comp2io) = ", pio_rearr_comm_max_pend_req_comp2io + write(shr_log_unit, *) " max pend req (comp2io) = ", pio_rearr_opts.comm_fc_opts_comp2io.max_pend_req end if - write(shr_log_unit, *) " enable_hs (comp2io) = ", pio_rearr_comm_enable_hs_comp2io - write(shr_log_unit, *) " enable_isend (comp2io) = ", pio_rearr_comm_enable_isend_comp2io - if(pio_rearr_comm_max_pend_req_io2comp == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + write(shr_log_unit, *) " enable_hs (comp2io) = ", pio_rearr_opts.comm_fc_opts_comp2io.enable_hs + write(shr_log_unit, *) " enable_isend (comp2io) = ", pio_rearr_opts.comm_fc_opts_comp2io.enable_isend + if(pio_rearr_opts.comm_fc_opts_io2comp.max_pend_req == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then write(shr_log_unit, *) " max pend req (io2comp) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" else - write(shr_log_unit, *) " max pend req (io2comp) = ", pio_rearr_comm_max_pend_req_io2comp + write(shr_log_unit, *) " max pend req (io2comp) = ", pio_rearr_opts.comm_fc_opts_io2comp.max_pend_req end if - write(shr_log_unit, *) " enable_hs (io2comp) = ", pio_rearr_comm_enable_hs_io2comp - write(shr_log_unit, *) " enable_isend (io2comp) = ", pio_rearr_comm_enable_isend_io2comp + write(shr_log_unit, *) " enable_hs (io2comp) = ", pio_rearr_opts.comm_fc_opts_io2comp.enable_hs + write(shr_log_unit, *) " enable_isend (io2comp) = ", pio_rearr_opts.comm_fc_opts_io2comp.enable_isend end if end subroutine shr_pio_init subroutine shr_pio_component_init(driver, ncomps, rc) - use ESMF, only : ESMF_GridComp, ESMF_LogSetError, ESMF_RC_NOT_VALID, ESMF_GridCompIsCreated + use ESMF, only : ESMF_GridComp, ESMF_LogSetError, ESMF_RC_NOT_VALID, ESMF_GridCompIsCreated, ESMF_VM, ESMF_VMGet + use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal use NUOPC, only : NUOPC_CompAttributeGet use NUOPC_Driver, only : NUOPC_DriverGetComp - use shr_kind_mod, only : CS=>shr_kind_cs type(ESMF_GridComp) :: driver + type(ESMF_VM) :: vm integer, intent(in) :: ncomps integer, intent(out) :: rc - integer :: i + integer :: i, npets, default_stride + + integer :: comp_comm, comp_rank type(ESMF_GridComp), pointer :: gcomp(:) character(CS) :: cval character(CS) :: msgstr + allocate(pio_comp_settings(ncomps)) allocate(gcomp(ncomps)) + + allocate(io_compid(ncomps)) + allocate(iosystems(ncomps)) + nullify(gcomp) call NUOPC_DriverGetComp(driver, compList=gcomp, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - total_comps = ncomps + total_comps = size(gcomp) - do i=1,ncomps + do i=1,total_comps if (ESMF_GridCompIsCreated(gcomp(i), rc=rc)) then + io_compid(i) = i + call ESMF_GridCompGet(gcomp(i), vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, mpiCommunicator=comp_comm, localPet=comp_rank, petCount=npets, & + ssiLocalPetCount=default_stride, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp(i), name="pio_stride", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cval, *) pio_comp_settings(i)%pio_stride + if(pio_comp_settings(i)%pio_stride <= 0 .or. pio_comp_settings(i)%pio_stride > npets) then + pio_comp_settings(i)%pio_stride = min(npets, default_stride) + endif call NUOPC_CompAttributeGet(gcomp(i), name="pio_rearranger", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -236,10 +262,20 @@ subroutine shr_pio_component_init(driver, ncomps, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cval, *) pio_comp_settings(i)%pio_numiotasks + if(pio_comp_settings(i)%pio_numiotasks < 0 .or. pio_comp_settings(i)%pio_numiotasks > npets) then + pio_comp_settings(i)%pio_numiotasks = max(1,npets/pio_comp_settings(i)%pio_stride) + endif + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_root", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cval, *) pio_comp_settings(i)%pio_root + if(pio_comp_settings(i)%pio_root < 0 .or. pio_comp_settings(i)%pio_root > npets) then + pio_comp_settings(i)%pio_root = 0 + endif + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_typename", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -258,7 +294,6 @@ subroutine shr_pio_component_init(driver, ncomps, rc) return end select - call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return pio_comp_settings(i)%pio_async_interface = (trim(cval) == '.true.') @@ -266,12 +301,40 @@ subroutine shr_pio_component_init(driver, ncomps, rc) call NUOPC_CompAttributeGet(gcomp(i), name="pio_netcdf_format", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) + + if(comp_rank == 0) then + call shr_pio_log_comp_settings(gcomp(i), pio_comp_settings(i)) + endif + + if (pio_comp_settings(i)%pio_async_interface) then + else if(ESMF_GridCompIsPetLocal(gcomp(i), rc=rc)) then + print *,__FILE__,__LINE__,i, comp_rank ,comp_comm ,pio_comp_settings(i)%pio_numiotasks, pio_comp_settings(i)%pio_stride,& + pio_comp_settings(i)%pio_rearranger, pio_comp_settings(i)%pio_root + call pio_init(comp_rank ,comp_comm ,pio_comp_settings(i)%pio_numiotasks, 0, pio_comp_settings(i)%pio_stride, & + pio_comp_settings(i)%pio_rearranger, iosystems(i), pio_comp_settings(i)%pio_root, & + pio_rearr_opts) + endif endif enddo deallocate(gcomp) end subroutine shr_pio_component_init + subroutine shr_pio_log_comp_settings(gcomp, pio_component_settings) + use ESMF, only : ESMF_GridComp + type(ESMF_GridComp) :: gcomp + type(pio_comp_t) :: pio_component_settings + + print *,__FILE__,__LINE__,' numiotasks=',pio_component_settings.pio_numiotasks + + print *,__FILE__,__LINE__,' stride=',pio_component_settings.pio_stride + + print *,__FILE__,__LINE__,' rearranger=',pio_component_settings.pio_rearranger + + print *,__FILE__,__LINE__,' root=',pio_component_settings.pio_root + + end subroutine shr_pio_log_comp_settings + !=============================================================================== subroutine shr_pio_finalize( ) integer :: ierr @@ -436,105 +499,6 @@ function shr_pio_getiosys_fromname(component) result(iosystem) end function shr_pio_getiosys_fromname - - subroutine shr_pio_read_component_namelist(nlfilename, Comm, pio_stride, pio_root, & - pio_numiotasks, pio_iotype, pio_rearranger, pio_netcdf_ioformat) - character(len=*), intent(in) :: nlfilename - integer, intent(in) :: Comm - - integer, intent(inout) :: pio_stride, pio_root, pio_numiotasks - integer, intent(inout) :: pio_iotype, pio_rearranger, pio_netcdf_ioformat - character(len=SHR_KIND_CS) :: pio_typename - character(len=SHR_KIND_CS) :: pio_netcdf_format - integer :: unitn - - integer :: iam, ierr, npes - logical :: iamroot - character(*),parameter :: subName = '(shr_pio_read_component_namelist) ' - integer :: pio_default_stride, pio_default_root, pio_default_numiotasks, pio_default_iotype - integer :: pio_default_rearranger, pio_default_netcdf_ioformat - - namelist /pio_inparm/ pio_stride, pio_root, pio_numiotasks, & - pio_typename, pio_rearranger, pio_netcdf_format - - - - call mpi_comm_rank(Comm, iam , ierr) - call shr_mpi_chkerr(ierr,subname//' mpi_comm_rank comm_world') - call mpi_comm_size(Comm, npes, ierr) - call shr_mpi_chkerr(ierr,subname//' mpi_comm_size comm_world') - - if(iam==0) then - iamroot=.true. - else - iamroot=.false. - end if - - pio_default_stride = pio_stride - pio_default_root = pio_root - pio_default_numiotasks = pio_numiotasks - pio_default_iotype = pio_iotype - pio_default_rearranger = pio_rearranger - pio_default_netcdf_ioformat = PIO_64BIT_DATA - - !-------------------------------------------------------------------------- - ! read io nml parameters - !-------------------------------------------------------------------------- - pio_stride = -99 ! set based on pio_numiotasks value when initialized < 0 - pio_numiotasks = -99 ! set based on pio_stride value when initialized < 0 - pio_root = -99 - pio_typename = 'nothing' - pio_rearranger = -99 - pio_netcdf_format = '64bit_offset' - - if(iamroot) then - unitn=shr_file_getunit() - open( unitn, file=trim(nlfilename), status='old' , iostat=ierr) - if( ierr /= 0) then - write(shr_log_unit,*) 'No ',trim(nlfilename),' found, using defaults for pio settings' - pio_stride = pio_default_stride - pio_root = pio_default_root - pio_numiotasks = pio_default_numiotasks - pio_iotype = pio_default_iotype - pio_rearranger = pio_default_rearranger - pio_netcdf_ioformat = pio_default_netcdf_ioformat - else - ierr = 1 - do while( ierr /= 0 ) - read(unitn,nml=pio_inparm,iostat=ierr) - if (ierr < 0) then - call shr_sys_abort( subname//':: namelist read returns an'// & - ' end of file or end of record condition' ) - end if - end do - close(unitn) - call shr_file_freeUnit( unitn ) - - call shr_pio_getiotypefromname(pio_typename, pio_iotype, pio_default_iotype) - call shr_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, pio_default_netcdf_ioformat) - end if - if(pio_stride== -99) then - if (pio_numiotasks > 0) then - pio_stride = npes/pio_numiotasks - else - pio_stride = pio_default_stride - endif - endif - if(pio_root == -99) pio_root = pio_default_root - if(pio_rearranger == -99) pio_rearranger = pio_default_rearranger - if(pio_numiotasks == -99) then - pio_numiotasks = npes/pio_stride - endif - endif - - - - call shr_pio_namelist_set(npes, Comm, pio_stride, pio_root, pio_numiotasks, pio_iotype, & - iamroot, pio_rearranger, pio_netcdf_ioformat) - - - end subroutine shr_pio_read_component_namelist - subroutine shr_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, pio_default_netcdf_ioformat) use shr_string_mod, only : shr_string_toupper character(len=*), intent(inout) :: pio_netcdf_format @@ -659,37 +623,6 @@ subroutine shr_pio_namelist_set(npes,mycomm, pio_stride, pio_root, pio_numiotask end subroutine shr_pio_namelist_set - ! This subroutine sets the global PIO rearranger options - ! The input args that represent the rearranger options are valid only - ! on the root proc of comm - ! The rearranger options are passed to PIO_Init() in shr_pio_init2() - subroutine shr_pio_rearr_opts_set(comm, pio_rearr_comm_type, pio_rearr_comm_fcd, & - pio_rearr_comm_max_pend_req_comp2io, pio_rearr_comm_enable_hs_comp2io, & - pio_rearr_comm_enable_isend_comp2io, & - pio_rearr_comm_max_pend_req_io2comp, pio_rearr_comm_enable_hs_io2comp, & - pio_rearr_comm_enable_isend_io2comp, & - pio_numiotasks) - integer(SHR_KIND_IN), intent(in) :: comm - character(len=shr_kind_cs), intent(in) :: pio_rearr_comm_type, pio_rearr_comm_fcd - integer, intent(in) :: pio_rearr_comm_max_pend_req_comp2io - logical, intent(in) :: pio_rearr_comm_enable_hs_comp2io - logical, intent(in) :: pio_rearr_comm_enable_isend_comp2io - integer, intent(in) :: pio_rearr_comm_max_pend_req_io2comp - logical, intent(in) :: pio_rearr_comm_enable_hs_io2comp - logical, intent(in) :: pio_rearr_comm_enable_isend_io2comp - integer, intent(in) :: pio_numiotasks - - character(*), parameter :: subname = '(shr_pio_rearr_opts_set) ' - integer, parameter :: NUM_REARR_COMM_OPTS = 8 - integer, parameter :: PIO_REARR_COMM_DEF_MAX_PEND_REQ = 64 - ! Automatically reset if the number of maximum pending requests is set to 0 - integer, parameter :: REARR_COMM_DEF_MAX_PEND_REQ_RESET = 0 - integer(SHR_KIND_IN), dimension(NUM_REARR_COMM_OPTS) :: buf - integer :: rank, ierr - - - - end subroutine !=============================================================================== end module shr_pio_mod diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 90fb0eb3f..808fb7965 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -177,6 +177,7 @@ subroutine med_io_init(gcomp, rc) pio_iotype = shr_pio_getiotype(med_id) pio_ioformat = shr_pio_getioformat(med_id) #else + print *,__FILE__,__LINE__,'PIO type, format:',pio_iotype, pio_ioformat ! query VM call ESMF_VMGetCurrent(vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -576,6 +577,7 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) if(pio_iotype == PIO_IOTYPE_NETCDF .or. pio_iotype == PIO_IOTYPE_PNETCDF) then nmode = ior(nmode,pio_ioformat) endif + rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) if (iam==0) write(logunit,'(a)') trim(subname) //' creating file '// trim(filename) rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) From 8f4737d5e69718b1473d1645959fb2431e3ce986 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 17 Mar 2022 08:17:37 -0600 Subject: [PATCH 039/395] get logging to work --- cesm/driver/ensemble_driver.F90 | 5 +- cesm/driver/esm.F90 | 1 - cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 7 +- cesm/nuopc_cap_share/shr_pio_mod.F90 | 90 ++++++++++++++-------- mediator/med.F90 | 7 +- 5 files changed, 73 insertions(+), 37 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 8ddbb727f..ecebd677a 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -259,7 +259,10 @@ subroutine SetModelServices(ensemble_driver, rc) logUnit = shrlogunit mastertask = .false. endif - call shr_file_setLogUnit (logunit) + call NUOPC_CompAttributeSet(driver, name="stdout_unit", value=logunit, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + +! call shr_file_setLogUnit (logunit) ! Create a clock for each driver instance call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index c1eebd065..9af9dd6a5 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -5,7 +5,6 @@ module ESM !----------------------------------------------------------------------------- use shr_kind_mod , only : r8=>shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_log_mod , only : shrlogunit=> shr_log_unit use shr_sys_mod , only : shr_sys_abort use shr_mpi_mod , only : shr_mpi_bcast use shr_mem_mod , only : shr_mem_init diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index 421606fd1..84aef5dad 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -132,7 +132,7 @@ end subroutine get_component_instance !=============================================================================== subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) - + use shr_pio_mod, only : shr_pio_log_comp_settings ! input/output variables type(ESMF_GridComp) :: gcomp logical, intent(in) :: mastertask @@ -156,12 +156,15 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + + call shr_pio_log_comp_settings(gcomp, logunit) + else logUnit = 6 endif call shr_file_setLogUnit (logunit) - + end subroutine set_component_logging !=============================================================================== diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/shr_pio_mod.F90 index 444db69ad..138663aa7 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/shr_pio_mod.F90 @@ -22,6 +22,7 @@ module shr_pio_mod public :: shr_pio_finalize public :: shr_pio_getioformat public :: shr_pio_getrearranger + public :: shr_pio_log_comp_settings interface shr_pio_getiotype module procedure shr_pio_getiotype_fromid, shr_pio_getiotype_fromname @@ -208,8 +209,8 @@ end subroutine shr_pio_init subroutine shr_pio_component_init(driver, ncomps, rc) use ESMF, only : ESMF_GridComp, ESMF_LogSetError, ESMF_RC_NOT_VALID, ESMF_GridCompIsCreated, ESMF_VM, ESMF_VMGet - use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal - use NUOPC, only : NUOPC_CompAttributeGet + use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated + use NUOPC, only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use NUOPC_Driver, only : NUOPC_DriverGetComp type(ESMF_GridComp) :: driver @@ -228,6 +229,7 @@ subroutine shr_pio_component_init(driver, ncomps, rc) allocate(gcomp(ncomps)) allocate(io_compid(ncomps)) + allocate(io_compname(ncomps)) allocate(iosystems(ncomps)) nullify(gcomp) @@ -238,15 +240,24 @@ subroutine shr_pio_component_init(driver, ncomps, rc) total_comps = size(gcomp) do i=1,total_comps - if (ESMF_GridCompIsCreated(gcomp(i), rc=rc)) then - io_compid(i) = i - call ESMF_GridCompGet(gcomp(i), vm=vm, rc=rc) + io_compid(i) = i+1 + + if (ESMF_GridCompIsPetLocal(gcomp(i), rc=rc)) then + call ESMF_GridCompGet(gcomp(i), vm=vm, name=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + io_compname(i) = trim(cval) + + call NUOPC_CompAttributeAdd(gcomp(i), attrList=(/'MCTID'/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write(cval, *) io_compid(i) + call NUOPC_CompAttributeSet(gcomp(i), name="MCTID", value=trim(cval), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, mpiCommunicator=comp_comm, localPet=comp_rank, petCount=npets, & ssiLocalPetCount=default_stride, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + call NUOPC_CompAttributeGet(gcomp(i), name="pio_stride", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cval, *) pio_comp_settings(i)%pio_stride @@ -257,11 +268,11 @@ subroutine shr_pio_component_init(driver, ncomps, rc) call NUOPC_CompAttributeGet(gcomp(i), name="pio_rearranger", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cval, *) pio_comp_settings(i)%pio_rearranger - + call NUOPC_CompAttributeGet(gcomp(i), name="pio_numiotasks", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cval, *) pio_comp_settings(i)%pio_numiotasks - + if(pio_comp_settings(i)%pio_numiotasks < 0 .or. pio_comp_settings(i)%pio_numiotasks > npets) then pio_comp_settings(i)%pio_numiotasks = max(1,npets/pio_comp_settings(i)%pio_stride) endif @@ -270,12 +281,12 @@ subroutine shr_pio_component_init(driver, ncomps, rc) call NUOPC_CompAttributeGet(gcomp(i), name="pio_root", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cval, *) pio_comp_settings(i)%pio_root - + if(pio_comp_settings(i)%pio_root < 0 .or. pio_comp_settings(i)%pio_root > npets) then pio_comp_settings(i)%pio_root = 0 endif - - + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_typename", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -293,45 +304,62 @@ subroutine shr_pio_component_init(driver, ncomps, rc) call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return end select - + call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return pio_comp_settings(i)%pio_async_interface = (trim(cval) == '.true.') - + call NUOPC_CompAttributeGet(gcomp(i), name="pio_netcdf_format", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) - - if(comp_rank == 0) then - call shr_pio_log_comp_settings(gcomp(i), pio_comp_settings(i)) - endif - + if (pio_comp_settings(i)%pio_async_interface) then - else if(ESMF_GridCompIsPetLocal(gcomp(i), rc=rc)) then - print *,__FILE__,__LINE__,i, comp_rank ,comp_comm ,pio_comp_settings(i)%pio_numiotasks, pio_comp_settings(i)%pio_stride,& - pio_comp_settings(i)%pio_rearranger, pio_comp_settings(i)%pio_root + else call pio_init(comp_rank ,comp_comm ,pio_comp_settings(i)%pio_numiotasks, 0, pio_comp_settings(i)%pio_stride, & pio_comp_settings(i)%pio_rearranger, iosystems(i), pio_comp_settings(i)%pio_root, & pio_rearr_opts) + print *,__FILE__,__LINE__,io_compid(i),iosystems(i) endif +! if(comp_rank == 0) then +! call shr_pio_log_comp_settings(gcomp(i)) +! endif + endif enddo deallocate(gcomp) end subroutine shr_pio_component_init - subroutine shr_pio_log_comp_settings(gcomp, pio_component_settings) - use ESMF, only : ESMF_GridComp + subroutine shr_pio_log_comp_settings(gcomp, logunit) + use ESMF, only : ESMF_GridComp, ESMF_GridCompGet + use NUOPC, only: NUOPC_CompAttributeGet + type(ESMF_GridComp) :: gcomp - type(pio_comp_t) :: pio_component_settings + integer, intent(in) :: logunit - print *,__FILE__,__LINE__,' numiotasks=',pio_component_settings.pio_numiotasks + integer :: compid + character(len=CS) :: name, cval + integer :: i + integer :: rc + logical :: isPresent + + call ESMF_GridCompGet(gcomp, name=name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name="MCTID", value=cval, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if(isPresent) then + read(cval, *) compid + i = shr_pio_getindex(compid) + endif + write(logunit,*) trim(name),': PIO numiotasks=', pio_comp_settings(i)%pio_numiotasks - print *,__FILE__,__LINE__,' stride=',pio_component_settings.pio_stride + write(logunit, *) trim(name), ': PIO stride=',pio_comp_settings(i)%pio_stride - print *,__FILE__,__LINE__,' rearranger=',pio_component_settings.pio_rearranger + write(logunit, *) trim(name),': PIO rearranger=',pio_comp_settings(i)%pio_rearranger - print *,__FILE__,__LINE__,' root=',pio_component_settings.pio_root + write(logunit, *) trim(name),': PIO root=',pio_comp_settings(i)%pio_root end subroutine shr_pio_log_comp_settings @@ -436,7 +464,7 @@ integer function shr_pio_getindex_fromid(compid) result(index) implicit none integer, intent(in) :: compid integer :: i - + character(len=shr_kind_cl) :: msg index = -1 do i=1,total_comps if(io_compid(i)==compid) then @@ -446,7 +474,8 @@ integer function shr_pio_getindex_fromid(compid) result(index) end do if(index<0) then - call shr_sys_abort('shr_pio_getindex :: compid out of allowed range') + write(msg, *) 'shr_pio_getindex :: compid=',compid,' out of allowed range: ' + call shr_sys_abort(msg) end if end function shr_pio_getindex_fromid @@ -484,7 +513,6 @@ function shr_pio_getiosys_fromid(compid) result(iosystem) integer, intent(in) :: compid type(iosystem_desc_t), pointer :: iosystem - iosystem => iosystems(shr_pio_getindex(compid)) end function shr_pio_getiosys_fromid diff --git a/mediator/med.F90 b/mediator/med.F90 index 67b2785c8..1dcd4011b 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -547,8 +547,9 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_VM, ESMF_SUCCESS use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_AttributeGet, ESMF_AttributeSet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_METHOD_INITIALIZE - use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_CompAttributeGet + use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_CompAttributeGet, NUOPC_CompAttributeSet use med_internalstate_mod, only : mastertask, logunit, diagunit + use nuopc_shr_methods, only : set_component_logging type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -560,6 +561,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) character(len=CL) :: cvalue integer :: localPet integer :: i + integer :: shrlogunit logical :: isPresent, isSet character(len=CX) :: msgString character(len=CX) :: diro @@ -590,7 +592,8 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (.not. isPresent .and. .not. isSet) then logfile = 'mediator.log' end if - open(newunit=logunit, file=trim(diro)//"/"//trim(logfile)) + + call set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) call NUOPC_CompAttributeGet(gcomp, name="do_budgets", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From 25d0e731c7564bee326e2b35fd31f02f21d3c844 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 17 Mar 2022 14:16:43 -0600 Subject: [PATCH 040/395] some cleanup --- cesm/driver/ensemble_driver.F90 | 5 +---- cesm/driver/esmApp.F90 | 11 ----------- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 1 - cesm/nuopc_cap_share/shr_ndep_mod.F90 | 6 +++--- cesm/nuopc_cap_share/shr_pio_mod.F90 | 11 ++++++----- cime_config/buildnml | 3 --- mediator/med.F90 | 2 +- 7 files changed, 11 insertions(+), 28 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index ecebd677a..8ddbb727f 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -259,10 +259,7 @@ subroutine SetModelServices(ensemble_driver, rc) logUnit = shrlogunit mastertask = .false. endif - call NUOPC_CompAttributeSet(driver, name="stdout_unit", value=logunit, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - -! call shr_file_setLogUnit (logunit) + call shr_file_setLogUnit (logunit) ! Create a clock for each driver instance call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) diff --git a/cesm/driver/esmApp.F90 b/cesm/driver/esmApp.F90 index 5314e043e..12cf1537d 100644 --- a/cesm/driver/esmApp.F90 +++ b/cesm/driver/esmApp.F90 @@ -43,17 +43,6 @@ program esmApp #endif COMP_COMM = MPI_COMM_WORLD - !----------------------------------------------------------------------------- - ! Initialize PIO - !----------------------------------------------------------------------------- - - ! For planned future use of async io using pio2. The IO tasks are seperated from the compute tasks here - ! and COMP_COMM will be MPI_COMM_NULL on the IO tasks which then call shr_pio_init2 and do not return until - ! the model completes. All other tasks call ESMF_Initialize. 8 is the maximum number of component models - ! supported - -! call shr_pio_init1(8, "drv_in", COMP_COMM) - !----------------------------------------------------------------------------- ! Initialize ESMF !----------------------------------------------------------------------------- diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index 84aef5dad..bdd34a518 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -156,7 +156,6 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) - call shr_pio_log_comp_settings(gcomp, logunit) else diff --git a/cesm/nuopc_cap_share/shr_ndep_mod.F90 b/cesm/nuopc_cap_share/shr_ndep_mod.F90 index d3a9f9801..6e0fcb91a 100644 --- a/cesm/nuopc_cap_share/shr_ndep_mod.F90 +++ b/cesm/nuopc_cap_share/shr_ndep_mod.F90 @@ -49,9 +49,9 @@ subroutine shr_ndep_readnl(NLFilename, ndep_nflds) character(len=32) :: ndep_list(maxspc) = '' ! List of ndep species integer :: localpet integer :: mpicom - character(*),parameter :: F00 = "('(shr_ndep_read) ',8a)" - character(*),parameter :: FI1 = "('(shr_ndep_init) ',a,I2)" - character(*),parameter :: subName = '(shr_ndep_read) ' + + character(*),parameter :: subName = '(shr_ndep_readnl) ' + character(*),parameter :: F00 = "('(shr_ndep_readnl) ',8a)" ! ------------------------------------------------------------------ namelist /ndep_inparm/ ndep_list diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/shr_pio_mod.F90 index 138663aa7..f44ab2e43 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/shr_pio_mod.F90 @@ -315,15 +315,16 @@ subroutine shr_pio_component_init(driver, ncomps, rc) if (pio_comp_settings(i)%pio_async_interface) then else + if(pio_rearr_opts.comm_fc_opts_io2comp.max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + pio_rearr_opts.comm_fc_opts_io2comp.max_pend_req = pio_comp_settings(i)%pio_numiotasks + endif + if(pio_rearr_opts.comm_fc_opts_comp2io.max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + pio_rearr_opts.comm_fc_opts_comp2io.max_pend_req = pio_comp_settings(i)%pio_numiotasks + endif call pio_init(comp_rank ,comp_comm ,pio_comp_settings(i)%pio_numiotasks, 0, pio_comp_settings(i)%pio_stride, & pio_comp_settings(i)%pio_rearranger, iosystems(i), pio_comp_settings(i)%pio_root, & pio_rearr_opts) - print *,__FILE__,__LINE__,io_compid(i),iosystems(i) endif -! if(comp_rank == 0) then -! call shr_pio_log_comp_settings(gcomp(i)) -! endif - endif enddo diff --git a/cime_config/buildnml b/cime_config/buildnml index 18cf5b4a8..d819ad950 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -574,9 +574,6 @@ def buildnml(case, caseroot, component): # create the files nuopc.runconfig, nuopc.runseq, drv_in and drv_flds_in _create_drv_namelists(case, infile, confdir, nmlgen, files) - # create the files comp_modelio.nml where comp = [atm, lnd...] -# _create_component_modelio_namelists(case, confdir, nmlgen, files) - # set rundir rundir = case.get_value("RUNDIR") diff --git a/mediator/med.F90 b/mediator/med.F90 index 1dcd4011b..befc001a5 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -547,7 +547,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_VM, ESMF_SUCCESS use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_AttributeGet, ESMF_AttributeSet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_METHOD_INITIALIZE - use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_CompAttributeGet, NUOPC_CompAttributeSet + use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_CompAttributeGet use med_internalstate_mod, only : mastertask, logunit, diagunit use nuopc_shr_methods, only : set_component_logging From 1193194e99ec78af26c0cdf4baabf389a5f66a54 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 17 Mar 2022 14:39:16 -0600 Subject: [PATCH 041/395] must work with ufs --- cesm/driver/esm.F90 | 4 ++-- mediator/med.F90 | 9 ++++++--- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index 9af9dd6a5..4b117ccc1 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -10,7 +10,7 @@ module ESM use shr_mem_mod , only : shr_mem_init use shr_file_mod , only : shr_file_setLogunit use esm_utils_mod, only : logunit, mastertask, dbug_flag, chkerr - use perf_mod , only : t_initf + use perf_mod , only : t_initf, t_setLogUnit implicit none private @@ -219,7 +219,7 @@ subroutine SetModelServices(driver, rc) !------------------------------------------- ! Timer initialization (has to be after pelayouts are determined) !------------------------------------------- - + call t_setLogUnit(logunit) call t_initf('drv_in', LogPrint=.true., mpicom=global_comm, mastertask=mastertask, MaxThreads=maxthreads) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) diff --git a/mediator/med.F90 b/mediator/med.F90 index befc001a5..6be7a2f55 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -549,8 +549,9 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_METHOD_INITIALIZE use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_CompAttributeGet use med_internalstate_mod, only : mastertask, logunit, diagunit +#ifdef CESMCOUPLED use nuopc_shr_methods, only : set_component_logging - +#endif type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -592,9 +593,11 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (.not. isPresent .and. .not. isSet) then logfile = 'mediator.log' end if - +#ifdef CESMCOUPLED call set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) - +#else + open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) +#endif call NUOPC_CompAttributeGet(gcomp, name="do_budgets", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then From aff27cbd613ae2b838cce7c74e4a023910fe5a5f Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 17 Mar 2022 16:40:25 -0600 Subject: [PATCH 042/395] more logging fixes, correct syntax in shr_pio_mod --- cesm/driver/esm.F90 | 3 +- cesm/nuopc_cap_share/shr_pio_mod.F90 | 44 ++++++++++++++-------------- cime_config/buildnml | 14 +-------- 3 files changed, 24 insertions(+), 37 deletions(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index 4b117ccc1..16a5a4562 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -219,8 +219,7 @@ subroutine SetModelServices(driver, rc) !------------------------------------------- ! Timer initialization (has to be after pelayouts are determined) !------------------------------------------- - call t_setLogUnit(logunit) - call t_initf('drv_in', LogPrint=.true., mpicom=global_comm, mastertask=mastertask, MaxThreads=maxthreads) + call t_initf('drv_in', LogPrint=.true., LogUnit=logunit, mpicom=global_comm, mastertask=mastertask, MaxThreads=maxthreads) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/shr_pio_mod.F90 index f44ab2e43..beea4a3c1 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/shr_pio_mod.F90 @@ -145,9 +145,9 @@ subroutine shr_pio_init(driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if(trim(pio_rearr_comm_type) .eq. 'p2p') then - pio_rearr_opts.comm_type = PIO_REARR_COMM_P2P + pio_rearr_opts%comm_type = PIO_REARR_COMM_P2P else - pio_rearr_opts.comm_type = PIO_REARR_COMM_COLL + pio_rearr_opts%comm_type = PIO_REARR_COMM_COLL endif call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_fcd", value=pio_rearr_comm_fcd, rc=rc) @@ -159,50 +159,50 @@ subroutine shr_pio_init(driver, rc) call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_hs_comp2io", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_rearr_opts.comm_fc_opts_comp2io.enable_hs = (trim(cname) .eq. '.true.') + pio_rearr_opts%comm_fc_opts_comp2io%enable_hs = (trim(cname) .eq. '.true.') call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_hs_io2comp", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_rearr_opts.comm_fc_opts_io2comp.enable_hs = (trim(cname) .eq. '.true.') + pio_rearr_opts%comm_fc_opts_io2comp%enable_hs = (trim(cname) .eq. '.true.') call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_isend_comp2io", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_rearr_opts.comm_fc_opts_comp2io.enable_isend = (trim(cname) .eq. '.true.') + pio_rearr_opts%comm_fc_opts_comp2io%enable_isend = (trim(cname) .eq. '.true.') call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_isend_io2comp", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_rearr_opts.comm_fc_opts_io2comp.enable_isend = (trim(cname) .eq. '.true.') + pio_rearr_opts%comm_fc_opts_io2comp%enable_isend = (trim(cname) .eq. '.true.') call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_max_pend_req_comp2io", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cname, *) pio_rearr_opts.comm_fc_opts_comp2io.max_pend_req + read(cname, *) pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_max_pend_req_io2comp", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cname, *) pio_rearr_opts.comm_fc_opts_io2comp.max_pend_req + read(cname, *) pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req if(mastertask) then ! Log the rearranger options write(shr_log_unit, *) "PIO rearranger options:" - write(shr_log_unit, *) " comm type = ", pio_rearr_opts.comm_type, " (",trim(pio_rearr_comm_type),")" - write(shr_log_unit, *) " comm fcd = ", pio_rearr_opts.fcd, " (",trim(pio_rearr_comm_fcd),")" - if(pio_rearr_opts.comm_fc_opts_comp2io.max_pend_req == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + write(shr_log_unit, *) " comm type = ", pio_rearr_opts%comm_type, " (",trim(pio_rearr_comm_type),")" + write(shr_log_unit, *) " comm fcd = ", pio_rearr_opts%fcd, " (",trim(pio_rearr_comm_fcd),")" + if(pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then write(shr_log_unit, *) " max pend req (comp2io) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" else - write(shr_log_unit, *) " max pend req (comp2io) = ", pio_rearr_opts.comm_fc_opts_comp2io.max_pend_req + write(shr_log_unit, *) " max pend req (comp2io) = ", pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req end if - write(shr_log_unit, *) " enable_hs (comp2io) = ", pio_rearr_opts.comm_fc_opts_comp2io.enable_hs - write(shr_log_unit, *) " enable_isend (comp2io) = ", pio_rearr_opts.comm_fc_opts_comp2io.enable_isend - if(pio_rearr_opts.comm_fc_opts_io2comp.max_pend_req == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + write(shr_log_unit, *) " enable_hs (comp2io) = ", pio_rearr_opts%comm_fc_opts_comp2io%enable_hs + write(shr_log_unit, *) " enable_isend (comp2io) = ", pio_rearr_opts%comm_fc_opts_comp2io%enable_isend + if(pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then write(shr_log_unit, *) " max pend req (io2comp) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" else - write(shr_log_unit, *) " max pend req (io2comp) = ", pio_rearr_opts.comm_fc_opts_io2comp.max_pend_req + write(shr_log_unit, *) " max pend req (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req end if - write(shr_log_unit, *) " enable_hs (io2comp) = ", pio_rearr_opts.comm_fc_opts_io2comp.enable_hs - write(shr_log_unit, *) " enable_isend (io2comp) = ", pio_rearr_opts.comm_fc_opts_io2comp.enable_isend + write(shr_log_unit, *) " enable_hs (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%enable_hs + write(shr_log_unit, *) " enable_isend (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%enable_isend end if end subroutine shr_pio_init @@ -315,11 +315,11 @@ subroutine shr_pio_component_init(driver, ncomps, rc) if (pio_comp_settings(i)%pio_async_interface) then else - if(pio_rearr_opts.comm_fc_opts_io2comp.max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then - pio_rearr_opts.comm_fc_opts_io2comp.max_pend_req = pio_comp_settings(i)%pio_numiotasks + if(pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req = pio_comp_settings(i)%pio_numiotasks endif - if(pio_rearr_opts.comm_fc_opts_comp2io.max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then - pio_rearr_opts.comm_fc_opts_comp2io.max_pend_req = pio_comp_settings(i)%pio_numiotasks + if(pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req = pio_comp_settings(i)%pio_numiotasks endif call pio_init(comp_rank ,comp_comm ,pio_comp_settings(i)%pio_numiotasks, 0, pio_comp_settings(i)%pio_stride, & pio_comp_settings(i)%pio_rearranger, iosystems(i), pio_comp_settings(i)%pio_root, & diff --git a/cime_config/buildnml b/cime_config/buildnml index d819ad950..4cdcb7aac 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -312,7 +312,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): newgroup = "MED_modelio" else: newgroup = model.upper()+"_modelio" - nmlgen._definition.rename_group("modelio", newgroup) + nmlgen.rename_group("modelio", newgroup) if maxinst == 1 and model != 'cpl' and not multi_driver: inst_count = case.get_value("NINST_" + model.upper()) @@ -500,18 +500,6 @@ def compare_drv_flds_in(first, second, infile1, infile2): expect(False, "incompatible settings in drv_flds_in from \n %s \n and \n %s" % (infile1, infile2)) -############################################################################### -def _create_component_modelio_namelists(case, confdir, nmlgen, files): -############################################################################### - - # will need to create a new namelist generator - infiles = [] - definition_dir = os.path.dirname(files.get_value("NAMELIST_DEFINITION_FILE", attribute={"component":"drv"})) - definition_file = [os.path.join(definition_dir, "namelist_definition_modelio.xml")] - - confdir = os.path.join(case.get_value("CASEBUILD"), "cplconf") - - ############################################################################### def buildnml(case, caseroot, component): ############################################################################### From d23ad4bad90f94be3f4de0011224a7f1e5238eed Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 23 Mar 2022 12:57:42 -0600 Subject: [PATCH 043/395] clean up code --- cesm/driver/esm.F90 | 4 +++- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 3 ++- cesm/nuopc_cap_share/shr_pio_mod.F90 | 19 +++++++++++++++++-- mediator/med_io_mod.F90 | 1 - 4 files changed, 22 insertions(+), 5 deletions(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index 16a5a4562..c48e2a198 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -930,6 +930,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) endif ! Initialize PIO + ! This reads in the pio parameters that are independent of component call shr_pio_init(driver, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1176,7 +1177,8 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return enddo - + ! Read in component dependent PIO parameters and initialize + ! IO systems call shr_pio_component_init(driver, size(comps), rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index bdd34a518..5bae5b4a4 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -156,12 +156,13 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + ! Write the PIO settings to the beggining of each component log call shr_pio_log_comp_settings(gcomp, logunit) else logUnit = 6 endif - + ! TODO: shr_file mod is deprecated and should be removed. call shr_file_setLogUnit (logunit) end subroutine set_component_logging diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/shr_pio_mod.F90 index beea4a3c1..bed4ce29a 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/shr_pio_mod.F90 @@ -219,11 +219,13 @@ subroutine shr_pio_component_init(driver, ncomps, rc) integer, intent(out) :: rc integer :: i, npets, default_stride - + integer :: j integer :: comp_comm, comp_rank type(ESMF_GridComp), pointer :: gcomp(:) character(CS) :: cval character(CS) :: msgstr + integer :: do_async_init + type(io_system_desc_t), allocatable :: async_iosystems(:) allocate(pio_comp_settings(ncomps)) allocate(gcomp(ncomps)) @@ -233,6 +235,7 @@ subroutine shr_pio_component_init(driver, ncomps, rc) allocate(iosystems(ncomps)) nullify(gcomp) + do_async_init = 0 call NUOPC_DriverGetComp(driver, compList=gcomp, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -314,7 +317,8 @@ subroutine shr_pio_component_init(driver, ncomps, rc) call shr_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) if (pio_comp_settings(i)%pio_async_interface) then - else + do_async_init = do_async_init + 1 + else if(pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req = pio_comp_settings(i)%pio_numiotasks endif @@ -327,6 +331,17 @@ subroutine shr_pio_component_init(driver, ncomps, rc) endif endif enddo + if (do_async_init > 0) then + allocate(async_iosystems(do_async_init)) + j=1 + do i=1,total_comps + if(pio_comp_settings(i)%pio_async_interface) then + iosystem(i) = async_iosystems(j) + j = j+1 + endif + enddo + + endif deallocate(gcomp) end subroutine shr_pio_component_init diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 808fb7965..1a1541475 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -177,7 +177,6 @@ subroutine med_io_init(gcomp, rc) pio_iotype = shr_pio_getiotype(med_id) pio_ioformat = shr_pio_getioformat(med_id) #else - print *,__FILE__,__LINE__,'PIO type, format:',pio_iotype, pio_ioformat ! query VM call ESMF_VMGetCurrent(vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From d8e82e86ae2a65505ebe3f4c9e3422686cf0908b Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 1 Apr 2022 11:18:20 -0600 Subject: [PATCH 044/395] fix bugs in pio interface --- cesm/nuopc_cap_share/shr_pio_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/shr_pio_mod.F90 index bed4ce29a..e05a1ed99 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/shr_pio_mod.F90 @@ -225,7 +225,7 @@ subroutine shr_pio_component_init(driver, ncomps, rc) character(CS) :: cval character(CS) :: msgstr integer :: do_async_init - type(io_system_desc_t), allocatable :: async_iosystems(:) + type(iosystem_desc_t), allocatable :: async_iosystems(:) allocate(pio_comp_settings(ncomps)) allocate(gcomp(ncomps)) @@ -336,7 +336,7 @@ subroutine shr_pio_component_init(driver, ncomps, rc) j=1 do i=1,total_comps if(pio_comp_settings(i)%pio_async_interface) then - iosystem(i) = async_iosystems(j) + iosystems(i) = async_iosystems(j) j = j+1 endif enddo From 167b0eb231ec8afeb141ed272edbd5b97cb699a5 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 13 Apr 2022 10:39:02 -0600 Subject: [PATCH 045/395] handle inst number in fortran --- cesm/driver/ensemble_driver.F90 | 2 +- cesm/driver/esm.F90 | 7 +++++-- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 8 ++++++++ 3 files changed, 14 insertions(+), 3 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 8ddbb727f..1c5d3ca67 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -244,7 +244,7 @@ subroutine SetModelServices(ensemble_driver, rc) call ReadAttributes(driver, config, "DRIVER_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(driver, config, "DRV_modelio"//trim(inst_suffix)//"::", rc=rc) + call ReadAttributes(driver, config, "DRV_modelio::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Set the driver log to the driver task 0 diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index c48e2a198..bd124639f 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -668,8 +668,11 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n if (chkerr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(gcomp, config, "ALLCOMP_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(gcomp, config, trim(compname)//"_modelio"//trim(inst_suffix)//"::", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + call ReadAttributes(gcomp, config, trim(compname)//"_modelio::", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) then + print *,__FILE__,__LINE__,"ERROR reading ",trim(compname)," modelio from runconfig" + return + endif call ReadAttributes(gcomp, config, "CLOCK_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index 5bae5b4a4..da7891c49 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -143,6 +143,8 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) ! local variables character(len=CL) :: diro character(len=CL) :: logfile + character(len=CL) :: inst_suffix + integer :: inst_index ! not used here !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -154,6 +156,12 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call get_component_instance(gcomp, inst_suffix, inst_index, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Multiinstance logfile name needs a correction + if(logfile(4:4) == '_') then + logfile = logfile(1:3)//trim(inst_suffix)//logfile(9:) + endif open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) ! Write the PIO settings to the beggining of each component log From 6654167914b56c2e6c5c669738365c03d451d664 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Sat, 16 Apr 2022 23:45:32 -0600 Subject: [PATCH 046/395] add option to write meshes and update code that retrieve area information from xgrid --- mediator/med_phases_aofluxes_mod.F90 | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 5c386612f..903e016bb 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -24,7 +24,7 @@ module med_phases_aofluxes_mod use ESMF , only : ESMF_Mesh, ESMF_MeshGet, ESMF_XGrid, ESMF_XGridCreate, ESMF_TYPEKIND_R8 use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LOGMSG_ERROR, ESMF_FAILURE use ESMF , only : ESMF_Finalize, ESMF_LogFoundError - use ESMF , only : ESMF_XGridGet, ESMF_KIND_R8 + use ESMF , only : ESMF_XGridGet, ESMF_MeshWrite, ESMF_KIND_R8 use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_internalstate_mod , only : InternalState, mastertask, logunit use med_internalstate_mod , only : compatm, compocn, coupling_mode, aoflux_code, mapconsd, mapconsf, mapfcopy @@ -749,6 +749,7 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Field) :: lfield type(ESMF_Mesh) :: ocn_mesh type(ESMF_Mesh) :: atm_mesh + type(ESMF_Mesh) :: xch_mesh real(r8), pointer :: dataptr(:) integer :: fieldcount type(ESMF_CoordSys_Flag) :: coordSys @@ -785,6 +786,17 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) storeOverlay=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! write meshes for debug purpose + if (dbug_flag > 20) then + call ESMF_MeshWrite(atm_mesh, filename="atm_mesh", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshWrite(ocn_mesh, filename="ocn_mesh", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_XGridGet(xgrid, mesh=xch_mesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshWrite(xch_mesh, filename="xch_mesh", rc=rc) + end if + ! create module field on exchange grid and set its initial value to 1 field_x = ESMF_FieldCreate(xgrid, typekind=ESMF_TYPEKIND_R8, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -891,18 +903,16 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) ! setup grid area ! ------------------------ - ! TODO: ESMF_XGridGet() call could return coordSys in newer version of ESMF allocate(area(lsize)) - !call ESMF_XGridGet(xgrid, coordSys=coordSys, area=area, rc=rc) - call ESMF_XGridGet(xgrid, area=area, rc=rc) + call ESMF_XGridGet(xgrid, coordSys=coordSys, area=area, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(aoflux_in%garea(lsize)) aoflux_in%garea(:) = area(:) deallocate(area) - !if (coordSys /= ESMF_COORDSYS_CART) then + if (coordSys /= ESMF_COORDSYS_CART) then ! Convert square radians to square meters aoflux_in%garea(:) = aoflux_in%garea(:)*(rearth**2) - !end if + end if end subroutine med_aofluxes_init_xgrid From 383f11c235f83743d8f6cb0d95f16d611f2d69ee Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Sun, 17 Apr 2022 01:04:58 -0600 Subject: [PATCH 047/395] update ccpp host based on recent changes in ccpp framework --- ufs/ccpp/data/MED_data.F90 | 2 +- ufs/ccpp/data/MED_data.meta | 1 - ufs/ccpp/driver/med_ccpp_driver.F90 | 2 +- 3 files changed, 2 insertions(+), 3 deletions(-) diff --git a/ufs/ccpp/data/MED_data.F90 b/ufs/ccpp/data/MED_data.F90 index bd81da972..4a57d38c6 100644 --- a/ufs/ccpp/data/MED_data.F90 +++ b/ufs/ccpp/data/MED_data.F90 @@ -15,7 +15,7 @@ module MED_data use MED_typedefs, only: MED_grid_type use MED_typedefs, only: MED_sfcprop_type use MED_typedefs, only: MED_diag_type - use ccpp_api, only: ccpp_t + use ccpp_types, only: ccpp_t implicit none diff --git a/ufs/ccpp/data/MED_data.meta b/ufs/ccpp/data/MED_data.meta index 053118660..91148f4f8 100644 --- a/ufs/ccpp/data/MED_data.meta +++ b/ufs/ccpp/data/MED_data.meta @@ -60,7 +60,6 @@ name = MED_data type = module dependencies = MED_typedefs.F90 - dependencies = ../../../../../FV3/ccpp/framework/src/ccpp_api.F90 [ccpp-arg-table] name = MED_data diff --git a/ufs/ccpp/driver/med_ccpp_driver.F90 b/ufs/ccpp/driver/med_ccpp_driver.F90 index aa50062b5..72586e212 100644 --- a/ufs/ccpp/driver/med_ccpp_driver.F90 +++ b/ufs/ccpp/driver/med_ccpp_driver.F90 @@ -1,6 +1,6 @@ module med_ccpp_driver - use ccpp_api, only: ccpp_t + use ccpp_types, only: ccpp_t use ccpp_static_api_med, only: ccpp_physics_init use ccpp_static_api_med, only: ccpp_physics_run use ccpp_static_api_med, only: ccpp_physics_finalize From d56d53bb206bc31f78843653556e2d4b6b944423 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Tue, 19 Apr 2022 10:41:26 -0600 Subject: [PATCH 048/395] fix for providing cell area to CCPP host model --- mediator/med_phases_aofluxes_mod.F90 | 31 ++++++++++++++++++---------- 1 file changed, 20 insertions(+), 11 deletions(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 903e016bb..4df830fbc 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -494,6 +494,7 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) integer :: fieldcount type(ESMF_Field) :: lfield type(ESMF_Mesh) :: lmesh + real(R8), pointer :: garea(:) => null() type(ESMF_CoordSys_Flag) :: coordSys character(len=*),parameter :: subname=' (med_aofluxes_init_ocngrid) ' !----------------------------------------------------------------------- @@ -536,7 +537,8 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) call ESMF_FieldBundleGet(is_local%wrap%FBArea(compocn), 'area', field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=aoflux_in%garea, rc=rc) + allocate(aoflux_in%garea(lsize)) + call ESMF_FieldGet(lfield, farrayPtr=garea, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -544,7 +546,9 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (coordSys /= ESMF_COORDSYS_CART) then ! Convert square radians to square meters - aoflux_in%garea(:) = aoflux_in%garea(:)*(rearth**2) + aoflux_in%garea(:) = garea(:)*(rearth**2) + else + aoflux_in%garea(:) = garea(:) end if ! ------------------------ @@ -599,6 +603,7 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) integer :: maptype type(ESMF_Field) :: lfield type(ESMF_Mesh) :: lmesh + real(R8), pointer :: garea(:) => null() type(ESMF_CoordSys_Flag) :: coordSys character(len=*),parameter :: subname=' (med_aofluxes_init_atmgrid) ' !----------------------------------------------------------------------- @@ -682,7 +687,8 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) call ESMF_FieldBundleGet(is_local%wrap%FBArea(compatm), 'area', field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=aoflux_in%garea, rc=rc) + allocate(aoflux_in%garea(lsize)) + call ESMF_FieldGet(lfield, farrayPtr=garea, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -690,7 +696,9 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (coordSys /= ESMF_COORDSYS_CART) then ! Convert square radians to square meters - aoflux_in%garea(:) = aoflux_in%garea(:)*(rearth**2) + aoflux_in%garea(:) = garea(:)*(rearth**2) + else + aoflux_in%garea(:) = garea(:) end if ! ------------------------ @@ -753,7 +761,7 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) real(r8), pointer :: dataptr(:) integer :: fieldcount type(ESMF_CoordSys_Flag) :: coordSys - real(ESMF_KIND_R8) ,allocatable :: area(:) + real(ESMF_KIND_R8) ,allocatable :: garea(:) character(ESMF_MAXSTR),allocatable :: fieldNameList(:) character(len=*),parameter :: subname=' (med_aofluxes_init_xgrid) ' !----------------------------------------------------------------------- @@ -903,16 +911,17 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) ! setup grid area ! ------------------------ - allocate(area(lsize)) - call ESMF_XGridGet(xgrid, coordSys=coordSys, area=area, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(garea(lsize)) allocate(aoflux_in%garea(lsize)) - aoflux_in%garea(:) = area(:) - deallocate(area) + call ESMF_XGridGet(xgrid, coordSys=coordSys, area=garea, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return if (coordSys /= ESMF_COORDSYS_CART) then ! Convert square radians to square meters - aoflux_in%garea(:) = aoflux_in%garea(:)*(rearth**2) + aoflux_in%garea(:) = garea(:)*(rearth**2) + else + aoflux_in%garea(:) = garea(:) end if + deallocate(garea) end subroutine med_aofluxes_init_xgrid From c99de054d6881e4d8fc4c4e6f8faaafa4731ff1f Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Tue, 19 Apr 2022 14:10:57 -0600 Subject: [PATCH 049/395] make ccpp physics options configurable --- mediator/med_phases_aofluxes_mod.F90 | 2 +- ufs/flux_atmocn_ccpp_mod.F90 | 135 ++++++++++++++++++++++----- 2 files changed, 113 insertions(+), 24 deletions(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 4df830fbc..25417b546 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1053,7 +1053,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) #else #ifdef UFS_AOFLUX if (trim(aoflux_code) == 'ccpp') then - call flux_atmocn_ccpp( & + call flux_atmocn_ccpp(gcomp=gcomp, mastertask=mastertask, logunit=logunit, & nMax=aoflux_in%lsize, psfc=aoflux_in%psfc, & pbot=aoflux_in%pbot, tbot=aoflux_in%tbot, qbot=aoflux_in%shum, lwdn=aoflux_in%lwdn, & zbot=aoflux_in%zbot, garea=aoflux_in%garea, ubot=aoflux_in%ubot, usfc=aoflux_in%usfc, vbot=aoflux_in%vbot, & diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index 10dbde4d2..ba868c653 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -1,12 +1,16 @@ module flux_atmocn_ccpp_mod - use med_kind_mod, only : R8=>SHR_KIND_R8 + use ESMF, only : ESMF_GridComp, ESMF_SUCCESS + use NUOPC, only : NUOPC_CompAttributeGet + + use med_kind_mod, only : R8=>SHR_KIND_R8, CS=>SHR_KIND_CS use physcons, only : p0 => con_p0 use physcons, only : cappa => con_rocp use physcons, only : cp => con_cp use physcons, only : hvap => con_hvap use physcons, only : sbc => con_sbc use MED_data, only : physics + use med_utils_mod, only : chkerr => med_utils_chkerr use med_ccpp_driver, only : med_ccpp_driver_init use med_ccpp_driver, only : med_ccpp_driver_run use med_ccpp_driver, only : med_ccpp_driver_finalize @@ -19,17 +23,23 @@ module flux_atmocn_ccpp_mod public :: flux_atmOcn_ccpp ! computes atm/ocn fluxes + character(*), parameter :: u_FILE_u = & + __FILE__ + !=============================================================================== contains !=============================================================================== - subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & - garea, ubot, usfc, vbot, vsfc, rbot, ts, lwdn, sen, lat, & + subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, & + tbot, qbot, zbot, garea, ubot, usfc, vbot, vsfc, rbot, ts, lwdn, sen, lat, & lwup, evp, taux, tauy, qref, missval) implicit none !--- input arguments -------------------------------- + type(ESMF_GridComp), intent(in) :: gcomp ! gridded component + logical , intent(in) :: mastertask ! master task + integer , intent(in) :: logunit ! log file unit number integer , intent(in) :: nMax ! data vector length integer , intent(in) :: mask (nMax) ! ocn domain mask real(r8), intent(in) :: psfc(nMax) ! atm P (surface) (Pa) @@ -57,12 +67,17 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & real(r8), intent(out) :: qref(nMax) ! diag: 2m ref humidity (kg/kg) !--- local variables -------------------------------- - integer :: n - real(r8) :: spval, semis_water - logical, save :: first_call = .true. - character(len=*),parameter :: subname=' (flux_atmOcn_ccpp) ' + integer :: n, rc + real(r8) :: spval + logical :: isPresent, isSet + character(len=cs) :: cvalue + real(r8), save :: semis_water + logical, save :: first_call = .true. + character(len=*), parameter :: subname=' (flux_atmOcn_ccpp) ' !--------------------------------------- + rc = ESMF_SUCCESS + ! missing value if (present(missval)) then spval = missval @@ -70,12 +85,96 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & spval = shr_const_spval endif - ! set up surface emissivity for lw radiation - ! semis_wat is constant and set to 0.97 in setemis() call - ! TODO: This could be a part of CCPP suite or provided by ESMF config - semis_water = 0.97 - + ! init CCPP and setup/allocate variables if (first_call) then + ! determine CCPP/physics specific options + ! semis_water, surface emissivity for lw radiation + ! semis_wat is constant and set to 0.97 in setemis() call + call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_semis_water", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + semis_water = 0.97 + if (isPresent .and. isSet) then + read(cvalue,*) semis_water + end if + ! lseaspray + call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_lseaspray", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%model%lseaspray = .true. + if (isPresent .and. isSet) then + if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%lseaspray = .false. + end if + ! ivegsrc + call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_ivegsrc", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%model%ivegsrc = 1 + if (isPresent .and. isSet) then + read(cvalue,*) physics%model%ivegsrc + end if + ! redrag + call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_redrag", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%model%redrag = .true. + if (isPresent .and. isSet) then + if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%redrag = .false. + end if + ! lsm + call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_lsm", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%model%lsm = 1 + if (isPresent .and. isSet) then + read(cvalue,*) physics%model%lsm + end if + ! frac_grid + call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_frac_grid", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%model%frac_grid = .true. + if (isPresent .and. isSet) then + if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%frac_grid = .false. + end if + ! restart + call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_restart", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%model%restart = .true. + if (isPresent .and. isSet) then + if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%restart = .false. + end if + ! cplice + call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_cplice", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%model%cplice = .true. + if (isPresent .and. isSet) then + if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%cplice = .false. + end if + ! cplflx + call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_cplflx", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%model%cplflx = .true. + if (isPresent .and. isSet) then + if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%cplflx = .false. + end if + ! lheatstrg + call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_lheatstrg", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%model%lheatstrg = .true. + if (isPresent .and. isSet) then + if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%lheatstrg = .false. + end if + + if (mastertask) then + write(logunit,*) '========================================================' + write(logunit,'(a,f5.2)') trim(subname)//' ccpp_phy_semis_water = ', semis_water + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_lseaspray = ', physics%model%lseaspray + write(logunit,'(a,i)') trim(subname)//' ccpp_phy_ivegsrc = ', physics%model%ivegsrc + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_redrag = ', physics%model%redrag + write(logunit,'(a,i)') trim(subname)//' ccpp_phy_lsm = ', physics%model%lsm + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_frac_grid = ', physics%model%frac_grid + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_restart = ', physics%model%restart + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_cplice = ', physics%model%cplice + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_cplflx = ', physics%model%cplflx + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_lheatstrg = ', physics%model%lheatstrg + write(logunit,*) '========================================================' + end if + ! allocate and initalize data structures call physics%statein%create(nMax,physics%model) call physics%interstitial%create(nMax) @@ -113,18 +212,8 @@ subroutine flux_atmOcn_ccpp(nMax, mask, psfc, pbot, tbot, qbot, zbot, & ! fill in grid related variables physics%grid%area(:) = garea(:) - ! customization of host model options to calculate the fluxes - ! TODO: this needs to be provided by config - physics%model%lseaspray = .true. - physics%model%ivegsrc = 1 - physics%model%redrag = .true. - physics%model%lsm = 2 - physics%model%frac_grid = .true. - physics%model%restart = .true. - physics%model%cplice = .true. - physics%model%cplflx = .true. + ! set counter physics%model%kdt = physics%model%kdt+1 - physics%model%lheatstrg = .true. ! reset physics variables call physics%interstitial%phys_reset() From ef360eabd92e5dac3e3bae6e553c13fdea87d252 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Fri, 22 Apr 2022 16:33:32 -0400 Subject: [PATCH 050/395] Refactor nems field exchange; set default masks for mapping in med_internalstate (#279) Refactors esmFldsExchange_nems.F90 to use separate advertise and initialize phases and to check that a component is present before advertising a field to or from that component. Implements default src and dst mask values in place of the code currently in med_map_mod.F90. Fixes #63 and #64. --- mediator/esmFldsExchange_nems_mod.F90 | 645 +++++++++++++++++--------- mediator/med.F90 | 15 +- mediator/med_internalstate_mod.F90 | 56 ++- mediator/med_map_mod.F90 | 62 +-- mediator/med_phases_post_lnd_mod.F90 | 2 +- mediator/med_phases_prep_atm_mod.F90 | 8 +- mediator/med_time_mod.F90 | 4 +- 7 files changed, 515 insertions(+), 277 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 81def7650..436232652 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -24,12 +24,13 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use NUOPC use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_utils_mod , only : chkerr => med_utils_chkerr + use med_methods_mod , only : fldchk => med_methods_FB_FldChk use med_internalstate_mod , only : InternalState use med_internalstate_mod , only : mastertask, logunit use med_internalstate_mod , only : compmed, compatm, compocn, compice, comprof, compwav, ncomps use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf - use med_internalstate_mod , only : mapconsf_aofrac + use med_internalstate_mod , only : mapconsf_aofrac, mapbilnr_nstod use med_internalstate_mod , only : coupling_mode, mapnames use esmFlds , only : med_fldList_type use esmFlds , only : addfld => med_fldList_AddFld @@ -48,12 +49,16 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) character(len=CX) :: msgString character(len=CL) :: cvalue character(len=CS) :: fldname - character(len=CS), allocatable :: flds(:) + character(len=CS), allocatable :: flds(:), oflds(:), aflds(:), iflds(:) character(len=*) , parameter :: subname='(esmFldsExchange_nems)' !-------------------------------------- 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 @@ -71,59 +76,82 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! scalar information !===================================================================== - 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 + if (phase == 'advertise') 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 !===================================================================== ! Mediator fields !===================================================================== ! masks from components - call addfld(fldListFr(compice)%flds, 'Si_imask') - call addfld(fldListFr(compocn)%flds, 'So_omask') - call addmap(fldListFr(compocn)%flds, 'So_omask', compice, mapfcopy, 'unset', 'unset') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice)) call addfld(fldListFr(compice)%flds, 'Si_imask') + if (is_local%wrap%comp_present(compocn)) call addfld(fldListFr(compocn)%flds, 'So_omask') + else + 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, 'So_omask', compice, mapfcopy, 'unset', 'unset') + end if + end if if ( trim(coupling_mode) == 'nems_orig_data') then - ! atm and ocn fields required for atm/ocn flux calculation' - allocate(flds(10)) - flds = (/'Sa_u ','Sa_v ', 'Sa_z ', 'Sa_tbot', 'Sa_pbot', 'Sa_shum', & - 'Sa_u10m','Sa_v10m', 'Sa_t2m ', 'Sa_q2m '/) - do n = 1,size(flds) - fldname = trim(flds(n)) - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'one', 'unset') - end do - deallocate(flds) - - ! unused fields needed by the atm/ocn flux computation - allocate(flds(13)) - flds = (/'So_tref ', 'So_qref ','So_u10 ', 'So_ustar ','So_ssq ', & - 'So_re ', 'So_duu10n','Faox_lwup', 'Faox_sen ','Faox_lat ', & - 'Faox_evap', 'Faox_taux','Faox_tauy'/) - do n = 1,size(flds) - fldname = trim(flds(n)) - call addfld(fldListMed_aoflux%flds, trim(fldname)) - end do - deallocate(flds) + ! atm fields required for atm/ocn flux calculation + allocate(flds(10)) + flds = (/'Sa_u ', 'Sa_v ', 'Sa_z ', 'Sa_tbot', 'Sa_pbot', & + 'Sa_shum', 'Sa_u10m', 'Sa_v10m', 'Sa_t2m ', 'Sa_q2m '/) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) )then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + end if + else + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'one', 'unset') + end if + end if + end do + deallocate(flds) + + ! fields returned by the atm/ocn flux computation which are otherwise unadvertised + allocate(flds(8)) + flds = (/'So_tref ', 'So_qref ', 'So_ustar ', 'So_re ','So_ssq ', & + 'So_u10 ', 'So_duu10n', 'Faox_lat '/) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListMed_aoflux%flds, trim(fldname)) + end if + end do + deallocate(flds) end if - ! unused fields from ice - but that are needed to be realized by the cice cap - call addfld(fldListFr(compice)%flds, 'Faii_evap') - call addfld(fldListFr(compice)%flds, 'mean_sw_pen_to_ocn') + ! TODO: unused, but required to maintain B4B repro for mediator restarts; should be removed + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, 'mean_sw_pen_to_ocn') + end if !===================================================================== ! FIELDS TO ATMOSPHERE (compatm) !===================================================================== ! to atm: fractions (computed in med_phases_prep_atm) - call addfld(fldListFr(compice)%flds, 'Si_ifrac') - call addfld(fldListTo(compatm)%flds, 'Si_ifrac') - ! ofrac used by atm - call addfld(fldListFr(compatm)%flds, 'Sa_ofrac') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm)) then + call addfld(fldListFr(compice)%flds, 'Si_ifrac') + call addfld(fldListTo(compatm)%flds, 'Si_ifrac') + end if + ! ofrac used by atm + if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compatm)) then + call addfld(fldListFr(compatm)%flds, 'Sa_ofrac') + end if + end if ! to atm: unmerged from ice ! - zonal surface stress, meridional surface stress @@ -135,44 +163,70 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! - mean snow volume per unit area ! - surface temperatures allocate(flds(9)) - flds = (/'Faii_taux', 'Faii_tauy', 'Faii_lat ', & - 'Faii_sen ', 'Faii_lwup', 'Faii_evap', & - 'Si_vice ', 'Si_vsno ', 'Si_t '/) + flds = (/'Faii_taux', 'Faii_tauy', 'Faii_lat ', 'Faii_sen ', 'Faii_lwup', & + 'Faii_evap', 'Si_vice ', 'Si_vsno ', 'Si_t '/) do n = 1,size(flds) fldname = trim(flds(n)) - call addfld(fldListFr(compice)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) - call addmap(fldListFr(compice)%flds, trim(fldname), compatm, maptype, 'ifrac', 'unset') - call addmrg(fldListTo(compatm)%flds, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm)) then + call addfld(fldListFr(compice)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) + end if + else + 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(fldListFr(compice)%flds, trim(fldname), compatm, maptype, 'ifrac', 'unset') + call addmrg(fldListTo(compatm)%flds, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + end if + end if end do deallocate(flds) allocate(flds(4)) - flds = (/'avsdr ', 'avsdf ', & - 'anidr ', 'anidf '/) + flds = (/'Si_avsdr', 'Si_avsdf', 'Si_anidr', 'Si_anidf'/) do n = 1,size(flds) - fldname = 'Si_'//trim(flds(n)) - call addfld(fldListFr(compice)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) - call addmap(fldListFr(compice)%flds, trim(fldname), compatm, maptype, 'ifrac', 'unset') - call addmrg(fldListTo(compatm)%flds, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm)) then + call addfld(fldListFr(compice)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) + end if + else + 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(fldListFr(compice)%flds, trim(fldname), compatm, maptype, 'ifrac', 'unset') + call addmrg(fldListTo(compatm)%flds, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + end if + end if end do deallocate(flds) ! to atm: unmerged surface temperatures from ocn - call addfld(fldListFr(compocn)%flds, 'So_t') - call addfld(fldListTo(compatm)%flds, 'So_t') - call addmap(fldListFr(compocn)%flds, 'So_t', compatm, maptype, 'ofrac', 'unset') - call addmrg(fldListTo(compatm)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') - - ! temporary conditional to avoid conflicts of advertised fields - ! when waves are passing through connectors - if (is_local%wrap%comp_present(compwav)) then - ! to atm: surface roughness length from wav - call addfld(fldListFr(compwav)%flds, 'Sw_z0') - call addfld(fldListTo(compatm)%flds, 'Sw_z0') - call addmap(fldListFr(compwav)%flds, 'Sw_z0', compatm, mapnstod_consf, 'one', 'unset') - call addmrg(fldListTo(compatm)%flds, 'Sw_z0', mrg_from=compwav, mrg_fld='Sw_z0', mrg_type='copy') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compatm)) then + call addfld(fldListFr(compocn)%flds, 'So_t') + call addfld(fldListTo(compatm)%flds, 'So_t') + end if + else + if ( fldchk(is_local%wrap%FBexp(compatm) , 'So_t', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_t', rc=rc)) then + call addmap(fldListFr(compocn)%flds, 'So_t', compatm, maptype, 'ofrac', 'unset') + call addmrg(fldListTo(compatm)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + end if + end if + + ! to atm: surface roughness length from wav + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compatm)) then + call addfld(fldListFr(compwav)%flds, 'Sw_z0') + call addfld(fldListTo(compatm)%flds, 'Sw_z0') + end if + else + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sw_z0', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav,compwav), 'Sw_z0', rc=rc)) then + call addmap(fldListFr(compwav)%flds, 'Sw_z0', compatm, mapnstod_consf, 'one', 'unset') + call addmrg(fldListTo(compatm)%flds, 'Sw_z0', mrg_from=compwav, mrg_fld='Sw_z0', mrg_type='copy') + end if end if !===================================================================== @@ -180,116 +234,223 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) !===================================================================== ! to ocn: sea level pressure from atm - call addfld(fldListTo(compocn)%flds, 'Sa_pslv') - call addfld(fldListFr(compatm)%flds, 'Sa_pslv') - call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, maptype, 'one', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Sa_pslv', mrg_from=compatm, mrg_fld='Sa_pslv', mrg_type='copy') - - ! to ocn: from atm (custom merge in med_phases_prep_ocn) - ! - downward direct near-infrared incident solar radiation - ! - downward diffuse near-infrared incident solar radiation - ! - downward dirrect visible incident solar radiation - ! - downward diffuse visible incident solar radiation - allocate(flds(4)) - flds = (/'Faxa_swndr', 'Faxa_swndf', 'Faxa_swvdr', 'Faxa_swvdf'/) - do n = 1,size(flds) - fldname = trim(flds(n)) - call addfld(fldListTo(compocn)%flds, trim(fldname)) - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'one', 'unset') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListFr(compatm)%flds, 'Sa_pslv') + call addfld(fldListTo(compocn)%flds, 'Sa_pslv') + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Sa_pslv', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_pslv', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, maptype, 'one', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Sa_pslv', mrg_from=compatm, mrg_fld='Sa_pslv', mrg_type='copy') + end if + end if + + ! to ocn: from sw from atm and sw net from ice (custom merge in med_phases_prep_ocn) + ! - downward direct near-infrared ("n" or "i") incident solar radiation + ! - downward diffuse near-infrared ("n" or "i") incident solar radiation + ! - downward direct visible ("v") incident solar radiation + ! - downward diffuse visible ("v") incident solar radiation + allocate(oflds(4)) + allocate(aflds(4)) + allocate(iflds(4)) + oflds = (/'Foxx_swnet_idr', 'Foxx_swnet_idf', 'Foxx_swnet_vdr', 'Foxx_swnet_vdf'/) + aflds = (/'Faxa_swndr' , 'Faxa_swndf' , 'Faxa_swvdr' , 'Faxa_swvdf'/) + iflds = (/'Fioi_swpen_idr', 'Fioi_swpen_idf', 'Fioi_swpen_vdr', 'Fioi_swpen_vdf'/) + do n = 1,size(oflds) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListFr(compatm)%flds, trim(aflds(n))) + call addfld(fldListTo(compocn)%flds, trim(oflds(n))) + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , trim(oflds(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), trim(aflds(n)), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(aflds(n)), compocn, maptype, 'one', 'unset') + end if + end if end do - deallocate(flds) - ! to ocn: from ice net shortwave radiation (custom merge in med_phases_prep_ocn) - ! - downward direct near-infrared incident solar radiation - ! - downward diffuse near-infrared incident solar radiation - ! - downward dirrect visible incident solar radiation - ! - downward diffuse visible incident solar radiation - allocate(flds(4)) - flds = (/'vdr', 'vdf', 'idr', 'idf'/) - do n = 1,size(flds) - call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_'//trim(flds(n))) - call addfld(fldListFr(compice)%flds, 'Fioi_swpen_'//trim(flds(n))) - call addmap(fldListFr(compice)%flds, 'Fioi_swpen_'//trim(flds(n)), compocn, mapfcopy, 'unset', 'unset') + do n = 1,size(oflds) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListFr(compice)%flds, trim(iflds(n))) + call addfld(fldListTo(compocn)%flds, trim(oflds(n))) + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , trim(oflds(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), trim(iflds(n)), rc=rc)) then + call addmap(fldListFr(compice)%flds, trim(iflds(n)), compocn, mapfcopy, 'unset', 'unset') + end if + end if end do - deallocate(flds) + deallocate(oflds) + deallocate(aflds) + deallocate(iflds) ! to ocn: rain and snow via auto merge allocate(flds(2)) flds = (/'Faxa_rain', 'Faxa_snow'/) do n = 1,size(flds) fldname = trim(flds(n)) - call addfld(fldListTo(compocn)%flds, trim(fldname)) - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'one', 'unset') - call addmrg(fldListTo(compocn)%flds, trim(fldname), & - mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='ofrac') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compocn)%flds, trim(fldname)) + end if + else + 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, maptype, 'one', 'unset') + call addmrg(fldListTo(compocn)%flds, trim(fldname), & + mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + end if end do deallocate(flds) if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then ! to ocn: merge surface stress (custom merge calculation in med_phases_prep_ocn) - allocate(flds(2)) - flds = (/'taux', 'tauy'/) - do n = 1,size(flds) - call addfld(fldListTo(compocn)%flds, 'Foxx_'//trim(flds(n))) - call addfld(fldListFr(compice)%flds, 'Fioi_'//trim(flds(n))) - call addfld(fldListFr(compatm)%flds, 'Faxa_'//trim(flds(n))) - call addmap(fldListFr(compatm)%flds, 'Faxa_'//trim(flds(n)), compocn, mapconsf_aofrac, 'aofrac', 'unset') - call addmap(fldListFr(compice)%flds, 'Fioi_'//trim(flds(n)), compocn, mapfcopy, 'unset', 'unset') + allocate(oflds(2)) + allocate(aflds(2)) + allocate(iflds(2)) + oflds = (/'Foxx_taux', 'Foxx_tauy'/) + aflds = (/'Faxa_taux', 'Faxa_tauy'/) + iflds = (/'Fioi_taux', 'Fioi_tauy'/) + do n = 1,size(oflds) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm) & + .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListFr(compice)%flds, trim(iflds(n))) + call addfld(fldListFr(compatm)%flds, trim(aflds(n))) + call addfld(fldListTo(compocn)%flds, trim(oflds(n))) + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , trim(oflds(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), trim(iflds(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), trim(aflds(n)), rc=rc)) then + call addmap(fldListFr(compice)%flds, trim(iflds(n)), compocn, mapfcopy, 'unset', 'unset') + call addmap(fldListFr(compatm)%flds, trim(aflds(n)), compocn, mapconsf_aofrac, 'aofrac', 'unset') + end if + end if end do - deallocate(flds) + deallocate(oflds) + deallocate(aflds) + deallocate(iflds) ! to ocn: net long wave via auto merge - call addfld(fldListTo(compocn)%flds, 'Faxa_lwnet') - call addfld(fldListFr(compatm)%flds, 'Faxa_lwnet') - call addmap(fldListFr(compatm)%flds, 'Faxa_lwnet', compocn, mapconsf_aofrac, 'aofrac', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Faxa_lwnet', & - mrg_from=compatm, mrg_fld='Faxa_lwnet', mrg_type='copy_with_weights', mrg_fracname='ofrac') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListFr(compatm)%flds, 'Faxa_lwnet') + call addfld(fldListTo(compocn)%flds, 'Faxa_lwnet') + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_lwnet', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwnet', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_lwnet', compocn, mapconsf_aofrac, 'aofrac', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Faxa_lwnet', & + mrg_from=compatm, mrg_fld='Faxa_lwnet', mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + end if ! to ocn: merged sensible heat flux (custom merge in med_phases_prep_ocn) - call addfld(fldListTo(compocn)%flds, 'Faxa_sen') - call addfld(fldListFr(compatm)%flds, 'Faxa_sen') - call addmap(fldListFr(compatm)%flds, 'Faxa_sen', compocn, mapconsf_aofrac, 'aofrac', 'unset') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListFr(compatm)%flds, 'Faxa_sen') + call addfld(fldListTo(compocn)%flds, 'Faxa_sen') + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_sen', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_sen', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_sen', compocn, mapconsf_aofrac, 'aofrac', 'unset') + end if + end if ! to ocn: evaporation water flux (custom merge in med_phases_prep_ocn) - call addfld(fldListTo(compocn)%flds, 'Faxa_evap') - call addfld(fldListFr(compatm)%flds, 'Faxa_lat') - call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, mapconsf_aofrac, 'aofrac', 'unset') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListFr(compatm)%flds, 'Faxa_lat') + call addfld(fldListTo(compocn)%flds, 'Faxa_evap') + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_evap', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lat' , rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, mapconsf_aofrac, 'aofrac', 'unset') + end if + end if else ! nems_orig_data ! to ocn: surface stress from mediator and ice stress via auto merge allocate(flds(2)) flds = (/'taux', 'tauy'/) do n = 1,size(flds) - call addfld(fldListTo(compocn)%flds , 'Foxx_'//trim(flds(n))) - call addfld(fldListFr(compice)%flds , 'Fioi_'//trim(flds(n))) - call addmap(fldListFr(compice)%flds, 'Fioi_'//trim(flds(n)), compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Foxx_'//trim(flds(n)), & - mrg_from=compmed, mrg_fld='Faox_'//trim(flds(n)), mrg_type='merge', mrg_fracname='ofrac') - call addmrg(fldListTo(compocn)%flds, 'Foxx_'//trim(flds(n)), & - mrg_from=compice, mrg_fld='Fioi_'//trim(flds(n)), mrg_type='merge', mrg_fracname='ifrac') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListMed_aoflux%flds , 'Faox_'//trim(flds(n))) + call addfld(fldListFr(compice)%flds , 'Fioi_'//trim(flds(n))) + call addfld(fldListTo(compocn)%flds , 'Foxx_'//trim(flds(n))) + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_'//trim(flds(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_'//trim(flds(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_'//trim(flds(n)), rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_'//trim(flds(n)), compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Foxx_'//trim(flds(n)), & + mrg_from=compmed, mrg_fld='Faox_'//trim(flds(n)), mrg_type='merge', mrg_fracname='ofrac') + call addmrg(fldListTo(compocn)%flds, 'Foxx_'//trim(flds(n)), & + mrg_from=compice, mrg_fld='Fioi_'//trim(flds(n)), mrg_type='merge', mrg_fracname='ifrac') + end if + end if end do deallocate(flds) ! to ocn: long wave net via auto merge - call addfld(fldListTo(compocn)%flds, 'Foxx_lwnet') - call addfld(fldListFr(compatm)%flds, 'Faxa_lwdn') - call addmap(fldListFr(compatm)%flds, 'Faxa_lwdn', compocn, maptype, 'one', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Foxx_lwnet', & - mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') - call addmrg(fldListTo(compocn)%flds, 'Foxx_lwnet', & - mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='merge', mrg_fracname='ofrac') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListMed_aoflux%flds , 'Faox_lwup') + call addfld(fldListFr(compatm)%flds, 'Faxa_lwdn') + call addfld(fldListTo(compocn)%flds, 'Foxx_lwnet') + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_lwnet', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_lwup' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn' , rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_lwdn', compocn, maptype, 'one', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Foxx_lwnet', & + mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') + call addmrg(fldListTo(compocn)%flds, 'Foxx_lwnet', & + mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='merge', mrg_fracname='ofrac') + end if + end if ! to ocn: sensible heat flux from mediator via auto merge - call addfld(fldListTo(compocn)%flds, 'Faox_sen') - call addmrg(fldListTo(compocn)%flds, 'Faox_sen', & - mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='copy_with_weights', mrg_fracname='ofrac') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compocn)) then + call addfld(fldListMed_aoflux%flds , 'Faox_sen') + call addfld(fldListTo(compocn)%flds, 'Faox_sen') + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faox_sen', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_sen' , rc=rc)) then + call addmrg(fldListTo(compocn)%flds, 'Faox_sen', & + mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + end if ! to ocn: evaporation water flux from mediator via auto merge - call addfld(fldListTo(compocn)%flds, 'Faox_evap') - call addmrg(fldListTo(compocn)%flds, 'Faox_evap', & - mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='copy_with_weights', mrg_fracname='ofrac') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compocn)) then + call addfld(fldListMed_aoflux%flds , 'Faox_evap') + call addfld(fldListTo(compocn)%flds, 'Faox_evap') + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faox_evap', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_evap' , rc=rc)) then + call addmrg(fldListTo(compocn)%flds, 'Faox_evap', & + mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + end if end if ! to ocn: water flux due to melting ice from ice @@ -299,30 +460,42 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) flds = (/'Fioi_meltw', 'Fioi_melth', 'Fioi_salt '/) do n = 1,size(flds) fldname = trim(flds(n)) - call addfld(fldListFr(compice)%flds, trim(fldname)) - call addfld(fldListTo(compocn)%flds, trim(fldname)) - call addmap(fldListFr(compice)%flds, trim(fldname), compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, trim(fldname), & - mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='ifrac') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListFr(compice)%flds, trim(fldname)) + call addfld(fldListTo(compocn)%flds, trim(fldname)) + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), trim(fldname), rc=rc)) then + call addmap(fldListFr(compice)%flds, trim(fldname), compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, trim(fldname), & + mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='ifrac') + end if + end if end do deallocate(flds) - ! temporary conditional to avoid conflicts of advertised fields - ! when waves are passing through connectors - if (is_local%wrap%comp_present(compwav)) then - ! to ocn: partitioned stokes drift from wav - allocate(flds(6)) - flds = (/'Sw_ustokes1', 'Sw_ustokes2', 'Sw_ustokes3', & - 'Sw_vstokes1', 'Sw_vstokes2', 'Sw_vstokes3'/) - do n = 1,size(flds) - fldname = trim(flds(n)) - call addfld(fldListTo(compocn)%flds, trim(fldname)) - call addfld(fldListFr(compwav)%flds, trim(fldname)) - call addmap(fldListFr(compwav)%flds, trim(fldname), compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, trim(fldname), mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') - end do - deallocate(flds) - end if + ! to ocn: partitioned stokes drift from wav + allocate(flds(6)) + flds = (/'Sw_ustokes1', 'Sw_ustokes2', 'Sw_ustokes3', & + 'Sw_vstokes1', 'Sw_vstokes2', 'Sw_vstokes3'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListFr(compwav)%flds, trim(fldname)) + call addfld(fldListTo(compocn)%flds, trim(fldname)) + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav,compwav), trim(fldname), rc=rc)) then + call addmap(fldListFr(compwav)%flds, trim(fldname), compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, trim(fldname), mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') + end if + end if + end do + deallocate(flds) !===================================================================== ! FIELDS TO ICE (compice) @@ -338,14 +511,22 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ice: snow from atm allocate(flds(7)) - flds = (/'Faxa_lwdn ' , 'Faxa_swndr ' , 'Faxa_swvdr ' , 'Faxa_swndf ' , 'Faxa_swvdf ', & - 'Faxa_rain ' , 'Faxa_snow '/) + flds = (/'Faxa_lwdn ', 'Faxa_swndr', 'Faxa_swvdr', 'Faxa_swndf', 'Faxa_swvdf', & + 'Faxa_rain ', 'Faxa_snow '/) do n = 1,size(flds) fldname = trim(flds(n)) - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(compice)%flds, trim(fldname)) - call addmap(fldListFr(compatm)%flds, trim(fldname), compice, maptype, 'one', 'unset') - call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compice)) then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compice)%flds, trim(fldname)) + end if + else + 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, maptype, 'one', 'unset') + call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end if + end if end do deallocate(flds) @@ -357,13 +538,22 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ice: meridional wind at the lowest model level from atm ! to ice: specific humidity at the lowest model level from atm allocate(flds(6)) - flds = (/'Sa_z ', 'Sa_pbot ', 'Sa_tbot ','Sa_u ','Sa_v ','Sa_shum '/) + flds = (/'Sa_u ', 'Sa_v ', 'Sa_z ', 'Sa_tbot', 'Sa_pbot', & + 'Sa_shum'/) do n = 1,size(flds) fldname = trim(flds(n)) - call addfld(fldListTo(compice)%flds, trim(fldname)) - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addmap(fldListFr(compatm)%flds, trim(fldname), compice, maptype, 'one', 'unset') - call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compice)) then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compice)%flds, trim(fldname)) + endif + else + 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, maptype, 'one', 'unset') + call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end if + end if end do deallocate(flds) @@ -376,13 +566,22 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ice: meridional sea surface slope from ocn ! to ice: ocean melt and freeze potential from ocn allocate(flds(7)) - flds = (/'So_t ', 'So_s ', 'So_u ', 'So_v ','So_dhdx', 'So_dhdy', 'Fioo_q '/) + flds = (/'So_t ', 'So_s ', 'So_u ', 'So_v ','So_dhdx', & + 'So_dhdy', 'Fioo_q '/) do n = 1,size(flds) fldname = trim(flds(n)) - call addfld(fldListTo(compice)%flds, trim(fldname)) - call addfld(fldListFr(compocn)%flds, trim(fldname)) - 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') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compice)) then + call addfld(fldListFr(compocn)%flds, trim(fldname)) + call addfld(fldListTo(compice)%flds, trim(fldname)) + endif + else + 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 if end do deallocate(flds) @@ -390,41 +589,61 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! FIELDS TO WAV (compwav) !===================================================================== - ! temporary conditional to avoid conflicts of advertised fields - ! when waves are passing through connectors - if (is_local%wrap%comp_present(compwav)) then - ! to wav - 10m winds and bottom temperature from atm - allocate(flds(3)) - flds = (/'Sa_u10m', 'Sa_v10m', 'Sa_tbot'/) - do n = 1,size(flds) - fldname = trim(flds(n)) - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(compwav)%flds, trim(fldname)) - call addmap(fldListFr(compatm)%flds, trim(fldname), compwav, mapnstod_consf, 'one', 'unset') - call addmrg(fldListTo(compwav)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') - end do - deallocate(flds) - - ! to wav: sea ice fraction - call addfld(fldListTo(compwav)%flds, 'Si_ifrac') - call addfld(fldListFr(compice)%flds, 'Si_ifrac') - call addmap(fldListFr(compice)%flds, 'Si_ifrac', compwav, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compwav)%flds, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') - - ! to wav: zonal sea water velocity from ocn - ! to wav: meridional sea water velocity from ocn - ! to wav: surface temperature from ocn - allocate(flds(3)) - flds = (/'So_u', 'So_v', 'So_t'/) - do n = 1,size(flds) - fldname = trim(flds(n)) - call addfld(fldListTo(compwav)%flds, trim(fldname)) - call addfld(fldListFr(compocn)%flds, trim(fldname)) - call addmap(fldListFr(compocn)%flds, trim(fldname), compwav, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compwav)%flds, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') - end do - deallocate(flds) - end if + ! to wav - 10m winds and bottom temperature from atm + allocate(flds(3)) + flds = (/'Sa_u10m', 'Sa_v10m', 'Sa_tbot'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compwav)) then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compwav)%flds, trim(fldname)) + end if + else + if ( fldchk(is_local%wrap%FBexp(compwav) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), compwav, mapnstod_consf, 'one', 'unset') + call addmrg(fldListTo(compwav)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end if + end if + end do + deallocate(flds) + + ! to wav: sea ice fraction + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compwav)) then + call addfld(fldListFr(compice)%flds, 'Si_ifrac') + call addfld(fldListTo(compwav)%flds, 'Si_ifrac') + end if + else + if ( fldchk(is_local%wrap%FBexp(compwav) , 'Si_ifrac', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Si_ifrac', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_ifrac', compwav, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compwav)%flds, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') + end if + end if + + ! to wav: zonal sea water velocity from ocn + ! to wav: meridional sea water velocity from ocn + ! to wav: surface temperature from ocn + allocate(flds(3)) + flds = (/'So_u', 'So_v', 'So_t'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compwav)) then + call addfld(fldListFr(compocn)%flds, trim(fldname)) + call addfld(fldListTo(compwav)%flds, trim(fldname)) + end if + else + if ( fldchk(is_local%wrap%FBexp(compwav) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), trim(fldname), rc=rc)) then + call addmap(fldListFr(compocn)%flds, trim(fldname), compwav, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compwav)%flds, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + end if + end if + end do + deallocate(flds) end subroutine esmFldsExchange_nems diff --git a/mediator/med.F90 b/mediator/med.F90 index 6be7a2f55..92be267e1 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -25,7 +25,6 @@ module MED use med_constants_mod , only : spval_init => med_constants_spval_init use med_constants_mod , only : spval => med_constants_spval use med_constants_mod , only : czero => med_constants_czero - use med_constants_mod , only : ispval_mask => med_constants_ispval_mask use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : Field_GeomPrint => med_methods_Field_GeomPrint use med_methods_mod , only : State_GeomPrint => med_methods_State_GeomPrint @@ -41,7 +40,7 @@ module MED use med_utils_mod , only : memcheck => med_memcheck use med_time_mod , only : med_time_alarmInit use med_internalstate_mod , only : InternalState, med_internalstate_init, med_internalstate_coupling - use med_internalstate_mod , only : logunit, mastertask + use med_internalstate_mod , only : med_internalstate_defaultmasks, logunit, mastertask use med_internalstate_mod , only : ncomps, compname use med_internalstate_mod , only : compmed, compatm, compocn, compice, complnd, comprof, compwav, compglc use med_internalstate_mod , only : coupling_mode @@ -654,13 +653,14 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) ! TransferOfferGeomObject Attribute. use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_SUCCESS, ESMF_LogFoundAllocError - use ESMF , only : ESMF_StateIsCreated + use ESMF , only : ESMF_StateIsCreated use ESMF , only : ESMF_LogMsg_Info, ESMF_LogWrite use ESMF , only : ESMF_END_ABORT, ESMF_Finalize, ESMF_MAXSTR use NUOPC , only : NUOPC_AddNamespace, NUOPC_Advertise, NUOPC_AddNestedState use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use esmFlds, only : med_fldlist_init1 use med_phases_history_mod, only : med_phases_history_init + use med_internalstate_mod , only : atm_name ! input/output variables type(ESMF_GridComp) :: gcomp @@ -783,8 +783,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) if (trim(coupling_mode) == 'cesm') then call esmFldsExchange_cesm(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac' & - .or. trim(coupling_mode) == 'nems_orig_data') then + else if (trim(coupling_mode(1:4)) == 'nems') then call esmFldsExchange_nems(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode(1:4)) == 'hafs') then @@ -795,6 +794,10 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) call ESMF_Finalize(endflag=ESMF_END_ABORT) end if + ! Set default masking for mapping + call med_internalstate_defaultmasks(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !------------------ ! Determine component present indices !------------------ @@ -1746,6 +1749,8 @@ subroutine DataInitialize(gcomp, rc) if (trim(coupling_mode) == 'cesm') then call esmFldsExchange_cesm(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + else if (trim(coupling_mode(1:4)) == 'nems') then + call esmFldsExchange_nems(gcomp, phase='initialize', rc=rc) else if (trim(coupling_mode) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 8286118a9..b9b61e85e 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -15,6 +15,7 @@ module med_internalstate_mod ! public routines public :: med_internalstate_init public :: med_internalstate_coupling + public :: med_internalstate_defaultmasks integer, public :: logunit ! logunit for mediator log output integer, public :: diagunit ! diagunit for budget output (med master only) @@ -48,6 +49,9 @@ module med_internalstate_mod ! Coupling mode character(len=CS), public :: coupling_mode ! valid values are [cesm,nems_orig,nems_frac,nems_orig_data,hafs] + ! Default src and destination masks for mapping + integer, public, allocatable :: defaultMasks(:,:) + ! Mapping integer , public, parameter :: mapunset = 0 integer , public, parameter :: mapbilnr = 1 @@ -113,7 +117,7 @@ module med_internalstate_mod logical, pointer :: med_coupling_active(:,:) ! computes the active coupling integer :: num_icesheets ! obtained from attribute logical :: ocn2glc_coupling = .false. ! obtained from attribute - logical :: lnd2glc_coupling = .false. + logical :: lnd2glc_coupling = .false. logical :: accum_lnd2glc = .false. ! Mediator vm @@ -187,8 +191,8 @@ module med_internalstate_mod subroutine med_internalstate_init(gcomp, rc) - use ESMF , only : ESMF_LogFoundAllocError, ESMF_AttributeGet - use NUOPC_Comp , only : NUOPC_CompAttributeGet + use ESMF , only : ESMF_LogFoundAllocError, ESMF_AttributeGet + use NUOPC_Comp , only : NUOPC_CompAttributeGet ! input/output variables type(ESMF_GridComp) :: gcomp @@ -205,7 +209,7 @@ subroutine med_internalstate_init(gcomp, rc) character(len=CL) :: cname character(len=ESMF_MAXSTR) :: mesh_glc character(len=CX) :: msgString - character(len=3) :: name + character(len=3) :: name integer :: num_icesheets character(len=*),parameter :: subname=' (internalstate init) ' !----------------------------------------------------------- @@ -329,7 +333,7 @@ subroutine med_internalstate_init(gcomp, rc) ! Write out present flags write(logunit,*) do n1 = 1,ncomps - name = trim(compname(n1)) ! this trims the ice sheets index from the glc name + name = trim(compname(n1)) ! this trims the ice sheets index from the glc name write(msgString,'(A,L4)') trim(subname)//' comp_present(comp'//name//') = ',& is_local%wrap%comp_present(n1) write(logunit,'(a)') trim(msgString) @@ -353,7 +357,7 @@ subroutine med_internalstate_init(gcomp, rc) ! Obtain dststatus_print setting if present call NUOPC_CompAttributeGet(gcomp, name='dststatus_print', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) dststatus_print=(trim(cvalue)=="true") + if (isPresent .and. isSet) dststatus_print=(trim(cvalue) == "true") write(msgString,*) trim(subname)//': Mediator dststatus_print is ',dststatus_print call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) @@ -551,4 +555,44 @@ subroutine med_internalstate_coupling(gcomp, rc) end subroutine med_internalstate_coupling + subroutine med_internalstate_defaultmasks(gcomp, rc) + + use med_constants_mod , only : ispval_mask => med_constants_ispval_mask + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + + !---------------------------------------------------------- + ! Default masking: for each component, the first element is + ! when it is the src and the second element is when it is + ! the destination + !---------------------------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + allocate(defaultMasks(ncomps,2)) + defaultMasks(:,:) = ispval_mask + if (is_local%wrap%comp_present(compocn)) defaultMasks(compocn,:) = 0 + if (is_local%wrap%comp_present(compice)) defaultMasks(compice,:) = 0 + if (is_local%wrap%comp_present(compwav)) defaultMasks(compwav,:) = 0 + if ( trim(coupling_mode(1:4)) == 'nems') then + if (is_local%wrap%comp_present(compatm)) defaultMasks(compatm,:) = 1 + endif + if ( trim(coupling_mode) == 'hafs') then + if (is_local%wrap%comp_present(compatm)) defaultMasks(compatm,1) = 1 + endif + if ( trim(coupling_mode) /= 'cesm') then + if (is_local%wrap%comp_present(compatm) .and. trim(atm_name(1:4)) == 'datm') then + defaultMasks(compatm,1) = 0 + end if + end if + + end subroutine med_internalstate_defaultmasks + end module med_internalstate_mod diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 5921d927e..3717f5cba 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -342,7 +342,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, use med_internalstate_mod , only : mapfillv_bilnr, mapbilnr_nstod, mapconsf_aofrac use med_internalstate_mod , only : ncomps, compatm, compice, compocn, compwav, compname use med_internalstate_mod , only : coupling_mode, dststatus_print - use med_internalstate_mod , only : atm_name + use med_internalstate_mod , only : defaultMasks use med_constants_mod , only : ispval_mask => med_constants_ispval_mask ! input/output variables @@ -389,63 +389,33 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, ! set local flag to false ldstprint = .false. - polemethod=ESMF_POLEMETHOD_ALLAVG + ! set src and dst masking using defaults + srcMaskValue = defaultMasks(n1,1) + dstMaskValue = defaultMasks(n2,2) + + ! override defaults for specific cases if (trim(coupling_mode) == 'cesm') then - dstMaskValue = ispval_mask - srcMaskValue = ispval_mask - if (n1 == compocn .or. n1 == compice) srcMaskValue = 0 - if (n2 == compocn .or. n2 == compice) dstMaskValue = 0 if (n1 == compwav .and. n2 == compocn) then srcMaskValue = 0 dstMaskValue = ispval_mask endif - if (n1 == compwav .or. n2 == compwav) then - polemethod = ESMF_POLEMETHOD_NONE ! todo: remove this when ESMF tripolar mapping fix is in place. - endif - else if (coupling_mode(1:4) == 'nems') then - if ( (n1 == compocn .or. n1 == compice .or. n1 == compwav) .and. & - (n2 == compocn .or. n2 == compice .or. n2 == compwav) ) then - srcMaskValue = 0 - dstMaskValue = 0 - else if (n1 == compatm .and. (n2 == compocn .or. n2 == compice .or. n2 == compwav)) then - srcMaskValue = 1 - dstMaskValue = 0 - if (atm_name(1:4).eq.'datm') then - srcMaskValue = 0 - endif - else if (n2 == compatm .and. (n1 == compocn .or. n1 == compice .or. n1 == compwav)) then - srcMaskValue = 0 - dstMaskValue = 1 - else - ! TODO: what should the condition be here? - dstMaskValue = ispval_mask + end if + if (trim(coupling_mode) == 'hafs') then + if (n1 == compatm .and. n2 == compwav) then srcMaskValue = ispval_mask end if - else if (trim(coupling_mode) == 'hafs') then - dstMaskValue = ispval_mask - srcMaskValue = ispval_mask - if (n1 == compocn .or. n1 == compice) srcMaskValue = 0 - if (n2 == compocn .or. n2 == compice) dstMaskValue = 0 - if (n1 == compatm .and. n2 == compocn) then - if (trim(atm_name).ne.'datm') then - srcMaskValue = 1 - endif - dstMaskValue = 0 - elseif (n1 == compocn .and. n2 == compatm) then - srcMaskValue = 0 - dstMaskValue = ispval_mask - elseif (n1 == compatm .and. n2 == compwav) then - dstMaskValue = 0 - elseif (n1 == compwav .and. n2 == compatm) then - srcMaskValue = 0 - dstMaskValue = ispval_mask - endif end if - write(string,'(a,i10,a,i10)') trim(compname(n1))//' to '//trim(compname(n2))//' srcMask = ', & srcMaskValue,' dstMask = ',dstMaskValue call ESMF_LogWrite(trim(string), ESMF_LOGMSG_INFO) + polemethod=ESMF_POLEMETHOD_ALLAVG + if (trim(coupling_mode) == 'cesm') then + if (n1 == compwav .or. n2 == compwav) then + polemethod = ESMF_POLEMETHOD_NONE ! todo: remove this when ESMF tripolar mapping fix is in place. + endif + end if + ! Create route handle if (mapindex == mapfcopy) then if (mastertask) then diff --git a/mediator/med_phases_post_lnd_mod.F90 b/mediator/med_phases_post_lnd_mod.F90 index 559e67345..d057506af 100644 --- a/mediator/med_phases_post_lnd_mod.F90 +++ b/mediator/med_phases_post_lnd_mod.F90 @@ -80,7 +80,7 @@ subroutine med_phases_post_lnd(gcomp, rc) if (is_local%wrap%lnd2glc_coupling) then call med_phases_prep_glc_accum_lnd(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Note that in this case med_phases_prep_glc_avg is called + ! Note that in this case med_phases_prep_glc_avg is called ! from med_phases_prep_glc in the run sequence else if (is_local%wrap%accum_lnd2glc) then call med_phases_prep_glc_accum_lnd(gcomp, rc) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index c2e9b4ef5..485cdaf9b 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -242,17 +242,17 @@ subroutine med_phases_prep_atm(gcomp, rc) end subroutine med_phases_prep_atm !----------------------------------------------------------------------------- - subroutine med_phases_prep_atm_enthalpy_correction (gcomp, hcorr, rc) + subroutine med_phases_prep_atm_enthalpy_correction (gcomp, hcorr, rc) - ! Enthalpy correction term calculation called by med_phases_prep_ocn_accum in + ! Enthalpy correction term calculation called by med_phases_prep_ocn_accum in ! med_phases_prep_ocn_mod ! Note that this is only called if the following fields are in FBExp(compocn) ! 'Faxa_rain','Foxx_hrain','Faxa_snow' ,'Foxx_hsnow', - ! 'Foxx_evap','Foxx_hevap','Foxx_hcond','Foxx_rofl', + ! 'Foxx_evap','Foxx_hevap','Foxx_hcond','Foxx_rofl', ! 'Foxx_hrofl','Foxx_rofi','Foxx_hrofi' use ESMF , only : ESMF_VMAllreduce, ESMF_GridCompGet, ESMF_REDUCE_SUM - use ESMF , only : ESMF_VM + use ESMF , only : ESMF_VM ! input/output variables type(ESMF_GridComp) , intent(in) :: gcomp diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index 51e4db6e4..14cd7464b 100644 --- a/mediator/med_time_mod.F90 +++ b/mediator/med_time_mod.F90 @@ -73,7 +73,7 @@ subroutine med_time_alarmInit( clock, alarm, option, & integer , optional , intent(in) :: opt_tod ! alarm tod (sec) type(ESMF_Time) , optional , intent(in) :: reftime ! reference time character(len=*) , optional , intent(in) :: alarmname ! alarm name - logical , optional , intent(in) :: advance_clock ! advance clock to trigger alarm + logical , optional , intent(in) :: advance_clock ! advance clock to trigger alarm integer , intent(out) :: rc ! Return code ! local variables @@ -264,7 +264,7 @@ subroutine med_time_alarmInit( clock, alarm, option, & if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Advance model clock to trigger alarm then reset model clock back to currtime - if (present(advance_clock)) then + if (present(advance_clock)) then if (advance_clock) then call ESMF_AlarmSet(alarm, clock=clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 3018d88b7b8078f1888c8ad851b6e850c2204e0a Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Sun, 24 Apr 2022 22:03:44 -0600 Subject: [PATCH 051/395] use mesh file instead of grid name (#285) This was done so that vertical component used in grid name does not affect tests. --- cime_config/buildnml | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 4cdcb7aac..bddd97274 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -62,10 +62,12 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config['lnd_grid'] = lnd_grid config['ice_grid'] = ice_grid config['ocn_grid'] = ocn_grid - config['samegrid_atm_lnd'] = 'true' if atm_grid == lnd_grid else 'false' - config['samegrid_atm_ice'] = 'true' if atm_grid == ice_grid else 'false' - config['samegrid_atm_ocn'] = 'true' if atm_grid == ocn_grid else 'false' - config['samegrid_atm_wav'] = 'true' if atm_grid == wav_grid else 'false' + + atm_mesh = case.get_value("ATM_DOMAIN_MESH") + config['samegrid_atm_lnd'] = 'true' if atm_mesh == case.get_value("LND_DOMAIN_MESH") else 'false' + config['samegrid_atm_ice'] = 'true' if atm_mesh == case.get_value("ICE_DOMAIN_MESH") else 'false' + config['samegrid_atm_ocn'] = 'true' if atm_grid == case.get_value("OCN_DOMAIN_MESH") else 'false' + config['samegrid_atm_wav'] = 'true' if atm_grid == case.get_value("WAV_DOMAIN_MESH") else 'false' config['samegrid_lnd_rof'] = 'true' if lnd_grid == rof_grid else 'false' # determine if need to set atm_domainfile From 150677a840bf5576dfdb0ba54ae82f0444125483 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 26 Apr 2022 09:11:31 -0600 Subject: [PATCH 052/395] dont repeat user_nl entries (#289) --- cime_config/buildnml | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index bddd97274..fb8ed6484 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -309,7 +309,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): model = model.lower() config = {} config['component'] = model - nmlgen.init_defaults(infile, config, skip_entry_loop=True) + nmlgen.init_defaults([], config, skip_entry_loop=True) if model == 'cpl': newgroup = "MED_modelio" else: @@ -348,10 +348,6 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): inst_index = inst_index + 1 nmlgen.write_nuopc_config_file(conffile) - - - - #-------------------------------- # Update nuopc.runconfig file if component needs it #-------------------------------- From a7886b9bf61f0657c6566dd1f0015ea19423a692 Mon Sep 17 00:00:00 2001 From: mvertens Date: Tue, 26 Apr 2022 09:38:34 -0600 Subject: [PATCH 053/395] changes to fix scam and add wave/ice coupling (#290) --- cime_config/buildnml | 6 ++++ cime_config/namelist_definition_drv.xml | 38 ++++++++++++++++--------- 2 files changed, 31 insertions(+), 13 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index fb8ed6484..6b76b8b1e 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -104,6 +104,12 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): #---------------------------------------------------- nmlgen.init_defaults(infile, config, skip_default_for_groups=["modelio"]) + #-------------------------------- + # Overwrite: wav-ice coupling (assumes cice6 as the ice component + #-------------------------------- + if (case.get_value("COMP_WAV") == 'ww3dev' and case.get_value("COMP_ICE") == 'cice'): + nmlgen.set_value('wavice_coupling', value='.true.') + #-------------------------------- # Overwrite: set brnch_retain_casename #-------------------------------- diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 611c36619..9c4e338d3 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1992,7 +1992,7 @@ MED_attributes atm to ocn mapping, 'unset' or 'idmap' are normal possible values - unset + unset idmap @@ -2002,7 +2002,7 @@ MED_attributes atm to ocn mapping, 'unset' or 'idmap' are normal possible values - unset + unset idmap @@ -2012,7 +2012,7 @@ MED_attributes atm to lnd mapping, 'unset' or 'idmap' are normal possible values - unset + unset idmap @@ -2022,7 +2022,7 @@ MED_attributes ocn to atm mapping, 'unset' or 'idmap' are normal possible values - unset + unset idmap @@ -2032,7 +2032,7 @@ MED_attributes ice to atm mapping, 'unset' or 'idmap' are normal possible values - unset + unset idmap @@ -2042,7 +2042,7 @@ MED_attributes lnd to atm mapping, 'unset' or 'idmap' are normal possible values - unset + unset idmap @@ -2053,7 +2053,7 @@ MED_attributes lnd to rof mapping, 'unset' or 'idmap' are normal possible values - unset + unset idmap @@ -2064,7 +2064,7 @@ MED_attributes rof to lnd mapping, 'unset' or 'idmap' are normal possible values - unset + unset idmap @@ -2074,7 +2074,7 @@ MED_attributes atm to wav mapping, 'unset' or 'idmap' are normal possible values - unset + unset idmap @@ -3789,6 +3789,18 @@ + + logical + expdef + ALLCOMP_attributes + + If true, wav-ice coupling is active + + + .false. + + + @@ -3806,7 +3818,7 @@ char mapping abs - ATM_attributes + ALLCOMP_attributes MESH description of atm grid @@ -3866,7 +3878,7 @@ char mapping abs - ICE_attributes + ALLCOMP_attributes MESH description of ice grid @@ -3920,7 +3932,7 @@ char mapping abs - LND_attributes + ALLCOMP_attributes MESH description of lnd grid @@ -3947,7 +3959,7 @@ char mapping abs - OCN_attributes + ALLCOMP_attributes MESH description of ocn grid From 5acea36d920a3863cde6d0681ef009a9fcc63a9b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 27 Apr 2022 13:52:34 -0600 Subject: [PATCH 054/395] fixes for aquaplanet --- cime_config/buildnml | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 6b76b8b1e..46070d9da 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -64,11 +64,13 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config['ocn_grid'] = ocn_grid atm_mesh = case.get_value("ATM_DOMAIN_MESH") + lnd_mesh = case.get_value("LND_DOMAIN_MESH") + rof_mesh = case.get_value("ROF_DOMAIN_MESH") config['samegrid_atm_lnd'] = 'true' if atm_mesh == case.get_value("LND_DOMAIN_MESH") else 'false' + config['samegrid_atm_ocn'] = 'true' if atm_mesh == case.get_value("OCN_DOMAIN_MESH") else 'false' config['samegrid_atm_ice'] = 'true' if atm_mesh == case.get_value("ICE_DOMAIN_MESH") else 'false' - config['samegrid_atm_ocn'] = 'true' if atm_grid == case.get_value("OCN_DOMAIN_MESH") else 'false' - config['samegrid_atm_wav'] = 'true' if atm_grid == case.get_value("WAV_DOMAIN_MESH") else 'false' - config['samegrid_lnd_rof'] = 'true' if lnd_grid == rof_grid else 'false' + config['samegrid_atm_wav'] = 'true' if atm_mesh == case.get_value("WAV_DOMAIN_MESH") else 'false' + config['samegrid_lnd_rof'] = 'true' if lnd_mesh == rof_mesh else 'false' # determine if need to set atm_domainfile scol_lon = float(case.get_value('PTS_LON')) From 6a54cb6052c9b79abf2ee03f89bbc14ab7c8de8b Mon Sep 17 00:00:00 2001 From: mvertens Date: Wed, 27 Apr 2022 22:27:28 -0600 Subject: [PATCH 055/395] fixes to get can single column SCT test to pass (#293) --- cesm/driver/esm.F90 | 69 ++++++++++++++++++++----- cime_config/namelist_definition_drv.xml | 7 --- 2 files changed, 55 insertions(+), 21 deletions(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index bd124639f..4e2885b36 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -1203,6 +1203,8 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) use netcdf, only : nf90_inq_dimid, nf90_inquire_dimension, nf90_inq_varid, nf90_get_var use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_VM, ESMF_VMGet, ESMF_SUCCESS + use ESMF , only : ESMF_Mesh, ESMF_MeshCreate, ESMF_FILEFORMAT_ESMFMESH, ESMF_MeshGet, ESMF_MESHLOC_ELEMENT + use ESMF , only : ESMF_Field, ESMF_FieldCreate, ESMF_FieldGet, ESMF_FieldRegridGetArea, ESMF_TYPEKIND_r8 ! input/output variables character(len=*) , intent(in) :: compname @@ -1212,6 +1214,7 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) ! local variables type(ESMF_VM) :: vm character(len=CL) :: single_column_lnd_domainfile + character(len=CL) :: single_column_global_meshfile real(r8) :: scol_lon real(r8) :: scol_lat real(r8) :: scol_area @@ -1219,7 +1222,16 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) real(r8) :: scol_lndfrac integer :: scol_ocnmask real(r8) :: scol_ocnfrac - integer :: i,j,ni,nj + integer :: scol_mesh_n + type(ESMF_Mesh) :: mesh + type(ESMF_Field) :: lfield + integer :: lsize + integer :: spatialdim + real(r8), pointer :: ownedElemCoords(:) + real(r8), pointer :: latMesh(:) + real(r8), pointer :: lonMesh(:) + real(r8), pointer :: dataptr(:) + integer :: i,j,ni,nj,n integer :: ncid integer :: dimid integer :: varid_xc @@ -1243,7 +1255,6 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) character(len=*), parameter :: subname= ' (esm_get_single_column_attributes) ' !------------------------------------------------------------------------------- - rc = ESMF_SUCCESS ! obtain the single column lon and lat @@ -1255,6 +1266,8 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) read(cvalue,*) scol_lat call NUOPC_CompAttributeGet(gcomp, name='single_column_lnd_domainfile', value=single_column_lnd_domainfile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=single_column_global_meshfile, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeAdd(gcomp, attrList=(/'scol_spval'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1349,6 +1362,7 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) do j = 1,nj lats(j) = glob_grid(1,j) end do + ! find nearest neighbor indices of scol_lon and scol_lat in single_column_lnd_domain file ! convert lons array and scol_lon to 0,360 and find index of value closest to 0 ! and obtain single-column longitude/latitude indices to retrieve @@ -1388,26 +1402,53 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) //' ocean and land mask cannot both be zero') end if + status = nf90_close(ncid) + if (status /= nf90_noerr) call shr_sys_abort (trim(subname) //': closing '//& + trim(single_column_lnd_domainfile)) + + ! Now read in mesh file to get exact values of scol_lon and scol_lat that will be used + ! by the models - assume that this occurs only on 1 processor + mesh = ESMF_MeshCreate(filename=trim(single_column_global_meshfile), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=lsize, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(ownedElemCoords(spatialDim*lsize)) + allocate(lonMesh(lsize), latMesh(lsize)) + call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,lsize + lonMesh(n) = ownedElemCoords(2*n-1) + latMesh(n) = ownedElemCoords(2*n) + if (abs(lonMesh(n) - scol_lon) < 1.e-4 .and. abs(latMesh(n) - scol_lat) < 1.e-4) then + scol_mesh_n = n + scol_mesh_n = n + exit + end if + end do + scol_lon = lonMesh(scol_mesh_n) + scol_lat = latMesh(scol_mesh_n) + + ! Obtain mesh info areas + lfield = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_r8, name='area', meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegridGetArea(lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dataptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + scol_area = dataptr(scol_mesh_n) + + ! Set single column attribute values for all components write(cvalue,*) scol_lon call NUOPC_CompAttributeSet(gcomp, name='scol_lon', value=trim(cvalue), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - write(cvalue,*) scol_lat call NUOPC_CompAttributeSet(gcomp, name='scol_lat', value=trim(cvalue), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - write(cvalue,*) ni - call NUOPC_CompAttributeSet(gcomp, name='scol_ni', value=trim(cvalue), rc=rc) + write(cvalue,*) scol_area + call NUOPC_CompAttributeSet(gcomp, name='scol_area', value=trim(cvalue), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - write(cvalue,*) nj - call NUOPC_CompAttributeSet(gcomp, name='scol_nj', value=trim(cvalue), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - status = nf90_close(ncid) - if (status /= nf90_noerr) call shr_sys_abort (trim(subname) //': closing '//& - trim(single_column_lnd_domainfile)) - + ! Write out diagnostic info write(logunit,'(a,2(f13.5,2x))')trim(subname)//' nearest neighbor scol_lon and scol_lat in '& //trim(single_column_lnd_domainfile)//' are ',scol_lon,scol_lat if (trim(compname) == 'LND') then diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 9c4e338d3..a535a0fa6 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -3824,7 +3824,6 @@ $ATM_DOMAIN_MESH - null @@ -3884,7 +3883,6 @@ $ICE_DOMAIN_MESH - null @@ -3911,7 +3909,6 @@ $GLC_DOMAIN_MESH - null @@ -3938,7 +3935,6 @@ $LND_DOMAIN_MESH - null @@ -3965,7 +3961,6 @@ $OCN_DOMAIN_MESH - null @@ -3992,7 +3987,6 @@ $ROF_DOMAIN_MESH - null @@ -4019,7 +4013,6 @@ $WAV_DOMAIN_MESH - null From 3dbaa6cd05c1362b86b2dca49a773c4aaf2ae7d0 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 29 Apr 2022 14:01:07 -0600 Subject: [PATCH 056/395] need to initialize these variables --- cesm/driver/esm.F90 | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index 4e2885b36..f788c2478 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -1460,6 +1460,12 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) else write(logunit,'(a)')trim(subname)//' atm point has unit mask and unit fraction ' end if + write(cvalue,*) ni + call NUOPC_CompAttributeSet(gcomp, name='scol_ni', value=trim(cvalue), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(cvalue,*) nj + call NUOPC_CompAttributeSet(gcomp, name='scol_nj', value=trim(cvalue), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else @@ -1472,12 +1478,11 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) scol_ocnfrac = 1._r8 scol_area = 1.e30 + write(cvalue,*) 1 call NUOPC_CompAttributeSet(gcomp, name='scol_ni', value=trim(cvalue), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - write(cvalue,*) 1 call NUOPC_CompAttributeSet(gcomp, name='scol_nj', value=trim(cvalue), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - write(cvalue,*) 1 write(logunit,'(a)')' single point mode is active' write(logunit,'(a,f13.5,a,f13.5,a)')' scol_lon is ',scol_lon,' and scol_lat is ' From c57d725d0ad0411117105ac66f9be5aa33b21dd6 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 29 Apr 2022 15:15:59 -0600 Subject: [PATCH 057/395] fix name of driver log --- cime_config/buildnml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cime_config/buildnml b/cime_config/buildnml index 46070d9da..23354c522 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -350,6 +350,8 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): nmlgen.set_value("diro", case.get_value('RUNDIR')) if model == 'cpl': logfile = 'med' + inst_string + ".log." + str(lid) + elif model == 'drv': + logfile = model + ".log." + str(lid) else: logfile = model + inst_string + ".log." + str(lid) nmlgen.set_value("logfile", logfile) From a4c7438fcbf484b80a271acd1b56745a432d9774 Mon Sep 17 00:00:00 2001 From: mvertens Date: Tue, 3 May 2022 09:53:11 -0600 Subject: [PATCH 058/395] add wave/cice coupling fields (#296) * added new fields for coupling ww3 to cice6 --- mediator/esmFldsExchange_cesm_mod.F90 | 59 ++++++++++++++++++++++++++- mediator/fd_cesm.yaml | 15 +++++++ 2 files changed, 72 insertions(+), 2 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 4ee15aba1..9bf8062eb 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -93,11 +93,21 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) integer :: n, ns character(len=CL) :: cvalue character(len=CS) :: name + logical :: wavice_coupling + logical :: ocn2glc_coupling character(len=*) , parameter :: subname=' (esmFldsExchange_cesm) ' !-------------------------------------- rc = ESMF_SUCCESS + call NUOPC_CompAttributeGet(gcomp, name='wavice_coupling', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) wavice_coupling + + call NUOPC_CompAttributeGet(gcomp, name='ocn2glc_coupling', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ocn2glc_coupling + !--------------------------------------- ! Get the internal state !--------------------------------------- @@ -2790,6 +2800,23 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if + ! --------------------------------------------------------------------- + ! to ice: wave elevation spectrum (field with ungridded dimensions) + ! --------------------------------------------------------------------- + if (wavice_coupling) then + if (phase == 'advertise') then + call addfld(fldListFr(compwav)%flds, 'Sw_elevation_spectrum') + call addfld(fldListTo(compice)%flds, 'Sw_elevation_spectrum') + else + if ( fldchk(is_local%wrap%FBExp(compice) , 'Sw_elevation_spectrum', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav,compwav), 'Sw_elevation_spectrum', rc=rc)) then + call addmap(fldListFr(compwav)%flds, 'Sw_elevation_spectrum', compice, mapbilnr, 'one', 'unset') + call addmrg(fldListTo(compice)%flds, 'Sw_elevation_spectrum', & + mrg_from=compwav, mrg_fld='Sw_elevation_spectrum', mrg_type='copy') + end if + end if + end if + !===================================================================== ! FIELDS TO WAVE (compwav) !===================================================================== @@ -2808,7 +2835,36 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg(fldListTo(compwav)%flds, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') end if end if - + !---------------------------------------------------------- + ! to wav: ice thickness from ice + !---------------------------------------------------------- + if (wavice_coupling) then + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, 'Si_thick') + call addfld(fldListTo(compwav)%flds, 'Si_thick') + else + if (fldchk(is_local%wrap%FBexp(compwav) , 'Si_thick', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_thick', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_thick', compwav, mapbilnr, 'one', ice2wav_smap) + call addmrg(fldListTo(compwav)%flds, 'Si_thick', mrg_from=compice, mrg_fld='Si_thick', mrg_type='copy') + end if + end if + end if + !---------------------------------------------------------- + ! to wav: ice floe diameter from ice + !---------------------------------------------------------- + if (wavice_coupling) then + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, 'Si_floediam') + call addfld(fldListTo(compwav)%flds, 'Si_floediam') + else + if (fldchk(is_local%wrap%FBexp(compwav) , 'Si_floediam', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_floediam', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_floediam', compwav, mapbilnr, 'one', ice2wav_smap) + call addmrg(fldListTo(compwav)%flds, 'Si_floediam', mrg_from=compice, mrg_fld='Si_floediam', mrg_type='copy') + end if + end if + end if ! --------------------------------------------------------------------- ! to wav: ocean surface temperature from ocn ! --------------------------------------------------------------------- @@ -2823,7 +2879,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg(fldListTo(compwav)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') end if end if - ! --------------------------------------------------------------------- ! to wav: ocean currents from ocn ! --------------------------------------------------------------------- diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 9196090d8..648a4fed2 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -740,6 +740,14 @@ canonical_units: m description: sea-ice export - volume of snow per unit area # + - standard_name: Si_thick + canonical_units: m + description: sea-ice export - ice thickness + # + - standard_name: Si_floediam + canonical_units: m + description: sea-ice export - ice floe diameter + # #----------------------------------- # section: ocean export to mediator #----------------------------------- @@ -1157,6 +1165,13 @@ - standard_name: Sw_pstokes_y canonical_units: m/s description: Northward partitioned stokes drift components + + # + - standard_name: Sw_elevation_spectrum + alias: wave_elevation_spectrum + canonical_units: m2/s + description: wave elevation spectrum + #----------------------------------- # mediator fields #----------------------------------- From f2385cc48436943f41ce8407e09656210d2d57fd Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Wed, 4 May 2022 17:41:52 -0600 Subject: [PATCH 059/395] fix char length issue for gnu compiler --- mediator/esmFldsExchange_nems_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 536ee75e5..9fe5b70ba 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -258,7 +258,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) if (trim(coupling_mode) == 'nems_frac_aoflux') then if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compatm)) then allocate(flds(5)) - flds = (/ 'lat', 'sen', 'lwup', 'taux', 'tauy' /) + flds = (/ 'lat ', 'sen ', 'lwup', 'taux', 'tauy' /) if (phase == 'advertise') then do n = 1,size(flds) call addfld(fldListMed_aoflux%flds , 'Faox_'//trim(flds(n))) From 44b4e8faccc9b4fe2aeb6b7bed97922c22a1ca04 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 May 2022 18:46:07 -0600 Subject: [PATCH 060/395] update esmf build in workflow --- .github/workflows/extbuild.yml | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index a90bf338d..74c872b9a 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -19,12 +19,12 @@ jobs: CXX: mpicxx CPPFLAGS: "-I/usr/include -I/usr/local/include" # Versions of all dependencies can be updated here - ESMF_VERSION: ESMF_8_2_0_beta_snapshot_14 - PNETCDF_VERSION: pnetcdf-1.12.2 + ESMF_VERSION: ESMF_8_3_0_beta_snapshot_13 + PNETCDF_VERSION: pnetcdf-1.12.3 NETCDF_FORTRAN_VERSION: v4.5.2 # PIO version is awkward - PIO_VERSION_DIR: pio2_5_3 - PIO_VERSION: pio-2.5.3 + PIO_VERSION_DIR: pio2_5_7 + PIO_VERSION: pio-2.5.7 steps: - uses: actions/checkout@v2 # Build the ESMF library, if the cache contains a previous build @@ -39,11 +39,17 @@ jobs: sudo apt-get update sudo apt-get install gfortran wget openmpi-bin netcdf-bin libopenmpi-dev libnetcdf-dev - id: build-ESMF + uses: actions/checkout@v3 + with: + repository: esmf-org/esmf + path: esmf-src + ref: v8.3.0b13 if: steps.cache-esmf.outputs.cache-hit != 'true' run: | - wget https://github.com/esmf-org/esmf/archive/${{ env.ESMF_VERSION }}.tar.gz - tar -xzvf ${{ env.ESMF_VERSION }}.tar.gz - pushd esmf-${{ env.ESMF_VERSION }} + #wget https://github.com/esmf-org/esmf/archive/${{ env.ESMF_VERSION }}.tar.gz + #tar -xzvf ${{ env.ESMF_VERSION }}.tar.gz + #pushd esmf-${{ env.ESMF_VERSION }} + cd esmf-src export ESMF_DIR=`pwd` export ESMF_COMM=openmpi export ESMF_YAMLCPP="internal" From d71c52216a305f6d4fe79f09f6458fc27fd33f29 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 May 2022 18:51:00 -0600 Subject: [PATCH 061/395] fix build --- .github/workflows/extbuild.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 74c872b9a..350232dba 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -38,12 +38,13 @@ jobs: run: | sudo apt-get update sudo apt-get install gfortran wget openmpi-bin netcdf-bin libopenmpi-dev libnetcdf-dev - - id: build-ESMF + - id: checkout-ESMF uses: actions/checkout@v3 with: repository: esmf-org/esmf path: esmf-src ref: v8.3.0b13 + - id: build-ESMF if: steps.cache-esmf.outputs.cache-hit != 'true' run: | #wget https://github.com/esmf-org/esmf/archive/${{ env.ESMF_VERSION }}.tar.gz From 89681d437f1542ee059d36f4a55caa4ffbe6ee42 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 5 May 2022 07:04:35 -0600 Subject: [PATCH 062/395] fix error in esmf build --- .github/workflows/extbuild.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 350232dba..e6fb993c1 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -19,7 +19,7 @@ jobs: CXX: mpicxx CPPFLAGS: "-I/usr/include -I/usr/local/include" # Versions of all dependencies can be updated here - ESMF_VERSION: ESMF_8_3_0_beta_snapshot_13 + ESMF_VERSION: v8.3.0b13 PNETCDF_VERSION: pnetcdf-1.12.3 NETCDF_FORTRAN_VERSION: v4.5.2 # PIO version is awkward @@ -43,14 +43,14 @@ jobs: with: repository: esmf-org/esmf path: esmf-src - ref: v8.3.0b13 + ref: ${{ env.ESMF_VERSION }} - id: build-ESMF if: steps.cache-esmf.outputs.cache-hit != 'true' run: | #wget https://github.com/esmf-org/esmf/archive/${{ env.ESMF_VERSION }}.tar.gz #tar -xzvf ${{ env.ESMF_VERSION }}.tar.gz #pushd esmf-${{ env.ESMF_VERSION }} - cd esmf-src + pushd esmf-src export ESMF_DIR=`pwd` export ESMF_COMM=openmpi export ESMF_YAMLCPP="internal" From 32e544aaa081451c64309025166520fddcd006db Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 5 May 2022 07:32:00 -0600 Subject: [PATCH 063/395] fix pio version --- .github/workflows/extbuild.yml | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index e6fb993c1..b0b01f785 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -22,9 +22,7 @@ jobs: ESMF_VERSION: v8.3.0b13 PNETCDF_VERSION: pnetcdf-1.12.3 NETCDF_FORTRAN_VERSION: v4.5.2 - # PIO version is awkward - PIO_VERSION_DIR: pio2_5_7 - PIO_VERSION: pio-2.5.7 + PIO_VERSION: pio2_5_7 steps: - uses: actions/checkout@v2 # Build the ESMF library, if the cache contains a previous build @@ -102,14 +100,18 @@ jobs: ${{ runner.os }}-${{ env.NETCDF_FORTRAN_VERSION }}-netcdf-fortran ${{ runner.os }}-${{ env.PNETCDF_VERSION }}-pnetcdf + - id: checkout-PIO + uses: actions/checkout@v3 + with: + repository: NCAR/ParallelIO + path: parallelio-src + ref: ${{ env.PIO_VERSION }} - name: Build PIO if: steps.cache-PIO.outputs.cache-hit != 'true' run: | - wget https://github.com/NCAR/ParallelIO/releases/download/${{ env.PIO_VERSION_DIR }}/${{ env.PIO_VERSION }}.tar.gz - tar -xzvf ${{ env.PIO_VERSION }}.tar.gz mkdir build-pio pushd build-pio - cmake -Wno-dev -DNetCDF_C_LIBRARY=/usr/lib/x86_64-linux-gnu/libnetcdf.so -DNetCDF_C_INCLUDE_DIR=/usr/include -DCMAKE_PREFIX_PATH=/usr -DCMAKE_INSTALL_PREFIX=$HOME/pio -DPIO_HDF5_LOGGING=On -DPIO_USE_MALLOC=On -DPIO_ENABLE_TESTS=Off -DPIO_ENABLE_LOGGING=On -DPIO_ENABLE_EXAMPLES=Off -DPIO_ENABLE_TIMING=Off -DNetCDF_Fortran_PATH=$HOME/netcdf-fortran -DPnetCDF_PATH=$HOME/pnetcdf ../${{ env.PIO_VERSION }} + cmake -Wno-dev -DNetCDF_C_LIBRARY=/usr/lib/x86_64-linux-gnu/libnetcdf.so -DNetCDF_C_INCLUDE_DIR=/usr/include -DCMAKE_PREFIX_PATH=/usr -DCMAKE_INSTALL_PREFIX=$HOME/pio -DPIO_HDF5_LOGGING=On -DPIO_USE_MALLOC=On -DPIO_ENABLE_TESTS=Off -DPIO_ENABLE_LOGGING=On -DPIO_ENABLE_EXAMPLES=Off -DPIO_ENABLE_TIMING=Off -DNetCDF_Fortran_PATH=$HOME/netcdf-fortran -DPnetCDF_PATH=$HOME/pnetcdf ../parallelio-src make VERBOSE=1 make install popd From 139047ec4d7fa2dccacce6c1ac1110afc7e02ac4 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 5 May 2022 14:20:44 -0600 Subject: [PATCH 064/395] make qmin constant --- mediator/med_phases_aofluxes_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 8beb5e13b..83b2841e2 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -963,7 +963,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) real(r8), pointer :: data_normdst(:) real(r8), pointer :: data_dst(:) integer :: maptype - real(r8) :: qmin = 1.0e-8_r8 + real(r8), parameter :: qmin = 1.0e-8_r8 character(*),parameter :: subName = '(med_aofluxes_update) ' !----------------------------------------------------------------------- From 1bef7aae5558969cb423b7ec4cec1c6abfe45b2b Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 5 May 2022 23:09:30 -0600 Subject: [PATCH 065/395] declare constants as parameters --- mediator/med_phases_aofluxes_mod.F90 | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 83b2841e2..915c4e3d4 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -35,6 +35,9 @@ module med_phases_aofluxes_mod #ifndef CESMCOUPLED use ufs_const_mod , only : rearth => SHR_CONST_REARTH use ufs_const_mod , only : pi => SHR_CONST_PI +#else + use shr_const_mod , only : rearth => SHR_CONST_REARTH + use shr_const_mod , only : pi => SHR_CONST_PI #endif implicit none @@ -964,6 +967,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) real(r8), pointer :: data_dst(:) integer :: maptype real(r8), parameter :: qmin = 1.0e-8_r8 + real(r8), parameter :: p0 = 100000.0_r8 ! reference pressure in Pa + real(r8), parameter :: rcp = 0.286_r8 ! gas constant of air / specific heat capacity at a constant pressure + real(r8), parameter :: rdair = 287.058_r8 ! dry air gas constant in J/K/kg character(*),parameter :: subName = '(med_aofluxes_update) ' !----------------------------------------------------------------------- @@ -1004,8 +1010,8 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) ! Note pbot, tbot and shum have already been mapped or are available on the aoflux grid if (compute_atm_thbot) then do n = 1,aoflux_in%lsize - if (aoflux_in%mask(n) /= 0._r8) then - aoflux_in%thbot(n) = aoflux_in%tbot(n)*((100000._R8/aoflux_in%pbot(n))**0.286_R8) + if (aoflux_in%mask(n) /= 0.0_r8) then + aoflux_in%thbot(n) = aoflux_in%tbot(n)*((p0/aoflux_in%pbot(n))**rcp) end if end do end if @@ -1014,19 +1020,19 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) (trim(coupling_mode) == 'nems_frac_aoflux' .or. trim(coupling_mode) == 'nems_frac_aoflux_sbs')) then ! Add limiting factor to humidity to be consistent with UFS aoflux calculation do n = 1,aoflux_in%lsize - if (aoflux_in%mask(n) /= 0._r8) then + if (aoflux_in%mask(n) /= 0.0_r8) then aoflux_in%shum(n) = max(aoflux_in%shum(n), qmin) end if end do ! Use pbot as psfc for the initial pass since psfc provided by UFS atm is zero - if (maxval(aoflux_in%psfc, mask=(aoflux_in%mask/= 0._r8)) < 100._r8) then + if (maxval(aoflux_in%psfc, mask=(aoflux_in%mask/= 0.0_r8)) < 100.0_r8) then aoflux_in%psfc(:) = aoflux_in%pbot(:) call ESMF_LogWrite(trim(subname)//" : using pbot as psfc for initial pass!", ESMF_LOGMSG_INFO) end if end if do n = 1,aoflux_in%lsize - if (aoflux_in%mask(n) /= 0._r8) then - aoflux_in%dens(n) = aoflux_in%pbot(n)/(287.058_R8*(1._R8 + 0.608_R8*aoflux_in%shum(n))*aoflux_in%tbot(n)) + if (aoflux_in%mask(n) /= 0.0_r8) then + aoflux_in%dens(n) = aoflux_in%pbot(n)/(rdair*(1.0_r8 + 0.608_r8*aoflux_in%shum(n))*aoflux_in%tbot(n)) end if end do end if From b0eee2c780362fff79babb2857019b8b056b16f2 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Fri, 6 May 2022 13:50:04 -0500 Subject: [PATCH 066/395] fix for UFS OpnReqTests debug test --- mediator/med_phases_aofluxes_mod.F90 | 2 +- ufs/flux_atmocn_ccpp_mod.F90 | 19 +++++++++++-------- 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 8beb5e13b..ca1c10c10 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1059,7 +1059,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) zbot=aoflux_in%zbot, garea=aoflux_in%garea, ubot=aoflux_in%ubot, usfc=aoflux_in%usfc, vbot=aoflux_in%vbot, & vsfc=aoflux_in%vsfc, rbot=aoflux_in%dens, ts=aoflux_in%tocn, mask=aoflux_in%mask, & sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evp=aoflux_out%evap, & - taux=aoflux_out%taux, tauy=aoflux_out%tauy, qref=aoflux_out%qref, & + taux=aoflux_out%taux, tauy=aoflux_out%tauy, qref=aoflux_out%qref, duu10n=aoflux_out%duu10n, & missval=0.0_r8) else #endif diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index ba868c653..7cf83aa9d 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -32,7 +32,7 @@ module flux_atmocn_ccpp_mod subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, & tbot, qbot, zbot, garea, ubot, usfc, vbot, vsfc, rbot, ts, lwdn, sen, lat, & - lwup, evp, taux, tauy, qref, missval) + lwup, evp, taux, tauy, qref, duu10n, missval) implicit none @@ -58,13 +58,14 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, real(r8), intent(in), optional :: missval ! masked value !--- output arguments ------------------------------- - real(r8), intent(out) :: sen(nMax) ! heat flux: sensible (W/m^2) - real(r8), intent(out) :: lat(nMax) ! heat flux: latent (W/m^2) - real(r8), intent(out) :: lwup(nMax) ! heat flux: lw upward (W/m^2) - real(r8), intent(out) :: evp(nMax) ! heat flux: evap ((kg/s)/m^2) - real(r8), intent(out) :: taux(nMax) ! surface stress, zonal (N) - real(r8), intent(out) :: tauy(nMax) ! surface stress, maridional (N) - real(r8), intent(out) :: qref(nMax) ! diag: 2m ref humidity (kg/kg) + real(r8), intent(out) :: sen(nMax) ! heat flux: sensible (W/m^2) + real(r8), intent(out) :: lat(nMax) ! heat flux: latent (W/m^2) + real(r8), intent(out) :: lwup(nMax) ! heat flux: lw upward (W/m^2) + real(r8), intent(out) :: evp(nMax) ! heat flux: evap ((kg/s)/m^2) + real(r8), intent(out) :: taux(nMax) ! surface stress, zonal (N) + real(r8), intent(out) :: tauy(nMax) ! surface stress, maridional (N) + real(r8), intent(out) :: qref(nMax) ! diag: 2m ref humidity (kg/kg) + real(r8), intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 !--- local variables -------------------------------- integer :: n, rc @@ -251,6 +252,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, taux(n) = rbot(n)*physics%interstitial%stress_water(n)*ubot(n)/physics%interstitial%wind(n) tauy(n) = rbot(n)*physics%interstitial%stress_water(n)*vbot(n)/physics%interstitial%wind(n) qref(n) = physics%interstitial%qss_water(n) + duu10n(n) = physics%interstitial%wind(n)*physics%interstitial%wind(n) else sen(n) = spval lat(n) = spval @@ -259,6 +261,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, taux(n) = spval tauy(n) = spval qref(n) = spval + duu10n(n) = spval end if end do From d307cd55388cffdf050e72389e634364ba262661 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Mon, 9 May 2022 00:46:43 -0600 Subject: [PATCH 067/395] fix threading issue in CCPP driver --- ufs/ccpp/driver/med_ccpp_driver.F90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/ufs/ccpp/driver/med_ccpp_driver.F90 b/ufs/ccpp/driver/med_ccpp_driver.F90 index 72586e212..8a867e1cd 100644 --- a/ufs/ccpp/driver/med_ccpp_driver.F90 +++ b/ufs/ccpp/driver/med_ccpp_driver.F90 @@ -28,6 +28,11 @@ subroutine med_ccpp_driver_init(ccpp_suite) !--- local variables -------------------------------- integer :: ierr + ! for physics running over the entire domain, block and thread + ! number are not used; set to safe values + cdata%blk_no = 1 + cdata%thrd_no = 1 + ! initialize CCPP physics (run all _init routines) call ccpp_physics_init(cdata, suite_name=trim(ccpp_suite), ierr=ierr) if (ierr /= 0) then From 3fe2c87ed4ac4257ebdf76025a6eaa4b0b99b9ed Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Tue, 10 May 2022 00:09:17 -0500 Subject: [PATCH 068/395] update naming convention and use _med suffix in CCPP host model --- ufs/ccpp/data/MED_typedefs.F90 | 12 ++++++------ ufs/ccpp/data/MED_typedefs.meta | 8 ++++---- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/ufs/ccpp/data/MED_typedefs.F90 b/ufs/ccpp/data/MED_typedefs.F90 index 725a0bea5..3e6586041 100644 --- a/ufs/ccpp/data/MED_typedefs.F90 +++ b/ufs/ccpp/data/MED_typedefs.F90 @@ -184,8 +184,8 @@ module MED_typedefs !! \htmlinclude MED_coupling_type.html !! type MED_coupling_type - real(kind=kind_phys), pointer :: dtsfcino_cpl(:) => null() !< sfc latent heat flux over ocean - real(kind=kind_phys), pointer :: dqsfcino_cpl(:) => null() !< sfc sensible heat flux over ocean + real(kind=kind_phys), pointer :: dtsfcin_med(:) => null() !< sfc latent heat flux over ocean + real(kind=kind_phys), pointer :: dqsfcin_med(:) => null() !< sfc sensible heat flux over ocean contains procedure :: create => coupling_create !< allocate array data end type MED_coupling_type @@ -611,10 +611,10 @@ subroutine coupling_create(coupling, im) class(MED_coupling_type) :: coupling integer, intent(in) :: im - allocate(coupling%dtsfcino_cpl(im)) - coupling%dtsfcino_cpl = clear_val - allocate(coupling%dqsfcino_cpl(im)) - coupling%dqsfcino_cpl = clear_val + allocate(coupling%dtsfcin_med(im)) + coupling%dtsfcin_med = clear_val + allocate(coupling%dqsfcin_med(im)) + coupling%dqsfcin_med = clear_val end subroutine coupling_create diff --git a/ufs/ccpp/data/MED_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta index 7d4f8cbcb..eed67be49 100644 --- a/ufs/ccpp/data/MED_typedefs.meta +++ b/ufs/ccpp/data/MED_typedefs.meta @@ -890,15 +890,15 @@ [ccpp-arg-table] name = MED_coupling_type type = ddt -[dtsfcino_cpl] - standard_name = surface_upward_sensible_heat_flux_over_ocean_from_coupled_process +[dtsfcin_med] + standard_name = surface_upward_sensible_heat_flux_over_ocean_from_mediator long_name = sfc sensible heat flux input over ocean for coupling units = W m-2 dimensions = (horizontal_loop_extent) type = real kind = kind_phys -[dqsfcino_cpl] - standard_name = surface_upward_latent_heat_flux_over_ocean_from_coupled_process +[dqsfcin_med] + standard_name = surface_upward_latent_heat_flux_over_ocean_from_mediator long_name = sfc latent heat flux input over ocean for coupling units = W m-2 dimensions = (horizontal_loop_extent) From dfdb479c9b9eec693a5b050d0866ab064d1de152 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Sun, 15 May 2022 02:28:31 -0500 Subject: [PATCH 069/395] add restart capability to CCPP host model --- mediator/med_internalstate_mod.F90 | 3 +- mediator/med_phases_aofluxes_mod.F90 | 8 +- ufs/flux_atmocn_ccpp_mod.F90 | 161 +++-- ufs/ufs_io.F90 | 896 +++++++++++++++++++++++++++ 4 files changed, 1017 insertions(+), 51 deletions(-) create mode 100644 ufs/ufs_io.F90 diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index ea956ad69..99baa2fe1 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -5,7 +5,7 @@ module med_internalstate_mod !----------------------------------------------------------------------------- use ESMF , only : ESMF_RouteHandle, ESMF_FieldBundle, ESMF_State, ESMF_Field, ESMF_VM - use ESMF , only : ESMF_GridComp, ESMF_MAXSTR, ESMF_LOGMSG_INFO, ESMF_LOGWRITE + use ESMF , only : ESMF_GridComp, ESMF_Mesh, ESMF_MAXSTR, ESMF_LOGMSG_INFO, ESMF_LOGWRITE use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_utils_mod, only : chkerr => med_utils_ChkErr @@ -159,6 +159,7 @@ module med_internalstate_mod ! Mediator field bundles and other info for atm/ocn flux computation character(len=CS) :: aoflux_grid ! 'ogrid', 'agrid' or 'xgrid' + type(ESMF_Mesh) :: aoflux_mesh ! Mesh used for atm/ocn flux computation type(ESMF_FieldBundle) :: FBMed_aoflux_a ! Ocn/Atm flux output fields on atm grid type(ESMF_FieldBundle) :: FBMed_aoflux_o ! Ocn/Atm flux output fields on ocn grid type(packed_data_type), pointer :: packed_data_aoflux_o2a(:) ! packed data for mapping ocn->atm diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 73cf495b4..c87b19d43 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -24,7 +24,7 @@ module med_phases_aofluxes_mod use ESMF , only : ESMF_Mesh, ESMF_MeshGet, ESMF_XGrid, ESMF_XGridCreate, ESMF_TYPEKIND_R8 use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LOGMSG_ERROR, ESMF_FAILURE use ESMF , only : ESMF_Finalize, ESMF_LogFoundError - use ESMF , only : ESMF_XGridGet, ESMF_MeshWrite, ESMF_KIND_R8 + use ESMF , only : ESMF_XGridGet, ESMF_MeshCreate, ESMF_MeshWrite, ESMF_KIND_R8 use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_internalstate_mod , only : InternalState, mastertask, logunit use med_internalstate_mod , only : compatm, compocn, coupling_mode, aoflux_code, mapconsd, mapconsf, mapfcopy @@ -545,6 +545,7 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + is_local%wrap%aoflux_mesh = ESMF_MeshCreate(lmesh, rc=rc) call ESMF_MeshGet(lmesh, coordSys=coordSys, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (coordSys /= ESMF_COORDSYS_CART) then @@ -695,6 +696,7 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + is_local%wrap%aoflux_mesh = ESMF_MeshCreate(lmesh, rc=rc) call ESMF_MeshGet(lmesh, coordSys=coordSys, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (coordSys /= ESMF_COORDSYS_CART) then @@ -758,6 +760,7 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Field) :: field_a type(ESMF_Field) :: field_o type(ESMF_Field) :: lfield + type(ESMF_Mesh) :: lmesh type(ESMF_Mesh) :: ocn_mesh type(ESMF_Mesh) :: atm_mesh type(ESMF_Mesh) :: xch_mesh @@ -916,8 +919,9 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) allocate(garea(lsize)) allocate(aoflux_in%garea(lsize)) - call ESMF_XGridGet(xgrid, coordSys=coordSys, area=garea, rc=rc) + call ESMF_XGridGet(xgrid, mesh=lmesh, coordSys=coordSys, area=garea, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + is_local%wrap%aoflux_mesh = ESMF_MeshCreate(lmesh, rc=rc) if (coordSys /= ESMF_COORDSYS_CART) then ! Convert square radians to square meters aoflux_in%garea(:) = garea(:)*(rearth**2) diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index 7cf83aa9d..cc10b85fd 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -1,21 +1,30 @@ module flux_atmocn_ccpp_mod - use ESMF, only : ESMF_GridComp, ESMF_SUCCESS + use ESMF, only : operator(-), operator(/) + use ESMF, only : ESMF_GridComp, ESMF_Time, ESMF_SUCCESS + use ESMF, only : ESMF_Clock, ESMF_TimeInterval, ESMF_ClockGet + use ESMF, only : ESMF_GridCompGetInternalState use NUOPC, only : NUOPC_CompAttributeGet + use NUOPC_Mediator, only : NUOPC_MediatorGet - use med_kind_mod, only : R8=>SHR_KIND_R8, CS=>SHR_KIND_CS use physcons, only : p0 => con_p0 use physcons, only : cappa => con_rocp use physcons, only : cp => con_cp use physcons, only : hvap => con_hvap use physcons, only : sbc => con_sbc + use MED_data, only : physics - use med_utils_mod, only : chkerr => med_utils_chkerr use med_ccpp_driver, only : med_ccpp_driver_init use med_ccpp_driver, only : med_ccpp_driver_run use med_ccpp_driver, only : med_ccpp_driver_finalize + use ufs_const_mod - use med_internalstate_mod, only : aoflux_ccpp_suite + use ufs_io_mod, only : read_initial, read_restart, write_restart + use med_kind_mod, only : R8=>SHR_KIND_R8, CS=>SHR_KIND_CS + use med_utils_mod, only : chkerr => med_utils_chkerr + use med_internalstate_mod, only : aoflux_ccpp_suite, logunit + use med_internalstate_mod, only : InternalState, mastertask + use med_constants_mod, only : dbug_flag => med_constants_dbug_flag implicit none @@ -68,17 +77,27 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, real(r8), intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 !--- local variables -------------------------------- - integer :: n, rc - real(r8) :: spval - logical :: isPresent, isSet - character(len=cs) :: cvalue - real(r8), save :: semis_water - logical, save :: first_call = .true. + type(ESMF_Clock) :: mclock + type(ESMF_Time) :: currtime, starttime + type(ESMF_TimeInterval) :: timeStep + type(InternalState) :: is_local + integer :: n, rc + real(r8) :: spval + logical :: isPresent, isSet + character(len=cs) :: cvalue + character(len=cs) :: starttype + integer, save :: restart_freq + real(r8), save :: semis_water + logical, save :: first_call = .true. character(len=*), parameter :: subname=' (flux_atmOcn_ccpp) ' !--------------------------------------- rc = ESMF_SUCCESS + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! missing value if (present(missval)) then spval = missval @@ -86,8 +105,31 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, spval = shr_const_spval endif + !---------------------- + ! Determine clock, starttime and currtime + !---------------------- + + call NUOPC_MediatorGet(gcomp, mediatorClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(mclock, currtime=currTime, starttime=startTime, timeStep=timeStep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! init CCPP and setup/allocate variables if (first_call) then + ! allocate and initalize data structures + call physics%statein%create(nMax,physics%model) + call physics%interstitial%create(nMax) + call physics%coupling%create(nMax) + call physics%grid%create(nMax) + call physics%sfcprop%create(nMax,physics%model) + call physics%diag%create(nMax) + + ! initalize dimension + physics%init%im = nMax + + ! initalize model related parameters + call physics%model%init() + ! determine CCPP/physics specific options ! semis_water, surface emissivity for lw radiation ! semis_wat is constant and set to 0.97 in setemis() call @@ -161,40 +203,45 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%lheatstrg = .false. end if + ! determine CCPP/host model specific options, set it to < 0 for no restart + call NUOPC_CompAttributeGet(gcomp, name="ccpp_restart_interval", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) restart_freq + else + restart_freq = 3600 ! write restart file every hour + end if + if (mastertask) then write(logunit,*) '========================================================' - write(logunit,'(a,f5.2)') trim(subname)//' ccpp_phy_semis_water = ', semis_water - write(logunit,'(a,l)') trim(subname)//' ccpp_phy_lseaspray = ', physics%model%lseaspray - write(logunit,'(a,i)') trim(subname)//' ccpp_phy_ivegsrc = ', physics%model%ivegsrc - write(logunit,'(a,l)') trim(subname)//' ccpp_phy_redrag = ', physics%model%redrag - write(logunit,'(a,i)') trim(subname)//' ccpp_phy_lsm = ', physics%model%lsm - write(logunit,'(a,l)') trim(subname)//' ccpp_phy_frac_grid = ', physics%model%frac_grid - write(logunit,'(a,l)') trim(subname)//' ccpp_phy_restart = ', physics%model%restart - write(logunit,'(a,l)') trim(subname)//' ccpp_phy_cplice = ', physics%model%cplice - write(logunit,'(a,l)') trim(subname)//' ccpp_phy_cplflx = ', physics%model%cplflx - write(logunit,'(a,l)') trim(subname)//' ccpp_phy_lheatstrg = ', physics%model%lheatstrg + write(logunit,'(a,f5.2)') trim(subname)//' ccpp_phy_semis_water = ', semis_water + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_lseaspray = ', physics%model%lseaspray + write(logunit,'(a,i)') trim(subname)//' ccpp_phy_ivegsrc = ', physics%model%ivegsrc + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_redrag = ', physics%model%redrag + write(logunit,'(a,i)') trim(subname)//' ccpp_phy_lsm = ', physics%model%lsm + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_frac_grid = ', physics%model%frac_grid + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_restart = ', physics%model%restart + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_cplice = ', physics%model%cplice + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_cplflx = ', physics%model%cplflx + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_lheatstrg = ', physics%model%lheatstrg + write(logunit,'(a,i)') trim(subname)//' ccpp_restart_interval = ', restart_freq write(logunit,*) '========================================================' end if - ! allocate and initalize data structures - call physics%statein%create(nMax,physics%model) - call physics%interstitial%create(nMax) - call physics%coupling%create(nMax) - call physics%grid%create(nMax) - call physics%sfcprop%create(nMax,physics%model) - call physics%diag%create(nMax) - - ! initalize dimension - physics%init%im = nMax - - ! initalize model related parameters - ! TODO: part of these need to be ingested from FV3 input.nml or configured through ESMF config file - call physics%model%init() + ! read initial condition/restart + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) starttype + if (trim(starttype) == trim('startup')) then + call read_initial(gcomp, rc) + else + call read_restart(gcomp, rc) + !physics%model%restart = .true. + end if ! run CCPP init ! TODO: suite name need to be provided by ESMF config file call med_ccpp_driver_init(trim(aoflux_ccpp_suite)) - first_call = .false. end if ! fill in atmospheric forcing @@ -214,29 +261,41 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, physics%grid%area(:) = garea(:) ! set counter - physics%model%kdt = physics%model%kdt+1 + physics%model%kdt = ((currTime-StartTime)/timeStep)+1 + if (mastertask .and. dbug_flag > 5) then + write(logunit,'(a,i)') 'kdt = ', physics%model%kdt + end if - ! reset physics variables + ! reset physics variables, mimic GFS_suite_interstitial_phys_reset call physics%interstitial%phys_reset() - ! fill in required interstitial variables - where (mask(:) /= 0) - physics%interstitial%wet = .true. - end where - physics%interstitial%wind = sqrt(ubot(:)**2+vbot(:)**2) + ! set required variables to mimic GFS_surface_generic_pre + ! TODO: the wind calculation in GFS_surface_generic_pre has cnvwind adjustment + physics%interstitial%wind = sqrt(ubot(:)*ubot(:)+vbot(:)*vbot(:)) physics%interstitial%prslki = physics%statein%prsik(:)/physics%statein%prslk(:) - physics%interstitial%tsurf_water = ts - physics%interstitial%tsfc_water = ts - physics%interstitial%qss_water = qbot - ! fill in required sfcprop variables + ! set required variables to mimic GFS_surface_composites_pre (assumes no ice) + physics%interstitial%uustar_water(:) = physics%sfcprop%uustar(:) + physics%sfcprop%tsfco(:) = ts(:) + physics%sfcprop%tsfc(:) = ts(:) + physics%interstitial%tsfc_water(:) = physics%sfcprop%tsfc(:) + physics%interstitial%tsurf_water(:) = physics%sfcprop%tsfc(:) + physics%sfcprop%zorlw(:) = physics%sfcprop%zorl(:) + do n = 1, nMax + physics%sfcprop%zorlw(n) = max(1.0e-5, min(1.0d0, physics%sfcprop%zorlw(n))) + end do + + ! other variables + if (.not. first_call) physics%sfcprop%qss(:) = qbot(:) + physics%interstitial%qss_water(:) = physics%sfcprop%qss(:) + + ! calculate wet flag and ocean fraction based on masking, assumes full oceean where (mask(:) /= 0) + physics%interstitial%wet = .true. physics%sfcprop%oceanfrac = 1.0d0 elsewhere physics%sfcprop%oceanfrac = 0.0d0 end where - physics%sfcprop%tsfco = ts - physics%sfcprop%qss = qbot ! run CCPP physics ! TODO: suite name need to be provided by ESMF config file @@ -265,6 +324,12 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, end if end do + ! write restart file + call write_restart(gcomp, restart_freq, rc) + + ! set first call flag + first_call = .false. + end subroutine flux_atmOcn_ccpp end module flux_atmocn_ccpp_mod diff --git a/ufs/ufs_io.F90 b/ufs/ufs_io.F90 new file mode 100644 index 000000000..a1bb0730c --- /dev/null +++ b/ufs/ufs_io.F90 @@ -0,0 +1,896 @@ + module ufs_io_mod + + use ESMF, only : operator(-) + use ESMF, only : ESMF_VM, ESMF_VMGet, ESMF_VMGetCurrent, ESMF_LogWrite + use ESMF, only : ESMF_GridComp, ESMF_GridCompGet, ESMF_SUCCESS, ESMF_FAILURE + use ESMF, only : ESMF_Field, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR + use ESMF, only : ESMF_Grid, ESMF_Decomp_Flag, ESMF_DECOMP_SYMMEDGEMAX + use ESMF, only : ESMF_GridCreateMosaic, ESMF_INDEX_GLOBAL, ESMF_TYPEKIND_R8 + use ESMF, only : ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER + use ESMF, only : ESMF_GridCompGetInternalState, ESMF_KIND_R8 + use ESMF, only : ESMF_ArraySpec, ESMF_ArraySpecSet, ESMF_MESHLOC_ELEMENT + use ESMF, only : ESMF_FieldCreate, ESMF_FieldGet, ESMF_FieldDestroy + use ESMF, only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated + use ESMF, only : ESMF_MeshGet, ESMF_FieldRegridStore, ESMF_FieldRedist + use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleAdd + use ESMF, only : ESMF_FieldWriteVTK, ESMF_VMAllFullReduce, ESMF_REDUCE_SUM + use ESMF, only : ESMF_Calendar, ESMF_Clock, ESMF_ClockGet + use ESMF, only : ESMF_ClockGetNextTime, ESMF_TimeIntervalGet + use ESMF, only : ESMF_Time, ESMF_TimeGet, ESMF_TimeInterval + use ESMF, only : ESMF_FieldBundleIsCreated + use NUOPC, only : NUOPC_CompAttributeGet + use NUOPC_Mediator, only : NUOPC_MediatorGet + + use fms_mod, only : fms_init + use fms2_io_mod, only : open_file, FmsNetcdfFile_t + use mosaic2_mod, only : get_mosaic_ntiles, get_mosaic_grid_sizes + use mosaic2_mod, only : get_mosaic_contact, get_mosaic_ncontacts + use mpp_mod, only : mpp_pe, mpp_root_pe, mpp_error, FATAL + use mpp_domains_mod, only : mpp_get_compute_domain + use mpp_domains_mod, only : mpp_domains_init, mpp_define_mosaic, domain2d + use mpp_io_mod, only : MPP_RDONLY, MPP_NETCDF, MPP_SINGLE, MPP_MULTI + use mpp_io_mod, only : mpp_get_info, mpp_get_fields, mpp_get_atts + use mpp_io_mod, only : mpp_open, mpp_read, fieldtype + + use med_kind_mod, only : r8=>SHR_KIND_R8, cs=>SHR_KIND_CS, cl=>SHR_KIND_CL + use med_utils_mod, only : chkerr => med_utils_chkerr + use med_constants_mod, only : dbug_flag => med_constants_dbug_flag + use med_internalstate_mod, only : InternalState, mastertask, logunit + use med_io_mod, only : med_io_write, med_io_wopen, med_io_enddef, med_io_read + use med_io_mod, only : med_io_close, med_io_write_time, med_io_define_time + use med_io_mod, only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date + use ufs_const_mod, only : shr_const_cday + use med_methods_mod, only : fldbun_getdata1d => med_methods_FB_getdata1d + use med_methods_mod, only : fldbun_diagnose => med_methods_FB_diagnose + use med_methods_mod, only : FB_fldchk => med_methods_FB_FldChk + use med_methods_mod, only : FB_getfldptr => med_methods_FB_GetFldPtr + + use MED_data, only : physics + + implicit none + + private ! default private + + public read_initial + public read_restart + public write_restart + + type domain_type + type(ESMF_Grid) :: grid ! ESMF grid object from mosaic file + type(ESMF_RouteHandle) :: rh ! ESMF route handle object to transfer data from grid to mesh + type(domain2d) :: mosaic_domain ! domain object created by FMS + integer :: layout(2) ! layout for domain decomposition + integer, allocatable :: nit(:) ! size of tile in i direction + integer, allocatable :: njt(:) ! size of tile in j direction + integer :: ntiles ! number of tiles in case of having CS grid + integer :: ncontacts ! number of contacts in case of having CS grid + integer, allocatable :: tile1(:) ! list of tile numbers in tile 1 of each contact + integer, allocatable :: tile2(:) ! list of tile numbers in tile 2 of each contact + integer, allocatable :: istart1(:) ! list of starting i-index in tile 1 of each contact + integer, allocatable :: iend1(:) ! list of ending i-index in tile 1 of each contact + integer, allocatable :: jstart1(:) ! list of starting j-index in tile 1 of each contact + integer, allocatable :: jend1(:) ! list of ending j-index in tile 1 of each contact + integer, allocatable :: istart2(:) ! list of starting i-index in tile 2 of each contact + integer, allocatable :: iend2(:) ! list of ending i-index in tile 2 of each contact + integer, allocatable :: jstart2(:) ! list of starting j-index in tile 2 of each contact + integer, allocatable :: jend2(:) ! list of ending j-index in tile 2 of each contact + end type domain_type + + type(ESMF_FieldBundle), save :: FBrst + character(cs) :: prefix = 'ccpp' + integer :: file_ind = 10 + character(cl) :: case_name = 'unset' ! case name + + character(*), parameter :: modName = "(ufs_io)" + character(*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine read_initial(gcomp, rc) + implicit none + + ! input/output variables + type(ESMF_GridComp), intent(in) :: gcomp + integer, intent(inout) :: rc + + ! local variables + type(domain_type) :: domain + type(ESMF_Field) :: field + real(ESMF_KIND_R8), pointer :: ptr(:,:,:) + character(len=cl) :: filename + character(len=*), parameter :: subname = trim(modName)//': (read_initial) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + ! --------------------- + ! Create domain + ! --------------------- + + call create_fms_domain(gcomp, domain, rc) + + ! --------------------- + ! Create grid + ! --------------------- + + call create_grid(domain, rc) + + !---------------------- + ! Set file name for initial conditions + !---------------------- + + ! TODO: make file name configurable + filename = 'INPUT/sfc_data.tile' + call ESMF_LogWrite(subname//' read initial conditions from '//trim(filename)//'*', ESMF_LOGMSG_INFO) + + !---------------------- + ! Read surface friction velocity + !---------------------- + + call read_tiled_file(gcomp, filename, 'uustar', domain, field, numrec=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%sfcprop%uustar(:) = ptr(:,1,1) + nullify(ptr) + call ESMF_FieldDestroy(field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---------------------- + ! Read surface roughness length + !---------------------- + + call read_tiled_file(gcomp, filename, 'zorl', domain, field, numrec=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%sfcprop%zorl(:) = ptr(:,1,1) + physics%sfcprop%zorlw(:) = ptr(:,1,1) + nullify(ptr) + call ESMF_FieldDestroy(field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---------------------- + ! Read sea surface temperature, composite + !---------------------- + + call read_tiled_file(gcomp, filename, 'tsea', domain, field, numrec=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%sfcprop%tsfco(:) = ptr(:,1,1) + physics%sfcprop%tsfc(:) = ptr(:,1,1) + nullify(ptr) + call ESMF_FieldDestroy(field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---------------------- + ! Read precipitation + !---------------------- + + call read_tiled_file(gcomp, filename, 'tprcp', domain, field, numrec=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%sfcprop%tprcp(:) = ptr(:,1,1) + nullify(ptr) + call ESMF_FieldDestroy(field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine read_initial + + !=============================================================================== + subroutine read_restart(gcomp, rc) + implicit none + + ! input/output variables + type(ESMF_GridComp), intent(in) :: gcomp ! gridded component + integer, intent(inout) :: rc ! return code + + ! local variables + type(ESMF_VM) :: vm + type(ESMF_Field) :: field + type(ESMF_Clock) :: mclock + type(ESMF_Time) :: currtime + type(ESMF_TimeInterval) :: timeStep + type(InternalState) :: is_local + integer :: n, yr, mon, day, sec + real(r8), pointer :: ptr(:) + logical :: isPresent, isSet + character(len=cl) :: cvalue + character(len=cl) :: rest_file + character(len=cl) :: currtime_str + character(len=cs), allocatable :: flds(:) + character(len=*), parameter :: subname=trim(modName)//': (read_restart) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + !---------------------- + ! Query VM + !---------------------- + + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---------------------- + ! Set restart file name + !---------------------- + + if (trim(case_name) == 'unset') then + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + call NUOPC_CompAttributeGet(gcomp, name='ccpp_restart_file', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + rest_file = trim(cvalue) + else + call NUOPC_MediatorGet(gcomp, mediatorClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(mclock, currTime=currTime, timeStep=timeStep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(currTime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + rest_file = trim(case_name)//'.cpl.ccpp.'//trim(currtime_str)//'.nc' + end if + + !---------------------- + ! Now read in the restart file + !---------------------- + + if (mastertask) then + write(logunit,'(a)') 'Reading CCPP restart file: '//trim(rest_file) + end if + + ! create FB + FBrst = ESMF_FieldBundleCreate(rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! add fields + allocate(flds(12)) + flds = (/ 'zorl ', & + 'uustar', & + 'qss ' /) + do n = 1,size(flds) + field = ESMF_FieldCreate(is_local%wrap%aoflux_mesh, ESMF_TYPEKIND_R8, & + name=trim(flds(n)), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + call ESMF_FieldGet(field, farrayptr=ptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ptr(:) = 0.0_r8 + nullify(ptr) + call ESMF_FieldBundleAdd(FBrst, (/field/), rc=rc) + end do + + ! read file to FB + call med_io_read(rest_file, vm, FBrst, pre=trim(prefix), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//' diagnose at '//trim(currtime_str), ESMF_LOGMSG_INFO) + call fldbun_diagnose(FBrst, string=trim(subname)//' CCPP FBrst ', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + !---------------------- + ! Fill internal data structures + !---------------------- + + do n = 1,size(flds) + if (FB_FldChk(FBrst, trim(flds(n)), rc=rc)) then + call FB_getfldptr(FBrst, trim(flds(n)), ptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (mastertask) write(logunit,'(a)') 'Reading: '//trim(flds(n)) + if (trim(flds(n)) == 'zorl' ) physics%sfcprop%zorl(:) = ptr(:) + if (trim(flds(n)) == 'uustar') physics%sfcprop%uustar(:)= ptr(:) + if (trim(flds(n)) == 'qss' ) physics%sfcprop%qss(:) = ptr(:) + + nullify(ptr) + end if + end do + deallocate(flds) + + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + + end subroutine read_restart + + !=============================================================================== + subroutine create_fms_domain(gcomp, domain, rc) + implicit none + + ! input/output variables + type(ESMF_GridComp), intent(in) :: gcomp + type(domain_type), intent(inout) :: domain + integer, intent(inout) :: rc + + ! local variables + type(ESMF_VM) :: vm + type(FmsNetcdfFile_t) :: mosaic_fileobj + integer :: mpicomm + integer :: n, ntiles + integer :: halo = 0 + integer :: global_indices(4,6) + integer :: layout2d(2,6) + integer, allocatable :: pe_start(:), pe_end(:) + character(len=cl) :: msg, mosaic_file + character(len=*), parameter :: subname = trim(modName)//': (create_mosaic) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + ! --------------------- + ! Initialize FMS + ! --------------------- + + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm=vm, mpiCommunicator=mpicomm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call fms_init(mpicomm) + + ! --------------------- + ! Open mosaic file and query some information + ! --------------------- + + ! TODO: make mosaic file name configurable + mosaic_file = 'INPUT/C96_mosaic.nc' + + if (.not. open_file(mosaic_fileobj, trim(mosaic_file), 'read')) then + call ESMF_LogWrite(trim(subname)//'error in opening file '//trim(mosaic_file), ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + end if + + ! query number of tiles + domain%ntiles = get_mosaic_ntiles(mosaic_fileobj) + + ! query domain sizes for each tile + if (.not. allocated(domain%nit)) allocate(domain%nit(domain%ntiles)) + if (.not. allocated(domain%njt)) allocate(domain%njt(domain%ntiles)) + call get_mosaic_grid_sizes(mosaic_fileobj, domain%nit, domain%njt) + + ! query number of contacts + domain%ncontacts = get_mosaic_ncontacts(mosaic_fileobj) + + ! allocate required arrays to create FMS domain from mosaic file + if (.not. allocated(domain%tile1)) allocate(domain%tile1(domain%ncontacts)) + if (.not. allocated(domain%tile2)) allocate(domain%tile2(domain%ncontacts)) + if (.not. allocated(domain%istart1)) allocate(domain%istart1(domain%ncontacts)) + if (.not. allocated(domain%iend1)) allocate(domain%iend1(domain%ncontacts)) + if (.not. allocated(domain%jstart1)) allocate(domain%jstart1(domain%ncontacts)) + if (.not. allocated(domain%jend1)) allocate(domain%jend1(domain%ncontacts)) + if (.not. allocated(domain%istart2)) allocate(domain%istart2(domain%ncontacts)) + if (.not. allocated(domain%iend2)) allocate(domain%iend2(domain%ncontacts)) + if (.not. allocated(domain%jstart2)) allocate(domain%jstart2(domain%ncontacts)) + if (.not. allocated(domain%jend2)) allocate(domain%jend2(domain%ncontacts)) + + ! query information about contacts + call get_mosaic_contact(mosaic_fileobj, domain%tile1, domain%tile2, & + domain%istart1, domain%iend1, domain%jstart1, domain%jend1, & + domain%istart2, domain%iend2, domain%jstart2, domain%jend2) + + ! print out debug information + if (dbug_flag > 5) then + do n = 1, domain%ncontacts + write(msg, fmt='(A,I2,A,2I5)') trim(subname)//' : tile1, tile2 (', n ,') = ', domain%tile1(n), domain%tile2(n) + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + write(msg, fmt='(A,I2,A,4I5)') trim(subname)//' : istart1, iend1, jstart1, jend1 (', n ,') = ', & + domain%istart1(n), domain%iend1(n), domain%jstart1(n), domain%jend1(n) + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + write(msg, fmt='(A,I2,A,4I5)') trim(subname)//' : istart2, iend2, jstart2, jend2 (', n ,') = ', & + domain%istart2(n), domain%iend2(n), domain%jstart2(n), domain%jend2(n) + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + end do + end if + + !---------------------- + ! Initialize domain + !---------------------- + + call mpp_domains_init() + + !---------------------- + ! Set pe_start, pe_end + !---------------------- + + ! TODO: make layout options configurable + domain%layout(1) = 3 + domain%layout(2) = 8 + + allocate(pe_start(domain%ntiles)) + allocate(pe_end(domain%ntiles)) + do n = 1, domain%ntiles + pe_start(n) = mpp_root_pe()+(n-1)*domain%layout(1)*domain%layout(2) + pe_end(n) = mpp_root_pe()+n*domain%layout(1)*domain%layout(2)-1 + if (dbug_flag > 5) then + write(msg, fmt='(A,I2,A,2I5)') trim(subname)//' pe_start, pe_end (', n ,') = ', pe_start(n), pe_end(n) + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + end if + enddo + + !---------------------- + ! Create FMS domain object + !---------------------- + + do n = 1, domain%ntiles + layout2d(:,n) = domain%layout(:) + global_indices(1,n) = 1 + global_indices(2,n) = domain%nit(n) + global_indices(3,n) = 1 + global_indices(4,n) = domain%njt(n) + enddo + + call mpp_define_mosaic(global_indices, layout2d, domain%mosaic_domain, & + domain%ntiles, domain%ncontacts, domain%tile1, domain%tile2, & + domain%istart1, domain%iend1, domain%jstart1, domain%jend1, & + domain%istart2, domain%iend2, domain%jstart2, domain%jend2, & + pe_start, pe_end, symmetry=.true., & + whalo=halo, ehalo=halo, shalo=halo, nhalo=halo, & + name='atm domain') + + !---------------------- + ! Deallocate temporary arrays + !---------------------- + + deallocate(pe_start) + deallocate(pe_end) + + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + + end subroutine create_fms_domain + + !=============================================================================== + subroutine create_grid(domain, rc) + implicit none + + ! input/output variables + type(domain_type), intent(inout) :: domain + integer, intent(inout) :: rc + + ! local variables + type(ESMF_Decomp_Flag) :: decompflagPTile(2,6) + integer :: n + integer :: decomptile(2,6) + character(len=cl) :: mosaic_file, input_dir + character(len=*), parameter :: subname = trim(modName)//': (create_grid) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + ! TODO: make mosaic file name and input folder configurable + mosaic_file = 'INPUT/C96_mosaic.nc' + input_dir = 'INPUT/' + + ! TODO: currently this is only tested with global application + ! set decomposition + do n = 1, domain%ntiles + decomptile(1,n) = domain%layout(1) + decomptile(2,n) = domain%layout(2) + decompflagPTile(:,n) = (/ ESMF_DECOMP_SYMMEDGEMAX, ESMF_DECOMP_SYMMEDGEMAX /) + end do + + ! create grid + domain%grid = ESMF_GridCreateMosaic(filename=trim(mosaic_file), & + regDecompPTile=decomptile, tileFilePath=trim(input_dir), decompflagPTile=decompflagPTile, & + staggerlocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), & + indexflag=ESMF_INDEX_GLOBAL, name='input_grid', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + + end subroutine create_grid + + !=============================================================================== + subroutine read_tiled_file(gcomp, filename, varname, domain, field_dst, numrec, numlev, rc) + implicit none + + ! input/output variables + type(ESMF_GridComp), intent(in) :: gcomp + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + type(domain_type), intent(inout) :: domain + type(ESMF_Field), intent(inout) :: field_dst + integer, intent(in), optional :: numrec + integer, intent(in), optional :: numlev + integer, intent(inout), optional :: rc + + ! local variables + type(ESMF_Field) :: field_src, field_tmp + type(ESMF_ArraySpec) :: arraySpec + type(InternalState) :: is_local + type(fieldtype), allocatable:: vars(:) + integer :: funit, my_tile + integer :: i, j, n, nt, nl + integer :: isc, iec, jsc, jec + integer :: ndim, nvar, natt, ntime + logical :: not_found, is_root_pe + real(ESMF_KIND_R8), pointer :: ptr(:), ptr3d(:,:,:) + real(ESMF_KIND_R8), pointer :: ptr4d(:,:,:,:) + real(r8), allocatable :: rdata(:,:,:,:) + character(len=cl) :: cname, fname + character(len=*), parameter :: subname=trim(modName)//': (read_tiled_file) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' reading '//trim(varname), ESMF_LOGMSG_INFO) + + !---------------------- + ! Get the internal state from the mediator component + !---------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + !---------------------- + ! Define required variables + !---------------------- + + if (present(numrec)) then + nt = numrec + else + nt = 1 + end if + + if (present(numlev)) then + nl = numlev + else + nl = 1 + end if + + my_tile = int(mpp_pe()/(domain%layout(1)*domain%layout(2)))+1 + + is_root_pe = .false. + if (mpp_pe() == (my_tile-1)*(domain%layout(1)*domain%layout(2))) is_root_pe = .true. + + !---------------------- + ! Open file and query file attributes + !---------------------- + + write(cname, fmt='(A,I1,A)') trim(filename), my_tile, '.nc' + call mpp_open(funit, trim(cname), action=MPP_RDONLY, form=MPP_NETCDF, threading=MPP_MULTI, fileset=MPP_SINGLE, is_root_pe=is_root_pe) + call mpp_get_info(funit, ndim, nvar, natt, ntime) + allocate(vars(nvar)) + call mpp_get_fields(funit, vars(:)) + + !---------------------- + ! Find and read requested variable + !---------------------- + + not_found = .true. + do n = 1, nvar + ! get variable name + call mpp_get_atts(vars(n), name=cname) + + ! check variable name + if (trim(cname) == trim(varname)) then + ! get array bounds or domain + call mpp_get_compute_domain(domain%mosaic_domain, isc, iec, jsc, jec) + + ! allocate data array and set initial value + allocate(rdata(isc:iec,jsc:jec,nl,nt)) + rdata(:,:,:,:) = 0.0_r8 + + ! read data + do i = 1, nt + call mpp_read(funit, vars(n), domain%mosaic_domain, rdata, 1) + end do + + ! set missing values to zero + where (rdata == 1.0e20) + rdata(:,:,:,:) = 0.0_r8 + end where + end if + + not_found = .false. + end do + + if (not_found) then + call mpp_error(FATAL, 'File being read is not the expected one. '//trim(varname)//' is not found.') + end if + + !---------------------- + ! Move data from grid to mesh + !---------------------- + + ! set type and rank for ESMF arrayspec + call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_R8, rank=4, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create source field + field_src = ESMF_FieldCreate(domain%grid, arraySpec, staggerloc=ESMF_STAGGERLOC_CENTER, & + indexflag=ESMF_INDEX_GLOBAL, ungriddedLBound=(/1,1/), ungriddedUBound=(/nl,nt/), & + gridToFieldMap=(/1,2/), name=trim(varname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! get pointer and fill it + call ESMF_FieldGet(field_src, localDe=0, farrayPtr=ptr4d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ptr4d(:,:,:,:) = rdata(:,:,:,:) + nullify(ptr4d) + if (allocated(rdata)) deallocate(rdata) + + ! create destination field + field_dst = ESMF_FieldCreate(is_local%wrap%aoflux_mesh, ESMF_TYPEKIND_R8, & + name=trim(varname), meshloc=ESMF_MESHLOC_ELEMENT, ungriddedLbound=(/1,1/), & + ungriddedUbound=(/nl,nt/), gridToFieldMap=(/1/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create routehandle from grid to mesh + if (.not. ESMF_RouteHandleIsCreated(domain%rh, rc=rc)) then + call ESMF_FieldRegridStore(field_src, field_dst, routehandle=domain%rh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! redist field from ESMF Grid to Mesh + call ESMF_FieldRedist(field_src, field_dst, domain%rh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! clean memory + call ESMF_FieldDestroy(field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---------------------- + ! Output result field for debugging purpose + !---------------------- + + if (dbug_flag > 5) then + ! TODO: ESMF_FieldWriteVTK() call does not support ungridded dimension + ! The workaround is implemented in here but it would be nice to extend + ! ESMF_FieldWriteVTK() call to handle it. + field_tmp = ESMF_FieldCreate(is_local%wrap%aoflux_mesh, ESMF_TYPEKIND_R8, & + name=trim(varname), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(field_tmp, localDe=0, farrayPtr=ptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(field_dst, localDe=0, farrayPtr=ptr3d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! write to different file along ungridded dimension + do i = 1, nl + do j = 1, nt + ptr(:) = ptr3d(:,i,j) + write(fname, fmt='(A,I2.2,A,I2.2)') trim(varname)//'_lev', i, '_time', j + call ESMF_FieldWriteVTK(field_tmp, trim(fname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + end do + + ! clean memory + nullify(ptr) + nullify(ptr3d) + call ESMF_FieldDestroy(field_tmp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + end subroutine read_tiled_file + + !=============================================================================== + subroutine write_restart(gcomp, restart_freq, rc) + implicit none + + ! input/output variableswrite_restart + type(ESMF_GridComp), intent(in) :: gcomp ! gridded component + integer, intent(in) :: restart_freq ! restart interval in hours + integer, intent(inout) :: rc ! return code + + ! local variables + type(ESMF_VM) :: vm + type(ESMF_Field) :: field + type(ESMF_Clock) :: mclock + type(ESMF_Calendar) :: calendar + type(ESMF_Time) :: currtime, starttime, nexttime + type(ESMF_TimeInterval) :: timediff(2) + type(InternalState) :: is_local + integer :: yr, mon, day, sec + integer :: m, ns, start_ymd + character(cl) :: time_units + real(r8) :: time_val + real(r8) :: time_bnds(2) + real(r8), pointer :: ptr(:) + logical :: whead(2) = (/.true. , .false./) + logical :: wdata(2) = (/.false., .true. /) + logical :: isPresent, isSet + character(len=cl) :: tmpstr + character(len=cl) :: rest_file + character(len=cl) :: nexttime_str + integer, save :: ns_total + logical, save :: first_call = .true. + character(len=*), parameter :: subname=trim(modName)//': (write_restart) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + !---------------------- + ! Determine clock, starttime, currtime and nexttime + !---------------------- + + call NUOPC_MediatorGet(gcomp, mediatorClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(mclock, currtime=currtime, starttime=starttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---------------------- + ! Determine time units + !---------------------- + + call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_ymd2date(yr, mon, day, start_ymd) + time_units = 'days since '//trim(med_io_date2yyyymmdd(start_ymd))//' '//med_io_sec2hms(sec, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---------------------- + ! Determine restart file name + !---------------------- + + if (trim(case_name) == 'unset') then + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + rest_file = trim(case_name)//'.cpl.ccpp.'//trim(nexttime_str)//'.nc' + + ! return if it is not time to write restart + if (restart_freq < 0) return + if (mod(sec, restart_freq) /= 0) return + + !---------------------- + ! Create restart file + !---------------------- + + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_wopen(trim(rest_file), vm, clobber=.true., file_ind=file_ind) + if (mastertask) then + write(logunit,'(a)') 'CCPP restart file is created: '//trim(rest_file) + end if + + !---------------------- + ! Define time dimension + !---------------------- + + timediff(1) = nexttime - starttime + call ESMF_TimeIntervalGet(timediff(1), d=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + time_val = day + sec/real(shr_const_cday,r8) + time_bnds(1) = time_val + time_bnds(2) = time_val + + !---------------------- + ! Create FB and add fields to it + !---------------------- + + if (first_call) then + ! create FB + FBrst = ESMF_FieldBundleCreate(rc=rc) + + ! get total element count + call ESMF_MeshGet(is_local%wrap%aoflux_mesh, elementCount=ns, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllFullReduce(vm, (/ns/), ns_total, 1, ESMF_REDUCE_SUM, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! surface roughness length in cm + field = ESMF_FieldCreate(is_local%wrap%aoflux_mesh, ESMF_TYPEKIND_R8, & + name='zorl', meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, farrayptr=ptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ptr(:) = physics%sfcprop%zorl(:) + call ESMF_FieldBundleAdd(FBrst, (/field/), rc=rc) + + ! boundary layer parameter + field = ESMF_FieldCreate(is_local%wrap%aoflux_mesh, ESMF_TYPEKIND_R8, & + name='uustar', meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, farrayptr=ptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ptr(:) = physics%sfcprop%uustar(:) + nullify(ptr) + call ESMF_FieldBundleAdd(FBrst, (/field/), rc=rc) + + ! surface air saturation specific humidity (kg/kg) + field = ESMF_FieldCreate(is_local%wrap%aoflux_mesh, ESMF_TYPEKIND_R8, & + name='qss', meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, farrayptr=ptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ptr(:) = physics%sfcprop%qss(:) + nullify(ptr) + call ESMF_FieldBundleAdd(FBrst, (/field/), rc=rc) + else + call fldbun_getdata1d(FBrst, 'zorl', ptr, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ptr(:) = physics%sfcprop%zorl(:) + nullify(ptr) + + call fldbun_getdata1d(FBrst, 'uustar', ptr, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ptr(:) = physics%sfcprop%uustar(:) + nullify(ptr) + + call fldbun_getdata1d(FBrst, 'qss', ptr, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ptr(:) = physics%sfcprop%qss(:) + nullify(ptr) + end if + + ! diagnose + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//' diagnose at '//trim(nexttime_str), ESMF_LOGMSG_INFO) + call fldbun_diagnose(FBrst, string=trim(subname)//' CCPP FBrst ', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! debug + + + !---------------------- + ! Write data + !---------------------- + + ! loop over whead/wdata phases + do m = 1, 2 + if (m == 2) then + call med_io_enddef(rest_file, file_ind=file_ind) + end if + + ! write time values + if (whead(m)) then + call ESMF_ClockGet(mclock, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_define_time(time_units, calendar, file_ind=file_ind, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call med_io_write_time(time_val, time_bnds, nt=1, file_ind=file_ind, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! write data + call med_io_write(rest_file, FBrst, whead(m), wdata(m), ns_total, 1, nt=1, pre=trim(prefix), file_ind=file_ind, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + !---------------------- + ! Close file + !---------------------- + + call med_io_close(rest_file, vm, file_ind=file_ind, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (mastertask) then + write(logunit,'(a)') 'CCPP restart file is closed: '//trim(rest_file) + end if + + end subroutine write_restart + + end module ufs_io_mod From a8bb7666d170171b7a00e57df0d180fbc9935064 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Mon, 16 May 2022 11:10:25 -0500 Subject: [PATCH 070/395] more work to bring restart capability to CCPP host model --- ufs/flux_atmocn_ccpp_mod.F90 | 204 +++++++++++++++++++++++++++++++++-- ufs/ufs_io.F90 | 115 ++++++-------------- 2 files changed, 228 insertions(+), 91 deletions(-) diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index cc10b85fd..b99c356cd 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -1,9 +1,10 @@ module flux_atmocn_ccpp_mod use ESMF, only : operator(-), operator(/) - use ESMF, only : ESMF_GridComp, ESMF_Time, ESMF_SUCCESS + use ESMF, only : ESMF_GridComp, ESMF_Time, ESMF_SUCCESS, ESMF_FAILURE use ESMF, only : ESMF_Clock, ESMF_TimeInterval, ESMF_ClockGet - use ESMF, only : ESMF_GridCompGetInternalState + use ESMF, only : ESMF_GridCompGetInternalState, ESMF_LOGMSG_INFO + use ESMF, only : ESMF_LogWrite use NUOPC, only : NUOPC_CompAttributeGet use NUOPC_Mediator, only : NUOPC_MediatorGet @@ -21,6 +22,7 @@ module flux_atmocn_ccpp_mod use ufs_const_mod use ufs_io_mod, only : read_initial, read_restart, write_restart use med_kind_mod, only : R8=>SHR_KIND_R8, CS=>SHR_KIND_CS + use med_kind_mod, only : CL=>SHR_KIND_CL use med_utils_mod, only : chkerr => med_utils_chkerr use med_internalstate_mod, only : aoflux_ccpp_suite, logunit use med_internalstate_mod, only : InternalState, mastertask @@ -32,6 +34,16 @@ module flux_atmocn_ccpp_mod public :: flux_atmOcn_ccpp ! computes atm/ocn fluxes + integer, save :: restart_freq + integer, save :: layout(2) + real(r8), save :: semis_water + character(len=cs), save :: starttype + character(len=cl), save :: ini_file + character(len=cl), save :: rst_file + character(len=cl), save :: mosaic_file + character(len=cl), save :: input_dir + character(len=1) , save :: listDel = ":" + character(*), parameter :: u_FILE_u = & __FILE__ @@ -84,10 +96,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, integer :: n, rc real(r8) :: spval logical :: isPresent, isSet - character(len=cs) :: cvalue - character(len=cs) :: starttype - integer, save :: restart_freq - real(r8), save :: semis_water + character(len=cs) :: cvalue, cname logical, save :: first_call = .true. character(len=*), parameter :: subname=' (flux_atmOcn_ccpp) ' !--------------------------------------- @@ -203,7 +212,8 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%lheatstrg = .false. end if - ! determine CCPP/host model specific options, set it to < 0 for no restart + ! determine CCPP/host model specific options + ! restart interval, set it to < 0 for no restart call NUOPC_CompAttributeGet(gcomp, name="ccpp_restart_interval", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then @@ -212,6 +222,65 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, restart_freq = 3600 ! write restart file every hour end if + ! file name for restart + call NUOPC_CompAttributeGet(gcomp, name='ccpp_restart_file', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + rst_file = trim(cvalue) + else + rst_file = 'unset' + end if + + ! file name for initial conditions + call NUOPC_CompAttributeGet(gcomp, name='ccpp_ini_file_prefix', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + ini_file = trim(cvalue) + else + ini_file = 'INPUT/sfc_data.tile' + end if + + ! name of mosaic file that will be used to read tiled files + call NUOPC_CompAttributeGet(gcomp, name='ccpp_ini_mosaic_file', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (isPresent .and. isSet) then + mosaic_file = trim(cvalue) + else + if (trim(rst_file) == 'unset') then + call ESMF_LogWrite(trim(subname)//': ccpp_ini_mosaic_file is required to read tiled initial condition!', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + end if + + ! input directory for tiled CS grid files + call NUOPC_CompAttributeGet(gcomp, name='ccpp_input_dir', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (isPresent .and. isSet) then + input_dir = trim(cvalue) + else + input_dir = "INPUT/" + end if + + ! layout to to read tiled CS grid files + call NUOPC_CompAttributeGet(gcomp, name='ccpp_ini_layout', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + do n = 1, 2 + call string_listGetName(cvalue, n, cname, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cname,*) layout(n) + end do + else + if (trim(rst_file) == 'unset') then + call ESMF_LogWrite(trim(subname)//': ccpp_ini_layout is required to read tiled initial condition!', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + end if + if (mastertask) then write(logunit,*) '========================================================' write(logunit,'(a,f5.2)') trim(subname)//' ccpp_phy_semis_water = ', semis_water @@ -225,6 +294,13 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, write(logunit,'(a,l)') trim(subname)//' ccpp_phy_cplflx = ', physics%model%cplflx write(logunit,'(a,l)') trim(subname)//' ccpp_phy_lheatstrg = ', physics%model%lheatstrg write(logunit,'(a,i)') trim(subname)//' ccpp_restart_interval = ', restart_freq + write(logunit,'(a)') trim(subname)//' ccpp_ini_file_prefix = ', trim(ini_file) + write(logunit,'(a)') trim(subname)//' ccpp_ini_mosaic_file = ', trim(mosaic_file) + write(logunit,'(a)') trim(subname)//' ccpp_input_dir = ', trim(input_dir) + write(logunit,'(a)') trim(subname)//' ccpp_restart_file = ', trim(rst_file) + do n = 1, 2 + write(logunit,'(a,i,a,i2)') trim(subname)//' ccpp_ini_layout(',n,') = ', layout(n) + end do write(logunit,*) '========================================================' end if @@ -233,10 +309,9 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) starttype if (trim(starttype) == trim('startup')) then - call read_initial(gcomp, rc) + call read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rc) else - call read_restart(gcomp, rc) - !physics%model%restart = .true. + call read_restart(gcomp, rst_file, rc) end if ! run CCPP init @@ -332,4 +407,113 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, end subroutine flux_atmOcn_ccpp + !=============================================================================== + subroutine string_listGetName(list, k, name, rc) + + ! ---------------------------------------------- + ! Get name of k-th field in list + ! It is adapted from CDEPS, shr_string_listGetName + ! ---------------------------------------------- + + implicit none + + ! input/output variables + character(*) , intent(in) :: list ! list/string + integer , intent(in) :: k ! index of field + character(*) , intent(out) :: name ! k-th name in list + integer , intent(out) :: rc + + ! local variables + integer :: i,n ! generic indecies + integer :: kFlds ! number of fields in list + integer :: i0,i1 ! name = list(i0:i1) + character(*), parameter :: subName = '(shr_string_listGetName)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + !--- check that this is a valid index --- + kFlds = string_listGetNum(list) + if (k < 1 .or. kFlds < k) then + call ESMF_LogWrite(trim(subname)//": ERROR invalid index ", ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + end if + + !--- start with whole list, then remove fields before and after desired + !field --- + i0 = 1 + i1 = len_trim(list) + + !--- remove field names before desired field --- + do n=2,k + i = index(list(i0:i1),listDel) + i0 = i0 + i + end do + + !--- remove field names after desired field --- + if ( k < kFlds ) then + i = index(list(i0:i1),listDel) + i1 = i0 + i - 2 + end if + + !--- copy result into output variable --- + name = list(i0:i1)//" " + + end subroutine string_listGetName + + !=============================================================================== + integer function string_listGetNum(str) + + ! ---------------------------------------------- + ! Get number of fields in a string list + ! It is adapted from CDEPS, string_listGetNum + ! ---------------------------------------------- + + implicit none + + ! input/output variables + character(*), intent(in) :: str ! string to search + + ! local variables + integer :: count ! counts occurances of char + character(*), parameter :: subName = '(string_listGetNum)' + ! ---------------------------------------------- + + string_listGetNum = 0 + + if (len_trim(str) > 0) then + count = string_countChar(str,listDel) + string_listGetNum = count + 1 + endif + + end function string_listGetNum + + !=============================================================================== + integer function string_countChar(str,char,rc) + + ! ---------------------------------------------- + ! Count number of occurances of a character + ! It is adapted from CDEPS, string_countChar + ! ---------------------------------------------- + + implicit none + + ! input/output variables + character(*), intent(in) :: str ! string to search + character(1), intent(in) :: char ! char to search for + integer, intent(out), optional :: rc ! return code + + ! local variables + integer :: count ! counts occurances of char + integer :: n ! generic index + character(*), parameter :: subName = '(string_countChar)' + ! ---------------------------------------------- + + count = 0 + do n = 1, len_trim(str) + if (str(n:n) == char) count = count + 1 + end do + string_countChar = count + + end function string_countChar end module flux_atmocn_ccpp_mod diff --git a/ufs/ufs_io.F90 b/ufs/ufs_io.F90 index a1bb0730c..44370407f 100644 --- a/ufs/ufs_io.F90 +++ b/ufs/ufs_io.F90 @@ -89,18 +89,21 @@ module ufs_io_mod contains !=============================================================================== - subroutine read_initial(gcomp, rc) + subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rc) implicit none ! input/output variables type(ESMF_GridComp), intent(in) :: gcomp + character(len=cl), intent(in) :: ini_file + character(len=cl), intent(in) :: mosaic_file + character(len=cl), intent(in) :: input_dir + integer :: layout(2) integer, intent(inout) :: rc ! local variables type(domain_type) :: domain type(ESMF_Field) :: field real(ESMF_KIND_R8), pointer :: ptr(:,:,:) - character(len=cl) :: filename character(len=*), parameter :: subname = trim(modName)//': (read_initial) ' !------------------------------------------------------------------------------- @@ -111,27 +114,20 @@ subroutine read_initial(gcomp, rc) ! Create domain ! --------------------- - call create_fms_domain(gcomp, domain, rc) + domain%layout(:) = layout(:) + call create_fms_domain(gcomp, domain, mosaic_file, rc) ! --------------------- ! Create grid ! --------------------- - call create_grid(domain, rc) - - !---------------------- - ! Set file name for initial conditions - !---------------------- - - ! TODO: make file name configurable - filename = 'INPUT/sfc_data.tile' - call ESMF_LogWrite(subname//' read initial conditions from '//trim(filename)//'*', ESMF_LOGMSG_INFO) + call create_grid(gcomp, domain, mosaic_file, input_dir, rc) !---------------------- ! Read surface friction velocity !---------------------- - call read_tiled_file(gcomp, filename, 'uustar', domain, field, numrec=1, rc=rc) + call read_tiled_file(gcomp, ini_file, 'uustar', domain, field, numrec=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -144,39 +140,11 @@ subroutine read_initial(gcomp, rc) ! Read surface roughness length !---------------------- - call read_tiled_file(gcomp, filename, 'zorl', domain, field, numrec=1, rc=rc) + call read_tiled_file(gcomp, ini_file, 'zorl', domain, field, numrec=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return physics%sfcprop%zorl(:) = ptr(:,1,1) - physics%sfcprop%zorlw(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !---------------------- - ! Read sea surface temperature, composite - !---------------------- - - call read_tiled_file(gcomp, filename, 'tsea', domain, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - physics%sfcprop%tsfco(:) = ptr(:,1,1) - physics%sfcprop%tsfc(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !---------------------- - ! Read precipitation - !---------------------- - - call read_tiled_file(gcomp, filename, 'tprcp', domain, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - physics%sfcprop%tprcp(:) = ptr(:,1,1) nullify(ptr) call ESMF_FieldDestroy(field, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -184,12 +152,13 @@ subroutine read_initial(gcomp, rc) end subroutine read_initial !=============================================================================== - subroutine read_restart(gcomp, rc) + subroutine read_restart(gcomp, rst_file, rc) implicit none ! input/output variables - type(ESMF_GridComp), intent(in) :: gcomp ! gridded component - integer, intent(inout) :: rc ! return code + type(ESMF_GridComp), intent(in) :: gcomp ! gridded component + character(len=cl), intent(inout):: rst_file ! restart file + integer, intent(inout) :: rc ! return code ! local variables type(ESMF_VM) :: vm @@ -200,9 +169,6 @@ subroutine read_restart(gcomp, rc) type(InternalState) :: is_local integer :: n, yr, mon, day, sec real(r8), pointer :: ptr(:) - logical :: isPresent, isSet - character(len=cl) :: cvalue - character(len=cl) :: rest_file character(len=cl) :: currtime_str character(len=cs), allocatable :: flds(:) character(len=*), parameter :: subname=trim(modName)//': (read_restart) ' @@ -231,11 +197,7 @@ subroutine read_restart(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call NUOPC_CompAttributeGet(gcomp, name='ccpp_restart_file', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - rest_file = trim(cvalue) - else + if (trim(rst_file) == 'unset') then call NUOPC_MediatorGet(gcomp, mediatorClock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -245,7 +207,7 @@ subroutine read_restart(gcomp, rc) call ESMF_TimeGet(currTime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(currtime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - rest_file = trim(case_name)//'.cpl.ccpp.'//trim(currtime_str)//'.nc' + rst_file = trim(case_name)//'.cpl.ccpp.'//trim(currtime_str)//'.nc' end if !---------------------- @@ -253,7 +215,7 @@ subroutine read_restart(gcomp, rc) !---------------------- if (mastertask) then - write(logunit,'(a)') 'Reading CCPP restart file: '//trim(rest_file) + write(logunit,'(a)') 'Reading CCPP restart file: '//trim(rst_file) end if ! create FB @@ -276,7 +238,7 @@ subroutine read_restart(gcomp, rc) end do ! read file to FB - call med_io_read(rest_file, vm, FBrst, pre=trim(prefix), rc=rc) + call med_io_read(rst_file, vm, FBrst, pre=trim(prefix), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then @@ -309,12 +271,13 @@ subroutine read_restart(gcomp, rc) end subroutine read_restart !=============================================================================== - subroutine create_fms_domain(gcomp, domain, rc) + subroutine create_fms_domain(gcomp, domain, mosaic_file, rc) implicit none ! input/output variables type(ESMF_GridComp), intent(in) :: gcomp type(domain_type), intent(inout) :: domain + character(len=cl), intent(in) :: mosaic_file integer, intent(inout) :: rc ! local variables @@ -326,8 +289,8 @@ subroutine create_fms_domain(gcomp, domain, rc) integer :: global_indices(4,6) integer :: layout2d(2,6) integer, allocatable :: pe_start(:), pe_end(:) - character(len=cl) :: msg, mosaic_file - character(len=*), parameter :: subname = trim(modName)//': (create_mosaic) ' + character(len=cl) :: msg + character(len=*), parameter :: subname = trim(modName)//': (create_fms_domain) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -349,9 +312,6 @@ subroutine create_fms_domain(gcomp, domain, rc) ! Open mosaic file and query some information ! --------------------- - ! TODO: make mosaic file name configurable - mosaic_file = 'INPUT/C96_mosaic.nc' - if (.not. open_file(mosaic_fileobj, trim(mosaic_file), 'read')) then call ESMF_LogWrite(trim(subname)//'error in opening file '//trim(mosaic_file), ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE @@ -410,10 +370,6 @@ subroutine create_fms_domain(gcomp, domain, rc) ! Set pe_start, pe_end !---------------------- - ! TODO: make layout options configurable - domain%layout(1) = 3 - domain%layout(2) = 8 - allocate(pe_start(domain%ntiles)) allocate(pe_end(domain%ntiles)) do n = 1, domain%ntiles @@ -457,28 +413,26 @@ subroutine create_fms_domain(gcomp, domain, rc) end subroutine create_fms_domain !=============================================================================== - subroutine create_grid(domain, rc) + subroutine create_grid(gcomp, domain, mosaic_file, input_dir, rc) implicit none ! input/output variables + type(ESMF_GridComp), intent(in) :: gcomp type(domain_type), intent(inout) :: domain + character(len=cl), intent(in) :: mosaic_file + character(len=cl), intent(in) :: input_dir integer, intent(inout) :: rc ! local variables type(ESMF_Decomp_Flag) :: decompflagPTile(2,6) integer :: n integer :: decomptile(2,6) - character(len=cl) :: mosaic_file, input_dir character(len=*), parameter :: subname = trim(modName)//': (create_grid) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - ! TODO: make mosaic file name and input folder configurable - mosaic_file = 'INPUT/C96_mosaic.nc' - input_dir = 'INPUT/' - ! TODO: currently this is only tested with global application ! set decomposition do n = 1, domain%ntiles @@ -710,9 +664,8 @@ subroutine write_restart(gcomp, restart_freq, rc) real(r8), pointer :: ptr(:) logical :: whead(2) = (/.true. , .false./) logical :: wdata(2) = (/.false., .true. /) - logical :: isPresent, isSet character(len=cl) :: tmpstr - character(len=cl) :: rest_file + character(len=cl) :: rst_file character(len=cl) :: nexttime_str integer, save :: ns_total logical, save :: first_call = .true. @@ -757,7 +710,7 @@ subroutine write_restart(gcomp, restart_freq, rc) call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - rest_file = trim(case_name)//'.cpl.ccpp.'//trim(nexttime_str)//'.nc' + rst_file = trim(case_name)//'.cpl.ccpp.'//trim(nexttime_str)//'.nc' ! return if it is not time to write restart if (restart_freq < 0) return @@ -769,9 +722,9 @@ subroutine write_restart(gcomp, restart_freq, rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(trim(rest_file), vm, clobber=.true., file_ind=file_ind) + call med_io_wopen(trim(rst_file), vm, clobber=.true., file_ind=file_ind) if (mastertask) then - write(logunit,'(a)') 'CCPP restart file is created: '//trim(rest_file) + write(logunit,'(a)') 'CCPP restart file is created: '//trim(rst_file) end if !---------------------- @@ -861,7 +814,7 @@ subroutine write_restart(gcomp, restart_freq, rc) ! loop over whead/wdata phases do m = 1, 2 if (m == 2) then - call med_io_enddef(rest_file, file_ind=file_ind) + call med_io_enddef(rst_file, file_ind=file_ind) end if ! write time values @@ -876,7 +829,7 @@ subroutine write_restart(gcomp, restart_freq, rc) end if ! write data - call med_io_write(rest_file, FBrst, whead(m), wdata(m), ns_total, 1, nt=1, pre=trim(prefix), file_ind=file_ind, rc=rc) + call med_io_write(rst_file, FBrst, whead(m), wdata(m), ns_total, 1, nt=1, pre=trim(prefix), file_ind=file_ind, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do @@ -884,11 +837,11 @@ subroutine write_restart(gcomp, restart_freq, rc) ! Close file !---------------------- - call med_io_close(rest_file, vm, file_ind=file_ind, rc=rc) + call med_io_close(rst_file, vm, file_ind=file_ind, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (mastertask) then - write(logunit,'(a)') 'CCPP restart file is closed: '//trim(rest_file) + write(logunit,'(a)') 'CCPP restart file is closed: '//trim(rst_file) end if end subroutine write_restart From 355557a9d7c116e6a95540c5fb64a318589df027 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Wed, 18 May 2022 00:36:09 -0600 Subject: [PATCH 071/395] fix to write data on exchange grid --- mediator/med_io_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 1a1541475..6d9b8d2f6 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -1111,12 +1111,14 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue) end if end do - else if (rank == 1) then + else if (rank == 1 .or. rank == 0) then name1 = trim(lpre)//'_'//trim(itemc) rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) call pio_setframe(io_file(lfile_ind),varid,frame) + ! fix for writing data on exchange grid, which has no data in some PETs + if (rank == 0) nullify(fldptr1) call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr1, rcode, fillval=lfillvalue) - end if ! end if rank is 2 or 1 + end if ! end if rank is 2 or 1 or 0 end if ! end if not "hgt" end do ! end loop over fields in FB From c542d8f397afc320cb22488c3f2e2772bbaa8ad7 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 18 May 2022 15:52:47 -0600 Subject: [PATCH 072/395] first step - reorder pio_init and move to ensemble_driver --- cesm/driver/ensemble_driver.F90 | 46 +++++++ cesm/driver/esm.F90 | 8 +- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 11 +- cesm/nuopc_cap_share/shr_pio_mod.F90 | 132 +++++++++++++++++---- 4 files changed, 166 insertions(+), 31 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 1c5d3ca67..15327d1d3 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -30,6 +30,7 @@ subroutine SetServices(ensemble_driver, rc) use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSpecialize use NUOPC_Driver , only : driver_routine_SS => SetServices use NUOPC_Driver , only : ensemble_label_SetModelServices => label_SetModelServices + use NUOPC_Driver , only : ensemble_label_ModifyCplLists => label_ModifyCplLists use ESMF , only : ESMF_GridComp, ESMF_GridCompSet use ESMF , only : ESMF_Config, ESMF_ConfigCreate, ESMF_ConfigLoadFile use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO @@ -54,6 +55,10 @@ subroutine SetServices(ensemble_driver, rc) specRoutine=SetModelServices, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(ensemble_driver, specLabel=ensemble_label_ModifyCplLists, & + specRoutine=InitializeIO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Create, open and set the config config = ESMF_ConfigCreate(rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -273,5 +278,46 @@ subroutine SetModelServices(ensemble_driver, rc) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine SetModelServices + subroutine InitializeIO(ensemble_driver, rc) + use ESMF, only: ESMF_GridComp, ESMF_LOGMSG_INFO, ESMF_LogWrite + use ESMF, only: ESMF_SUCCESS, ESMF_VM, ESMF_GridCompGet, ESMF_VMGet + use ESMF, only: ESMF_CONFIG, ESMF_GridCompIsPetLocal, ESMF_State, ESMF_Clock + use NUOPC, only: NUOPC_CompAttributeGet + use NUOPC_DRIVER, only: NUOPC_DriverGetComp + use shr_pio_mod , only: shr_pio_init, shr_pio_component_init + + type(ESMF_GridComp) :: ensemble_driver + type(ESMF_VM) :: ensemble_vm + integer, intent(out) :: rc + character(len=*), parameter :: subname=u_FILE_u//"InitializeIO" + type(ESMF_GridComp), pointer :: dcomp(:), ccomp(:) + logical :: asyncio_task=.false. + integer :: iam + integer :: Global_Comm + integer :: drv, comp + integer, allocatable :: asyncio_petlist(:) + + rc = ESMF_SUCCESS + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + + call ESMF_GridCompGet(ensemble_driver, vm=ensemble_vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(ensemble_vm, localpet=iam, mpiCommunicator=Global_Comm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + nullify(dcomp) + call NUOPC_DriverGetComp(ensemble_driver, complist=dcomp, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do drv=1,size(dcomp) + if (ESMF_GridCompIsPetLocal(dcomp(drv), rc=rc) .or. asyncio_task) then + call shr_pio_init(dcomp(drv), rc=rc) + + call shr_pio_component_init(dcomp(drv), Global_Comm, asyncio_petlist, rc) + + endif + enddo + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + end subroutine InitializeIO end module Ensemble_driver diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index f788c2478..f04603bf7 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -934,8 +934,8 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) ! Initialize PIO ! This reads in the pio parameters that are independent of component - call shr_pio_init(driver, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return +! call shr_pio_init(driver, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(comms(componentCount+1), comps(componentCount+1)) comps(1) = 1 @@ -1182,8 +1182,8 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) enddo ! Read in component dependent PIO parameters and initialize ! IO systems - call shr_pio_component_init(driver, size(comps), rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return +! call shr_pio_component_init(driver, size(comps), rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return ! Initialize MCT (this is needed for data models and cice prescribed capability) call mct_world_init(componentCount+1, GLOBAL_COMM, comms, comps) diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index da7891c49..65279418b 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -132,7 +132,7 @@ end subroutine get_component_instance !=============================================================================== subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) - use shr_pio_mod, only : shr_pio_log_comp_settings + use NUOPC, only : NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd ! input/output variables type(ESMF_GridComp) :: gcomp logical, intent(in) :: mastertask @@ -164,15 +164,18 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) endif open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) - ! Write the PIO settings to the beggining of each component log - call shr_pio_log_comp_settings(gcomp, logunit) else logUnit = 6 endif ! TODO: shr_file mod is deprecated and should be removed. call shr_file_setLogUnit (logunit) - + + call NUOPC_CompAttributeAdd(gcomp, attrList=(/'logunit'/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name='logunit',value=logunit, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end subroutine set_component_logging !=============================================================================== diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/shr_pio_mod.F90 index e05a1ed99..8300710bc 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/shr_pio_mod.F90 @@ -207,49 +207,72 @@ subroutine shr_pio_init(driver, rc) end subroutine shr_pio_init - subroutine shr_pio_component_init(driver, ncomps, rc) + subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) use ESMF, only : ESMF_GridComp, ESMF_LogSetError, ESMF_RC_NOT_VALID, ESMF_GridCompIsCreated, ESMF_VM, ESMF_VMGet - use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated + use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated, ESMF_Finalize, ESMF_PtrInt1D use NUOPC, only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use NUOPC_Driver, only : NUOPC_DriverGetComp + use mpi, only : MPI_INTEGER, MPI_MAX, MPI_IN_PLACE, MPI_LOR, MPI_LOGICAL type(ESMF_GridComp) :: driver - type(ESMF_VM) :: vm - integer, intent(in) :: ncomps + integer, intent(in) :: Global_COMM ! The communicator associated with the ensemble_driver + integer, intent(in) :: async_io_petlist(:) integer, intent(out) :: rc + type(ESMF_VM) :: vm integer :: i, npets, default_stride integer :: j - integer :: comp_comm, comp_rank + integer :: comp_comm, comp_rank, driver_comm + integer, allocatable :: procs_per_comp(:), async_procs_per_comp(:) + integer, allocatable :: io_proc_list(:), async_io_tasks(:), comp_proc_list(:,:) + type(ESMF_PtrInt1D), pointer :: all_comp_proc_lists(:) type(ESMF_GridComp), pointer :: gcomp(:) character(CS) :: cval character(CS) :: msgstr integer :: do_async_init + integer :: totalpes + integer :: asyncio_ntasks + integer :: asyncio_stride + integer :: pecnt + integer :: ierr type(iosystem_desc_t), allocatable :: async_iosystems(:) + character(len=*), parameter :: subname="shr_pio_component_init" - allocate(pio_comp_settings(ncomps)) - allocate(gcomp(ncomps)) - - allocate(io_compid(ncomps)) - allocate(io_compname(ncomps)) - allocate(iosystems(ncomps)) + call ESMF_GridCompGet(gridcomp=driver, vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return nullify(gcomp) - do_async_init = 0 - - call NUOPC_DriverGetComp(driver, compList=gcomp, rc=rc) + nullify(all_comp_proc_lists) + call NUOPC_DriverGetComp(driver, compList=gcomp, petLists=all_comp_proc_lists, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return total_comps = size(gcomp) + allocate(pio_comp_settings(total_comps)) + allocate(procs_per_comp(total_comps)) + allocate(io_compid(total_comps)) + allocate(io_compname(total_comps)) + allocate(iosystems(total_comps)) + do_async_init = 0 + call ESMF_VMGet(vm, petCount=totalpes, mpiCommunicator=driver_comm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + +! call NUOPC_CompAttributeGet(driver, name="asyncio_ntasks", value=cval, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return +! read(cval, *) asyncio_ntasks + asyncio_ntasks = 0 +! call NUOPC_CompAttributeGet(driver, name="asyncio_stride", value=cval, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return +! read(cval, *) asyncio_stride + asyncio_stride = 0 + do i=1,total_comps io_compid(i) = i+1 - if (ESMF_GridCompIsPetLocal(gcomp(i), rc=rc)) then call ESMF_GridCompGet(gcomp(i), vm=vm, name=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return io_compname(i) = trim(cval) - call NUOPC_CompAttributeAdd(gcomp(i), attrList=(/'MCTID'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -261,6 +284,8 @@ subroutine shr_pio_component_init(driver, ncomps, rc) ssiLocalPetCount=default_stride, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + procs_per_comp(i) = npets + call NUOPC_CompAttributeGet(gcomp(i), name="pio_stride", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cval, *) pio_comp_settings(i)%pio_stride @@ -316,9 +341,7 @@ subroutine shr_pio_component_init(driver, ncomps, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) - if (pio_comp_settings(i)%pio_async_interface) then - do_async_init = do_async_init + 1 - else + if (.not. pio_comp_settings(i)%pio_async_interface) then if(pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req = pio_comp_settings(i)%pio_numiotasks endif @@ -329,10 +352,71 @@ subroutine shr_pio_component_init(driver, ncomps, rc) pio_comp_settings(i)%pio_rearranger, iosystems(i), pio_comp_settings(i)%pio_root, & pio_rearr_opts) endif + ! Write the PIO settings to the beggining of each component log + if(comp_rank == 0) call shr_pio_log_comp_settings(gcomp(i)) endif enddo + do i=1,total_comps + call MPI_AllReduce(MPI_IN_PLACE, pio_comp_settings(i)%pio_async_interface, 1, MPI_LOGICAL, & + MPI_LOR, driver_comm, rc) + if(pio_comp_settings(i)%pio_async_interface) do_async_init = do_async_init + 1 + enddo + +! +! Async IO initialization +! + + allocate(async_io_tasks(totalpes)) + j=1 + if(asyncio_ntasks > 0) then + allocate(io_proc_list(asyncio_ntasks)) + do i=1,totalpes + if (mod(i,asyncio_stride) == 0) then + io_proc_list(j) = i + j = j + 1 + endif + enddo + endif +! +! Get the PET list for each component using async IO +! + call MPI_Allreduce(MPI_IN_PLACE, do_async_init, 1, MPI_INTEGER, MPI_MAX, driver_comm, ierr) if (do_async_init > 0) then + allocate(comp_proc_list(totalpes, do_async_init)) + j = 1 + do i=1,total_comps + + if(pio_comp_settings(i)%pio_async_interface) then + pecnt = size(all_comp_proc_lists(i)%ptr) + comp_proc_list(1:pecnt,j) = all_comp_proc_lists(i)%ptr + j = j+1 + endif + enddo + + if(asyncio_ntasks == 0) then + call shr_sys_abort(subname//' ERROR: ASYNC IO Requested but no IO PES assigned') + endif + allocate(async_iosystems(do_async_init)) + allocate(async_procs_per_comp(do_async_init)) + + + + j=1 + do i=1,total_comps + if(pio_comp_settings(i)%pio_async_interface) then + async_procs_per_comp(j) = procs_per_comp(i) + + j = j+1 + + endif + enddo +! call init_intercom(async_iosystems, driver_comm, async_procs_per_comp, comp_proc_list, io_proc_list, & +! PIO_REARR_BOX) + if(asyncio_ntasks) then + ! IO tasks should not return until the run is completed + call ESMF_FINALIZE() + endif j=1 do i=1,total_comps if(pio_comp_settings(i)%pio_async_interface) then @@ -340,19 +424,18 @@ subroutine shr_pio_component_init(driver, ncomps, rc) j = j+1 endif enddo - + print *,__FILE__,__LINE__,' async_init: ',do_async_init endif - deallocate(gcomp) end subroutine shr_pio_component_init - subroutine shr_pio_log_comp_settings(gcomp, logunit) + subroutine shr_pio_log_comp_settings(gcomp) use ESMF, only : ESMF_GridComp, ESMF_GridCompGet use NUOPC, only: NUOPC_CompAttributeGet type(ESMF_GridComp) :: gcomp - integer, intent(in) :: logunit + integer :: logunit integer :: compid character(len=CS) :: name, cval integer :: i @@ -362,6 +445,9 @@ subroutine shr_pio_log_comp_settings(gcomp, logunit) call ESMF_GridCompGet(gcomp, name=name, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='logunit', value=logunit) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name="MCTID", value=cval, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From 5df8fd5ec2f8df36e3a26d85f28ceb4f5b27722c Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 19 May 2022 07:30:37 -0600 Subject: [PATCH 073/395] standardize subname variable --- cesm/driver/ensemble_driver.F90 | 6 +- cesm/driver/esm.F90 | 22 +++---- cesm/driver/esm_time_mod.F90 | 8 +-- cesm/nuopc_cap_share/glc_elevclass_mod.F90 | 24 ++++---- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 12 ++-- cesm/nuopc_cap_share/shr_fire_emis_mod.F90 | 2 +- cesm/nuopc_cap_share/shr_megan_mod.F90 | 2 +- .../shr_ozone_coupling_mod.F90 | 2 +- cesm/nuopc_cap_share/shr_pio_mod.F90 | 2 +- mediator/esmFlds.F90 | 22 +++---- mediator/esmFldsExchange_cesm_mod.F90 | 2 +- mediator/esmFldsExchange_hafs_mod.F90 | 10 ++-- mediator/esmFldsExchange_nems_mod.F90 | 2 +- mediator/med.F90 | 24 ++++---- mediator/med_diag_mod.F90 | 2 +- mediator/med_fraction_mod.F90 | 4 +- mediator/med_internalstate_mod.F90 | 4 +- mediator/med_map_mod.F90 | 20 +++---- mediator/med_merge_mod.F90 | 10 ++-- mediator/med_methods_mod.F90 | 58 +++++++++---------- mediator/med_phases_aofluxes_mod.F90 | 10 ++-- mediator/med_phases_history_mod.F90 | 18 +++--- mediator/med_phases_ocnalb_mod.F90 | 6 +- mediator/med_phases_post_atm_mod.F90 | 2 +- mediator/med_phases_post_glc_mod.F90 | 6 +- mediator/med_phases_post_ice_mod.F90 | 2 +- mediator/med_phases_post_lnd_mod.F90 | 2 +- mediator/med_phases_post_ocn_mod.F90 | 2 +- mediator/med_phases_post_rof_mod.F90 | 2 +- mediator/med_phases_post_wav_mod.F90 | 2 +- mediator/med_phases_prep_atm_mod.F90 | 2 +- mediator/med_phases_prep_glc_mod.F90 | 12 ++-- mediator/med_phases_prep_ice_mod.F90 | 2 +- mediator/med_phases_prep_lnd_mod.F90 | 2 +- mediator/med_phases_prep_ocn_mod.F90 | 10 ++-- mediator/med_phases_prep_rof_mod.F90 | 8 +-- mediator/med_phases_prep_wav_mod.F90 | 6 +- mediator/med_phases_profile_mod.F90 | 2 +- mediator/med_phases_restart_mod.F90 | 6 +- mediator/med_time_mod.F90 | 2 +- 40 files changed, 171 insertions(+), 171 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 15327d1d3..85ddb67eb 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -40,7 +40,7 @@ subroutine SetServices(ensemble_driver, rc) ! local variables type(ESMF_Config) :: config - character(len=*), parameter :: subname = "(ensemble_driver.F90:SetServices)" + character(len=*), parameter :: subname = '('//__FILE__//':SetServices)' !--------------------------------------- rc = ESMF_SUCCESS @@ -120,7 +120,7 @@ subroutine SetModelServices(ensemble_driver, rc) character(len=*) , parameter :: start_type_start = "startup" character(len=*) , parameter :: start_type_cont = "continue" character(len=*) , parameter :: start_type_brnch = "branch" - character(len=*) , parameter :: subname = "(ensemble_driver.F90:SetModelServices)" + character(len=*), parameter :: subname = '('//__FILE__//':SetModelServices)' !------------------------------------------- rc = ESMF_SUCCESS @@ -289,7 +289,7 @@ subroutine InitializeIO(ensemble_driver, rc) type(ESMF_GridComp) :: ensemble_driver type(ESMF_VM) :: ensemble_vm integer, intent(out) :: rc - character(len=*), parameter :: subname=u_FILE_u//"InitializeIO" + character(len=*), parameter :: subname = '('//__FILE__//':InitializeIO)' type(ESMF_GridComp), pointer :: dcomp(:), ccomp(:) logical :: asyncio_task=.false. integer :: iam diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index f04603bf7..cb4bc09e3 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -55,7 +55,7 @@ subroutine SetServices(driver, rc) ! local variables type(ESMF_Config) :: runSeq - character(len=*), parameter :: subname = "(esm.F90:SetServices)" + character(len=*), parameter :: subname = '('//__FILE__//':SetServices)' !--------------------------------------- rc = ESMF_SUCCESS @@ -133,7 +133,7 @@ subroutine SetModelServices(driver, rc) integer :: maxthreads character(len=CL) :: msgstr integer :: componentcount - character(len=*), parameter :: subname = "(esm.F90:SetModelServices)" + character(len=*), parameter :: subname = '('//__FILE__//':SetModelServices)' !------------------------------------------- rc = ESMF_SUCCESS @@ -246,7 +246,7 @@ subroutine SetRunSequence(driver, rc) integer :: localrc type(ESMF_Config) :: runSeq type(NUOPC_FreeFormat) :: runSeqFF - character(len=*), parameter :: subname = "(esm.F90:SetRunSequence)" + character(len=*), parameter :: subname = '('//__FILE__//':SetRunSequence)' !--------------------------------------- rc = ESMF_SUCCESS @@ -344,7 +344,7 @@ recursive subroutine ModifyCplLists(driver, importState, exportState, clock, rc) character(len=CL), allocatable :: cplList(:) character(len=CL) :: tempString character(len=CL) :: msgstr - character(len=*), parameter :: subname = "(esm.F90:ModifyCplLists)" + character(len=*), parameter :: subname = '('//__FILE__//':pretty_print_nuopc_freeformat)' !--------------------------------------- rc = ESMF_SUCCESS @@ -443,7 +443,7 @@ subroutine InitAttributes(driver, rc) integer , parameter :: ens1=1 ! use first instance of ensemble only integer , parameter :: fix1=1 ! temporary hard-coding to first ensemble, needs to be fixed real(R8) , parameter :: epsilo = shr_const_mwwv/shr_const_mwdair - character(len=*) , parameter :: subname = '(InitAttributes)' + character(len=*), parameter :: subname = '('//__FILE__//':InitAttributes)' !---------------------------------------------------------- rc = ESMF_SUCCESS @@ -575,7 +575,7 @@ subroutine CheckAttributes( driver, rc ) character(len=CS) :: logFilePostFix ! postfix for output log files character(len=CL) :: outPathRoot ! root for output log files character(len=CS) :: cime_model - character(len=*), parameter :: subname = '(driver_attributes_check) ' + character(len=*), parameter :: subname = '('//__FILE__//':CheckAttributes)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -635,7 +635,7 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n character(len=CL) :: cvalue character(len=CS) :: attribute integer :: componentCount - character(len=*), parameter :: subname = "(esm.F90:AddAttributes)" + character(len=*), parameter :: subname = '('//__FILE__//':AddAttributes)' !------------------------------------------- rc = ESMF_Success @@ -737,7 +737,7 @@ subroutine ReadAttributes(gcomp, config, label, relaxedflag, formatprint, rc) ! local variables type(NUOPC_FreeFormat) :: attrFF - character(len=*), parameter :: subname = "(esm.F90:ReadAttributes)" + character(len=*), parameter :: subname = '('//__FILE__//':ReadAttributes)' !------------------------------------------- rc = ESMF_SUCCESS @@ -784,7 +784,7 @@ subroutine InitAdvertize(driver, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables - character(len=*), parameter :: subname = "(esm.F90:InitAdvertize)" + character(len=*), parameter :: subname = '('//__FILE__//':InitAdvertize)' !--------------------------------------- rc = ESMF_SUCCESS @@ -892,7 +892,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) character(CL) :: cvalue logical :: found_comp integer :: rank, nprocs, ierr - character(len=*), parameter :: subname = "(esm_pelayout.F90:esm_init_pelayout)" + character(len=*), parameter :: subname = '('//__FILE__//':esm_init_pelayout)' !--------------------------------------- rc = ESMF_SUCCESS @@ -1252,7 +1252,7 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) integer :: iscol_data(1) integer :: petcount character(len=CL) :: cvalue - character(len=*), parameter :: subname= ' (esm_get_single_column_attributes) ' + character(len=*), parameter :: subname = '('//__FILE__//':esm_set_single_column_attributes)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index 40c57b87c..3a4b7f1e5 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -102,7 +102,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert character(CS) :: inst_suffix integer :: tmp(4) ! Array for Broadcast logical :: isPresent - character(len=*), parameter :: subname = '(esm_time_clockInit): ' + character(len=*), parameter :: subname = '('//__FILE__//':esm_time_clockInit)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -393,7 +393,7 @@ subroutine esm_time_alarmInit( clock, alarm, option, & type(ESMF_Time) :: NextAlarm ! Next restart alarm time type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval integer :: sec - character(len=*), parameter :: subname = '(med_time_alarmInit): ' + character(len=*), parameter :: subname = '('//__FILE__//':esm_time_alarmInit)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -582,7 +582,7 @@ subroutine esm_time_timeInit( Time, ymd, cal, tod, desc, logunit ) integer :: ltod ! local tod character(len=256) :: ldesc ! local desc integer :: rc ! return code - character(len=*), parameter :: subname = '(esm_time_m_ETimeInit) ' + character(len=*), parameter :: subname = '('//__FILE__//':esm_time_timeInit)' !------------------------------------------------------------------------------- ltod = 0 @@ -649,7 +649,7 @@ subroutine esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, c ! local variables integer :: status, ncid, varid ! netcdf stuff character(CL) :: tmpstr ! temporary - character(len=*), parameter :: subname = "(esm_time_read_restart)" + character(len=*), parameter :: subname = '('//__FILE__//':esm_time_read_restart)' !---------------------------------------------------------------- ! use netcdf here since it's serial diff --git a/cesm/nuopc_cap_share/glc_elevclass_mod.F90 b/cesm/nuopc_cap_share/glc_elevclass_mod.F90 index 3a984f642..ee32d7c77 100644 --- a/cesm/nuopc_cap_share/glc_elevclass_mod.F90 +++ b/cesm/nuopc_cap_share/glc_elevclass_mod.F90 @@ -78,7 +78,7 @@ subroutine glc_elevclass_init_default(my_glc_nec, logunit) integer, intent(in), optional :: logunit ! ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = 'glc_elevclass_init' + character(len=*), parameter :: subname = '('//__FILE__//':glc_elevclass_init_default)' !----------------------------------------------------------------------- glc_nec = my_glc_nec @@ -130,7 +130,7 @@ subroutine glc_elevclass_init_override(my_glc_nec, my_topomax) ! ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = 'glc_elevclass_init_override' + character(len=*), parameter :: subname = '('//__FILE__//':glc_elevclass_init_override)' !----------------------------------------------------------------------- SHR_ASSERT_ALL_FL((ubound(my_topomax) == (/my_glc_nec/)), __FILE__, __LINE__) @@ -147,7 +147,7 @@ subroutine glc_elevclass_clean() ! !DESCRIPTION: ! Deallocate memory allocated in this module - character(len=*), parameter :: subname = 'glc_elevclass_clean' + character(len=*), parameter :: subname = '('//__FILE__//':glc_elevclass_clean)' !----------------------------------------------------------------------- if (allocated(topomax)) then @@ -169,7 +169,7 @@ function glc_get_num_elevation_classes() result(num_elevation_classes) ! ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = 'glc_get_num_elevation_classes' + character(len=*), parameter :: subname = '('//__FILE__//':glc_elevclass_clean)' !----------------------------------------------------------------------- num_elevation_classes = glc_nec @@ -199,7 +199,7 @@ subroutine glc_get_elevation_classes_without_bareland(glc_topo, glc_elevclass, l integer :: glc_pt integer :: err_code - character(len=*), parameter :: subname = 'get_glc_elevation_classes' + character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_classes_without_bareland)' !----------------------------------------------------------------------- npts = size(glc_elevclass) @@ -246,7 +246,7 @@ subroutine glc_get_elevation_classes_with_bareland(glc_ice_covered, glc_topo, gl ! Tolerance for checking whether ice_covered is 0 or 1 real(r8), parameter :: ice_covered_tol = 1.e-13 - character(len=*), parameter :: subname = 'get_glc_elevation_classes' + character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_classes_with_bareland)' !----------------------------------------------------------------------- npts = size(glc_elevclass) @@ -315,7 +315,7 @@ subroutine glc_get_elevation_class(topo, elevation_class, err_code) ! !LOCAL VARIABLES: integer :: ec ! temporary elevation class - character(len=*), parameter :: subname = 'glc_get_elevation_class' + character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_class)' !----------------------------------------------------------------------- if (glc_nec < 1) then @@ -359,7 +359,7 @@ function glc_get_elevclass_bounds() result(elevclass_bounds) ! ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = 'glc_get_elevclass_bounds' + character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_class)' !----------------------------------------------------------------------- elevclass_bounds(:) = topomax(:) @@ -388,7 +388,7 @@ function glc_elevclass_as_string(elevation_class) result(ec_string) ! !LOCAL VARIABLES: character(len=16) :: format_string - character(len=*), parameter :: subname = 'glc_elevclass_as_string' + character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_class)' !----------------------------------------------------------------------- ! e.g., for GLC_ELEVCLASS_STRLEN = 2, format_string will be '(i2.2)' @@ -412,7 +412,7 @@ function glc_mean_elevation_virtual(elevation_class, logunit) result(mean_elevat integer :: resulting_elevation_class integer :: err_code - character(len=*), parameter :: subname = 'glc_mean_elevation_virtual' + character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_class)' !----------------------------------------------------------------------- if (elevation_class == 0) then @@ -478,7 +478,7 @@ function glc_errcode_to_string(err_code) result(err_string) ! ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = 'glc_errcode_to_string' + character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_class)' !----------------------------------------------------------------------- select case (err_code) @@ -522,7 +522,7 @@ subroutine glc_get_fractional_icecov(nec, glc_topo, glc_icefrac, glc_icefrac_ec, integer :: ec integer :: glc_pt integer :: err_code - character(len=*), parameter :: subname = 'get_glc_elevation_classes' + character(len=*), parameter :: subname = '('//__FILE__//':glc_get_fractional_icecov)' !----------------------------------------------------------------------- npts = size(glc_topo) diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index 65279418b..32d7af5e1 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -228,7 +228,7 @@ subroutine state_getscalar(state, scalar_id, scalar_value, flds_scalar_name, fld type(ESMF_Field) :: field real(r8), pointer :: farrayptr(:,:) real(r8) :: tmp(1) - character(len=*), parameter :: subname='(state_getscalar)' + character(len=*), parameter :: subname = '('//__FILE__//':state_getscalar)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -279,7 +279,7 @@ subroutine state_setscalar(scalar_value, scalar_id, State, flds_scalar_name, fld type(ESMF_Field) :: lfield type(ESMF_VM) :: vm real(r8), pointer :: farrayptr(:,:) - character(len=*), parameter :: subname='(state_setscalar)' + character(len=*), parameter :: subname = '('//__FILE__//':state_setscalar)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -325,7 +325,7 @@ subroutine state_diagnose(State, string, rc) character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) real(r8), pointer :: dataPtr1d(:) real(r8), pointer :: dataPtr2d(:,:) - character(len=*),parameter :: subname='(state_diagnose)' + character(len=*), parameter :: subname = '('//__FILE__//':state_diagnose)' ! ---------------------------------------------- call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) @@ -402,7 +402,7 @@ subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) type(ESMF_Mesh) :: lmesh integer :: lrank, nnodes, nelements logical :: labort - character(len=*), parameter :: subname='(field_getfldptr)' + character(len=*), parameter :: subname = '('//__FILE__//':field_getfldptr)' ! ---------------------------------------------- if (.not.present(rc)) then @@ -529,7 +529,7 @@ subroutine alarmInit( clock, alarm, option, & type(ESMF_Time) :: NextAlarm ! Next restart alarm time type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval integer :: sec - character(len=*), parameter :: subname = '(set_alarmInit): ' + character(len=*), parameter :: subname = '('//__FILE__//':alarmInit)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -813,7 +813,7 @@ subroutine timeInit( Time, ymd, cal, tod, rc) ! local variables integer :: year, mon, day ! year, month, day as integers integer :: tdate ! temporary date - character(len=*), parameter :: subname='(timeInit)' + character(len=*), parameter :: subname = '('//__FILE__//':timeInit)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/cesm/nuopc_cap_share/shr_fire_emis_mod.F90 b/cesm/nuopc_cap_share/shr_fire_emis_mod.F90 index 47e9cf117..5558e8848 100644 --- a/cesm/nuopc_cap_share/shr_fire_emis_mod.F90 +++ b/cesm/nuopc_cap_share/shr_fire_emis_mod.F90 @@ -115,7 +115,7 @@ subroutine shr_fire_emis_readnl( NLFileName, emis_nflds ) logical :: fire_emis_elevated = .true. integer :: i, tmp(1) character(*),parameter :: F00 = "('(shr_fire_emis_readnl) ',2a)" - character(len=*), parameter :: subname='(shr_fire_emis_readnl)' + character(len=*), parameter :: subname = '('//__FILE__//':shr_fire_emis_readnl)' !------------------------------------------------------------------ namelist /fire_emis_nl/ fire_emis_specifier, fire_emis_factors_file, fire_emis_elevated diff --git a/cesm/nuopc_cap_share/shr_megan_mod.F90 b/cesm/nuopc_cap_share/shr_megan_mod.F90 index 4273217c0..ee01d3719 100644 --- a/cesm/nuopc_cap_share/shr_megan_mod.F90 +++ b/cesm/nuopc_cap_share/shr_megan_mod.F90 @@ -128,7 +128,7 @@ subroutine shr_megan_readnl( NLFileName, megan_nflds) integer :: rc integer :: i, tmp(1) character(*), parameter :: F00 = "('(shr_megan_readnl) ',2a)" - character(len=*), parameter :: subname='(shr_megan_readnl)' + character(len=*), parameter :: subname = '('//__FILE__//':shr_megan_readnl)' !-------------------------------------------------------------- namelist /megan_emis_nl/ megan_specifier, megan_factors_file, megan_mapped_emisfctrs diff --git a/cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 b/cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 index fbd601c3c..0600b062f 100644 --- a/cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 +++ b/cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 @@ -54,7 +54,7 @@ subroutine shr_ozone_coupling_readnl(NLFilename, atm_ozone_frequency_val) integer :: mpicom character(len=*), parameter :: atm_ozone_frequency_not_present = 'NOT_PRESENT' - character(len=*), parameter :: subname = '(shr_ozone_coupling_readnl) ' + character(len=*), parameter :: subname = '('//__FILE__//':shr_ozone_coupling_readnl)' ! ------------------------------------------------------------------ namelist /ozone_coupling_nl/ atm_ozone_frequency diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/shr_pio_mod.F90 index 8300710bc..2f23a88e3 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/shr_pio_mod.F90 @@ -236,7 +236,7 @@ subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) integer :: pecnt integer :: ierr type(iosystem_desc_t), allocatable :: async_iosystems(:) - character(len=*), parameter :: subname="shr_pio_component_init" + character(len=*), parameter :: subname = '('//__FILE__//':shr_pio_component_init)' call ESMF_GridCompGet(gridcomp=driver, vm=vm, rc=rc) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index 36dda2519..a96fcfdd6 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -103,7 +103,7 @@ subroutine med_fldList_AddFld(flds, stdname, shortname) logical :: found integer :: mapsize, mrgsize type(med_fldList_entry_type), pointer :: newflds(:) - character(len=*), parameter :: subname='(med_fldList_AddFld)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_AddFld)' ! ---------------------------------------------- if (associated(flds)) then @@ -210,7 +210,7 @@ subroutine med_fldList_AddMrg(flds, fldname, mrg_from, mrg_fld, mrg_type, mrg_fr ! local variables integer :: n, id - character(len=*), parameter :: subname='(med_fldList_AddMrg)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_AddMrg)' ! ---------------------------------------------- id = 0 @@ -255,7 +255,7 @@ subroutine med_fldList_AddMap(flds, fldname, destcomp, maptype, mapnorm, mapfile integer :: id, n integer :: rc character(len=CX) :: lmapfile - character(len=*),parameter :: subname='(med_fldList_AddMap)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_AddMap)' ! ---------------------------------------------- lmapfile = 'unset' if (present(mapfile)) lmapfile = mapfile @@ -334,7 +334,7 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num character(ESMF_MAXSTR), pointer :: ConnectedList(:) character(ESMF_MAXSTR), pointer :: NameSpaceList(:) character(ESMF_MAXSTR), pointer :: itemNameList(:) - character(len=*),parameter :: subname='(med_fldList_Realize)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_Realize)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -488,7 +488,7 @@ subroutine SetScalarField(field, flds_scalar_name, flds_scalar_num, rc) ! local variables type(ESMF_Distgrid) :: distgrid type(ESMF_Grid) :: grid - character(len=*), parameter :: subname='(SetScalarField)' + character(len=*), parameter :: subname = '('//__FILE__//':SetScalarField)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -525,7 +525,7 @@ subroutine med_fldList_GetFldInfo_general(fldList, fldindex, stdname, shortname) character(len=*) , intent(out) :: shortname ! local variables - character(len=*), parameter :: subname='(med_fldList_GetFldInfo_general)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_GetFldInfo_general)' ! ---------------------------------------------- stdname = fldList%flds(fldindex)%stdname @@ -544,7 +544,7 @@ subroutine med_fldList_GetFldInfo_stdname(fldList, fldindex_in, stdname_out) character(len=*) , intent(out) :: stdname_out ! local variables - character(len=*), parameter :: subname='(med_fldList_GetFldInfo_stdname)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_GetFldInfo_stdname)' ! ---------------------------------------------- stdname_out = fldList%flds(fldindex_in)%stdname @@ -562,7 +562,7 @@ subroutine med_fldList_GetFldInfo_index(fldList, stdname_in, fldindex_out) ! local variables integer :: n - character(len=*), parameter :: subname='(med_fldList_GetFldInfo_index)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_GetFldInfo_index)' ! ---------------------------------------------- fldindex_out = 0 @@ -588,7 +588,7 @@ subroutine med_fldList_GetFldInfo_merging(fldList, fldindex, compsrc, merge_fiel character(len=*) , intent(out) :: merge_fracname ! local variables - character(len=*), parameter :: subname='(med_fldList_GetFldInfo_merging)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_GetFldInfo_merging)' ! ---------------------------------------------- merge_field = fldList%flds(fldindex)%merge_fields(compsrc) @@ -666,7 +666,7 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active) character(len=CL) :: mrgstr character(len=CL) :: cvalue logical :: init_mrgstr - character(len=*),parameter :: subname = '(med_fldList_Document_Mapping)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_Document_Mapping)' !----------------------------------------------------------- !--------------------------------------- @@ -763,7 +763,7 @@ subroutine med_fldList_Document_Merging(logunit, med_coupling_active) character(len=CS) :: string character(len=CL) :: mrgstr logical :: init_mrgstr - character(len=*),parameter :: subname = '(med_fldList_Document_Mapping)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_Document_Merging)' !----------------------------------------------------------- write(logunit,*) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 9bf8062eb..d4653a025 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -95,7 +95,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) character(len=CS) :: name logical :: wavice_coupling logical :: ocn2glc_coupling - character(len=*) , parameter :: subname=' (esmFldsExchange_cesm) ' + character(len=*), parameter :: subname = '('//__FILE__//':esmFldsExchange_cesm)' !-------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index bfa23dc25..2197fc81d 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -58,7 +58,7 @@ subroutine esmFldsExchange_hafs(gcomp, phase, rc) integer , intent(inout) :: rc ! local variables: - character(len=*) , parameter :: subname='(esmFldsExchange_hafs)' + character(len=*), parameter :: subname = '('//__FILE__//':esmFldsExchange_hafs)' !-------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -106,7 +106,7 @@ subroutine esmFldsExchange_hafs_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_hafs_advt)' + character(len=*), parameter :: subname = '('//__FILE__//':esmFldsExchange_hafs_advt)' !-------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -261,7 +261,7 @@ subroutine esmFldsExchange_hafs_fchk(gcomp, phase, rc) ! local variables: type(InternalState) :: is_local - character(len=*) , parameter :: subname='(esmFldsExchange_hafs_fchk)' + character(len=*), parameter :: subname = '('//__FILE__//':esmFldsExchange_hafs_fchk)' !-------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -319,7 +319,7 @@ subroutine esmFldsExchange_hafs_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_hafs_init)' + character(len=*), parameter :: subname = '('//__FILE__//':esmFldsExchange_hafs_init)' !-------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -498,7 +498,7 @@ subroutine esmFldsExchange_hafs_attr(gcomp, hafs_attr, rc) integer :: verbosity, diagnostic character(len=CL) :: cvalue logical :: isPresent, isSet - character(len=*) , parameter :: subname='(esmFldsExchange_hafs_attr)' + character(len=*), parameter :: subname = '('//__FILE__//':esmFldsExchange_hafs_attr)' !-------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 436232652..c73eb118d 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -50,7 +50,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) character(len=CL) :: cvalue character(len=CS) :: fldname character(len=CS), allocatable :: flds(:), oflds(:), aflds(:), iflds(:) - character(len=*) , parameter :: subname='(esmFldsExchange_nems)' + character(len=*), parameter :: subname = '('//__FILE__//':esmFldsExchange_nems)' !-------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med.F90 b/mediator/med.F90 index 92be267e1..1fe7ae7c7 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -129,7 +129,7 @@ subroutine SetServices(gcomp, rc) integer, intent(out) :: rc ! local variables - character(len=*),parameter :: subname=' (SetServices) ' + character(len=*), parameter :: subname = '('//__FILE__//':SetServices)' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -568,7 +568,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) character(len=CX) :: logfile character(len=CX) :: diagfile character(len=CX) :: do_budgets - character(len=*),parameter :: subname=' (InitializeP0) ' + character(len=*), parameter :: subname = '('//__FILE__//':InitializeP0)' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -677,7 +677,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) character(len=8) :: cnum type(InternalState) :: is_local integer :: stat - character(len=*),parameter :: subname=' (Advertise Fields) ' + character(len=*), parameter :: subname = '('//__FILE__//':InitializeIPDv03p1)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -906,7 +906,7 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) type(InternalState) :: is_local type(ESMF_VM) :: vm integer :: n - character(len=*),parameter :: subname=' (Realize Fields with Transfer Provide) ' + character(len=*), parameter :: subname = '('//__FILE__//':InitializeIPDv03p3)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -967,7 +967,7 @@ subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) ! local variables type(InternalState) :: is_local integer :: n1,n2 - character(len=*),parameter :: subname=' (Modify Decomp of Mesh/Grid) ' + character(len=*), parameter :: subname = '('//__FILE__//':InitializeIPDv03p4)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1034,7 +1034,7 @@ subroutine realizeConnectedGrid(State,string,rc) integer , allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) character(ESMF_MAXSTR) , allocatable :: fieldNameList(:) type(ESMF_DistGridConnection) , allocatable :: connectionList(:) - character(len=*),parameter :: subname=' (realizeConnectedGrid) ' + character(len=*), parameter :: subname = '('//__FILE__//':realizeConnectedGrid)' !----------------------------------------------------------- ! All of the Fields that set their TransferOfferGeomObject Attribute @@ -1295,7 +1295,7 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) ! local variables type(InternalState) :: is_local integer :: n1,n2 - character(len=*),parameter :: subname=' (Realize Fields with Transfer Accept) ' + character(len=*), parameter :: subname = '('//__FILE__//':InitializeIPDv03p5)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1367,7 +1367,7 @@ subroutine completeFieldInitialization(State,rc) integer, allocatable :: ungriddedLBound(:), ungriddedUBound(:) logical :: isPresent logical :: meshcreated - character(len=*),parameter :: subname=' (Complete Field Initialization) ' + character(len=*), parameter :: subname = '('//__FILE__//':completeFieldInitialization)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1563,7 +1563,7 @@ subroutine DataInitialize(gcomp, rc) logical,save :: first_call = .true. real(r8) :: real_nx, real_ny character(len=CX) :: msgString - character(len=*), parameter :: subname=' (Data Initialization) ' + character(len=*), parameter :: subname = '('//__FILE__//':DataInitialize)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -2172,7 +2172,7 @@ subroutine SetRunClock(gcomp, rc) logical, save :: stopalarmcreated=.false. integer :: alarmcount - character(len=*),parameter :: subname=' (Set Run Clock) ' + character(len=*), parameter :: subname = '('//__FILE__//':SetRunClock)' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -2257,7 +2257,7 @@ subroutine med_meshinfo_create(FB, mesh_info, FBArea, rc) real(r8), allocatable :: ownedElemCoords(:) real(r8), pointer :: dataptr(:) integer :: n, dimcount, fieldcount - character(len=*),parameter :: subname=' (module_MED:med_meshinfo_create) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_meshinfo_create)' !------------------------------------------------------------------------------- rc= ESMF_SUCCESS @@ -2330,7 +2330,7 @@ subroutine med_grid_write(grid, fileName, rc) type(ESMF_ArrayBundle) :: arrayBundle integer :: tileCount logical :: isPresent - character(len=*), parameter :: subname=' (Grid Write) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_grid_write)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 2792d0a26..b3ff0d710 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -2751,7 +2751,7 @@ subroutine add_to_budget_diag(entries, index, name) integer :: oldsize logical :: found type(budget_diag_type), pointer :: new_entries(:) - character(len=*), parameter :: subname='(add_to_budget_diag)' + character(len=*), parameter :: subname = '('//__FILE__//':add_to_budget_diag)' !---------------------------------------------------------------------- if (associated(entries)) then diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 5b7944c7d..3134fa55f 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -182,7 +182,7 @@ subroutine med_fraction_init(gcomp, rc) integer :: maptype integer :: fieldCount logical, save :: first_call = .true. - character(len=*),parameter :: subname=' (med_fraction_init)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fraction_init)' !--------------------------------------- call t_startf('MED:'//subname) @@ -671,7 +671,7 @@ subroutine med_fraction_set(gcomp, rc) type(ESMF_Field) :: field_dst integer :: n integer :: maptype - character(len=*),parameter :: subname=' (med_fraction_set)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fraction_set)' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index b9b61e85e..7672a3df4 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -211,7 +211,7 @@ subroutine med_internalstate_init(gcomp, rc) character(len=CX) :: msgString character(len=3) :: name integer :: num_icesheets - character(len=*),parameter :: subname=' (internalstate init) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_internalstate_init)' !----------------------------------------------------------- nullify(is_local%wrap) @@ -388,7 +388,7 @@ subroutine med_internalstate_coupling(gcomp, rc) character(len=CL) :: cvalue character(len=CX) :: msgString logical :: isPresent, isSet - character(len=*),parameter :: subname=' (internalstate allowed coupling) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_internalstate_coupling)' !----------------------------------------------------------- nullify(is_local%wrap) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 3717f5cba..ecad003c1 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -109,7 +109,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun real(R8), pointer :: dataptr(:) type(ESMF_Mesh) :: mesh_src type(ESMF_Mesh) :: mesh_dst - character(len=*), parameter :: subname=' (module_med_map: RouteHandles_init) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_map_RouteHandles_initfrom_esmflds)' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -297,7 +297,7 @@ subroutine med_map_routehandles_initfrom_fieldbundle(n1, n2, FBsrc, FBdst, mapin ! local variables type(ESMF_Field) :: fldsrc type(ESMF_Field) :: flddst - character(len=*), parameter :: subname=' (module_MED_map:med_map_routehandles_initfrom_fieldbundle) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_map_routehandles_initfrom_fieldbundle)' !--------------------------------------------- rc = ESMF_SUCCESS @@ -370,7 +370,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, integer(I4), pointer :: dof(:) integer :: srcTermProcessing_Value = 0 type(ESMF_PoleMethod_Flag) :: polemethod - character(len=*), parameter :: subname=' (module_med_map: med_map_routehandles_initfrom_field) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_map_routehandles_initfrom_field)' !--------------------------------------------- lmapfile = 'unset' @@ -641,7 +641,7 @@ logical function med_map_RH_is_created_RH3d(RHs,n1,n2,mapindex,rc) ! local variables integer :: rc1, rc2 - character(len=*), parameter :: subname=' (module_MED_map:med_map_RH_is_created_RH3d) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_map_routehandles_initfrom_field)' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -666,7 +666,7 @@ logical function med_map_RH_is_created_RH1d(RHs,mapindex,rc) ! local variables integer :: rc1, rc2 logical :: mapexists - character(len=*), parameter :: subname=' (module_MED_map:med_map_RH_is_created_RH1d) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_map_routehandles_initfrom_field)' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -736,7 +736,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & character(CL), allocatable :: fieldNameList(:) character(CS) :: mapnorm_mapindex character(len=CX) :: tmpstr - character(len=*), parameter :: subname=' (module_MED_map:med_packed_field_create) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_map_packed_field_create)' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -937,7 +937,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d type(ESMF_Field) :: udst, vdst ! only used for 3d mapping of u,v real(r8), pointer :: data_norm(:) real(r8), pointer :: data_dst(:,:) - character(len=*), parameter :: subname=' (module_MED_map:med_map_field_packed) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_map_field_packed)' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -1149,7 +1149,7 @@ subroutine med_map_field_normalized(field_src, field_dst, routehandles, maptype, integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields integer :: lsize_src integer :: lsize_dst - character(len=*), parameter :: subname=' (module_MED_map:med_map_field_normalized) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_map_field_normalized)' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -1262,7 +1262,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r logical :: checkflag = .false. character(len=CS) :: lfldname real(ESMF_KIND_R8), parameter :: fillValue = 9.99e20_ESMF_KIND_R8 - character(len=*), parameter :: subname='(module_MED_map:med_map_field) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_map_field)' !--------------------------------------------------- rc = ESMF_SUCCESS @@ -1365,7 +1365,7 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, rc) integer :: spatialDim real(r8), parameter :: deg2rad = shr_const_pi/180.0_R8 ! deg to rads logical :: first_time = .true. - character(len=*), parameter :: subname=' (module_MED_map:med_map_uv_cart3d) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_map_uv_cart3d)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index bd1aa4f80..a62b7c6b9 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -79,7 +79,7 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f real(r8), pointer :: dataptr1d(:) real(r8), pointer :: dataptr2d(:,:) logical :: zero_output - character(len=*),parameter :: subname=' (module_med_merge_mod: med_merge_auto)' + character(len=*), parameter :: subname = '('//__FILE__//':med_merge_auto_multi_fldbuns)' !--------------------------------------- call t_startf('MED:'//subname) @@ -244,7 +244,7 @@ subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo, real(r8), pointer :: dataptr1d(:) real(r8), pointer :: dataptr2d(:,:) logical :: zero_output - character(len=*),parameter :: subname=' (module_med_merge_mod: med_merge_auto)' + character(len=*), parameter :: subname = '('//__FILE__//':med_merge_auto_single_fldbun)' !--------------------------------------- call t_startf('MED:'//subname) @@ -364,7 +364,7 @@ subroutine med_merge_auto_field(merge_type, field_out, ungriddedUBound_out, & real(R8), pointer :: dpf1(:) 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=*), parameter :: subname = '('//__FILE__//':med_merge_auto_field)' !--------------------------------------- rc = ESMF_SUCCESS @@ -481,7 +481,7 @@ subroutine med_merge_auto_errcheck(compsrc, fldname_out, field_out, & type(ESMF_Field) :: field_in integer :: ungriddedUBound_in(1) ! size of ungridded dimension, if any character(len=CL) :: errmsg - character(len=*),parameter :: subname=' (module_med_merge_mod: med_merge_errcheck)' + character(len=*), parameter :: subname = '('//__FILE__//':med_merge_auto_errcheck)' !--------------------------------------- rc = ESMF_SUCCESS @@ -572,7 +572,7 @@ subroutine med_merge_field_1D(FBout, fnameout, & integer :: lb1,ub1,i,j,n logical :: wgtfound, FBinfound integer :: dbrc - character(len=*),parameter :: subname='(med_merge_field_1D)' + character(len=*), parameter :: subname = '('//__FILE__//':med_merge_field_1D)' ! ---------------------------------------------- if (dbug_flag > 10) then diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index f25b024cd..a15c2d55c 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -109,7 +109,7 @@ subroutine med_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, r real(R8), pointer :: dataptr1d(:) real(R8), pointer :: dataptr2d(:,:) character(ESMF_MAXSTR), allocatable :: lfieldNameList(:) - character(len=*), parameter :: subname='(med_methods_FB_init_pointer)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_init_pointer)' ! ---------------------------------------------- ! Create empty FBout @@ -262,7 +262,7 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S integer, allocatable :: gridToFieldMap(:) logical :: isPresent character(ESMF_MAXSTR), allocatable :: lfieldNameList(:) - character(len=*), parameter :: subname='(med_methods_FB_init)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_init)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -540,7 +540,7 @@ subroutine med_methods_FB_getNameN(FB, fieldnum, fieldname, rc) ! local variables integer :: fieldCount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - character(len=*),parameter :: subname='(med_methods_FB_getNameN)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_getNameN)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -586,7 +586,7 @@ subroutine med_methods_FB_getFieldN(FB, fieldnum, field, rc) ! local variables character(len=ESMF_MAXSTR) :: name - character(len=*),parameter :: subname='(med_methods_FB_getFieldN)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_getFieldN)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -624,7 +624,7 @@ subroutine med_methods_State_getNameN(State, fieldnum, fieldname, rc) ! local variables integer :: fieldCount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - character(len=*),parameter :: subname='(med_methods_State_getNameN)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_getNameN)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -671,7 +671,7 @@ subroutine med_methods_State_getNumFields(State, fieldnum, rc) ! local variables integer :: n,itemCount type(ESMF_Field), pointer :: fieldList(:) - character(len=*),parameter :: subname='(med_methods_State_getNumFields)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_getNumFields)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -718,7 +718,7 @@ subroutine med_methods_FB_reset(FB, value, rc) integer :: lrank real(R8), pointer :: fldptr1(:) real(R8), pointer :: fldptr2(:,:) - character(len=*),parameter :: subname='(med_methods_FB_reset)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_reset)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -796,7 +796,7 @@ subroutine med_methods_State_reset(State, value, rc) integer :: lrank real(R8), pointer :: fldptr1(:) real(R8), pointer :: fldptr2(:,:) - character(len=*),parameter :: subname='(med_methods_State_reset)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_reset)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -862,7 +862,7 @@ subroutine med_methods_FB_average(FB, count, rc) real(R8), pointer :: dataPtr1(:) real(R8), pointer :: dataPtr2(:,:) type(ESMF_Field) :: lfield - character(len=*),parameter :: subname='(med_methods_FB_average)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_average)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -941,7 +941,7 @@ subroutine med_methods_FB_diagnose(FB, string, rc) real(R8), pointer :: dataPtr1d(:) real(R8), pointer :: dataPtr2d(:,:) type(ESMF_Field) :: lfield - character(len=*), parameter :: subname='(med_methods_FB_diagnose)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_diagnose)' ! ---------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1021,7 +1021,7 @@ subroutine med_methods_Array_diagnose(array, string, rc) ! local variables character(len=CS) :: lstring real(R8), pointer :: dataPtr3d(:,:,:) - character(len=*),parameter :: subname='(med_methods_Array_diagnose)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Array_diagnose)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1075,7 +1075,7 @@ subroutine med_methods_State_diagnose(State, string, rc) real(R8), pointer :: dataPtr1d(:) real(R8), pointer :: dataPtr2d(:,:) type(ESMF_Field) :: lfield - character(len=*),parameter :: subname='(med_methods_State_diagnose)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_diagnose)' ! ---------------------------------------------- if (dbug_flag > 5) then @@ -1157,7 +1157,7 @@ subroutine med_methods_FB_Field_diagnose(FB, fieldname, string, rc) real(R8), pointer :: dataPtr2d(:,:) type(ESMF_Field) :: lfield integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields - character(len=*),parameter :: subname='(med_methods_FB_Field_diagnose)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_Field_diagnose)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1222,7 +1222,7 @@ subroutine med_methods_Field_diagnose(field, fieldname, string, rc) character(len=CS) :: lstring real(R8), pointer :: dataPtr1d(:) real(R8), pointer :: dataPtr2d(:,:) - character(len=*),parameter :: subname='(med_methods_Field_diagnose)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Field_diagnose)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1284,7 +1284,7 @@ subroutine med_methods_FB_copy(FBout, FBin, rc) type(ESMF_FieldBundle), intent(inout) :: FBout type(ESMF_FieldBundle), intent(in) :: FBin integer , intent(out) :: rc - character(len=*), parameter :: subname='(med_methods_FB_copy)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_copy)' ! ---------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1327,7 +1327,7 @@ subroutine med_methods_FB_accum(FBout, FBin, copy, rc) real(R8), pointer :: dataPtri2(:,:) real(R8), pointer :: dataPtro2(:,:) type(ESMF_Field) :: lfield - character(len=*), parameter :: subname='(med_methods_FB_accum)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_accum)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1439,7 +1439,7 @@ logical function med_methods_FB_FldChk(FB, fldname, rc) integer , intent(out) :: rc ! local variables - character(len=*), parameter :: subname='(med_methods_FB_FldChk)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_accum)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1499,7 +1499,7 @@ subroutine med_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abort, rc) integer :: lrank, nnodes, nelements logical :: labort type(ESMF_GeomType_Flag) :: geomtype - character(len=*), parameter :: subname='(med_methods_Field_GetFldPtr)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Field_GetFldPtr)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1619,7 +1619,7 @@ subroutine med_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, rank, field, ! local variables type(ESMF_Field) :: lfield integer :: lrank - character(len=*), parameter :: subname='(med_methods_FB_GetFldPtr)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_GetFldPtr)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1670,7 +1670,7 @@ logical function med_methods_FieldPtr_Compare1(fldptr1, fldptr2, cstring, rc) integer , intent(out) :: rc ! local variables - character(len=*), parameter :: subname='(med_methods_FieldPtr_Compare1)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_GetFldPtr)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1707,7 +1707,7 @@ logical function med_methods_FieldPtr_Compare2(fldptr1, fldptr2, cstring, rc) integer , intent(out) :: rc ! local variables - character(len=*), parameter :: subname='(med_methods_FieldPtr_Compare2)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_GetFldPtr)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1750,7 +1750,7 @@ subroutine med_methods_State_GeomPrint(state, string, rc) integer :: fieldcount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) character(ESMF_MAXSTR) :: name - character(len=*),parameter :: subname='(med_methods_State_GeomPrint)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_GeomPrint)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1793,7 +1793,7 @@ subroutine med_methods_FB_GeomPrint(FB, string, rc) type(ESMF_Field) :: lfield integer :: fieldcount - character(len=*),parameter :: subname='(med_methods_FB_GeomPrint)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_GeomPrint)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1836,7 +1836,7 @@ subroutine med_methods_Field_GeomPrint(field, string, rc) real(R8), pointer :: dataPtr1(:) real(R8), pointer :: dataPtr2(:,:) type(ESMF_GeomType_Flag) :: geomtype - character(len=*),parameter :: subname='(med_methods_Field_GeomPrint)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Field_GeomPrint)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1918,7 +1918,7 @@ subroutine med_methods_Mesh_Print(mesh, string, rc) integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) type(ESMF_MeshStatus_Flag) :: meshStatus logical :: elemDGPresent, nodeDGPresent - character(len=*),parameter :: subname='(med_methods_Mesh_Print)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Mesh_Print)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -2082,7 +2082,7 @@ subroutine med_methods_Grid_Print(grid, string, rc) real(R8), pointer :: fldptrR81D(:) real(R8), pointer :: fldptrR82D(:,:) integer :: n1,n2,n3 - character(len=*),parameter :: subname='(med_methods_Grid_Print)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Grid_Print)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -2209,7 +2209,7 @@ subroutine med_methods_Clock_TimePrint(clock,string,rc) type(ESMF_TimeInterval) :: timeStep character(len=CS) :: timestr character(len=CL) :: lstring - character(len=*), parameter :: subname='(med_methods_Clock_TimePrint)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Clock_TimePrint)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -2281,7 +2281,7 @@ subroutine med_methods_State_GetScalar(state, scalar_id, scalar_value, flds_scal type(ESMF_Field) :: field real(R8), pointer :: farrayptr(:,:) real(r8) :: tmp(1) - character(len=*), parameter :: subname='(med_methods_State_GetScalar)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_GetScalar)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -2344,7 +2344,7 @@ subroutine med_methods_State_SetScalar(scalar_value, scalar_id, State, flds_scal type(ESMF_Field) :: field type(ESMF_VM) :: vm real(R8), pointer :: farrayptr(:,:) - character(len=*), parameter :: subname='(med_methods_State_SetScalar)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_SetScalar)' ! ---------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 794b84293..99a71a43e 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -164,7 +164,7 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) integer :: n integer :: fieldcount type(InternalState) :: is_local - character(len=*),parameter :: subname=' (med_phases_aofluxes_init_fldbuns) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_aofluxes_init_fldbuns)' !--------------------------------------- ! Create field bundles for mediator ocean/atmosphere flux computation @@ -261,7 +261,7 @@ subroutine med_phases_aofluxes_run(gcomp, rc) type(aoflux_out_type) , save :: aoflux_out logical , save :: aoflux_created logical , save :: first_call = .true. - character(len=*),parameter :: subname=' (med_phases_aofluxes_run) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_aofluxes_run)' !--------------------------------------- rc = ESMF_SUCCESS @@ -480,7 +480,7 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) character(len=CX) :: tmpstr integer :: lsize integer :: fieldcount - character(len=*),parameter :: subname=' (med_aofluxes_init_ocngrid) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_aofluxes_init_ogrid)' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -565,7 +565,7 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Mesh) :: mesh_src type(ESMF_Mesh) :: mesh_dst integer :: maptype - character(len=*),parameter :: subname=' (med_aofluxes_init_atmgrid) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_aofluxes_init_agrid)' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -701,7 +701,7 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) real(r8), pointer :: dataptr(:) integer :: fieldcount character(ESMF_MAXSTR),allocatable :: fieldNameList(:) - character(len=*),parameter :: subname=' (med_aofluxes_init_xgrid) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_aofluxes_init_xgrid)' !----------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 7cfc6fc89..7fed47fe4 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -181,7 +181,7 @@ subroutine med_phases_history_write(gcomp, rc) type(ESMF_TimeInterval) :: ringInterval integer :: ringInterval_length logical :: first_time = .true. - character(len=*), parameter :: subname='(med_phases_history_write)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_write)' !--------------------------------------- rc = ESMF_SUCCESS @@ -402,7 +402,7 @@ subroutine med_phases_history_write_med(gcomp, rc) character(CL) :: hist_n_in logical :: isPresent logical :: isSet - character(len=*), parameter :: subname='(med_phases_history_write_med)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_write_med)' !--------------------------------------- rc = ESMF_SUCCESS @@ -544,7 +544,7 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) character(len=CL) :: hist_file integer :: m logical :: isPresent, isSet - character(len=*), parameter :: subname='(med_phases_history_write_lnd2glc)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_write_lnd2glc)' !--------------------------------------- rc = ESMF_SUCCESS @@ -680,7 +680,7 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) real(r8) :: time_bnds(2) ! time bounds output logical :: write_now ! true => write to history type real(r8) :: tbnds(2) ! CF1.0 time bounds - character(len=*), parameter :: subname='(med_phases_history_write_inst_comp)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_write_comp_inst)' !--------------------------------------- rc = ESMF_SUCCESS @@ -839,7 +839,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) logical :: write_now ! true => write to history type real(r8) :: tbnds(2) ! CF1.0 time bounds character(CS) :: scalar_name - character(len=*), parameter :: subname='(med_phases_history_write_comp_avg)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_write_comp_avg)' !--------------------------------------- rc = ESMF_SUCCESS @@ -1059,7 +1059,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output character(CS), allocatable :: fieldNameList(:) - character(len=*), parameter :: subname='(med_phases_history_write_comp_aux)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_write_comp_aux)' !--------------------------------------- rc = ESMF_SUCCESS @@ -1531,7 +1531,7 @@ subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hi type(ESMF_TimeInterval) :: htimestep type(ESMF_TimeInterval) :: mtimestep, dtimestep integer :: msec, dsec - character(len=*), parameter :: subname='(med_phases_history_init_histclock) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_init_histclock)' !--------------------------------------- rc = ESMF_SUCCESS @@ -1593,7 +1593,7 @@ subroutine med_phases_history_query_ifwrite(gcomp, hclock, alarmname, write_now, integer :: yr,mon,day,sec ! time units type(ESMF_TimeInterval) :: ringInterval integer :: ringInterval_length - character(len=*), parameter :: subname='(med_phases_history_query_ifwrite) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_query_ifwrite)' !--------------------------------------- rc = ESMF_SUCCESS @@ -1707,7 +1707,7 @@ subroutine med_phases_history_set_timeinfo(gcomp, hclock, alarmname, & integer :: start_ymd ! Starting date YYYYMMDD logical :: isPresent logical :: isSet - character(len=*), parameter :: subname='(med_phases_history_set_timeinfo) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_set_timeinfo)' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 1fe8fb502..b9c38b957 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -252,7 +252,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) real(R8), parameter :: const_deg2rad = shr_const_pi/180.0_R8 ! deg to rads character(CL) :: msg logical :: first_call = .true. - character(len=*) , parameter :: subname='(med_phases_ocnalb_run)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_ocnalb_run)' !--------------------------------------- rc = ESMF_SUCCESS @@ -463,7 +463,7 @@ subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, mastertask, rc) ! local variables character(len=CL) :: msgstr ! temporary character(len=CL) :: cvalue ! temporary - character(len=*) , parameter :: subname = "(med_phases_ocnalb_orbital_init)" + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_ocnalb_orbital_init)' !------------------------------------------- rc = ESMF_SUCCESS @@ -570,7 +570,7 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, character(len=CL) :: msgstr ! temporary logical :: lprint logical :: first_time = .true. - character(len=*) , parameter :: subname = "(med_phases_ocnalb_orbital_update)" + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_ocnalb_orbital_update)' !------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index ab6f65e2b..1be463731 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -43,7 +43,7 @@ subroutine med_phases_post_atm(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock - character(len=*), parameter :: subname='(med_phases_post_atm)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_atm)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index 14610e710..e01bddf8d 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -98,7 +98,7 @@ subroutine med_phases_post_glc(gcomp, rc) logical :: first_call = .true. logical :: isPresent character(CL) :: cvalue - character(len=*), parameter :: subname='(med_phases_post_glc)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_glc)' !--------------------------------------- rc = ESMF_SUCCESS @@ -246,7 +246,7 @@ subroutine map_glc2lnd_init(gcomp, rc) integer :: fieldCount integer :: ns,n type(ESMF_Field), pointer :: fieldlist(:) - character(len=*) , parameter :: subname='(map_glc2lnd_init)' + character(len=*), parameter :: subname = '('//__FILE__//':map_glc2lnd_init)' !--------------------------------------- rc = ESMF_SUCCESS @@ -383,7 +383,7 @@ subroutine map_glc2lnd( gcomp, rc) real(r8), pointer :: dataptr1d_src(:) real(r8), pointer :: dataptr1d_dst(:) real(r8), pointer :: icemask_l(:) - character(len=*), parameter :: subname = 'map_glc2lnd' + character(len=*), parameter :: subname = '('//__FILE__//':map_glc2lnd)' !----------------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_post_ice_mod.F90 b/mediator/med_phases_post_ice_mod.F90 index d081448e4..fc4c84dfc 100644 --- a/mediator/med_phases_post_ice_mod.F90 +++ b/mediator/med_phases_post_ice_mod.F90 @@ -40,7 +40,7 @@ subroutine med_phases_post_ice(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock - character(len=*),parameter :: subname='(med_phases_post_ice)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_ice)' !------------------------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_post_lnd_mod.F90 b/mediator/med_phases_post_lnd_mod.F90 index d057506af..49bd90255 100644 --- a/mediator/med_phases_post_lnd_mod.F90 +++ b/mediator/med_phases_post_lnd_mod.F90 @@ -37,7 +37,7 @@ subroutine med_phases_post_lnd(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock - character(len=*),parameter :: subname='(med_phases_post_lnd)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_lnd)' !------------------------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_post_ocn_mod.F90 b/mediator/med_phases_post_ocn_mod.F90 index abf766211..a883890ca 100644 --- a/mediator/med_phases_post_ocn_mod.F90 +++ b/mediator/med_phases_post_ocn_mod.F90 @@ -39,7 +39,7 @@ subroutine med_phases_post_ocn(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock - character(len=*),parameter :: subname='(med_phases_post_ocn)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_ocn)' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index ea478b0cc..0d5999cf0 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -36,7 +36,7 @@ subroutine med_phases_post_rof(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock - character(len=*), parameter :: subname='(med_phases_post_rof)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_rof)' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_post_wav_mod.F90 b/mediator/med_phases_post_wav_mod.F90 index 31abf004c..57d0e61ab 100644 --- a/mediator/med_phases_post_wav_mod.F90 +++ b/mediator/med_phases_post_wav_mod.F90 @@ -35,7 +35,7 @@ subroutine med_phases_post_wav(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock - character(len=*),parameter :: subname='(med_phases_post_wav)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_wav)' !------------------------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 485cdaf9b..cb76f1552 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -53,7 +53,7 @@ subroutine med_phases_prep_atm(gcomp, rc) real(R8), pointer :: ifrac(:) real(R8), pointer :: ofrac(:) integer :: i, j, n, n1, ncnt - character(len=*),parameter :: subname='(med_phases_prep_atm)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_atm)' !------------------------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index d47bbf46c..a30b0118d 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -146,7 +146,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) character(len=CS) :: glc_renormalize_smb logical :: glc_coupled_fluxes integer :: ungriddedUBound_output(1) ! currently the size must equal 1 for rank 2 fieldds - character(len=*),parameter :: subname=' (med_phases_prep_glc_init) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_glc_init)' !--------------------------------------- call t_startf('MED:'//subname) @@ -400,7 +400,7 @@ subroutine med_phases_prep_glc_accum_lnd(gcomp, rc) integer :: i,n real(r8), pointer :: data2d_in(:,:) real(r8), pointer :: data2d_out(:,:) - character(len=*),parameter :: subname=' (med_phases_prep_glc_accum) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_glc_accum_lnd)' !--------------------------------------- call t_startf('MED:'//subname) @@ -458,7 +458,7 @@ subroutine med_phases_prep_glc_accum_ocn(gcomp, rc) integer :: i,n real(r8), pointer :: data2d_in(:,:) real(r8), pointer :: data2d_out(:,:) - character(len=*),parameter :: subname=' (med_phases_prep_glc_accum) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_glc_accum_ocn)' !--------------------------------------- call t_startf('MED:'//subname) @@ -531,7 +531,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) logical :: do_avg logical :: isPresent, isSet logical :: write_histaux_l2x1yrg - character(len=*) , parameter :: subname=' (med_phases_prep_glc) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_glc_avg)' !--------------------------------------- call t_startf('MED:'//subname) @@ -771,7 +771,7 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) character(len=3) :: cnum type(ESMF_Field), pointer :: fieldlist_lnd(:) type(ESMF_Field), pointer :: fieldlist_glc(:) - character(len=*) , parameter :: subname=' (med_phases_prep_glc_map_lnd2glc) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_glc_map_lnd2glc)' !--------------------------------------- ! Get the internal state @@ -1063,7 +1063,7 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) real(r8) :: ablat_renorm_factor ! ratio between global ablation on the two grids real(r8) :: effective_area ! grid cell area multiplied by min(lfrac,icemask_l). real(r8), pointer :: area_g(:) ! areas on glc grid - character(len=*), parameter :: subname=' (renormalize_smb) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_glc_renormalize_smb)' !--------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 0d78bbed0..4144225ae 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -59,7 +59,7 @@ subroutine med_phases_prep_ice(gcomp, rc) integer :: scalar_id real(r8) :: tmp(1) logical :: first_precip_fact_call = .true. - character(len=*),parameter :: subname='(med_phases_prep_ice)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_ice)' !--------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 81114c1bf..4c27a4c38 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -51,7 +51,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) logical :: first_call = .true. real(r8), pointer :: dataptr_scalar_lnd(:,:) real(r8), pointer :: dataptr_scalar_atm(:,:) - character(len=*), parameter :: subname='(med_phases_prep_lnd)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_lnd)' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index de4599ffb..e463eb4eb 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -51,7 +51,7 @@ subroutine med_phases_prep_ocn_init(gcomp, rc) ! local variables type(InternalState) :: is_local - character(len=*),parameter :: subname=' (med_phases_prep_ocn_init) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_ocn_init)' !--------------------------------------- rc = ESMF_SUCCESS @@ -99,7 +99,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) real(r8), pointer :: rofi(:), hrofi(:) real(r8), pointer :: areas(:) real(r8), allocatable :: hcorr(:) - character(len=*), parameter :: subname='(med_phases_prep_ocn_accum)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_ocn_accum)' !--------------------------------------- call t_startf('MED:'//subname) @@ -251,7 +251,7 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: ncnt - character(len=*),parameter :: subname='(med_phases_prep_ocn_avg)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_ocn_avg)' !--------------------------------------- rc = ESMF_SUCCESS @@ -362,7 +362,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) integer :: lsize real(R8) :: c1,c2,c3,c4 character(len=64), allocatable :: fldnames(:) - character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_cesm)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_ocn_custom_cesm)' !--------------------------------------- rc = ESMF_SUCCESS @@ -628,7 +628,7 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) real(R8), pointer :: ofrac(:) integer :: lsize real(R8) , parameter :: const_lhvap = 2.501e6_R8 ! latent heat of evaporation ~ J/kg - character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_nems)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_ocn_custom_nems)' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index e64eea43b..008a2ae1b 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -94,7 +94,7 @@ subroutine med_phases_prep_rof_init(gcomp, rc) type(ESMF_Mesh) :: mesh_r type(ESMF_Field) :: lfield character(len=CS), allocatable :: fldnames_temp(:) - character(len=*),parameter :: subname=' (med_phases_prep_rof_init) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_rof_init)' !--------------------------------------- rc = ESMF_SUCCESS @@ -198,7 +198,7 @@ subroutine med_phases_prep_rof_accum(gcomp, rc) real(r8), pointer :: dataptr1d_accum(:) type(ESMF_Field) :: lfield type(ESMF_Field) :: lfield_accum - character(len=*), parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof_accum)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_rof_accum)' !--------------------------------------- call t_startf('MED:'//subname) @@ -281,7 +281,7 @@ subroutine med_phases_prep_rof(gcomp, rc) type(ESMF_Field) :: lfield_dst type(ESMF_Field) :: field_lfrac_lnd character(CL), pointer :: lfieldnamelist(:) - character(len=*),parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_rof)' !--------------------------------------- call t_startf('MED:'//subname) @@ -462,7 +462,7 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) real(r8), pointer :: irrig_volr0_r(:) real(r8), pointer :: irrig_flux_l(:) real(r8), pointer :: irrig_flux_r(:) - character(len=*), parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof_irrig)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_rof_irrig)' !--------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index a1bd85c1b..29eeecc32 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -46,7 +46,7 @@ subroutine med_phases_prep_wav_init(gcomp, rc) ! local variables type(InternalState) :: is_local - character(len=*),parameter :: subname=' (med_phases_prep_wav_init) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_wav_init)' !--------------------------------------- rc = ESMF_SUCCESS @@ -82,7 +82,7 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n, ncnt - character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_wav_accum)' !--------------------------------------- call t_startf('MED:'//subname) @@ -138,7 +138,7 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: ncnt - character(len=*),parameter :: subname='(med_phases_prep_wav_avg)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_wav_avg)' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_profile_mod.F90 b/mediator/med_phases_profile_mod.F90 index 46d8f2a73..9876127ed 100644 --- a/mediator/med_phases_profile_mod.F90 +++ b/mediator/med_phases_profile_mod.F90 @@ -65,7 +65,7 @@ subroutine med_phases_profile(gcomp, rc) real(r8) :: msize, mrss, ringdays real(r8), save :: avgdt character(len=CL) :: walltimestr, nexttimestr - character(len=*), parameter :: subname='(med_phases_profile)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_profile)' !--------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 5affb149a..27bead2d8 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -66,7 +66,7 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) integer :: restart_n ! freq_n setting relative to freq_option logical :: isPresent logical :: isSet - character(len=*), parameter :: subname='(med_phases_restart_alarm_init)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_restart_alarm_init)' !--------------------------------------- rc = ESMF_SUCCESS @@ -182,7 +182,7 @@ subroutine med_phases_restart_write(gcomp, rc) character(ESMF_MAXSTR) :: tmpstr logical :: isPresent logical :: first_time = .true. - character(len=*), parameter :: subname='(med_phases_restart_write)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_restart_write)' !--------------------------------------- call t_startf('MED:'//subname) @@ -503,7 +503,7 @@ subroutine med_phases_restart_read(gcomp, rc) character(ESMF_MAXSTR) :: restart_pfile ! Local path to restart pointer filename character(ESMF_MAXSTR) :: cpl_inst_tag ! instance tag logical :: isPresent - character(len=*), parameter :: subname='(med_phases_restart_read)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_restart_read)' !--------------------------------------- call t_startf('MED:'//subname) call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index 14cd7464b..5bb15b574 100644 --- a/mediator/med_time_mod.F90 +++ b/mediator/med_time_mod.F90 @@ -87,7 +87,7 @@ subroutine med_time_alarmInit( clock, alarm, option, & type(ESMF_Time) :: NextAlarm ! Next alarm time type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval integer :: sec - character(len=*), parameter :: subname = '(med_time_alarmInit): ' + character(len=*), parameter :: subname = '('//__FILE__//':med_time_alarmInit)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS From 31f93160251c4959356bcbea7eed1e2fad8920a0 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Fri, 20 May 2022 11:19:37 -0500 Subject: [PATCH 074/395] more work for ccpp restart capability, agrid and ogrid are passing now --- mediator/med_phases_aofluxes_mod.F90 | 2 +- ufs/flux_atmocn_ccpp_mod.F90 | 39 ++-- ufs/{ufs_io.F90 => ufs_io_mod.F90} | 321 ++++++++++++++------------- 3 files changed, 194 insertions(+), 168 deletions(-) rename ufs/{ufs_io.F90 => ufs_io_mod.F90} (80%) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index c87b19d43..44c775bbb 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1070,7 +1070,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) vsfc=aoflux_in%vsfc, rbot=aoflux_in%dens, ts=aoflux_in%tocn, mask=aoflux_in%mask, & sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evp=aoflux_out%evap, & taux=aoflux_out%taux, tauy=aoflux_out%tauy, qref=aoflux_out%qref, duu10n=aoflux_out%duu10n, & - missval=0.0_r8) + missval=0.0_r8, rh=rh_agrid2xgrid_2ndord) else #endif call flux_atmocn (logunit=logunit, & diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index b99c356cd..70b365ad8 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -4,7 +4,7 @@ module flux_atmocn_ccpp_mod use ESMF, only : ESMF_GridComp, ESMF_Time, ESMF_SUCCESS, ESMF_FAILURE use ESMF, only : ESMF_Clock, ESMF_TimeInterval, ESMF_ClockGet use ESMF, only : ESMF_GridCompGetInternalState, ESMF_LOGMSG_INFO - use ESMF, only : ESMF_LogWrite + use ESMF, only : ESMF_RouteHandle, ESMF_LogWrite use NUOPC, only : NUOPC_CompAttributeGet use NUOPC_Mediator, only : NUOPC_MediatorGet @@ -42,7 +42,7 @@ module flux_atmocn_ccpp_mod character(len=cl), save :: rst_file character(len=cl), save :: mosaic_file character(len=cl), save :: input_dir - character(len=1) , save :: listDel = ":" + character(len=1) , save :: listDel = "," character(*), parameter :: u_FILE_u = & __FILE__ @@ -51,14 +51,15 @@ module flux_atmocn_ccpp_mod contains !=============================================================================== - subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, & + subroutine flux_atmOcn_ccpp(gcomp, rh, mastertask, logunit, nMax, mask, psfc, pbot, & tbot, qbot, zbot, garea, ubot, usfc, vbot, vsfc, rbot, ts, lwdn, sen, lat, & lwup, evp, taux, tauy, qref, duu10n, missval) implicit none !--- input arguments -------------------------------- - type(ESMF_GridComp), intent(in) :: gcomp ! gridded component + type(ESMF_GridComp), intent(in) :: gcomp ! gridded component + type(ESMF_RouteHandle), intent(in) :: rh ! route handle to map atm->xgrid logical , intent(in) :: mastertask ! master task integer , intent(in) :: logunit ! log file unit number integer , intent(in) :: nMax ! data vector length @@ -186,9 +187,9 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, ! restart call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_restart", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - physics%model%restart = .true. + physics%model%restart = .false. if (isPresent .and. isSet) then - if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%restart = .false. + if (trim(cvalue) .eq. '.true.' .or. trim(cvalue) .eq. 'true') physics%model%restart = .true. end if ! cplice call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_cplice", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) @@ -271,6 +272,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, do n = 1, 2 call string_listGetName(cvalue, n, cname, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (rc == ESMF_FAILURE) return read(cname,*) layout(n) end do else @@ -294,10 +296,10 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, write(logunit,'(a,l)') trim(subname)//' ccpp_phy_cplflx = ', physics%model%cplflx write(logunit,'(a,l)') trim(subname)//' ccpp_phy_lheatstrg = ', physics%model%lheatstrg write(logunit,'(a,i)') trim(subname)//' ccpp_restart_interval = ', restart_freq - write(logunit,'(a)') trim(subname)//' ccpp_ini_file_prefix = ', trim(ini_file) - write(logunit,'(a)') trim(subname)//' ccpp_ini_mosaic_file = ', trim(mosaic_file) - write(logunit,'(a)') trim(subname)//' ccpp_input_dir = ', trim(input_dir) - write(logunit,'(a)') trim(subname)//' ccpp_restart_file = ', trim(rst_file) + write(logunit,'(a)') trim(subname)//' ccpp_ini_file_prefix = '//trim(ini_file) + write(logunit,'(a)') trim(subname)//' ccpp_ini_mosaic_file = '//trim(mosaic_file) + write(logunit,'(a)') trim(subname)//' ccpp_input_dir = '//trim(input_dir) + write(logunit,'(a)') trim(subname)//' ccpp_restart_file = '//trim(rst_file) do n = 1, 2 write(logunit,'(a,i,a,i2)') trim(subname)//' ccpp_ini_layout(',n,') = ', layout(n) end do @@ -309,7 +311,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) starttype if (trim(starttype) == trim('startup')) then - call read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rc) + call read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rh, rc) else call read_restart(gcomp, rst_file, rc) end if @@ -344,12 +346,12 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, ! reset physics variables, mimic GFS_suite_interstitial_phys_reset call physics%interstitial%phys_reset() - ! set required variables to mimic GFS_surface_generic_pre + ! init required variables to mimic GFS_surface_generic_pre ! TODO: the wind calculation in GFS_surface_generic_pre has cnvwind adjustment physics%interstitial%wind = sqrt(ubot(:)*ubot(:)+vbot(:)*vbot(:)) physics%interstitial%prslki = physics%statein%prsik(:)/physics%statein%prslk(:) - ! set required variables to mimic GFS_surface_composites_pre (assumes no ice) + ! init required variables to mimic GFS_surface_composites_pre (assumes no ice) physics%interstitial%uustar_water(:) = physics%sfcprop%uustar(:) physics%sfcprop%tsfco(:) = ts(:) physics%sfcprop%tsfc(:) = ts(:) @@ -360,9 +362,13 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, physics%sfcprop%zorlw(n) = max(1.0e-5, min(1.0d0, physics%sfcprop%zorlw(n))) end do - ! other variables - if (.not. first_call) physics%sfcprop%qss(:) = qbot(:) - physics%interstitial%qss_water(:) = physics%sfcprop%qss(:) + ! init other variables + if (first_call) then + physics%interstitial%qss_water(:) = physics%sfcprop%qss(:) + else + physics%sfcprop%qss(:) = qbot(:) + physics%interstitial%qss_water(:) = qbot(:) + end if ! calculate wet flag and ocean fraction based on masking, assumes full oceean where (mask(:) /= 0) @@ -516,4 +522,5 @@ integer function string_countChar(str,char,rc) string_countChar = count end function string_countChar + end module flux_atmocn_ccpp_mod diff --git a/ufs/ufs_io.F90 b/ufs/ufs_io_mod.F90 similarity index 80% rename from ufs/ufs_io.F90 rename to ufs/ufs_io_mod.F90 index 44370407f..4915f82fd 100644 --- a/ufs/ufs_io.F90 +++ b/ufs/ufs_io_mod.F90 @@ -10,14 +10,15 @@ module ufs_io_mod use ESMF, only : ESMF_GridCompGetInternalState, ESMF_KIND_R8 use ESMF, only : ESMF_ArraySpec, ESMF_ArraySpecSet, ESMF_MESHLOC_ELEMENT use ESMF, only : ESMF_FieldCreate, ESMF_FieldGet, ESMF_FieldDestroy - use ESMF, only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated - use ESMF, only : ESMF_MeshGet, ESMF_FieldRegridStore, ESMF_FieldRedist + use ESMF, only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated, ESMF_FieldRedist + use ESMF, only : ESMF_MeshGet, ESMF_FieldRegrid, ESMF_FieldRegridStore use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleAdd use ESMF, only : ESMF_FieldWriteVTK, ESMF_VMAllFullReduce, ESMF_REDUCE_SUM - use ESMF, only : ESMF_Calendar, ESMF_Clock, ESMF_ClockGet + use ESMF, only : ESMF_Mesh, ESMF_Calendar, ESMF_Clock, ESMF_ClockGet use ESMF, only : ESMF_ClockGetNextTime, ESMF_TimeIntervalGet use ESMF, only : ESMF_Time, ESMF_TimeGet, ESMF_TimeInterval - use ESMF, only : ESMF_FieldBundleIsCreated + use ESMF, only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet + use ESMF, only : ESMF_FieldBundleRemove, ESMF_FieldBundleDestroy use NUOPC, only : NUOPC_CompAttributeGet use NUOPC_Mediator, only : NUOPC_MediatorGet @@ -36,6 +37,7 @@ module ufs_io_mod use med_utils_mod, only : chkerr => med_utils_chkerr use med_constants_mod, only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod, only : InternalState, mastertask, logunit + use med_internalstate_mod, only : compatm, compocn, mapconsf use med_io_mod, only : med_io_write, med_io_wopen, med_io_enddef, med_io_read use med_io_mod, only : med_io_close, med_io_write_time, med_io_define_time use med_io_mod, only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date @@ -76,7 +78,6 @@ module ufs_io_mod integer, allocatable :: jend2(:) ! list of ending j-index in tile 2 of each contact end type domain_type - type(ESMF_FieldBundle), save :: FBrst character(cs) :: prefix = 'ccpp' integer :: file_ind = 10 character(cl) :: case_name = 'unset' ! case name @@ -89,7 +90,7 @@ module ufs_io_mod contains !=============================================================================== - subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rc) + subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rh_a2x, rc) implicit none ! input/output variables @@ -98,18 +99,27 @@ subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rc) character(len=cl), intent(in) :: mosaic_file character(len=cl), intent(in) :: input_dir integer :: layout(2) + type(ESMF_RouteHandle) :: rh_a2x integer, intent(inout) :: rc ! local variables - type(domain_type) :: domain - type(ESMF_Field) :: field - real(ESMF_KIND_R8), pointer :: ptr(:,:,:) + type(domain_type) :: domain + type(InternalState) :: is_local + type(ESMF_Mesh) :: atm_mesh + type(ESMF_Field) :: lfield, field, field_dst + real(ESMF_KIND_R8), pointer :: ptr(:) + integer :: n + character(len=cs), allocatable :: flds(:) character(len=*), parameter :: subname = trim(modName)//': (read_initial) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! --------------------- ! Create domain ! --------------------- @@ -123,31 +133,69 @@ subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rc) call create_grid(gcomp, domain, mosaic_file, input_dir, rc) - !---------------------- - ! Read surface friction velocity - !---------------------- + ! --------------------- + ! Determine atm mesh + ! --------------------- - call read_tiled_file(gcomp, ini_file, 'uustar', domain, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - physics%sfcprop%uustar(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm,compatm), fieldname='Sa_z', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, mesh=atm_mesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !---------------------- - ! Read surface roughness length + ! Read data !---------------------- - call read_tiled_file(gcomp, ini_file, 'zorl', domain, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - physics%sfcprop%zorl(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(flds(2)) + flds = (/ 'zorl ', & + 'uustar' /) + do n = 1,size(flds) + ! read from tiled file + call read_tiled_file(gcomp, ini_file, trim(flds(n)), domain, field, atm_mesh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create destination field + field_dst = ESMF_FieldCreate(is_local%wrap%aoflux_mesh, ESMF_TYPEKIND_R8, & + name='uustar', meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! map field + if (is_local%wrap%aoflux_grid == 'ogrid') then ! aoflux_grid is ocn + ! remap from atm to ocn + call ESMF_FieldRegrid(field, field_dst, is_local%wrap%RH(compatm,compocn,mapconsf), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else if (is_local%wrap%aoflux_grid == 'agrid') then ! aoflux_grid is atm + ! do nothing, use source field + field_dst = field + else if (is_local%wrap%aoflux_grid == 'xgrid') then ! aoflux_grid is exchange + ! remap from atm to exchange grid + call ESMF_FieldRegrid(field, field_dst, rh_a2x, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! debug + if (dbug_flag > 5) then + call ESMF_FieldWriteVTK(field_dst, 'ini_'//trim(flds(n))//'_'//trim(is_local%wrap%aoflux_grid), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! return pointer and fill variable + call ESMF_FieldGet(field_dst, localDe=0, farrayPtr=ptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) write(logunit,'(a)') 'Reading: '//trim(flds(n)) + if (trim(flds(n)) == 'zorl' ) physics%sfcprop%zorl(:) = ptr(:) + if (trim(flds(n)) == 'uustar') physics%sfcprop%uustar(:)= ptr(:) + nullify(ptr) + + ! free memory + call ESMF_FieldDestroy(field_dst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + ! free memory + if (allocated(flds)) deallocate(flds) + + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine read_initial @@ -166,6 +214,7 @@ subroutine read_restart(gcomp, rst_file, rc) type(ESMF_Clock) :: mclock type(ESMF_Time) :: currtime type(ESMF_TimeInterval) :: timeStep + type(ESMF_FieldBundle), save :: FBin type(InternalState) :: is_local integer :: n, yr, mon, day, sec real(r8), pointer :: ptr(:) @@ -219,11 +268,11 @@ subroutine read_restart(gcomp, rst_file, rc) end if ! create FB - FBrst = ESMF_FieldBundleCreate(rc=rc) + FBin = ESMF_FieldBundleCreate(rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! add fields - allocate(flds(12)) + allocate(flds(3)) flds = (/ 'zorl ', & 'uustar', & 'qss ' /) @@ -234,16 +283,16 @@ subroutine read_restart(gcomp, rst_file, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ptr(:) = 0.0_r8 nullify(ptr) - call ESMF_FieldBundleAdd(FBrst, (/field/), rc=rc) + call ESMF_FieldBundleAdd(FBin, (/field/), rc=rc) end do ! read file to FB - call med_io_read(rst_file, vm, FBrst, pre=trim(prefix), rc=rc) + call med_io_read(rst_file, vm, FBin, pre=trim(prefix), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//' diagnose at '//trim(currtime_str), ESMF_LOGMSG_INFO) - call fldbun_diagnose(FBrst, string=trim(subname)//' CCPP FBrst ', rc=rc) + call fldbun_diagnose(FBin, string=trim(subname)//' CCPP FBin ', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -252,8 +301,8 @@ subroutine read_restart(gcomp, rst_file, rc) !---------------------- do n = 1,size(flds) - if (FB_FldChk(FBrst, trim(flds(n)), rc=rc)) then - call FB_getfldptr(FBrst, trim(flds(n)), ptr, rc=rc) + if (FB_FldChk(FBin, trim(flds(n)), rc=rc)) then + call FB_getfldptr(FBin, trim(flds(n)), ptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (mastertask) write(logunit,'(a)') 'Reading: '//trim(flds(n)) @@ -264,8 +313,30 @@ subroutine read_restart(gcomp, rst_file, rc) nullify(ptr) end if end do + + !---------------------- + ! Free memory + !---------------------- + + do n = 1,size(flds) + if (FB_FldChk(FBin, trim(flds(n)), rc=rc)) then + ! get field from FB + call ESMF_FieldBundleGet(FBin, trim(flds(n)), field=field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! remove field from FB + call ESMF_FieldBundleRemove(FBin, (/ trim(flds(n)) /), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! remove field + call ESMF_FieldDestroy(field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end do deallocate(flds) + ! remove FB + call ESMF_FieldBundleDestroy(FBin, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine read_restart @@ -453,7 +524,7 @@ subroutine create_grid(gcomp, domain, mosaic_file, input_dir, rc) end subroutine create_grid !=============================================================================== - subroutine read_tiled_file(gcomp, filename, varname, domain, field_dst, numrec, numlev, rc) + subroutine read_tiled_file(gcomp, filename, varname, domain, field_dst, mesh, rc) implicit none ! input/output variables @@ -462,8 +533,7 @@ subroutine read_tiled_file(gcomp, filename, varname, domain, field_dst, numrec, character(len=*), intent(in) :: varname type(domain_type), intent(inout) :: domain type(ESMF_Field), intent(inout) :: field_dst - integer, intent(in), optional :: numrec - integer, intent(in), optional :: numlev + type(ESMF_Mesh), intent(in) :: mesh integer, intent(inout), optional :: rc ! local variables @@ -472,14 +542,13 @@ subroutine read_tiled_file(gcomp, filename, varname, domain, field_dst, numrec, type(InternalState) :: is_local type(fieldtype), allocatable:: vars(:) integer :: funit, my_tile - integer :: i, j, n, nt, nl + integer :: i, j, n integer :: isc, iec, jsc, jec integer :: ndim, nvar, natt, ntime logical :: not_found, is_root_pe - real(ESMF_KIND_R8), pointer :: ptr(:), ptr3d(:,:,:) - real(ESMF_KIND_R8), pointer :: ptr4d(:,:,:,:) - real(r8), allocatable :: rdata(:,:,:,:) - character(len=cl) :: cname, fname + real(ESMF_KIND_R8), pointer :: ptr2d(:,:) + real(r8), allocatable :: rdata(:,:) + character(len=cl) :: cname character(len=*), parameter :: subname=trim(modName)//': (read_tiled_file) ' !------------------------------------------------------------------------------- @@ -495,21 +564,8 @@ subroutine read_tiled_file(gcomp, filename, varname, domain, field_dst, numrec, if (chkerr(rc,__LINE__,u_FILE_u)) return !---------------------- - ! Define required variables + ! Set tile !---------------------- - - if (present(numrec)) then - nt = numrec - else - nt = 1 - end if - - if (present(numlev)) then - nl = numlev - else - nl = 1 - end if - my_tile = int(mpp_pe()/(domain%layout(1)*domain%layout(2)))+1 is_root_pe = .false. @@ -540,17 +596,15 @@ subroutine read_tiled_file(gcomp, filename, varname, domain, field_dst, numrec, call mpp_get_compute_domain(domain%mosaic_domain, isc, iec, jsc, jec) ! allocate data array and set initial value - allocate(rdata(isc:iec,jsc:jec,nl,nt)) - rdata(:,:,:,:) = 0.0_r8 + allocate(rdata(isc:iec,jsc:jec)) + rdata(:,:) = 0.0_r8 ! read data - do i = 1, nt - call mpp_read(funit, vars(n), domain%mosaic_domain, rdata, 1) - end do + call mpp_read(funit, vars(n), domain%mosaic_domain, rdata, 1) ! set missing values to zero where (rdata == 1.0e20) - rdata(:,:,:,:) = 0.0_r8 + rdata(:,:) = 0.0_r8 end where end if @@ -566,26 +620,24 @@ subroutine read_tiled_file(gcomp, filename, varname, domain, field_dst, numrec, !---------------------- ! set type and rank for ESMF arrayspec - call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_R8, rank=4, rc=rc) + call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_R8, rank=2, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! create source field field_src = ESMF_FieldCreate(domain%grid, arraySpec, staggerloc=ESMF_STAGGERLOC_CENTER, & - indexflag=ESMF_INDEX_GLOBAL, ungriddedLBound=(/1,1/), ungriddedUBound=(/nl,nt/), & - gridToFieldMap=(/1,2/), name=trim(varname), rc=rc) + indexflag=ESMF_INDEX_GLOBAL, name=trim(varname), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! get pointer and fill it - call ESMF_FieldGet(field_src, localDe=0, farrayPtr=ptr4d, rc=rc) + call ESMF_FieldGet(field_src, localDe=0, farrayPtr=ptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ptr4d(:,:,:,:) = rdata(:,:,:,:) - nullify(ptr4d) + ptr2d(:,:) = rdata(:,:) + nullify(ptr2d) if (allocated(rdata)) deallocate(rdata) ! create destination field - field_dst = ESMF_FieldCreate(is_local%wrap%aoflux_mesh, ESMF_TYPEKIND_R8, & - name=trim(varname), meshloc=ESMF_MESHLOC_ELEMENT, ungriddedLbound=(/1,1/), & - ungriddedUbound=(/nl,nt/), gridToFieldMap=(/1/), rc=rc) + field_dst = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=trim(varname), & + meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! create routehandle from grid to mesh @@ -607,33 +659,7 @@ subroutine read_tiled_file(gcomp, filename, varname, domain, field_dst, numrec, !---------------------- if (dbug_flag > 5) then - ! TODO: ESMF_FieldWriteVTK() call does not support ungridded dimension - ! The workaround is implemented in here but it would be nice to extend - ! ESMF_FieldWriteVTK() call to handle it. - field_tmp = ESMF_FieldCreate(is_local%wrap%aoflux_mesh, ESMF_TYPEKIND_R8, & - name=trim(varname), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_FieldGet(field_tmp, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_FieldGet(field_dst, localDe=0, farrayPtr=ptr3d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! write to different file along ungridded dimension - do i = 1, nl - do j = 1, nt - ptr(:) = ptr3d(:,i,j) - write(fname, fmt='(A,I2.2,A,I2.2)') trim(varname)//'_lev', i, '_time', j - call ESMF_FieldWriteVTK(field_tmp, trim(fname), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - end do - - ! clean memory - nullify(ptr) - nullify(ptr3d) - call ESMF_FieldDestroy(field_tmp, rc=rc) + call ESMF_FieldWriteVTK(field_dst, trim(varname)//'_agrid', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -655,20 +681,22 @@ subroutine write_restart(gcomp, restart_freq, rc) type(ESMF_Calendar) :: calendar type(ESMF_Time) :: currtime, starttime, nexttime type(ESMF_TimeInterval) :: timediff(2) + type(ESMF_FieldBundle), save :: FBout type(InternalState) :: is_local integer :: yr, mon, day, sec - integer :: m, ns, start_ymd + integer :: n, m, ns, start_ymd character(cl) :: time_units real(r8) :: time_val real(r8) :: time_bnds(2) real(r8), pointer :: ptr(:) - logical :: whead(2) = (/.true. , .false./) - logical :: wdata(2) = (/.false., .true. /) + logical :: whead(2) = (/.true. , .false./) + logical :: wdata(2) = (/.false., .true. /) character(len=cl) :: tmpstr character(len=cl) :: rst_file character(len=cl) :: nexttime_str integer, save :: ns_total logical, save :: first_call = .true. + character(len=cs), allocatable :: flds(:) character(len=*), parameter :: subname=trim(modName)//': (write_restart) ' !------------------------------------------------------------------------------- @@ -744,7 +772,7 @@ subroutine write_restart(gcomp, restart_freq, rc) if (first_call) then ! create FB - FBrst = ESMF_FieldBundleCreate(rc=rc) + FBout = ESMF_FieldBundleCreate(rc=rc) ! get total element count call ESMF_MeshGet(is_local%wrap%aoflux_mesh, elementCount=ns, rc=rc) @@ -752,61 +780,52 @@ subroutine write_restart(gcomp, restart_freq, rc) call ESMF_VMAllFullReduce(vm, (/ns/), ns_total, 1, ESMF_REDUCE_SUM, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! surface roughness length in cm - field = ESMF_FieldCreate(is_local%wrap%aoflux_mesh, ESMF_TYPEKIND_R8, & - name='zorl', meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, farrayptr=ptr, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - ptr(:) = physics%sfcprop%zorl(:) - call ESMF_FieldBundleAdd(FBrst, (/field/), rc=rc) - - ! boundary layer parameter - field = ESMF_FieldCreate(is_local%wrap%aoflux_mesh, ESMF_TYPEKIND_R8, & - name='uustar', meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, farrayptr=ptr, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - ptr(:) = physics%sfcprop%uustar(:) - nullify(ptr) - call ESMF_FieldBundleAdd(FBrst, (/field/), rc=rc) + ! add fields + allocate(flds(3)) + flds = (/ 'zorl ', & + 'uustar', & + 'qss ' /) + do n = 1,size(flds) + ! create new field on aoflux mesh + field = ESMF_FieldCreate(is_local%wrap%aoflux_mesh, ESMF_TYPEKIND_R8, & + name=trim(flds(n)), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! get pointer out of field + call ESMF_FieldGet(field, farrayptr=ptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! fill pointer + if (trim(flds(n)) == 'zorl' ) ptr(:) = physics%sfcprop%zorl(:) + if (trim(flds(n)) == 'uustar') ptr(:) = physics%sfcprop%uustar(:) + if (trim(flds(n)) == 'qss' ) ptr(:) = physics%sfcprop%qss(:) + nullify(ptr) - ! surface air saturation specific humidity (kg/kg) - field = ESMF_FieldCreate(is_local%wrap%aoflux_mesh, ESMF_TYPEKIND_R8, & - name='qss', meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, farrayptr=ptr, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - ptr(:) = physics%sfcprop%qss(:) - nullify(ptr) - call ESMF_FieldBundleAdd(FBrst, (/field/), rc=rc) + ! add field to FB + call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do else - call fldbun_getdata1d(FBrst, 'zorl', ptr, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - ptr(:) = physics%sfcprop%zorl(:) - nullify(ptr) - - call fldbun_getdata1d(FBrst, 'uustar', ptr, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - ptr(:) = physics%sfcprop%uustar(:) - nullify(ptr) - - call fldbun_getdata1d(FBrst, 'qss', ptr, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - ptr(:) = physics%sfcprop%qss(:) - nullify(ptr) + do n = 1,size(flds) + ! retrieve field pointer from FB + call fldbun_getdata1d(FBout, trim(flds(n)), ptr, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! fill pointer + if (trim(flds(n)) == 'zorl' ) ptr(:) = physics%sfcprop%zorl(:) + if (trim(flds(n)) == 'uustar') ptr(:) = physics%sfcprop%uustar(:) + if (trim(flds(n)) == 'qss' ) ptr(:) = physics%sfcprop%qss(:) + nullify(ptr) + end do end if - ! diagnose + ! debug if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//' diagnose at '//trim(nexttime_str), ESMF_LOGMSG_INFO) - call fldbun_diagnose(FBrst, string=trim(subname)//' CCPP FBrst ', rc=rc) + call fldbun_diagnose(FBout, string=trim(subname)//' CCPP FBout ', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! debug - - !---------------------- ! Write data !---------------------- @@ -829,7 +848,7 @@ subroutine write_restart(gcomp, restart_freq, rc) end if ! write data - call med_io_write(rst_file, FBrst, whead(m), wdata(m), ns_total, 1, nt=1, pre=trim(prefix), file_ind=file_ind, rc=rc) + call med_io_write(rst_file, FBout, whead(m), wdata(m), ns_total, 1, nt=1, pre=trim(prefix), file_ind=file_ind, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do From c90b9f1f499a093ca169c98cde21e5ca1df5ff38 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Sat, 21 May 2022 02:28:09 -0500 Subject: [PATCH 075/395] fix ccpp restart for xgrid and add support for sfc_diag --- mediator/med_phases_aofluxes_mod.F90 | 3 +- ufs/ccpp/config/ccpp_prebuild_config.py | 4 +- ufs/ccpp/data/MED_data.F90 | 2 + ufs/ccpp/data/MED_typedefs.F90 | 37 +++++++++++++++ ufs/ccpp/data/MED_typedefs.meta | 59 ++++++++++++++++++++++++ ufs/ccpp/suites/suite_FV3_sfc_ocean.xml | 1 + ufs/flux_atmocn_ccpp_mod.F90 | 33 +++++++++++--- ufs/ufs_io_mod.F90 | 60 ++++++------------------- 8 files changed, 144 insertions(+), 55 deletions(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 44c775bbb..a6695a77e 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1069,7 +1069,8 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) zbot=aoflux_in%zbot, garea=aoflux_in%garea, ubot=aoflux_in%ubot, usfc=aoflux_in%usfc, vbot=aoflux_in%vbot, & vsfc=aoflux_in%vsfc, rbot=aoflux_in%dens, ts=aoflux_in%tocn, mask=aoflux_in%mask, & sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evp=aoflux_out%evap, & - taux=aoflux_out%taux, tauy=aoflux_out%tauy, qref=aoflux_out%qref, duu10n=aoflux_out%duu10n, & + taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & + duu10n=aoflux_out%duu10n, ustar_sv=aoflux_out%ustar, re_sv=aoflux_out%re, ssq_sv=aoflux_out%ssq, & missval=0.0_r8, rh=rh_agrid2xgrid_2ndord) else #endif diff --git a/ufs/ccpp/config/ccpp_prebuild_config.py b/ufs/ccpp/config/ccpp_prebuild_config.py index 7636f5271..d2872972e 100755 --- a/ufs/ccpp/config/ccpp_prebuild_config.py +++ b/ufs/ccpp/config/ccpp_prebuild_config.py @@ -41,6 +41,7 @@ 'MED_typedefs' : { 'MED_init_type' : 'physics%init', 'MED_statein_type' : 'physics%Statein', + 'MED_stateout_type' : 'physics%Stateout', 'MED_interstitial_type' : 'physics%Interstitial', 'MED_control_type' : 'physics%Model', 'MED_coupling_type' : 'physics%Coupling', @@ -62,7 +63,8 @@ '{}/ccpp/physics/physics/GFS_surface_loop_control_part1.F90'.format(fv3_path), '{}/ccpp/physics/physics/GFS_surface_loop_control_part2.F90'.format(fv3_path), '{}/ccpp/physics/physics/GFS_surface_composites_pre.F90'.format(fv3_path), - '{}/ccpp/physics/physics/GFS_surface_composites_post.F90'.format(fv3_path) + '{}/ccpp/physics/physics/GFS_surface_composites_post.F90'.format(fv3_path), + '{}/ccpp/physics/physics/sfc_diag.f'.format(fv3_path) ] # Default build dir, relative to current working directory, diff --git a/ufs/ccpp/data/MED_data.F90 b/ufs/ccpp/data/MED_data.F90 index 4a57d38c6..edaf9dffa 100644 --- a/ufs/ccpp/data/MED_data.F90 +++ b/ufs/ccpp/data/MED_data.F90 @@ -8,6 +8,7 @@ module MED_data !! use MED_typedefs, only: MED_statein_type + use MED_typedefs, only: MED_stateout_type use MED_typedefs, only: MED_init_type use MED_typedefs, only: MED_interstitial_type use MED_typedefs, only: MED_control_type @@ -27,6 +28,7 @@ module MED_data type physics_type type(MED_init_type) :: init type(MED_statein_type) :: statein + type(MED_stateout_type) :: stateout type(MED_interstitial_type) :: interstitial type(MED_control_type) :: model type(MED_coupling_type) :: coupling diff --git a/ufs/ccpp/data/MED_typedefs.F90 b/ufs/ccpp/data/MED_typedefs.F90 index 3e6586041..9b2d556a8 100644 --- a/ufs/ccpp/data/MED_typedefs.F90 +++ b/ufs/ccpp/data/MED_typedefs.F90 @@ -44,6 +44,18 @@ module MED_typedefs procedure :: create => statein_create !< allocate array data end type MED_statein_type +!! \section arg_table_MED_stateout_type +!! \htmlinclude MED_stateout_type.html +!! + type MED_stateout_type + real(kind=kind_phys), pointer :: gu0(:) => null() !< updated zonal wind + real(kind=kind_phys), pointer :: gv0(:) => null() !< updated meridional wind + real(kind=kind_phys), pointer :: gt0(:) => null() !< updated temperature + real(kind=kind_phys), pointer :: gq0(:) => null() !< updated tracers + contains + procedure :: create => stateout_create !< allocate array data + end type MED_stateout_type + !! \section arg_table_MED_interstitial_type !! \htmlinclude MED_interstitial_type.html !! @@ -233,6 +245,9 @@ module MED_typedefs real(kind=kind_phys), pointer :: evap(:) => null() !< kinematic surface upward latent heat flux (kg kg-1 m s-1) real(kind=kind_phys), pointer :: hflx(:) => null() !< kinematic surface upward sensible heat flux (K m/s) real(kind=kind_phys), pointer :: tiice(:,:) => null() !< sea ice internal temperature + real(kind=kind_phys), pointer :: t2m(:) => null() !< temperature at 2 m + real(kind=kind_phys), pointer :: q2m(:) => null() !< specific humidity at 2 m + real(kind=kind_phys), pointer :: f10m(:) => null() !< ratio of sigma level 1 wind and 10m wind contains procedure :: create => sfcprop_create !< allocate array data end type MED_sfcprop_type @@ -291,6 +306,22 @@ subroutine statein_create(statein, im, model) end subroutine statein_create + subroutine stateout_create(stateout, im) + implicit none + class(MED_stateout_type) :: stateout + integer, intent(in) :: im + + allocate(stateout%gu0(im)) + stateout%gu0 = clear_val + allocate(stateout%gv0(im)) + stateout%gv0 = clear_val + allocate(stateout%gt0(im)) + stateout%gt0 = clear_val + allocate(stateout%gq0(im)) + stateout%gq0 = clear_val + + end subroutine stateout_create + subroutine interstitial_create(interstitial, im) implicit none class(MED_interstitial_type) :: interstitial @@ -694,6 +725,12 @@ subroutine sfcprop_create(sfcprop, im, model) sfcprop%hflx = clear_val allocate(sfcprop%tiice(im,model%kice)) sfcprop%tiice = clear_val + allocate(sfcprop%t2m(im)) + sfcprop%t2m = clear_val + allocate(sfcprop%q2m(im)) + sfcprop%q2m = clear_val + allocate(sfcprop%f10m(im)) + sfcprop%f10m = clear_val end subroutine sfcprop_create diff --git a/ufs/ccpp/data/MED_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta index eed67be49..2e975afc1 100644 --- a/ufs/ccpp/data/MED_typedefs.meta +++ b/ufs/ccpp/data/MED_typedefs.meta @@ -107,6 +107,44 @@ type = real kind = kind_phys +######################################################################## +[ccpp-table-properties] + name = MED_stateout_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = MED_stateout_type + type = ddt +[gu0] + standard_name = x_wind_of_new_state_at_surface_adjacent_layer + long_name = zonal wind at lowest model layer updated by physics + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gv0] + standard_name = y_wind_of_new_state_at_surface_adjacent_layer + long_name = meridional wind at lowest model layer updated by physics + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gt0] + standard_name = air_temperature_of_new_state_at_surface_adjacent_layer + long_name = temperature at lowest model layer updated by physics + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gq0] + standard_name = specific_humidity_of_new_state_at_surface_adjacent_layer + long_name = water vapor specific humidity at lowest model layer updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + ######################################################################## [ccpp-table-properties] name = MED_interstitial_type @@ -1139,6 +1177,27 @@ dimensions = (horizontal_loop_extent,vertical_dimension_of_sea_ice) type = real kind = kind_phys +[t2m] + standard_name = air_temperature_at_2m + long_name = 2 meter temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[q2m] + standard_name = specific_humidity_at_2m + long_name = 2 meter specific humidity + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[f10m] + standard_name = ratio_of_wind_at_surface_adjacent_layer_to_wind_at_10m + long_name = ratio of sigma level 1 wind and 10m wind + units = ratio + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys ######################################################################## [ccpp-table-properties] diff --git a/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml b/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml index af99985a1..5017d407e 100644 --- a/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml +++ b/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml @@ -13,6 +13,7 @@ GFS_surface_composites_post + sfc_diag diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index 70b365ad8..22f590c55 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -53,7 +53,7 @@ module flux_atmocn_ccpp_mod subroutine flux_atmOcn_ccpp(gcomp, rh, mastertask, logunit, nMax, mask, psfc, pbot, & tbot, qbot, zbot, garea, ubot, usfc, vbot, vsfc, rbot, ts, lwdn, sen, lat, & - lwup, evp, taux, tauy, qref, duu10n, missval) + lwup, evp, taux, tauy, tref, qref, duu10n, ustar_sv, re_sv, ssq_sv, missval) implicit none @@ -86,8 +86,12 @@ subroutine flux_atmOcn_ccpp(gcomp, rh, mastertask, logunit, nMax, mask, psfc, pb real(r8), intent(out) :: evp(nMax) ! heat flux: evap ((kg/s)/m^2) real(r8), intent(out) :: taux(nMax) ! surface stress, zonal (N) real(r8), intent(out) :: tauy(nMax) ! surface stress, maridional (N) + real(r8), intent(out) :: tref (nMax) ! diag: 2m ref height T (K) real(r8), intent(out) :: qref(nMax) ! diag: 2m ref humidity (kg/kg) real(r8), intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + real(r8), intent(out) :: ustar_sv(nMax) ! diag: ustar + real(r8), intent(out) :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) + real(r8), intent(out) :: ssq_sv(nMax) ! diag: sea surface humidity (kg/kg) !--- local variables -------------------------------- type(ESMF_Clock) :: mclock @@ -128,6 +132,7 @@ subroutine flux_atmOcn_ccpp(gcomp, rh, mastertask, logunit, nMax, mask, psfc, pb if (first_call) then ! allocate and initalize data structures call physics%statein%create(nMax,physics%model) + call physics%stateout%create(nMax) call physics%interstitial%create(nMax) call physics%coupling%create(nMax) call physics%grid%create(nMax) @@ -287,21 +292,21 @@ subroutine flux_atmOcn_ccpp(gcomp, rh, mastertask, logunit, nMax, mask, psfc, pb write(logunit,*) '========================================================' write(logunit,'(a,f5.2)') trim(subname)//' ccpp_phy_semis_water = ', semis_water write(logunit,'(a,l)') trim(subname)//' ccpp_phy_lseaspray = ', physics%model%lseaspray - write(logunit,'(a,i)') trim(subname)//' ccpp_phy_ivegsrc = ', physics%model%ivegsrc + write(logunit,'(a,i2)') trim(subname)//' ccpp_phy_ivegsrc = ', physics%model%ivegsrc write(logunit,'(a,l)') trim(subname)//' ccpp_phy_redrag = ', physics%model%redrag - write(logunit,'(a,i)') trim(subname)//' ccpp_phy_lsm = ', physics%model%lsm + write(logunit,'(a,i2)') trim(subname)//' ccpp_phy_lsm = ', physics%model%lsm write(logunit,'(a,l)') trim(subname)//' ccpp_phy_frac_grid = ', physics%model%frac_grid write(logunit,'(a,l)') trim(subname)//' ccpp_phy_restart = ', physics%model%restart write(logunit,'(a,l)') trim(subname)//' ccpp_phy_cplice = ', physics%model%cplice write(logunit,'(a,l)') trim(subname)//' ccpp_phy_cplflx = ', physics%model%cplflx write(logunit,'(a,l)') trim(subname)//' ccpp_phy_lheatstrg = ', physics%model%lheatstrg - write(logunit,'(a,i)') trim(subname)//' ccpp_restart_interval = ', restart_freq + write(logunit,'(a,i5)') trim(subname)//' ccpp_restart_interval = ', restart_freq write(logunit,'(a)') trim(subname)//' ccpp_ini_file_prefix = '//trim(ini_file) write(logunit,'(a)') trim(subname)//' ccpp_ini_mosaic_file = '//trim(mosaic_file) write(logunit,'(a)') trim(subname)//' ccpp_input_dir = '//trim(input_dir) write(logunit,'(a)') trim(subname)//' ccpp_restart_file = '//trim(rst_file) do n = 1, 2 - write(logunit,'(a,i,a,i2)') trim(subname)//' ccpp_ini_layout(',n,') = ', layout(n) + write(logunit,'(a,i1,a,i2)') trim(subname)//' ccpp_ini_layout(',n,') = ', layout(n) end do write(logunit,*) '========================================================' end if @@ -334,13 +339,19 @@ subroutine flux_atmOcn_ccpp(gcomp, rh, mastertask, logunit, nMax, mask, psfc, pb physics%statein%u10m(:) = usfc(:) physics%statein%v10m(:) = vsfc(:) + ! fill in updated states by physics, currently set to statein + physics%stateout%gu0(:) = ubot(:) + physics%stateout%gv0(:) = vbot(:) + physics%stateout%gt0(:) = tbot(:) + physics%stateout%gq0(:) = qbot(:) + ! fill in grid related variables physics%grid%area(:) = garea(:) ! set counter physics%model%kdt = ((currTime-StartTime)/timeStep)+1 if (mastertask .and. dbug_flag > 5) then - write(logunit,'(a,i)') 'kdt = ', physics%model%kdt + write(logunit,'(a,i5)') 'kdt = ', physics%model%kdt end if ! reset physics variables, mimic GFS_suite_interstitial_phys_reset @@ -391,8 +402,12 @@ subroutine flux_atmOcn_ccpp(gcomp, rh, mastertask, logunit, nMax, mask, psfc, pb evp(n) = lat(n)/hvap taux(n) = rbot(n)*physics%interstitial%stress_water(n)*ubot(n)/physics%interstitial%wind(n) tauy(n) = rbot(n)*physics%interstitial%stress_water(n)*vbot(n)/physics%interstitial%wind(n) - qref(n) = physics%interstitial%qss_water(n) + tref(n) = physics%sfcprop%t2m(n) + qref(n) = physics%sfcprop%q2m(n) duu10n(n) = physics%interstitial%wind(n)*physics%interstitial%wind(n) + ustar_sv(n) = physics%interstitial%uustar_water(n) + re_sv(n) = physics%interstitial%cmm_water(n) + ssq_sv(n) = physics%interstitial%qss_water(n) else sen(n) = spval lat(n) = spval @@ -400,8 +415,12 @@ subroutine flux_atmOcn_ccpp(gcomp, rh, mastertask, logunit, nMax, mask, psfc, pb evp(n) = spval taux(n) = spval tauy(n) = spval + tref(n) = spval qref(n) = spval duu10n(n) = spval + ustar_sv(n) = spval + re_sv(n) = spval + ssq_sv(n) = spval end if end do diff --git a/ufs/ufs_io_mod.F90 b/ufs/ufs_io_mod.F90 index 4915f82fd..ae1063b81 100644 --- a/ufs/ufs_io_mod.F90 +++ b/ufs/ufs_io_mod.F90 @@ -19,6 +19,7 @@ module ufs_io_mod use ESMF, only : ESMF_Time, ESMF_TimeGet, ESMF_TimeInterval use ESMF, only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet use ESMF, only : ESMF_FieldBundleRemove, ESMF_FieldBundleDestroy + use ESMF, only : ESMF_FieldBundleRead, ESMF_FieldBundleWrite use NUOPC, only : NUOPC_CompAttributeGet use NUOPC_Mediator, only : NUOPC_MediatorGet @@ -38,8 +39,6 @@ module ufs_io_mod use med_constants_mod, only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod, only : InternalState, mastertask, logunit use med_internalstate_mod, only : compatm, compocn, mapconsf - use med_io_mod, only : med_io_write, med_io_wopen, med_io_enddef, med_io_read - use med_io_mod, only : med_io_close, med_io_write_time, med_io_define_time use med_io_mod, only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date use ufs_const_mod, only : shr_const_cday use med_methods_mod, only : fldbun_getdata1d => med_methods_FB_getdata1d @@ -78,11 +77,9 @@ module ufs_io_mod integer, allocatable :: jend2(:) ! list of ending j-index in tile 2 of each contact end type domain_type - character(cs) :: prefix = 'ccpp' - integer :: file_ind = 10 character(cl) :: case_name = 'unset' ! case name - character(*), parameter :: modName = "(ufs_io)" + character(*), parameter :: modName = "(ufs_io_mod)" character(*), parameter :: u_FILE_u = & __FILE__ @@ -209,8 +206,7 @@ subroutine read_restart(gcomp, rst_file, rc) integer, intent(inout) :: rc ! return code ! local variables - type(ESMF_VM) :: vm - type(ESMF_Field) :: field + type(ESMF_Field) :: field, lfield type(ESMF_Clock) :: mclock type(ESMF_Time) :: currtime type(ESMF_TimeInterval) :: timeStep @@ -230,13 +226,6 @@ subroutine read_restart(gcomp, rst_file, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - !---------------------- - ! Query VM - !---------------------- - - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - !---------------------- ! Set restart file name !---------------------- @@ -287,9 +276,10 @@ subroutine read_restart(gcomp, rst_file, rc) end do ! read file to FB - call med_io_read(rst_file, vm, FBin, pre=trim(prefix), rc=rc) + call ESMF_FieldBundleRead(FBin, trim(rst_file), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! debug if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//' diagnose at '//trim(currtime_str), ESMF_LOGMSG_INFO) call fldbun_diagnose(FBin, string=trim(subname)//' CCPP FBin ', rc=rc) @@ -311,6 +301,14 @@ subroutine read_restart(gcomp, rst_file, rc) if (trim(flds(n)) == 'qss' ) physics%sfcprop%qss(:) = ptr(:) nullify(ptr) + + ! debug + if (dbug_flag > 5) then + call ESMF_FieldBundleGet(FBin, fieldName=trim(flds(n)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldWriteVTK(lfield, 'rst_'//trim(flds(n))//'_'//trim(is_local%wrap%aoflux_grid), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if end if end do @@ -750,10 +748,6 @@ subroutine write_restart(gcomp, restart_freq, rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(trim(rst_file), vm, clobber=.true., file_ind=file_ind) - if (mastertask) then - write(logunit,'(a)') 'CCPP restart file is created: '//trim(rst_file) - end if !---------------------- ! Define time dimension @@ -830,33 +824,7 @@ subroutine write_restart(gcomp, restart_freq, rc) ! Write data !---------------------- - ! loop over whead/wdata phases - do m = 1, 2 - if (m == 2) then - call med_io_enddef(rst_file, file_ind=file_ind) - end if - - ! write time values - if (whead(m)) then - call ESMF_ClockGet(mclock, calendar=calendar, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, file_ind=file_ind, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call med_io_write_time(time_val, time_bnds, nt=1, file_ind=file_ind, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! write data - call med_io_write(rst_file, FBout, whead(m), wdata(m), ns_total, 1, nt=1, pre=trim(prefix), file_ind=file_ind, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - - !---------------------- - ! Close file - !---------------------- - - call med_io_close(rst_file, vm, file_ind=file_ind, rc=rc) + call ESMF_FieldBundleWrite(FBout, trim(rst_file), overwrite=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (mastertask) then From f5574979271647242767c45004b6c889e240a6df Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 24 May 2022 19:18:56 -0600 Subject: [PATCH 076/395] read dep data from file; preserve seq_drydep_mod interface modified: cesm/nuopc_cap_share/seq_drydep_mod.F90 new file: cesm/nuopc_cap_share/shr_drydep_mod.F90 --- cesm/nuopc_cap_share/seq_drydep_mod.F90 | 1211 +---------------------- cesm/nuopc_cap_share/shr_drydep_mod.F90 | 653 ++++++++++++ 2 files changed, 661 insertions(+), 1203 deletions(-) create mode 100644 cesm/nuopc_cap_share/shr_drydep_mod.F90 diff --git a/cesm/nuopc_cap_share/seq_drydep_mod.F90 b/cesm/nuopc_cap_share/seq_drydep_mod.F90 index 0d98f5c85..780a6c611 100644 --- a/cesm/nuopc_cap_share/seq_drydep_mod.F90 +++ b/cesm/nuopc_cap_share/seq_drydep_mod.F90 @@ -1,1221 +1,26 @@ module seq_drydep_mod - !======================================================================== - ! Module for handling dry depostion of tracers. - ! This module is shared by land and atmosphere models for the computations of - ! dry deposition of tracers - !======================================================================== - - 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_kind_mod , only : r8 => shr_kind_r8, CS => SHR_KIND_CS, CX => SHR_KIND_CX - use shr_const_mod , only : SHR_CONST_G, SHR_CONST_RDAIR, SHR_CONST_CPDAIR, SHR_CONST_MWWV - use shr_mpi_mod , only : shr_mpi_bcast - use shr_nl_mod , only : shr_nl_find_group_name - use shr_log_mod , only : s_logunit => shr_log_Unit - use shr_infnan_mod , only : shr_infnan_posinf, assignment(=) + use shr_drydep_mod, only: seq_drydep_setHCoeff=>shr_drydep_setHCoeff + use shr_drydep_mod implicit none - private - - ! public member functions - public :: seq_drydep_readnl ! Read namelist - public :: seq_drydep_init ! Initialization of drydep data - public :: seq_drydep_setHCoeff ! Calculate Henry's law coefficients - - ! private array sizes - integer, public, parameter :: n_species_table = 192 ! Number of species to work with - integer, private, parameter :: maxspc = 210 ! Maximum number of species - integer, private, parameter :: NSeas = 5 ! Number of seasons - integer, private, parameter :: NLUse = 11 ! Number of land-use types - logical, private :: drydep_initialized = .false. - - ! public data members: ! method specification - character(16),public,parameter :: DD_XATM = 'xactive_atm' ! dry-dep atmosphere - character(16),public,parameter :: DD_XLND = 'xactive_lnd' ! dry-dep land - character(16),public,parameter :: DD_TABL = 'table' ! dry-dep table (atm and lnd) - character(16),public :: drydep_method = DD_XLND ! Which option choosen - - real(r8), public, parameter :: ph = 1.e-5_r8 ! measure of the acidity (dimensionless) - - logical, public :: lnd_drydep ! If dry-dep fields passed - integer, public :: n_drydep = 0 ! Number in drypdep list - logical :: drydep_init = .false. ! has seq_drydep_init been called? - character(len=CS), public, dimension(maxspc) :: drydep_list = '' ! List of dry-dep species - - real(r8), public, allocatable, dimension(:) :: foxd ! reactivity factor for oxidation (dimensioness) - real(r8), public, allocatable, dimension(:) :: drat ! ratio of molecular diffusivity (D_H2O/D_species; dimensionless) - integer, public, allocatable, dimension(:) :: mapping ! mapping to species table - - ! --- Indices for each species --- - integer, public :: h2_ndx, ch4_ndx, co_ndx, pan_ndx, mpan_ndx, so2_ndx, o3_ndx, o3a_ndx, xpan_ndx - - !--------------------------------------------------------------------------- - ! Table 1 from Wesely, Atmos. Environment, 1989, p1293 - ! Table 2 from Sheih, microfiche PB86-218104 and Walcek, Atmos. Environment, 1986, p949 - ! Table 3-5 compiled by P. Hess - ! - ! index #1 : season - ! 1 -> midsummer with lush vegetation - ! 2 -> autumn with unharvested cropland - ! 3 -> late autumn after frost, no snow - ! 4 -> winter, snow on ground, and subfreezing - ! 5 -> transitional spring with partially green short annuals - ! - ! index #2 : landuse type - ! 1 -> urban land - ! 2 -> agricultural land - ! 3 -> range land - ! 4 -> deciduous forest - ! 5 -> coniferous forest - ! 6 -> mixed forest including wetland - ! 7 -> water, both salt and fresh - ! 8 -> barren land, mostly desert - ! 9 -> nonforested wetland - ! 10 -> mixed agricultural and range land - ! 11 -> rocky open areas with low growing shrubs - ! - ! JFL August 2000 - !--------------------------------------------------------------------------- - - !--------------------------------------------------------------------------- - ! table to parameterize the impact of soil moisture on the deposition of H2 and - ! CO on soils (from Sanderson et al., J. Atmos. Chem., 46, 15-28, 2003). - !--------------------------------------------------------------------------- - - !--- deposition of h2 and CO on soils --- - real(r8), parameter, public :: h2_a(NLUse) = & - (/ 0.000_r8, 0.000_r8, 0.270_r8, 0.000_r8, 0.000_r8, & - 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8/) - !--- deposition of h2 and CO on soils --- - real(r8), parameter, public :: h2_b(NLUse) = & - (/ 0.000_r8,-41.390_r8, -0.472_r8,-41.900_r8,-41.900_r8, & - -41.900_r8, 0.000_r8, 0.000_r8, 0.000_r8,-41.390_r8, 0.000_r8/) - !--- deposition of h2 and CO on soils --- - real(r8), parameter, public :: h2_c(NLUse) = & - (/ 0.000_r8, 16.850_r8, 1.235_r8, 19.700_r8, 19.700_r8, & - 19.700_r8, 0.000_r8, 0.000_r8, 0.000_r8, 17.700_r8, 1.000_r8/) - - !--- deposition of h2 and CO on soils - ! - !--- ri: Richardson number (dimensionless) - !--- rlu: Resistance of leaves in upper canopy (s.m-1) - !--- rac: Aerodynamic resistance to lower canopy (s.m-1) - !--- rgss: Ground surface resistance for SO2 (s.m-1) - !--- rgso: Ground surface resistance for O3 (s.m-1) - !--- rcls: Lower canopy resistance for SO2 (s.m-1) - !--- rclo: Lower canopy resistance for O3 (s.m-1) - ! - real(r8), public, dimension(NSeas,NLUse) :: ri, rlu, rac, rgss, rgso, rcls, rclo - - data ri (1,1:NLUse) & - /1.e36_r8, 60._r8, 120._r8, 70._r8, 130._r8, 100._r8,1.e36_r8,1.e36_r8, 80._r8, 100._r8, 150._r8/ - data rlu (1,1:NLUse) & - /1.e36_r8,2000._r8,2000._r8,2000._r8,2000._r8,2000._r8,1.e36_r8,1.e36_r8,2500._r8,2000._r8,4000._r8/ - data rac (1,1:NLUse) & - / 100._r8, 200._r8, 100._r8,2000._r8,2000._r8,2000._r8, 0._r8, 0._r8, 300._r8, 150._r8, 200._r8/ - data rgss(1,1:NLUse) & - / 400._r8, 150._r8, 350._r8, 500._r8, 500._r8, 100._r8, 0._r8,1000._r8, 0._r8, 220._r8, 400._r8/ - data rgso(1,1:NLUse) & - / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ - data rcls(1,1:NLUse) & - /1.e36_r8,2000._r8,2000._r8,2000._r8,2000._r8,2000._r8,1.e36_r8,1.e36_r8,2500._r8,2000._r8,4000._r8/ - data rclo(1,1:NLUse) & - /1.e36_r8,1000._r8,1000._r8,1000._r8,1000._r8,1000._r8,1.e36_r8,1.e36_r8,1000._r8,1000._r8,1000._r8/ - - data ri (2,1:NLUse) & - /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 250._r8, 500._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ - data rlu (2,1:NLUse) & - /1.e36_r8,9000._r8,9000._r8,9000._r8,4000._r8,8000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ - data rac (2,1:NLUse) & - / 100._r8, 150._r8, 100._r8,1500._r8,2000._r8,1700._r8, 0._r8, 0._r8, 200._r8, 120._r8, 140._r8/ - data rgss(2,1:NLUse) & - / 400._r8, 200._r8, 350._r8, 500._r8, 500._r8, 100._r8, 0._r8,1000._r8, 0._r8, 300._r8, 400._r8/ - data rgso(2,1:NLUse) & - / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8, 800._r8, 180._r8, 200._r8/ - data rcls(2,1:NLUse) & - /1.e36_r8,9000._r8,9000._r8,9000._r8,2000._r8,4000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ - data rclo(2,1:NLUse) & - /1.e36_r8, 400._r8, 400._r8, 400._r8,1000._r8, 600._r8,1.e36_r8,1.e36_r8, 400._r8, 400._r8, 400._r8/ - - data ri (3,1:NLUse) & - /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 250._r8, 500._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ - data rlu (3,1:NLUse) & - /1.e36_r8,1.e36_r8,9000._r8,9000._r8,4000._r8,8000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ - data rac (3,1:NLUse) & - / 100._r8, 10._r8, 100._r8,1000._r8,2000._r8,1500._r8, 0._r8, 0._r8, 100._r8, 50._r8, 120._r8/ - data rgss(3,1:NLUse) & - / 400._r8, 150._r8, 350._r8, 500._r8, 500._r8, 200._r8, 0._r8,1000._r8, 0._r8, 200._r8, 400._r8/ - data rgso(3,1:NLUse) & - / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ - data rcls(3,1:NLUse) & - /1.e36_r8,1.e36_r8,9000._r8,9000._r8,3000._r8,6000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ - data rclo(3,1:NLUse) & - /1.e36_r8,1000._r8, 400._r8, 400._r8,1000._r8, 600._r8,1.e36_r8,1.e36_r8, 800._r8, 600._r8, 600._r8/ - - data ri (4,1:NLUse) & - /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 400._r8, 800._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ - data rlu (4,1:NLUse) & - /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,6000._r8,9000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ - data rac (4,1:NLUse) & - / 100._r8, 10._r8, 10._r8,1000._r8,2000._r8,1500._r8, 0._r8, 0._r8, 50._r8, 10._r8, 50._r8/ - data rgss(4,1:NLUse) & - / 100._r8, 100._r8, 100._r8, 100._r8, 100._r8, 100._r8, 0._r8,1000._r8, 100._r8, 100._r8, 50._r8/ - data rgso(4,1:NLUse) & - / 600._r8,3500._r8,3500._r8,3500._r8,3500._r8,3500._r8,2000._r8, 400._r8,3500._r8,3500._r8,3500._r8/ - data rcls(4,1:NLUse) & - /1.e36_r8,1.e36_r8,1.e36_r8,9000._r8, 200._r8, 400._r8,1.e36_r8,1.e36_r8,9000._r8,1.e36_r8,9000._r8/ - data rclo(4,1:NLUse) & - /1.e36_r8,1000._r8,1000._r8, 400._r8,1500._r8, 600._r8,1.e36_r8,1.e36_r8, 800._r8,1000._r8, 800._r8/ - - data ri (5,1:NLUse) & - /1.e36_r8, 120._r8, 240._r8, 140._r8, 250._r8, 190._r8,1.e36_r8,1.e36_r8, 160._r8, 200._r8, 300._r8/ - data rlu (5,1:NLUse) & - /1.e36_r8,4000._r8,4000._r8,4000._r8,2000._r8,3000._r8,1.e36_r8,1.e36_r8,4000._r8,4000._r8,8000._r8/ - data rac (5,1:NLUse) & - / 100._r8, 50._r8, 80._r8,1200._r8,2000._r8,1500._r8, 0._r8, 0._r8, 200._r8, 60._r8, 120._r8/ - data rgss(5,1:NLUse) & - / 500._r8, 150._r8, 350._r8, 500._r8, 500._r8, 200._r8, 0._r8,1000._r8, 0._r8, 250._r8, 400._r8/ - data rgso(5,1:NLUse) & - / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ - data rcls(5,1:NLUse) & - /1.e36_r8,4000._r8,4000._r8,4000._r8,2000._r8,3000._r8,1.e36_r8,1.e36_r8,4000._r8,4000._r8,8000._r8/ - data rclo(5,1:NLUse) & - /1.e36_r8,1000._r8, 500._r8, 500._r8,1500._r8, 700._r8,1.e36_r8,1.e36_r8, 600._r8, 800._r8, 800._r8/ - - !--------------------------------------------------------------------------- - ! ... roughness length - !--------------------------------------------------------------------------- - real(r8), public, dimension(NSeas,NLUse) :: z0 - - data z0 (1,1:NLUse) & - /1.000_r8,0.250_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.150_r8,0.100_r8,0.100_r8/ - data z0 (2,1:NLUse) & - /1.000_r8,0.100_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.100_r8,0.080_r8,0.080_r8/ - data z0 (3,1:NLUse) & - /1.000_r8,0.005_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.100_r8,0.020_r8,0.060_r8/ - data z0 (4,1:NLUse) & - /1.000_r8,0.001_r8,0.001_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.001_r8,0.001_r8,0.040_r8/ - data z0 (5,1:NLUse) & - /1.000_r8,0.030_r8,0.020_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.010_r8,0.030_r8,0.060_r8/ - - !real(r8), private, dimension(11,5), parameter :: z0xxx = reshape ( & - ! (/ 1.000,0.250,0.050,1.000,1.000,1.000,0.0006,0.002,0.150,0.100,0.100 , & - ! 1.000,0.100,0.050,1.000,1.000,1.000,0.0006,0.002,0.100,0.080,0.080 , & - ! 1.000,0.005,0.050,1.000,1.000,1.000,0.0006,0.002,0.100,0.020,0.060 , & - ! 1.000,0.001,0.001,1.000,1.000,1.000,0.0006,0.002,0.001,0.001,0.040 , & - ! 1.000,0.030,0.020,1.000,1.000,1.000,0.0006,0.002,0.010,0.030,0.060 /), (/11,5/) ) - - !--------------------------------------------------------------------------- - ! public chemical data - !--------------------------------------------------------------------------- - - !--- data for foxd (reactivity factor for oxidation) ---- - real(r8), public, parameter :: dfoxd(n_species_table) = & - (/ 1._r8 & ! OX - ,1._r8 & ! H2O2 - ,1._r8 & ! OH - ,.1_r8 & ! HO2 - ,1.e-36_r8 & ! CO - ,1.e-36_r8 & ! CH4 - ,1._r8 & ! CH3O2 - ,1._r8 & ! CH3OOH - ,1._r8 & ! CH2O - ,1._r8 & ! HCOOH - ,0._r8 & ! NO - ,.1_r8 & ! NO2 - ,1.e-36_r8 & ! HNO3 - ,1.e-36_r8 & ! CO2 - ,1.e-36_r8 & ! NH3 - ,.1_r8 & ! N2O5 - ,1._r8 & ! NO3 - ,1._r8 & ! CH3OH - ,.1_r8 & ! HO2NO2 - ,1._r8 & ! O1D - ,1.e-36_r8 & ! C2H6 - ,.1_r8 & ! C2H5O2 - ,.1_r8 & ! PO2 - ,.1_r8 & ! MACRO2 - ,.1_r8 & ! ISOPO2 - ,1.e-36_r8 & ! C4H10 - ,1._r8 & ! CH3CHO - ,1._r8 & ! C2H5OOH - ,1.e-36_r8 & ! C3H6 - ,1._r8 & ! POOH - ,1.e-36_r8 & ! C2H4 - ,.1_r8 & ! PAN - ,1._r8 & ! CH3COOOH - ,1.e-36_r8 & ! MTERP - ,1._r8 & ! GLYOXAL - ,1._r8 & ! CH3COCHO - ,1._r8 & ! GLYALD - ,.1_r8 & ! CH3CO3 - ,1.e-36_r8 & ! C3H8 - ,.1_r8 & ! C3H7O2 - ,1._r8 & ! CH3COCH3 - ,1._r8 & ! C3H7OOH - ,.1_r8 & ! RO2 - ,1._r8 & ! ROOH - ,1.e-36_r8 & ! Rn - ,1.e-36_r8 & ! ISOP - ,1._r8 & ! MVK - ,1._r8 & ! MACR - ,1._r8 & ! C2H5OH - ,1._r8 & ! ONITR - ,.1_r8 & ! ONIT - ,.1_r8 & ! ISOPNO3 - ,1._r8 & ! HYDRALD - ,1.e-36_r8 & ! HCN - ,1.e-36_r8 & ! CH3CN - ,1.e-36_r8 & ! SO2 - ,0.1_r8 & ! SOAGff0 - ,0.1_r8 & ! SOAGff1 - ,0.1_r8 & ! SOAGff2 - ,0.1_r8 & ! SOAGff3 - ,0.1_r8 & ! SOAGff4 - ,0.1_r8 & ! SOAGbg0 - ,0.1_r8 & ! SOAGbg1 - ,0.1_r8 & ! SOAGbg2 - ,0.1_r8 & ! SOAGbg3 - ,0.1_r8 & ! SOAGbg4 - ,0.1_r8 & ! SOAG0 - ,0.1_r8 & ! SOAG1 - ,0.1_r8 & ! SOAG2 - ,0.1_r8 & ! SOAG3 - ,0.1_r8 & ! SOAG4 - ,0.1_r8 & ! IVOC - ,0.1_r8 & ! SVOC - ,0.1_r8 & ! IVOCbb - ,0.1_r8 & ! IVOCff - ,0.1_r8 & ! SVOCbb - ,0.1_r8 & ! SVOCff - ,1.e-36_r8 & ! N2O - ,1.e-36_r8 & ! H2 - ,1.e-36_r8 & ! C2H2 - ,1._r8 & ! CH3COOH - ,1._r8 & ! EOOH - ,1._r8 & ! HYAC - ,1.e-36_r8 & ! BIGENE - ,1.e-36_r8 & ! BIGALK - ,1._r8 & ! MEK - ,1._r8 & ! MEKOOH - ,1._r8 & ! MACROOH - ,1._r8 & ! MPAN - ,1._r8 & ! ALKNIT - ,1._r8 & ! NOA - ,1._r8 & ! ISOPNITA - ,1._r8 & ! ISOPNITB - ,1._r8 & ! ISOPNOOH - ,1._r8 & ! NC4CHO - ,1._r8 & ! NC4CH2OH - ,1._r8 & ! TERPNIT - ,1._r8 & ! NTERPOOH - ,1._r8 & ! ALKOOH - ,1._r8 & ! BIGALD - ,1._r8 & ! HPALD - ,1._r8 & ! IEPOX - ,1._r8 & ! XOOH - ,1._r8 & ! ISOPOOH - ,1.e-36_r8 & ! TOLUENE - ,1._r8 & ! CRESOL - ,1._r8 & ! TOLOOH - ,1.e-36_r8 & ! BENZENE - ,1._r8 & ! PHENOL - ,1._r8 & ! BEPOMUC - ,1._r8 & ! PHENOOH - ,1._r8 & ! C6H5OOH - ,1._r8 & ! BENZOOH - ,1._r8 & ! BIGALD1 - ,1._r8 & ! BIGALD2 - ,1._r8 & ! BIGALD3 - ,1._r8 & ! BIGALD4 - ,1._r8 & ! TEPOMUC - ,1._r8 & ! BZOOH - ,1._r8 & ! BZALD - ,1._r8 & ! PBZNIT - ,1.e-36_r8 & ! XYLENES - ,1._r8 & ! XYLOL - ,1._r8 & ! XYLOLOOH - ,1._r8 & ! XYLENOOH - ,1.e-36_r8 & ! BCARY - ,1._r8 & ! TERPOOH - ,1._r8 & ! TERPROD1 - ,1._r8 & ! TERPROD2 - ,1._r8 & ! TERP2OOH - ,1.e-36_r8 & ! DMS - ,1.e-36_r8 & ! H2SO4 - ,1._r8 & ! HONITR - ,1._r8 & ! MACRN - ,1._r8 & ! MVKN - ,1._r8 & ! ISOPN2B - ,1._r8 & ! ISOPN3B - ,1._r8 & ! ISOPN4D - ,1._r8 & ! ISOPN1D - ,1._r8 & ! ISOPNOOHD - ,1._r8 & ! ISOPNOOHB - ,1._r8 & ! ISOPNBNO3 - ,1._r8 & ! NO3CH2CHO - ,1._r8 & ! HYPERACET - ,1._r8 & ! HCOCH2OOH - ,1._r8 & ! DHPMPAL - ,1._r8 & ! MVKOOH - ,1._r8 & ! ISOPOH - ,1._r8 & ! ISOPFDN - ,1._r8 & ! ISOPFNP - ,1._r8 & ! INHEB - ,1._r8 & ! HMHP - ,1._r8 & ! HPALD1 - ,1._r8 & ! INHED - ,1._r8 & ! HPALD4 - ,1._r8 & ! ISOPHFP - ,1._r8 & ! HPALDB1C - ,1._r8 & ! HPALDB4C - ,1._r8 & ! ICHE - ,1._r8 & ! ISOPFDNC - ,1._r8 & ! ISOPFNC - ,1._r8 & ! TERPNT - ,1._r8 & ! TERPNS - ,1._r8 & ! TERPNT1 - ,1._r8 & ! TERPNS1 - ,1._r8 & ! TERPNPT - ,1._r8 & ! TERPNPS - ,1._r8 & ! TERPNPT1 - ,1._r8 & ! TERPNPS1 - ,1._r8 & ! TERPFDN - ,1._r8 & ! SQTN - ,1._r8 & ! TERPHFN - ,1._r8 & ! TERP1OOH - ,1._r8 & ! TERPDHDP - ,1._r8 & ! TERPF2 - ,1._r8 & ! TERPF1 - ,1._r8 & ! TERPA - ,1._r8 & ! TERPA2 - ,1._r8 & ! TERPK - ,1._r8 & ! TERPAPAN - ,1._r8 & ! TERPACID - ,1._r8 & ! TERPA2PAN - ,1.e-36_r8 & ! APIN - ,1.e-36_r8 & ! BPIN - ,1.e-36_r8 & ! LIMON - ,1.e-36_r8 & ! MYRC - ,1._r8 & ! TERPACID2 - ,1._r8 & ! TERPACID3 - ,1._r8 & ! TERPA3PAN - ,1._r8 & ! TERPOOHL - ,1._r8 & ! TERPA3 - ,1._r8 & ! TERP2AOOH - /) + character(len=*), parameter :: DD_XLND = 'xactive_lnd' ! dry-dep land + character(len=*), parameter :: drydep_method = DD_XLND ! XLND is the only option now + logical, protected :: lnd_drydep - ! PRIVATE DATA: - - Interface seq_drydep_setHCoeff ! overload subroutine - Module Procedure set_hcoeff_scalar - Module Procedure set_hcoeff_vector - End Interface - - real(r8), private, parameter :: small_value = 1.e-36_r8 !--- smallest value to use --- - - !--------------------------------------------------------------------------- - ! private chemical data - !--------------------------------------------------------------------------- - - !--- Names of species that can work with --- - character(len=20), public, parameter :: species_name_table(n_species_table) = & - (/ 'OX ' & - ,'H2O2 ' & - ,'OH ' & - ,'HO2 ' & - ,'CO ' & - ,'CH4 ' & - ,'CH3O2 ' & - ,'CH3OOH ' & - ,'CH2O ' & - ,'HCOOH ' & - ,'NO ' & - ,'NO2 ' & - ,'HNO3 ' & - ,'CO2 ' & - ,'NH3 ' & - ,'N2O5 ' & - ,'NO3 ' & - ,'CH3OH ' & - ,'HO2NO2 ' & - ,'O1D ' & - ,'C2H6 ' & - ,'C2H5O2 ' & - ,'PO2 ' & - ,'MACRO2 ' & - ,'ISOPO2 ' & - ,'C4H10 ' & - ,'CH3CHO ' & - ,'C2H5OOH ' & - ,'C3H6 ' & - ,'POOH ' & - ,'C2H4 ' & - ,'PAN ' & - ,'CH3COOOH ' & - ,'MTERP ' & - ,'GLYOXAL ' & - ,'CH3COCHO ' & - ,'GLYALD ' & - ,'CH3CO3 ' & - ,'C3H8 ' & - ,'C3H7O2 ' & - ,'CH3COCH3 ' & - ,'C3H7OOH ' & - ,'RO2 ' & - ,'ROOH ' & - ,'Rn ' & - ,'ISOP ' & - ,'MVK ' & - ,'MACR ' & - ,'C2H5OH ' & - ,'ONITR ' & - ,'ONIT ' & - ,'ISOPNO3 ' & - ,'HYDRALD ' & - ,'HCN ' & - ,'CH3CN ' & - ,'SO2 ' & - ,'SOAGff0 ' & - ,'SOAGff1 ' & - ,'SOAGff2 ' & - ,'SOAGff3 ' & - ,'SOAGff4 ' & - ,'SOAGbg0 ' & - ,'SOAGbg1 ' & - ,'SOAGbg2 ' & - ,'SOAGbg3 ' & - ,'SOAGbg4 ' & - ,'SOAG0 ' & - ,'SOAG1 ' & - ,'SOAG2 ' & - ,'SOAG3 ' & - ,'SOAG4 ' & - ,'IVOC ' & - ,'SVOC ' & - ,'IVOCbb ' & - ,'IVOCff ' & - ,'SVOCbb ' & - ,'SVOCff ' & - ,'N2O ' & - ,'H2 ' & - ,'C2H2 ' & - ,'CH3COOH ' & - ,'EOOH ' & - ,'HYAC ' & - ,'BIGENE ' & - ,'BIGALK ' & - ,'MEK ' & - ,'MEKOOH ' & - ,'MACROOH ' & - ,'MPAN ' & - ,'ALKNIT ' & - ,'NOA ' & - ,'ISOPNITA ' & - ,'ISOPNITB ' & - ,'ISOPNOOH ' & - ,'NC4CHO ' & - ,'NC4CH2OH ' & - ,'TERPNIT ' & - ,'NTERPOOH ' & - ,'ALKOOH ' & - ,'BIGALD ' & - ,'HPALD ' & - ,'IEPOX ' & - ,'XOOH ' & - ,'ISOPOOH ' & - ,'TOLUENE ' & - ,'CRESOL ' & - ,'TOLOOH ' & - ,'BENZENE ' & - ,'PHENOL ' & - ,'BEPOMUC ' & - ,'PHENOOH ' & - ,'C6H5OOH ' & - ,'BENZOOH ' & - ,'BIGALD1 ' & - ,'BIGALD2 ' & - ,'BIGALD3 ' & - ,'BIGALD4 ' & - ,'TEPOMUC ' & - ,'BZOOH ' & - ,'BZALD ' & - ,'PBZNIT ' & - ,'XYLENES ' & - ,'XYLOL ' & - ,'XYLOLOOH ' & - ,'XYLENOOH ' & - ,'BCARY ' & - ,'TERPOOH ' & - ,'TERPROD1 ' & - ,'TERPROD2 ' & - ,'TERP2OOH ' & - ,'DMS ' & - ,'H2SO4 ' & - ,'HONITR ' & - ,'MACRN ' & - ,'MVKN ' & - ,'ISOPN2B ' & - ,'ISOPN3B ' & - ,'ISOPN4D ' & - ,'ISOPN1D ' & - ,'ISOPNOOHD' & - ,'ISOPNOOHB' & - ,'ISOPNBNO3' & - ,'NO3CH2CHO' & - ,'HYPERACET' & - ,'HCOCH2OOH' & - ,'DHPMPAL ' & - ,'MVKOOH ' & - ,'ISOPOH ' & - ,'ISOPFDN ' & - ,'ISOPFNP ' & - ,'INHEB ' & - ,'HMHP ' & - ,'HPALD1 ' & - ,'INHED ' & - ,'HPALD4 ' & - ,'ISOPHFP ' & - ,'HPALDB1C ' & - ,'HPALDB4C ' & - ,'ICHE ' & - ,'ISOPFDNC ' & - ,'ISOPFNC ' & - ,'TERPNT ' & - ,'TERPNS ' & - ,'TERPNT1 ' & - ,'TERPNS1 ' & - ,'TERPNPT ' & - ,'TERPNPS ' & - ,'TERPNPT1 ' & - ,'TERPNPS1 ' & - ,'TERPFDN ' & - ,'SQTN ' & - ,'TERPHFN ' & - ,'TERP1OOH ' & - ,'TERPDHDP ' & - ,'TERPF2 ' & - ,'TERPF1 ' & - ,'TERPA ' & - ,'TERPA2 ' & - ,'TERPK ' & - ,'TERPAPAN ' & - ,'TERPACID ' & - ,'TERPA2PAN' & - ,'APIN ' & - ,'BPIN ' & - ,'LIMON ' & - ,'MYRC ' & - ,'TERPACID2' & - ,'TERPACID3' & - ,'TERPA3PAN' & - ,'TERPOOHL ' & - ,'TERPA3 ' & - ,'TERP2AOOH' & - /) - - !--- data for effective Henry's Law coefficient --- - real(r8), public, parameter :: dheff(n_species_table*6) = & - (/1.03e-02_r8, 2830._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! OX - ,8.70e+04_r8, 7320._r8,2.2e-12_r8,-3730._r8,0._r8 , 0._r8 & ! H2O2 - ,3.90e+01_r8, 4300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! OH - ,6.90e+02_r8, 5900._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HO2 - ,9.81e-04_r8, 1650._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CO - ,1.41e-03_r8, 1820._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH4 - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3O2 - ,3.00e+02_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3OOH - ,3.23e+03_r8, 7100._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH2O - ,8.90e+03_r8, 6100._r8,1.8e-04_r8, -20._r8,0._r8 , 0._r8 & ! HCOOH - ,1.92e-03_r8, 1762._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NO - ,1.20e-02_r8, 2440._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NO2 - ,2.10e+05_r8, 8700._r8,2.2e+01_r8, 0._r8,0._r8 , 0._r8 & ! HNO3 - ,3.44e-02_r8, 2715._r8,4.3e-07_r8,-1000._r8,4.7e-11_r8,-1760._r8 & ! CO2 - ,6.02e+01_r8, 4160._r8,1.7e-05_r8,-4325._r8,1.0e-14_r8,-6716._r8 & ! NH3 - ,2.14e+00_r8, 3362._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! N2O5 - ,3.80e-02_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NO3 - ,2.03e+02_r8, 5645._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3OH - ,4.00e+01_r8, 8400._r8,1.3e-06_r8, 0._r8,0._r8 , 0._r8 & ! HO2NO2 - ,1.00e-16_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! O1D - ,1.88e-03_r8, 2750._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H6 - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H5O2 - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PO2 - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MACRO2 - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPO2 - ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C4H10 - ,1.29e+01_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3CHO - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H5OOH - ,5.57e-03_r8, 2800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C3H6 - ,1.50e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! POOH - ,5.96e-03_r8, 2200._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H4 - ,2.80e+00_r8, 5730._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PAN - ,8.37e+02_r8, 5310._r8,1.8e-04_r8, -20._r8,0._r8 , 0._r8 & ! CH3COOOH - ,2.94e-02_r8, 1800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MTERP - ,4.19e+05_r8, 7480._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! GLYOXAL - ,3.50e+03_r8, 7545._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3COCHO - ,4.00e+04_r8, 4630._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! GLYALD - ,1.00e-01_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3CO3 - ,1.51e-03_r8, 3120._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C3H8 - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C3H7O2 - ,2.78e+01_r8, 5530._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3COCH3 - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C3H7OOH - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! RO2 - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ROOH - ,0.00e+00_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! Rn - ,3.45e-02_r8, 4400._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOP - ,4.10e+01_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MVK - ,6.50e+00_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MACR - ,1.90e+02_r8, 6500._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H5OH - ,1.44e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ONITR - ,1.00e+03_r8, 6000._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ONIT - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNO3 - ,1.10e+05_r8, 6000._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HYDRALD - ,9.02e+00_r8, 8258._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HCN - ,5.28e+01_r8, 3970._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3CN - ,1.36e+00_r8, 3100._r8,1.30e-02_r8,1960._r8,6.6e-08_r8, 1500._r8 & ! SO2 - ,1.3e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff0 - ,3.2e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff1 - ,4.0e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff2 - ,1.3e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff3 - ,1.6e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff4 - ,7.9e+11_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg0 - ,6.3e+10_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg1 - ,3.2e+09_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg2 - ,6.3e+08_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg3 - ,3.2e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg4 - ,4.0e+11_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG0 - ,3.2e+10_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG1 - ,1.6e+09_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG2 - ,3.2e+08_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG3 - ,1.6e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG4 - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! IVOC - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SVOC - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! IVOCbb - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! IVOCff - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SVOCbb - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SVOCff - ,2.42e-02_r8, 2710._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! N2O - ,7.9e-04_r8, 530._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! H2 - ,4.14e-02_r8, 1890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H2 - ,4.1e+03_r8, 6200._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3COOH - ,1.9e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! EOOH - ,1.46e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HYAC - ,5.96e-03_r8, 2365._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGENE - ,1.24e-03_r8, 3010._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALK - ,1.80e+01_r8, 5740._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MEK - ,6.4e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MEKOOH - ,4.4e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MACROOH - ,1.72e+00_r8, 5700._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MPAN - ,1.01e+00_r8, 5790._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ALKNIT - ,1.e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NOA - ,8.34e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNITA - ,4.82e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNITB - ,8.75e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNOOH - ,1.46e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NC4CHO - ,4.02e+04_r8, 9500._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NC4CH2OH - ,8.41e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNIT - ,6.67e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NTERPOOH - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ALKOOH - ,9.6e+00_r8, 6220._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD - ,2.30e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALD - ,3.e+07_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! IEPOX - ,1.e+11_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XOOH - ,3.5e+06_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPOOH - ,1.5e-01_r8, 4300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TOLUENE - ,5.67e+02_r8, 5800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CRESOL - ,2.30e+04_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TOLOOH - ,1.8e-01_r8, 3800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BENZENE - ,2.84e+03_r8, 2700._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PHENOL - ,3.e+07_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BEPOMUC - ,1.5e+06_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PHENOOH - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C6H5OOH - ,2.3e+03_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BENZOOH - ,1.e+05_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD1 - ,2.9e+04_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD2 - ,2.2e+04_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD3 - ,2.2e+04_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD4 - ,2.5e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TEPOMUC - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BZOOH - ,3.24e+01_r8, 6300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BZALD - ,2.8e+00_r8, 5730._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PBZNIT - ,2.e-01_r8, 4300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XYLENES - ,1.01e+03_r8, 6800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XYLOL - ,1.9e+06_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XYLOLOOH - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XYLENOOH - ,5.57e-03_r8, 2800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BCARY - ,3.6e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPOOH - ,3.92e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPROD1 - ,7.20e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPROD2 - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERP2OOH - ,5.4e-01_r8, 3460._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! DMS - ,1.e+11_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! H2SO4 - ,2.64e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HONITR - ,4.14e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MACRN - ,1.84e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MVKN - ,8.34e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPN2B - ,8.34e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPN3B - ,4.82e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPN4D - ,4.82e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPN1D - ,9.67e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNOOHD - ,6.61e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNOOHB - ,8.34e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNBNO3 - ,3.39e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NO3CH2CHO - ,1.16e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HYPERACET - ,2.99e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HCOCH2OOH - ,9.37e+07_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! DHPMPAL - ,1.24e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MVKOOH - ,8.77e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPOH - ,5.02e+08_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPFDN - ,2.97e+11_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPFNP - ,1.05e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! INHEB - ,1.70e+06_r8, 9870._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HMHP - ,2.30e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALD1 - ,1.51e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! INHED - ,2.30e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALD4 - ,7.60e+09_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPHFP - ,5.43e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALDB1C - ,5.43e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALDB4C - ,2.09e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ICHE - ,7.16e+09_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPFDNC - ,1.41e+11_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPFNC - ,8.41e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNT - ,8.41e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNS - ,8.55e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNT1 - ,8.55e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNS1 - ,6.67e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNPT - ,6.67e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNPS - ,6.78e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNPT1 - ,6.78e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNPS1 - ,1.65e+09_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPFDN - ,9.04e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SQTN - ,7.53e+11_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPHFN - ,3.64e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERP1OOH - ,3.41e+14_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPDHDP - ,6.54e+01_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPF2 - ,4.05e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPF1 - ,3.92e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA - ,7.20e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA2 - ,6.39e+01_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPK - ,7.94e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPAPAN - ,5.63e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPACID - ,9.59e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA2PAN - ,2.94e-02_r8, 1800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! APIN - ,1.52e-02_r8, 4500._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BPIN - ,4.86e-02_r8, 4600._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! LIMON - ,7.30e-02_r8, 2800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MYRC - ,2.64e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPACID2 - ,3.38e+09_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPACID3 - ,1.23e+07_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA3PAN - ,4.41e+12_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPOOHL - ,1.04e+08_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA3 - ,3.67e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERP2AOOH - /) - - real(r8), private, parameter :: wh2o = SHR_CONST_MWWV - real(r8), private, parameter :: mol_wgts(n_species_table) = & - (/ 47.9981995_r8, 34.0135994_r8, 17.0067997_r8, 33.0061989_r8, 28.0104008_r8, & - 16.0405998_r8, 47.0320015_r8, 48.0393982_r8, 30.0251999_r8, 46.0246010_r8, & - 30.0061398_r8, 46.0055389_r8, 63.0123405_r8, 44.0098000_r8, 17.0289402_r8, & - 108.010483_r8, 62.0049400_r8, 32.0400009_r8, 79.0117416_r8, 15.9994001_r8, & - 30.0664005_r8, 61.0578003_r8, 91.0830002_r8, 119.093399_r8, 117.119797_r8, & - 58.1180000_r8, 44.0509987_r8, 62.0652008_r8, 42.0774002_r8, 92.0904007_r8, & - 28.0515995_r8, 121.047943_r8, 76.0497971_r8, 136.228394_r8, 58.0355988_r8, & - 72.0614014_r8, 60.0503998_r8, 75.0423965_r8, 44.0922012_r8, 75.0836029_r8, & - 58.0768013_r8, 76.0910034_r8, 89.070126_r8, 90.078067_r8, 222.000000_r8, & - 68.1141968_r8, 70.0877991_r8, 70.0877991_r8, 46.0657997_r8, 147.125946_r8, & - 119.074341_r8, 162.117935_r8, 100.112999_r8, 27.0256_r8 , 41.0524_r8 , & - 64.064800_r8, 250._r8, 250._r8, 250._r8, 250._r8, & - 250._r8, 250._r8, 250._r8, 250._r8, 250._r8, & - 250._r8, 250._r8, 250._r8, 250._r8, 250._r8, & - 250._r8, 170.3_r8, 170.3_r8, 170.3_r8, 170.3_r8, & - 170.3_r8, 170.3_r8, 44.0129_r8, 2.0148_r8, 26.0368_r8, & - 60.0504_r8, 78.0646_r8, 74.0762_r8, 56.1032_r8, 72.1438_r8, & - 72.1026_r8, 104.101_r8, 120.101_r8, 147.085_r8, 133.141_r8, & - 119.074_r8, 147.126_r8, 147.126_r8, 163.125_r8, 145.111_r8, & - 147.126_r8, 215.24_r8, 231.24_r8, 104.143_r8, 98.0982_r8, & - 116.112_r8, 118.127_r8, 150.126_r8, 118.127_r8, 92.1362_r8, & - 108.136_r8, 174.148_r8, 78.1104_r8, 94.1098_r8, 126.109_r8, & - 176.122_r8, 110.109_r8, 160.122_r8, 84.0724_r8, 98.0982_r8, & - 98.0982_r8, 112.124_r8, 140.134_r8, 124.135_r8, 106.121_r8, & - 183.118_r8, 106.162_r8, 122.161_r8, 204.173_r8, 188.174_r8, & - 204.343_r8, 186.241_r8, 168.227_r8, 154.201_r8, 200.226_r8, & - 62.1324_r8, 98.0784_r8, 135.118733_r8, 149.102257_r8, 149.102257_r8, & - 147.129469_r8, 147.129469_r8, 147.129469_r8, 147.129469_r8, 163.128874_r8, & - 163.128874_r8, 147.129469_r8, 105.049617_r8, 90.078067_r8, 76.05145_r8, & - 136.103494_r8, 120.104089_r8, 102.131897_r8, 226.141733_r8, 197.143565_r8, & - 163.128874_r8, 64.040714_r8, 116.11542_r8, 163.128874_r8, 116.11542_r8, & - 150.130112_r8, 116.11542_r8, 116.11542_r8, 116.11542_r8, 224.125851_r8, & - 195.127684_r8, 215.246675_r8, 215.246675_r8, 215.246675_r8, 215.246675_r8, & - 231.24608_r8, 231.24608_r8, 231.24608_r8, 231.24608_r8, 294.258938_r8, & - 283.36388_r8, 265.260771_r8, 186.248507_r8, 236.262604_r8, 110.153964_r8, & - 168.233221_r8, 168.233221_r8, 154.206603_r8, 138.207199_r8, 245.229603_r8, & - 200.232031_r8, 231.202986_r8, 136.228394_r8, 136.228394_r8, 136.228394_r8, & - 136.228394_r8, 186.205413_r8, 202.204818_r8, 247.202391_r8, 218.247317_r8, & - 170.206008_r8, 186.248507_r8 /) - - -!=============================================================================== -CONTAINS -!=============================================================================== +contains subroutine seq_drydep_readnl(NLFilename, drydep_nflds) - !======================================================================== - ! reads drydep_inparm namelist and determines the number of drydep velocity - ! fields that are sent from the land component - !======================================================================== - character(len=*), intent(in) :: NLFilename ! Namelist filename integer, intent(out) :: drydep_nflds - !----- local ----- - integer :: i ! Indices - integer :: unitn ! namelist unit number - integer :: ierr ! error code - logical :: exists ! if file exists or not - type(ESMF_VM) :: vm - integer :: localPet - integer :: mpicom - integer :: rc - character(*),parameter :: F00 = "('(seq_drydep_read) ',8a)" - character(*),parameter :: FI1 = "('(seq_drydep_init) ',a,I2)" - character(*),parameter :: subName = '(seq_drydep_read) ' - !----------------------------------------------------------------------------- - - namelist /drydep_inparm/ drydep_list, drydep_method - - !----------------------------------------------------------------------------- - ! Read namelist and figure out the drydep field list to pass - ! First check if file exists and if not, n_drydep will be zero - !----------------------------------------------------------------------------- + call shr_drydep_readnl(NLFilename, drydep_nflds) - rc = ESMF_SUCCESS - drydep_nflds = 0 - - !--- Open and read namelist --- - if ( len_trim(NLFilename) == 0 )then - call shr_sys_abort( subName//'ERROR: nlfilename not set' ) - end if - - 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' ) - write(s_logunit,F00) 'Read in drydep_inparm namelist from: ', trim(NLFilename) - call shr_nl_find_group_name(unitn, 'drydep_inparm', ierr) - if (ierr == 0) then - ! Note that ierr /= 0, no namelist is present. - read(unitn, drydep_inparm, iostat=ierr) - if (ierr > 0) then - call shr_sys_abort( 'problem on read of drydep_inparm namelist in seq_drydep_readnl') - end if - endif - close( unitn ) - end if - end if - call shr_mpi_bcast( drydep_list, mpicom ) - call shr_mpi_bcast( drydep_method, mpicom ) - - do i=1,maxspc - if(len_trim(drydep_list(i)) > 0) then - drydep_nflds=drydep_nflds+1 - endif - enddo - - ! set module variable - n_drydep = drydep_nflds - - ! Make sure method is valid and determine if land is passing drydep fields - lnd_drydep = (drydep_nflds>0 .and. drydep_method == DD_XLND) - if (localpet==0) then - write(s_logunit,*) 'seq_drydep_read: drydep_method: ', trim(drydep_method) - if ( drydep_nflds == 0 )then - write(s_logunit,F00) 'No dry deposition fields will be transfered' - else - write(s_logunit,FI1) 'Number of dry deposition fields transfered is ', drydep_nflds - end if - end if - - if ( trim(drydep_method)/=trim(DD_XATM) .and. & - trim(drydep_method)/=trim(DD_XLND) .and. & - trim(drydep_method)/=trim(DD_TABL) ) then - write(s_logunit,*) 'seq_drydep_read: drydep_method : ', trim(drydep_method) - write(s_logunit,*) 'seq_drydep_read: drydep_method must be set to : ', & - DD_XATM,', ', DD_XLND,', or ', DD_TABL - call shr_sys_abort('seq_drydep_read: incorrect dry deposition method specification') - endif - - if (.not. drydep_initialized) then - call seq_drydep_init() - end if + lnd_drydep = drydep_nflds>0 end subroutine seq_drydep_readnl -!==================================================================================== - - subroutine seq_drydep_init( ) - - !======================================================================== - ! Initialization of dry deposition fields - ! reads drydep_inparm namelist and sets up CCSM driver list of fields for - ! land-atmosphere communications. - !======================================================================== - - !----- local ----- - integer :: i, l ! Indices - character(len=32) :: test_name ! field test name - - !----- formats ----- - character(*),parameter :: subName = '(seq_drydep_init) ' - character(*),parameter :: F00 = "('(seq_drydep_init) ',8a)" - - !----------------------------------------------------------------------------- - ! Return if this routine has already been called (e.g. cam and clm both call this) - !----------------------------------------------------------------------------- - if(allocated(foxd)) return - !----------------------------------------------------------------------------- - ! Allocate and fill foxd, drat and mapping as well as species indices - !----------------------------------------------------------------------------- - - if ( n_drydep > 0 ) then - - allocate( foxd(n_drydep) ) - allocate( drat(n_drydep) ) - allocate( mapping(n_drydep) ) - - ! This initializes these variables to infinity. - foxd = shr_infnan_posinf - drat = shr_infnan_posinf - - mapping(:) = 0 - - end if - - h2_ndx=-1; ch4_ndx=-1; co_ndx=-1; mpan_ndx = -1; pan_ndx = -1; so2_ndx=-1; o3_ndx=-1; xpan_ndx=-1 - - !--- Loop over drydep species that need to be worked with --- - do i=1,n_drydep - if ( len_trim(drydep_list(i))==0 ) exit - - test_name = drydep_list(i) - - if( trim(test_name) == 'O3' ) then - test_name = 'OX' - end if - - !--- Figure out if species maps to a species in the species table --- - do l = 1,n_species_table - if( trim( test_name ) == trim( species_name_table(l) ) ) then - mapping(i) = l - exit - end if - end do - - !--- If it doesn't map to a species in the species table find species close enough --- - if( mapping(i) < 1 ) then - select case( trim(test_name) ) - case( 'O3S', 'O3INERT' ) - test_name = 'OX' - case( 'Pb' ) - test_name = 'HNO3' - case( 'SOGM','SOGI','SOGT','SOGB','SOGX' ) - test_name = 'CH3OOH' - case( 'SOA', 'SO4', 'CB1', 'CB2', 'OC1', 'OC2', 'NH4', 'SA1', 'SA2', 'SA3', 'SA4' ) - test_name = 'OX' ! this is just a place holder. values are explicitly set below - case( 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX' ) - test_name = 'OX' ! this is just a place holder. values are explicitly set below - case( 'SOAGbb0' ) - test_name = 'SOAGff0' - case( 'SOAGbb1' ) - test_name = 'SOAGff1' - case( 'SOAGbb2' ) - test_name = 'SOAGff2' - case( 'SOAGbb3' ) - test_name = 'SOAGff3' - case( 'SOAGbb4' ) - test_name = 'SOAGff4' - case( 'O3A' ) - test_name = 'OX' - case( 'XMPAN' ) - test_name = 'MPAN' - case( 'XPAN' ) - test_name = 'PAN' - case( 'XNO' ) - test_name = 'NO' - case( 'XNO2' ) - test_name = 'NO2' - case( 'XHNO3' ) - test_name = 'HNO3' - case( 'XONIT' ) - test_name = 'ONIT' - case( 'XONITR' ) - test_name = 'ONITR' - case( 'XHO2NO2') - test_name = 'HO2NO2' - case( 'XNH4NO3' ) - test_name = 'HNO3' - case( 'NH4NO3' ) - test_name = 'HNO3' - case default - test_name = 'blank' - end select - - !--- If found a match check the species table again --- - if( trim(test_name) /= 'blank' ) then - do l = 1,n_species_table - if( trim( test_name ) == trim( species_name_table(l) ) ) then - mapping(i) = l - exit - end if - end do - else - write(s_logunit,F00) trim(drydep_list(i)),' not in tables; will have dep vel = 0' - call shr_sys_abort( subName//': '//trim(drydep_list(i))//' is not in tables' ) - end if - end if - - !--- Figure out the specific species indices --- - if ( trim(drydep_list(i)) == 'H2' ) h2_ndx = i - if ( trim(drydep_list(i)) == 'CO' ) co_ndx = i - if ( trim(drydep_list(i)) == 'CH4' ) ch4_ndx = i - if ( trim(drydep_list(i)) == 'MPAN' ) mpan_ndx = i - if ( trim(drydep_list(i)) == 'PAN' ) pan_ndx = i - if ( trim(drydep_list(i)) == 'SO2' ) so2_ndx = i - if ( trim(drydep_list(i)) == 'OX' .or. trim(drydep_list(i)) == 'O3' ) o3_ndx = i - if ( trim(drydep_list(i)) == 'O3A' ) o3a_ndx = i - if ( trim(drydep_list(i)) == 'XPAN' ) xpan_ndx = i - - if( mapping(i) > 0) then - l = mapping(i) - foxd(i) = dfoxd(l) - drat(i) = sqrt(mol_wgts(l)/wh2o) - endif - - enddo - - where( rgss < 1._r8 ) - rgss = 1._r8 - endwhere - - where( rac < small_value) - rac = small_value - endwhere - - drydep_initialized = .true. - - end subroutine seq_drydep_init - -!==================================================================================== - - subroutine set_hcoeff_scalar( sfc_temp, heff ) - - !======================================================================== - ! Interface to seq_drydep_setHCoeff when input is scalar - ! wrapper routine used when surface temperature is a scalar (single column) rather - ! than an array (multiple columns). - ! - ! !REVISION HISTORY: - ! 2008-Nov-12 - F. Vitt - first version - !======================================================================== - - implicit none - - real(r8), intent(in) :: sfc_temp ! Input surface temperature - real(r8), intent(out) :: heff(n_drydep) ! Output Henry's law coefficients - - !----- local ----- - real(r8) :: sfc_temp_tmp(1) ! surface temp - - sfc_temp_tmp(:) = sfc_temp - call set_hcoeff_vector( 1, sfc_temp_tmp, heff(:n_drydep) ) - - end subroutine set_hcoeff_scalar - -!==================================================================================== - - subroutine set_hcoeff_vector( ncol, sfc_temp, heff ) - - !======================================================================== - ! Interface to seq_drydep_setHCoeff when input is vector - ! sets dry depositions coefficients -- used by both land and atmosphere models - !======================================================================== - - integer, intent(in) :: ncol ! Input size of surface-temp vector - real(r8), intent(in) :: sfc_temp(ncol) ! Surface temperature - real(r8), intent(out) :: heff(ncol,n_drydep) ! Henry's law coefficients - - !----- local ----- - real(r8), parameter :: t0 = 298._r8 ! Standard Temperature - real(r8), parameter :: ph_inv = 1._r8/ph ! Inverse of PH - integer :: m, l, id ! indices - real(r8) :: e298 ! Henry's law coefficient @ standard temperature (298K) - real(r8) :: dhr ! temperature dependence of Henry's law coefficient - real(r8) :: dk1s(ncol) ! DK Work array 1 - real(r8) :: dk2s(ncol) ! DK Work array 2 - real(r8) :: wrk(ncol) ! Work array - - !----- formats ----- - character(*),parameter :: subName = '(seq_drydep_set_hcoeff) ' - character(*),parameter :: F00 = "('(seq_drydep_set_hcoeff) ',8a)" - - !------------------------------------------------------------------------------- - ! notes: - !------------------------------------------------------------------------------- - - wrk(:) = (t0 - sfc_temp(:))/(t0*sfc_temp(:)) - do m = 1,n_drydep - l = mapping(m) - id = 6*(l - 1) - e298 = dheff(id+1) - dhr = dheff(id+2) - heff(:,m) = e298*exp( dhr*wrk(:) ) - !--- Calculate coefficients based on the drydep tables --- - if( dheff(id+3) /= 0._r8 .and. dheff(id+5) == 0._r8 ) then - e298 = dheff(id+3) - dhr = dheff(id+4) - dk1s(:) = e298*exp( dhr*wrk(:) ) - where( heff(:,m) /= 0._r8 ) - heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph_inv) - elsewhere - heff(:,m) = dk1s(:)*ph_inv - endwhere - end if - !--- For coefficients that are non-zero AND CO2 or NH3 handle things this way --- - if( dheff(id+5) /= 0._r8 ) then - if( trim( drydep_list(m) ) == 'CO2' .or. trim( drydep_list(m) ) == 'NH3' & - .or. trim( drydep_list(m) ) == 'SO2' ) then - e298 = dheff(id+3) - dhr = dheff(id+4) - dk1s(:) = e298*exp( dhr*wrk(:) ) - e298 = dheff(id+5) - dhr = dheff(id+6) - dk2s(:) = e298*exp( dhr*wrk(:) ) - !--- For Carbon dioxide --- - if( trim(drydep_list(m)) == 'CO2'.or. trim( drydep_list(m) ) == 'SO2' ) then - heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph_inv*(1._r8 + dk2s(:)*ph_inv)) - !--- For NH3 --- - else if( trim( drydep_list(m) ) == 'NH3' ) then - heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph/dk2s(:)) - !--- This can't happen --- - else - write(s_logunit,F00) 'Bad species ',drydep_list(m) - call shr_sys_abort( subName//'ERROR: in assigning coefficients' ) - end if - end if - end if - end do - - end subroutine set_hcoeff_vector - -!=============================================================================== - end module seq_drydep_mod diff --git a/cesm/nuopc_cap_share/shr_drydep_mod.F90 b/cesm/nuopc_cap_share/shr_drydep_mod.F90 new file mode 100644 index 000000000..561c14d1c --- /dev/null +++ b/cesm/nuopc_cap_share/shr_drydep_mod.F90 @@ -0,0 +1,653 @@ +module shr_drydep_mod + + !======================================================================== + ! Module for handling dry depostion of tracers. + ! This module is shared by land and atmosphere models for the computations of + ! dry deposition of tracers + !======================================================================== + + 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_kind_mod , only : r8 => shr_kind_r8, CS => SHR_KIND_CS, CX => SHR_KIND_CX + use shr_const_mod , only : SHR_CONST_MWWV + use shr_mpi_mod , only : shr_mpi_bcast + use shr_nl_mod , only : shr_nl_find_group_name + use shr_log_mod , only : s_logunit => shr_log_Unit + use shr_infnan_mod , only : shr_infnan_posinf, assignment(=) + + implicit none + private + + ! public member functions + public :: shr_drydep_readnl ! Read namelist + public :: shr_drydep_init ! Initialization of drydep data + public :: shr_drydep_setHCoeff ! Calculate Henry's law coefficients + + ! private array sizes + + integer, private, parameter :: maxspc = 210 ! Maximum number of species + integer, public, protected :: n_species_table ! Number of species to work with + integer, private, parameter :: NSeas = 5 ! Number of seasons + integer, public, parameter :: NLUse = 11 ! Number of land-use types + integer, private, protected :: NHen + + logical, private :: drydep_initialized = .false. + + ! public data members: + + real(r8), public, parameter :: ph = 1.e-5_r8 ! measure of the acidity (dimensionless) + + integer, public, protected :: n_drydep = 0 ! Number in drypdep list + character(len=32), public, protected :: drydep_list(maxspc) = '' ! List of dry-dep species + + character(len=CS), public, protected :: drydep_fields_token = '' ! First drydep fields token + + real(r8), public, allocatable, protected :: foxd(:) ! reactivity factor for oxidation (dimensioness) + real(r8), public, allocatable, protected :: drat(:) ! ratio of molecular diffusivity (D_H2O/D_species; dimensionless) + integer, public, allocatable, protected :: mapping(:) ! mapping to species table + ! --- Indices for each species --- + integer, public, protected :: h2_ndx, ch4_ndx, co_ndx, pan_ndx, mpan_ndx, so2_ndx, o3_ndx, o3a_ndx, xpan_ndx + + !--------------------------------------------------------------------------- + ! Table 1 from Wesely, Atmos. Environment, 1989, p1293 + ! Table 2 from Sheih, microfiche PB86-218104 and Walcek, Atmos. Environment, 1986, p949 + ! Table 3-5 compiled by P. Hess + ! + ! index #1 : season + ! 1 -> midsummer with lush vegetation + ! 2 -> autumn with unharvested cropland + ! 3 -> late autumn after frost, no snow + ! 4 -> winter, snow on ground, and subfreezing + ! 5 -> transitional spring with partially green short annuals + ! + ! index #2 : landuse type + ! 1 -> urban land + ! 2 -> agricultural land + ! 3 -> range land + ! 4 -> deciduous forest + ! 5 -> coniferous forest + ! 6 -> mixed forest including wetland + ! 7 -> water, both salt and fresh + ! 8 -> barren land, mostly desert + ! 9 -> nonforested wetland + ! 10 -> mixed agricultural and range land + ! 11 -> rocky open areas with low growing shrubs + ! + ! JFL August 2000 + !--------------------------------------------------------------------------- + + !--------------------------------------------------------------------------- + ! table to parameterize the impact of soil moisture on the deposition of H2 and + ! CO on soils (from Sanderson et al., J. Atmos. Chem., 46, 15-28, 2003). + !--------------------------------------------------------------------------- + + !--- deposition of h2 and CO on soils --- + real(r8), parameter, public :: h2_a(NLUse) = & + (/ 0.000_r8, 0.000_r8, 0.270_r8, 0.000_r8, 0.000_r8, & + 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8/) + !--- deposition of h2 and CO on soils --- + real(r8), parameter, public :: h2_b(NLUse) = & + (/ 0.000_r8,-41.390_r8, -0.472_r8,-41.900_r8,-41.900_r8, & + -41.900_r8, 0.000_r8, 0.000_r8, 0.000_r8,-41.390_r8, 0.000_r8/) + !--- deposition of h2 and CO on soils --- + real(r8), parameter, public :: h2_c(NLUse) = & + (/ 0.000_r8, 16.850_r8, 1.235_r8, 19.700_r8, 19.700_r8, & + 19.700_r8, 0.000_r8, 0.000_r8, 0.000_r8, 17.700_r8, 1.000_r8/) + + !--- deposition of h2 and CO on soils + ! + !--- ri: Richardson number (dimensionless) + !--- rlu: Resistance of leaves in upper canopy (s.m-1) + !--- rac: Aerodynamic resistance to lower canopy (s.m-1) + !--- rgss: Ground surface resistance for SO2 (s.m-1) + !--- rgso: Ground surface resistance for O3 (s.m-1) + !--- rcls: Lower canopy resistance for SO2 (s.m-1) + !--- rclo: Lower canopy resistance for O3 (s.m-1) + ! + real(r8), public, protected, dimension(NSeas,NLUse) :: ri, rlu, rac, rgss, rgso, rcls, rclo + + data ri (1,1:NLUse) & + /1.e36_r8, 60._r8, 120._r8, 70._r8, 130._r8, 100._r8,1.e36_r8,1.e36_r8, 80._r8, 100._r8, 150._r8/ + data rlu (1,1:NLUse) & + /1.e36_r8,2000._r8,2000._r8,2000._r8,2000._r8,2000._r8,1.e36_r8,1.e36_r8,2500._r8,2000._r8,4000._r8/ + data rac (1,1:NLUse) & + / 100._r8, 200._r8, 100._r8,2000._r8,2000._r8,2000._r8, 0._r8, 0._r8, 300._r8, 150._r8, 200._r8/ + data rgss(1,1:NLUse) & + / 400._r8, 150._r8, 350._r8, 500._r8, 500._r8, 100._r8, 0._r8,1000._r8, 0._r8, 220._r8, 400._r8/ + data rgso(1,1:NLUse) & + / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ + data rcls(1,1:NLUse) & + /1.e36_r8,2000._r8,2000._r8,2000._r8,2000._r8,2000._r8,1.e36_r8,1.e36_r8,2500._r8,2000._r8,4000._r8/ + data rclo(1,1:NLUse) & + /1.e36_r8,1000._r8,1000._r8,1000._r8,1000._r8,1000._r8,1.e36_r8,1.e36_r8,1000._r8,1000._r8,1000._r8/ + + data ri (2,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 250._r8, 500._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ + data rlu (2,1:NLUse) & + /1.e36_r8,9000._r8,9000._r8,9000._r8,4000._r8,8000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rac (2,1:NLUse) & + / 100._r8, 150._r8, 100._r8,1500._r8,2000._r8,1700._r8, 0._r8, 0._r8, 200._r8, 120._r8, 140._r8/ + data rgss(2,1:NLUse) & + / 400._r8, 200._r8, 350._r8, 500._r8, 500._r8, 100._r8, 0._r8,1000._r8, 0._r8, 300._r8, 400._r8/ + data rgso(2,1:NLUse) & + / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8, 800._r8, 180._r8, 200._r8/ + data rcls(2,1:NLUse) & + /1.e36_r8,9000._r8,9000._r8,9000._r8,2000._r8,4000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rclo(2,1:NLUse) & + /1.e36_r8, 400._r8, 400._r8, 400._r8,1000._r8, 600._r8,1.e36_r8,1.e36_r8, 400._r8, 400._r8, 400._r8/ + + data ri (3,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 250._r8, 500._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ + data rlu (3,1:NLUse) & + /1.e36_r8,1.e36_r8,9000._r8,9000._r8,4000._r8,8000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rac (3,1:NLUse) & + / 100._r8, 10._r8, 100._r8,1000._r8,2000._r8,1500._r8, 0._r8, 0._r8, 100._r8, 50._r8, 120._r8/ + data rgss(3,1:NLUse) & + / 400._r8, 150._r8, 350._r8, 500._r8, 500._r8, 200._r8, 0._r8,1000._r8, 0._r8, 200._r8, 400._r8/ + data rgso(3,1:NLUse) & + / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ + data rcls(3,1:NLUse) & + /1.e36_r8,1.e36_r8,9000._r8,9000._r8,3000._r8,6000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rclo(3,1:NLUse) & + /1.e36_r8,1000._r8, 400._r8, 400._r8,1000._r8, 600._r8,1.e36_r8,1.e36_r8, 800._r8, 600._r8, 600._r8/ + + data ri (4,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 400._r8, 800._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ + data rlu (4,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,6000._r8,9000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rac (4,1:NLUse) & + / 100._r8, 10._r8, 10._r8,1000._r8,2000._r8,1500._r8, 0._r8, 0._r8, 50._r8, 10._r8, 50._r8/ + data rgss(4,1:NLUse) & + / 100._r8, 100._r8, 100._r8, 100._r8, 100._r8, 100._r8, 0._r8,1000._r8, 100._r8, 100._r8, 50._r8/ + data rgso(4,1:NLUse) & + / 600._r8,3500._r8,3500._r8,3500._r8,3500._r8,3500._r8,2000._r8, 400._r8,3500._r8,3500._r8,3500._r8/ + data rcls(4,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,9000._r8, 200._r8, 400._r8,1.e36_r8,1.e36_r8,9000._r8,1.e36_r8,9000._r8/ + data rclo(4,1:NLUse) & + /1.e36_r8,1000._r8,1000._r8, 400._r8,1500._r8, 600._r8,1.e36_r8,1.e36_r8, 800._r8,1000._r8, 800._r8/ + + data ri (5,1:NLUse) & + /1.e36_r8, 120._r8, 240._r8, 140._r8, 250._r8, 190._r8,1.e36_r8,1.e36_r8, 160._r8, 200._r8, 300._r8/ + data rlu (5,1:NLUse) & + /1.e36_r8,4000._r8,4000._r8,4000._r8,2000._r8,3000._r8,1.e36_r8,1.e36_r8,4000._r8,4000._r8,8000._r8/ + data rac (5,1:NLUse) & + / 100._r8, 50._r8, 80._r8,1200._r8,2000._r8,1500._r8, 0._r8, 0._r8, 200._r8, 60._r8, 120._r8/ + data rgss(5,1:NLUse) & + / 500._r8, 150._r8, 350._r8, 500._r8, 500._r8, 200._r8, 0._r8,1000._r8, 0._r8, 250._r8, 400._r8/ + data rgso(5,1:NLUse) & + / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ + data rcls(5,1:NLUse) & + /1.e36_r8,4000._r8,4000._r8,4000._r8,2000._r8,3000._r8,1.e36_r8,1.e36_r8,4000._r8,4000._r8,8000._r8/ + data rclo(5,1:NLUse) & + /1.e36_r8,1000._r8, 500._r8, 500._r8,1500._r8, 700._r8,1.e36_r8,1.e36_r8, 600._r8, 800._r8, 800._r8/ + + !--------------------------------------------------------------------------- + ! ... roughness length + !--------------------------------------------------------------------------- + real(r8), public, protected, dimension(NSeas,NLUse) :: z0 + + data z0 (1,1:NLUse) & + /1.000_r8,0.250_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.150_r8,0.100_r8,0.100_r8/ + data z0 (2,1:NLUse) & + /1.000_r8,0.100_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.100_r8,0.080_r8,0.080_r8/ + data z0 (3,1:NLUse) & + /1.000_r8,0.005_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.100_r8,0.020_r8,0.060_r8/ + data z0 (4,1:NLUse) & + /1.000_r8,0.001_r8,0.001_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.001_r8,0.001_r8,0.040_r8/ + data z0 (5,1:NLUse) & + /1.000_r8,0.030_r8,0.020_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.010_r8,0.030_r8,0.060_r8/ + + !--------------------------------------------------------------------------- + ! public chemical data + !--------------------------------------------------------------------------- + + !--- data for foxd (reactivity factor for oxidation) ---- + real(r8), public, protected, allocatable :: dfoxd(:) + + ! PRIVATE DATA: + + Interface shr_drydep_setHCoeff + Module Procedure set_hcoeff_scalar + Module Procedure set_hcoeff_vector + End Interface + + real(r8), private, parameter :: small_value = 1.e-36_r8 !--- smallest value to use --- + + !--------------------------------------------------------------------------- + ! private chemical data + !--------------------------------------------------------------------------- + + !--- Names of species that can work with --- + character(len=16), public, protected, allocatable :: species_name_table(:) + + !--- data for effective Henry's Law coefficient --- + real(r8), public, protected, allocatable :: dheff(:,:) + + real(r8), private, parameter :: wh2o = SHR_CONST_MWWV + real(r8), allocatable :: mol_wgts(:) + + character(len=500) :: dep_data_file = 'NONE' ! complete file path + +!=============================================================================== +CONTAINS +!=============================================================================== + + subroutine shr_drydep_readnl(NLFilename, drydep_nflds) + + !======================================================================== + ! reads drydep_inparm namelist and determines the number of drydep velocity + ! fields that are sent from the land component + !======================================================================== + + character(len=*), intent(in) :: NLFilename ! Namelist filename + integer, intent(out) :: drydep_nflds + + !----- local ----- + integer :: i ! Indices + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not + type(ESMF_VM) :: vm + integer :: localPet + integer :: mpicom + integer :: rc + character(*),parameter :: F00 = "('(shr_drydep_read) ',8a)" + character(*),parameter :: FI1 = "('(shr_drydep_init) ',a,I2)" + character(*),parameter :: subName = '(shr_drydep_read) ' + !----------------------------------------------------------------------------- + + namelist /drydep_inparm/ drydep_list, dep_data_file + + !----------------------------------------------------------------------------- + ! Read namelist and figure out the drydep field list to pass + ! First check if file exists and if not, n_drydep 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 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' ) + write(s_logunit,F00) 'Read in drydep_inparm namelist from: ', trim(NLFilename) + call shr_nl_find_group_name(unitn, 'drydep_inparm', ierr) + if (ierr == 0) then + ! Note that ierr /= 0, no namelist is present. + read(unitn, drydep_inparm, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort( 'problem on read of drydep_inparm namelist in shr_drydep_readnl') + end if + endif + close( unitn ) + end if + end if + call shr_mpi_bcast( drydep_list, mpicom ) + call shr_mpi_bcast( dep_data_file, mpicom ) + + do i=1,maxspc + if(len_trim(drydep_list(i)) > 0) then + drydep_nflds=drydep_nflds+1 + endif + enddo + + ! set module variable + n_drydep = drydep_nflds + + if (localpet==0) then + if ( drydep_nflds == 0 )then + write(s_logunit,F00) 'No dry deposition fields will be transfered' + else + write(s_logunit,FI1) 'Number of dry deposition fields transfered is ', drydep_nflds + end if + end if + + if (.not. drydep_initialized) then + call shr_drydep_init() + end if + + end subroutine shr_drydep_readnl + +!==================================================================================== + + subroutine shr_drydep_init( ) + + use shr_pio_mod, only: shr_pio_getiosys, shr_pio_getiotype + use pio + use netcdf + + !======================================================================== + ! Initialization of dry deposition fields + ! reads drydep_inparm namelist and sets up CCSM driver list of fields for + ! land-atmosphere communications. + !======================================================================== + + !----- local ----- + integer :: i, l ! Indices + character(len=32) :: test_name ! field test name + integer :: dimid, varid, fileid + type(ESMF_VM) :: vm + integer :: localPet + integer :: mpicom + integer :: rc + + !----- formats ----- + character(*),parameter :: subName = '(shr_drydep_init) ' + character(*),parameter :: F00 = "('(shr_drydep_init) ',8a)" + + !----------------------------------------------------------------------------- + ! Return if this routine has already been called (e.g. cam and clm both call this) + !----------------------------------------------------------------------------- + if(allocated(foxd)) return + + if (dep_data_file=='NONE' .or. len_trim(dep_data_file)==0) return + + rc = ESMF_SUCCESS + + 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 + + rc = nf90_noerr + + if (localPet==0) then + rc = nf90_open(path=trim(dep_data_file), mode=nf90_nowrite, ncid=fileid) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: not able to open file: '//trim(dep_data_file)) + + rc = nf90_inq_dimid(fileid,'n_species_table',dimid) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_dimid n_species_table') + + rc = nf90_inquire_dimension(fileid,dimid,len=n_species_table) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inquire_dimension n_species_table') + + rc = nf90_inq_dimid(fileid,'NHen',dimid) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_dimid NHen') + + rc = nf90_inquire_dimension(fileid,dimid,len=nHen) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inquire_dimension nHen') + endif + call shr_mpi_bcast( n_species_table, mpicom ) + call shr_mpi_bcast( nHen, mpicom ) + + allocate( mol_wgts(n_species_table) ) + allocate( dfoxd(n_species_table) ) + allocate( species_name_table(n_species_table) ) + allocate( dheff(nhen,n_species_table)) + + if (localPet==0) then + rc = nf90_inq_varid(fileid,'mol_wghts',varid) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_varid mol_wghts') + rc = nf90_get_var(fileid,varid,mol_wgts) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_get_var mol_wgts') + + rc = nf90_inq_varid(fileid,'dfoxd',varid) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_varid dfoxd') + rc = nf90_get_var(fileid,varid,dfoxd) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_get_var dfoxd') + + rc = nf90_inq_varid(fileid,'species_name_table',varid) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_varid species_name_table') + rc = nf90_get_var(fileid,varid,species_name_table) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_get_var species_name_table') + + rc = nf90_inq_varid(fileid,'dheff',varid) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_varid dheff') + rc = nf90_get_var(fileid,varid,dheff) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_get_var dheff') + + rc = nf90_close(fileid) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_close') + end if + call shr_mpi_bcast( mol_wgts, mpicom ) + call shr_mpi_bcast( dfoxd, mpicom ) + call shr_mpi_bcast( species_name_table, mpicom ) + call shr_mpi_bcast( dheff, mpicom ) + + !----------------------------------------------------------------------------- + ! Allocate and fill foxd, drat and mapping as well as species indices + !----------------------------------------------------------------------------- + + if ( n_drydep > 0 ) then + + allocate( foxd(n_drydep) ) + allocate( drat(n_drydep) ) + allocate( mapping(n_drydep) ) + + ! This initializes these variables to infinity. + foxd = shr_infnan_posinf + drat = shr_infnan_posinf + + mapping(:) = 0 + + end if + + h2_ndx=-1; ch4_ndx=-1; co_ndx=-1; mpan_ndx = -1; pan_ndx = -1; so2_ndx=-1; o3_ndx=-1; xpan_ndx=-1 + + !--- Loop over drydep species that need to be worked with --- + do i=1,n_drydep + if ( len_trim(drydep_list(i))==0 ) exit + + test_name = drydep_list(i) + + if( trim(test_name) == 'O3' ) then + test_name = 'OX' + end if + + !--- Figure out if species maps to a species in the species table --- + do l = 1,n_species_table + if( trim( test_name ) == trim( species_name_table(l) ) ) then + mapping(i) = l + exit + end if + end do + + !--- If it doesn't map to a species in the species table find species close enough --- + if( mapping(i) < 1 ) then + select case( trim(test_name) ) + case( 'O3S', 'O3INERT' ) + test_name = 'OX' + case( 'Pb' ) + test_name = 'HNO3' + case( 'SOGM','SOGI','SOGT','SOGB','SOGX' ) + test_name = 'CH3OOH' + case( 'SOA', 'SO4', 'CB1', 'CB2', 'OC1', 'OC2', 'NH4', 'SA1', 'SA2', 'SA3', 'SA4' ) + test_name = 'OX' ! this is just a place holder. values are explicitly set below + case( 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX' ) + test_name = 'OX' ! this is just a place holder. values are explicitly set below + case( 'SOAGbb0' ) + test_name = 'SOAGff0' + case( 'SOAGbb1' ) + test_name = 'SOAGff1' + case( 'SOAGbb2' ) + test_name = 'SOAGff2' + case( 'SOAGbb3' ) + test_name = 'SOAGff3' + case( 'SOAGbb4' ) + test_name = 'SOAGff4' + case( 'O3A' ) + test_name = 'OX' + case( 'XMPAN' ) + test_name = 'MPAN' + case( 'XPAN' ) + test_name = 'PAN' + case( 'XNO' ) + test_name = 'NO' + case( 'XNO2' ) + test_name = 'NO2' + case( 'XHNO3' ) + test_name = 'HNO3' + case( 'XONIT' ) + test_name = 'ONIT' + case( 'XONITR' ) + test_name = 'ONITR' + case( 'XHO2NO2') + test_name = 'HO2NO2' + case( 'XNH4NO3' ) + test_name = 'HNO3' + case( 'NH4NO3' ) + test_name = 'HNO3' + case default + test_name = 'blank' + end select + + !--- If found a match check the species table again --- + if( trim(test_name) /= 'blank' ) then + do l = 1,n_species_table + if( trim( test_name ) == trim( species_name_table(l) ) ) then + mapping(i) = l + exit + end if + end do + else + write(s_logunit,F00) trim(drydep_list(i)),' not in tables; will have dep vel = 0' + call shr_sys_abort( subName//': '//trim(drydep_list(i))//' is not in tables' ) + end if + end if + + !--- Figure out the specific species indices --- + if ( trim(drydep_list(i)) == 'H2' ) h2_ndx = i + if ( trim(drydep_list(i)) == 'CO' ) co_ndx = i + if ( trim(drydep_list(i)) == 'CH4' ) ch4_ndx = i + if ( trim(drydep_list(i)) == 'MPAN' ) mpan_ndx = i + if ( trim(drydep_list(i)) == 'PAN' ) pan_ndx = i + if ( trim(drydep_list(i)) == 'SO2' ) so2_ndx = i + if ( trim(drydep_list(i)) == 'OX' .or. trim(drydep_list(i)) == 'O3' ) o3_ndx = i + if ( trim(drydep_list(i)) == 'O3A' ) o3a_ndx = i + if ( trim(drydep_list(i)) == 'XPAN' ) xpan_ndx = i + + if( mapping(i) > 0) then + l = mapping(i) + foxd(i) = dfoxd(l) + drat(i) = sqrt(mol_wgts(l)/wh2o) + endif + + enddo + + where( rgss < 1._r8 ) + rgss = 1._r8 + endwhere + + where( rac < small_value) + rac = small_value + endwhere + + drydep_initialized = .true. + + end subroutine shr_drydep_init + +!==================================================================================== + + subroutine set_hcoeff_scalar( sfc_temp, heff ) + + !======================================================================== + ! Interface to shr_drydep_setHCoeff when input is scalar + ! wrapper routine used when surface temperature is a scalar (single column) rather + ! than an array (multiple columns). + ! + ! !REVISION HISTORY: + ! 2008-Nov-12 - F. Vitt - first version + !======================================================================== + + implicit none + + real(r8), intent(in) :: sfc_temp ! Input surface temperature + real(r8), intent(out) :: heff(n_drydep) ! Output Henry's law coefficients + + !----- local ----- + real(r8) :: sfc_temp_tmp(1) ! surface temp + + sfc_temp_tmp(:) = sfc_temp + call set_hcoeff_vector( 1, sfc_temp_tmp, heff(:n_drydep) ) + + end subroutine set_hcoeff_scalar + +!==================================================================================== + + subroutine set_hcoeff_vector( ncol, sfc_temp, heff ) + + !======================================================================== + ! Interface to shr_drydep_setHCoeff when input is vector + ! sets dry depositions coefficients -- used by both land and atmosphere models + !======================================================================== + + integer, intent(in) :: ncol ! Input size of surface-temp vector + real(r8), intent(in) :: sfc_temp(ncol) ! Surface temperature + real(r8), intent(out) :: heff(ncol,n_drydep) ! Henry's law coefficients + + !----- local ----- + real(r8), parameter :: t0 = 298._r8 ! Standard Temperature + real(r8), parameter :: ph_inv = 1._r8/ph ! Inverse of PH + integer :: m, l ! indices + real(r8) :: e298 ! Henry's law coefficient @ standard temperature (298K) + real(r8) :: dhr ! temperature dependence of Henry's law coefficient + real(r8) :: dk1s(ncol) ! DK Work array 1 + real(r8) :: dk2s(ncol) ! DK Work array 2 + real(r8) :: wrk(ncol) ! Work array + + !----- formats ----- + character(*),parameter :: subName = '(shr_drydep_set_hcoeff) ' + character(*),parameter :: F00 = "('(shr_drydep_set_hcoeff) ',8a)" + + !------------------------------------------------------------------------------- + ! notes: + !------------------------------------------------------------------------------- + + wrk(:) = (t0 - sfc_temp(:))/(t0*sfc_temp(:)) + do m = 1,n_drydep + l = mapping(m) + e298 = dheff(1,l) + dhr = dheff(2,l) + heff(:,m) = e298*exp( dhr*wrk(:) ) + !--- Calculate coefficients based on the drydep tables --- + if( dheff(3,l) /= 0._r8 .and. dheff(5,l) == 0._r8 ) then + e298 = dheff(3,l) + dhr = dheff(4,l) + dk1s(:) = e298*exp( dhr*wrk(:) ) + where( heff(:,m) /= 0._r8 ) + heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph_inv) + elsewhere + heff(:,m) = dk1s(:)*ph_inv + endwhere + end if + !--- For coefficients that are non-zero AND CO2 or NH3 handle things this way --- + if( dheff(5,l) /= 0._r8 ) then + if( trim( drydep_list(m) ) == 'CO2' .or. trim( drydep_list(m) ) == 'NH3' .or. trim( drydep_list(m) ) == 'SO2' ) then + e298 = dheff(3,l) + dhr = dheff(4,l) + dk1s(:) = e298*exp( dhr*wrk(:) ) + e298 = dheff(5,l) + dhr = dheff(6,l) + dk2s(:) = e298*exp( dhr*wrk(:) ) + !--- For Carbon dioxide --- + if( trim(drydep_list(m)) == 'CO2'.or. trim( drydep_list(m) ) == 'SO2' ) then + heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph_inv*(1._r8 + dk2s(:)*ph_inv)) + !--- For NH3 --- + else if( trim( drydep_list(m) ) == 'NH3' ) then + heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph/dk2s(:)) + !--- This can't happen --- + else + write(s_logunit,F00) 'Bad species ',drydep_list(m) + call shr_sys_abort( subName//'ERROR: in assigning coefficients' ) + end if + end if + end if + end do + + end subroutine set_hcoeff_vector + +!=============================================================================== + +end module shr_drydep_mod From c7e92a6c6bf1e4f1bf2b466d4e75e0b0b4afb56c Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Wed, 25 May 2022 01:51:25 -0500 Subject: [PATCH 077/395] update to fix ORT issues --- mediator/med_phases_aofluxes_mod.F90 | 8 +- mediator/med_phases_prep_atm_mod.F90 | 3 +- ufs/flux_atmocn_ccpp_mod.F90 | 37 ++------ ufs/ufs_io_mod.F90 | 137 +++++++++++++++++---------- 4 files changed, 101 insertions(+), 84 deletions(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index a6695a77e..582a622a4 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1071,7 +1071,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evp=aoflux_out%evap, & taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & duu10n=aoflux_out%duu10n, ustar_sv=aoflux_out%ustar, re_sv=aoflux_out%re, ssq_sv=aoflux_out%ssq, & - missval=0.0_r8, rh=rh_agrid2xgrid_2ndord) + missval=0.0_r8) else #endif call flux_atmocn (logunit=logunit, & @@ -1142,7 +1142,7 @@ subroutine med_aofluxes_map_ogrid2agrid_input(gcomp, rc) real(r8), pointer :: data_dst(:) integer :: nf,n integer :: maptype - character(*),parameter :: subName = '(med_aofluxes_map_ogrid2agrid_output) ' + character(*),parameter :: subName = '(med_aofluxes_map_ogrid2agrid_input) ' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1211,7 +1211,7 @@ subroutine med_aofluxes_map_agrid2xgrid_input(gcomp, rc) type(ESMF_Field) :: field_src type(ESMF_Field) :: field_dst integer :: nf - character(*),parameter :: subName = '(med_aofluxes_map_ogrid2agrid_output) ' + character(*),parameter :: subName = '(med_aofluxes_map_agrid2xgrid_input) ' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1268,7 +1268,7 @@ subroutine med_aofluxes_map_ogrid2xgrid_input(gcomp, rc) type(ESMF_Field) :: field_src type(ESMF_Field) :: field_dst integer :: nf - character(*),parameter :: subName = '(med_aofluxes_map_ogrid2agrid_output) ' + character(*),parameter :: subName = '(med_aofluxes_map_ogrid2xgrid_input) ' !----------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 0715def68..8d41adbb8 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -115,7 +115,8 @@ subroutine med_phases_prep_atm(gcomp, rc) !--------------------------------------- if (trim(coupling_mode) == 'cesm' .or. & trim(coupling_mode) == 'hafs' .or. & - trim(coupling_mode) == 'nems_frac_aoflux') then + trim(coupling_mode) == 'nems_frac_aoflux' .or. & + trim(coupling_mode) == 'nems_frac_aoflux_sbs') then if (is_local%wrap%aoflux_grid == 'ogrid') then call med_aofluxes_map_ogrid2agrid_output(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index 22f590c55..45caee98b 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -4,7 +4,7 @@ module flux_atmocn_ccpp_mod use ESMF, only : ESMF_GridComp, ESMF_Time, ESMF_SUCCESS, ESMF_FAILURE use ESMF, only : ESMF_Clock, ESMF_TimeInterval, ESMF_ClockGet use ESMF, only : ESMF_GridCompGetInternalState, ESMF_LOGMSG_INFO - use ESMF, only : ESMF_RouteHandle, ESMF_LogWrite + use ESMF, only : ESMF_LogWrite use NUOPC, only : NUOPC_CompAttributeGet use NUOPC_Mediator, only : NUOPC_MediatorGet @@ -35,7 +35,6 @@ module flux_atmocn_ccpp_mod public :: flux_atmOcn_ccpp ! computes atm/ocn fluxes integer, save :: restart_freq - integer, save :: layout(2) real(r8), save :: semis_water character(len=cs), save :: starttype character(len=cl), save :: ini_file @@ -51,7 +50,7 @@ module flux_atmocn_ccpp_mod contains !=============================================================================== - subroutine flux_atmOcn_ccpp(gcomp, rh, mastertask, logunit, nMax, mask, psfc, pbot, & + subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, & tbot, qbot, zbot, garea, ubot, usfc, vbot, vsfc, rbot, ts, lwdn, sen, lat, & lwup, evp, taux, tauy, tref, qref, duu10n, ustar_sv, re_sv, ssq_sv, missval) @@ -59,7 +58,6 @@ subroutine flux_atmOcn_ccpp(gcomp, rh, mastertask, logunit, nMax, mask, psfc, pb !--- input arguments -------------------------------- type(ESMF_GridComp), intent(in) :: gcomp ! gridded component - type(ESMF_RouteHandle), intent(in) :: rh ! route handle to map atm->xgrid logical , intent(in) :: mastertask ! master task integer , intent(in) :: logunit ! log file unit number integer , intent(in) :: nMax ! data vector length @@ -270,24 +268,6 @@ subroutine flux_atmOcn_ccpp(gcomp, rh, mastertask, logunit, nMax, mask, psfc, pb input_dir = "INPUT/" end if - ! layout to to read tiled CS grid files - call NUOPC_CompAttributeGet(gcomp, name='ccpp_ini_layout', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - do n = 1, 2 - call string_listGetName(cvalue, n, cname, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (rc == ESMF_FAILURE) return - read(cname,*) layout(n) - end do - else - if (trim(rst_file) == 'unset') then - call ESMF_LogWrite(trim(subname)//': ccpp_ini_layout is required to read tiled initial condition!', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - end if - if (mastertask) then write(logunit,*) '========================================================' write(logunit,'(a,f5.2)') trim(subname)//' ccpp_phy_semis_water = ', semis_water @@ -305,9 +285,6 @@ subroutine flux_atmOcn_ccpp(gcomp, rh, mastertask, logunit, nMax, mask, psfc, pb write(logunit,'(a)') trim(subname)//' ccpp_ini_mosaic_file = '//trim(mosaic_file) write(logunit,'(a)') trim(subname)//' ccpp_input_dir = '//trim(input_dir) write(logunit,'(a)') trim(subname)//' ccpp_restart_file = '//trim(rst_file) - do n = 1, 2 - write(logunit,'(a,i1,a,i2)') trim(subname)//' ccpp_ini_layout(',n,') = ', layout(n) - end do write(logunit,*) '========================================================' end if @@ -315,11 +292,11 @@ subroutine flux_atmOcn_ccpp(gcomp, rh, mastertask, logunit, nMax, mask, psfc, pb call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) starttype - if (trim(starttype) == trim('startup')) then - call read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rh, rc) - else - call read_restart(gcomp, rst_file, rc) - end if + !if (trim(starttype) == trim('startup')) then + ! call read_initial(gcomp, ini_file, mosaic_file, input_dir, rc) + !else + ! call read_restart(gcomp, rst_file, rc) + !end if ! run CCPP init ! TODO: suite name need to be provided by ESMF config file diff --git a/ufs/ufs_io_mod.F90 b/ufs/ufs_io_mod.F90 index ae1063b81..82dd80ba7 100644 --- a/ufs/ufs_io_mod.F90 +++ b/ufs/ufs_io_mod.F90 @@ -19,7 +19,8 @@ module ufs_io_mod use ESMF, only : ESMF_Time, ESMF_TimeGet, ESMF_TimeInterval use ESMF, only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet use ESMF, only : ESMF_FieldBundleRemove, ESMF_FieldBundleDestroy - use ESMF, only : ESMF_FieldBundleRead, ESMF_FieldBundleWrite + use ESMF, only : ESMF_FieldWrite, ESMF_FieldBundleRead, ESMF_FieldBundleWrite + use ESMF, only : ESMF_REGRIDMETHOD_CONSERVE_2ND, ESMF_MeshCreate use NUOPC, only : NUOPC_CompAttributeGet use NUOPC_Mediator, only : NUOPC_MediatorGet @@ -28,7 +29,7 @@ module ufs_io_mod use mosaic2_mod, only : get_mosaic_ntiles, get_mosaic_grid_sizes use mosaic2_mod, only : get_mosaic_contact, get_mosaic_ncontacts use mpp_mod, only : mpp_pe, mpp_root_pe, mpp_error, FATAL - use mpp_domains_mod, only : mpp_get_compute_domain + use mpp_domains_mod, only : mpp_define_layout, mpp_get_compute_domain use mpp_domains_mod, only : mpp_domains_init, mpp_define_mosaic, domain2d use mpp_io_mod, only : MPP_RDONLY, MPP_NETCDF, MPP_SINGLE, MPP_MULTI use mpp_io_mod, only : mpp_get_info, mpp_get_fields, mpp_get_atts @@ -58,7 +59,8 @@ module ufs_io_mod type domain_type type(ESMF_Grid) :: grid ! ESMF grid object from mosaic file - type(ESMF_RouteHandle) :: rh ! ESMF route handle object to transfer data from grid to mesh + type(ESMF_Mesh) :: mesh ! ESMF mesh object from CS grid + type(ESMF_RouteHandle) :: rh ! ESMF routehandle object to redist data from CS grid to mesh type(domain2d) :: mosaic_domain ! domain object created by FMS integer :: layout(2) ! layout for domain decomposition integer, allocatable :: nit(:) ! size of tile in i direction @@ -87,7 +89,8 @@ module ufs_io_mod contains !=============================================================================== - subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rh_a2x, rc) + subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, rc) + implicit none ! input/output variables @@ -95,14 +98,12 @@ subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rh_a2x, character(len=cl), intent(in) :: ini_file character(len=cl), intent(in) :: mosaic_file character(len=cl), intent(in) :: input_dir - integer :: layout(2) - type(ESMF_RouteHandle) :: rh_a2x integer, intent(inout) :: rc ! local variables type(domain_type) :: domain type(InternalState) :: is_local - type(ESMF_Mesh) :: atm_mesh + type(ESMF_RouteHandle) :: rh type(ESMF_Field) :: lfield, field, field_dst real(ESMF_KIND_R8), pointer :: ptr(:) integer :: n @@ -121,7 +122,6 @@ subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rh_a2x, ! Create domain ! --------------------- - domain%layout(:) = layout(:) call create_fms_domain(gcomp, domain, mosaic_file, rc) ! --------------------- @@ -130,15 +130,6 @@ subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rh_a2x, call create_grid(gcomp, domain, mosaic_file, input_dir, rc) - ! --------------------- - ! Determine atm mesh - ! --------------------- - - call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm,compatm), fieldname='Sa_z', field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, mesh=atm_mesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - !---------------------- ! Read data !---------------------- @@ -148,7 +139,7 @@ subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rh_a2x, 'uustar' /) do n = 1,size(flds) ! read from tiled file - call read_tiled_file(gcomp, ini_file, trim(flds(n)), domain, field, atm_mesh, rc=rc) + call read_tiled_file(gcomp, ini_file, trim(flds(n)), domain, field, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! create destination field @@ -157,17 +148,18 @@ subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rh_a2x, if (ChkErr(rc,__LINE__,u_FILE_u)) return ! map field - if (is_local%wrap%aoflux_grid == 'ogrid') then ! aoflux_grid is ocn - ! remap from atm to ocn - call ESMF_FieldRegrid(field, field_dst, is_local%wrap%RH(compatm,compocn,mapconsf), rc=rc) + if (is_local%wrap%aoflux_grid == 'ogrid' .or. is_local%wrap%aoflux_grid == 'xgrid') then + ! create rh + call ESMF_FieldRegridStore(field, field_dst, routehandle=rh, & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! remap from atm to ocn/xgrid + call ESMF_FieldRegrid(field, field_dst, rh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (is_local%wrap%aoflux_grid == 'agrid') then ! aoflux_grid is atm + else ! do nothing, use source field field_dst = field - else if (is_local%wrap%aoflux_grid == 'xgrid') then ! aoflux_grid is exchange - ! remap from atm to exchange grid - call ESMF_FieldRegrid(field, field_dst, rh_a2x, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! debug @@ -352,8 +344,8 @@ subroutine create_fms_domain(gcomp, domain, mosaic_file, rc) ! local variables type(ESMF_VM) :: vm type(FmsNetcdfFile_t) :: mosaic_fileobj - integer :: mpicomm - integer :: n, ntiles + integer :: mpicomm, npes_per_tile + integer :: n, ntiles, npet integer :: halo = 0 integer :: global_indices(4,6) integer :: layout2d(2,6) @@ -372,7 +364,7 @@ subroutine create_fms_domain(gcomp, domain, mosaic_file, rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm=vm, mpiCommunicator=mpicomm, rc=rc) + call ESMF_VMGet(vm=vm, mpiCommunicator=mpicomm, petCount=npet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call fms_init(mpicomm) @@ -416,7 +408,7 @@ subroutine create_fms_domain(gcomp, domain, mosaic_file, rc) domain%istart2, domain%iend2, domain%jstart2, domain%jend2) ! print out debug information - if (dbug_flag > 5) then + if (dbug_flag > 2) then do n = 1, domain%ncontacts write(msg, fmt='(A,I2,A,2I5)') trim(subname)//' : tile1, tile2 (', n ,') = ', domain%tile1(n), domain%tile2(n) call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) @@ -435,6 +427,42 @@ subroutine create_fms_domain(gcomp, domain, mosaic_file, rc) call mpp_domains_init() + !---------------------- + ! Find out layout that will be used to read the data + !---------------------- + + ! setup global indices + do n = 1, domain%ntiles + global_indices(1,n) = 1 + global_indices(2,n) = domain%nit(n) + global_indices(3,n) = 1 + global_indices(4,n) = domain%njt(n) + end do + + ! check total number of PETs + if (mod(npet, domain%ntiles)) then + write(msg, fmt='(A,I5)') trim(subname)//' : nPet should be multiple of 6 to read initial conditions but it is ', npet + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + end if + + ! calculate layout + npes_per_tile = npet/domain%ntiles + call mpp_define_layout(global_indices(:,1), npes_per_tile, domain%layout) + + ! set layout and print out debug information + do n = 1, domain%ntiles + layout2d(:,n) = domain%layout(:) + if (dbug_flag > 2) then + write(msg, fmt='(A,I2,A,2I5)') trim(subname)//' layout (', n ,') = ', layout2d(1,n), layout2d(2,n) + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + write(msg, fmt='(A,I2,A,4I5)') trim(subname)//' global_indices (', n,') = ', & + global_indices(1,n), global_indices(2,n), global_indices(3,n), global_indices(4,n) + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + end if + enddo + !---------------------- ! Set pe_start, pe_end !---------------------- @@ -444,7 +472,7 @@ subroutine create_fms_domain(gcomp, domain, mosaic_file, rc) do n = 1, domain%ntiles pe_start(n) = mpp_root_pe()+(n-1)*domain%layout(1)*domain%layout(2) pe_end(n) = mpp_root_pe()+n*domain%layout(1)*domain%layout(2)-1 - if (dbug_flag > 5) then + if (dbug_flag > 2) then write(msg, fmt='(A,I2,A,2I5)') trim(subname)//' pe_start, pe_end (', n ,') = ', pe_start(n), pe_end(n) call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) end if @@ -454,14 +482,6 @@ subroutine create_fms_domain(gcomp, domain, mosaic_file, rc) ! Create FMS domain object !---------------------- - do n = 1, domain%ntiles - layout2d(:,n) = domain%layout(:) - global_indices(1,n) = 1 - global_indices(2,n) = domain%nit(n) - global_indices(3,n) = 1 - global_indices(4,n) = domain%njt(n) - enddo - call mpp_define_mosaic(global_indices, layout2d, domain%mosaic_domain, & domain%ntiles, domain%ncontacts, domain%tile1, domain%tile2, & domain%istart1, domain%iend1, domain%jstart1, domain%jend1, & @@ -517,12 +537,16 @@ subroutine create_grid(gcomp, domain, mosaic_file, input_dir, rc) indexflag=ESMF_INDEX_GLOBAL, name='input_grid', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! create mesh + domain%mesh = ESMF_MeshCreate(domain%grid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine create_grid !=============================================================================== - subroutine read_tiled_file(gcomp, filename, varname, domain, field_dst, mesh, rc) + subroutine read_tiled_file(gcomp, filename, varname, domain, field_dst, rc) implicit none ! input/output variables @@ -531,7 +555,6 @@ subroutine read_tiled_file(gcomp, filename, varname, domain, field_dst, mesh, rc character(len=*), intent(in) :: varname type(domain_type), intent(inout) :: domain type(ESMF_Field), intent(inout) :: field_dst - type(ESMF_Mesh), intent(in) :: mesh integer, intent(inout), optional :: rc ! local variables @@ -634,7 +657,7 @@ subroutine read_tiled_file(gcomp, filename, varname, domain, field_dst, mesh, rc if (allocated(rdata)) deallocate(rdata) ! create destination field - field_dst = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=trim(varname), & + field_dst = ESMF_FieldCreate(domain%mesh, ESMF_TYPEKIND_R8, name=trim(varname), & meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -648,19 +671,24 @@ subroutine read_tiled_file(gcomp, filename, varname, domain, field_dst, mesh, rc call ESMF_FieldRedist(field_src, field_dst, domain%rh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! clean memory - call ESMF_FieldDestroy(field_src, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - !---------------------- ! Output result field for debugging purpose !---------------------- + if (dbug_flag > 2) then + call ESMF_FieldWrite(field_dst, trim(varname)//'agrid', variableName=trim(varname), overwrite=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (dbug_flag > 5) then - call ESMF_FieldWriteVTK(field_dst, trim(varname)//'_agrid', rc=rc) + call ESMF_FieldWriteVTK(field_dst, trim(varname)//'agrid', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + ! clean memory + call ESMF_FieldDestroy(field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine read_tiled_file !=============================================================================== @@ -687,8 +715,6 @@ subroutine write_restart(gcomp, restart_freq, rc) real(r8) :: time_val real(r8) :: time_bnds(2) real(r8), pointer :: ptr(:) - logical :: whead(2) = (/.true. , .false./) - logical :: wdata(2) = (/.false., .true. /) character(len=cl) :: tmpstr character(len=cl) :: rst_file character(len=cl) :: nexttime_str @@ -820,6 +846,19 @@ subroutine write_restart(gcomp, restart_freq, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + ! debug + if (dbug_flag > 5) then + do n = 1,size(flds) + ! retrieve field from FB + call ESMF_FieldBundleGet(FBout, fieldName=trim(flds(n)), field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! write field in VTK format + call ESMF_FieldWriteVTK(field, 'rst_'//trim(flds(n))//'_'//trim(is_local%wrap%aoflux_grid)//'_'//trim(nexttime_str), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + end if + !---------------------- ! Write data !---------------------- From 54e8ae551378a6cbb40e64671296627ed38b5dbb Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Wed, 25 May 2022 02:20:49 -0500 Subject: [PATCH 078/395] add missing call to read restart file --- ufs/flux_atmocn_ccpp_mod.F90 | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index 45caee98b..50daac45f 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -288,15 +288,13 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, write(logunit,*) '========================================================' end if - ! read initial condition/restart + ! read restart call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) starttype - !if (trim(starttype) == trim('startup')) then - ! call read_initial(gcomp, ini_file, mosaic_file, input_dir, rc) - !else - ! call read_restart(gcomp, rst_file, rc) - !end if + if (trim(starttype) == trim('continue')) then + call read_restart(gcomp, rst_file, rc) + end if ! run CCPP init ! TODO: suite name need to be provided by ESMF config file From 14b82162e18cab64fe057025dba07486328d8701 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Wed, 25 May 2022 11:11:18 -0600 Subject: [PATCH 079/395] fix for gnu compiler --- ufs/ufs_io_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ufs/ufs_io_mod.F90 b/ufs/ufs_io_mod.F90 index 82dd80ba7..632af742b 100644 --- a/ufs/ufs_io_mod.F90 +++ b/ufs/ufs_io_mod.F90 @@ -440,7 +440,7 @@ subroutine create_fms_domain(gcomp, domain, mosaic_file, rc) end do ! check total number of PETs - if (mod(npet, domain%ntiles)) then + if (mod(npet, domain%ntiles) == 0) then write(msg, fmt='(A,I5)') trim(subname)//' : nPet should be multiple of 6 to read initial conditions but it is ', npet call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE From b0e54180d7e91102fdfb9a43f64acfbae68fcc60 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Wed, 25 May 2022 22:10:59 -0600 Subject: [PATCH 080/395] change standard name of new option and couple of minor fix for debug and gnu --- ufs/ccpp/data/MED_typedefs.meta | 2 +- ufs/flux_atmocn_ccpp_mod.F90 | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/ufs/ccpp/data/MED_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta index 2e975afc1..1954ca360 100644 --- a/ufs/ccpp/data/MED_typedefs.meta +++ b/ufs/ccpp/data/MED_typedefs.meta @@ -770,7 +770,7 @@ dimensions = () type = logical [use_med_flux] - standard_name = flag_for_mediator_atmosphere_ocean_fluxes + standard_name = do_mediator_atmosphere_ocean_fluxes long_name = flag for using atmosphere-ocean fluxes form mediator (default false) units = flag dimensions = () diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index 50daac45f..673640b35 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -128,6 +128,9 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, ! init CCPP and setup/allocate variables if (first_call) then + ! initalize model related parameters + call physics%model%init() + ! allocate and initalize data structures call physics%statein%create(nMax,physics%model) call physics%stateout%create(nMax) @@ -140,9 +143,6 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, ! initalize dimension physics%init%im = nMax - ! initalize model related parameters - call physics%model%init() - ! determine CCPP/physics specific options ! semis_water, surface emissivity for lw radiation ! semis_wat is constant and set to 0.97 in setemis() call @@ -349,7 +349,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, end do ! init other variables - if (first_call) then + if (first_call .and. trim(starttype) == trim('continue')) then physics%interstitial%qss_water(:) = physics%sfcprop%qss(:) else physics%sfcprop%qss(:) = qbot(:) From e1e91b5d23b53dd82b76ade7a7b95ee666d5ee41 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 26 May 2022 10:45:08 -0600 Subject: [PATCH 081/395] fix conditional to check nproc --- ufs/ufs_io_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ufs/ufs_io_mod.F90 b/ufs/ufs_io_mod.F90 index 632af742b..904345c3a 100644 --- a/ufs/ufs_io_mod.F90 +++ b/ufs/ufs_io_mod.F90 @@ -440,7 +440,7 @@ subroutine create_fms_domain(gcomp, domain, mosaic_file, rc) end do ! check total number of PETs - if (mod(npet, domain%ntiles) == 0) then + if (mod(npet, domain%ntiles) /= 0) then write(msg, fmt='(A,I5)') trim(subname)//' : nPet should be multiple of 6 to read initial conditions but it is ', npet call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE From 2e3f06145f3ba0bbb7202aa6d7d56e578b07db90 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 26 May 2022 16:27:02 -0600 Subject: [PATCH 082/395] fix for initial conditions, default is not to read --- ufs/flux_atmocn_ccpp_mod.F90 | 40 ++++++++++++++++++++++++++++++-- ufs/ufs_io_mod.F90 | 45 +++++++++++++++++++++--------------- 2 files changed, 64 insertions(+), 21 deletions(-) diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index 673640b35..9dafda8eb 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -35,13 +35,15 @@ module flux_atmocn_ccpp_mod public :: flux_atmOcn_ccpp ! computes atm/ocn fluxes integer, save :: restart_freq + integer :: layout(2) real(r8), save :: semis_water character(len=cs), save :: starttype character(len=cl), save :: ini_file character(len=cl), save :: rst_file character(len=cl), save :: mosaic_file character(len=cl), save :: input_dir - character(len=1) , save :: listDel = "," + character(len=1) , save :: listDel = "," + logical , save :: ini_read character(*), parameter :: u_FILE_u = & __FILE__ @@ -152,6 +154,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, if (isPresent .and. isSet) then read(cvalue,*) semis_water end if + ! lseaspray call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_lseaspray", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -159,6 +162,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, if (isPresent .and. isSet) then if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%lseaspray = .false. end if + ! ivegsrc call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_ivegsrc", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -166,6 +170,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, if (isPresent .and. isSet) then read(cvalue,*) physics%model%ivegsrc end if + ! redrag call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_redrag", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -173,6 +178,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, if (isPresent .and. isSet) then if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%redrag = .false. end if + ! lsm call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_lsm", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -180,6 +186,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, if (isPresent .and. isSet) then read(cvalue,*) physics%model%lsm end if + ! frac_grid call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_frac_grid", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -187,6 +194,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, if (isPresent .and. isSet) then if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%frac_grid = .false. end if + ! restart call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_restart", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -194,6 +202,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, if (isPresent .and. isSet) then if (trim(cvalue) .eq. '.true.' .or. trim(cvalue) .eq. 'true') physics%model%restart = .true. end if + ! cplice call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_cplice", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -201,6 +210,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, if (isPresent .and. isSet) then if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%cplice = .false. end if + ! cplflx call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_cplflx", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -208,6 +218,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, if (isPresent .and. isSet) then if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%cplflx = .false. end if + ! lheatstrg call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_lheatstrg", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -268,6 +279,28 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, input_dir = "INPUT/" end if + ! layout to read tiled CS grid files + call NUOPC_CompAttributeGet(gcomp, name='ccpp_ini_layout', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + do n = 1, 2 + call string_listGetName(cvalue, n, cname, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (rc == ESMF_FAILURE) return + read(cname,*) layout(n) + end do + else + layout(:) = -1 + end if + + ! flag for reading initial conditions + call NUOPC_CompAttributeGet(gcomp, name="ccpp_ini_read", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ini_read = .false. + if (isPresent .and. isSet) then + if (trim(cvalue) .eq. '.true.' .or. trim(cvalue) .eq. 'true') ini_read = .true. + end if + if (mastertask) then write(logunit,*) '========================================================' write(logunit,'(a,f5.2)') trim(subname)//' ccpp_phy_semis_water = ', semis_water @@ -292,7 +325,10 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) starttype - if (trim(starttype) == trim('continue')) then + if (trim(starttype) == trim('startup')) then + ! TODO: this is just extra leyer of protection since reading of initial condition is not stable yet + if (ini_read) call read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rc) + else call read_restart(gcomp, rst_file, rc) end if diff --git a/ufs/ufs_io_mod.F90 b/ufs/ufs_io_mod.F90 index 904345c3a..ee85fa183 100644 --- a/ufs/ufs_io_mod.F90 +++ b/ufs/ufs_io_mod.F90 @@ -21,6 +21,7 @@ module ufs_io_mod use ESMF, only : ESMF_FieldBundleRemove, ESMF_FieldBundleDestroy use ESMF, only : ESMF_FieldWrite, ESMF_FieldBundleRead, ESMF_FieldBundleWrite use ESMF, only : ESMF_REGRIDMETHOD_CONSERVE_2ND, ESMF_MeshCreate + use ESMF, only : ESMF_TERMORDER_SRCSEQ, ESMF_REGION_TOTAL use NUOPC, only : NUOPC_CompAttributeGet use NUOPC_Mediator, only : NUOPC_MediatorGet @@ -89,7 +90,7 @@ module ufs_io_mod contains !=============================================================================== - subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, rc) + subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rc) implicit none @@ -98,6 +99,7 @@ subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, rc) character(len=cl), intent(in) :: ini_file character(len=cl), intent(in) :: mosaic_file character(len=cl), intent(in) :: input_dir + integer :: layout(2) integer, intent(inout) :: rc ! local variables @@ -122,7 +124,7 @@ subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, rc) ! Create domain ! --------------------- - call create_fms_domain(gcomp, domain, mosaic_file, rc) + call create_fms_domain(gcomp, domain, mosaic_file, layout, rc) ! --------------------- ! Create grid @@ -144,22 +146,22 @@ subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, rc) ! create destination field field_dst = ESMF_FieldCreate(is_local%wrap%aoflux_mesh, ESMF_TYPEKIND_R8, & - name='uustar', meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + name=trim(flds(n)), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! map field - if (is_local%wrap%aoflux_grid == 'ogrid' .or. is_local%wrap%aoflux_grid == 'xgrid') then - ! create rh - call ESMF_FieldRegridStore(field, field_dst, routehandle=rh, & - regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! create rh + call ESMF_FieldRegridStore(field, field_dst, routehandle=rh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! remap from atm to ocn/xgrid - call ESMF_FieldRegrid(field, field_dst, rh, rc=rc) + ! map field + if (is_local%wrap%aoflux_grid == 'agrid') then + ! do nothing, just redist in case of haning different decomp. in here and aoflux mesh + call ESMF_FieldRedist(field, field_dst, rh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - ! do nothing, use source field - field_dst = field + ! remap from atm to ocn or exchange grid + call ESMF_FieldRegrid(field, field_dst, rh, termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! debug @@ -332,13 +334,14 @@ subroutine read_restart(gcomp, rst_file, rc) end subroutine read_restart !=============================================================================== - subroutine create_fms_domain(gcomp, domain, mosaic_file, rc) + subroutine create_fms_domain(gcomp, domain, mosaic_file, layout, rc) implicit none ! input/output variables type(ESMF_GridComp), intent(in) :: gcomp type(domain_type), intent(inout) :: domain character(len=cl), intent(in) :: mosaic_file + integer :: layout(2) integer, intent(inout) :: rc ! local variables @@ -447,9 +450,13 @@ subroutine create_fms_domain(gcomp, domain, mosaic_file, rc) return end if - ! calculate layout - npes_per_tile = npet/domain%ntiles - call mpp_define_layout(global_indices(:,1), npes_per_tile, domain%layout) + ! calculate layout if it is not provided as configuration option + if (layout(1) < 0 .and. layout(2) < 0) then + npes_per_tile = npet/domain%ntiles + call mpp_define_layout(global_indices(:,1), npes_per_tile, domain%layout) + else + domain%layout(:) = layout(:) + end if ! set layout and print out debug information do n = 1, domain%ntiles @@ -676,12 +683,12 @@ subroutine read_tiled_file(gcomp, filename, varname, domain, field_dst, rc) !---------------------- if (dbug_flag > 2) then - call ESMF_FieldWrite(field_dst, trim(varname)//'agrid', variableName=trim(varname), overwrite=.true., rc=rc) + call ESMF_FieldWrite(field_dst, trim(varname)//'_agrid.nc', variableName=trim(varname), overwrite=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (dbug_flag > 5) then - call ESMF_FieldWriteVTK(field_dst, trim(varname)//'agrid', rc=rc) + call ESMF_FieldWriteVTK(field_dst, trim(varname)//'_agrid', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if From 81a2807b3d594ab98d9a4aae15a2baa717a5d836 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Fri, 27 May 2022 13:43:28 -0600 Subject: [PATCH 083/395] add new field to adjust new version of physics code --- ufs/ccpp/data/MED_typedefs.F90 | 2 ++ ufs/ccpp/data/MED_typedefs.meta | 6 ++++++ 2 files changed, 8 insertions(+) diff --git a/ufs/ccpp/data/MED_typedefs.F90 b/ufs/ccpp/data/MED_typedefs.F90 index 9b2d556a8..1b2ce51c5 100644 --- a/ufs/ccpp/data/MED_typedefs.F90 +++ b/ufs/ccpp/data/MED_typedefs.F90 @@ -188,6 +188,7 @@ module MED_typedefs real(kind=kind_phys) :: h0facs !< canopy heat storage factor for sensible heat flux in stable surface layer integer :: lsoil !< number of soil layers integer :: kice !< vertical loop extent for ice levels, start at 1 + integer :: lsm_ruc !< flag for RUC land surface model contains procedure :: init => control_initialize end type MED_control_type @@ -634,6 +635,7 @@ subroutine control_initialize(model) model%h0facs = 1.0 model%lsoil = 4 model%kice = 2 + model%lsm_ruc = 3 end subroutine control_initialize diff --git a/ufs/ccpp/data/MED_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta index 1954ca360..6204c6a21 100644 --- a/ufs/ccpp/data/MED_typedefs.meta +++ b/ufs/ccpp/data/MED_typedefs.meta @@ -918,6 +918,12 @@ units = count dimensions = () type = integer +[lsm_ruc] + standard_name = identifier_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer ######################################################################## [ccpp-table-properties] From a496972fabadc9d5cfd209f5de1ec811c95ab470 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 27 May 2022 14:11:58 -0600 Subject: [PATCH 084/395] more logging changes --- cesm/driver/ensemble_driver.F90 | 10 ++++++++-- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 8 ++++++++ cesm/nuopc_cap_share/shr_pio_mod.F90 | 17 +++++++++++------ mediator/med.F90 | 10 +++++----- 4 files changed, 32 insertions(+), 13 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 85ddb67eb..73bfc04a1 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -282,7 +282,7 @@ subroutine InitializeIO(ensemble_driver, rc) use ESMF, only: ESMF_GridComp, ESMF_LOGMSG_INFO, ESMF_LogWrite use ESMF, only: ESMF_SUCCESS, ESMF_VM, ESMF_GridCompGet, ESMF_VMGet use ESMF, only: ESMF_CONFIG, ESMF_GridCompIsPetLocal, ESMF_State, ESMF_Clock - use NUOPC, only: NUOPC_CompAttributeGet + use NUOPC, only: NUOPC_CompAttributeGet, NUOPC_CompGet use NUOPC_DRIVER, only: NUOPC_DriverGetComp use shr_pio_mod , only: shr_pio_init, shr_pio_component_init @@ -296,6 +296,7 @@ subroutine InitializeIO(ensemble_driver, rc) integer :: Global_Comm integer :: drv, comp integer, allocatable :: asyncio_petlist(:) + character(len=8) :: compname rc = ESMF_SUCCESS call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -309,11 +310,16 @@ subroutine InitializeIO(ensemble_driver, rc) nullify(dcomp) call NUOPC_DriverGetComp(ensemble_driver, complist=dcomp, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + allocate(asyncio_petlist(0)) do drv=1,size(dcomp) if (ESMF_GridCompIsPetLocal(dcomp(drv), rc=rc) .or. asyncio_task) then + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompGet(dcomp(drv), name=compname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": call shr_pio_init"//compname, ESMF_LOGMSG_INFO) call shr_pio_init(dcomp(drv), rc=rc) + call ESMF_LogWrite(trim(subname)//": call shr_pio_component_init"//compname, ESMF_LOGMSG_INFO) call shr_pio_component_init(dcomp(drv), Global_Comm, asyncio_petlist, rc) endif diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index 32d7af5e1..cd1d800b6 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -133,6 +133,7 @@ end subroutine get_component_instance subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) use NUOPC, only : NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd + use ESMF, only : ESMF_GridCompGet, ESMF_LOGMSG_INFO, ESMF_LogWrite ! input/output variables type(ESMF_GridComp) :: gcomp logical, intent(in) :: mastertask @@ -144,7 +145,9 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) character(len=CL) :: diro character(len=CL) :: logfile character(len=CL) :: inst_suffix + character(len=CL) :: name integer :: inst_index ! not used here + character(len=*), parameter :: subname = "("//__FILE__//": set_component_logging)" !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -170,6 +173,11 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) endif ! TODO: shr_file mod is deprecated and should be removed. call shr_file_setLogUnit (logunit) + + call ESMF_GridCompGet(gcomp, name=name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": setting logunit for component: "//trim(name), ESMF_LOGMSG_INFO) call NUOPC_CompAttributeAdd(gcomp, attrList=(/'logunit'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/shr_pio_mod.F90 index 2f23a88e3..cd3890122 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/shr_pio_mod.F90 @@ -210,6 +210,7 @@ end subroutine shr_pio_init subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) use ESMF, only : ESMF_GridComp, ESMF_LogSetError, ESMF_RC_NOT_VALID, ESMF_GridCompIsCreated, ESMF_VM, ESMF_VMGet use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated, ESMF_Finalize, ESMF_PtrInt1D + use ESMF, only : ESMF_LOGMSG_INFO, ESMF_LOGWRITE use NUOPC, only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use NUOPC_Driver, only : NUOPC_DriverGetComp use mpi, only : MPI_INTEGER, MPI_MAX, MPI_IN_PLACE, MPI_LOR, MPI_LOGICAL @@ -238,7 +239,7 @@ subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) type(iosystem_desc_t), allocatable :: async_iosystems(:) character(len=*), parameter :: subname = '('//__FILE__//':shr_pio_component_init)' - + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) call ESMF_GridCompGet(gridcomp=driver, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return nullify(gcomp) @@ -272,6 +273,7 @@ subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) if (ESMF_GridCompIsPetLocal(gcomp(i), rc=rc)) then call ESMF_GridCompGet(gcomp(i), vm=vm, name=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": initialize component: "//trim(cval), ESMF_LOGMSG_INFO) io_compname(i) = trim(cval) call NUOPC_CompAttributeAdd(gcomp(i), attrList=(/'MCTID'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -353,7 +355,8 @@ subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) pio_rearr_opts) endif ! Write the PIO settings to the beggining of each component log - if(comp_rank == 0) call shr_pio_log_comp_settings(gcomp(i)) + if(comp_rank == 0) call shr_pio_log_comp_settings(gcomp(i), rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return endif enddo do i=1,total_comps @@ -426,26 +429,28 @@ subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) enddo print *,__FILE__,__LINE__,' async_init: ',do_async_init endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine shr_pio_component_init - subroutine shr_pio_log_comp_settings(gcomp) - use ESMF, only : ESMF_GridComp, ESMF_GridCompGet + subroutine shr_pio_log_comp_settings(gcomp, rc) + use ESMF, only : ESMF_GridComp, ESMF_GridCompGet, ESMF_SUCCESS use NUOPC, only: NUOPC_CompAttributeGet type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc integer :: logunit integer :: compid character(len=CS) :: name, cval integer :: i - integer :: rc logical :: isPresent + rc = ESMF_SUCCESS call ESMF_GridCompGet(gcomp, name=name, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='logunit', value=logunit) + call NUOPC_CompAttributeGet(gcomp, name='logunit', value=logunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name="MCTID", value=cval, isPresent=isPresent, rc=rc) diff --git a/mediator/med.F90 b/mediator/med.F90 index 1fe7ae7c7..8ae6b955c 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -59,7 +59,7 @@ module MED public SetServices public SetVM private InitializeP0 - private InitializeIPDv03p1 ! advertise fields + private AdvertiseFields ! advertise fields private InitializeIPDv03p3 ! realize connected Fields with transfer action "provide" private InitializeIPDv03p4 ! optionally modify the decomp/distr of transferred Grid/Mesh private InitializeIPDv03p5 ! realize all Fields with transfer action "accept" @@ -161,7 +161,7 @@ subroutine SetServices(gcomp, rc) ! The valid values are: [will provide, can provide, cannot provide] call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeIPDv03p1, rc=rc) + phaseLabelList=(/"IPDv03p1"/), userRoutine=AdvertiseFields, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ @@ -647,7 +647,7 @@ end subroutine InitializeP0 !----------------------------------------------------------------------- - subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) + subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) ! Mediator advertises its import and export Fields and sets the ! TransferOfferGeomObject Attribute. @@ -677,7 +677,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) character(len=8) :: cnum type(InternalState) :: is_local integer :: stat - character(len=*), parameter :: subname = '('//__FILE__//':InitializeIPDv03p1)' + character(len=*), parameter :: subname = '('//__FILE__//':AdvertiseFields)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -882,7 +882,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - end subroutine InitializeIPDv03p1 + end subroutine AdvertiseFields !----------------------------------------------------------------------------- From b7b2cffb7511021f5cf984c1e466494b495a4020 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 31 May 2022 06:58:19 -0600 Subject: [PATCH 085/395] initialize drydep_nflds to zero modified: cesm/nuopc_cap_share/shr_drydep_mod.F90 --- cesm/nuopc_cap_share/shr_drydep_mod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cesm/nuopc_cap_share/shr_drydep_mod.F90 b/cesm/nuopc_cap_share/shr_drydep_mod.F90 index 561c14d1c..ae67df4f9 100644 --- a/cesm/nuopc_cap_share/shr_drydep_mod.F90 +++ b/cesm/nuopc_cap_share/shr_drydep_mod.F90 @@ -296,6 +296,8 @@ subroutine shr_drydep_readnl(NLFilename, drydep_nflds) call shr_mpi_bcast( drydep_list, mpicom ) call shr_mpi_bcast( dep_data_file, mpicom ) + drydep_nflds = 0 + do i=1,maxspc if(len_trim(drydep_list(i)) > 0) then drydep_nflds=drydep_nflds+1 From 28e3f622b9368cfd7cf2772973d4390e961db7e9 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 15 Jun 2022 07:33:53 -0600 Subject: [PATCH 086/395] initialize async io logical --- cesm/nuopc_cap_share/shr_pio_mod.F90 | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/shr_pio_mod.F90 index cd3890122..781268c5b 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/shr_pio_mod.F90 @@ -222,7 +222,7 @@ subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) type(ESMF_VM) :: vm integer :: i, npets, default_stride - integer :: j + integer :: j, myid integer :: comp_comm, comp_rank, driver_comm integer, allocatable :: procs_per_comp(:), async_procs_per_comp(:) integer, allocatable :: io_proc_list(:), async_io_tasks(:), comp_proc_list(:,:) @@ -236,6 +236,7 @@ subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) integer :: asyncio_stride integer :: pecnt integer :: ierr + logical :: asyncio_task type(iosystem_desc_t), allocatable :: async_iosystems(:) character(len=*), parameter :: subname = '('//__FILE__//':shr_pio_component_init)' @@ -246,7 +247,7 @@ subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) nullify(all_comp_proc_lists) call NUOPC_DriverGetComp(driver, compList=gcomp, petLists=all_comp_proc_lists, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + asyncio_task=.false. total_comps = size(gcomp) allocate(pio_comp_settings(total_comps)) allocate(procs_per_comp(total_comps)) @@ -255,7 +256,7 @@ subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) allocate(iosystems(total_comps)) do_async_init = 0 - call ESMF_VMGet(vm, petCount=totalpes, mpiCommunicator=driver_comm, rc=rc) + call ESMF_VMGet(vm, petCount=totalpes, localPet=myid, mpiCommunicator=driver_comm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -269,6 +270,7 @@ subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) asyncio_stride = 0 do i=1,total_comps + pio_comp_settings(i)%pio_async_interface = .false. io_compid(i) = i+1 if (ESMF_GridCompIsPetLocal(gcomp(i), rc=rc)) then call ESMF_GridCompGet(gcomp(i), vm=vm, name=cval, rc=rc) @@ -362,7 +364,10 @@ subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) do i=1,total_comps call MPI_AllReduce(MPI_IN_PLACE, pio_comp_settings(i)%pio_async_interface, 1, MPI_LOGICAL, & MPI_LOR, driver_comm, rc) - if(pio_comp_settings(i)%pio_async_interface) do_async_init = do_async_init + 1 + if(pio_comp_settings(i)%pio_async_interface) then + do_async_init = do_async_init + 1 + print *,__FILE__,__LINE__,i,do_async_init + endif enddo ! @@ -377,6 +382,7 @@ subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) if (mod(i,asyncio_stride) == 0) then io_proc_list(j) = i j = j + 1 + if(i==myid) asyncio_task=.true. endif enddo endif @@ -416,7 +422,7 @@ subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) enddo ! call init_intercom(async_iosystems, driver_comm, async_procs_per_comp, comp_proc_list, io_proc_list, & ! PIO_REARR_BOX) - if(asyncio_ntasks) then + if(asyncio_task) then ! IO tasks should not return until the run is completed call ESMF_FINALIZE() endif From 9aa32dc835dd706512311d40afdd1fc6247006e9 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 15 Jun 2022 14:59:02 -0600 Subject: [PATCH 087/395] add more error checking --- cesm/driver/ensemble_driver.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 73bfc04a1..5c63908a8 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -278,6 +278,7 @@ subroutine SetModelServices(ensemble_driver, rc) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine SetModelServices + subroutine InitializeIO(ensemble_driver, rc) use ESMF, only: ESMF_GridComp, ESMF_LOGMSG_INFO, ESMF_LogWrite use ESMF, only: ESMF_SUCCESS, ESMF_VM, ESMF_GridCompGet, ESMF_VMGet @@ -318,10 +319,11 @@ subroutine InitializeIO(ensemble_driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//": call shr_pio_init"//compname, ESMF_LOGMSG_INFO) call shr_pio_init(dcomp(drv), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//": call shr_pio_component_init"//compname, ESMF_LOGMSG_INFO) call shr_pio_component_init(dcomp(drv), Global_Comm, asyncio_petlist, rc) - + if (chkerr(rc,__LINE__,u_FILE_u)) return endif enddo call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) From 3516bbdc9622b5f06751869c929fb10a70b0d348 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Tue, 21 Jun 2022 15:29:12 -0600 Subject: [PATCH 088/395] fix after merge with master --- mediator/esmFldsExchange_nems_mod.F90 | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 1d29f30f2..3561e2565 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -265,6 +265,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_t', rc=rc)) then call addmap(fldListFr(complnd)%flds, 'Sl_t', compatm, maptype, 'lfrin', 'unset') call addmrg(fldListTo(compatm)%flds, 'Sl_t', mrg_from=complnd, mrg_fld='Sl_t', mrg_type='copy') + end if + end if ! to atm: unmerged from mediator, merge will be done under FV3/CCPP composite step ! - zonal surface stress, meridional surface stress @@ -685,10 +687,18 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end if do n = 1,size(flds) fldname = trim(flds(n)) - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(complnd)%flds, trim(fldname)) - call addmap(fldListFr(compatm)%flds, trim(fldname), complnd, maptype, 'one', 'unset') - call addmrg(fldListTo(complnd)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(complnd)) then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(complnd)%flds, trim(fldname)) + end if + else + if ( fldchk(is_local%wrap%FBexp(compatm) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(complnd,complnd), trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), complnd, maptype, 'one', 'unset') + call addmrg(fldListTo(complnd)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end if + end if end do deallocate(flds) From e2d0bbadf11f69e99c90fa38c97676da6ffc3d0e Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 23 Jun 2022 08:59:24 -0600 Subject: [PATCH 089/395] async io test passes ERS_Ln9.ne30pg3_ne30pg3_mg17.QPC6.cheyenne_intel.cam-outfrq9s --- cesm/driver/ensemble_driver.F90 | 89 +++++--- cesm/driver/esm_time_mod.F90 | 281 +++++++++++++----------- cesm/nuopc_cap_share/shr_pio_mod.F90 | 227 ++++++++++--------- cime_config/config_component.xml | 16 ++ cime_config/namelist_definition_drv.xml | 25 +++ 5 files changed, 379 insertions(+), 259 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 5c63908a8..d99823f88 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -17,7 +17,10 @@ module Ensemble_driver public :: SetServices private :: SetModelServices + private :: ensemble_finalize + integer, allocatable :: asyncio_petlist(:) + logical :: asyncio_task=.false. character(*),parameter :: u_FILE_u = & __FILE__ @@ -27,10 +30,11 @@ module Ensemble_driver subroutine SetServices(ensemble_driver, rc) - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSpecialize + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSpecialize, NUOPC_CompAttributeSet use NUOPC_Driver , only : driver_routine_SS => SetServices use NUOPC_Driver , only : ensemble_label_SetModelServices => label_SetModelServices use NUOPC_Driver , only : ensemble_label_ModifyCplLists => label_ModifyCplLists + use NUOPC_Driver, only : label_Finalize use ESMF , only : ESMF_GridComp, ESMF_GridCompSet use ESMF , only : ESMF_Config, ESMF_ConfigCreate, ESMF_ConfigLoadFile use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO @@ -69,6 +73,15 @@ subroutine SetServices(ensemble_driver, rc) call ESMF_GridCompSet(ensemble_driver, config=config, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(ensemble_driver, name="InitializeDataResolution", value="false", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Set a finalize method + call NUOPC_CompSpecialize(ensemble_driver, specLabel=label_Finalize, & + specRoutine=ensemble_finalize, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine SetServices @@ -95,7 +108,7 @@ subroutine SetModelServices(ensemble_driver, rc) ! local variables type(ESMF_VM) :: vm - type(ESMF_GridComp) :: driver, gridcomptmp + type(ESMF_GridComp) :: driver type(ESMF_Config) :: config integer :: n, n1, stat integer, pointer :: petList(:) @@ -107,10 +120,14 @@ subroutine SetModelServices(ensemble_driver, rc) character(len=512) :: logfile integer :: global_comm logical :: read_restart + logical :: comp_task character(len=CS) :: read_restart_string integer :: inst + integer :: currentpet, petcnt, iopetcnt integer :: number_of_members integer :: ntasks_per_member + integer :: pio_async_iotasks + integer :: pio_async_iostride character(CL) :: start_type ! Type of startup character(len=7) :: drvrinst character(len=5) :: inst_suffix @@ -193,13 +210,21 @@ subroutine SetModelServices(ensemble_driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) number_of_members - call ESMF_VMGet(vm, localPet=localPet, PetCount=PetCount, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="pio_async_iotasks", value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) pio_async_iotasks - ntasks_per_member = PetCount/number_of_members - if(ntasks_per_member*number_of_members .ne. PetCount) then + call NUOPC_CompAttributeGet(ensemble_driver, name="pio_async_iostride", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) pio_async_iostride + + call ESMF_VMGet(vm, localPet=localPet, PetCount=PetCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ntasks_per_member = PetCount/number_of_members - pio_async_iotasks + if(ntasks_per_member*number_of_members .ne. (PetCount - pio_async_iotasks)) then write (msgstr,'(a,i5,a,i3,a,i3,a)') & - "PetCount (",PetCount,") must be evenly divisable by number of members (",number_of_members,")" + "PetCount - Async IOtasks (",PetCount-pio_async_iotasks,") must be evenly divisable by number of members (",number_of_members,")" call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return endif @@ -209,23 +234,33 @@ subroutine SetModelServices(ensemble_driver, rc) !------------------------------------------- allocate(petList(ntasks_per_member)) - + allocate(asyncio_petlist(pio_async_iotasks)) + currentpet = 0 + iopetcnt = 1 do inst=1,number_of_members - + petcnt=1 + comp_task = .false. ! Determine pet list for driver instance - petList(1) = (inst-1) * ntasks_per_member - do n=2,ntasks_per_member - petList(n) = petList(n-1) + 1 + do n=1,ntasks_per_member+pio_async_iotasks + if(pio_async_iostride == 0 .or. modulo(n,pio_async_iostride) .ne. 2) then + petList(petcnt) = currentpet + petcnt = petcnt+1 + if (currentpet == localPet) comp_task=.true. + else + asyncio_petlist(iopetcnt) = currentpet + iopetcnt = iopetcnt + 1 + if (currentpet == localPet) asyncio_task=.true. + endif + currentpet = currentpet + 1 enddo ! Add driver instance to ensemble driver write(drvrinst,'(a,i4.4)') "ESM",inst - call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=gridcomptmp, rc=rc) + call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=driver, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (localpet >= petlist(1) .and. localpet <= petlist(ntasks_per_member)) then - - driver = gridcomptmp + mastertask = .false. + if (comp_task) then if(number_of_members > 1) then call NUOPC_CompAttributeAdd(driver, attrList=(/'inst_suffix'/), rc=rc) @@ -262,17 +297,13 @@ subroutine SetModelServices(ensemble_driver, rc) mastertask = .true. else logUnit = shrlogunit - mastertask = .false. endif call shr_file_setLogUnit (logunit) - - ! Create a clock for each driver instance - call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif + ! Create a clock for each driver instance + call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return enddo - deallocate(petList) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -292,11 +323,9 @@ subroutine InitializeIO(ensemble_driver, rc) integer, intent(out) :: rc character(len=*), parameter :: subname = '('//__FILE__//':InitializeIO)' type(ESMF_GridComp), pointer :: dcomp(:), ccomp(:) - logical :: asyncio_task=.false. integer :: iam integer :: Global_Comm integer :: drv, comp - integer, allocatable :: asyncio_petlist(:) character(len=8) :: compname rc = ESMF_SUCCESS @@ -311,7 +340,7 @@ subroutine InitializeIO(ensemble_driver, rc) nullify(dcomp) call NUOPC_DriverGetComp(ensemble_driver, complist=dcomp, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(asyncio_petlist(0)) + do drv=1,size(dcomp) if (ESMF_GridCompIsPetLocal(dcomp(drv), rc=rc) .or. asyncio_task) then if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -326,6 +355,16 @@ subroutine InitializeIO(ensemble_driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif enddo + deallocate(asyncio_petlist) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine InitializeIO + subroutine ensemble_finalize(ensemble_driver, rc) + use ESMF, only : ESMF_GridComp, ESMF_SUCCESS + use shr_pio_mod, only: shr_pio_finalize + type(ESMF_GridComp) :: Ensemble_driver + integer, intent(out) :: rc + rc = ESMF_SUCCESS + call shr_pio_finalize() + + end subroutine ensemble_finalize end module Ensemble_driver diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index 3a4b7f1e5..a4892f2c2 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -10,8 +10,8 @@ module esm_time_mod use ESMF , only : ESMF_Time, ESMF_TimeGet, ESMF_TimeSet use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_LOGMSG_ERROR - use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast - use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE + use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast, ESMF_VMAllReduce + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_GridCompIsPetLocal, ESMF_REDUCE_MAX use ESMF , only : operator(<), operator(/=), operator(+) use ESMF , only : operator(-), operator(*) , operator(>=) use ESMF , only : operator(<=), operator(>), operator(==) @@ -53,7 +53,7 @@ module esm_time_mod !=============================================================================== subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastertask, rc) - + ! input/output variables type(ESMF_GridComp) :: ensemble_driver, instance_driver integer, intent(in) :: logunit @@ -62,7 +62,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert ! local variables type(ESMF_Clock) :: clock - type(ESMF_VM) :: vm + type(ESMF_VM) :: vm, envm type(ESMF_Time) :: StartTime ! Start time type(ESMF_Time) :: RefTime ! Reference time type(ESMF_Time) :: CurrTime ! Current time @@ -101,100 +101,168 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert character(CL) :: tmpstr ! temporary character(CS) :: inst_suffix integer :: tmp(4) ! Array for Broadcast + integer :: myid, bcastID(2) logical :: isPresent - character(len=*), parameter :: subname = '('//__FILE__//':esm_time_clockInit)' + logical, save :: firsttime = .true. + logical :: indriver + character(len=*), parameter :: subname = '('//__FILE__//':esm_time_clockInit) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - - call ESMF_GridCompGet(instance_driver, vm=vm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) !--------------------------------------------------------------------------- ! Determine start time, reference time and current time !--------------------------------------------------------------------------- - call NUOPC_CompAttributeGet(instance_driver, name="start_ymd", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="start_ymd", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) start_ymd - call NUOPC_CompAttributeGet(instance_driver, name="start_tod", value=cvalue, rc=rc) + + call NUOPC_CompAttributeGet(ensemble_driver, name="start_tod", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) start_tod - call NUOPC_CompAttributeGet(instance_driver, name='read_restart', value=cvalue, rc=rc) + !--------------------------------------------------------------------------- + ! Determine driver clock timestep + !--------------------------------------------------------------------------- + + call NUOPC_CompAttributeGet(ensemble_driver, name="atm_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) atm_cpl_dt + + call NUOPC_CompAttributeGet(ensemble_driver, name="lnd_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) lnd_cpl_dt + + call NUOPC_CompAttributeGet(ensemble_driver, name="ice_cpl_dt", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) read_restart + read(cvalue,*) ice_cpl_dt + + call NUOPC_CompAttributeGet(ensemble_driver, name="ocn_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ocn_cpl_dt + + call NUOPC_CompAttributeGet(ensemble_driver, name="glc_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) glc_cpl_dt - if (read_restart) then + call NUOPC_CompAttributeGet(ensemble_driver, name="rof_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) rof_cpl_dt - call NUOPC_CompAttributeGet(instance_driver, name='drv_restart_pointer', value=restart_file, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="wav_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) wav_cpl_dt + + call NUOPC_CompAttributeGet(ensemble_driver, name="glc_avg_period", value=glc_avg_period, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) glc_avg_period + + dtime_drv = minval((/atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt/)) + if(mastertask) then + write(tmpstr,'(i10)') dtime_drv + call ESMF_LogWrite(trim(subname)//': driver time interval is : '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + write(logunit,*) trim(subname)//': driver time interval is : '// trim(tmpstr) + endif + + call ESMF_GridCompGet(ensemble_driver, vm=envm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(envm, localPet=myid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + indriver = ESMF_GridCompIsPetLocal(instance_driver, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if(indriver) then + call ESMF_GridCompGet(instance_driver, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(restart_file) /= 'none') then + call NUOPC_CompAttributeGet(instance_driver, name='read_restart', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) read_restart - call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", isPresent=isPresent, rc=rc) + if (read_restart) then + + call NUOPC_CompAttributeGet(instance_driver, name='drv_restart_pointer', value=restart_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(isPresent) then - call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", value=inst_suffix, rc=rc) + + if (trim(restart_file) /= 'none') then + + call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - inst_suffix = "" - endif - - restart_pfile = trim(restart_file)//inst_suffix - - if (mastertask) then - call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & - ESMF_LOGMSG_INFO) - open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) - if (ierr < 0) then - rc = ESMF_FAILURE - call ESMF_LogWrite(trim(subname)//' ERROR rpointer file open returns error', & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) - return - end if - read(unitn,'(a)', iostat=ierr) restart_file - if (ierr < 0) then - rc = ESMF_FAILURE - call ESMF_LogWrite(trim(subname)//' ERROR rpointer file read returns error', & - ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) - return - end if - close(unitn) + if(isPresent) then + call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", value=inst_suffix, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + inst_suffix = "" + endif + + restart_pfile = trim(restart_file)//inst_suffix + if (mastertask) then - write(logunit,'(a)') trim(subname)//" reading driver restart from file = "//trim(restart_file) - end if - call esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & + ESMF_LOGMSG_INFO) + open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) + if (ierr < 0) then + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//' ERROR rpointer file open returns error', & + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) + return + end if + read(unitn,'(a)', iostat=ierr) restart_file + if (ierr < 0) then + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//' ERROR rpointer file read returns error', & + ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) + return + end if + close(unitn) + if (mastertask) then + write(logunit,'(a)') trim(subname)//" reading driver restart from file = "//trim(restart_file) + end if + call esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + endif - tmp(1) = start_ymd ; tmp(2) = start_tod - tmp(3) = curr_ymd ; tmp(4) = curr_tod - endif + else - call ESMF_VMBroadcast(vm, tmp, 4, 0, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - start_ymd = tmp(1) ; start_tod = tmp(2) - curr_ymd = tmp(3) ; curr_tod = tmp(4) + if (mastertask) then + write(logunit,*) ' NOTE: the current compset has no mediator - which provides the clock restart information' + write(logunit,*) ' In this case the restarts are handled solely by the component being used and' + write(logunit,*) ' and the driver clock will always be starting from the initial date on restart' + end if + curr_ymd = start_ymd + curr_tod = start_tod + + end if else - if (mastertask) then - write(logunit,*) ' NOTE: the current compset has no mediator - which provides the clock restart information' - write(logunit,*) ' In this case the restarts are handled solely by the component being used and' - write(logunit,*) ' and the driver clock will always be starting from the initial date on restart' - end if curr_ymd = start_ymd curr_tod = start_tod - end if - - else + end if ! end if read_restart + endif - curr_ymd = start_ymd - curr_tod = start_tod - end if ! end if read_restart + if(mastertask) then + bcastID(1) = myid + tmp(1) = start_ymd ; tmp(2) = start_tod + tmp(3) = curr_ymd ; tmp(4) = curr_tod + else + bcastID(1) = 0 + tmp = 0 + endif + call ESMF_VMAllReduce(envm, bcastID(1:1), bcastID(2:2), 1, ESMF_REDUCE_MAX,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMBroadcast(envm, tmp, 4, bcastID(2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + start_ymd = tmp(1) ; start_tod = tmp(2) + curr_ymd = tmp(3) ; curr_tod = tmp(4) + ! Determine start time (THE FOLLOWING ASSUMES THAT THE DEFAULT CALENDAR IS SET in the driver) call esm_time_date2ymd(start_ymd, yr, mon, day) @@ -231,48 +299,6 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert call ESMF_TimeSet( RefTime, yy=yr, mm=mon, dd=day, s=ref_tod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !--------------------------------------------------------------------------- - ! Determine driver clock timestep - !--------------------------------------------------------------------------- - - call NUOPC_CompAttributeGet(instance_driver, name="atm_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) atm_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="lnd_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) lnd_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="ice_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ice_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="ocn_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ocn_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="glc_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="rof_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) rof_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="wav_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) wav_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="glc_avg_period", value=glc_avg_period, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_avg_period - - dtime_drv = minval((/atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt/)) - if(mastertask) then - write(tmpstr,'(i10)') dtime_drv - call ESMF_LogWrite(trim(subname)//': driver time interval is : '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - write(logunit,*) trim(subname)//': driver time interval is : '// trim(tmpstr) - endif call ESMF_TimeIntervalSet( TimeStep, s=dtime_drv, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -294,20 +320,22 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert if (ChkErr(rc,__LINE__,u_FILE_u)) return end do - ! Set the ensemble driver gridded component clock to the created clock - call ESMF_GridCompSet(instance_driver, clock=clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Set the driver gridded component clock to the created clock + if (indriver) then + call ESMF_GridCompSet(instance_driver, clock=clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif ! Set driver clock stop time - call NUOPC_CompAttributeGet(instance_driver, name="stop_option", value=stop_option, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="stop_option", value=stop_option, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(instance_driver, name="stop_n", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="stop_n", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_n - call NUOPC_CompAttributeGet(instance_driver, name="stop_ymd", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="stop_ymd", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_ymd - call NUOPC_CompAttributeGet(instance_driver, name="stop_tod", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="stop_tod", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_tod if ( stop_ymd < 0) then @@ -315,6 +343,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert stop_tod = 0 endif + if (mastertask) then write(tmpstr,'(i10)') stop_ymd call ESMF_LogWrite(trim(subname)//': driver stop_ymd: '// trim(tmpstr), ESMF_LOGMSG_INFO) @@ -322,6 +351,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert write(tmpstr,'(i10)') stop_tod call ESMF_LogWrite(trim(subname)//': driver stop_tod: '// trim(tmpstr), ESMF_LOGMSG_INFO) write(logunit,*) trim(subname)//': driver stop_tod: '// trim(tmpstr) + else endif call esm_time_alarmInit(clock, & @@ -342,17 +372,18 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert !--------------------------------------------------------------------------- ! Create the ensemble driver clock - ! TODO: this is done repeatedly - but only needs to be done the first time this is called !--------------------------------------------------------------------------- + if(firsttime) then + TimeStep = StopTime - ClockTime + clock = ESMF_ClockCreate(TimeStep, ClockTime, StopTime=StopTime, & + refTime=RefTime, name='ESMF ensemble Driver Clock', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - TimeStep = StopTime - ClockTime - clock = ESMF_ClockCreate(TimeStep, ClockTime, StopTime=StopTime, & - refTime=RefTime, name='ESMF ensemble Driver Clock', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_GridCompSet(ensemble_driver, clock=clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - + call ESMF_GridCompSet(ensemble_driver, clock=clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + firsttime = .false. + endif + end subroutine esm_time_clockInit !=============================================================================== @@ -393,7 +424,7 @@ subroutine esm_time_alarmInit( clock, alarm, option, & type(ESMF_Time) :: NextAlarm ! Next restart alarm time type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval integer :: sec - character(len=*), parameter :: subname = '('//__FILE__//':esm_time_alarmInit)' + character(len=*), parameter :: subname = '(med_time_alarmInit): ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -582,7 +613,7 @@ subroutine esm_time_timeInit( Time, ymd, cal, tod, desc, logunit ) integer :: ltod ! local tod character(len=256) :: ldesc ! local desc integer :: rc ! return code - character(len=*), parameter :: subname = '('//__FILE__//':esm_time_timeInit)' + character(len=*), parameter :: subname = '(esm_time_m_ETimeInit) ' !------------------------------------------------------------------------------- ltod = 0 @@ -649,7 +680,7 @@ subroutine esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, c ! local variables integer :: status, ncid, varid ! netcdf stuff character(CL) :: tmpstr ! temporary - character(len=*), parameter :: subname = '('//__FILE__//':esm_time_read_restart)' + character(len=*), parameter :: subname = "(esm_time_read_restart)" !---------------------------------------------------------------- ! use netcdf here since it's serial diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/shr_pio_mod.F90 index 781268c5b..0ec27ab5b 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/shr_pio_mod.F90 @@ -207,7 +207,7 @@ subroutine shr_pio_init(driver, rc) end subroutine shr_pio_init - subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) + subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) use ESMF, only : ESMF_GridComp, ESMF_LogSetError, ESMF_RC_NOT_VALID, ESMF_GridCompIsCreated, ESMF_VM, ESMF_VMGet use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated, ESMF_Finalize, ESMF_PtrInt1D use ESMF, only : ESMF_LOGMSG_INFO, ESMF_LOGWRITE @@ -217,16 +217,16 @@ subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) type(ESMF_GridComp) :: driver integer, intent(in) :: Global_COMM ! The communicator associated with the ensemble_driver - integer, intent(in) :: async_io_petlist(:) + integer, intent(in) :: asyncio_petlist(:) integer, intent(out) :: rc type(ESMF_VM) :: vm integer :: i, npets, default_stride integer :: j, myid - integer :: comp_comm, comp_rank, driver_comm + integer :: comp_comm, comp_rank integer, allocatable :: procs_per_comp(:), async_procs_per_comp(:) - integer, allocatable :: io_proc_list(:), async_io_tasks(:), comp_proc_list(:,:) - type(ESMF_PtrInt1D), pointer :: all_comp_proc_lists(:) + integer, allocatable :: io_proc_list(:), asyncio_tasks(:), comp_proc_list(:,:) + type(ESMF_GridComp), pointer :: gcomp(:) character(CS) :: cval character(CS) :: msgstr @@ -236,43 +236,70 @@ subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) integer :: asyncio_stride integer :: pecnt integer :: ierr - logical :: asyncio_task + integer :: iocomm + integer :: ncomps + integer :: driverpecount, driver_myid + integer, allocatable :: asyncio_comp_comm(:) + logical :: asyncio_task, petlocal type(iosystem_desc_t), allocatable :: async_iosystems(:) character(len=*), parameter :: subname = '('//__FILE__//':shr_pio_component_init)' + asyncio_ntasks = size(asyncio_petlist) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - call ESMF_GridCompGet(gridcomp=driver, vm=vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - nullify(gcomp) - nullify(all_comp_proc_lists) - call NUOPC_DriverGetComp(driver, compList=gcomp, petLists=all_comp_proc_lists, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + + call MPI_Comm_rank(global_comm, myid, rc) + call MPI_Comm_size(global_comm, totalpes, rc) asyncio_task=.false. - total_comps = size(gcomp) + do i=1,asyncio_ntasks + if(myid == asyncio_petlist(i)) then + asyncio_task = .true. + exit + endif + enddo + + nullify(gcomp) + + driverpecount = 0 + if (.not. asyncio_task) then + call ESMF_GridCompGet(gridcomp=driver, vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_DriverGetComp(driver, compList=gcomp, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=driver_myid, petcount=driverpecount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + + if(associated(gcomp)) then + total_comps = size(gcomp) + else + total_comps = 0 + endif + + call MPI_AllReduce(MPI_IN_PLACE, total_comps, 1, MPI_INTEGER, & + MPI_MAX, Global_comm, rc) + call MPI_AllReduce(MPI_IN_PLACE, driverpecount, 1, MPI_INTEGER, & + MPI_MAX, Global_comm, rc) + allocate(pio_comp_settings(total_comps)) allocate(procs_per_comp(total_comps)) allocate(io_compid(total_comps)) allocate(io_compname(total_comps)) allocate(iosystems(total_comps)) do_async_init = 0 - - call ESMF_VMGet(vm, petCount=totalpes, localPet=myid, mpiCommunicator=driver_comm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - -! call NUOPC_CompAttributeGet(driver, name="asyncio_ntasks", value=cval, rc=rc) -! if (chkerr(rc,__LINE__,u_FILE_u)) return -! read(cval, *) asyncio_ntasks - asyncio_ntasks = 0 -! call NUOPC_CompAttributeGet(driver, name="asyncio_stride", value=cval, rc=rc) -! if (chkerr(rc,__LINE__,u_FILE_u)) return -! read(cval, *) asyncio_stride - asyncio_stride = 0 - + procs_per_comp = 0 do i=1,total_comps + if(associated(gcomp)) then + petlocal = ESMF_GridCompIsPetLocal(gcomp(i), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + petlocal = .false. + endif pio_comp_settings(i)%pio_async_interface = .false. io_compid(i) = i+1 - if (ESMF_GridCompIsPetLocal(gcomp(i), rc=rc)) then + if (petlocal) then call ESMF_GridCompGet(gcomp(i), vm=vm, name=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//": initialize component: "//trim(cval), ESMF_LOGMSG_INFO) @@ -290,35 +317,39 @@ subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) procs_per_comp(i) = npets - call NUOPC_CompAttributeGet(gcomp(i), name="pio_stride", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_stride - if(pio_comp_settings(i)%pio_stride <= 0 .or. pio_comp_settings(i)%pio_stride > npets) then - pio_comp_settings(i)%pio_stride = min(npets, default_stride) - endif - - call NUOPC_CompAttributeGet(gcomp(i), name="pio_rearranger", value=cval, rc=rc) + call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_rearranger + pio_comp_settings(i)%pio_async_interface = (trim(cval) == '.true.') + if(.not. pio_comp_settings(i)%pio_async_interface) then + call NUOPC_CompAttributeGet(gcomp(i), name="pio_stride", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_stride + if(pio_comp_settings(i)%pio_stride <= 0 .or. pio_comp_settings(i)%pio_stride > npets) then + pio_comp_settings(i)%pio_stride = min(npets, default_stride) + endif - call NUOPC_CompAttributeGet(gcomp(i), name="pio_numiotasks", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_numiotasks + call NUOPC_CompAttributeGet(gcomp(i), name="pio_rearranger", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_rearranger + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_numiotasks", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_numiotasks - if(pio_comp_settings(i)%pio_numiotasks < 0 .or. pio_comp_settings(i)%pio_numiotasks > npets) then - pio_comp_settings(i)%pio_numiotasks = max(1,npets/pio_comp_settings(i)%pio_stride) - endif + if(pio_comp_settings(i)%pio_numiotasks < 0 .or. pio_comp_settings(i)%pio_numiotasks > npets) then + pio_comp_settings(i)%pio_numiotasks = max(1,npets/pio_comp_settings(i)%pio_stride) + endif - call NUOPC_CompAttributeGet(gcomp(i), name="pio_root", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_root + call NUOPC_CompAttributeGet(gcomp(i), name="pio_root", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_root - if(pio_comp_settings(i)%pio_root < 0 .or. pio_comp_settings(i)%pio_root > npets) then - pio_comp_settings(i)%pio_root = 0 + if(pio_comp_settings(i)%pio_root < 0 .or. pio_comp_settings(i)%pio_root > npets) then + pio_comp_settings(i)%pio_root = 0 + endif endif - call NUOPC_CompAttributeGet(gcomp(i), name="pio_typename", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -336,11 +367,7 @@ subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return end select - - call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_comp_settings(i)%pio_async_interface = (trim(cval) == '.true.') - + call NUOPC_CompAttributeGet(gcomp(i), name="pio_netcdf_format", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) @@ -363,77 +390,58 @@ subroutine shr_pio_component_init(driver, Global_COMM, async_io_petlist, rc) enddo do i=1,total_comps call MPI_AllReduce(MPI_IN_PLACE, pio_comp_settings(i)%pio_async_interface, 1, MPI_LOGICAL, & - MPI_LOR, driver_comm, rc) + MPI_LOR, global_comm, rc) if(pio_comp_settings(i)%pio_async_interface) then do_async_init = do_async_init + 1 - print *,__FILE__,__LINE__,i,do_async_init endif enddo - -! -! Async IO initialization -! - - allocate(async_io_tasks(totalpes)) - j=1 - if(asyncio_ntasks > 0) then - allocate(io_proc_list(asyncio_ntasks)) - do i=1,totalpes - if (mod(i,asyncio_stride) == 0) then - io_proc_list(j) = i - j = j + 1 - if(i==myid) asyncio_task=.true. - endif - enddo - endif ! ! Get the PET list for each component using async IO ! - call MPI_Allreduce(MPI_IN_PLACE, do_async_init, 1, MPI_INTEGER, MPI_MAX, driver_comm, ierr) + call MPI_Allreduce(MPI_IN_PLACE, do_async_init, 1, MPI_INTEGER, MPI_MAX, Global_comm, ierr) + + call MPI_Allreduce(MPI_IN_PLACE, procs_per_comp, total_comps, MPI_INTEGER, MPI_MAX, Global_comm, ierr) + if (do_async_init > 0) then - allocate(comp_proc_list(totalpes, do_async_init)) + allocate(asyncio_comp_comm(do_async_init)) + allocate(comp_proc_list(driverpecount, do_async_init)) j = 1 - do i=1,total_comps - - if(pio_comp_settings(i)%pio_async_interface) then - pecnt = size(all_comp_proc_lists(i)%ptr) - comp_proc_list(1:pecnt,j) = all_comp_proc_lists(i)%ptr - j = j+1 - endif - enddo - + comp_proc_list = 0 + if(.not. asyncio_task) then + do i=1,total_comps + if(pio_comp_settings(i)%pio_async_interface) then + comp_proc_list(1+driver_myid,j) = myid + j = j+1 + endif + enddo + endif + call MPI_AllReduce(MPI_IN_PLACE, comp_proc_list, driverpecount*do_async_init, MPI_INTEGER, MPI_MAX, Global_comm, ierr) if(asyncio_ntasks == 0) then call shr_sys_abort(subname//' ERROR: ASYNC IO Requested but no IO PES assigned') endif allocate(async_iosystems(do_async_init)) allocate(async_procs_per_comp(do_async_init)) - - j=1 do i=1,total_comps if(pio_comp_settings(i)%pio_async_interface) then async_procs_per_comp(j) = procs_per_comp(i) - j = j+1 - endif enddo -! call init_intercom(async_iosystems, driver_comm, async_procs_per_comp, comp_proc_list, io_proc_list, & -! PIO_REARR_BOX) - if(asyncio_task) then - ! IO tasks should not return until the run is completed - call ESMF_FINALIZE() + ! IO tasks should not return until the run is completed + call pio_init(async_iosystems, Global_comm, async_procs_per_comp, comp_proc_list, asyncio_petlist, & + PIO_REARR_BOX, asyncio_comp_comm, io_comm) + if(.not. asyncio_task) then + j=1 + do i=1,total_comps + if(pio_comp_settings(i)%pio_async_interface) then + iosystems(i) = async_iosystems(j) + j = j+1 + endif + enddo endif - j=1 - do i=1,total_comps - if(pio_comp_settings(i)%pio_async_interface) then - iosystems(i) = async_iosystems(j) - j = j+1 - endif - enddo - print *,__FILE__,__LINE__,' async_init: ',do_async_init endif call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -466,21 +474,22 @@ subroutine shr_pio_log_comp_settings(gcomp, rc) read(cval, *) compid i = shr_pio_getindex(compid) endif - write(logunit,*) trim(name),': PIO numiotasks=', pio_comp_settings(i)%pio_numiotasks - - write(logunit, *) trim(name), ': PIO stride=',pio_comp_settings(i)%pio_stride - - write(logunit, *) trim(name),': PIO rearranger=',pio_comp_settings(i)%pio_rearranger - - write(logunit, *) trim(name),': PIO root=',pio_comp_settings(i)%pio_root - + if(pio_comp_settings(i)%pio_async_interface) then + write(logunit,*) trim(name),': using ASYNC IO interface' + else + write(logunit,*) trim(name),': PIO numiotasks=', pio_comp_settings(i)%pio_numiotasks + write(logunit, *) trim(name), ': PIO stride=',pio_comp_settings(i)%pio_stride + write(logunit, *) trim(name),': PIO rearranger=',pio_comp_settings(i)%pio_rearranger + write(logunit, *) trim(name),': PIO root=',pio_comp_settings(i)%pio_root + endif end subroutine shr_pio_log_comp_settings !=============================================================================== subroutine shr_pio_finalize( ) integer :: ierr integer :: i - do i=1,total_comps + + do i=1,size(iosystems) call pio_finalize(iosystems(i), ierr) end do diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index b8909947b..d825a172d 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -2023,6 +2023,22 @@ pio blocksize for box decompositions + + integer + 0 + run_pio + env_run.xml + Task count for asyncronous IO, only valid if PIO_ASYNC_INTERFACE is True + + + + integer + 0 + run_pio + env_run.xml + Stride of tasks for asyncronous IO, only valid if PIO_ASYNC_INTERFACE is True + + integer -1 diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index a535a0fa6..06d0d66c6 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -36,6 +36,30 @@ + + integer + pio + PELAYOUT_attributes + + IO tasks FOR ASYNC IO, only valid if ASYNCIO is true. + + + $PIO_ASYNC_IOTASKS + + + + + integer + pio + PELAYOUT_attributes + + IO tasks FOR ASYNC IO, only valid if ASYNCIO is true. + + + $PIO_ASYNC_IOSTRIDE + + + char expdef @@ -3977,6 +4001,7 @@ $ESMF_VERBOSITY_LEVEL + char mapping From 694ac852638dcb46fdc452a45154867aea55bb70 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 23 Jun 2022 11:11:23 -0600 Subject: [PATCH 090/395] fix for land coupling --- mediator/esmFldsExchange_nems_mod.F90 | 71 ++++++++++++++------------- 1 file changed, 37 insertions(+), 34 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 3561e2565..9cd801a70 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -668,40 +668,6 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end do deallocate(flds) - !===================================================================== - ! FIELDS TO LAND (complnd) - !===================================================================== - - ! to lnd - states and fluxes from atm - if ( trim(coupling_mode) == 'nems_orig_data') then - allocate(flds(16)) - flds = (/'Sa_z ', 'Sa_topo ', 'Sa_tbot ', 'Sa_pbot ', & - 'Sa_shum ', 'Sa_u ', 'Sa_v ', 'Faxa_lwdn ', & - 'Sa_ptem ', 'Sa_dens ', 'Faxa_swdn ', 'Faxa_swnet', & - 'Faxa_snowc', 'Faxa_snowl', 'Faxa_rainc', 'Faxa_rainl' /) - else - allocate(flds(9)) - flds = (/'Sa_z ', 'Sa_tbot ', 'Sa_pbot ', 'Sa_shum ', & - 'Sa_u ', 'Sa_v ', 'Faxa_swdn ', 'Faxa_lwdn ', & - 'Faxa_rain ' /) - end if - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(complnd)) then - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(complnd)%flds, trim(fldname)) - end if - else - if ( fldchk(is_local%wrap%FBexp(compatm) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(complnd,complnd), trim(fldname), rc=rc)) then - call addmap(fldListFr(compatm)%flds, trim(fldname), complnd, maptype, 'one', 'unset') - call addmrg(fldListTo(complnd)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') - end if - end if - end do - deallocate(flds) - !===================================================================== ! FIELDS TO WAV (compwav) !===================================================================== @@ -762,6 +728,43 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end do deallocate(flds) + !===================================================================== + ! FIELDS TO LAND (complnd) + !===================================================================== + + ! to lnd - states and fluxes from atm + if ( trim(coupling_mode) == 'nems_orig_data') then + allocate(flds(21)) + flds = (/'Sa_z ', 'Sa_topo ', 'Sa_tbot ', 'Sa_pbot ', & + 'Sa_shum ', 'Sa_u ', 'Sa_v ', 'Faxa_lwdn ', & + 'Sa_ptem ', 'Sa_dens ', 'Faxa_swdn ', 'Faxa_swnet', & + 'Faxa_snowc', 'Faxa_snowl', 'Faxa_rainc', 'Faxa_rainl', & + 'Sa_pslv ', & + 'Faxa_swndr', 'Faxa_swndf', 'Faxa_swvdr', 'Faxa_swvdf'/) + else + allocate(flds(9)) + flds = (/'Sa_z ', 'Sa_tbot ', 'Sa_pbot ', 'Sa_shum ', & + 'Sa_u ', 'Sa_v ', 'Faxa_swdn ', 'Faxa_lwdn ', & + 'Faxa_rain ' /) + end if + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(complnd)) then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(complnd)%flds, trim(fldname)) + end if + else + if ( fldchk(is_local%wrap%FBexp(complnd) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then + print*, "i am here !!!" + call addmap(fldListFr(compatm)%flds, trim(fldname), complnd, maptype, 'one', 'unset') + call addmrg(fldListTo(complnd)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end if + end if + end do + deallocate(flds) + end subroutine esmFldsExchange_nems end module esmFldsExchange_nems_mod From c569aa60794279f70851be6d8aef9b7769c95d94 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 23 Jun 2022 11:23:33 -0600 Subject: [PATCH 091/395] clean print statement --- mediator/esmFldsExchange_nems_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 9cd801a70..4584f4fde 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -757,7 +757,6 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(complnd) , trim(fldname), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - print*, "i am here !!!" call addmap(fldListFr(compatm)%flds, trim(fldname), complnd, maptype, 'one', 'unset') call addmrg(fldListTo(complnd)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') end if From 80408b4b10808de80053e2c84c71f72b4537a08d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 23 Jun 2022 12:53:26 -0600 Subject: [PATCH 092/395] add some comments --- cesm/driver/ensemble_driver.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index d99823f88..8ab6b437b 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -59,6 +59,8 @@ subroutine SetServices(ensemble_driver, rc) specRoutine=SetModelServices, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! The ModifyCplLists specialization happens after Advertize but before Realize and + ! is the perfect time to initialize IO. call NUOPC_CompSpecialize(ensemble_driver, specLabel=ensemble_label_ModifyCplLists, & specRoutine=InitializeIO, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -73,10 +75,12 @@ subroutine SetServices(ensemble_driver, rc) call ESMF_GridCompSet(ensemble_driver, config=config, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! The ensemble_driver does not need to InitializeDataResolution and doing so will cause a hang + ! if asyncronous IO is used. call NUOPC_CompAttributeSet(ensemble_driver, name="InitializeDataResolution", value="false", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Set a finalize method + ! Set a finalize method, it calls pio_finalize call NUOPC_CompSpecialize(ensemble_driver, specLabel=label_Finalize, & specRoutine=ensemble_finalize, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From f3e08447fdd49068b07ddeaf490380b6841142e9 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 24 Jun 2022 06:39:26 -0600 Subject: [PATCH 093/395] fix if block --- cesm/driver/ensemble_driver.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 8ab6b437b..64bf13de0 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -246,7 +246,11 @@ subroutine SetModelServices(ensemble_driver, rc) comp_task = .false. ! Determine pet list for driver instance do n=1,ntasks_per_member+pio_async_iotasks - if(pio_async_iostride == 0 .or. modulo(n,pio_async_iostride) .ne. 2) then + if(pio_async_iostride == 0) then + petList(petcnt) = currentpet + petcnt = petcnt+1 + if (currentpet == localPet) comp_task=.true. + else if(modulo(n,pio_async_iostride) .ne. 2) then petList(petcnt) = currentpet petcnt = petcnt+1 if (currentpet == localPet) comp_task=.true. From 28bcf741163e91bb4d97e5d8d16ae86b71559eff Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 5 Jul 2022 10:58:11 -0600 Subject: [PATCH 094/395] Extract non-initialization parts of shr_pio_mod to a module in share Extract the non-initialization parts of shr_pio_mod to a module in the share repository, just keeping the initialization parts here. Needs to be coordinated with a branch in the CESM_share repository. --- cesm/driver/esm.F90 | 6 +- .../{shr_pio_mod.F90 => init_pio_mod.F90} | 324 ++---------------- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 4 +- 3 files changed, 34 insertions(+), 300 deletions(-) rename cesm/nuopc_cap_share/{shr_pio_mod.F90 => init_pio_mod.F90} (58%) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index f788c2478..9be41b4d9 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -808,7 +808,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) use mpi , only : MPI_COMM_NULL, mpi_comm_size #endif use mct_mod , only : mct_world_init - use shr_pio_mod , only : shr_pio_init, shr_pio_component_init + use init_pio_mod , only : init_pio_init, init_pio_component_init #ifdef MED_PRESENT use med_internalstate_mod , only : med_id @@ -934,7 +934,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) ! Initialize PIO ! This reads in the pio parameters that are independent of component - call shr_pio_init(driver, rc=rc) + call init_pio_init(driver, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(comms(componentCount+1), comps(componentCount+1)) @@ -1182,7 +1182,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) enddo ! Read in component dependent PIO parameters and initialize ! IO systems - call shr_pio_component_init(driver, size(comps), rc) + call init_pio_component_init(driver, size(comps), rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Initialize MCT (this is needed for data models and cice prescribed capability) diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/init_pio_mod.F90 similarity index 58% rename from cesm/nuopc_cap_share/shr_pio_mod.F90 rename to cesm/nuopc_cap_share/init_pio_mod.F90 index e05a1ed99..d07cc0db1 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/init_pio_mod.F90 @@ -1,5 +1,6 @@ -module shr_pio_mod +module init_pio_mod use pio + use shr_pio_mod, only : io_compname, pio_comp_settings, iosystems, io_compid, shr_pio_getindex use shr_kind_mod, only : CS=>shr_kind_CS, shr_kind_cl, shr_kind_in use shr_file_mod, only : shr_file_getunit, shr_file_freeunit use shr_log_mod, only : shr_log_unit @@ -14,52 +15,12 @@ module shr_pio_mod #include #endif private - public :: shr_pio_init - public :: shr_pio_component_init - public :: shr_pio_getiosys - public :: shr_pio_getiotype - public :: shr_pio_getioroot - public :: shr_pio_finalize - public :: shr_pio_getioformat - public :: shr_pio_getrearranger - public :: shr_pio_log_comp_settings - - interface shr_pio_getiotype - module procedure shr_pio_getiotype_fromid, shr_pio_getiotype_fromname - end interface - interface shr_pio_getioformat - module procedure shr_pio_getioformat_fromid, shr_pio_getioformat_fromname - end interface - interface shr_pio_getiosys - module procedure shr_pio_getiosys_fromid, shr_pio_getiosys_fromname - end interface - interface shr_pio_getioroot - module procedure shr_pio_getioroot_fromid, shr_pio_getioroot_fromname - end interface - interface shr_pio_getindex - module procedure shr_pio_getindex_fromid, shr_pio_getindex_fromname - end interface - interface shr_pio_getrearranger - module procedure shr_pio_getrearranger_fromid, shr_pio_getrearranger_fromname - end interface - - type pio_comp_t - integer :: compid - integer :: pio_root - integer :: pio_stride - integer :: pio_numiotasks - integer :: pio_iotype - integer :: pio_rearranger - integer :: pio_netcdf_ioformat - logical :: pio_async_interface - end type pio_comp_t - - character(len=16), allocatable :: io_compname(:) - type(pio_comp_t), allocatable :: pio_comp_settings(:) - type (iosystem_desc_t), allocatable, target :: iosystems(:) + public :: init_pio_init + public :: init_pio_component_init + public :: init_pio_finalize + public :: init_pio_log_comp_settings + integer :: io_comm - logical :: pio_async_interface - integer, allocatable :: io_compid(:) integer :: pio_debug_level=0, pio_blocksize=0 integer(kind=pio_offset_kind) :: pio_buffer_size_limit=-1 @@ -88,7 +49,7 @@ module shr_pio_mod !! !< - subroutine shr_pio_init(driver, rc) + subroutine init_pio_init(driver, rc) use ESMF, only : ESMF_GridComp, ESMF_VM, ESMF_Config, ESMF_GridCompGet use ESMF, only : ESMF_VMGet, ESMF_RC_NOT_VALID, ESMF_LogSetError use NUOPC, only: NUOPC_CompAttributeGet @@ -104,7 +65,7 @@ subroutine shr_pio_init(driver, rc) character(len=CS) :: pio_rearr_comm_type, pio_rearr_comm_fcd character(CS) :: msgstr - character(*), parameter :: subName = '(shr_pio_init) ' + character(*), parameter :: subName = '(init_pio_init) ' call ESMF_GridCompGet(driver, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -205,9 +166,9 @@ subroutine shr_pio_init(driver, rc) write(shr_log_unit, *) " enable_isend (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%enable_isend end if - end subroutine shr_pio_init + end subroutine init_pio_init - subroutine shr_pio_component_init(driver, ncomps, rc) + subroutine init_pio_component_init(driver, ncomps, rc) use ESMF, only : ESMF_GridComp, ESMF_LogSetError, ESMF_RC_NOT_VALID, ESMF_GridCompIsCreated, ESMF_VM, ESMF_VMGet use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated use NUOPC, only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd @@ -226,6 +187,7 @@ subroutine shr_pio_component_init(driver, ncomps, rc) character(CS) :: msgstr integer :: do_async_init type(iosystem_desc_t), allocatable :: async_iosystems(:) + logical, allocatable :: pio_async_interface(:) allocate(pio_comp_settings(ncomps)) allocate(gcomp(ncomps)) @@ -234,6 +196,8 @@ subroutine shr_pio_component_init(driver, ncomps, rc) allocate(io_compname(ncomps)) allocate(iosystems(ncomps)) + allocate(pio_async_interface(ncomps)) + nullify(gcomp) do_async_init = 0 @@ -310,13 +274,13 @@ subroutine shr_pio_component_init(driver, ncomps, rc) call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_comp_settings(i)%pio_async_interface = (trim(cval) == '.true.') + pio_async_interface(i) = (trim(cval) == '.true.') call NUOPC_CompAttributeGet(gcomp(i), name="pio_netcdf_format", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) + call init_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) - if (pio_comp_settings(i)%pio_async_interface) then + if (pio_async_interface(i)) then do_async_init = do_async_init + 1 else if(pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then @@ -335,7 +299,7 @@ subroutine shr_pio_component_init(driver, ncomps, rc) allocate(async_iosystems(do_async_init)) j=1 do i=1,total_comps - if(pio_comp_settings(i)%pio_async_interface) then + if(pio_async_interface(i)) then iosystems(i) = async_iosystems(j) j = j+1 endif @@ -344,9 +308,9 @@ subroutine shr_pio_component_init(driver, ncomps, rc) endif deallocate(gcomp) - end subroutine shr_pio_component_init + end subroutine init_pio_component_init - subroutine shr_pio_log_comp_settings(gcomp, logunit) + subroutine init_pio_log_comp_settings(gcomp, logunit) use ESMF, only : ESMF_GridComp, ESMF_GridCompGet use NUOPC, only: NUOPC_CompAttributeGet @@ -377,173 +341,21 @@ subroutine shr_pio_log_comp_settings(gcomp, logunit) write(logunit, *) trim(name),': PIO root=',pio_comp_settings(i)%pio_root - end subroutine shr_pio_log_comp_settings + end subroutine init_pio_log_comp_settings !=============================================================================== - subroutine shr_pio_finalize( ) + subroutine init_pio_finalize( ) integer :: ierr integer :: i do i=1,total_comps call pio_finalize(iosystems(i), ierr) end do - end subroutine shr_pio_finalize - -!=============================================================================== - function shr_pio_getiotype_fromid(compid) result(io_type) - integer, intent(in) :: compid - integer :: io_type - - io_type = pio_comp_settings(shr_pio_getindex(compid))%pio_iotype - - end function shr_pio_getiotype_fromid - - - function shr_pio_getiotype_fromname(component) result(io_type) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - character(len=*), intent(in) :: component - integer :: io_type - - io_type = pio_comp_settings(shr_pio_getindex(component))%pio_iotype - - end function shr_pio_getiotype_fromname - - function shr_pio_getrearranger_fromid(compid) result(io_type) - integer, intent(in) :: compid - integer :: io_type - - io_type = pio_comp_settings(shr_pio_getindex(compid))%pio_rearranger - - end function shr_pio_getrearranger_fromid - - - function shr_pio_getrearranger_fromname(component) result(io_type) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - character(len=*), intent(in) :: component - integer :: io_type - - io_type = pio_comp_settings(shr_pio_getindex(component))%pio_rearranger - - end function shr_pio_getrearranger_fromname - - function shr_pio_getioformat_fromid(compid) result(io_format) - integer, intent(in) :: compid - integer :: io_format - - io_format = pio_comp_settings(shr_pio_getindex(compid))%pio_netcdf_ioformat - - end function shr_pio_getioformat_fromid - - - function shr_pio_getioformat_fromname(component) result(io_format) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - character(len=*), intent(in) :: component - integer :: io_format - - io_format = pio_comp_settings(shr_pio_getindex(component))%pio_netcdf_ioformat - - end function shr_pio_getioformat_fromname - -!=============================================================================== - function shr_pio_getioroot_fromid(compid) result(io_root) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - integer, intent(in) :: compid - integer :: io_root - - io_root = pio_comp_settings(shr_pio_getindex(compid))%pio_root - - end function shr_pio_getioroot_fromid - - function shr_pio_getioroot_fromname(component) result(io_root) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - character(len=*), intent(in) :: component - integer :: io_root - - io_root = pio_comp_settings(shr_pio_getindex(component))%pio_root - - - end function shr_pio_getioroot_fromname - + end subroutine init_pio_finalize !=============================================================================== - !! Given a component name, return the index of that component. - !! This is the index into io_compid, io_compname, comp_pio_iotype, etc. - !! If the given component is not found, return -1 - - integer function shr_pio_getindex_fromid(compid) result(index) - implicit none - integer, intent(in) :: compid - integer :: i - character(len=shr_kind_cl) :: msg - index = -1 - do i=1,total_comps - if(io_compid(i)==compid) then - index = i - exit - end if - end do - - if(index<0) then - write(msg, *) 'shr_pio_getindex :: compid=',compid,' out of allowed range: ' - call shr_sys_abort(msg) - end if - end function shr_pio_getindex_fromid - - - integer function shr_pio_getindex_fromname(component) result(index) - use shr_string_mod, only : shr_string_toupper - - implicit none - - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - character(len=*), intent(in) :: component - - character(len=len(component)) :: component_ucase - integer :: i - - ! convert component name to upper case in order to match case in io_compname - component_ucase = shr_string_toUpper(component) - - index = -1 ! flag for not found - do i=1,size(io_compname) - if (trim(component_ucase) == trim(io_compname(i))) then - index = i - exit - end if - end do - if(index<0) then - call shr_sys_abort(' shr_pio_getindex:: compid out of allowed range') - end if - end function shr_pio_getindex_fromname - - function shr_pio_getiosys_fromid(compid) result(iosystem) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - integer, intent(in) :: compid - type(iosystem_desc_t), pointer :: iosystem - - iosystem => iosystems(shr_pio_getindex(compid)) - - end function shr_pio_getiosys_fromid - - function shr_pio_getiosys_fromname(component) result(iosystem) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - character(len=*), intent(in) :: component - type(iosystem_desc_t), pointer :: iosystem - - iosystem => iosystems(shr_pio_getindex(component)) - - end function shr_pio_getiosys_fromname - - subroutine shr_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, pio_default_netcdf_ioformat) + subroutine init_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, pio_default_netcdf_ioformat) use shr_string_mod, only : shr_string_toupper character(len=*), intent(inout) :: pio_netcdf_format integer, intent(out) :: pio_netcdf_ioformat @@ -560,10 +372,10 @@ subroutine shr_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, p pio_netcdf_ioformat = pio_default_netcdf_ioformat endif - end subroutine shr_pio_getioformatfromname + end subroutine init_pio_getioformatfromname - subroutine shr_pio_getiotypefromname(typename, iotype, defaulttype) + subroutine init_pio_getiotypefromname(typename, iotype, defaulttype) use shr_string_mod, only : shr_string_toupper character(len=*), intent(inout) :: typename integer, intent(out) :: iotype @@ -583,90 +395,12 @@ subroutine shr_pio_getiotypefromname(typename, iotype, defaulttype) else if ( typename .eq. 'DEFAULT') then iotype = defaulttype else - write(shr_log_unit,*) 'shr_pio_mod: WARNING Bad io_type argument - using iotype_netcdf' + write(shr_log_unit,*) 'init_pio_mod: WARNING Bad io_type argument - using iotype_netcdf' iotype=pio_iotype_netcdf end if - end subroutine shr_pio_getiotypefromname - -!=============================================================================== - subroutine shr_pio_namelist_set(npes,mycomm, pio_stride, pio_root, pio_numiotasks, & - pio_iotype, iamroot, pio_rearranger, pio_netcdf_ioformat) - integer, intent(in) :: npes, mycomm - integer, intent(inout) :: pio_stride, pio_root, pio_numiotasks - integer, intent(inout) :: pio_iotype, pio_rearranger, pio_netcdf_ioformat - logical, intent(in) :: iamroot - character(*),parameter :: subName = '(shr_pio_namelist_set) ' - - call shr_mpi_bcast(pio_iotype , mycomm) - call shr_mpi_bcast(pio_stride , mycomm) - call shr_mpi_bcast(pio_root , mycomm) - call shr_mpi_bcast(pio_numiotasks, mycomm) - call shr_mpi_bcast(pio_rearranger, mycomm) - call shr_mpi_bcast(pio_netcdf_ioformat, mycomm) - - if (pio_root<0) then - pio_root = 1 - endif - if(.not. pio_async_interface) then - pio_root = min(pio_root,npes-1) -! If you are asking for parallel IO then you should use at least two io pes - if(npes > 1 .and. pio_numiotasks == 1 .and. & - (pio_iotype .eq. PIO_IOTYPE_PNETCDF .or. & - pio_iotype .eq. PIO_IOTYPE_NETCDF4P)) then - pio_numiotasks = 2 - pio_stride = min(pio_stride, npes/2) - endif - endif - - !-------------------------------------------------------------------------- - ! check/set/correct io pio parameters - !-------------------------------------------------------------------------- - if (pio_stride>0.and.pio_numiotasks<0) then - pio_numiotasks = max(1,npes/pio_stride) - else if(pio_numiotasks>0 .and. pio_stride<0) then - pio_stride = max(1,npes/pio_numiotasks) - else if(pio_numiotasks<0 .and. pio_stride<0) then - pio_stride = max(1,npes/4) - pio_numiotasks = max(1,npes/pio_stride) - end if - if(pio_stride == 1 .and. .not. pio_async_interface) then - pio_root = 0 - endif - if(pio_rearranger .ne. PIO_REARR_SUBSET .and. pio_rearranger .ne. PIO_REARR_BOX) then - write(shr_log_unit,*) 'pio_rearranger value, ',pio_rearranger,& - ', not supported - using PIO_REARR_BOX' - pio_rearranger = PIO_REARR_BOX - - endif - - - if (.not. pio_async_interface .and. & - pio_root + (pio_stride)*(pio_numiotasks-1) >= npes .or. & - pio_stride<=0 .or. pio_numiotasks<=0 .or. pio_root < 0 .or. & - pio_root > npes-1 ) then - if(npes<100) then - pio_stride = max(1,npes/4) - else if(npes<1000) then - pio_stride = max(1,npes/8) - else - pio_stride = max(1,npes/16) - end if - if(pio_stride>1) then - pio_numiotasks = npes/pio_stride - pio_root = min(1,npes-1) - else - pio_numiotasks = npes - pio_root = 0 - end if - if( iamroot) then - write(shr_log_unit,*) 'pio_stride, iotasks or root out of bounds - resetting to defaults: ',& - pio_stride,pio_numiotasks, pio_root - end if - end if - - end subroutine shr_pio_namelist_set + end subroutine init_pio_getiotypefromname !=============================================================================== -end module shr_pio_mod +end module init_pio_mod diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index da7891c49..4fe80b534 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -132,7 +132,7 @@ end subroutine get_component_instance !=============================================================================== subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) - use shr_pio_mod, only : shr_pio_log_comp_settings + use init_pio_mod, only : init_pio_log_comp_settings ! input/output variables type(ESMF_GridComp) :: gcomp logical, intent(in) :: mastertask @@ -165,7 +165,7 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) ! Write the PIO settings to the beggining of each component log - call shr_pio_log_comp_settings(gcomp, logunit) + call init_pio_log_comp_settings(gcomp, logunit) else logUnit = 6 From 67ae99bf62ef9dd49428d5e426c523477554195a Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 5 Jul 2022 11:48:48 -0600 Subject: [PATCH 095/395] more log info --- cesm/driver/ensemble_driver.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 64bf13de0..5a1e2124f 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -361,6 +361,7 @@ subroutine InitializeIO(ensemble_driver, rc) call ESMF_LogWrite(trim(subname)//": call shr_pio_component_init"//compname, ESMF_LOGMSG_INFO) call shr_pio_component_init(dcomp(drv), Global_Comm, asyncio_petlist, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": shr_pio_component_init done"//compname, ESMF_LOGMSG_INFO) endif enddo deallocate(asyncio_petlist) From 03ce9b7b31c5163038b47f528cd2218cc6b35471 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 5 Jul 2022 14:56:52 -0600 Subject: [PATCH 096/395] Make pio_async_interface a module-level variable This will be needed for https://github.com/ESCOMP/CMEPS/pull/305, where this variable is now referenced from another subroutine as well. --- cesm/nuopc_cap_share/init_pio_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cesm/nuopc_cap_share/init_pio_mod.F90 b/cesm/nuopc_cap_share/init_pio_mod.F90 index d07cc0db1..94d6dc86e 100644 --- a/cesm/nuopc_cap_share/init_pio_mod.F90 +++ b/cesm/nuopc_cap_share/init_pio_mod.F90 @@ -25,6 +25,7 @@ module init_pio_mod integer(kind=pio_offset_kind) :: pio_buffer_size_limit=-1 type(pio_rearr_opt_t) :: pio_rearr_opts + logical, allocatable :: pio_async_interface(:) integer :: total_comps logical :: mastertask @@ -187,7 +188,6 @@ subroutine init_pio_component_init(driver, ncomps, rc) character(CS) :: msgstr integer :: do_async_init type(iosystem_desc_t), allocatable :: async_iosystems(:) - logical, allocatable :: pio_async_interface(:) allocate(pio_comp_settings(ncomps)) allocate(gcomp(ncomps)) From 1f8ce1304a7c0939cbc4584e1b5afa5165821fb6 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 5 Jul 2022 16:10:21 -0600 Subject: [PATCH 097/395] Rename init_pio to driver_pio As per Jim Edwards suggestion (https://github.com/ESCOMP/CESM_CPL7andDataComps/pull/16#pullrequestreview-1029231612) --- cesm/driver/esm.F90 | 6 +-- .../{init_pio_mod.F90 => driver_pio_mod.F90} | 42 +++++++++---------- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 4 +- 3 files changed, 26 insertions(+), 26 deletions(-) rename cesm/nuopc_cap_share/{init_pio_mod.F90 => driver_pio_mod.F90} (93%) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index 9be41b4d9..b6f39ad52 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -808,7 +808,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) use mpi , only : MPI_COMM_NULL, mpi_comm_size #endif use mct_mod , only : mct_world_init - use init_pio_mod , only : init_pio_init, init_pio_component_init + use driver_pio_mod , only : driver_pio_init, driver_pio_component_init #ifdef MED_PRESENT use med_internalstate_mod , only : med_id @@ -934,7 +934,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) ! Initialize PIO ! This reads in the pio parameters that are independent of component - call init_pio_init(driver, rc=rc) + call driver_pio_init(driver, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(comms(componentCount+1), comps(componentCount+1)) @@ -1182,7 +1182,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) enddo ! Read in component dependent PIO parameters and initialize ! IO systems - call init_pio_component_init(driver, size(comps), rc) + call driver_pio_component_init(driver, size(comps), rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Initialize MCT (this is needed for data models and cice prescribed capability) diff --git a/cesm/nuopc_cap_share/init_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 similarity index 93% rename from cesm/nuopc_cap_share/init_pio_mod.F90 rename to cesm/nuopc_cap_share/driver_pio_mod.F90 index 94d6dc86e..0e743d669 100644 --- a/cesm/nuopc_cap_share/init_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -1,4 +1,4 @@ -module init_pio_mod +module driver_pio_mod use pio use shr_pio_mod, only : io_compname, pio_comp_settings, iosystems, io_compid, shr_pio_getindex use shr_kind_mod, only : CS=>shr_kind_CS, shr_kind_cl, shr_kind_in @@ -15,10 +15,10 @@ module init_pio_mod #include #endif private - public :: init_pio_init - public :: init_pio_component_init - public :: init_pio_finalize - public :: init_pio_log_comp_settings + public :: driver_pio_init + public :: driver_pio_component_init + public :: driver_pio_finalize + public :: driver_pio_log_comp_settings integer :: io_comm integer :: pio_debug_level=0, pio_blocksize=0 @@ -50,7 +50,7 @@ module init_pio_mod !! !< - subroutine init_pio_init(driver, rc) + subroutine driver_pio_init(driver, rc) use ESMF, only : ESMF_GridComp, ESMF_VM, ESMF_Config, ESMF_GridCompGet use ESMF, only : ESMF_VMGet, ESMF_RC_NOT_VALID, ESMF_LogSetError use NUOPC, only: NUOPC_CompAttributeGet @@ -66,7 +66,7 @@ subroutine init_pio_init(driver, rc) character(len=CS) :: pio_rearr_comm_type, pio_rearr_comm_fcd character(CS) :: msgstr - character(*), parameter :: subName = '(init_pio_init) ' + character(*), parameter :: subName = '(driver_pio_init) ' call ESMF_GridCompGet(driver, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -167,9 +167,9 @@ subroutine init_pio_init(driver, rc) write(shr_log_unit, *) " enable_isend (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%enable_isend end if - end subroutine init_pio_init + end subroutine driver_pio_init - subroutine init_pio_component_init(driver, ncomps, rc) + subroutine driver_pio_component_init(driver, ncomps, rc) use ESMF, only : ESMF_GridComp, ESMF_LogSetError, ESMF_RC_NOT_VALID, ESMF_GridCompIsCreated, ESMF_VM, ESMF_VMGet use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated use NUOPC, only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd @@ -278,7 +278,7 @@ subroutine init_pio_component_init(driver, ncomps, rc) call NUOPC_CompAttributeGet(gcomp(i), name="pio_netcdf_format", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call init_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) + call driver_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) if (pio_async_interface(i)) then do_async_init = do_async_init + 1 @@ -308,9 +308,9 @@ subroutine init_pio_component_init(driver, ncomps, rc) endif deallocate(gcomp) - end subroutine init_pio_component_init + end subroutine driver_pio_component_init - subroutine init_pio_log_comp_settings(gcomp, logunit) + subroutine driver_pio_log_comp_settings(gcomp, logunit) use ESMF, only : ESMF_GridComp, ESMF_GridCompGet use NUOPC, only: NUOPC_CompAttributeGet @@ -341,21 +341,21 @@ subroutine init_pio_log_comp_settings(gcomp, logunit) write(logunit, *) trim(name),': PIO root=',pio_comp_settings(i)%pio_root - end subroutine init_pio_log_comp_settings + end subroutine driver_pio_log_comp_settings !=============================================================================== - subroutine init_pio_finalize( ) + subroutine driver_pio_finalize( ) integer :: ierr integer :: i do i=1,total_comps call pio_finalize(iosystems(i), ierr) end do - end subroutine init_pio_finalize + end subroutine driver_pio_finalize !=============================================================================== - subroutine init_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, pio_default_netcdf_ioformat) + subroutine driver_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, pio_default_netcdf_ioformat) use shr_string_mod, only : shr_string_toupper character(len=*), intent(inout) :: pio_netcdf_format integer, intent(out) :: pio_netcdf_ioformat @@ -372,10 +372,10 @@ subroutine init_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, pio_netcdf_ioformat = pio_default_netcdf_ioformat endif - end subroutine init_pio_getioformatfromname + end subroutine driver_pio_getioformatfromname - subroutine init_pio_getiotypefromname(typename, iotype, defaulttype) + subroutine driver_pio_getiotypefromname(typename, iotype, defaulttype) use shr_string_mod, only : shr_string_toupper character(len=*), intent(inout) :: typename integer, intent(out) :: iotype @@ -395,12 +395,12 @@ subroutine init_pio_getiotypefromname(typename, iotype, defaulttype) else if ( typename .eq. 'DEFAULT') then iotype = defaulttype else - write(shr_log_unit,*) 'init_pio_mod: WARNING Bad io_type argument - using iotype_netcdf' + write(shr_log_unit,*) 'driver_pio_mod: WARNING Bad io_type argument - using iotype_netcdf' iotype=pio_iotype_netcdf end if - end subroutine init_pio_getiotypefromname + end subroutine driver_pio_getiotypefromname !=============================================================================== -end module init_pio_mod +end module driver_pio_mod diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index 4fe80b534..8d472902b 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -132,7 +132,7 @@ end subroutine get_component_instance !=============================================================================== subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) - use init_pio_mod, only : init_pio_log_comp_settings + use driver_pio_mod, only : driver_pio_log_comp_settings ! input/output variables type(ESMF_GridComp) :: gcomp logical, intent(in) :: mastertask @@ -165,7 +165,7 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) ! Write the PIO settings to the beggining of each component log - call init_pio_log_comp_settings(gcomp, logunit) + call driver_pio_log_comp_settings(gcomp, logunit) else logUnit = 6 From 639adab757c4fc4b8275a7ad496c3c3c65043f48 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 6 Jul 2022 14:10:53 -0600 Subject: [PATCH 098/395] cleanup and comment --- cesm/driver/ensemble_driver.F90 | 23 ++++++++++++++++++++--- cesm/nuopc_cap_share/shr_pio_mod.F90 | 5 +++-- 2 files changed, 23 insertions(+), 5 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 5a1e2124f..778b9ecf1 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -21,6 +21,7 @@ module Ensemble_driver integer, allocatable :: asyncio_petlist(:) logical :: asyncio_task=.false. + logical :: asyncIO_available=.false. character(*),parameter :: u_FILE_u = & __FILE__ @@ -44,6 +45,7 @@ subroutine SetServices(ensemble_driver, rc) ! local variables type(ESMF_Config) :: config + logical :: isPresent ! Check to see if InitializeDataResolution attribute is available character(len=*), parameter :: subname = '('//__FILE__//':SetServices)' !--------------------------------------- @@ -75,11 +77,20 @@ subroutine SetServices(ensemble_driver, rc) call ESMF_GridCompSet(ensemble_driver, config=config, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! NUOPC component drivers end the initialization process with an internal call to InitializeDataResolution. ! The ensemble_driver does not need to InitializeDataResolution and doing so will cause a hang - ! if asyncronous IO is used. - call NUOPC_CompAttributeSet(ensemble_driver, name="InitializeDataResolution", value="false", rc=rc) + ! if asyncronous IO is used. This attribute is available after ESMF8.4.0b03 to toggle that control. + ! Cannot use asyncIO with older ESMF versions. + call NUOPC_CompAttributeGet(ensemble_driver, name="InitializeDataResolution", & + isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if(isPresent) then + call NUOPC_CompAttributeSet(ensemble_driver, name="InitializeDataResolution", value="false", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + asyncIO_available = .true. + endif + ! Set a finalize method, it calls pio_finalize call NUOPC_CompSpecialize(ensemble_driver, specLabel=label_Finalize, & specRoutine=ensemble_finalize, rc=rc) @@ -213,7 +224,7 @@ subroutine SetModelServices(ensemble_driver, rc) call NUOPC_CompAttributeGet(ensemble_driver, name="ninst", value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) number_of_members - + call NUOPC_CompAttributeGet(ensemble_driver, name="pio_async_iotasks", value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) pio_async_iotasks @@ -233,6 +244,11 @@ subroutine SetModelServices(ensemble_driver, rc) return endif + if(pio_async_iotasks > 0 .and. .not. asyncIO_available) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg="AsyncIO requires ESMF version 8.4.0b03 or newer", line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + !------------------------------------------- ! Loop over number of ensemblel members !------------------------------------------- @@ -367,6 +383,7 @@ subroutine InitializeIO(ensemble_driver, rc) deallocate(asyncio_petlist) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine InitializeIO + subroutine ensemble_finalize(ensemble_driver, rc) use ESMF, only : ESMF_GridComp, ESMF_SUCCESS use shr_pio_mod, only: shr_pio_finalize diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/shr_pio_mod.F90 index 0ec27ab5b..2d0649131 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/shr_pio_mod.F90 @@ -261,8 +261,9 @@ subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) nullify(gcomp) - driverpecount = 0 - if (.not. asyncio_task) then + if (asyncio_task) then + driverpecount = 0 + else call ESMF_GridCompGet(gridcomp=driver, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From 1ec59d0858bdf0636b2077e5a17c7c9c9b9de265 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 6 Jul 2022 14:37:55 -0600 Subject: [PATCH 099/395] add to use statement --- cesm/driver/ensemble_driver.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 778b9ecf1..2e7cfa73b 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -32,6 +32,7 @@ module Ensemble_driver subroutine SetServices(ensemble_driver, rc) use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSpecialize, NUOPC_CompAttributeSet + use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Driver , only : driver_routine_SS => SetServices use NUOPC_Driver , only : ensemble_label_SetModelServices => label_SetModelServices use NUOPC_Driver , only : ensemble_label_ModifyCplLists => label_ModifyCplLists From 2930f6b13fd9d707d008c14a11ec96a2c8bfba65 Mon Sep 17 00:00:00 2001 From: mvertens Date: Fri, 8 Jul 2022 09:31:45 -0600 Subject: [PATCH 100/395] CESM specific - activated atm/ocn flux scheme2 (#307) * added atm/ocn flux scheme2 capability to CESM --- cesm/flux_atmocn/shr_flux_mod.F90 | 20 +++++++++++++++++--- cime_config/namelist_definition_drv.xml | 12 +++++++++++- mediator/esmFldsExchange_cesm_mod.F90 | 1 + mediator/med_phases_aofluxes_mod.F90 | 15 ++++++++++++++- 4 files changed, 43 insertions(+), 5 deletions(-) diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index 87d8be9d5..9e74abf28 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -133,8 +133,8 @@ end subroutine shr_flux_adjust_constants ! Thomas Toniazzo (Bjerknes Centre, Bergen) ” !=============================================================================== SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & - & qbot ,s16O ,sHDO ,s18O ,rbot , & - & tbot ,us ,vs , & + & qbot ,s16O ,sHDO ,s18O ,rbot, & + & tbot ,us ,vs, pslv, & & ts ,mask , seq_flux_atmocn_minwind, & & sen ,lat ,lwup , & & r16O, rhdo, r18O, & @@ -169,6 +169,7 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) + real(R8) ,intent(in) :: pslv (nMax) ! atm sea level pressure(Pa) real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) real(R8) ,intent(in) :: ts (nMax) ! ocn temperature (K) @@ -553,9 +554,22 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & endif ENDDO + else if (ocn_surface_flux_scheme .eq. 2) then + + call flux_atmOcn_UA(logunit,& + nMax, zbot, ubot, vbot, thbot, & + qbot, s16O, sHDO, s18O, rbot, & + tbot, pslv, us, vs, & + ts, mask, sen, lat, lwup, & + r16O, rhdo, r18O, & + evap, evap_16O, evap_HDO, evap_18O, & + taux, tauy, tref, qref, & + duu10n, ustar_sv, re_sv, ssq_sv, & + missval) + else - call shr_sys_abort(subName//" subroutine flux_atmOcn requires ocn_surface_flux_scheme = 0 or 1") + call shr_sys_abort(subName//" subroutine flux_atmOcn requires ocn_surface_flux_scheme = 0, 1 or 2") endif !! ocn_surface_flux_scheme diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index a535a0fa6..f4d366913 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -894,7 +894,17 @@ ogrid - + + integer + control + MED_attributes + + atm/ocn flux calculation scheme + + + 0 + + real control diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 9bf8062eb..48ac2a2ed 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -291,6 +291,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap(fldListFr(compatm)%flds, 'Sa_shum', compocn, mapbilnr, 'one', atm2ocn_map) call addmap(fldListFr(compatm)%flds, 'Sa_ptem', compocn, mapbilnr, 'one', atm2ocn_map) call addmap(fldListFr(compatm)%flds, 'Sa_dens', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_map) if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_shum_wiso', rc=rc)) then call addmap(fldListFr(compatm)%flds, 'Sa_shum_wiso', compocn, mapbilnr, 'one', atm2ocn_map) end if diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 582a622a4..c0c442a7f 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -398,6 +398,12 @@ subroutine med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc) else ocn_surface_flux_scheme = 0 end if +#ifdef CESMCOUPLED + if (mastertask) then + write(logunit,*) + write(logunit,'(a)') trim(subname)//' ocn_surface_flux_scheme is '//trim(cvalue) + end if +#endif ! bottom level potential temperature and/or botom level density ! will need to be computed if not received from the atm @@ -1050,7 +1056,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) nMax=aoflux_in%lsize, & zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, qbot=aoflux_in%shum, & s16O=aoflux_in%shum_16O, sHDO=aoflux_in%shum_HDO, s18O=aoflux_in%shum_18O, rbot=aoflux_in%dens, & - tbot=aoflux_in%tbot, us=aoflux_in%uocn, vs=aoflux_in%vocn, ts=aoflux_in%tocn, & + tbot=aoflux_in%tbot, us=aoflux_in%uocn, vs=aoflux_in%vocn, pslv=aoflux_in%psfc, ts=aoflux_in%tocn, & mask=aoflux_in%mask, seq_flux_atmocn_minwind=0.5_r8, & sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, & r16O=aoflux_in%roce_16O, rhdo=aoflux_in%roce_HDO, r18O=aoflux_in%roce_18O, & @@ -1507,6 +1513,8 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r ! Set pointers for aoflux_in attributes ! Note that if computation is on the xgrid, fldbun_a and fldbun_o are both fldbun_x + use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk + ! input/output variables type(ESMF_FieldBundle) , intent(inout) :: fldbun_a type(ESMF_FieldBundle) , intent(inout) :: fldbun_o @@ -1575,6 +1583,11 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (chkerr(rc,__LINE__,u_FILE_u)) return end if + if (FB_fldchk(fldbun_a, 'Sa_pslv', rc=rc)) then + call fldbun_getfldptr(fldbun_a, 'Sa_pslv', aoflux_in%psfc, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + ! if either density or potential temperature are computed, will need bottom level pressure if (compute_atm_dens .or. compute_atm_thbot) then call fldbun_getfldptr(fldbun_a, 'Sa_pbot', aoflux_in%pbot, xgrid=xgrid, rc=rc) From f56af792ad4fe4e02cdaabff49f655a8ba2308c9 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 13 Jul 2022 13:22:23 -0600 Subject: [PATCH 101/395] state as of now --- cesm/driver/ensemble_driver.F90 | 80 ++++++++++++++-------- cesm/driver/esm.F90 | 49 +++++++++---- cesm/driver/esm_time_mod.F90 | 18 ++--- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 4 +- cesm/nuopc_cap_share/shr_pio_mod.F90 | 3 + cime_config/config_component.xml | 16 +++-- cime_config/namelist_definition_drv.xml | 24 +++++-- 7 files changed, 133 insertions(+), 61 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 2e7cfa73b..975649719 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -62,8 +62,10 @@ subroutine SetServices(ensemble_driver, rc) specRoutine=SetModelServices, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! The ModifyCplLists specialization happens after Advertize but before Realize and - ! is the perfect time to initialize IO. + ! ModifyCplLists is a NUOPC specialization which happens after Advertize but before Realize + ! We have overloaded this specialization location to initilize IO. + ! So after all components have called Advertise but before any component calls Realize + ! IO will be initialized and any async IO tasks will be split off to the PIO async IO driver. call NUOPC_CompSpecialize(ensemble_driver, specLabel=ensemble_label_ModifyCplLists, & specRoutine=InitializeIO, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -91,7 +93,6 @@ subroutine SetServices(ensemble_driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return asyncIO_available = .true. endif - ! Set a finalize method, it calls pio_finalize call NUOPC_CompSpecialize(ensemble_driver, specLabel=label_Finalize, & specRoutine=ensemble_finalize, rc=rc) @@ -142,8 +143,9 @@ subroutine SetModelServices(ensemble_driver, rc) integer :: currentpet, petcnt, iopetcnt integer :: number_of_members integer :: ntasks_per_member - integer :: pio_async_iotasks - integer :: pio_async_iostride + integer :: pio_asyncio_ntasks + integer :: pio_asyncio_stride + integer :: pio_asyncio_rootpe character(CL) :: start_type ! Type of startup character(len=7) :: drvrinst character(len=5) :: inst_suffix @@ -226,26 +228,30 @@ subroutine SetModelServices(ensemble_driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) number_of_members - call NUOPC_CompAttributeGet(ensemble_driver, name="pio_async_iotasks", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="pio_asyncio_ntasks", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) pio_asyncio_ntasks + + call NUOPC_CompAttributeGet(ensemble_driver, name="pio_asyncio_stride", value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) pio_async_iotasks + read(cvalue,*) pio_asyncio_stride - call NUOPC_CompAttributeGet(ensemble_driver, name="pio_async_iostride", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="pio_asyncio_rootpe", value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) pio_async_iostride + read(cvalue,*) pio_asyncio_rootpe call ESMF_VMGet(vm, localPet=localPet, PetCount=PetCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ntasks_per_member = PetCount/number_of_members - pio_async_iotasks - if(ntasks_per_member*number_of_members .ne. (PetCount - pio_async_iotasks)) then + ntasks_per_member = PetCount/number_of_members - pio_asyncio_ntasks + if(ntasks_per_member*number_of_members .ne. (PetCount - pio_asyncio_ntasks)) then write (msgstr,'(a,i5,a,i3,a,i3,a)') & - "PetCount - Async IOtasks (",PetCount-pio_async_iotasks,") must be evenly divisable by number of members (",number_of_members,")" + "PetCount - Async IOtasks (",PetCount-pio_asyncio_ntasks,") must be evenly divisable by number of members (",number_of_members,")" call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return endif - if(pio_async_iotasks > 0 .and. .not. asyncIO_available) then + if(pio_asyncio_ntasks > 0 .and. .not. asyncIO_available) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg="AsyncIO requires ESMF version 8.4.0b03 or newer", line=__LINE__, file=__FILE__, rcToReturn=rc) return endif @@ -255,35 +261,55 @@ subroutine SetModelServices(ensemble_driver, rc) !------------------------------------------- allocate(petList(ntasks_per_member)) - allocate(asyncio_petlist(pio_async_iotasks)) - currentpet = 0 + ! Create an asyncio petlist (a list of Pets who will be dedicated to IO). All components + ! with async IO enabled will use these IO PETS. If stride = MPI_TASKS_PER_NODE then there will + ! be one IO task per node. + allocate(asyncio_petlist(pio_asyncio_ntasks)) iopetcnt = 1 + currentPet = 0 + + do n=1,pio_asyncio_ntasks + asyncio_petlist(n) = pio_asyncio_rootpe + (n-1)*pio_asyncio_stride + if (localPet == asyncio_petlist(n)) asyncio_task = .true. +! if (asyncio_petlist(n) == currentPet) currentPet = currentPet + 1 + enddo + + do inst=1,number_of_members petcnt=1 comp_task = .false. ! Determine pet list for driver instance - do n=1,ntasks_per_member+pio_async_iotasks - if(pio_async_iostride == 0) then + do n=1,ntasks_per_member+pio_asyncio_ntasks + if(pio_asyncio_stride == 0) then petList(petcnt) = currentpet petcnt = petcnt+1 - if (currentpet == localPet) comp_task=.true. - else if(modulo(n,pio_async_iostride) .ne. 2) then + if (currentpet == localPet) comp_task=.true. + else if(pio_asyncio_stride == 1) then + if (currentpet < asyncio_petlist(1) .or. currentpet > asyncio_petlist(pio_asyncio_ntasks)) then + petList(petcnt) = currentpet + petcnt = petcnt+1 + if (currentpet == localPet) comp_task=.true. + endif + else if(modulo(n-1,pio_asyncio_stride) .ne. pio_asyncio_rootpe) then petList(petcnt) = currentpet petcnt = petcnt+1 - if (currentpet == localPet) comp_task=.true. - else - asyncio_petlist(iopetcnt) = currentpet - iopetcnt = iopetcnt + 1 - if (currentpet == localPet) asyncio_task=.true. + if (currentpet == localPet) comp_task=.true. endif currentpet = currentpet + 1 enddo + if(asyncio_task .and. comp_task) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg="task is set as both a compute task and an asyncio task", line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif ! Add driver instance to ensemble driver write(drvrinst,'(a,i4.4)') "ESM",inst call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=driver, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - + if (chkerr(rc,__LINE__,u_FILE_u)) then + write(msgstr,*) 'size(petList):', size(petList), ' petcnt:', petcnt, ' petList: ',petList + call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif mastertask = .false. if (comp_task) then @@ -313,7 +339,7 @@ subroutine SetModelServices(ensemble_driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Set the driver log to the driver task 0 - if (mod(localPet, ntasks_per_member) == 0) then + if (petList(1) == localPet) then call NUOPC_CompAttributeGet(driver, name="diro", value=diro, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(driver, name="logfile", value=logfile, rc=rc) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index cb4bc09e3..e40ca1f87 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -801,7 +801,8 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) use ESMF , only : ESMF_ConfigGetLen, ESMF_LogFoundAllocError, ESMF_ConfigGetAttribute use ESMF , only : ESMF_RC_NOT_VALID, ESMF_LogSetError, ESMF_Info, ESMF_InfoSet use ESMF , only : ESMF_GridCompIsPetLocal, ESMF_MethodAdd, ESMF_UtilStringLowerCase - use ESMF , only : ESMF_InfoCreate, ESMF_InfoDestroy + use ESMF , only : ESMF_InfoCreate, ESMF_InfoDestroy, ESMF_VMGetGlobal + use ESMF , only : ESMF_VMAllGather use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Driver , only : NUOPC_DriverAddComp #ifndef NO_MPI2 @@ -870,11 +871,14 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) ! local variables type(ESMF_GridComp) :: child type(ESMF_VM) :: vm + type(ESMF_VM) :: globalvm type(ESMF_Config) :: config type(ESMF_Info) :: info integer :: componentcount integer :: PetCount integer :: LocalPet + integer :: PetIDinGlobal(1) + integer, allocatable :: PetMapinGlobal(:) integer :: ntasks, rootpe, nthrds, stride integer :: ntask, cnt integer :: i @@ -884,7 +888,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) character(CL) :: msgstr integer, allocatable :: petlist(:) integer, pointer :: comms(:), comps(:) - integer :: Global_Comm + integer :: Driver_comm logical :: isPresent integer, allocatable :: comp_comm_iam(:) logical, allocatable :: comp_iamin(:) @@ -892,6 +896,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) character(CL) :: cvalue logical :: found_comp integer :: rank, nprocs, ierr + integer :: n ! loop variable character(len=*), parameter :: subname = '('//__FILE__//':esm_init_pelayout)' !--------------------------------------- @@ -901,10 +906,21 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) call ESMF_GridCompGet(driver, vm=vm, config=config, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGetGlobal(vm=globalvm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(driver, config, "PELAYOUT_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, petCount=petCount, mpiCommunicator=Global_Comm, rc=rc) + call ESMF_VMGet(vm, petCount=petCount, LocalPet=LocalPet, mpiCommunicator=Driver_comm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(globalvm, LocalPet=PetIDinGlobal(1), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + allocate(PetMapinGlobal(petCount)) + call ESMF_VMAllGather(vm, PetIDinGlobal, PetMapinGlobal, 1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return componentCount = ESMF_ConfigGetLen(config,label="component_list:", rc=rc) @@ -932,16 +948,11 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) inst_suffix = "" endif - ! Initialize PIO - ! This reads in the pio parameters that are independent of component -! call shr_pio_init(driver, rc=rc) -! if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(comms(componentCount+1), comps(componentCount+1)) comps(1) = 1 comms = MPI_COMM_NULL - comms(1) = Global_Comm - + comms(1) = Driver_comm + ! First find the maximum number of threads across all components maxthreads = 1 do i=1,componentCount namestr = ESMF_UtilStringLowerCase(compLabels(i)) @@ -952,7 +963,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) if(nthrds > maxthreads) maxthreads = nthrds enddo - + ! Now loop over components and add each to driver do i=1,componentCount namestr = ESMF_UtilStringLowerCase(compLabels(i)) if (namestr == 'med') namestr = 'cpl' @@ -979,11 +990,22 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_rootpe', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) rootpe + + ! rootpe is specified in context of the ensemble_driver which may include asyncio tasks + ! so we need to adjust. + do n=1,PetCount + if(rootpe == PetMapinGlobal(n)) then + rootpe = n - 1 + exit + endif + enddo + if (rootpe < 0 .or. rootpe > PetCount) then write (msgstr, *) "Invalid Rootpe value specified for component: ",namestr, ' rootpe: ',rootpe call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return endif + if(rootpe+ntasks > PetCount) then write (msgstr, *) "Invalid pelayout value specified for component: ",namestr, ' rootpe+ntasks: ',rootpe+ntasks call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) @@ -993,6 +1015,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_pestride', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stride + if (stride < 1 .or. rootpe+(ntasks-1)*stride > PetCount) then write (msgstr, *) "Invalid pestride value specified for component: ",namestr,& ' rootpe: ',rootpe, ' pestride: ', stride, ' ntasks: ',ntasks, ' PetCount: ', PetCount @@ -1186,10 +1209,10 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) ! if (chkerr(rc,__LINE__,u_FILE_u)) return ! Initialize MCT (this is needed for data models and cice prescribed capability) - call mct_world_init(componentCount+1, GLOBAL_COMM, comms, comps) + call mct_world_init(componentCount+1, DRIVER_COMM, comms, comps) - deallocate(petlist, comms, comps, comp_iamin, comp_comm_iam) + deallocate(petlist, comms, comps, comp_iamin, comp_comm_iam, PetMapinGlobal) end subroutine esm_init_pelayout diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index a4892f2c2..5f55bce6e 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -62,7 +62,8 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert ! local variables type(ESMF_Clock) :: clock - type(ESMF_VM) :: vm, envm + type(ESMF_VM) :: vm ! VM of the driver + type(ESMF_VM) :: envm ! VM of the ensemble_driver (which includes asyncIO tasks) type(ESMF_Time) :: StartTime ! Start time type(ESMF_Time) :: RefTime ! Reference time type(ESMF_Time) :: CurrTime ! Current time @@ -103,8 +104,8 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert integer :: tmp(4) ! Array for Broadcast integer :: myid, bcastID(2) logical :: isPresent - logical, save :: firsttime = .true. - logical :: indriver + logical :: firsttime = .true. + logical :: is_driver_pet character(len=*), parameter :: subname = '('//__FILE__//':esm_time_clockInit) ' !------------------------------------------------------------------------------- @@ -171,10 +172,10 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert call ESMF_VMGet(envm, localPet=myid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - indriver = ESMF_GridCompIsPetLocal(instance_driver, rc=rc) + is_driver_pet = ESMF_GridCompIsPetLocal(instance_driver, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(indriver) then + if(is_driver_pet) then call ESMF_GridCompGet(instance_driver, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -188,7 +189,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert if (ChkErr(rc,__LINE__,u_FILE_u)) return if (trim(restart_file) /= 'none') then - + ! inst_suffix is set by ensemble_driver if the number of members is > 1 call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if(isPresent) then @@ -321,7 +322,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert end do ! Set the driver gridded component clock to the created clock - if (indriver) then + if (is_driver_pet) then call ESMF_GridCompSet(instance_driver, clock=clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -351,7 +352,6 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert write(tmpstr,'(i10)') stop_tod call ESMF_LogWrite(trim(subname)//': driver stop_tod: '// trim(tmpstr), ESMF_LOGMSG_INFO) write(logunit,*) trim(subname)//': driver stop_tod: '// trim(tmpstr) - else endif call esm_time_alarmInit(clock, & @@ -374,6 +374,8 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert ! Create the ensemble driver clock !--------------------------------------------------------------------------- if(firsttime) then + ! TimeStep for the ensemble_driver and any asyncIO tasks is the full length of + ! the model run. TimeStep = StopTime - ClockTime clock = ESMF_ClockCreate(TimeStep, ClockTime, StopTime=StopTime, & refTime=RefTime, name='ESMF ensemble Driver Clock', rc=rc) diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index cd1d800b6..e5d355be9 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -22,7 +22,6 @@ module nuopc_shr_methods use NUOPC_Model , only : NUOPC_ModelGet use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_sys_mod , only : shr_sys_abort - use shr_file_mod , only : shr_file_setlogunit, shr_file_getLogUnit implicit none private @@ -171,8 +170,7 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) else logUnit = 6 endif - ! TODO: shr_file mod is deprecated and should be removed. - call shr_file_setLogUnit (logunit) + call ESMF_GridCompGet(gcomp, name=name, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/shr_pio_mod.F90 index 2d0649131..2e44da722 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/shr_pio_mod.F90 @@ -259,6 +259,8 @@ subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) endif enddo + if(asyncio_task) print *,__FILE__,__LINE__,'I am an ASYNCIO TASK' + nullify(gcomp) if (asyncio_task) then @@ -435,6 +437,7 @@ subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) call pio_init(async_iosystems, Global_comm, async_procs_per_comp, comp_proc_list, asyncio_petlist, & PIO_REARR_BOX, asyncio_comp_comm, io_comm) if(.not. asyncio_task) then + print *,__FILE__,__LINE__,'I am a compute task' j=1 do i=1,total_comps if(pio_comp_settings(i)%pio_async_interface) then diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index d825a172d..a410eeba5 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -2023,22 +2023,30 @@ pio blocksize for box decompositions - + integer 0 run_pio - env_run.xml + env_mach_pes.xml Task count for asyncronous IO, only valid if PIO_ASYNC_INTERFACE is True - + integer 0 run_pio - env_run.xml + env_mach_pes.xml Stride of tasks for asyncronous IO, only valid if PIO_ASYNC_INTERFACE is True + + integer + 1 + run_pio + env_mach_pes.xml + RootPE of tasks for asyncronous IO, only valid if PIO_ASYNC_INTERFACE is True + + integer -1 diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 06d0d66c6..db1da7675 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -36,7 +36,7 @@ - + integer pio PELAYOUT_attributes @@ -44,19 +44,31 @@ IO tasks FOR ASYNC IO, only valid if ASYNCIO is true. - $PIO_ASYNC_IOTASKS + $PIO_ASYNCIO_NTASKS - + integer pio PELAYOUT_attributes - IO tasks FOR ASYNC IO, only valid if ASYNCIO is true. + IO task stride FOR ASYNC IO, only valid if ASYNCIO is true. - $PIO_ASYNC_IOSTRIDE + $PIO_ASYNCIO_STRIDE + + + + + integer + pio + PELAYOUT_attributes + + IO rootpe task FOR ASYNC IO, only valid if ASYNCIO is true. + + + $PIO_ASYNCIO_ROOTPE @@ -4125,7 +4137,7 @@ $ROF_PIO_REARRANGER $GLC_PIO_REARRANGER $WAV_PIO_REARRANGER - -99 + $ESP_PIO_REARRANGER From fdf5009f3b4ca45913e1d7c0d3e44041dd8b1125 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 13 Jul 2022 15:16:48 -0600 Subject: [PATCH 102/395] save for vacation --- cesm/nuopc_cap_share/shr_pio_mod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/shr_pio_mod.F90 index 2e44da722..9c3282c8f 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/shr_pio_mod.F90 @@ -434,6 +434,7 @@ subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) endif enddo ! IO tasks should not return until the run is completed + if(asyncio_task) j = pio_set_log_level(3) call pio_init(async_iosystems, Global_comm, async_procs_per_comp, comp_proc_list, asyncio_petlist, & PIO_REARR_BOX, asyncio_comp_comm, io_comm) if(.not. asyncio_task) then From 5f646a0b6caeb9ec91a03969350293f5393c1c95 Mon Sep 17 00:00:00 2001 From: Alper Altuntas Date: Mon, 18 Jul 2022 21:23:40 -0600 Subject: [PATCH 103/395] set wavice_coupling to false for now because it causes instabilities. (#308) --- cime_config/buildnml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 23354c522..b80c74388 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -109,8 +109,9 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): #-------------------------------- # Overwrite: wav-ice coupling (assumes cice6 as the ice component #-------------------------------- - if (case.get_value("COMP_WAV") == 'ww3dev' and case.get_value("COMP_ICE") == 'cice'): - nmlgen.set_value('wavice_coupling', value='.true.') + ## commenting out wavice_coupling for now because it causes instabilities. -aa + ##if (case.get_value("COMP_WAV") == 'ww3dev' and case.get_value("COMP_ICE") == 'cice'): + ## nmlgen.set_value('wavice_coupling', value='.true.') #-------------------------------- # Overwrite: set brnch_retain_casename From 8088dd280451cf2d5a929e71fa86f88f62dbc533 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 8 Aug 2022 14:16:31 -0600 Subject: [PATCH 104/395] more debugged --- cesm/driver/ensemble_driver.F90 | 2 + cesm/driver/esm_time_mod.F90 | 3 +- cesm/nuopc_cap_share/shr_pio_mod.F90 | 61 ++++++++++++++++++++++------ 3 files changed, 52 insertions(+), 14 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 975649719..a38c6a63a 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -208,6 +208,8 @@ subroutine SetModelServices(ensemble_driver, rc) write(read_restart_string,*) read_restart ! Add read_restart to ensemble_driver attributes + + call ESMF_LogWrite(trim(subname)//": set read_restart "//trim(read_restart_string), ESMF_LOGMSG_INFO) call NUOPC_CompAttributeAdd(ensemble_driver, attrList=(/'read_restart'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeSet(ensemble_driver, name='read_restart', value=trim(read_restart_string), rc=rc) diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index 5f55bce6e..46b95ed61 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -179,7 +179,8 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert call ESMF_GridCompGet(instance_driver, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(instance_driver, name='read_restart', value=cvalue, rc=rc) + ! read_restart is set in ensemble_driver SetModelServices + call NUOPC_CompAttributeGet(ensemble_driver, name='read_restart', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) read_restart diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/shr_pio_mod.F90 index 9c3282c8f..74b361e1e 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/shr_pio_mod.F90 @@ -223,6 +223,7 @@ subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) type(ESMF_VM) :: vm integer :: i, npets, default_stride integer :: j, myid + integer :: k integer :: comp_comm, comp_rank integer, allocatable :: procs_per_comp(:), async_procs_per_comp(:) integer, allocatable :: io_proc_list(:), asyncio_tasks(:), comp_proc_list(:,:) @@ -239,8 +240,10 @@ subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) integer :: iocomm integer :: ncomps integer :: driverpecount, driver_myid + integer, allocatable :: driverpetlist(:) integer, allocatable :: asyncio_comp_comm(:) - logical :: asyncio_task, petlocal + logical :: asyncio_task + logical, allocatable :: petlocal(:) type(iosystem_desc_t), allocatable :: async_iosystems(:) character(len=*), parameter :: subname = '('//__FILE__//':shr_pio_component_init)' @@ -258,9 +261,6 @@ subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) exit endif enddo - - if(asyncio_task) print *,__FILE__,__LINE__,'I am an ASYNCIO TASK' - nullify(gcomp) if (asyncio_task) then @@ -281,6 +281,9 @@ subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) total_comps = 0 endif + call ESMF_LogWrite(trim(subname)//": share total_comps and driverpecount", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call MPI_AllReduce(MPI_IN_PLACE, total_comps, 1, MPI_INTEGER, & MPI_MAX, Global_comm, rc) call MPI_AllReduce(MPI_IN_PLACE, driverpecount, 1, MPI_INTEGER, & @@ -291,18 +294,20 @@ subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) allocate(io_compid(total_comps)) allocate(io_compname(total_comps)) allocate(iosystems(total_comps)) + allocate(petlocal(total_comps)) do_async_init = 0 procs_per_comp = 0 + do i=1,total_comps if(associated(gcomp)) then - petlocal = ESMF_GridCompIsPetLocal(gcomp(i), rc=rc) + petlocal(i) = ESMF_GridCompIsPetLocal(gcomp(i), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else - petlocal = .false. + petlocal(i) = .false. endif pio_comp_settings(i)%pio_async_interface = .false. io_compid(i) = i+1 - if (petlocal) then + if (petlocal(i)) then call ESMF_GridCompGet(gcomp(i), vm=vm, name=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//": initialize component: "//trim(cval), ESMF_LOGMSG_INFO) @@ -389,8 +394,13 @@ subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) ! Write the PIO settings to the beggining of each component log if(comp_rank == 0) call shr_pio_log_comp_settings(gcomp(i), rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + endif enddo + + call ESMF_LogWrite(trim(subname)//": check for async", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do i=1,total_comps call MPI_AllReduce(MPI_IN_PLACE, pio_comp_settings(i)%pio_async_interface, 1, MPI_LOGICAL, & MPI_LOR, global_comm, rc) @@ -398,9 +408,11 @@ subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) do_async_init = do_async_init + 1 endif enddo + ! ! Get the PET list for each component using async IO ! + call MPI_Allreduce(MPI_IN_PLACE, do_async_init, 1, MPI_INTEGER, MPI_MAX, Global_comm, ierr) call MPI_Allreduce(MPI_IN_PLACE, procs_per_comp, total_comps, MPI_INTEGER, MPI_MAX, Global_comm, ierr) @@ -409,23 +421,43 @@ subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) allocate(asyncio_comp_comm(do_async_init)) allocate(comp_proc_list(driverpecount, do_async_init)) j = 1 - comp_proc_list = 0 + k = 1 + comp_proc_list = -1 if(.not. asyncio_task) then do i=1,total_comps - if(pio_comp_settings(i)%pio_async_interface) then - comp_proc_list(1+driver_myid,j) = myid + if(pio_comp_settings(i)%pio_async_interface .and. petlocal(i)) then + comp_proc_list(1+driver_myid,j) = myid + do k=1,size(asyncio_petlist) + if(comp_proc_list(1+driver_myid, j) == asyncio_petlist(k)) then + call shr_sys_abort(subname//' ERROR: OVERLAP with asyncio_petlist') + endif + enddo j = j+1 endif enddo endif + call MPI_AllReduce(MPI_IN_PLACE, comp_proc_list, driverpecount*do_async_init, MPI_INTEGER, MPI_MAX, Global_comm, ierr) if(asyncio_ntasks == 0) then call shr_sys_abort(subname//' ERROR: ASYNC IO Requested but no IO PES assigned') endif + do i=1,do_async_init + do j=1,driverpecount + if(comp_proc_list(j,i) == -1) then + do k=j+1,driverpecount + if(comp_proc_list(k,i) >= 0) then + comp_proc_list(j,i) = comp_proc_list(k,i) + comp_proc_list(k,i) = -1 + exit + endif + enddo + endif + enddo + enddo + allocate(async_iosystems(do_async_init)) allocate(async_procs_per_comp(do_async_init)) - j=1 do i=1,total_comps if(pio_comp_settings(i)%pio_async_interface) then @@ -434,11 +466,14 @@ subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) endif enddo ! IO tasks should not return until the run is completed - if(asyncio_task) j = pio_set_log_level(3) +! ierr = pio_set_log_level(3) + + call ESMF_LogWrite(trim(subname)//": call async pio_init", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call pio_init(async_iosystems, Global_comm, async_procs_per_comp, comp_proc_list, asyncio_petlist, & PIO_REARR_BOX, asyncio_comp_comm, io_comm) if(.not. asyncio_task) then - print *,__FILE__,__LINE__,'I am a compute task' j=1 do i=1,total_comps if(pio_comp_settings(i)%pio_async_interface) then From c0199829d175b0c97cddbc38c317a5050b8afca8 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 9 Aug 2022 10:32:09 -0600 Subject: [PATCH 105/395] more asyncio debugging; --- cesm/driver/ensemble_driver.F90 | 16 +++++++++------- cesm/nuopc_cap_share/shr_pio_mod.F90 | 7 ++----- 2 files changed, 11 insertions(+), 12 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index a38c6a63a..8e95c0557 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -130,7 +130,7 @@ subroutine SetModelServices(ensemble_driver, rc) integer :: n, n1, stat integer, pointer :: petList(:) character(len=20) :: model, prefix - integer :: petCount, i + integer :: petCount, i, k integer :: localPet logical :: is_set character(len=512) :: diro @@ -246,6 +246,7 @@ subroutine SetModelServices(ensemble_driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ntasks_per_member = PetCount/number_of_members - pio_asyncio_ntasks + if(ntasks_per_member*number_of_members .ne. (PetCount - pio_asyncio_ntasks)) then write (msgstr,'(a,i5,a,i3,a,i3,a)') & "PetCount - Async IOtasks (",PetCount-pio_asyncio_ntasks,") must be evenly divisable by number of members (",number_of_members,")" @@ -273,10 +274,9 @@ subroutine SetModelServices(ensemble_driver, rc) do n=1,pio_asyncio_ntasks asyncio_petlist(n) = pio_asyncio_rootpe + (n-1)*pio_asyncio_stride if (localPet == asyncio_petlist(n)) asyncio_task = .true. -! if (asyncio_petlist(n) == currentPet) currentPet = currentPet + 1 enddo - + k = 1 do inst=1,number_of_members petcnt=1 comp_task = .false. @@ -292,10 +292,12 @@ subroutine SetModelServices(ensemble_driver, rc) petcnt = petcnt+1 if (currentpet == localPet) comp_task=.true. endif - else if(modulo(n-1,pio_asyncio_stride) .ne. pio_asyncio_rootpe) then + else if (currentpet .ne. asyncio_petlist(k)) then petList(petcnt) = currentpet petcnt = petcnt+1 if (currentpet == localPet) comp_task=.true. + else if (currentpet == asyncio_petlist(k)) then + k = modulo(k,pio_asyncio_ntasks) + 1 endif currentpet = currentpet + 1 enddo @@ -399,14 +401,14 @@ subroutine InitializeIO(ensemble_driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompGet(dcomp(drv), name=compname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": call shr_pio_init"//compname, ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": call shr_pio_init "//compname, ESMF_LOGMSG_INFO) call shr_pio_init(dcomp(drv), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": call shr_pio_component_init"//compname, ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": call shr_pio_component_init "//compname, ESMF_LOGMSG_INFO) call shr_pio_component_init(dcomp(drv), Global_Comm, asyncio_petlist, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": shr_pio_component_init done"//compname, ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": shr_pio_component_init done "//compname, ESMF_LOGMSG_INFO) endif enddo deallocate(asyncio_petlist) diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/shr_pio_mod.F90 index 74b361e1e..20535c191 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/shr_pio_mod.F90 @@ -414,7 +414,6 @@ subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) ! call MPI_Allreduce(MPI_IN_PLACE, do_async_init, 1, MPI_INTEGER, MPI_MAX, Global_comm, ierr) - call MPI_Allreduce(MPI_IN_PLACE, procs_per_comp, total_comps, MPI_INTEGER, MPI_MAX, Global_comm, ierr) if (do_async_init > 0) then @@ -425,8 +424,8 @@ subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) comp_proc_list = -1 if(.not. asyncio_task) then do i=1,total_comps - if(pio_comp_settings(i)%pio_async_interface .and. petlocal(i)) then - comp_proc_list(1+driver_myid,j) = myid + if(pio_comp_settings(i)%pio_async_interface) then + if(petlocal(i)) comp_proc_list(1+driver_myid,j) = myid do k=1,size(asyncio_petlist) if(comp_proc_list(1+driver_myid, j) == asyncio_petlist(k)) then call shr_sys_abort(subname//' ERROR: OVERLAP with asyncio_petlist') @@ -436,7 +435,6 @@ subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) endif enddo endif - call MPI_AllReduce(MPI_IN_PLACE, comp_proc_list, driverpecount*do_async_init, MPI_INTEGER, MPI_MAX, Global_comm, ierr) if(asyncio_ntasks == 0) then call shr_sys_abort(subname//' ERROR: ASYNC IO Requested but no IO PES assigned') @@ -470,7 +468,6 @@ subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) call ESMF_LogWrite(trim(subname)//": call async pio_init", ESMF_LOGMSG_INFO) if (chkerr(rc,__LINE__,u_FILE_u)) return - call pio_init(async_iosystems, Global_comm, async_procs_per_comp, comp_proc_list, asyncio_petlist, & PIO_REARR_BOX, asyncio_comp_comm, io_comm) if(.not. asyncio_task) then From c7b75d156a2cea7a003d28ce1c3c339e1538b731 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 11 Aug 2022 00:09:49 -0600 Subject: [PATCH 106/395] fix masking issue for land coupling --- mediator/med_map_mod.F90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 3717f5cba..eec1df850 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -340,7 +340,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, use med_internalstate_mod , only : mapunset, mapnames, nmappers use med_internalstate_mod , only : mapnstod, mapnstod_consd, mapnstod_consf, mapnstod_consd use med_internalstate_mod , only : mapfillv_bilnr, mapbilnr_nstod, mapconsf_aofrac - use med_internalstate_mod , only : ncomps, compatm, compice, compocn, compwav, compname + use med_internalstate_mod , only : ncomps, compatm, compice, compocn, compwav, complnd, compname use med_internalstate_mod , only : coupling_mode, dststatus_print use med_internalstate_mod , only : defaultMasks use med_constants_mod , only : ispval_mask => med_constants_ispval_mask @@ -400,6 +400,12 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dstMaskValue = ispval_mask endif end if + if (trim(coupling_mode(1:4)) == 'nems') then + if (n1 == compatm .and. n2 == complnd) then + srcMaskValue = ispval_mask + dstMaskValue = ispval_mask + end if + end if if (trim(coupling_mode) == 'hafs') then if (n1 == compatm .and. n2 == compwav) then srcMaskValue = ispval_mask From 8ba09a608b0e75b0db9cdccabf17ffbd4400014b Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 18 Aug 2022 16:23:52 -0600 Subject: [PATCH 107/395] fix surface pressure issue for land coupling --- mediator/esmFldsExchange_nems_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 4584f4fde..46a7e7399 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -743,7 +743,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) 'Faxa_swndr', 'Faxa_swndf', 'Faxa_swvdr', 'Faxa_swvdf'/) else allocate(flds(9)) - flds = (/'Sa_z ', 'Sa_tbot ', 'Sa_pbot ', 'Sa_shum ', & + flds = (/'Sa_z ', 'Sa_tbot ', 'Sa_pslv ', 'Sa_shum ', & 'Sa_u ', 'Sa_v ', 'Faxa_swdn ', 'Faxa_lwdn ', & 'Faxa_rain ' /) end if From 5e9c7d9b4e8a0e78db629ccd51548db41970c2d7 Mon Sep 17 00:00:00 2001 From: Adrianna Foster Date: Wed, 31 Aug 2022 14:06:23 -0600 Subject: [PATCH 108/395] Update cime config namelist definition to include datmcomf/drv_flds_in (#309) --- cime_config/namelist_definition_drv.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index f4d366913..7674eb62b 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -3699,7 +3699,7 @@ components that need to look at the same data. - Buildconf/camconf/drv_flds_in,Buildconf/clmconf/drv_flds_in + Buildconf/camconf/drv_flds_in,Buildconf/clmconf/drv_flds_in,Buildconf/datmconf/drv_flds_in From 5559270dbc6e4ecfcf55364c57d68b09dcc5849d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 12 Sep 2022 15:36:29 -0600 Subject: [PATCH 109/395] add namelist control of async rearranger --- cesm/nuopc_cap_share/shr_pio_mod.F90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/shr_pio_mod.F90 index 20535c191..54f9a3e45 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/shr_pio_mod.F90 @@ -239,6 +239,7 @@ subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) integer :: ierr integer :: iocomm integer :: ncomps + integer :: async_rearr integer :: driverpecount, driver_myid integer, allocatable :: driverpetlist(:) integer, allocatable :: asyncio_comp_comm(:) @@ -461,6 +462,11 @@ subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) if(pio_comp_settings(i)%pio_async_interface) then async_procs_per_comp(j) = procs_per_comp(i) j = j+1 + if(async_rearr == 0) then + async_rearr = pio_comp_settings(i)%pio_rearranger + elseif(async_rearr .ne. pio_comp_settings(i)%pio_rearranger) then + call shr_sys_abort(subname//' ERROR: all async component rearrangers must match') + endif endif enddo ! IO tasks should not return until the run is completed @@ -469,7 +475,7 @@ subroutine shr_pio_component_init(driver, Global_COMM, asyncio_petlist, rc) call ESMF_LogWrite(trim(subname)//": call async pio_init", ESMF_LOGMSG_INFO) if (chkerr(rc,__LINE__,u_FILE_u)) return call pio_init(async_iosystems, Global_comm, async_procs_per_comp, comp_proc_list, asyncio_petlist, & - PIO_REARR_BOX, asyncio_comp_comm, io_comm) + async_rearr, asyncio_comp_comm, io_comm) if(.not. asyncio_task) then j=1 do i=1,total_comps From c91b15cae6b97049900bc74c816d87a0fd56815c Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 15 Sep 2022 10:44:38 -0600 Subject: [PATCH 110/395] mods for land side-by-side configuration --- mediator/esmFldsExchange_nems_mod.F90 | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 46a7e7399..6424da65b 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -737,15 +737,17 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) allocate(flds(21)) flds = (/'Sa_z ', 'Sa_topo ', 'Sa_tbot ', 'Sa_pbot ', & 'Sa_shum ', 'Sa_u ', 'Sa_v ', 'Faxa_lwdn ', & - 'Sa_ptem ', 'Sa_dens ', 'Faxa_swdn ', 'Faxa_swnet', & + 'Sa_ptem ', 'Sa_dens ', 'Faxa_swdn ', 'Sa_pslv ', & 'Faxa_snowc', 'Faxa_snowl', 'Faxa_rainc', 'Faxa_rainl', & - 'Sa_pslv ', & - 'Faxa_swndr', 'Faxa_swndf', 'Faxa_swvdr', 'Faxa_swvdf'/) + 'Faxa_swndr', 'Faxa_swndf', 'Faxa_swvdr', 'Faxa_swvdf', & + 'Faxa_swnet'/) else - allocate(flds(9)) - flds = (/'Sa_z ', 'Sa_tbot ', 'Sa_pslv ', 'Sa_shum ', & - 'Sa_u ', 'Sa_v ', 'Faxa_swdn ', 'Faxa_lwdn ', & - 'Faxa_rain ' /) + allocate(flds(18)) + flds = (/'Sa_z ', 'Sa_ta ', 'Sa_pslv ', 'Sa_qa ', & + 'Sa_ua ', 'Sa_va ', 'Faxa_swdn ', 'Faxa_lwdn ', & + 'Faxa_swnet', 'Faxa_rain ', 'Sa_prsl ', 'vfrac ', & + 'Faxa_snow ', 'Faxa_rainc', 'Sa_tskn ', 'Sa_exner ', & + 'Sa_ustar ', 'zorl ' /) end if do n = 1,size(flds) fldname = trim(flds(n)) From cdbd5c113906023169e70f660a0427ecf2faf429 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 21 Sep 2022 08:50:20 -0600 Subject: [PATCH 111/395] merge to master --- cesm/driver/ensemble_driver.F90 | 6 +- cesm/nuopc_cap_share/driver_pio_mod.F90 | 6 +- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 4 +- cesm/nuopc_cap_share/seq_drydep_mod.F90 | 1211 +++++++++++++++++++- 4 files changed, 1211 insertions(+), 16 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 8e95c0557..5118093da 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -371,7 +371,7 @@ subroutine InitializeIO(ensemble_driver, rc) use ESMF, only: ESMF_CONFIG, ESMF_GridCompIsPetLocal, ESMF_State, ESMF_Clock use NUOPC, only: NUOPC_CompAttributeGet, NUOPC_CompGet use NUOPC_DRIVER, only: NUOPC_DriverGetComp - use shr_pio_mod , only: shr_pio_init, shr_pio_component_init + use driver_pio_mod , only: driver_pio_init, driver_pio_component_init type(ESMF_GridComp) :: ensemble_driver type(ESMF_VM) :: ensemble_vm @@ -402,11 +402,11 @@ subroutine InitializeIO(ensemble_driver, rc) call NUOPC_CompGet(dcomp(drv), name=compname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//": call shr_pio_init "//compname, ESMF_LOGMSG_INFO) - call shr_pio_init(dcomp(drv), rc=rc) + call driver_pio_init(dcomp(drv), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//": call shr_pio_component_init "//compname, ESMF_LOGMSG_INFO) - call shr_pio_component_init(dcomp(drv), Global_Comm, asyncio_petlist, rc) + call driver_pio_component_init(dcomp(drv), Global_Comm, asyncio_petlist, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//": shr_pio_component_init done "//compname, ESMF_LOGMSG_INFO) endif diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index 33559d5f4..5b9edd426 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -169,7 +169,7 @@ subroutine driver_pio_init(driver, rc) end subroutine driver_pio_init - subroutine driver_pio_component_init(driver, ncomps, rc) + subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) use ESMF, only : ESMF_GridComp, ESMF_LogSetError, ESMF_RC_NOT_VALID, ESMF_GridCompIsCreated, ESMF_VM, ESMF_VMGet use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated, ESMF_Finalize, ESMF_PtrInt1D use ESMF, only : ESMF_LOGMSG_INFO, ESMF_LOGWRITE @@ -457,8 +457,8 @@ subroutine driver_pio_component_init(driver, ncomps, rc) deallocate(gcomp) end subroutine driver_pio_component_init - subroutine driver_pio_log_comp_settings(gcomp, logunit) - use ESMF, only : ESMF_GridComp, ESMF_GridCompGet + subroutine driver_pio_log_comp_settings(gcomp, logunit, rc) + use ESMF, only : ESMF_GridComp, ESMF_GridCompGet, ESMF_SUCCESS use NUOPC, only: NUOPC_CompAttributeGet type(ESMF_GridComp) :: gcomp diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index 5e27e7825..c001bd3b7 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -170,8 +170,8 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) ! Write the PIO settings to the beggining of each component log - call driver_pio_log_comp_settings(gcomp, logunit) - + call driver_pio_log_comp_settings(gcomp, logunit, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else logUnit = 6 endif diff --git a/cesm/nuopc_cap_share/seq_drydep_mod.F90 b/cesm/nuopc_cap_share/seq_drydep_mod.F90 index 780a6c611..0d98f5c85 100644 --- a/cesm/nuopc_cap_share/seq_drydep_mod.F90 +++ b/cesm/nuopc_cap_share/seq_drydep_mod.F90 @@ -1,26 +1,1221 @@ module seq_drydep_mod - use shr_drydep_mod, only: seq_drydep_setHCoeff=>shr_drydep_setHCoeff - use shr_drydep_mod + !======================================================================== + ! Module for handling dry depostion of tracers. + ! This module is shared by land and atmosphere models for the computations of + ! dry deposition of tracers + !======================================================================== + + 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_kind_mod , only : r8 => shr_kind_r8, CS => SHR_KIND_CS, CX => SHR_KIND_CX + use shr_const_mod , only : SHR_CONST_G, SHR_CONST_RDAIR, SHR_CONST_CPDAIR, SHR_CONST_MWWV + use shr_mpi_mod , only : shr_mpi_bcast + use shr_nl_mod , only : shr_nl_find_group_name + use shr_log_mod , only : s_logunit => shr_log_Unit + use shr_infnan_mod , only : shr_infnan_posinf, assignment(=) implicit none + private + + ! public member functions + public :: seq_drydep_readnl ! Read namelist + public :: seq_drydep_init ! Initialization of drydep data + public :: seq_drydep_setHCoeff ! Calculate Henry's law coefficients + + ! private array sizes + integer, public, parameter :: n_species_table = 192 ! Number of species to work with + integer, private, parameter :: maxspc = 210 ! Maximum number of species + integer, private, parameter :: NSeas = 5 ! Number of seasons + integer, private, parameter :: NLUse = 11 ! Number of land-use types + logical, private :: drydep_initialized = .false. + + ! public data members: ! method specification - character(len=*), parameter :: DD_XLND = 'xactive_lnd' ! dry-dep land - character(len=*), parameter :: drydep_method = DD_XLND ! XLND is the only option now - logical, protected :: lnd_drydep + character(16),public,parameter :: DD_XATM = 'xactive_atm' ! dry-dep atmosphere + character(16),public,parameter :: DD_XLND = 'xactive_lnd' ! dry-dep land + character(16),public,parameter :: DD_TABL = 'table' ! dry-dep table (atm and lnd) + character(16),public :: drydep_method = DD_XLND ! Which option choosen + + real(r8), public, parameter :: ph = 1.e-5_r8 ! measure of the acidity (dimensionless) + + logical, public :: lnd_drydep ! If dry-dep fields passed + integer, public :: n_drydep = 0 ! Number in drypdep list + logical :: drydep_init = .false. ! has seq_drydep_init been called? + character(len=CS), public, dimension(maxspc) :: drydep_list = '' ! List of dry-dep species + + real(r8), public, allocatable, dimension(:) :: foxd ! reactivity factor for oxidation (dimensioness) + real(r8), public, allocatable, dimension(:) :: drat ! ratio of molecular diffusivity (D_H2O/D_species; dimensionless) + integer, public, allocatable, dimension(:) :: mapping ! mapping to species table + + ! --- Indices for each species --- + integer, public :: h2_ndx, ch4_ndx, co_ndx, pan_ndx, mpan_ndx, so2_ndx, o3_ndx, o3a_ndx, xpan_ndx + + !--------------------------------------------------------------------------- + ! Table 1 from Wesely, Atmos. Environment, 1989, p1293 + ! Table 2 from Sheih, microfiche PB86-218104 and Walcek, Atmos. Environment, 1986, p949 + ! Table 3-5 compiled by P. Hess + ! + ! index #1 : season + ! 1 -> midsummer with lush vegetation + ! 2 -> autumn with unharvested cropland + ! 3 -> late autumn after frost, no snow + ! 4 -> winter, snow on ground, and subfreezing + ! 5 -> transitional spring with partially green short annuals + ! + ! index #2 : landuse type + ! 1 -> urban land + ! 2 -> agricultural land + ! 3 -> range land + ! 4 -> deciduous forest + ! 5 -> coniferous forest + ! 6 -> mixed forest including wetland + ! 7 -> water, both salt and fresh + ! 8 -> barren land, mostly desert + ! 9 -> nonforested wetland + ! 10 -> mixed agricultural and range land + ! 11 -> rocky open areas with low growing shrubs + ! + ! JFL August 2000 + !--------------------------------------------------------------------------- + + !--------------------------------------------------------------------------- + ! table to parameterize the impact of soil moisture on the deposition of H2 and + ! CO on soils (from Sanderson et al., J. Atmos. Chem., 46, 15-28, 2003). + !--------------------------------------------------------------------------- + + !--- deposition of h2 and CO on soils --- + real(r8), parameter, public :: h2_a(NLUse) = & + (/ 0.000_r8, 0.000_r8, 0.270_r8, 0.000_r8, 0.000_r8, & + 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8/) + !--- deposition of h2 and CO on soils --- + real(r8), parameter, public :: h2_b(NLUse) = & + (/ 0.000_r8,-41.390_r8, -0.472_r8,-41.900_r8,-41.900_r8, & + -41.900_r8, 0.000_r8, 0.000_r8, 0.000_r8,-41.390_r8, 0.000_r8/) + !--- deposition of h2 and CO on soils --- + real(r8), parameter, public :: h2_c(NLUse) = & + (/ 0.000_r8, 16.850_r8, 1.235_r8, 19.700_r8, 19.700_r8, & + 19.700_r8, 0.000_r8, 0.000_r8, 0.000_r8, 17.700_r8, 1.000_r8/) + + !--- deposition of h2 and CO on soils + ! + !--- ri: Richardson number (dimensionless) + !--- rlu: Resistance of leaves in upper canopy (s.m-1) + !--- rac: Aerodynamic resistance to lower canopy (s.m-1) + !--- rgss: Ground surface resistance for SO2 (s.m-1) + !--- rgso: Ground surface resistance for O3 (s.m-1) + !--- rcls: Lower canopy resistance for SO2 (s.m-1) + !--- rclo: Lower canopy resistance for O3 (s.m-1) + ! + real(r8), public, dimension(NSeas,NLUse) :: ri, rlu, rac, rgss, rgso, rcls, rclo + + data ri (1,1:NLUse) & + /1.e36_r8, 60._r8, 120._r8, 70._r8, 130._r8, 100._r8,1.e36_r8,1.e36_r8, 80._r8, 100._r8, 150._r8/ + data rlu (1,1:NLUse) & + /1.e36_r8,2000._r8,2000._r8,2000._r8,2000._r8,2000._r8,1.e36_r8,1.e36_r8,2500._r8,2000._r8,4000._r8/ + data rac (1,1:NLUse) & + / 100._r8, 200._r8, 100._r8,2000._r8,2000._r8,2000._r8, 0._r8, 0._r8, 300._r8, 150._r8, 200._r8/ + data rgss(1,1:NLUse) & + / 400._r8, 150._r8, 350._r8, 500._r8, 500._r8, 100._r8, 0._r8,1000._r8, 0._r8, 220._r8, 400._r8/ + data rgso(1,1:NLUse) & + / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ + data rcls(1,1:NLUse) & + /1.e36_r8,2000._r8,2000._r8,2000._r8,2000._r8,2000._r8,1.e36_r8,1.e36_r8,2500._r8,2000._r8,4000._r8/ + data rclo(1,1:NLUse) & + /1.e36_r8,1000._r8,1000._r8,1000._r8,1000._r8,1000._r8,1.e36_r8,1.e36_r8,1000._r8,1000._r8,1000._r8/ + + data ri (2,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 250._r8, 500._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ + data rlu (2,1:NLUse) & + /1.e36_r8,9000._r8,9000._r8,9000._r8,4000._r8,8000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rac (2,1:NLUse) & + / 100._r8, 150._r8, 100._r8,1500._r8,2000._r8,1700._r8, 0._r8, 0._r8, 200._r8, 120._r8, 140._r8/ + data rgss(2,1:NLUse) & + / 400._r8, 200._r8, 350._r8, 500._r8, 500._r8, 100._r8, 0._r8,1000._r8, 0._r8, 300._r8, 400._r8/ + data rgso(2,1:NLUse) & + / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8, 800._r8, 180._r8, 200._r8/ + data rcls(2,1:NLUse) & + /1.e36_r8,9000._r8,9000._r8,9000._r8,2000._r8,4000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rclo(2,1:NLUse) & + /1.e36_r8, 400._r8, 400._r8, 400._r8,1000._r8, 600._r8,1.e36_r8,1.e36_r8, 400._r8, 400._r8, 400._r8/ + + data ri (3,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 250._r8, 500._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ + data rlu (3,1:NLUse) & + /1.e36_r8,1.e36_r8,9000._r8,9000._r8,4000._r8,8000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rac (3,1:NLUse) & + / 100._r8, 10._r8, 100._r8,1000._r8,2000._r8,1500._r8, 0._r8, 0._r8, 100._r8, 50._r8, 120._r8/ + data rgss(3,1:NLUse) & + / 400._r8, 150._r8, 350._r8, 500._r8, 500._r8, 200._r8, 0._r8,1000._r8, 0._r8, 200._r8, 400._r8/ + data rgso(3,1:NLUse) & + / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ + data rcls(3,1:NLUse) & + /1.e36_r8,1.e36_r8,9000._r8,9000._r8,3000._r8,6000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rclo(3,1:NLUse) & + /1.e36_r8,1000._r8, 400._r8, 400._r8,1000._r8, 600._r8,1.e36_r8,1.e36_r8, 800._r8, 600._r8, 600._r8/ + + data ri (4,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 400._r8, 800._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ + data rlu (4,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,6000._r8,9000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rac (4,1:NLUse) & + / 100._r8, 10._r8, 10._r8,1000._r8,2000._r8,1500._r8, 0._r8, 0._r8, 50._r8, 10._r8, 50._r8/ + data rgss(4,1:NLUse) & + / 100._r8, 100._r8, 100._r8, 100._r8, 100._r8, 100._r8, 0._r8,1000._r8, 100._r8, 100._r8, 50._r8/ + data rgso(4,1:NLUse) & + / 600._r8,3500._r8,3500._r8,3500._r8,3500._r8,3500._r8,2000._r8, 400._r8,3500._r8,3500._r8,3500._r8/ + data rcls(4,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,9000._r8, 200._r8, 400._r8,1.e36_r8,1.e36_r8,9000._r8,1.e36_r8,9000._r8/ + data rclo(4,1:NLUse) & + /1.e36_r8,1000._r8,1000._r8, 400._r8,1500._r8, 600._r8,1.e36_r8,1.e36_r8, 800._r8,1000._r8, 800._r8/ + + data ri (5,1:NLUse) & + /1.e36_r8, 120._r8, 240._r8, 140._r8, 250._r8, 190._r8,1.e36_r8,1.e36_r8, 160._r8, 200._r8, 300._r8/ + data rlu (5,1:NLUse) & + /1.e36_r8,4000._r8,4000._r8,4000._r8,2000._r8,3000._r8,1.e36_r8,1.e36_r8,4000._r8,4000._r8,8000._r8/ + data rac (5,1:NLUse) & + / 100._r8, 50._r8, 80._r8,1200._r8,2000._r8,1500._r8, 0._r8, 0._r8, 200._r8, 60._r8, 120._r8/ + data rgss(5,1:NLUse) & + / 500._r8, 150._r8, 350._r8, 500._r8, 500._r8, 200._r8, 0._r8,1000._r8, 0._r8, 250._r8, 400._r8/ + data rgso(5,1:NLUse) & + / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ + data rcls(5,1:NLUse) & + /1.e36_r8,4000._r8,4000._r8,4000._r8,2000._r8,3000._r8,1.e36_r8,1.e36_r8,4000._r8,4000._r8,8000._r8/ + data rclo(5,1:NLUse) & + /1.e36_r8,1000._r8, 500._r8, 500._r8,1500._r8, 700._r8,1.e36_r8,1.e36_r8, 600._r8, 800._r8, 800._r8/ + + !--------------------------------------------------------------------------- + ! ... roughness length + !--------------------------------------------------------------------------- + real(r8), public, dimension(NSeas,NLUse) :: z0 + + data z0 (1,1:NLUse) & + /1.000_r8,0.250_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.150_r8,0.100_r8,0.100_r8/ + data z0 (2,1:NLUse) & + /1.000_r8,0.100_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.100_r8,0.080_r8,0.080_r8/ + data z0 (3,1:NLUse) & + /1.000_r8,0.005_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.100_r8,0.020_r8,0.060_r8/ + data z0 (4,1:NLUse) & + /1.000_r8,0.001_r8,0.001_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.001_r8,0.001_r8,0.040_r8/ + data z0 (5,1:NLUse) & + /1.000_r8,0.030_r8,0.020_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.010_r8,0.030_r8,0.060_r8/ + + !real(r8), private, dimension(11,5), parameter :: z0xxx = reshape ( & + ! (/ 1.000,0.250,0.050,1.000,1.000,1.000,0.0006,0.002,0.150,0.100,0.100 , & + ! 1.000,0.100,0.050,1.000,1.000,1.000,0.0006,0.002,0.100,0.080,0.080 , & + ! 1.000,0.005,0.050,1.000,1.000,1.000,0.0006,0.002,0.100,0.020,0.060 , & + ! 1.000,0.001,0.001,1.000,1.000,1.000,0.0006,0.002,0.001,0.001,0.040 , & + ! 1.000,0.030,0.020,1.000,1.000,1.000,0.0006,0.002,0.010,0.030,0.060 /), (/11,5/) ) + + !--------------------------------------------------------------------------- + ! public chemical data + !--------------------------------------------------------------------------- + + !--- data for foxd (reactivity factor for oxidation) ---- + real(r8), public, parameter :: dfoxd(n_species_table) = & + (/ 1._r8 & ! OX + ,1._r8 & ! H2O2 + ,1._r8 & ! OH + ,.1_r8 & ! HO2 + ,1.e-36_r8 & ! CO + ,1.e-36_r8 & ! CH4 + ,1._r8 & ! CH3O2 + ,1._r8 & ! CH3OOH + ,1._r8 & ! CH2O + ,1._r8 & ! HCOOH + ,0._r8 & ! NO + ,.1_r8 & ! NO2 + ,1.e-36_r8 & ! HNO3 + ,1.e-36_r8 & ! CO2 + ,1.e-36_r8 & ! NH3 + ,.1_r8 & ! N2O5 + ,1._r8 & ! NO3 + ,1._r8 & ! CH3OH + ,.1_r8 & ! HO2NO2 + ,1._r8 & ! O1D + ,1.e-36_r8 & ! C2H6 + ,.1_r8 & ! C2H5O2 + ,.1_r8 & ! PO2 + ,.1_r8 & ! MACRO2 + ,.1_r8 & ! ISOPO2 + ,1.e-36_r8 & ! C4H10 + ,1._r8 & ! CH3CHO + ,1._r8 & ! C2H5OOH + ,1.e-36_r8 & ! C3H6 + ,1._r8 & ! POOH + ,1.e-36_r8 & ! C2H4 + ,.1_r8 & ! PAN + ,1._r8 & ! CH3COOOH + ,1.e-36_r8 & ! MTERP + ,1._r8 & ! GLYOXAL + ,1._r8 & ! CH3COCHO + ,1._r8 & ! GLYALD + ,.1_r8 & ! CH3CO3 + ,1.e-36_r8 & ! C3H8 + ,.1_r8 & ! C3H7O2 + ,1._r8 & ! CH3COCH3 + ,1._r8 & ! C3H7OOH + ,.1_r8 & ! RO2 + ,1._r8 & ! ROOH + ,1.e-36_r8 & ! Rn + ,1.e-36_r8 & ! ISOP + ,1._r8 & ! MVK + ,1._r8 & ! MACR + ,1._r8 & ! C2H5OH + ,1._r8 & ! ONITR + ,.1_r8 & ! ONIT + ,.1_r8 & ! ISOPNO3 + ,1._r8 & ! HYDRALD + ,1.e-36_r8 & ! HCN + ,1.e-36_r8 & ! CH3CN + ,1.e-36_r8 & ! SO2 + ,0.1_r8 & ! SOAGff0 + ,0.1_r8 & ! SOAGff1 + ,0.1_r8 & ! SOAGff2 + ,0.1_r8 & ! SOAGff3 + ,0.1_r8 & ! SOAGff4 + ,0.1_r8 & ! SOAGbg0 + ,0.1_r8 & ! SOAGbg1 + ,0.1_r8 & ! SOAGbg2 + ,0.1_r8 & ! SOAGbg3 + ,0.1_r8 & ! SOAGbg4 + ,0.1_r8 & ! SOAG0 + ,0.1_r8 & ! SOAG1 + ,0.1_r8 & ! SOAG2 + ,0.1_r8 & ! SOAG3 + ,0.1_r8 & ! SOAG4 + ,0.1_r8 & ! IVOC + ,0.1_r8 & ! SVOC + ,0.1_r8 & ! IVOCbb + ,0.1_r8 & ! IVOCff + ,0.1_r8 & ! SVOCbb + ,0.1_r8 & ! SVOCff + ,1.e-36_r8 & ! N2O + ,1.e-36_r8 & ! H2 + ,1.e-36_r8 & ! C2H2 + ,1._r8 & ! CH3COOH + ,1._r8 & ! EOOH + ,1._r8 & ! HYAC + ,1.e-36_r8 & ! BIGENE + ,1.e-36_r8 & ! BIGALK + ,1._r8 & ! MEK + ,1._r8 & ! MEKOOH + ,1._r8 & ! MACROOH + ,1._r8 & ! MPAN + ,1._r8 & ! ALKNIT + ,1._r8 & ! NOA + ,1._r8 & ! ISOPNITA + ,1._r8 & ! ISOPNITB + ,1._r8 & ! ISOPNOOH + ,1._r8 & ! NC4CHO + ,1._r8 & ! NC4CH2OH + ,1._r8 & ! TERPNIT + ,1._r8 & ! NTERPOOH + ,1._r8 & ! ALKOOH + ,1._r8 & ! BIGALD + ,1._r8 & ! HPALD + ,1._r8 & ! IEPOX + ,1._r8 & ! XOOH + ,1._r8 & ! ISOPOOH + ,1.e-36_r8 & ! TOLUENE + ,1._r8 & ! CRESOL + ,1._r8 & ! TOLOOH + ,1.e-36_r8 & ! BENZENE + ,1._r8 & ! PHENOL + ,1._r8 & ! BEPOMUC + ,1._r8 & ! PHENOOH + ,1._r8 & ! C6H5OOH + ,1._r8 & ! BENZOOH + ,1._r8 & ! BIGALD1 + ,1._r8 & ! BIGALD2 + ,1._r8 & ! BIGALD3 + ,1._r8 & ! BIGALD4 + ,1._r8 & ! TEPOMUC + ,1._r8 & ! BZOOH + ,1._r8 & ! BZALD + ,1._r8 & ! PBZNIT + ,1.e-36_r8 & ! XYLENES + ,1._r8 & ! XYLOL + ,1._r8 & ! XYLOLOOH + ,1._r8 & ! XYLENOOH + ,1.e-36_r8 & ! BCARY + ,1._r8 & ! TERPOOH + ,1._r8 & ! TERPROD1 + ,1._r8 & ! TERPROD2 + ,1._r8 & ! TERP2OOH + ,1.e-36_r8 & ! DMS + ,1.e-36_r8 & ! H2SO4 + ,1._r8 & ! HONITR + ,1._r8 & ! MACRN + ,1._r8 & ! MVKN + ,1._r8 & ! ISOPN2B + ,1._r8 & ! ISOPN3B + ,1._r8 & ! ISOPN4D + ,1._r8 & ! ISOPN1D + ,1._r8 & ! ISOPNOOHD + ,1._r8 & ! ISOPNOOHB + ,1._r8 & ! ISOPNBNO3 + ,1._r8 & ! NO3CH2CHO + ,1._r8 & ! HYPERACET + ,1._r8 & ! HCOCH2OOH + ,1._r8 & ! DHPMPAL + ,1._r8 & ! MVKOOH + ,1._r8 & ! ISOPOH + ,1._r8 & ! ISOPFDN + ,1._r8 & ! ISOPFNP + ,1._r8 & ! INHEB + ,1._r8 & ! HMHP + ,1._r8 & ! HPALD1 + ,1._r8 & ! INHED + ,1._r8 & ! HPALD4 + ,1._r8 & ! ISOPHFP + ,1._r8 & ! HPALDB1C + ,1._r8 & ! HPALDB4C + ,1._r8 & ! ICHE + ,1._r8 & ! ISOPFDNC + ,1._r8 & ! ISOPFNC + ,1._r8 & ! TERPNT + ,1._r8 & ! TERPNS + ,1._r8 & ! TERPNT1 + ,1._r8 & ! TERPNS1 + ,1._r8 & ! TERPNPT + ,1._r8 & ! TERPNPS + ,1._r8 & ! TERPNPT1 + ,1._r8 & ! TERPNPS1 + ,1._r8 & ! TERPFDN + ,1._r8 & ! SQTN + ,1._r8 & ! TERPHFN + ,1._r8 & ! TERP1OOH + ,1._r8 & ! TERPDHDP + ,1._r8 & ! TERPF2 + ,1._r8 & ! TERPF1 + ,1._r8 & ! TERPA + ,1._r8 & ! TERPA2 + ,1._r8 & ! TERPK + ,1._r8 & ! TERPAPAN + ,1._r8 & ! TERPACID + ,1._r8 & ! TERPA2PAN + ,1.e-36_r8 & ! APIN + ,1.e-36_r8 & ! BPIN + ,1.e-36_r8 & ! LIMON + ,1.e-36_r8 & ! MYRC + ,1._r8 & ! TERPACID2 + ,1._r8 & ! TERPACID3 + ,1._r8 & ! TERPA3PAN + ,1._r8 & ! TERPOOHL + ,1._r8 & ! TERPA3 + ,1._r8 & ! TERP2AOOH + /) -contains + ! PRIVATE DATA: + + Interface seq_drydep_setHCoeff ! overload subroutine + Module Procedure set_hcoeff_scalar + Module Procedure set_hcoeff_vector + End Interface + + real(r8), private, parameter :: small_value = 1.e-36_r8 !--- smallest value to use --- + + !--------------------------------------------------------------------------- + ! private chemical data + !--------------------------------------------------------------------------- + + !--- Names of species that can work with --- + character(len=20), public, parameter :: species_name_table(n_species_table) = & + (/ 'OX ' & + ,'H2O2 ' & + ,'OH ' & + ,'HO2 ' & + ,'CO ' & + ,'CH4 ' & + ,'CH3O2 ' & + ,'CH3OOH ' & + ,'CH2O ' & + ,'HCOOH ' & + ,'NO ' & + ,'NO2 ' & + ,'HNO3 ' & + ,'CO2 ' & + ,'NH3 ' & + ,'N2O5 ' & + ,'NO3 ' & + ,'CH3OH ' & + ,'HO2NO2 ' & + ,'O1D ' & + ,'C2H6 ' & + ,'C2H5O2 ' & + ,'PO2 ' & + ,'MACRO2 ' & + ,'ISOPO2 ' & + ,'C4H10 ' & + ,'CH3CHO ' & + ,'C2H5OOH ' & + ,'C3H6 ' & + ,'POOH ' & + ,'C2H4 ' & + ,'PAN ' & + ,'CH3COOOH ' & + ,'MTERP ' & + ,'GLYOXAL ' & + ,'CH3COCHO ' & + ,'GLYALD ' & + ,'CH3CO3 ' & + ,'C3H8 ' & + ,'C3H7O2 ' & + ,'CH3COCH3 ' & + ,'C3H7OOH ' & + ,'RO2 ' & + ,'ROOH ' & + ,'Rn ' & + ,'ISOP ' & + ,'MVK ' & + ,'MACR ' & + ,'C2H5OH ' & + ,'ONITR ' & + ,'ONIT ' & + ,'ISOPNO3 ' & + ,'HYDRALD ' & + ,'HCN ' & + ,'CH3CN ' & + ,'SO2 ' & + ,'SOAGff0 ' & + ,'SOAGff1 ' & + ,'SOAGff2 ' & + ,'SOAGff3 ' & + ,'SOAGff4 ' & + ,'SOAGbg0 ' & + ,'SOAGbg1 ' & + ,'SOAGbg2 ' & + ,'SOAGbg3 ' & + ,'SOAGbg4 ' & + ,'SOAG0 ' & + ,'SOAG1 ' & + ,'SOAG2 ' & + ,'SOAG3 ' & + ,'SOAG4 ' & + ,'IVOC ' & + ,'SVOC ' & + ,'IVOCbb ' & + ,'IVOCff ' & + ,'SVOCbb ' & + ,'SVOCff ' & + ,'N2O ' & + ,'H2 ' & + ,'C2H2 ' & + ,'CH3COOH ' & + ,'EOOH ' & + ,'HYAC ' & + ,'BIGENE ' & + ,'BIGALK ' & + ,'MEK ' & + ,'MEKOOH ' & + ,'MACROOH ' & + ,'MPAN ' & + ,'ALKNIT ' & + ,'NOA ' & + ,'ISOPNITA ' & + ,'ISOPNITB ' & + ,'ISOPNOOH ' & + ,'NC4CHO ' & + ,'NC4CH2OH ' & + ,'TERPNIT ' & + ,'NTERPOOH ' & + ,'ALKOOH ' & + ,'BIGALD ' & + ,'HPALD ' & + ,'IEPOX ' & + ,'XOOH ' & + ,'ISOPOOH ' & + ,'TOLUENE ' & + ,'CRESOL ' & + ,'TOLOOH ' & + ,'BENZENE ' & + ,'PHENOL ' & + ,'BEPOMUC ' & + ,'PHENOOH ' & + ,'C6H5OOH ' & + ,'BENZOOH ' & + ,'BIGALD1 ' & + ,'BIGALD2 ' & + ,'BIGALD3 ' & + ,'BIGALD4 ' & + ,'TEPOMUC ' & + ,'BZOOH ' & + ,'BZALD ' & + ,'PBZNIT ' & + ,'XYLENES ' & + ,'XYLOL ' & + ,'XYLOLOOH ' & + ,'XYLENOOH ' & + ,'BCARY ' & + ,'TERPOOH ' & + ,'TERPROD1 ' & + ,'TERPROD2 ' & + ,'TERP2OOH ' & + ,'DMS ' & + ,'H2SO4 ' & + ,'HONITR ' & + ,'MACRN ' & + ,'MVKN ' & + ,'ISOPN2B ' & + ,'ISOPN3B ' & + ,'ISOPN4D ' & + ,'ISOPN1D ' & + ,'ISOPNOOHD' & + ,'ISOPNOOHB' & + ,'ISOPNBNO3' & + ,'NO3CH2CHO' & + ,'HYPERACET' & + ,'HCOCH2OOH' & + ,'DHPMPAL ' & + ,'MVKOOH ' & + ,'ISOPOH ' & + ,'ISOPFDN ' & + ,'ISOPFNP ' & + ,'INHEB ' & + ,'HMHP ' & + ,'HPALD1 ' & + ,'INHED ' & + ,'HPALD4 ' & + ,'ISOPHFP ' & + ,'HPALDB1C ' & + ,'HPALDB4C ' & + ,'ICHE ' & + ,'ISOPFDNC ' & + ,'ISOPFNC ' & + ,'TERPNT ' & + ,'TERPNS ' & + ,'TERPNT1 ' & + ,'TERPNS1 ' & + ,'TERPNPT ' & + ,'TERPNPS ' & + ,'TERPNPT1 ' & + ,'TERPNPS1 ' & + ,'TERPFDN ' & + ,'SQTN ' & + ,'TERPHFN ' & + ,'TERP1OOH ' & + ,'TERPDHDP ' & + ,'TERPF2 ' & + ,'TERPF1 ' & + ,'TERPA ' & + ,'TERPA2 ' & + ,'TERPK ' & + ,'TERPAPAN ' & + ,'TERPACID ' & + ,'TERPA2PAN' & + ,'APIN ' & + ,'BPIN ' & + ,'LIMON ' & + ,'MYRC ' & + ,'TERPACID2' & + ,'TERPACID3' & + ,'TERPA3PAN' & + ,'TERPOOHL ' & + ,'TERPA3 ' & + ,'TERP2AOOH' & + /) + + !--- data for effective Henry's Law coefficient --- + real(r8), public, parameter :: dheff(n_species_table*6) = & + (/1.03e-02_r8, 2830._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! OX + ,8.70e+04_r8, 7320._r8,2.2e-12_r8,-3730._r8,0._r8 , 0._r8 & ! H2O2 + ,3.90e+01_r8, 4300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! OH + ,6.90e+02_r8, 5900._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HO2 + ,9.81e-04_r8, 1650._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CO + ,1.41e-03_r8, 1820._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH4 + ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3O2 + ,3.00e+02_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3OOH + ,3.23e+03_r8, 7100._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH2O + ,8.90e+03_r8, 6100._r8,1.8e-04_r8, -20._r8,0._r8 , 0._r8 & ! HCOOH + ,1.92e-03_r8, 1762._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NO + ,1.20e-02_r8, 2440._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NO2 + ,2.10e+05_r8, 8700._r8,2.2e+01_r8, 0._r8,0._r8 , 0._r8 & ! HNO3 + ,3.44e-02_r8, 2715._r8,4.3e-07_r8,-1000._r8,4.7e-11_r8,-1760._r8 & ! CO2 + ,6.02e+01_r8, 4160._r8,1.7e-05_r8,-4325._r8,1.0e-14_r8,-6716._r8 & ! NH3 + ,2.14e+00_r8, 3362._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! N2O5 + ,3.80e-02_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NO3 + ,2.03e+02_r8, 5645._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3OH + ,4.00e+01_r8, 8400._r8,1.3e-06_r8, 0._r8,0._r8 , 0._r8 & ! HO2NO2 + ,1.00e-16_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! O1D + ,1.88e-03_r8, 2750._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H6 + ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H5O2 + ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PO2 + ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MACRO2 + ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPO2 + ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C4H10 + ,1.29e+01_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3CHO + ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H5OOH + ,5.57e-03_r8, 2800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C3H6 + ,1.50e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! POOH + ,5.96e-03_r8, 2200._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H4 + ,2.80e+00_r8, 5730._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PAN + ,8.37e+02_r8, 5310._r8,1.8e-04_r8, -20._r8,0._r8 , 0._r8 & ! CH3COOOH + ,2.94e-02_r8, 1800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MTERP + ,4.19e+05_r8, 7480._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! GLYOXAL + ,3.50e+03_r8, 7545._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3COCHO + ,4.00e+04_r8, 4630._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! GLYALD + ,1.00e-01_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3CO3 + ,1.51e-03_r8, 3120._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C3H8 + ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C3H7O2 + ,2.78e+01_r8, 5530._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3COCH3 + ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C3H7OOH + ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! RO2 + ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ROOH + ,0.00e+00_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! Rn + ,3.45e-02_r8, 4400._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOP + ,4.10e+01_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MVK + ,6.50e+00_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MACR + ,1.90e+02_r8, 6500._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H5OH + ,1.44e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ONITR + ,1.00e+03_r8, 6000._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ONIT + ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNO3 + ,1.10e+05_r8, 6000._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HYDRALD + ,9.02e+00_r8, 8258._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HCN + ,5.28e+01_r8, 3970._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3CN + ,1.36e+00_r8, 3100._r8,1.30e-02_r8,1960._r8,6.6e-08_r8, 1500._r8 & ! SO2 + ,1.3e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff0 + ,3.2e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff1 + ,4.0e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff2 + ,1.3e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff3 + ,1.6e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff4 + ,7.9e+11_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg0 + ,6.3e+10_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg1 + ,3.2e+09_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg2 + ,6.3e+08_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg3 + ,3.2e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg4 + ,4.0e+11_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG0 + ,3.2e+10_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG1 + ,1.6e+09_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG2 + ,3.2e+08_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG3 + ,1.6e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG4 + ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! IVOC + ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SVOC + ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! IVOCbb + ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! IVOCff + ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SVOCbb + ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SVOCff + ,2.42e-02_r8, 2710._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! N2O + ,7.9e-04_r8, 530._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! H2 + ,4.14e-02_r8, 1890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H2 + ,4.1e+03_r8, 6200._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3COOH + ,1.9e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! EOOH + ,1.46e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HYAC + ,5.96e-03_r8, 2365._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGENE + ,1.24e-03_r8, 3010._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALK + ,1.80e+01_r8, 5740._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MEK + ,6.4e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MEKOOH + ,4.4e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MACROOH + ,1.72e+00_r8, 5700._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MPAN + ,1.01e+00_r8, 5790._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ALKNIT + ,1.e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NOA + ,8.34e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNITA + ,4.82e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNITB + ,8.75e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNOOH + ,1.46e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NC4CHO + ,4.02e+04_r8, 9500._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NC4CH2OH + ,8.41e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNIT + ,6.67e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NTERPOOH + ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ALKOOH + ,9.6e+00_r8, 6220._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD + ,2.30e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALD + ,3.e+07_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! IEPOX + ,1.e+11_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XOOH + ,3.5e+06_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPOOH + ,1.5e-01_r8, 4300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TOLUENE + ,5.67e+02_r8, 5800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CRESOL + ,2.30e+04_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TOLOOH + ,1.8e-01_r8, 3800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BENZENE + ,2.84e+03_r8, 2700._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PHENOL + ,3.e+07_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BEPOMUC + ,1.5e+06_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PHENOOH + ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C6H5OOH + ,2.3e+03_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BENZOOH + ,1.e+05_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD1 + ,2.9e+04_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD2 + ,2.2e+04_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD3 + ,2.2e+04_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD4 + ,2.5e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TEPOMUC + ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BZOOH + ,3.24e+01_r8, 6300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BZALD + ,2.8e+00_r8, 5730._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PBZNIT + ,2.e-01_r8, 4300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XYLENES + ,1.01e+03_r8, 6800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XYLOL + ,1.9e+06_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XYLOLOOH + ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XYLENOOH + ,5.57e-03_r8, 2800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BCARY + ,3.6e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPOOH + ,3.92e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPROD1 + ,7.20e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPROD2 + ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERP2OOH + ,5.4e-01_r8, 3460._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! DMS + ,1.e+11_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! H2SO4 + ,2.64e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HONITR + ,4.14e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MACRN + ,1.84e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MVKN + ,8.34e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPN2B + ,8.34e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPN3B + ,4.82e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPN4D + ,4.82e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPN1D + ,9.67e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNOOHD + ,6.61e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNOOHB + ,8.34e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNBNO3 + ,3.39e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NO3CH2CHO + ,1.16e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HYPERACET + ,2.99e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HCOCH2OOH + ,9.37e+07_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! DHPMPAL + ,1.24e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MVKOOH + ,8.77e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPOH + ,5.02e+08_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPFDN + ,2.97e+11_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPFNP + ,1.05e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! INHEB + ,1.70e+06_r8, 9870._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HMHP + ,2.30e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALD1 + ,1.51e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! INHED + ,2.30e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALD4 + ,7.60e+09_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPHFP + ,5.43e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALDB1C + ,5.43e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALDB4C + ,2.09e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ICHE + ,7.16e+09_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPFDNC + ,1.41e+11_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPFNC + ,8.41e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNT + ,8.41e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNS + ,8.55e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNT1 + ,8.55e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNS1 + ,6.67e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNPT + ,6.67e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNPS + ,6.78e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNPT1 + ,6.78e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNPS1 + ,1.65e+09_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPFDN + ,9.04e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SQTN + ,7.53e+11_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPHFN + ,3.64e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERP1OOH + ,3.41e+14_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPDHDP + ,6.54e+01_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPF2 + ,4.05e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPF1 + ,3.92e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA + ,7.20e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA2 + ,6.39e+01_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPK + ,7.94e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPAPAN + ,5.63e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPACID + ,9.59e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA2PAN + ,2.94e-02_r8, 1800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! APIN + ,1.52e-02_r8, 4500._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BPIN + ,4.86e-02_r8, 4600._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! LIMON + ,7.30e-02_r8, 2800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MYRC + ,2.64e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPACID2 + ,3.38e+09_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPACID3 + ,1.23e+07_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA3PAN + ,4.41e+12_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPOOHL + ,1.04e+08_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA3 + ,3.67e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERP2AOOH + /) + + real(r8), private, parameter :: wh2o = SHR_CONST_MWWV + real(r8), private, parameter :: mol_wgts(n_species_table) = & + (/ 47.9981995_r8, 34.0135994_r8, 17.0067997_r8, 33.0061989_r8, 28.0104008_r8, & + 16.0405998_r8, 47.0320015_r8, 48.0393982_r8, 30.0251999_r8, 46.0246010_r8, & + 30.0061398_r8, 46.0055389_r8, 63.0123405_r8, 44.0098000_r8, 17.0289402_r8, & + 108.010483_r8, 62.0049400_r8, 32.0400009_r8, 79.0117416_r8, 15.9994001_r8, & + 30.0664005_r8, 61.0578003_r8, 91.0830002_r8, 119.093399_r8, 117.119797_r8, & + 58.1180000_r8, 44.0509987_r8, 62.0652008_r8, 42.0774002_r8, 92.0904007_r8, & + 28.0515995_r8, 121.047943_r8, 76.0497971_r8, 136.228394_r8, 58.0355988_r8, & + 72.0614014_r8, 60.0503998_r8, 75.0423965_r8, 44.0922012_r8, 75.0836029_r8, & + 58.0768013_r8, 76.0910034_r8, 89.070126_r8, 90.078067_r8, 222.000000_r8, & + 68.1141968_r8, 70.0877991_r8, 70.0877991_r8, 46.0657997_r8, 147.125946_r8, & + 119.074341_r8, 162.117935_r8, 100.112999_r8, 27.0256_r8 , 41.0524_r8 , & + 64.064800_r8, 250._r8, 250._r8, 250._r8, 250._r8, & + 250._r8, 250._r8, 250._r8, 250._r8, 250._r8, & + 250._r8, 250._r8, 250._r8, 250._r8, 250._r8, & + 250._r8, 170.3_r8, 170.3_r8, 170.3_r8, 170.3_r8, & + 170.3_r8, 170.3_r8, 44.0129_r8, 2.0148_r8, 26.0368_r8, & + 60.0504_r8, 78.0646_r8, 74.0762_r8, 56.1032_r8, 72.1438_r8, & + 72.1026_r8, 104.101_r8, 120.101_r8, 147.085_r8, 133.141_r8, & + 119.074_r8, 147.126_r8, 147.126_r8, 163.125_r8, 145.111_r8, & + 147.126_r8, 215.24_r8, 231.24_r8, 104.143_r8, 98.0982_r8, & + 116.112_r8, 118.127_r8, 150.126_r8, 118.127_r8, 92.1362_r8, & + 108.136_r8, 174.148_r8, 78.1104_r8, 94.1098_r8, 126.109_r8, & + 176.122_r8, 110.109_r8, 160.122_r8, 84.0724_r8, 98.0982_r8, & + 98.0982_r8, 112.124_r8, 140.134_r8, 124.135_r8, 106.121_r8, & + 183.118_r8, 106.162_r8, 122.161_r8, 204.173_r8, 188.174_r8, & + 204.343_r8, 186.241_r8, 168.227_r8, 154.201_r8, 200.226_r8, & + 62.1324_r8, 98.0784_r8, 135.118733_r8, 149.102257_r8, 149.102257_r8, & + 147.129469_r8, 147.129469_r8, 147.129469_r8, 147.129469_r8, 163.128874_r8, & + 163.128874_r8, 147.129469_r8, 105.049617_r8, 90.078067_r8, 76.05145_r8, & + 136.103494_r8, 120.104089_r8, 102.131897_r8, 226.141733_r8, 197.143565_r8, & + 163.128874_r8, 64.040714_r8, 116.11542_r8, 163.128874_r8, 116.11542_r8, & + 150.130112_r8, 116.11542_r8, 116.11542_r8, 116.11542_r8, 224.125851_r8, & + 195.127684_r8, 215.246675_r8, 215.246675_r8, 215.246675_r8, 215.246675_r8, & + 231.24608_r8, 231.24608_r8, 231.24608_r8, 231.24608_r8, 294.258938_r8, & + 283.36388_r8, 265.260771_r8, 186.248507_r8, 236.262604_r8, 110.153964_r8, & + 168.233221_r8, 168.233221_r8, 154.206603_r8, 138.207199_r8, 245.229603_r8, & + 200.232031_r8, 231.202986_r8, 136.228394_r8, 136.228394_r8, 136.228394_r8, & + 136.228394_r8, 186.205413_r8, 202.204818_r8, 247.202391_r8, 218.247317_r8, & + 170.206008_r8, 186.248507_r8 /) + + +!=============================================================================== +CONTAINS +!=============================================================================== subroutine seq_drydep_readnl(NLFilename, drydep_nflds) + !======================================================================== + ! reads drydep_inparm namelist and determines the number of drydep velocity + ! fields that are sent from the land component + !======================================================================== + character(len=*), intent(in) :: NLFilename ! Namelist filename integer, intent(out) :: drydep_nflds - call shr_drydep_readnl(NLFilename, drydep_nflds) + !----- local ----- + integer :: i ! Indices + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not + type(ESMF_VM) :: vm + integer :: localPet + integer :: mpicom + integer :: rc + character(*),parameter :: F00 = "('(seq_drydep_read) ',8a)" + character(*),parameter :: FI1 = "('(seq_drydep_init) ',a,I2)" + character(*),parameter :: subName = '(seq_drydep_read) ' + !----------------------------------------------------------------------------- + + namelist /drydep_inparm/ drydep_list, drydep_method + + !----------------------------------------------------------------------------- + ! Read namelist and figure out the drydep field list to pass + ! First check if file exists and if not, n_drydep will be zero + !----------------------------------------------------------------------------- - lnd_drydep = drydep_nflds>0 + rc = ESMF_SUCCESS + drydep_nflds = 0 + + !--- Open and read namelist --- + if ( len_trim(NLFilename) == 0 )then + call shr_sys_abort( subName//'ERROR: nlfilename not set' ) + end if + + 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' ) + write(s_logunit,F00) 'Read in drydep_inparm namelist from: ', trim(NLFilename) + call shr_nl_find_group_name(unitn, 'drydep_inparm', ierr) + if (ierr == 0) then + ! Note that ierr /= 0, no namelist is present. + read(unitn, drydep_inparm, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort( 'problem on read of drydep_inparm namelist in seq_drydep_readnl') + end if + endif + close( unitn ) + end if + end if + call shr_mpi_bcast( drydep_list, mpicom ) + call shr_mpi_bcast( drydep_method, mpicom ) + + do i=1,maxspc + if(len_trim(drydep_list(i)) > 0) then + drydep_nflds=drydep_nflds+1 + endif + enddo + + ! set module variable + n_drydep = drydep_nflds + + ! Make sure method is valid and determine if land is passing drydep fields + lnd_drydep = (drydep_nflds>0 .and. drydep_method == DD_XLND) + if (localpet==0) then + write(s_logunit,*) 'seq_drydep_read: drydep_method: ', trim(drydep_method) + if ( drydep_nflds == 0 )then + write(s_logunit,F00) 'No dry deposition fields will be transfered' + else + write(s_logunit,FI1) 'Number of dry deposition fields transfered is ', drydep_nflds + end if + end if + + if ( trim(drydep_method)/=trim(DD_XATM) .and. & + trim(drydep_method)/=trim(DD_XLND) .and. & + trim(drydep_method)/=trim(DD_TABL) ) then + write(s_logunit,*) 'seq_drydep_read: drydep_method : ', trim(drydep_method) + write(s_logunit,*) 'seq_drydep_read: drydep_method must be set to : ', & + DD_XATM,', ', DD_XLND,', or ', DD_TABL + call shr_sys_abort('seq_drydep_read: incorrect dry deposition method specification') + endif + + if (.not. drydep_initialized) then + call seq_drydep_init() + end if end subroutine seq_drydep_readnl +!==================================================================================== + + subroutine seq_drydep_init( ) + + !======================================================================== + ! Initialization of dry deposition fields + ! reads drydep_inparm namelist and sets up CCSM driver list of fields for + ! land-atmosphere communications. + !======================================================================== + + !----- local ----- + integer :: i, l ! Indices + character(len=32) :: test_name ! field test name + + !----- formats ----- + character(*),parameter :: subName = '(seq_drydep_init) ' + character(*),parameter :: F00 = "('(seq_drydep_init) ',8a)" + + !----------------------------------------------------------------------------- + ! Return if this routine has already been called (e.g. cam and clm both call this) + !----------------------------------------------------------------------------- + if(allocated(foxd)) return + !----------------------------------------------------------------------------- + ! Allocate and fill foxd, drat and mapping as well as species indices + !----------------------------------------------------------------------------- + + if ( n_drydep > 0 ) then + + allocate( foxd(n_drydep) ) + allocate( drat(n_drydep) ) + allocate( mapping(n_drydep) ) + + ! This initializes these variables to infinity. + foxd = shr_infnan_posinf + drat = shr_infnan_posinf + + mapping(:) = 0 + + end if + + h2_ndx=-1; ch4_ndx=-1; co_ndx=-1; mpan_ndx = -1; pan_ndx = -1; so2_ndx=-1; o3_ndx=-1; xpan_ndx=-1 + + !--- Loop over drydep species that need to be worked with --- + do i=1,n_drydep + if ( len_trim(drydep_list(i))==0 ) exit + + test_name = drydep_list(i) + + if( trim(test_name) == 'O3' ) then + test_name = 'OX' + end if + + !--- Figure out if species maps to a species in the species table --- + do l = 1,n_species_table + if( trim( test_name ) == trim( species_name_table(l) ) ) then + mapping(i) = l + exit + end if + end do + + !--- If it doesn't map to a species in the species table find species close enough --- + if( mapping(i) < 1 ) then + select case( trim(test_name) ) + case( 'O3S', 'O3INERT' ) + test_name = 'OX' + case( 'Pb' ) + test_name = 'HNO3' + case( 'SOGM','SOGI','SOGT','SOGB','SOGX' ) + test_name = 'CH3OOH' + case( 'SOA', 'SO4', 'CB1', 'CB2', 'OC1', 'OC2', 'NH4', 'SA1', 'SA2', 'SA3', 'SA4' ) + test_name = 'OX' ! this is just a place holder. values are explicitly set below + case( 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX' ) + test_name = 'OX' ! this is just a place holder. values are explicitly set below + case( 'SOAGbb0' ) + test_name = 'SOAGff0' + case( 'SOAGbb1' ) + test_name = 'SOAGff1' + case( 'SOAGbb2' ) + test_name = 'SOAGff2' + case( 'SOAGbb3' ) + test_name = 'SOAGff3' + case( 'SOAGbb4' ) + test_name = 'SOAGff4' + case( 'O3A' ) + test_name = 'OX' + case( 'XMPAN' ) + test_name = 'MPAN' + case( 'XPAN' ) + test_name = 'PAN' + case( 'XNO' ) + test_name = 'NO' + case( 'XNO2' ) + test_name = 'NO2' + case( 'XHNO3' ) + test_name = 'HNO3' + case( 'XONIT' ) + test_name = 'ONIT' + case( 'XONITR' ) + test_name = 'ONITR' + case( 'XHO2NO2') + test_name = 'HO2NO2' + case( 'XNH4NO3' ) + test_name = 'HNO3' + case( 'NH4NO3' ) + test_name = 'HNO3' + case default + test_name = 'blank' + end select + + !--- If found a match check the species table again --- + if( trim(test_name) /= 'blank' ) then + do l = 1,n_species_table + if( trim( test_name ) == trim( species_name_table(l) ) ) then + mapping(i) = l + exit + end if + end do + else + write(s_logunit,F00) trim(drydep_list(i)),' not in tables; will have dep vel = 0' + call shr_sys_abort( subName//': '//trim(drydep_list(i))//' is not in tables' ) + end if + end if + + !--- Figure out the specific species indices --- + if ( trim(drydep_list(i)) == 'H2' ) h2_ndx = i + if ( trim(drydep_list(i)) == 'CO' ) co_ndx = i + if ( trim(drydep_list(i)) == 'CH4' ) ch4_ndx = i + if ( trim(drydep_list(i)) == 'MPAN' ) mpan_ndx = i + if ( trim(drydep_list(i)) == 'PAN' ) pan_ndx = i + if ( trim(drydep_list(i)) == 'SO2' ) so2_ndx = i + if ( trim(drydep_list(i)) == 'OX' .or. trim(drydep_list(i)) == 'O3' ) o3_ndx = i + if ( trim(drydep_list(i)) == 'O3A' ) o3a_ndx = i + if ( trim(drydep_list(i)) == 'XPAN' ) xpan_ndx = i + + if( mapping(i) > 0) then + l = mapping(i) + foxd(i) = dfoxd(l) + drat(i) = sqrt(mol_wgts(l)/wh2o) + endif + + enddo + + where( rgss < 1._r8 ) + rgss = 1._r8 + endwhere + + where( rac < small_value) + rac = small_value + endwhere + + drydep_initialized = .true. + + end subroutine seq_drydep_init + +!==================================================================================== + + subroutine set_hcoeff_scalar( sfc_temp, heff ) + + !======================================================================== + ! Interface to seq_drydep_setHCoeff when input is scalar + ! wrapper routine used when surface temperature is a scalar (single column) rather + ! than an array (multiple columns). + ! + ! !REVISION HISTORY: + ! 2008-Nov-12 - F. Vitt - first version + !======================================================================== + + implicit none + + real(r8), intent(in) :: sfc_temp ! Input surface temperature + real(r8), intent(out) :: heff(n_drydep) ! Output Henry's law coefficients + + !----- local ----- + real(r8) :: sfc_temp_tmp(1) ! surface temp + + sfc_temp_tmp(:) = sfc_temp + call set_hcoeff_vector( 1, sfc_temp_tmp, heff(:n_drydep) ) + + end subroutine set_hcoeff_scalar + +!==================================================================================== + + subroutine set_hcoeff_vector( ncol, sfc_temp, heff ) + + !======================================================================== + ! Interface to seq_drydep_setHCoeff when input is vector + ! sets dry depositions coefficients -- used by both land and atmosphere models + !======================================================================== + + integer, intent(in) :: ncol ! Input size of surface-temp vector + real(r8), intent(in) :: sfc_temp(ncol) ! Surface temperature + real(r8), intent(out) :: heff(ncol,n_drydep) ! Henry's law coefficients + + !----- local ----- + real(r8), parameter :: t0 = 298._r8 ! Standard Temperature + real(r8), parameter :: ph_inv = 1._r8/ph ! Inverse of PH + integer :: m, l, id ! indices + real(r8) :: e298 ! Henry's law coefficient @ standard temperature (298K) + real(r8) :: dhr ! temperature dependence of Henry's law coefficient + real(r8) :: dk1s(ncol) ! DK Work array 1 + real(r8) :: dk2s(ncol) ! DK Work array 2 + real(r8) :: wrk(ncol) ! Work array + + !----- formats ----- + character(*),parameter :: subName = '(seq_drydep_set_hcoeff) ' + character(*),parameter :: F00 = "('(seq_drydep_set_hcoeff) ',8a)" + + !------------------------------------------------------------------------------- + ! notes: + !------------------------------------------------------------------------------- + + wrk(:) = (t0 - sfc_temp(:))/(t0*sfc_temp(:)) + do m = 1,n_drydep + l = mapping(m) + id = 6*(l - 1) + e298 = dheff(id+1) + dhr = dheff(id+2) + heff(:,m) = e298*exp( dhr*wrk(:) ) + !--- Calculate coefficients based on the drydep tables --- + if( dheff(id+3) /= 0._r8 .and. dheff(id+5) == 0._r8 ) then + e298 = dheff(id+3) + dhr = dheff(id+4) + dk1s(:) = e298*exp( dhr*wrk(:) ) + where( heff(:,m) /= 0._r8 ) + heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph_inv) + elsewhere + heff(:,m) = dk1s(:)*ph_inv + endwhere + end if + !--- For coefficients that are non-zero AND CO2 or NH3 handle things this way --- + if( dheff(id+5) /= 0._r8 ) then + if( trim( drydep_list(m) ) == 'CO2' .or. trim( drydep_list(m) ) == 'NH3' & + .or. trim( drydep_list(m) ) == 'SO2' ) then + e298 = dheff(id+3) + dhr = dheff(id+4) + dk1s(:) = e298*exp( dhr*wrk(:) ) + e298 = dheff(id+5) + dhr = dheff(id+6) + dk2s(:) = e298*exp( dhr*wrk(:) ) + !--- For Carbon dioxide --- + if( trim(drydep_list(m)) == 'CO2'.or. trim( drydep_list(m) ) == 'SO2' ) then + heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph_inv*(1._r8 + dk2s(:)*ph_inv)) + !--- For NH3 --- + else if( trim( drydep_list(m) ) == 'NH3' ) then + heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph/dk2s(:)) + !--- This can't happen --- + else + write(s_logunit,F00) 'Bad species ',drydep_list(m) + call shr_sys_abort( subName//'ERROR: in assigning coefficients' ) + end if + end if + end if + end do + + end subroutine set_hcoeff_vector + +!=============================================================================== + end module seq_drydep_mod From ce1bb64f865c560e546f40809a1eed12b8c787ab Mon Sep 17 00:00:00 2001 From: mvertens Date: Thu, 6 Oct 2022 15:16:06 -0600 Subject: [PATCH 112/395] put in correct way to set namelist for wavice coupling (#312) --- cime_config/buildnml | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index b80c74388..fd5d73df0 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -107,11 +107,10 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): nmlgen.init_defaults(infile, config, skip_default_for_groups=["modelio"]) #-------------------------------- - # Overwrite: wav-ice coupling (assumes cice6 as the ice component + # Set default wav-ice coupling (assumes cice6 as the ice component #-------------------------------- - ## commenting out wavice_coupling for now because it causes instabilities. -aa - ##if (case.get_value("COMP_WAV") == 'ww3dev' and case.get_value("COMP_ICE") == 'cice'): - ## nmlgen.set_value('wavice_coupling', value='.true.') + if (case.get_value("COMP_WAV") == 'ww3dev' and case.get_value("COMP_ICE") == 'cice'): + nmlgen.add_default('wavice_coupling', value='.true.') #-------------------------------- # Overwrite: set brnch_retain_casename From 325c10751c4a868bb020463d752adceab7f0b600 Mon Sep 17 00:00:00 2001 From: mvertens Date: Fri, 7 Oct 2022 10:13:49 -0600 Subject: [PATCH 113/395] changes that permits DAE test to work (#314) --- cime_config/namelist_definition_drv.xml | 176 ++++++++++++------------ 1 file changed, 88 insertions(+), 88 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 7674eb62b..fa860a440 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -3703,101 +3703,101 @@ - - - - - - - - - - - + + logical + data_assimilation + ALLCOMP_attributes + + Whether Data Assimilation is on for component atm + + + $DATA_ASSIMILATION_ATM + + - - - - - - - - - - - + + logical + data_assimilation + ALLCOMP_attributes + + Whether Data Assimilation is on for component CPL + + + $DATA_ASSIMILATION_CPL + + - - - - - - - - - - - + + logical + data_assimilation + ALLCOMP_attributes + + Whether Data Assimilation is on for component ocn + + + $DATA_ASSIMILATION_OCN + + - - - - - - - - - - - + + logical + data_assimilation + ALLCOMP_attributes + + Whether Data Assimilation is on for component wav + + + $DATA_ASSIMILATION_WAV + + - - - - - - - - - - - + + logical + data_assimilation + ALLCOMP_attributes + + Whether Data Assimilation is on for component glc + + + $DATA_ASSIMILATION_GLC + + - - - - - - - - - - - + + logical + data_assimilation + ALLCOMP_attributes + + Whether Data Assimilation is on for component rof + + + $DATA_ASSIMILATION_ROF + + - - - - - - - - - - - + + logical + data_assimilation + ALLCOMP_attributes + + Whether Data Assimilation is on for component ice + + + $DATA_ASSIMILATION_ICE + + - - - - - - - - - - - + + logical + data_assimilation + ALLCOMP_attributes + + Whether Data Assimilation is on for component lnd + + + $DATA_ASSIMILATION_LND + + logical From 962e7530f979734bb51303c8dfc8579d15db32e2 Mon Sep 17 00:00:00 2001 From: mvertens Date: Fri, 7 Oct 2022 10:16:56 -0600 Subject: [PATCH 114/395] simplify specification of stop_option, rest_option and history_option (cesm only) (#313) new simplified approach for setting setting stop, restart and history mediator settings --- cesm/driver/esm_time_mod.F90 | 53 ++++----- cime_config/config_component.xml | 6 +- cime_config/config_component_cesm.xml | 8 +- cime_config/namelist_definition_drv.xml | 145 ++++++++++++------------ 4 files changed, 106 insertions(+), 106 deletions(-) diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index 40c57b87c..7afcbc992 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -29,18 +29,18 @@ module esm_time_mod ! Clock and alarm options character(len=*), private, parameter :: & - optNONE = "none" , & - optNever = "never" , & - optNSteps = "nsteps" , & - optNSeconds = "nseconds" , & - optNMinutes = "nminutes" , & - optNHours = "nhours" , & - optNDays = "ndays" , & - optNMonths = "nmonths" , & - optNYears = "nyears" , & - optMonthly = "monthly" , & - optYearly = "yearly" , & - optDate = "date" , & + optNONE = "none" , & + optNever = "never" , & + optNSteps = "nstep" , & + optNSeconds = "nsecond" , & + optNMinutes = "nminute" , & + optNHours = "nhour" , & + optNDays = "nday" , & + optNMonths = "nmonth" , & + optNYears = "nyear" , & + optMonthly = "monthly" , & + optYearly = "yearly" , & + optDate = "date" , & optGLCCouplingPeriod = "glc_coupling_period" ! Module data @@ -434,13 +434,14 @@ subroutine esm_time_alarmInit( clock, alarm, option, & rc = ESMF_FAILURE return end if - else if (trim(option) == optNSteps .or. & - trim(option) == optNSeconds .or. & - trim(option) == optNMinutes .or. & - trim(option) == optNHours .or. & - trim(option) == optNDays .or. & - trim(option) == optNMonths .or. & - trim(option) == optNYears) then + else if (& + trim(option) == optNSteps .or. trim(option) == trim(optNSteps)//'s' .or. & + trim(option) == optNSeconds .or. trim(option) == trim(optNSeconds)//'s' .or. & + trim(option) == optNMinutes .or. trim(option) == trim(optNMinutes)//'s' .or. & + trim(option) == optNHours .or. trim(option) == trim(optNHours)//'s' .or. & + trim(option) == optNDays .or. trim(option) == trim(optNDays)//'s' .or. & + trim(option) == optNMonths .or. trim(option) == trim(optNMonths)//'s' .or. & + trim(option) == optNYears .or. trim(option) == trim(optNYears)//'s' ) then if (.not.present(opt_n)) then call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE @@ -451,7 +452,7 @@ subroutine esm_time_alarmInit( clock, alarm, option, & rc = ESMF_FAILURE return end if - end if + end if ! Determine inputs for call to create alarm selectcase (trim(option)) @@ -479,36 +480,36 @@ subroutine esm_time_alarmInit( clock, alarm, option, & if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .false. - case (optNSteps) + case (optNSteps,trim(optNSteps)//'s') call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. - case (optNSeconds) + case (optNSeconds,trim(optNSeconds)//'s') call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. - case (optNMinutes) + case (optNMinutes,trim(optNMinutes)//'s') call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. - case (optNHours) + case (optNHours,trim(optNHours)//'s') call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. - case (optNDays) + case (optNDays,trim(optNDays)//'s') call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. - case (optNMonths) + case (optNMonths,trim(optNMonths)//'s') call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index b8909947b..923e9afa8 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -340,7 +340,7 @@ char - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,date,end ndays run_begin_stop_restart env_run.xml @@ -372,7 +372,7 @@ char - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,date,end $STOP_OPTION run_begin_stop_restart env_run.xml @@ -404,7 +404,7 @@ char - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears never run_begin_stop_restart env_run.xml diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index b3becd832..cfcdc12ef 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -422,11 +422,11 @@ run_coupling env_run.xml - OPTION1 (like RASM_OPTION1 in CPL7) runs prep_ocn_avg, + OPTION1 (like RASM_OPTION1 in CPL7) runs prep_ocn_avg, BEFORE the aoflux and ocnalb calculations, thereby reducing most of the lags and field inconsistency but still allowing the ocean to run concurrently with the ice and atmosphere. - OPTION2 (like CESM1_MOD in CPL7) runs prep_ocn_avg, + OPTION2 (like CESM1_MOD in CPL7) runs prep_ocn_avg, AFTER the aoflux and ocnalb calculations, thereby permitting maximum concurrency TIGHT (like CESM1_MOD_TIGHT), is a tight coupling run sequence @@ -439,7 +439,7 @@ char - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,date,end never med_history env_run.xml @@ -468,7 +468,7 @@ char - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,date,end never nmonths diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index fa860a440..e35ff537d 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1072,23 +1072,22 @@ char time ALLCOMP_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history snapshot option (used with history_n and history_ymd) set by HIST_OPTION in env_run.xml. history_option alarms are: [none/never], turns option off - [nstep/s] , history snapshot every history_n nsteps , relative to current run start time - [nsecond/s] , history snapshot every history_n nseconds, relative to current run start time - [nminute/s] , history snapshot every history_n nminutes, relative to current run start time - [nhour/s] , history snapshot every history_n nhours , relative to current run start time - [nday/s] , history snapshot every history_n ndays , relative to current run start time - [monthly/s] , history snapshot every month , relative to current run start time - [nmonth/s] , history snapshot every history_n nmonths , relative to current run start time - [nyear/s] , history snapshot every history_n nyears , relative to current run start time - [date] , history snapshot at history_ymd value - [ifdays0] , history snapshot at history_n calendar day value and seconds equal 0 - [end] , history snapshot at end + [nsteps] , history snapshot every history_n nsteps , relative to current run start time + [nseconds] , history snapshot every history_n nseconds, relative to current run start time + [nminutes] , history snapshot every history_n nminutes, relative to current run start time + [nhours] , history snapshot every history_n nhours , relative to current run start time + [ndays] , history snapshot every history_n ndays , relative to current run start time + [monthly] , history snapshot every month , relative to current run start time + [nmonths] , history snapshot every history_n nmonths , relative to current run start time + [nyears] , history snapshot every history_n nyears , relative to current run start time + [date] , history snapshot at history_ymd value + [end] , history snapshot at end $HIST_OPTION @@ -1129,7 +1128,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history for mediator aoflux and oceean albedoes (used with history_n and history_ymd) @@ -1157,7 +1156,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history for atm import/export/fields snapshot option (used with history_n and history_ymd) @@ -1180,7 +1179,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator time average history option (used with histavg_n and histavg_ymd) @@ -1539,7 +1538,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history for ice import/export/fields snapshot option (used with history_n and history_ymd) @@ -1562,7 +1561,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator time average history option (used with histavg_n and histavg_ymd) @@ -1590,7 +1589,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history for glc import/export/fields snapshot option (used with history_n and history_ymd) @@ -1613,7 +1612,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator time average history option (used with histavg_n and histavg_ymd) @@ -1641,7 +1640,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history for lnd import/export/fields snapshot option (used with history_n and history_ymd) @@ -1664,7 +1663,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator time average history option (used with histavg_n and histavg_ymd) @@ -1770,7 +1769,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history for ocn import/export/fields snapshot option (used with history_n and history_ymd) @@ -1793,7 +1792,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator time average history option (used with histavg_n and histavg_ymd) @@ -1821,7 +1820,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history for rof import/export/fields snapshot option (used with history_n and history_ymd) @@ -1844,7 +1843,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator time average history option (used with histavg_n and histavg_ymd) @@ -1937,7 +1936,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history for wav import/export/fields snapshot option (used with history_n and history_ymd) @@ -1960,7 +1959,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator time average history option (used with histavg_n and histavg_ymd) @@ -2590,22 +2589,22 @@ char time CLOCK_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,monthly,nmonths,nyears,date,end sets the run length with stop_n and stop_ymd stop_option alarms are: - [none/never], turns option off - [nstep/s] , stops every stop_n nsteps , relative to current run start time - [nsecond/s] , stops every stop_n nseconds, relative to current run start time - [nminute/s] , stops every stop_n nminutes, relative to current run start time - [nhour/s] , stops every stop_n nhours , relative to current run start time - [nday/s] , stops every stop_n ndays , relative to current run start time - [nmonth/s] , stops every stop_n nmonths , relative to current run start time - [monthly/s] , stops every month , relative to current run start time - [nyear/s] , stops every stop_n nyears , relative to current run start time - [date] , stops at stop_ymd value - [ifdays0] , stops at stop_n calendar day value and seconds equal 0 - [end] , stops at end + [none/never] , turns option off + [nsteps] , stops every stop_n nsteps , relative to current run start time + [nseconds] , stops every stop_n nseconds, relative to current run start time + [nminutes] , stops every stop_n nminutes, relative to current run start time + [nhours] , stops every stop_n nhours , relative to current run start time + [ndays] , stops every stop_n ndays , relative to current run start time + [nmonths] , stops every stop_n nmonths , relative to current run start time + [nyears] , stops every stop_n nyears , relative to current run start time + [monthly] , stops every month , relative to current run start time + [yearly] , stops every year , relative to current run start time + [end] , stops at end + [date] , stops at stop_ymd value $STOP_OPTION @@ -2654,22 +2653,22 @@ char time CLOCK_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,monthly,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end sets the restart frequency with restart_n and restart_ymd restart_option alarms are: [none/never], turns option off - [nstep/s] , restarts every restart_n nsteps , relative to current run start time - [nsecond/s] , restarts every restart_n nseconds, relative to current run start time - [nminute/s] , restarts every restart_n nminutes, relative to current run start time - [nhour/s] , restarts every restart_n nhours , relative to current run start time - [nday/s] , restarts every restart_n ndays , relative to current run start time - [monthly/s] , restarts every month , relative to current run start time - [nmonth/s] , restarts every restart_n nmonths , relative to current run start time - [nyear/s] , restarts every restart_n nyears , relative to current run start time - [date] , restarts at restart_ymd value - [ifdays0] , restarts at restart_n calendar day value and seconds equal 0 - [end] , restarts at end + [nsteps] , restarts every restart_n nsteps , relative to current run start time + [nseconds] , restarts every restart_n nseconds, relative to current run start time + [nminutes] , restarts every restart_n nminutes, relative to current run start time + [nhours] , restarts every restart_n nhours , relative to current run start time + [ndays] , restarts every restart_n ndays , relative to current run start time + [nmonths] , restarts every restart_n nmonths , relative to current run start time + [nyears] , restarts every restart_n nyears , relative to current run start time + [monthly] , restarts every month , relative to current run start time + [yearly] , restarts every year , relative to current run start time + [date] , restarts at restart_ymd value + [end] , restarts at end $REST_OPTION @@ -2721,22 +2720,22 @@ char time CLOCK_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end Sets timing output file frequency (like rest_option but relative to run start date) tprof_option alarms are: [none/never], turns option off - [nstep/s] , every tprof_n nsteps , relative to current run start time - [nsecond/s] , every tprof_n nseconds, relative to current run start time - [nminute/s] , every tprof_n nminutes, relative to current run start time - [nhour/s] , every tprof_n nhours , relative to current run start time - [nday/s] , every tprof_n ndays , relative to current run start time - [monthly/s] , every month , relative to current run start time - [nmonth/s] , every tprof_n nmonths , relative to current run start time - [nyear/s] , every tprof_n nyears , relative to current run start time - [date] , at tprof_ymd value - [ifdays0] , at tprof_n calendar day value and seconds equal 0 - [end] , at end + [nsteps] , every tprof_n nsteps , relative to current run start time + [nseconds] , every tprof_n nseconds, relative to current run start time + [nminutes] , every tprof_n nminutes, relative to current run start time + [nhours] , every tprof_n nhours , relative to current run start time + [ndays] , every tprof_n ndays , relative to current run start time + [nmonths] , every tprof_n nmonths , relative to current run start time + [nyears] , every tprof_n nyears , relative to current run start time + [monthly] , every month , relative to current run start time + [yearly] , every year , relative to current run start time + [date] , at tprof_ymd value + [end] , at end never @@ -2771,19 +2770,19 @@ - + - - - - - - - - + + + + + + + + From 98e814f543425b7abdccd5976259208ce36d277b Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 12 Oct 2022 07:36:19 -0600 Subject: [PATCH 115/395] Revert "first step - reorder pio_init and move to ensemble_driver" --- cesm/driver/ensemble_driver.F90 | 202 +-- cesm/driver/esm.F90 | 66 +- cesm/driver/esm_time_mod.F90 | 278 ++-- cesm/nuopc_cap_share/driver_pio_mod.F90 | 266 +--- cesm/nuopc_cap_share/glc_elevclass_mod.F90 | 24 +- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 36 +- cesm/nuopc_cap_share/seq_drydep_mod.F90 | 1211 +---------------- cesm/nuopc_cap_share/shr_fire_emis_mod.F90 | 2 +- cesm/nuopc_cap_share/shr_megan_mod.F90 | 2 +- .../shr_ozone_coupling_mod.F90 | 2 +- cime_config/config_component.xml | 24 - cime_config/namelist_definition_drv.xml | 39 +- mediator/esmFlds.F90 | 22 +- mediator/esmFldsExchange_cesm_mod.F90 | 2 +- mediator/esmFldsExchange_hafs_mod.F90 | 10 +- mediator/esmFldsExchange_nems_mod.F90 | 2 +- mediator/med.F90 | 32 +- mediator/med_diag_mod.F90 | 2 +- mediator/med_fraction_mod.F90 | 4 +- mediator/med_internalstate_mod.F90 | 4 +- mediator/med_map_mod.F90 | 20 +- mediator/med_merge_mod.F90 | 10 +- mediator/med_methods_mod.F90 | 58 +- mediator/med_phases_aofluxes_mod.F90 | 11 +- mediator/med_phases_history_mod.F90 | 18 +- mediator/med_phases_ocnalb_mod.F90 | 6 +- mediator/med_phases_post_atm_mod.F90 | 2 +- mediator/med_phases_post_glc_mod.F90 | 6 +- mediator/med_phases_post_ice_mod.F90 | 2 +- mediator/med_phases_post_lnd_mod.F90 | 2 +- mediator/med_phases_post_ocn_mod.F90 | 2 +- mediator/med_phases_post_rof_mod.F90 | 2 +- mediator/med_phases_post_wav_mod.F90 | 2 +- mediator/med_phases_prep_atm_mod.F90 | 2 +- mediator/med_phases_prep_glc_mod.F90 | 12 +- mediator/med_phases_prep_ice_mod.F90 | 2 +- mediator/med_phases_prep_lnd_mod.F90 | 2 +- mediator/med_phases_prep_ocn_mod.F90 | 10 +- mediator/med_phases_prep_rof_mod.F90 | 8 +- mediator/med_phases_prep_wav_mod.F90 | 6 +- mediator/med_phases_profile_mod.F90 | 2 +- mediator/med_phases_restart_mod.F90 | 6 +- mediator/med_time_mod.F90 | 2 +- 43 files changed, 393 insertions(+), 2030 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 5118093da..1c5d3ca67 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -17,11 +17,7 @@ module Ensemble_driver public :: SetServices private :: SetModelServices - private :: ensemble_finalize - integer, allocatable :: asyncio_petlist(:) - logical :: asyncio_task=.false. - logical :: asyncIO_available=.false. character(*),parameter :: u_FILE_u = & __FILE__ @@ -31,12 +27,9 @@ module Ensemble_driver subroutine SetServices(ensemble_driver, rc) - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSpecialize, NUOPC_CompAttributeSet - use NUOPC , only : NUOPC_CompAttributeGet + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSpecialize use NUOPC_Driver , only : driver_routine_SS => SetServices use NUOPC_Driver , only : ensemble_label_SetModelServices => label_SetModelServices - use NUOPC_Driver , only : ensemble_label_ModifyCplLists => label_ModifyCplLists - use NUOPC_Driver, only : label_Finalize use ESMF , only : ESMF_GridComp, ESMF_GridCompSet use ESMF , only : ESMF_Config, ESMF_ConfigCreate, ESMF_ConfigLoadFile use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO @@ -46,8 +39,7 @@ subroutine SetServices(ensemble_driver, rc) ! local variables type(ESMF_Config) :: config - logical :: isPresent ! Check to see if InitializeDataResolution attribute is available - character(len=*), parameter :: subname = '('//__FILE__//':SetServices)' + character(len=*), parameter :: subname = "(ensemble_driver.F90:SetServices)" !--------------------------------------- rc = ESMF_SUCCESS @@ -62,14 +54,6 @@ subroutine SetServices(ensemble_driver, rc) specRoutine=SetModelServices, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! ModifyCplLists is a NUOPC specialization which happens after Advertize but before Realize - ! We have overloaded this specialization location to initilize IO. - ! So after all components have called Advertise but before any component calls Realize - ! IO will be initialized and any async IO tasks will be split off to the PIO async IO driver. - call NUOPC_CompSpecialize(ensemble_driver, specLabel=ensemble_label_ModifyCplLists, & - specRoutine=InitializeIO, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Create, open and set the config config = ESMF_ConfigCreate(rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -80,25 +64,6 @@ subroutine SetServices(ensemble_driver, rc) call ESMF_GridCompSet(ensemble_driver, config=config, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! NUOPC component drivers end the initialization process with an internal call to InitializeDataResolution. - ! The ensemble_driver does not need to InitializeDataResolution and doing so will cause a hang - ! if asyncronous IO is used. This attribute is available after ESMF8.4.0b03 to toggle that control. - ! Cannot use asyncIO with older ESMF versions. - call NUOPC_CompAttributeGet(ensemble_driver, name="InitializeDataResolution", & - isPresent=isPresent, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if(isPresent) then - call NUOPC_CompAttributeSet(ensemble_driver, name="InitializeDataResolution", value="false", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - asyncIO_available = .true. - endif - ! Set a finalize method, it calls pio_finalize - call NUOPC_CompSpecialize(ensemble_driver, specLabel=label_Finalize, & - specRoutine=ensemble_finalize, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine SetServices @@ -125,27 +90,22 @@ subroutine SetModelServices(ensemble_driver, rc) ! local variables type(ESMF_VM) :: vm - type(ESMF_GridComp) :: driver + type(ESMF_GridComp) :: driver, gridcomptmp type(ESMF_Config) :: config integer :: n, n1, stat integer, pointer :: petList(:) character(len=20) :: model, prefix - integer :: petCount, i, k + integer :: petCount, i integer :: localPet logical :: is_set character(len=512) :: diro character(len=512) :: logfile integer :: global_comm logical :: read_restart - logical :: comp_task character(len=CS) :: read_restart_string integer :: inst - integer :: currentpet, petcnt, iopetcnt integer :: number_of_members integer :: ntasks_per_member - integer :: pio_asyncio_ntasks - integer :: pio_asyncio_stride - integer :: pio_asyncio_rootpe character(CL) :: start_type ! Type of startup character(len=7) :: drvrinst character(len=5) :: inst_suffix @@ -155,7 +115,7 @@ subroutine SetModelServices(ensemble_driver, rc) character(len=*) , parameter :: start_type_start = "startup" character(len=*) , parameter :: start_type_cont = "continue" character(len=*) , parameter :: start_type_brnch = "branch" - character(len=*), parameter :: subname = '('//__FILE__//':SetModelServices)' + character(len=*) , parameter :: subname = "(ensemble_driver.F90:SetModelServices)" !------------------------------------------- rc = ESMF_SUCCESS @@ -208,8 +168,6 @@ subroutine SetModelServices(ensemble_driver, rc) write(read_restart_string,*) read_restart ! Add read_restart to ensemble_driver attributes - - call ESMF_LogWrite(trim(subname)//": set read_restart "//trim(read_restart_string), ESMF_LOGMSG_INFO) call NUOPC_CompAttributeAdd(ensemble_driver, attrList=(/'read_restart'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeSet(ensemble_driver, name='read_restart', value=trim(read_restart_string), rc=rc) @@ -229,93 +187,40 @@ subroutine SetModelServices(ensemble_driver, rc) call NUOPC_CompAttributeGet(ensemble_driver, name="ninst", value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) number_of_members - - call NUOPC_CompAttributeGet(ensemble_driver, name="pio_asyncio_ntasks", value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) pio_asyncio_ntasks - - call NUOPC_CompAttributeGet(ensemble_driver, name="pio_asyncio_stride", value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) pio_asyncio_stride - - call NUOPC_CompAttributeGet(ensemble_driver, name="pio_asyncio_rootpe", value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) pio_asyncio_rootpe call ESMF_VMGet(vm, localPet=localPet, PetCount=PetCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - ntasks_per_member = PetCount/number_of_members - pio_asyncio_ntasks - if(ntasks_per_member*number_of_members .ne. (PetCount - pio_asyncio_ntasks)) then + ntasks_per_member = PetCount/number_of_members + if(ntasks_per_member*number_of_members .ne. PetCount) then write (msgstr,'(a,i5,a,i3,a,i3,a)') & - "PetCount - Async IOtasks (",PetCount-pio_asyncio_ntasks,") must be evenly divisable by number of members (",number_of_members,")" + "PetCount (",PetCount,") must be evenly divisable by number of members (",number_of_members,")" call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return endif - if(pio_asyncio_ntasks > 0 .and. .not. asyncIO_available) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg="AsyncIO requires ESMF version 8.4.0b03 or newer", line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - !------------------------------------------- ! Loop over number of ensemblel members !------------------------------------------- allocate(petList(ntasks_per_member)) - ! Create an asyncio petlist (a list of Pets who will be dedicated to IO). All components - ! with async IO enabled will use these IO PETS. If stride = MPI_TASKS_PER_NODE then there will - ! be one IO task per node. - allocate(asyncio_petlist(pio_asyncio_ntasks)) - iopetcnt = 1 - currentPet = 0 - - do n=1,pio_asyncio_ntasks - asyncio_petlist(n) = pio_asyncio_rootpe + (n-1)*pio_asyncio_stride - if (localPet == asyncio_petlist(n)) asyncio_task = .true. - enddo - k = 1 do inst=1,number_of_members - petcnt=1 - comp_task = .false. + ! Determine pet list for driver instance - do n=1,ntasks_per_member+pio_asyncio_ntasks - if(pio_asyncio_stride == 0) then - petList(petcnt) = currentpet - petcnt = petcnt+1 - if (currentpet == localPet) comp_task=.true. - else if(pio_asyncio_stride == 1) then - if (currentpet < asyncio_petlist(1) .or. currentpet > asyncio_petlist(pio_asyncio_ntasks)) then - petList(petcnt) = currentpet - petcnt = petcnt+1 - if (currentpet == localPet) comp_task=.true. - endif - else if (currentpet .ne. asyncio_petlist(k)) then - petList(petcnt) = currentpet - petcnt = petcnt+1 - if (currentpet == localPet) comp_task=.true. - else if (currentpet == asyncio_petlist(k)) then - k = modulo(k,pio_asyncio_ntasks) + 1 - endif - currentpet = currentpet + 1 + petList(1) = (inst-1) * ntasks_per_member + do n=2,ntasks_per_member + petList(n) = petList(n-1) + 1 enddo - if(asyncio_task .and. comp_task) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg="task is set as both a compute task and an asyncio task", line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif ! Add driver instance to ensemble driver write(drvrinst,'(a,i4.4)') "ESM",inst - call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=driver, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) then - write(msgstr,*) 'size(petList):', size(petList), ' petcnt:', petcnt, ' petList: ',petList - call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - mastertask = .false. - if (comp_task) then + call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=gridcomptmp, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (localpet >= petlist(1) .and. localpet <= petlist(ntasks_per_member)) then + + driver = gridcomptmp if(number_of_members > 1) then call NUOPC_CompAttributeAdd(driver, attrList=(/'inst_suffix'/), rc=rc) @@ -343,7 +248,7 @@ subroutine SetModelServices(ensemble_driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Set the driver log to the driver task 0 - if (petList(1) == localPet) then + if (mod(localPet, ntasks_per_member) == 0) then call NUOPC_CompAttributeGet(driver, name="diro", value=diro, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(driver, name="logfile", value=logfile, rc=rc) @@ -352,76 +257,21 @@ subroutine SetModelServices(ensemble_driver, rc) mastertask = .true. else logUnit = shrlogunit + mastertask = .false. endif call shr_file_setLogUnit (logunit) - endif - ! Create a clock for each driver instance - call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - enddo - deallocate(petList) - - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - - end subroutine SetModelServices - - subroutine InitializeIO(ensemble_driver, rc) - use ESMF, only: ESMF_GridComp, ESMF_LOGMSG_INFO, ESMF_LogWrite - use ESMF, only: ESMF_SUCCESS, ESMF_VM, ESMF_GridCompGet, ESMF_VMGet - use ESMF, only: ESMF_CONFIG, ESMF_GridCompIsPetLocal, ESMF_State, ESMF_Clock - use NUOPC, only: NUOPC_CompAttributeGet, NUOPC_CompGet - use NUOPC_DRIVER, only: NUOPC_DriverGetComp - use driver_pio_mod , only: driver_pio_init, driver_pio_component_init - - type(ESMF_GridComp) :: ensemble_driver - type(ESMF_VM) :: ensemble_vm - integer, intent(out) :: rc - character(len=*), parameter :: subname = '('//__FILE__//':InitializeIO)' - type(ESMF_GridComp), pointer :: dcomp(:), ccomp(:) - integer :: iam - integer :: Global_Comm - integer :: drv, comp - character(len=8) :: compname - - rc = ESMF_SUCCESS - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - - call ESMF_GridCompGet(ensemble_driver, vm=ensemble_vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(ensemble_vm, localpet=iam, mpiCommunicator=Global_Comm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - nullify(dcomp) - call NUOPC_DriverGetComp(ensemble_driver, complist=dcomp, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - do drv=1,size(dcomp) - if (ESMF_GridCompIsPetLocal(dcomp(drv), rc=rc) .or. asyncio_task) then - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompGet(dcomp(drv), name=compname, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": call shr_pio_init "//compname, ESMF_LOGMSG_INFO) - call driver_pio_init(dcomp(drv), rc=rc) + ! Create a clock for each driver instance + call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": call shr_pio_component_init "//compname, ESMF_LOGMSG_INFO) - call driver_pio_component_init(dcomp(drv), Global_Comm, asyncio_petlist, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": shr_pio_component_init done "//compname, ESMF_LOGMSG_INFO) endif enddo - deallocate(asyncio_petlist) + + deallocate(petList) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - end subroutine InitializeIO - subroutine ensemble_finalize(ensemble_driver, rc) - use ESMF, only : ESMF_GridComp, ESMF_SUCCESS - use shr_pio_mod, only: shr_pio_finalize - type(ESMF_GridComp) :: Ensemble_driver - integer, intent(out) :: rc - rc = ESMF_SUCCESS - call shr_pio_finalize() + end subroutine SetModelServices - end subroutine ensemble_finalize end module Ensemble_driver diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index d4d89c217..b6f39ad52 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -55,7 +55,7 @@ subroutine SetServices(driver, rc) ! local variables type(ESMF_Config) :: runSeq - character(len=*), parameter :: subname = '('//__FILE__//':SetServices)' + character(len=*), parameter :: subname = "(esm.F90:SetServices)" !--------------------------------------- rc = ESMF_SUCCESS @@ -133,7 +133,7 @@ subroutine SetModelServices(driver, rc) integer :: maxthreads character(len=CL) :: msgstr integer :: componentcount - character(len=*), parameter :: subname = '('//__FILE__//':SetModelServices)' + character(len=*), parameter :: subname = "(esm.F90:SetModelServices)" !------------------------------------------- rc = ESMF_SUCCESS @@ -246,7 +246,7 @@ subroutine SetRunSequence(driver, rc) integer :: localrc type(ESMF_Config) :: runSeq type(NUOPC_FreeFormat) :: runSeqFF - character(len=*), parameter :: subname = '('//__FILE__//':SetRunSequence)' + character(len=*), parameter :: subname = "(esm.F90:SetRunSequence)" !--------------------------------------- rc = ESMF_SUCCESS @@ -344,7 +344,7 @@ recursive subroutine ModifyCplLists(driver, importState, exportState, clock, rc) character(len=CL), allocatable :: cplList(:) character(len=CL) :: tempString character(len=CL) :: msgstr - character(len=*), parameter :: subname = '('//__FILE__//':pretty_print_nuopc_freeformat)' + character(len=*), parameter :: subname = "(esm.F90:ModifyCplLists)" !--------------------------------------- rc = ESMF_SUCCESS @@ -443,7 +443,7 @@ subroutine InitAttributes(driver, rc) integer , parameter :: ens1=1 ! use first instance of ensemble only integer , parameter :: fix1=1 ! temporary hard-coding to first ensemble, needs to be fixed real(R8) , parameter :: epsilo = shr_const_mwwv/shr_const_mwdair - character(len=*), parameter :: subname = '('//__FILE__//':InitAttributes)' + character(len=*) , parameter :: subname = '(InitAttributes)' !---------------------------------------------------------- rc = ESMF_SUCCESS @@ -575,7 +575,7 @@ subroutine CheckAttributes( driver, rc ) character(len=CS) :: logFilePostFix ! postfix for output log files character(len=CL) :: outPathRoot ! root for output log files character(len=CS) :: cime_model - character(len=*), parameter :: subname = '('//__FILE__//':CheckAttributes)' + character(len=*), parameter :: subname = '(driver_attributes_check) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -635,7 +635,7 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n character(len=CL) :: cvalue character(len=CS) :: attribute integer :: componentCount - character(len=*), parameter :: subname = '('//__FILE__//':AddAttributes)' + character(len=*), parameter :: subname = "(esm.F90:AddAttributes)" !------------------------------------------- rc = ESMF_Success @@ -737,7 +737,7 @@ subroutine ReadAttributes(gcomp, config, label, relaxedflag, formatprint, rc) ! local variables type(NUOPC_FreeFormat) :: attrFF - character(len=*), parameter :: subname = '('//__FILE__//':ReadAttributes)' + character(len=*), parameter :: subname = "(esm.F90:ReadAttributes)" !------------------------------------------- rc = ESMF_SUCCESS @@ -784,7 +784,7 @@ subroutine InitAdvertize(driver, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables - character(len=*), parameter :: subname = '('//__FILE__//':InitAdvertize)' + character(len=*), parameter :: subname = "(esm.F90:InitAdvertize)" !--------------------------------------- rc = ESMF_SUCCESS @@ -801,8 +801,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) use ESMF , only : ESMF_ConfigGetLen, ESMF_LogFoundAllocError, ESMF_ConfigGetAttribute use ESMF , only : ESMF_RC_NOT_VALID, ESMF_LogSetError, ESMF_Info, ESMF_InfoSet use ESMF , only : ESMF_GridCompIsPetLocal, ESMF_MethodAdd, ESMF_UtilStringLowerCase - use ESMF , only : ESMF_InfoCreate, ESMF_InfoDestroy, ESMF_VMGetGlobal - use ESMF , only : ESMF_VMAllGather + use ESMF , only : ESMF_InfoCreate, ESMF_InfoDestroy use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Driver , only : NUOPC_DriverAddComp #ifndef NO_MPI2 @@ -871,14 +870,11 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) ! local variables type(ESMF_GridComp) :: child type(ESMF_VM) :: vm - type(ESMF_VM) :: globalvm type(ESMF_Config) :: config type(ESMF_Info) :: info integer :: componentcount integer :: PetCount integer :: LocalPet - integer :: PetIDinGlobal(1) - integer, allocatable :: PetMapinGlobal(:) integer :: ntasks, rootpe, nthrds, stride integer :: ntask, cnt integer :: i @@ -888,7 +884,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) character(CL) :: msgstr integer, allocatable :: petlist(:) integer, pointer :: comms(:), comps(:) - integer :: Driver_comm + integer :: Global_Comm logical :: isPresent integer, allocatable :: comp_comm_iam(:) logical, allocatable :: comp_iamin(:) @@ -896,8 +892,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) character(CL) :: cvalue logical :: found_comp integer :: rank, nprocs, ierr - integer :: n ! loop variable - character(len=*), parameter :: subname = '('//__FILE__//':esm_init_pelayout)' + character(len=*), parameter :: subname = "(esm_pelayout.F90:esm_init_pelayout)" !--------------------------------------- rc = ESMF_SUCCESS @@ -906,21 +901,10 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) call ESMF_GridCompGet(driver, vm=vm, config=config, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGetGlobal(vm=globalvm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ReadAttributes(driver, config, "PELAYOUT_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, petCount=petCount, LocalPet=LocalPet, mpiCommunicator=Driver_comm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(globalvm, LocalPet=PetIDinGlobal(1), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - allocate(PetMapinGlobal(petCount)) - call ESMF_VMAllGather(vm, PetIDinGlobal, PetMapinGlobal, 1, rc=rc) + call ESMF_VMGet(vm, petCount=petCount, mpiCommunicator=Global_Comm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return componentCount = ESMF_ConfigGetLen(config,label="component_list:", rc=rc) @@ -956,8 +940,8 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) allocate(comms(componentCount+1), comps(componentCount+1)) comps(1) = 1 comms = MPI_COMM_NULL - comms(1) = Driver_comm - ! First find the maximum number of threads across all components + comms(1) = Global_Comm + maxthreads = 1 do i=1,componentCount namestr = ESMF_UtilStringLowerCase(compLabels(i)) @@ -968,7 +952,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) if(nthrds > maxthreads) maxthreads = nthrds enddo - ! Now loop over components and add each to driver + do i=1,componentCount namestr = ESMF_UtilStringLowerCase(compLabels(i)) if (namestr == 'med') namestr = 'cpl' @@ -995,22 +979,11 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_rootpe', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) rootpe - - ! rootpe is specified in context of the ensemble_driver which may include asyncio tasks - ! so we need to adjust. - do n=1,PetCount - if(rootpe == PetMapinGlobal(n)) then - rootpe = n - 1 - exit - endif - enddo - if (rootpe < 0 .or. rootpe > PetCount) then write (msgstr, *) "Invalid Rootpe value specified for component: ",namestr, ' rootpe: ',rootpe call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return endif - if(rootpe+ntasks > PetCount) then write (msgstr, *) "Invalid pelayout value specified for component: ",namestr, ' rootpe+ntasks: ',rootpe+ntasks call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) @@ -1020,7 +993,6 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_pestride', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stride - if (stride < 1 .or. rootpe+(ntasks-1)*stride > PetCount) then write (msgstr, *) "Invalid pestride value specified for component: ",namestr,& ' rootpe: ',rootpe, ' pestride: ', stride, ' ntasks: ',ntasks, ' PetCount: ', PetCount @@ -1214,10 +1186,10 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Initialize MCT (this is needed for data models and cice prescribed capability) - call mct_world_init(componentCount+1, DRIVER_COMM, comms, comps) + call mct_world_init(componentCount+1, GLOBAL_COMM, comms, comps) - deallocate(petlist, comms, comps, comp_iamin, comp_comm_iam, PetMapinGlobal) + deallocate(petlist, comms, comps, comp_iamin, comp_comm_iam) end subroutine esm_init_pelayout @@ -1280,7 +1252,7 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) integer :: iscol_data(1) integer :: petcount character(len=CL) :: cvalue - character(len=*), parameter :: subname = '('//__FILE__//':esm_set_single_column_attributes)' + character(len=*), parameter :: subname= ' (esm_get_single_column_attributes) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index 9a321ad30..7afcbc992 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -10,8 +10,8 @@ module esm_time_mod use ESMF , only : ESMF_Time, ESMF_TimeGet, ESMF_TimeSet use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_LOGMSG_ERROR - use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast, ESMF_VMAllReduce - use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_GridCompIsPetLocal, ESMF_REDUCE_MAX + use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE use ESMF , only : operator(<), operator(/=), operator(+) use ESMF , only : operator(-), operator(*) , operator(>=) use ESMF , only : operator(<=), operator(>), operator(==) @@ -53,7 +53,7 @@ module esm_time_mod !=============================================================================== subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastertask, rc) - + ! input/output variables type(ESMF_GridComp) :: ensemble_driver, instance_driver integer, intent(in) :: logunit @@ -62,8 +62,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert ! local variables type(ESMF_Clock) :: clock - type(ESMF_VM) :: vm ! VM of the driver - type(ESMF_VM) :: envm ! VM of the ensemble_driver (which includes asyncIO tasks) + type(ESMF_VM) :: vm type(ESMF_Time) :: StartTime ! Start time type(ESMF_Time) :: RefTime ! Reference time type(ESMF_Time) :: CurrTime ! Current time @@ -102,169 +101,100 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert character(CL) :: tmpstr ! temporary character(CS) :: inst_suffix integer :: tmp(4) ! Array for Broadcast - integer :: myid, bcastID(2) logical :: isPresent - logical :: firsttime = .true. - logical :: is_driver_pet - character(len=*), parameter :: subname = '('//__FILE__//':esm_time_clockInit) ' + character(len=*), parameter :: subname = '(esm_time_clockInit): ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + + call ESMF_GridCompGet(instance_driver, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------------------------------------------- ! Determine start time, reference time and current time !--------------------------------------------------------------------------- - call NUOPC_CompAttributeGet(ensemble_driver, name="start_ymd", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="start_ymd", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) start_ymd - - call NUOPC_CompAttributeGet(ensemble_driver, name="start_tod", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="start_tod", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) start_tod - !--------------------------------------------------------------------------- - ! Determine driver clock timestep - !--------------------------------------------------------------------------- - - call NUOPC_CompAttributeGet(ensemble_driver, name="atm_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) atm_cpl_dt - - call NUOPC_CompAttributeGet(ensemble_driver, name="lnd_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) lnd_cpl_dt - - call NUOPC_CompAttributeGet(ensemble_driver, name="ice_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ice_cpl_dt - - call NUOPC_CompAttributeGet(ensemble_driver, name="ocn_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ocn_cpl_dt - - call NUOPC_CompAttributeGet(ensemble_driver, name="glc_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_cpl_dt - - call NUOPC_CompAttributeGet(ensemble_driver, name="rof_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) rof_cpl_dt - - call NUOPC_CompAttributeGet(ensemble_driver, name="wav_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) wav_cpl_dt - - call NUOPC_CompAttributeGet(ensemble_driver, name="glc_avg_period", value=glc_avg_period, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name='read_restart', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_avg_period - - dtime_drv = minval((/atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt/)) - if(mastertask) then - write(tmpstr,'(i10)') dtime_drv - call ESMF_LogWrite(trim(subname)//': driver time interval is : '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - write(logunit,*) trim(subname)//': driver time interval is : '// trim(tmpstr) - endif + read(cvalue,*) read_restart - call ESMF_GridCompGet(ensemble_driver, vm=envm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(envm, localPet=myid, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - is_driver_pet = ESMF_GridCompIsPetLocal(instance_driver, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (read_restart) then - if(is_driver_pet) then - call ESMF_GridCompGet(instance_driver, vm=vm, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name='drv_restart_pointer', value=restart_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! read_restart is set in ensemble_driver SetModelServices - call NUOPC_CompAttributeGet(ensemble_driver, name='read_restart', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) read_restart + if (trim(restart_file) /= 'none') then - if (read_restart) then - - call NUOPC_CompAttributeGet(instance_driver, name='drv_restart_pointer', value=restart_file, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (trim(restart_file) /= 'none') then - ! inst_suffix is set by ensemble_driver if the number of members is > 1 - call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", isPresent=isPresent, rc=rc) + if(isPresent) then + call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", value=inst_suffix, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(isPresent) then - call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", value=inst_suffix, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - inst_suffix = "" - endif - - restart_pfile = trim(restart_file)//inst_suffix - - if (mastertask) then - call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & - ESMF_LOGMSG_INFO) - open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) - if (ierr < 0) then - rc = ESMF_FAILURE - call ESMF_LogWrite(trim(subname)//' ERROR rpointer file open returns error', & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) - return - end if - read(unitn,'(a)', iostat=ierr) restart_file - if (ierr < 0) then - rc = ESMF_FAILURE - call ESMF_LogWrite(trim(subname)//' ERROR rpointer file read returns error', & - ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) - return - end if - close(unitn) - if (mastertask) then - write(logunit,'(a)') trim(subname)//" reading driver restart from file = "//trim(restart_file) - end if - call esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - endif - else - + inst_suffix = "" + endif + + restart_pfile = trim(restart_file)//inst_suffix + + if (mastertask) then + call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & + ESMF_LOGMSG_INFO) + open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) + if (ierr < 0) then + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//' ERROR rpointer file open returns error', & + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) + return + end if + read(unitn,'(a)', iostat=ierr) restart_file + if (ierr < 0) then + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//' ERROR rpointer file read returns error', & + ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) + return + end if + close(unitn) if (mastertask) then - write(logunit,*) ' NOTE: the current compset has no mediator - which provides the clock restart information' - write(logunit,*) ' In this case the restarts are handled solely by the component being used and' - write(logunit,*) ' and the driver clock will always be starting from the initial date on restart' + write(logunit,'(a)') trim(subname)//" reading driver restart from file = "//trim(restart_file) end if - curr_ymd = start_ymd - curr_tod = start_tod - - end if + call esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + tmp(1) = start_ymd ; tmp(2) = start_tod + tmp(3) = curr_ymd ; tmp(4) = curr_tod + endif + + call ESMF_VMBroadcast(vm, tmp, 4, 0, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + start_ymd = tmp(1) ; start_tod = tmp(2) + curr_ymd = tmp(3) ; curr_tod = tmp(4) else + if (mastertask) then + write(logunit,*) ' NOTE: the current compset has no mediator - which provides the clock restart information' + write(logunit,*) ' In this case the restarts are handled solely by the component being used and' + write(logunit,*) ' and the driver clock will always be starting from the initial date on restart' + end if curr_ymd = start_ymd curr_tod = start_tod - end if ! end if read_restart - endif - + end if - if(mastertask) then - bcastID(1) = myid - tmp(1) = start_ymd ; tmp(2) = start_tod - tmp(3) = curr_ymd ; tmp(4) = curr_tod else - bcastID(1) = 0 - tmp = 0 - endif - call ESMF_VMAllReduce(envm, bcastID(1:1), bcastID(2:2), 1, ESMF_REDUCE_MAX,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMBroadcast(envm, tmp, 4, bcastID(2), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - start_ymd = tmp(1) ; start_tod = tmp(2) - curr_ymd = tmp(3) ; curr_tod = tmp(4) - + curr_ymd = start_ymd + curr_tod = start_tod + + end if ! end if read_restart + ! Determine start time (THE FOLLOWING ASSUMES THAT THE DEFAULT CALENDAR IS SET in the driver) call esm_time_date2ymd(start_ymd, yr, mon, day) @@ -301,6 +231,48 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert call ESMF_TimeSet( RefTime, yy=yr, mm=mon, dd=day, s=ref_tod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !--------------------------------------------------------------------------- + ! Determine driver clock timestep + !--------------------------------------------------------------------------- + + call NUOPC_CompAttributeGet(instance_driver, name="atm_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) atm_cpl_dt + + call NUOPC_CompAttributeGet(instance_driver, name="lnd_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) lnd_cpl_dt + + call NUOPC_CompAttributeGet(instance_driver, name="ice_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ice_cpl_dt + + call NUOPC_CompAttributeGet(instance_driver, name="ocn_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ocn_cpl_dt + + call NUOPC_CompAttributeGet(instance_driver, name="glc_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) glc_cpl_dt + + call NUOPC_CompAttributeGet(instance_driver, name="rof_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) rof_cpl_dt + + call NUOPC_CompAttributeGet(instance_driver, name="wav_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) wav_cpl_dt + + call NUOPC_CompAttributeGet(instance_driver, name="glc_avg_period", value=glc_avg_period, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) glc_avg_period + + dtime_drv = minval((/atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt/)) + if(mastertask) then + write(tmpstr,'(i10)') dtime_drv + call ESMF_LogWrite(trim(subname)//': driver time interval is : '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + write(logunit,*) trim(subname)//': driver time interval is : '// trim(tmpstr) + endif call ESMF_TimeIntervalSet( TimeStep, s=dtime_drv, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -322,22 +294,20 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert if (ChkErr(rc,__LINE__,u_FILE_u)) return end do - ! Set the driver gridded component clock to the created clock - if (is_driver_pet) then - call ESMF_GridCompSet(instance_driver, clock=clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif + ! Set the ensemble driver gridded component clock to the created clock + call ESMF_GridCompSet(instance_driver, clock=clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Set driver clock stop time - call NUOPC_CompAttributeGet(ensemble_driver, name="stop_option", value=stop_option, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="stop_option", value=stop_option, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(ensemble_driver, name="stop_n", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="stop_n", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_n - call NUOPC_CompAttributeGet(ensemble_driver, name="stop_ymd", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="stop_ymd", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_ymd - call NUOPC_CompAttributeGet(ensemble_driver, name="stop_tod", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="stop_tod", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_tod if ( stop_ymd < 0) then @@ -345,7 +315,6 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert stop_tod = 0 endif - if (mastertask) then write(tmpstr,'(i10)') stop_ymd call ESMF_LogWrite(trim(subname)//': driver stop_ymd: '// trim(tmpstr), ESMF_LOGMSG_INFO) @@ -373,20 +342,17 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert !--------------------------------------------------------------------------- ! Create the ensemble driver clock + ! TODO: this is done repeatedly - but only needs to be done the first time this is called !--------------------------------------------------------------------------- - if(firsttime) then - ! TimeStep for the ensemble_driver and any asyncIO tasks is the full length of - ! the model run. - TimeStep = StopTime - ClockTime - clock = ESMF_ClockCreate(TimeStep, ClockTime, StopTime=StopTime, & - refTime=RefTime, name='ESMF ensemble Driver Clock', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridCompSet(ensemble_driver, clock=clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - firsttime = .false. - endif - + TimeStep = StopTime - ClockTime + clock = ESMF_ClockCreate(TimeStep, ClockTime, StopTime=StopTime, & + refTime=RefTime, name='ESMF ensemble Driver Clock', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_GridCompSet(ensemble_driver, clock=clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine esm_time_clockInit !=============================================================================== diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index 5b9edd426..0e743d669 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -169,112 +169,51 @@ subroutine driver_pio_init(driver, rc) end subroutine driver_pio_init - subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) + subroutine driver_pio_component_init(driver, ncomps, rc) use ESMF, only : ESMF_GridComp, ESMF_LogSetError, ESMF_RC_NOT_VALID, ESMF_GridCompIsCreated, ESMF_VM, ESMF_VMGet - use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated, ESMF_Finalize, ESMF_PtrInt1D - use ESMF, only : ESMF_LOGMSG_INFO, ESMF_LOGWRITE + use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated use NUOPC, only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use NUOPC_Driver, only : NUOPC_DriverGetComp - use mpi, only : MPI_INTEGER, MPI_MAX, MPI_IN_PLACE, MPI_LOR, MPI_LOGICAL type(ESMF_GridComp) :: driver - integer, intent(in) :: Global_COMM ! The communicator associated with the ensemble_driver - integer, intent(in) :: asyncio_petlist(:) + type(ESMF_VM) :: vm + integer, intent(in) :: ncomps integer, intent(out) :: rc - type(ESMF_VM) :: vm integer :: i, npets, default_stride - integer :: j, myid - integer :: k + integer :: j integer :: comp_comm, comp_rank - integer, allocatable :: procs_per_comp(:), async_procs_per_comp(:) - integer, allocatable :: io_proc_list(:), asyncio_tasks(:), comp_proc_list(:,:) - type(ESMF_GridComp), pointer :: gcomp(:) character(CS) :: cval character(CS) :: msgstr integer :: do_async_init - integer :: totalpes - integer :: asyncio_ntasks - integer :: asyncio_stride - integer :: pecnt - integer :: ierr - integer :: iocomm - integer :: ncomps - integer :: async_rearr - integer :: driverpecount, driver_myid - integer, allocatable :: driverpetlist(:) - integer, allocatable :: asyncio_comp_comm(:) - logical :: asyncio_task - logical, allocatable :: petlocal(:) type(iosystem_desc_t), allocatable :: async_iosystems(:) - character(len=*), parameter :: subname = '('//__FILE__//':shr_pio_component_init)' - asyncio_ntasks = size(asyncio_petlist) + allocate(pio_comp_settings(ncomps)) + allocate(gcomp(ncomps)) - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(io_compid(ncomps)) + allocate(io_compname(ncomps)) + allocate(iosystems(ncomps)) - call MPI_Comm_rank(global_comm, myid, rc) - call MPI_Comm_size(global_comm, totalpes, rc) - asyncio_task=.false. - do i=1,asyncio_ntasks - if(myid == asyncio_petlist(i)) then - asyncio_task = .true. - exit - endif - enddo - nullify(gcomp) + allocate(pio_async_interface(ncomps)) - if (asyncio_task) then - driverpecount = 0 - else - call ESMF_GridCompGet(gridcomp=driver, vm=vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_DriverGetComp(driver, compList=gcomp, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=driver_myid, petcount=driverpecount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif + nullify(gcomp) + do_async_init = 0 - if(associated(gcomp)) then - total_comps = size(gcomp) - else - total_comps = 0 - endif - - call ESMF_LogWrite(trim(subname)//": share total_comps and driverpecount", ESMF_LOGMSG_INFO) + call NUOPC_DriverGetComp(driver, compList=gcomp, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call MPI_AllReduce(MPI_IN_PLACE, total_comps, 1, MPI_INTEGER, & - MPI_MAX, Global_comm, rc) - call MPI_AllReduce(MPI_IN_PLACE, driverpecount, 1, MPI_INTEGER, & - MPI_MAX, Global_comm, rc) + total_comps = size(gcomp) - allocate(pio_comp_settings(total_comps)) - allocate(procs_per_comp(total_comps)) - allocate(io_compid(total_comps)) - allocate(io_compname(total_comps)) - allocate(iosystems(total_comps)) - allocate(petlocal(total_comps)) - do_async_init = 0 - procs_per_comp = 0 - do i=1,total_comps - if(associated(gcomp)) then - petlocal(i) = ESMF_GridCompIsPetLocal(gcomp(i), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - petlocal(i) = .false. - endif - pio_comp_settings(i)%pio_async_interface = .false. io_compid(i) = i+1 - if (petlocal(i)) then + + if (ESMF_GridCompIsPetLocal(gcomp(i), rc=rc)) then call ESMF_GridCompGet(gcomp(i), vm=vm, name=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": initialize component: "//trim(cval), ESMF_LOGMSG_INFO) io_compname(i) = trim(cval) + call NUOPC_CompAttributeAdd(gcomp(i), attrList=(/'MCTID'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -286,41 +225,35 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) ssiLocalPetCount=default_stride, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - procs_per_comp(i) = npets - - call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) + call NUOPC_CompAttributeGet(gcomp(i), name="pio_stride", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_comp_settings(i)%pio_async_interface = (trim(cval) == '.true.') - if(.not. pio_comp_settings(i)%pio_async_interface) then - call NUOPC_CompAttributeGet(gcomp(i), name="pio_stride", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_stride - if(pio_comp_settings(i)%pio_stride <= 0 .or. pio_comp_settings(i)%pio_stride > npets) then - pio_comp_settings(i)%pio_stride = min(npets, default_stride) - endif + read(cval, *) pio_comp_settings(i)%pio_stride + if(pio_comp_settings(i)%pio_stride <= 0 .or. pio_comp_settings(i)%pio_stride > npets) then + pio_comp_settings(i)%pio_stride = min(npets, default_stride) + endif - call NUOPC_CompAttributeGet(gcomp(i), name="pio_rearranger", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_rearranger - - call NUOPC_CompAttributeGet(gcomp(i), name="pio_numiotasks", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_numiotasks + call NUOPC_CompAttributeGet(gcomp(i), name="pio_rearranger", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_rearranger - if(pio_comp_settings(i)%pio_numiotasks < 0 .or. pio_comp_settings(i)%pio_numiotasks > npets) then - pio_comp_settings(i)%pio_numiotasks = max(1,npets/pio_comp_settings(i)%pio_stride) - endif + call NUOPC_CompAttributeGet(gcomp(i), name="pio_numiotasks", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_numiotasks + + if(pio_comp_settings(i)%pio_numiotasks < 0 .or. pio_comp_settings(i)%pio_numiotasks > npets) then + pio_comp_settings(i)%pio_numiotasks = max(1,npets/pio_comp_settings(i)%pio_stride) + endif - call NUOPC_CompAttributeGet(gcomp(i), name="pio_root", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_root + call NUOPC_CompAttributeGet(gcomp(i), name="pio_root", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_root - if(pio_comp_settings(i)%pio_root < 0 .or. pio_comp_settings(i)%pio_root > npets) then - pio_comp_settings(i)%pio_root = 0 - endif + if(pio_comp_settings(i)%pio_root < 0 .or. pio_comp_settings(i)%pio_root > npets) then + pio_comp_settings(i)%pio_root = 0 endif + call NUOPC_CompAttributeGet(gcomp(i), name="pio_typename", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -347,7 +280,9 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call driver_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) - if (.not. pio_comp_settings(i)%pio_async_interface) then + if (pio_async_interface(i)) then + do_async_init = do_async_init + 1 + else if(pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req = pio_comp_settings(i)%pio_numiotasks endif @@ -358,125 +293,39 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) pio_comp_settings(i)%pio_rearranger, iosystems(i), pio_comp_settings(i)%pio_root, & pio_rearr_opts) endif - ! Write the PIO settings to the beggining of each component log - if(comp_rank == 0) call shr_pio_log_comp_settings(gcomp(i), rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif enddo - - call ESMF_LogWrite(trim(subname)//": check for async", ESMF_LOGMSG_INFO) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - do i=1,total_comps - call MPI_AllReduce(MPI_IN_PLACE, pio_comp_settings(i)%pio_async_interface, 1, MPI_LOGICAL, & - MPI_LOR, global_comm, rc) - if(pio_comp_settings(i)%pio_async_interface) then - do_async_init = do_async_init + 1 - endif - enddo - -! -! Get the PET list for each component using async IO -! - - call MPI_Allreduce(MPI_IN_PLACE, do_async_init, 1, MPI_INTEGER, MPI_MAX, Global_comm, ierr) - call MPI_Allreduce(MPI_IN_PLACE, procs_per_comp, total_comps, MPI_INTEGER, MPI_MAX, Global_comm, ierr) - if (do_async_init > 0) then - allocate(asyncio_comp_comm(do_async_init)) - allocate(comp_proc_list(driverpecount, do_async_init)) - j = 1 - k = 1 - comp_proc_list = -1 - if(.not. asyncio_task) then - do i=1,total_comps - if(pio_comp_settings(i)%pio_async_interface) then - if(petlocal(i)) comp_proc_list(1+driver_myid,j) = myid - do k=1,size(asyncio_petlist) - if(comp_proc_list(1+driver_myid, j) == asyncio_petlist(k)) then - call shr_sys_abort(subname//' ERROR: OVERLAP with asyncio_petlist') - endif - enddo - j = j+1 - endif - enddo - endif - call MPI_AllReduce(MPI_IN_PLACE, comp_proc_list, driverpecount*do_async_init, MPI_INTEGER, MPI_MAX, Global_comm, ierr) - if(asyncio_ntasks == 0) then - call shr_sys_abort(subname//' ERROR: ASYNC IO Requested but no IO PES assigned') - endif - - do i=1,do_async_init - do j=1,driverpecount - if(comp_proc_list(j,i) == -1) then - do k=j+1,driverpecount - if(comp_proc_list(k,i) >= 0) then - comp_proc_list(j,i) = comp_proc_list(k,i) - comp_proc_list(k,i) = -1 - exit - endif - enddo - endif - enddo - enddo - allocate(async_iosystems(do_async_init)) - allocate(async_procs_per_comp(do_async_init)) j=1 do i=1,total_comps - if(pio_comp_settings(i)%pio_async_interface) then - async_procs_per_comp(j) = procs_per_comp(i) + if(pio_async_interface(i)) then + iosystems(i) = async_iosystems(j) j = j+1 - if(async_rearr == 0) then - async_rearr = pio_comp_settings(i)%pio_rearranger - elseif(async_rearr .ne. pio_comp_settings(i)%pio_rearranger) then - call shr_sys_abort(subname//' ERROR: all async component rearrangers must match') - endif endif enddo - ! IO tasks should not return until the run is completed -! ierr = pio_set_log_level(3) - - call ESMF_LogWrite(trim(subname)//": call async pio_init", ESMF_LOGMSG_INFO) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call pio_init(async_iosystems, Global_comm, async_procs_per_comp, comp_proc_list, asyncio_petlist, & - async_rearr, asyncio_comp_comm, io_comm) - if(.not. asyncio_task) then - j=1 - do i=1,total_comps - if(pio_comp_settings(i)%pio_async_interface) then - iosystems(i) = async_iosystems(j) - j = j+1 - endif - enddo - endif + endif - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) deallocate(gcomp) end subroutine driver_pio_component_init - subroutine driver_pio_log_comp_settings(gcomp, logunit, rc) - use ESMF, only : ESMF_GridComp, ESMF_GridCompGet, ESMF_SUCCESS + subroutine driver_pio_log_comp_settings(gcomp, logunit) + use ESMF, only : ESMF_GridComp, ESMF_GridCompGet use NUOPC, only: NUOPC_CompAttributeGet type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + integer, intent(in) :: logunit - integer :: logunit integer :: compid character(len=CS) :: name, cval integer :: i + integer :: rc logical :: isPresent - rc = ESMF_SUCCESS call ESMF_GridCompGet(gcomp, name=name, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='logunit', value=logunit, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name="MCTID", value=cval, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -484,15 +333,13 @@ subroutine driver_pio_log_comp_settings(gcomp, logunit, rc) read(cval, *) compid i = shr_pio_getindex(compid) endif + write(logunit,*) trim(name),': PIO numiotasks=', pio_comp_settings(i)%pio_numiotasks + + write(logunit, *) trim(name), ': PIO stride=',pio_comp_settings(i)%pio_stride + + write(logunit, *) trim(name),': PIO rearranger=',pio_comp_settings(i)%pio_rearranger - if(pio_comp_settings(i)%pio_async_interface) then - write(logunit,*) trim(name),': using ASYNC IO interface' - else - write(logunit,*) trim(name),': PIO numiotasks=', pio_comp_settings(i)%pio_numiotasks - write(logunit, *) trim(name), ': PIO stride=',pio_comp_settings(i)%pio_stride - write(logunit, *) trim(name),': PIO rearranger=',pio_comp_settings(i)%pio_rearranger - write(logunit, *) trim(name),': PIO root=',pio_comp_settings(i)%pio_root - endif + write(logunit, *) trim(name),': PIO root=',pio_comp_settings(i)%pio_root end subroutine driver_pio_log_comp_settings @@ -500,8 +347,7 @@ end subroutine driver_pio_log_comp_settings subroutine driver_pio_finalize( ) integer :: ierr integer :: i - - do i=1,size(iosystems) + do i=1,total_comps call pio_finalize(iosystems(i), ierr) end do diff --git a/cesm/nuopc_cap_share/glc_elevclass_mod.F90 b/cesm/nuopc_cap_share/glc_elevclass_mod.F90 index ee32d7c77..3a984f642 100644 --- a/cesm/nuopc_cap_share/glc_elevclass_mod.F90 +++ b/cesm/nuopc_cap_share/glc_elevclass_mod.F90 @@ -78,7 +78,7 @@ subroutine glc_elevclass_init_default(my_glc_nec, logunit) integer, intent(in), optional :: logunit ! ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = '('//__FILE__//':glc_elevclass_init_default)' + character(len=*), parameter :: subname = 'glc_elevclass_init' !----------------------------------------------------------------------- glc_nec = my_glc_nec @@ -130,7 +130,7 @@ subroutine glc_elevclass_init_override(my_glc_nec, my_topomax) ! ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = '('//__FILE__//':glc_elevclass_init_override)' + character(len=*), parameter :: subname = 'glc_elevclass_init_override' !----------------------------------------------------------------------- SHR_ASSERT_ALL_FL((ubound(my_topomax) == (/my_glc_nec/)), __FILE__, __LINE__) @@ -147,7 +147,7 @@ subroutine glc_elevclass_clean() ! !DESCRIPTION: ! Deallocate memory allocated in this module - character(len=*), parameter :: subname = '('//__FILE__//':glc_elevclass_clean)' + character(len=*), parameter :: subname = 'glc_elevclass_clean' !----------------------------------------------------------------------- if (allocated(topomax)) then @@ -169,7 +169,7 @@ function glc_get_num_elevation_classes() result(num_elevation_classes) ! ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = '('//__FILE__//':glc_elevclass_clean)' + character(len=*), parameter :: subname = 'glc_get_num_elevation_classes' !----------------------------------------------------------------------- num_elevation_classes = glc_nec @@ -199,7 +199,7 @@ subroutine glc_get_elevation_classes_without_bareland(glc_topo, glc_elevclass, l integer :: glc_pt integer :: err_code - character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_classes_without_bareland)' + character(len=*), parameter :: subname = 'get_glc_elevation_classes' !----------------------------------------------------------------------- npts = size(glc_elevclass) @@ -246,7 +246,7 @@ subroutine glc_get_elevation_classes_with_bareland(glc_ice_covered, glc_topo, gl ! Tolerance for checking whether ice_covered is 0 or 1 real(r8), parameter :: ice_covered_tol = 1.e-13 - character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_classes_with_bareland)' + character(len=*), parameter :: subname = 'get_glc_elevation_classes' !----------------------------------------------------------------------- npts = size(glc_elevclass) @@ -315,7 +315,7 @@ subroutine glc_get_elevation_class(topo, elevation_class, err_code) ! !LOCAL VARIABLES: integer :: ec ! temporary elevation class - character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_class)' + character(len=*), parameter :: subname = 'glc_get_elevation_class' !----------------------------------------------------------------------- if (glc_nec < 1) then @@ -359,7 +359,7 @@ function glc_get_elevclass_bounds() result(elevclass_bounds) ! ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_class)' + character(len=*), parameter :: subname = 'glc_get_elevclass_bounds' !----------------------------------------------------------------------- elevclass_bounds(:) = topomax(:) @@ -388,7 +388,7 @@ function glc_elevclass_as_string(elevation_class) result(ec_string) ! !LOCAL VARIABLES: character(len=16) :: format_string - character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_class)' + character(len=*), parameter :: subname = 'glc_elevclass_as_string' !----------------------------------------------------------------------- ! e.g., for GLC_ELEVCLASS_STRLEN = 2, format_string will be '(i2.2)' @@ -412,7 +412,7 @@ function glc_mean_elevation_virtual(elevation_class, logunit) result(mean_elevat integer :: resulting_elevation_class integer :: err_code - character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_class)' + character(len=*), parameter :: subname = 'glc_mean_elevation_virtual' !----------------------------------------------------------------------- if (elevation_class == 0) then @@ -478,7 +478,7 @@ function glc_errcode_to_string(err_code) result(err_string) ! ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_class)' + character(len=*), parameter :: subname = 'glc_errcode_to_string' !----------------------------------------------------------------------- select case (err_code) @@ -522,7 +522,7 @@ subroutine glc_get_fractional_icecov(nec, glc_topo, glc_icefrac, glc_icefrac_ec, integer :: ec integer :: glc_pt integer :: err_code - character(len=*), parameter :: subname = '('//__FILE__//':glc_get_fractional_icecov)' + character(len=*), parameter :: subname = 'get_glc_elevation_classes' !----------------------------------------------------------------------- npts = size(glc_topo) diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index c001bd3b7..8d472902b 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -22,6 +22,7 @@ module nuopc_shr_methods use NUOPC_Model , only : NUOPC_ModelGet use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_sys_mod , only : shr_sys_abort + use shr_file_mod , only : shr_file_setlogunit, shr_file_getLogUnit implicit none private @@ -131,10 +132,7 @@ end subroutine get_component_instance !=============================================================================== subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) - use NUOPC, only : NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd - use ESMF, only : ESMF_GridCompGet, ESMF_LOGMSG_INFO, ESMF_LogWrite use driver_pio_mod, only : driver_pio_log_comp_settings - ! input/output variables type(ESMF_GridComp) :: gcomp logical, intent(in) :: mastertask @@ -146,9 +144,7 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) character(len=CL) :: diro character(len=CL) :: logfile character(len=CL) :: inst_suffix - character(len=CL) :: name integer :: inst_index ! not used here - character(len=*), parameter :: subname = "("//__FILE__//": set_component_logging)" !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -168,25 +164,15 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) endif open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) - ! Write the PIO settings to the beggining of each component log - call driver_pio_log_comp_settings(gcomp, logunit, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + call driver_pio_log_comp_settings(gcomp, logunit) + else logUnit = 6 endif - + ! TODO: shr_file mod is deprecated and should be removed. + call shr_file_setLogUnit (logunit) - call ESMF_GridCompGet(gcomp, name=name, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//": setting logunit for component: "//trim(name), ESMF_LOGMSG_INFO) - - call NUOPC_CompAttributeAdd(gcomp, attrList=(/'logunit'/), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name='logunit',value=logunit, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end subroutine set_component_logging !=============================================================================== @@ -239,7 +225,7 @@ subroutine state_getscalar(state, scalar_id, scalar_value, flds_scalar_name, fld type(ESMF_Field) :: field real(r8), pointer :: farrayptr(:,:) real(r8) :: tmp(1) - character(len=*), parameter :: subname = '('//__FILE__//':state_getscalar)' + character(len=*), parameter :: subname='(state_getscalar)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -290,7 +276,7 @@ subroutine state_setscalar(scalar_value, scalar_id, State, flds_scalar_name, fld type(ESMF_Field) :: lfield type(ESMF_VM) :: vm real(r8), pointer :: farrayptr(:,:) - character(len=*), parameter :: subname = '('//__FILE__//':state_setscalar)' + character(len=*), parameter :: subname='(state_setscalar)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -336,7 +322,7 @@ subroutine state_diagnose(State, string, rc) character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) real(r8), pointer :: dataPtr1d(:) real(r8), pointer :: dataPtr2d(:,:) - character(len=*), parameter :: subname = '('//__FILE__//':state_diagnose)' + character(len=*),parameter :: subname='(state_diagnose)' ! ---------------------------------------------- call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) @@ -413,7 +399,7 @@ subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) type(ESMF_Mesh) :: lmesh integer :: lrank, nnodes, nelements logical :: labort - character(len=*), parameter :: subname = '('//__FILE__//':field_getfldptr)' + character(len=*), parameter :: subname='(field_getfldptr)' ! ---------------------------------------------- if (.not.present(rc)) then @@ -540,7 +526,7 @@ subroutine alarmInit( clock, alarm, option, & type(ESMF_Time) :: NextAlarm ! Next restart alarm time type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval integer :: sec - character(len=*), parameter :: subname = '('//__FILE__//':alarmInit)' + character(len=*), parameter :: subname = '(set_alarmInit): ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -824,7 +810,7 @@ subroutine timeInit( Time, ymd, cal, tod, rc) ! local variables integer :: year, mon, day ! year, month, day as integers integer :: tdate ! temporary date - character(len=*), parameter :: subname = '('//__FILE__//':timeInit)' + character(len=*), parameter :: subname='(timeInit)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/cesm/nuopc_cap_share/seq_drydep_mod.F90 b/cesm/nuopc_cap_share/seq_drydep_mod.F90 index 0d98f5c85..780a6c611 100644 --- a/cesm/nuopc_cap_share/seq_drydep_mod.F90 +++ b/cesm/nuopc_cap_share/seq_drydep_mod.F90 @@ -1,1221 +1,26 @@ module seq_drydep_mod - !======================================================================== - ! Module for handling dry depostion of tracers. - ! This module is shared by land and atmosphere models for the computations of - ! dry deposition of tracers - !======================================================================== - - 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_kind_mod , only : r8 => shr_kind_r8, CS => SHR_KIND_CS, CX => SHR_KIND_CX - use shr_const_mod , only : SHR_CONST_G, SHR_CONST_RDAIR, SHR_CONST_CPDAIR, SHR_CONST_MWWV - use shr_mpi_mod , only : shr_mpi_bcast - use shr_nl_mod , only : shr_nl_find_group_name - use shr_log_mod , only : s_logunit => shr_log_Unit - use shr_infnan_mod , only : shr_infnan_posinf, assignment(=) + use shr_drydep_mod, only: seq_drydep_setHCoeff=>shr_drydep_setHCoeff + use shr_drydep_mod implicit none - private - - ! public member functions - public :: seq_drydep_readnl ! Read namelist - public :: seq_drydep_init ! Initialization of drydep data - public :: seq_drydep_setHCoeff ! Calculate Henry's law coefficients - - ! private array sizes - integer, public, parameter :: n_species_table = 192 ! Number of species to work with - integer, private, parameter :: maxspc = 210 ! Maximum number of species - integer, private, parameter :: NSeas = 5 ! Number of seasons - integer, private, parameter :: NLUse = 11 ! Number of land-use types - logical, private :: drydep_initialized = .false. - - ! public data members: ! method specification - character(16),public,parameter :: DD_XATM = 'xactive_atm' ! dry-dep atmosphere - character(16),public,parameter :: DD_XLND = 'xactive_lnd' ! dry-dep land - character(16),public,parameter :: DD_TABL = 'table' ! dry-dep table (atm and lnd) - character(16),public :: drydep_method = DD_XLND ! Which option choosen - - real(r8), public, parameter :: ph = 1.e-5_r8 ! measure of the acidity (dimensionless) - - logical, public :: lnd_drydep ! If dry-dep fields passed - integer, public :: n_drydep = 0 ! Number in drypdep list - logical :: drydep_init = .false. ! has seq_drydep_init been called? - character(len=CS), public, dimension(maxspc) :: drydep_list = '' ! List of dry-dep species - - real(r8), public, allocatable, dimension(:) :: foxd ! reactivity factor for oxidation (dimensioness) - real(r8), public, allocatable, dimension(:) :: drat ! ratio of molecular diffusivity (D_H2O/D_species; dimensionless) - integer, public, allocatable, dimension(:) :: mapping ! mapping to species table - - ! --- Indices for each species --- - integer, public :: h2_ndx, ch4_ndx, co_ndx, pan_ndx, mpan_ndx, so2_ndx, o3_ndx, o3a_ndx, xpan_ndx - - !--------------------------------------------------------------------------- - ! Table 1 from Wesely, Atmos. Environment, 1989, p1293 - ! Table 2 from Sheih, microfiche PB86-218104 and Walcek, Atmos. Environment, 1986, p949 - ! Table 3-5 compiled by P. Hess - ! - ! index #1 : season - ! 1 -> midsummer with lush vegetation - ! 2 -> autumn with unharvested cropland - ! 3 -> late autumn after frost, no snow - ! 4 -> winter, snow on ground, and subfreezing - ! 5 -> transitional spring with partially green short annuals - ! - ! index #2 : landuse type - ! 1 -> urban land - ! 2 -> agricultural land - ! 3 -> range land - ! 4 -> deciduous forest - ! 5 -> coniferous forest - ! 6 -> mixed forest including wetland - ! 7 -> water, both salt and fresh - ! 8 -> barren land, mostly desert - ! 9 -> nonforested wetland - ! 10 -> mixed agricultural and range land - ! 11 -> rocky open areas with low growing shrubs - ! - ! JFL August 2000 - !--------------------------------------------------------------------------- - - !--------------------------------------------------------------------------- - ! table to parameterize the impact of soil moisture on the deposition of H2 and - ! CO on soils (from Sanderson et al., J. Atmos. Chem., 46, 15-28, 2003). - !--------------------------------------------------------------------------- - - !--- deposition of h2 and CO on soils --- - real(r8), parameter, public :: h2_a(NLUse) = & - (/ 0.000_r8, 0.000_r8, 0.270_r8, 0.000_r8, 0.000_r8, & - 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8/) - !--- deposition of h2 and CO on soils --- - real(r8), parameter, public :: h2_b(NLUse) = & - (/ 0.000_r8,-41.390_r8, -0.472_r8,-41.900_r8,-41.900_r8, & - -41.900_r8, 0.000_r8, 0.000_r8, 0.000_r8,-41.390_r8, 0.000_r8/) - !--- deposition of h2 and CO on soils --- - real(r8), parameter, public :: h2_c(NLUse) = & - (/ 0.000_r8, 16.850_r8, 1.235_r8, 19.700_r8, 19.700_r8, & - 19.700_r8, 0.000_r8, 0.000_r8, 0.000_r8, 17.700_r8, 1.000_r8/) - - !--- deposition of h2 and CO on soils - ! - !--- ri: Richardson number (dimensionless) - !--- rlu: Resistance of leaves in upper canopy (s.m-1) - !--- rac: Aerodynamic resistance to lower canopy (s.m-1) - !--- rgss: Ground surface resistance for SO2 (s.m-1) - !--- rgso: Ground surface resistance for O3 (s.m-1) - !--- rcls: Lower canopy resistance for SO2 (s.m-1) - !--- rclo: Lower canopy resistance for O3 (s.m-1) - ! - real(r8), public, dimension(NSeas,NLUse) :: ri, rlu, rac, rgss, rgso, rcls, rclo - - data ri (1,1:NLUse) & - /1.e36_r8, 60._r8, 120._r8, 70._r8, 130._r8, 100._r8,1.e36_r8,1.e36_r8, 80._r8, 100._r8, 150._r8/ - data rlu (1,1:NLUse) & - /1.e36_r8,2000._r8,2000._r8,2000._r8,2000._r8,2000._r8,1.e36_r8,1.e36_r8,2500._r8,2000._r8,4000._r8/ - data rac (1,1:NLUse) & - / 100._r8, 200._r8, 100._r8,2000._r8,2000._r8,2000._r8, 0._r8, 0._r8, 300._r8, 150._r8, 200._r8/ - data rgss(1,1:NLUse) & - / 400._r8, 150._r8, 350._r8, 500._r8, 500._r8, 100._r8, 0._r8,1000._r8, 0._r8, 220._r8, 400._r8/ - data rgso(1,1:NLUse) & - / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ - data rcls(1,1:NLUse) & - /1.e36_r8,2000._r8,2000._r8,2000._r8,2000._r8,2000._r8,1.e36_r8,1.e36_r8,2500._r8,2000._r8,4000._r8/ - data rclo(1,1:NLUse) & - /1.e36_r8,1000._r8,1000._r8,1000._r8,1000._r8,1000._r8,1.e36_r8,1.e36_r8,1000._r8,1000._r8,1000._r8/ - - data ri (2,1:NLUse) & - /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 250._r8, 500._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ - data rlu (2,1:NLUse) & - /1.e36_r8,9000._r8,9000._r8,9000._r8,4000._r8,8000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ - data rac (2,1:NLUse) & - / 100._r8, 150._r8, 100._r8,1500._r8,2000._r8,1700._r8, 0._r8, 0._r8, 200._r8, 120._r8, 140._r8/ - data rgss(2,1:NLUse) & - / 400._r8, 200._r8, 350._r8, 500._r8, 500._r8, 100._r8, 0._r8,1000._r8, 0._r8, 300._r8, 400._r8/ - data rgso(2,1:NLUse) & - / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8, 800._r8, 180._r8, 200._r8/ - data rcls(2,1:NLUse) & - /1.e36_r8,9000._r8,9000._r8,9000._r8,2000._r8,4000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ - data rclo(2,1:NLUse) & - /1.e36_r8, 400._r8, 400._r8, 400._r8,1000._r8, 600._r8,1.e36_r8,1.e36_r8, 400._r8, 400._r8, 400._r8/ - - data ri (3,1:NLUse) & - /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 250._r8, 500._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ - data rlu (3,1:NLUse) & - /1.e36_r8,1.e36_r8,9000._r8,9000._r8,4000._r8,8000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ - data rac (3,1:NLUse) & - / 100._r8, 10._r8, 100._r8,1000._r8,2000._r8,1500._r8, 0._r8, 0._r8, 100._r8, 50._r8, 120._r8/ - data rgss(3,1:NLUse) & - / 400._r8, 150._r8, 350._r8, 500._r8, 500._r8, 200._r8, 0._r8,1000._r8, 0._r8, 200._r8, 400._r8/ - data rgso(3,1:NLUse) & - / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ - data rcls(3,1:NLUse) & - /1.e36_r8,1.e36_r8,9000._r8,9000._r8,3000._r8,6000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ - data rclo(3,1:NLUse) & - /1.e36_r8,1000._r8, 400._r8, 400._r8,1000._r8, 600._r8,1.e36_r8,1.e36_r8, 800._r8, 600._r8, 600._r8/ - - data ri (4,1:NLUse) & - /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 400._r8, 800._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ - data rlu (4,1:NLUse) & - /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,6000._r8,9000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ - data rac (4,1:NLUse) & - / 100._r8, 10._r8, 10._r8,1000._r8,2000._r8,1500._r8, 0._r8, 0._r8, 50._r8, 10._r8, 50._r8/ - data rgss(4,1:NLUse) & - / 100._r8, 100._r8, 100._r8, 100._r8, 100._r8, 100._r8, 0._r8,1000._r8, 100._r8, 100._r8, 50._r8/ - data rgso(4,1:NLUse) & - / 600._r8,3500._r8,3500._r8,3500._r8,3500._r8,3500._r8,2000._r8, 400._r8,3500._r8,3500._r8,3500._r8/ - data rcls(4,1:NLUse) & - /1.e36_r8,1.e36_r8,1.e36_r8,9000._r8, 200._r8, 400._r8,1.e36_r8,1.e36_r8,9000._r8,1.e36_r8,9000._r8/ - data rclo(4,1:NLUse) & - /1.e36_r8,1000._r8,1000._r8, 400._r8,1500._r8, 600._r8,1.e36_r8,1.e36_r8, 800._r8,1000._r8, 800._r8/ - - data ri (5,1:NLUse) & - /1.e36_r8, 120._r8, 240._r8, 140._r8, 250._r8, 190._r8,1.e36_r8,1.e36_r8, 160._r8, 200._r8, 300._r8/ - data rlu (5,1:NLUse) & - /1.e36_r8,4000._r8,4000._r8,4000._r8,2000._r8,3000._r8,1.e36_r8,1.e36_r8,4000._r8,4000._r8,8000._r8/ - data rac (5,1:NLUse) & - / 100._r8, 50._r8, 80._r8,1200._r8,2000._r8,1500._r8, 0._r8, 0._r8, 200._r8, 60._r8, 120._r8/ - data rgss(5,1:NLUse) & - / 500._r8, 150._r8, 350._r8, 500._r8, 500._r8, 200._r8, 0._r8,1000._r8, 0._r8, 250._r8, 400._r8/ - data rgso(5,1:NLUse) & - / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ - data rcls(5,1:NLUse) & - /1.e36_r8,4000._r8,4000._r8,4000._r8,2000._r8,3000._r8,1.e36_r8,1.e36_r8,4000._r8,4000._r8,8000._r8/ - data rclo(5,1:NLUse) & - /1.e36_r8,1000._r8, 500._r8, 500._r8,1500._r8, 700._r8,1.e36_r8,1.e36_r8, 600._r8, 800._r8, 800._r8/ - - !--------------------------------------------------------------------------- - ! ... roughness length - !--------------------------------------------------------------------------- - real(r8), public, dimension(NSeas,NLUse) :: z0 - - data z0 (1,1:NLUse) & - /1.000_r8,0.250_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.150_r8,0.100_r8,0.100_r8/ - data z0 (2,1:NLUse) & - /1.000_r8,0.100_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.100_r8,0.080_r8,0.080_r8/ - data z0 (3,1:NLUse) & - /1.000_r8,0.005_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.100_r8,0.020_r8,0.060_r8/ - data z0 (4,1:NLUse) & - /1.000_r8,0.001_r8,0.001_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.001_r8,0.001_r8,0.040_r8/ - data z0 (5,1:NLUse) & - /1.000_r8,0.030_r8,0.020_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.010_r8,0.030_r8,0.060_r8/ - - !real(r8), private, dimension(11,5), parameter :: z0xxx = reshape ( & - ! (/ 1.000,0.250,0.050,1.000,1.000,1.000,0.0006,0.002,0.150,0.100,0.100 , & - ! 1.000,0.100,0.050,1.000,1.000,1.000,0.0006,0.002,0.100,0.080,0.080 , & - ! 1.000,0.005,0.050,1.000,1.000,1.000,0.0006,0.002,0.100,0.020,0.060 , & - ! 1.000,0.001,0.001,1.000,1.000,1.000,0.0006,0.002,0.001,0.001,0.040 , & - ! 1.000,0.030,0.020,1.000,1.000,1.000,0.0006,0.002,0.010,0.030,0.060 /), (/11,5/) ) - - !--------------------------------------------------------------------------- - ! public chemical data - !--------------------------------------------------------------------------- - - !--- data for foxd (reactivity factor for oxidation) ---- - real(r8), public, parameter :: dfoxd(n_species_table) = & - (/ 1._r8 & ! OX - ,1._r8 & ! H2O2 - ,1._r8 & ! OH - ,.1_r8 & ! HO2 - ,1.e-36_r8 & ! CO - ,1.e-36_r8 & ! CH4 - ,1._r8 & ! CH3O2 - ,1._r8 & ! CH3OOH - ,1._r8 & ! CH2O - ,1._r8 & ! HCOOH - ,0._r8 & ! NO - ,.1_r8 & ! NO2 - ,1.e-36_r8 & ! HNO3 - ,1.e-36_r8 & ! CO2 - ,1.e-36_r8 & ! NH3 - ,.1_r8 & ! N2O5 - ,1._r8 & ! NO3 - ,1._r8 & ! CH3OH - ,.1_r8 & ! HO2NO2 - ,1._r8 & ! O1D - ,1.e-36_r8 & ! C2H6 - ,.1_r8 & ! C2H5O2 - ,.1_r8 & ! PO2 - ,.1_r8 & ! MACRO2 - ,.1_r8 & ! ISOPO2 - ,1.e-36_r8 & ! C4H10 - ,1._r8 & ! CH3CHO - ,1._r8 & ! C2H5OOH - ,1.e-36_r8 & ! C3H6 - ,1._r8 & ! POOH - ,1.e-36_r8 & ! C2H4 - ,.1_r8 & ! PAN - ,1._r8 & ! CH3COOOH - ,1.e-36_r8 & ! MTERP - ,1._r8 & ! GLYOXAL - ,1._r8 & ! CH3COCHO - ,1._r8 & ! GLYALD - ,.1_r8 & ! CH3CO3 - ,1.e-36_r8 & ! C3H8 - ,.1_r8 & ! C3H7O2 - ,1._r8 & ! CH3COCH3 - ,1._r8 & ! C3H7OOH - ,.1_r8 & ! RO2 - ,1._r8 & ! ROOH - ,1.e-36_r8 & ! Rn - ,1.e-36_r8 & ! ISOP - ,1._r8 & ! MVK - ,1._r8 & ! MACR - ,1._r8 & ! C2H5OH - ,1._r8 & ! ONITR - ,.1_r8 & ! ONIT - ,.1_r8 & ! ISOPNO3 - ,1._r8 & ! HYDRALD - ,1.e-36_r8 & ! HCN - ,1.e-36_r8 & ! CH3CN - ,1.e-36_r8 & ! SO2 - ,0.1_r8 & ! SOAGff0 - ,0.1_r8 & ! SOAGff1 - ,0.1_r8 & ! SOAGff2 - ,0.1_r8 & ! SOAGff3 - ,0.1_r8 & ! SOAGff4 - ,0.1_r8 & ! SOAGbg0 - ,0.1_r8 & ! SOAGbg1 - ,0.1_r8 & ! SOAGbg2 - ,0.1_r8 & ! SOAGbg3 - ,0.1_r8 & ! SOAGbg4 - ,0.1_r8 & ! SOAG0 - ,0.1_r8 & ! SOAG1 - ,0.1_r8 & ! SOAG2 - ,0.1_r8 & ! SOAG3 - ,0.1_r8 & ! SOAG4 - ,0.1_r8 & ! IVOC - ,0.1_r8 & ! SVOC - ,0.1_r8 & ! IVOCbb - ,0.1_r8 & ! IVOCff - ,0.1_r8 & ! SVOCbb - ,0.1_r8 & ! SVOCff - ,1.e-36_r8 & ! N2O - ,1.e-36_r8 & ! H2 - ,1.e-36_r8 & ! C2H2 - ,1._r8 & ! CH3COOH - ,1._r8 & ! EOOH - ,1._r8 & ! HYAC - ,1.e-36_r8 & ! BIGENE - ,1.e-36_r8 & ! BIGALK - ,1._r8 & ! MEK - ,1._r8 & ! MEKOOH - ,1._r8 & ! MACROOH - ,1._r8 & ! MPAN - ,1._r8 & ! ALKNIT - ,1._r8 & ! NOA - ,1._r8 & ! ISOPNITA - ,1._r8 & ! ISOPNITB - ,1._r8 & ! ISOPNOOH - ,1._r8 & ! NC4CHO - ,1._r8 & ! NC4CH2OH - ,1._r8 & ! TERPNIT - ,1._r8 & ! NTERPOOH - ,1._r8 & ! ALKOOH - ,1._r8 & ! BIGALD - ,1._r8 & ! HPALD - ,1._r8 & ! IEPOX - ,1._r8 & ! XOOH - ,1._r8 & ! ISOPOOH - ,1.e-36_r8 & ! TOLUENE - ,1._r8 & ! CRESOL - ,1._r8 & ! TOLOOH - ,1.e-36_r8 & ! BENZENE - ,1._r8 & ! PHENOL - ,1._r8 & ! BEPOMUC - ,1._r8 & ! PHENOOH - ,1._r8 & ! C6H5OOH - ,1._r8 & ! BENZOOH - ,1._r8 & ! BIGALD1 - ,1._r8 & ! BIGALD2 - ,1._r8 & ! BIGALD3 - ,1._r8 & ! BIGALD4 - ,1._r8 & ! TEPOMUC - ,1._r8 & ! BZOOH - ,1._r8 & ! BZALD - ,1._r8 & ! PBZNIT - ,1.e-36_r8 & ! XYLENES - ,1._r8 & ! XYLOL - ,1._r8 & ! XYLOLOOH - ,1._r8 & ! XYLENOOH - ,1.e-36_r8 & ! BCARY - ,1._r8 & ! TERPOOH - ,1._r8 & ! TERPROD1 - ,1._r8 & ! TERPROD2 - ,1._r8 & ! TERP2OOH - ,1.e-36_r8 & ! DMS - ,1.e-36_r8 & ! H2SO4 - ,1._r8 & ! HONITR - ,1._r8 & ! MACRN - ,1._r8 & ! MVKN - ,1._r8 & ! ISOPN2B - ,1._r8 & ! ISOPN3B - ,1._r8 & ! ISOPN4D - ,1._r8 & ! ISOPN1D - ,1._r8 & ! ISOPNOOHD - ,1._r8 & ! ISOPNOOHB - ,1._r8 & ! ISOPNBNO3 - ,1._r8 & ! NO3CH2CHO - ,1._r8 & ! HYPERACET - ,1._r8 & ! HCOCH2OOH - ,1._r8 & ! DHPMPAL - ,1._r8 & ! MVKOOH - ,1._r8 & ! ISOPOH - ,1._r8 & ! ISOPFDN - ,1._r8 & ! ISOPFNP - ,1._r8 & ! INHEB - ,1._r8 & ! HMHP - ,1._r8 & ! HPALD1 - ,1._r8 & ! INHED - ,1._r8 & ! HPALD4 - ,1._r8 & ! ISOPHFP - ,1._r8 & ! HPALDB1C - ,1._r8 & ! HPALDB4C - ,1._r8 & ! ICHE - ,1._r8 & ! ISOPFDNC - ,1._r8 & ! ISOPFNC - ,1._r8 & ! TERPNT - ,1._r8 & ! TERPNS - ,1._r8 & ! TERPNT1 - ,1._r8 & ! TERPNS1 - ,1._r8 & ! TERPNPT - ,1._r8 & ! TERPNPS - ,1._r8 & ! TERPNPT1 - ,1._r8 & ! TERPNPS1 - ,1._r8 & ! TERPFDN - ,1._r8 & ! SQTN - ,1._r8 & ! TERPHFN - ,1._r8 & ! TERP1OOH - ,1._r8 & ! TERPDHDP - ,1._r8 & ! TERPF2 - ,1._r8 & ! TERPF1 - ,1._r8 & ! TERPA - ,1._r8 & ! TERPA2 - ,1._r8 & ! TERPK - ,1._r8 & ! TERPAPAN - ,1._r8 & ! TERPACID - ,1._r8 & ! TERPA2PAN - ,1.e-36_r8 & ! APIN - ,1.e-36_r8 & ! BPIN - ,1.e-36_r8 & ! LIMON - ,1.e-36_r8 & ! MYRC - ,1._r8 & ! TERPACID2 - ,1._r8 & ! TERPACID3 - ,1._r8 & ! TERPA3PAN - ,1._r8 & ! TERPOOHL - ,1._r8 & ! TERPA3 - ,1._r8 & ! TERP2AOOH - /) + character(len=*), parameter :: DD_XLND = 'xactive_lnd' ! dry-dep land + character(len=*), parameter :: drydep_method = DD_XLND ! XLND is the only option now + logical, protected :: lnd_drydep - ! PRIVATE DATA: - - Interface seq_drydep_setHCoeff ! overload subroutine - Module Procedure set_hcoeff_scalar - Module Procedure set_hcoeff_vector - End Interface - - real(r8), private, parameter :: small_value = 1.e-36_r8 !--- smallest value to use --- - - !--------------------------------------------------------------------------- - ! private chemical data - !--------------------------------------------------------------------------- - - !--- Names of species that can work with --- - character(len=20), public, parameter :: species_name_table(n_species_table) = & - (/ 'OX ' & - ,'H2O2 ' & - ,'OH ' & - ,'HO2 ' & - ,'CO ' & - ,'CH4 ' & - ,'CH3O2 ' & - ,'CH3OOH ' & - ,'CH2O ' & - ,'HCOOH ' & - ,'NO ' & - ,'NO2 ' & - ,'HNO3 ' & - ,'CO2 ' & - ,'NH3 ' & - ,'N2O5 ' & - ,'NO3 ' & - ,'CH3OH ' & - ,'HO2NO2 ' & - ,'O1D ' & - ,'C2H6 ' & - ,'C2H5O2 ' & - ,'PO2 ' & - ,'MACRO2 ' & - ,'ISOPO2 ' & - ,'C4H10 ' & - ,'CH3CHO ' & - ,'C2H5OOH ' & - ,'C3H6 ' & - ,'POOH ' & - ,'C2H4 ' & - ,'PAN ' & - ,'CH3COOOH ' & - ,'MTERP ' & - ,'GLYOXAL ' & - ,'CH3COCHO ' & - ,'GLYALD ' & - ,'CH3CO3 ' & - ,'C3H8 ' & - ,'C3H7O2 ' & - ,'CH3COCH3 ' & - ,'C3H7OOH ' & - ,'RO2 ' & - ,'ROOH ' & - ,'Rn ' & - ,'ISOP ' & - ,'MVK ' & - ,'MACR ' & - ,'C2H5OH ' & - ,'ONITR ' & - ,'ONIT ' & - ,'ISOPNO3 ' & - ,'HYDRALD ' & - ,'HCN ' & - ,'CH3CN ' & - ,'SO2 ' & - ,'SOAGff0 ' & - ,'SOAGff1 ' & - ,'SOAGff2 ' & - ,'SOAGff3 ' & - ,'SOAGff4 ' & - ,'SOAGbg0 ' & - ,'SOAGbg1 ' & - ,'SOAGbg2 ' & - ,'SOAGbg3 ' & - ,'SOAGbg4 ' & - ,'SOAG0 ' & - ,'SOAG1 ' & - ,'SOAG2 ' & - ,'SOAG3 ' & - ,'SOAG4 ' & - ,'IVOC ' & - ,'SVOC ' & - ,'IVOCbb ' & - ,'IVOCff ' & - ,'SVOCbb ' & - ,'SVOCff ' & - ,'N2O ' & - ,'H2 ' & - ,'C2H2 ' & - ,'CH3COOH ' & - ,'EOOH ' & - ,'HYAC ' & - ,'BIGENE ' & - ,'BIGALK ' & - ,'MEK ' & - ,'MEKOOH ' & - ,'MACROOH ' & - ,'MPAN ' & - ,'ALKNIT ' & - ,'NOA ' & - ,'ISOPNITA ' & - ,'ISOPNITB ' & - ,'ISOPNOOH ' & - ,'NC4CHO ' & - ,'NC4CH2OH ' & - ,'TERPNIT ' & - ,'NTERPOOH ' & - ,'ALKOOH ' & - ,'BIGALD ' & - ,'HPALD ' & - ,'IEPOX ' & - ,'XOOH ' & - ,'ISOPOOH ' & - ,'TOLUENE ' & - ,'CRESOL ' & - ,'TOLOOH ' & - ,'BENZENE ' & - ,'PHENOL ' & - ,'BEPOMUC ' & - ,'PHENOOH ' & - ,'C6H5OOH ' & - ,'BENZOOH ' & - ,'BIGALD1 ' & - ,'BIGALD2 ' & - ,'BIGALD3 ' & - ,'BIGALD4 ' & - ,'TEPOMUC ' & - ,'BZOOH ' & - ,'BZALD ' & - ,'PBZNIT ' & - ,'XYLENES ' & - ,'XYLOL ' & - ,'XYLOLOOH ' & - ,'XYLENOOH ' & - ,'BCARY ' & - ,'TERPOOH ' & - ,'TERPROD1 ' & - ,'TERPROD2 ' & - ,'TERP2OOH ' & - ,'DMS ' & - ,'H2SO4 ' & - ,'HONITR ' & - ,'MACRN ' & - ,'MVKN ' & - ,'ISOPN2B ' & - ,'ISOPN3B ' & - ,'ISOPN4D ' & - ,'ISOPN1D ' & - ,'ISOPNOOHD' & - ,'ISOPNOOHB' & - ,'ISOPNBNO3' & - ,'NO3CH2CHO' & - ,'HYPERACET' & - ,'HCOCH2OOH' & - ,'DHPMPAL ' & - ,'MVKOOH ' & - ,'ISOPOH ' & - ,'ISOPFDN ' & - ,'ISOPFNP ' & - ,'INHEB ' & - ,'HMHP ' & - ,'HPALD1 ' & - ,'INHED ' & - ,'HPALD4 ' & - ,'ISOPHFP ' & - ,'HPALDB1C ' & - ,'HPALDB4C ' & - ,'ICHE ' & - ,'ISOPFDNC ' & - ,'ISOPFNC ' & - ,'TERPNT ' & - ,'TERPNS ' & - ,'TERPNT1 ' & - ,'TERPNS1 ' & - ,'TERPNPT ' & - ,'TERPNPS ' & - ,'TERPNPT1 ' & - ,'TERPNPS1 ' & - ,'TERPFDN ' & - ,'SQTN ' & - ,'TERPHFN ' & - ,'TERP1OOH ' & - ,'TERPDHDP ' & - ,'TERPF2 ' & - ,'TERPF1 ' & - ,'TERPA ' & - ,'TERPA2 ' & - ,'TERPK ' & - ,'TERPAPAN ' & - ,'TERPACID ' & - ,'TERPA2PAN' & - ,'APIN ' & - ,'BPIN ' & - ,'LIMON ' & - ,'MYRC ' & - ,'TERPACID2' & - ,'TERPACID3' & - ,'TERPA3PAN' & - ,'TERPOOHL ' & - ,'TERPA3 ' & - ,'TERP2AOOH' & - /) - - !--- data for effective Henry's Law coefficient --- - real(r8), public, parameter :: dheff(n_species_table*6) = & - (/1.03e-02_r8, 2830._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! OX - ,8.70e+04_r8, 7320._r8,2.2e-12_r8,-3730._r8,0._r8 , 0._r8 & ! H2O2 - ,3.90e+01_r8, 4300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! OH - ,6.90e+02_r8, 5900._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HO2 - ,9.81e-04_r8, 1650._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CO - ,1.41e-03_r8, 1820._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH4 - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3O2 - ,3.00e+02_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3OOH - ,3.23e+03_r8, 7100._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH2O - ,8.90e+03_r8, 6100._r8,1.8e-04_r8, -20._r8,0._r8 , 0._r8 & ! HCOOH - ,1.92e-03_r8, 1762._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NO - ,1.20e-02_r8, 2440._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NO2 - ,2.10e+05_r8, 8700._r8,2.2e+01_r8, 0._r8,0._r8 , 0._r8 & ! HNO3 - ,3.44e-02_r8, 2715._r8,4.3e-07_r8,-1000._r8,4.7e-11_r8,-1760._r8 & ! CO2 - ,6.02e+01_r8, 4160._r8,1.7e-05_r8,-4325._r8,1.0e-14_r8,-6716._r8 & ! NH3 - ,2.14e+00_r8, 3362._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! N2O5 - ,3.80e-02_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NO3 - ,2.03e+02_r8, 5645._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3OH - ,4.00e+01_r8, 8400._r8,1.3e-06_r8, 0._r8,0._r8 , 0._r8 & ! HO2NO2 - ,1.00e-16_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! O1D - ,1.88e-03_r8, 2750._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H6 - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H5O2 - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PO2 - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MACRO2 - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPO2 - ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C4H10 - ,1.29e+01_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3CHO - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H5OOH - ,5.57e-03_r8, 2800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C3H6 - ,1.50e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! POOH - ,5.96e-03_r8, 2200._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H4 - ,2.80e+00_r8, 5730._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PAN - ,8.37e+02_r8, 5310._r8,1.8e-04_r8, -20._r8,0._r8 , 0._r8 & ! CH3COOOH - ,2.94e-02_r8, 1800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MTERP - ,4.19e+05_r8, 7480._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! GLYOXAL - ,3.50e+03_r8, 7545._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3COCHO - ,4.00e+04_r8, 4630._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! GLYALD - ,1.00e-01_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3CO3 - ,1.51e-03_r8, 3120._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C3H8 - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C3H7O2 - ,2.78e+01_r8, 5530._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3COCH3 - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C3H7OOH - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! RO2 - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ROOH - ,0.00e+00_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! Rn - ,3.45e-02_r8, 4400._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOP - ,4.10e+01_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MVK - ,6.50e+00_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MACR - ,1.90e+02_r8, 6500._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H5OH - ,1.44e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ONITR - ,1.00e+03_r8, 6000._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ONIT - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNO3 - ,1.10e+05_r8, 6000._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HYDRALD - ,9.02e+00_r8, 8258._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HCN - ,5.28e+01_r8, 3970._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3CN - ,1.36e+00_r8, 3100._r8,1.30e-02_r8,1960._r8,6.6e-08_r8, 1500._r8 & ! SO2 - ,1.3e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff0 - ,3.2e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff1 - ,4.0e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff2 - ,1.3e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff3 - ,1.6e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff4 - ,7.9e+11_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg0 - ,6.3e+10_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg1 - ,3.2e+09_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg2 - ,6.3e+08_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg3 - ,3.2e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg4 - ,4.0e+11_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG0 - ,3.2e+10_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG1 - ,1.6e+09_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG2 - ,3.2e+08_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG3 - ,1.6e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG4 - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! IVOC - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SVOC - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! IVOCbb - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! IVOCff - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SVOCbb - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SVOCff - ,2.42e-02_r8, 2710._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! N2O - ,7.9e-04_r8, 530._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! H2 - ,4.14e-02_r8, 1890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H2 - ,4.1e+03_r8, 6200._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3COOH - ,1.9e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! EOOH - ,1.46e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HYAC - ,5.96e-03_r8, 2365._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGENE - ,1.24e-03_r8, 3010._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALK - ,1.80e+01_r8, 5740._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MEK - ,6.4e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MEKOOH - ,4.4e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MACROOH - ,1.72e+00_r8, 5700._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MPAN - ,1.01e+00_r8, 5790._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ALKNIT - ,1.e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NOA - ,8.34e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNITA - ,4.82e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNITB - ,8.75e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNOOH - ,1.46e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NC4CHO - ,4.02e+04_r8, 9500._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NC4CH2OH - ,8.41e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNIT - ,6.67e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NTERPOOH - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ALKOOH - ,9.6e+00_r8, 6220._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD - ,2.30e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALD - ,3.e+07_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! IEPOX - ,1.e+11_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XOOH - ,3.5e+06_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPOOH - ,1.5e-01_r8, 4300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TOLUENE - ,5.67e+02_r8, 5800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CRESOL - ,2.30e+04_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TOLOOH - ,1.8e-01_r8, 3800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BENZENE - ,2.84e+03_r8, 2700._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PHENOL - ,3.e+07_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BEPOMUC - ,1.5e+06_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PHENOOH - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C6H5OOH - ,2.3e+03_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BENZOOH - ,1.e+05_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD1 - ,2.9e+04_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD2 - ,2.2e+04_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD3 - ,2.2e+04_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD4 - ,2.5e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TEPOMUC - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BZOOH - ,3.24e+01_r8, 6300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BZALD - ,2.8e+00_r8, 5730._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PBZNIT - ,2.e-01_r8, 4300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XYLENES - ,1.01e+03_r8, 6800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XYLOL - ,1.9e+06_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XYLOLOOH - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XYLENOOH - ,5.57e-03_r8, 2800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BCARY - ,3.6e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPOOH - ,3.92e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPROD1 - ,7.20e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPROD2 - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERP2OOH - ,5.4e-01_r8, 3460._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! DMS - ,1.e+11_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! H2SO4 - ,2.64e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HONITR - ,4.14e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MACRN - ,1.84e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MVKN - ,8.34e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPN2B - ,8.34e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPN3B - ,4.82e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPN4D - ,4.82e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPN1D - ,9.67e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNOOHD - ,6.61e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNOOHB - ,8.34e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNBNO3 - ,3.39e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NO3CH2CHO - ,1.16e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HYPERACET - ,2.99e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HCOCH2OOH - ,9.37e+07_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! DHPMPAL - ,1.24e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MVKOOH - ,8.77e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPOH - ,5.02e+08_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPFDN - ,2.97e+11_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPFNP - ,1.05e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! INHEB - ,1.70e+06_r8, 9870._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HMHP - ,2.30e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALD1 - ,1.51e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! INHED - ,2.30e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALD4 - ,7.60e+09_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPHFP - ,5.43e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALDB1C - ,5.43e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALDB4C - ,2.09e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ICHE - ,7.16e+09_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPFDNC - ,1.41e+11_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPFNC - ,8.41e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNT - ,8.41e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNS - ,8.55e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNT1 - ,8.55e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNS1 - ,6.67e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNPT - ,6.67e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNPS - ,6.78e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNPT1 - ,6.78e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNPS1 - ,1.65e+09_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPFDN - ,9.04e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SQTN - ,7.53e+11_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPHFN - ,3.64e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERP1OOH - ,3.41e+14_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPDHDP - ,6.54e+01_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPF2 - ,4.05e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPF1 - ,3.92e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA - ,7.20e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA2 - ,6.39e+01_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPK - ,7.94e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPAPAN - ,5.63e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPACID - ,9.59e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA2PAN - ,2.94e-02_r8, 1800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! APIN - ,1.52e-02_r8, 4500._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BPIN - ,4.86e-02_r8, 4600._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! LIMON - ,7.30e-02_r8, 2800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MYRC - ,2.64e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPACID2 - ,3.38e+09_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPACID3 - ,1.23e+07_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA3PAN - ,4.41e+12_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPOOHL - ,1.04e+08_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA3 - ,3.67e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERP2AOOH - /) - - real(r8), private, parameter :: wh2o = SHR_CONST_MWWV - real(r8), private, parameter :: mol_wgts(n_species_table) = & - (/ 47.9981995_r8, 34.0135994_r8, 17.0067997_r8, 33.0061989_r8, 28.0104008_r8, & - 16.0405998_r8, 47.0320015_r8, 48.0393982_r8, 30.0251999_r8, 46.0246010_r8, & - 30.0061398_r8, 46.0055389_r8, 63.0123405_r8, 44.0098000_r8, 17.0289402_r8, & - 108.010483_r8, 62.0049400_r8, 32.0400009_r8, 79.0117416_r8, 15.9994001_r8, & - 30.0664005_r8, 61.0578003_r8, 91.0830002_r8, 119.093399_r8, 117.119797_r8, & - 58.1180000_r8, 44.0509987_r8, 62.0652008_r8, 42.0774002_r8, 92.0904007_r8, & - 28.0515995_r8, 121.047943_r8, 76.0497971_r8, 136.228394_r8, 58.0355988_r8, & - 72.0614014_r8, 60.0503998_r8, 75.0423965_r8, 44.0922012_r8, 75.0836029_r8, & - 58.0768013_r8, 76.0910034_r8, 89.070126_r8, 90.078067_r8, 222.000000_r8, & - 68.1141968_r8, 70.0877991_r8, 70.0877991_r8, 46.0657997_r8, 147.125946_r8, & - 119.074341_r8, 162.117935_r8, 100.112999_r8, 27.0256_r8 , 41.0524_r8 , & - 64.064800_r8, 250._r8, 250._r8, 250._r8, 250._r8, & - 250._r8, 250._r8, 250._r8, 250._r8, 250._r8, & - 250._r8, 250._r8, 250._r8, 250._r8, 250._r8, & - 250._r8, 170.3_r8, 170.3_r8, 170.3_r8, 170.3_r8, & - 170.3_r8, 170.3_r8, 44.0129_r8, 2.0148_r8, 26.0368_r8, & - 60.0504_r8, 78.0646_r8, 74.0762_r8, 56.1032_r8, 72.1438_r8, & - 72.1026_r8, 104.101_r8, 120.101_r8, 147.085_r8, 133.141_r8, & - 119.074_r8, 147.126_r8, 147.126_r8, 163.125_r8, 145.111_r8, & - 147.126_r8, 215.24_r8, 231.24_r8, 104.143_r8, 98.0982_r8, & - 116.112_r8, 118.127_r8, 150.126_r8, 118.127_r8, 92.1362_r8, & - 108.136_r8, 174.148_r8, 78.1104_r8, 94.1098_r8, 126.109_r8, & - 176.122_r8, 110.109_r8, 160.122_r8, 84.0724_r8, 98.0982_r8, & - 98.0982_r8, 112.124_r8, 140.134_r8, 124.135_r8, 106.121_r8, & - 183.118_r8, 106.162_r8, 122.161_r8, 204.173_r8, 188.174_r8, & - 204.343_r8, 186.241_r8, 168.227_r8, 154.201_r8, 200.226_r8, & - 62.1324_r8, 98.0784_r8, 135.118733_r8, 149.102257_r8, 149.102257_r8, & - 147.129469_r8, 147.129469_r8, 147.129469_r8, 147.129469_r8, 163.128874_r8, & - 163.128874_r8, 147.129469_r8, 105.049617_r8, 90.078067_r8, 76.05145_r8, & - 136.103494_r8, 120.104089_r8, 102.131897_r8, 226.141733_r8, 197.143565_r8, & - 163.128874_r8, 64.040714_r8, 116.11542_r8, 163.128874_r8, 116.11542_r8, & - 150.130112_r8, 116.11542_r8, 116.11542_r8, 116.11542_r8, 224.125851_r8, & - 195.127684_r8, 215.246675_r8, 215.246675_r8, 215.246675_r8, 215.246675_r8, & - 231.24608_r8, 231.24608_r8, 231.24608_r8, 231.24608_r8, 294.258938_r8, & - 283.36388_r8, 265.260771_r8, 186.248507_r8, 236.262604_r8, 110.153964_r8, & - 168.233221_r8, 168.233221_r8, 154.206603_r8, 138.207199_r8, 245.229603_r8, & - 200.232031_r8, 231.202986_r8, 136.228394_r8, 136.228394_r8, 136.228394_r8, & - 136.228394_r8, 186.205413_r8, 202.204818_r8, 247.202391_r8, 218.247317_r8, & - 170.206008_r8, 186.248507_r8 /) - - -!=============================================================================== -CONTAINS -!=============================================================================== +contains subroutine seq_drydep_readnl(NLFilename, drydep_nflds) - !======================================================================== - ! reads drydep_inparm namelist and determines the number of drydep velocity - ! fields that are sent from the land component - !======================================================================== - character(len=*), intent(in) :: NLFilename ! Namelist filename integer, intent(out) :: drydep_nflds - !----- local ----- - integer :: i ! Indices - integer :: unitn ! namelist unit number - integer :: ierr ! error code - logical :: exists ! if file exists or not - type(ESMF_VM) :: vm - integer :: localPet - integer :: mpicom - integer :: rc - character(*),parameter :: F00 = "('(seq_drydep_read) ',8a)" - character(*),parameter :: FI1 = "('(seq_drydep_init) ',a,I2)" - character(*),parameter :: subName = '(seq_drydep_read) ' - !----------------------------------------------------------------------------- - - namelist /drydep_inparm/ drydep_list, drydep_method - - !----------------------------------------------------------------------------- - ! Read namelist and figure out the drydep field list to pass - ! First check if file exists and if not, n_drydep will be zero - !----------------------------------------------------------------------------- + call shr_drydep_readnl(NLFilename, drydep_nflds) - rc = ESMF_SUCCESS - drydep_nflds = 0 - - !--- Open and read namelist --- - if ( len_trim(NLFilename) == 0 )then - call shr_sys_abort( subName//'ERROR: nlfilename not set' ) - end if - - 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' ) - write(s_logunit,F00) 'Read in drydep_inparm namelist from: ', trim(NLFilename) - call shr_nl_find_group_name(unitn, 'drydep_inparm', ierr) - if (ierr == 0) then - ! Note that ierr /= 0, no namelist is present. - read(unitn, drydep_inparm, iostat=ierr) - if (ierr > 0) then - call shr_sys_abort( 'problem on read of drydep_inparm namelist in seq_drydep_readnl') - end if - endif - close( unitn ) - end if - end if - call shr_mpi_bcast( drydep_list, mpicom ) - call shr_mpi_bcast( drydep_method, mpicom ) - - do i=1,maxspc - if(len_trim(drydep_list(i)) > 0) then - drydep_nflds=drydep_nflds+1 - endif - enddo - - ! set module variable - n_drydep = drydep_nflds - - ! Make sure method is valid and determine if land is passing drydep fields - lnd_drydep = (drydep_nflds>0 .and. drydep_method == DD_XLND) - if (localpet==0) then - write(s_logunit,*) 'seq_drydep_read: drydep_method: ', trim(drydep_method) - if ( drydep_nflds == 0 )then - write(s_logunit,F00) 'No dry deposition fields will be transfered' - else - write(s_logunit,FI1) 'Number of dry deposition fields transfered is ', drydep_nflds - end if - end if - - if ( trim(drydep_method)/=trim(DD_XATM) .and. & - trim(drydep_method)/=trim(DD_XLND) .and. & - trim(drydep_method)/=trim(DD_TABL) ) then - write(s_logunit,*) 'seq_drydep_read: drydep_method : ', trim(drydep_method) - write(s_logunit,*) 'seq_drydep_read: drydep_method must be set to : ', & - DD_XATM,', ', DD_XLND,', or ', DD_TABL - call shr_sys_abort('seq_drydep_read: incorrect dry deposition method specification') - endif - - if (.not. drydep_initialized) then - call seq_drydep_init() - end if + lnd_drydep = drydep_nflds>0 end subroutine seq_drydep_readnl -!==================================================================================== - - subroutine seq_drydep_init( ) - - !======================================================================== - ! Initialization of dry deposition fields - ! reads drydep_inparm namelist and sets up CCSM driver list of fields for - ! land-atmosphere communications. - !======================================================================== - - !----- local ----- - integer :: i, l ! Indices - character(len=32) :: test_name ! field test name - - !----- formats ----- - character(*),parameter :: subName = '(seq_drydep_init) ' - character(*),parameter :: F00 = "('(seq_drydep_init) ',8a)" - - !----------------------------------------------------------------------------- - ! Return if this routine has already been called (e.g. cam and clm both call this) - !----------------------------------------------------------------------------- - if(allocated(foxd)) return - !----------------------------------------------------------------------------- - ! Allocate and fill foxd, drat and mapping as well as species indices - !----------------------------------------------------------------------------- - - if ( n_drydep > 0 ) then - - allocate( foxd(n_drydep) ) - allocate( drat(n_drydep) ) - allocate( mapping(n_drydep) ) - - ! This initializes these variables to infinity. - foxd = shr_infnan_posinf - drat = shr_infnan_posinf - - mapping(:) = 0 - - end if - - h2_ndx=-1; ch4_ndx=-1; co_ndx=-1; mpan_ndx = -1; pan_ndx = -1; so2_ndx=-1; o3_ndx=-1; xpan_ndx=-1 - - !--- Loop over drydep species that need to be worked with --- - do i=1,n_drydep - if ( len_trim(drydep_list(i))==0 ) exit - - test_name = drydep_list(i) - - if( trim(test_name) == 'O3' ) then - test_name = 'OX' - end if - - !--- Figure out if species maps to a species in the species table --- - do l = 1,n_species_table - if( trim( test_name ) == trim( species_name_table(l) ) ) then - mapping(i) = l - exit - end if - end do - - !--- If it doesn't map to a species in the species table find species close enough --- - if( mapping(i) < 1 ) then - select case( trim(test_name) ) - case( 'O3S', 'O3INERT' ) - test_name = 'OX' - case( 'Pb' ) - test_name = 'HNO3' - case( 'SOGM','SOGI','SOGT','SOGB','SOGX' ) - test_name = 'CH3OOH' - case( 'SOA', 'SO4', 'CB1', 'CB2', 'OC1', 'OC2', 'NH4', 'SA1', 'SA2', 'SA3', 'SA4' ) - test_name = 'OX' ! this is just a place holder. values are explicitly set below - case( 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX' ) - test_name = 'OX' ! this is just a place holder. values are explicitly set below - case( 'SOAGbb0' ) - test_name = 'SOAGff0' - case( 'SOAGbb1' ) - test_name = 'SOAGff1' - case( 'SOAGbb2' ) - test_name = 'SOAGff2' - case( 'SOAGbb3' ) - test_name = 'SOAGff3' - case( 'SOAGbb4' ) - test_name = 'SOAGff4' - case( 'O3A' ) - test_name = 'OX' - case( 'XMPAN' ) - test_name = 'MPAN' - case( 'XPAN' ) - test_name = 'PAN' - case( 'XNO' ) - test_name = 'NO' - case( 'XNO2' ) - test_name = 'NO2' - case( 'XHNO3' ) - test_name = 'HNO3' - case( 'XONIT' ) - test_name = 'ONIT' - case( 'XONITR' ) - test_name = 'ONITR' - case( 'XHO2NO2') - test_name = 'HO2NO2' - case( 'XNH4NO3' ) - test_name = 'HNO3' - case( 'NH4NO3' ) - test_name = 'HNO3' - case default - test_name = 'blank' - end select - - !--- If found a match check the species table again --- - if( trim(test_name) /= 'blank' ) then - do l = 1,n_species_table - if( trim( test_name ) == trim( species_name_table(l) ) ) then - mapping(i) = l - exit - end if - end do - else - write(s_logunit,F00) trim(drydep_list(i)),' not in tables; will have dep vel = 0' - call shr_sys_abort( subName//': '//trim(drydep_list(i))//' is not in tables' ) - end if - end if - - !--- Figure out the specific species indices --- - if ( trim(drydep_list(i)) == 'H2' ) h2_ndx = i - if ( trim(drydep_list(i)) == 'CO' ) co_ndx = i - if ( trim(drydep_list(i)) == 'CH4' ) ch4_ndx = i - if ( trim(drydep_list(i)) == 'MPAN' ) mpan_ndx = i - if ( trim(drydep_list(i)) == 'PAN' ) pan_ndx = i - if ( trim(drydep_list(i)) == 'SO2' ) so2_ndx = i - if ( trim(drydep_list(i)) == 'OX' .or. trim(drydep_list(i)) == 'O3' ) o3_ndx = i - if ( trim(drydep_list(i)) == 'O3A' ) o3a_ndx = i - if ( trim(drydep_list(i)) == 'XPAN' ) xpan_ndx = i - - if( mapping(i) > 0) then - l = mapping(i) - foxd(i) = dfoxd(l) - drat(i) = sqrt(mol_wgts(l)/wh2o) - endif - - enddo - - where( rgss < 1._r8 ) - rgss = 1._r8 - endwhere - - where( rac < small_value) - rac = small_value - endwhere - - drydep_initialized = .true. - - end subroutine seq_drydep_init - -!==================================================================================== - - subroutine set_hcoeff_scalar( sfc_temp, heff ) - - !======================================================================== - ! Interface to seq_drydep_setHCoeff when input is scalar - ! wrapper routine used when surface temperature is a scalar (single column) rather - ! than an array (multiple columns). - ! - ! !REVISION HISTORY: - ! 2008-Nov-12 - F. Vitt - first version - !======================================================================== - - implicit none - - real(r8), intent(in) :: sfc_temp ! Input surface temperature - real(r8), intent(out) :: heff(n_drydep) ! Output Henry's law coefficients - - !----- local ----- - real(r8) :: sfc_temp_tmp(1) ! surface temp - - sfc_temp_tmp(:) = sfc_temp - call set_hcoeff_vector( 1, sfc_temp_tmp, heff(:n_drydep) ) - - end subroutine set_hcoeff_scalar - -!==================================================================================== - - subroutine set_hcoeff_vector( ncol, sfc_temp, heff ) - - !======================================================================== - ! Interface to seq_drydep_setHCoeff when input is vector - ! sets dry depositions coefficients -- used by both land and atmosphere models - !======================================================================== - - integer, intent(in) :: ncol ! Input size of surface-temp vector - real(r8), intent(in) :: sfc_temp(ncol) ! Surface temperature - real(r8), intent(out) :: heff(ncol,n_drydep) ! Henry's law coefficients - - !----- local ----- - real(r8), parameter :: t0 = 298._r8 ! Standard Temperature - real(r8), parameter :: ph_inv = 1._r8/ph ! Inverse of PH - integer :: m, l, id ! indices - real(r8) :: e298 ! Henry's law coefficient @ standard temperature (298K) - real(r8) :: dhr ! temperature dependence of Henry's law coefficient - real(r8) :: dk1s(ncol) ! DK Work array 1 - real(r8) :: dk2s(ncol) ! DK Work array 2 - real(r8) :: wrk(ncol) ! Work array - - !----- formats ----- - character(*),parameter :: subName = '(seq_drydep_set_hcoeff) ' - character(*),parameter :: F00 = "('(seq_drydep_set_hcoeff) ',8a)" - - !------------------------------------------------------------------------------- - ! notes: - !------------------------------------------------------------------------------- - - wrk(:) = (t0 - sfc_temp(:))/(t0*sfc_temp(:)) - do m = 1,n_drydep - l = mapping(m) - id = 6*(l - 1) - e298 = dheff(id+1) - dhr = dheff(id+2) - heff(:,m) = e298*exp( dhr*wrk(:) ) - !--- Calculate coefficients based on the drydep tables --- - if( dheff(id+3) /= 0._r8 .and. dheff(id+5) == 0._r8 ) then - e298 = dheff(id+3) - dhr = dheff(id+4) - dk1s(:) = e298*exp( dhr*wrk(:) ) - where( heff(:,m) /= 0._r8 ) - heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph_inv) - elsewhere - heff(:,m) = dk1s(:)*ph_inv - endwhere - end if - !--- For coefficients that are non-zero AND CO2 or NH3 handle things this way --- - if( dheff(id+5) /= 0._r8 ) then - if( trim( drydep_list(m) ) == 'CO2' .or. trim( drydep_list(m) ) == 'NH3' & - .or. trim( drydep_list(m) ) == 'SO2' ) then - e298 = dheff(id+3) - dhr = dheff(id+4) - dk1s(:) = e298*exp( dhr*wrk(:) ) - e298 = dheff(id+5) - dhr = dheff(id+6) - dk2s(:) = e298*exp( dhr*wrk(:) ) - !--- For Carbon dioxide --- - if( trim(drydep_list(m)) == 'CO2'.or. trim( drydep_list(m) ) == 'SO2' ) then - heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph_inv*(1._r8 + dk2s(:)*ph_inv)) - !--- For NH3 --- - else if( trim( drydep_list(m) ) == 'NH3' ) then - heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph/dk2s(:)) - !--- This can't happen --- - else - write(s_logunit,F00) 'Bad species ',drydep_list(m) - call shr_sys_abort( subName//'ERROR: in assigning coefficients' ) - end if - end if - end if - end do - - end subroutine set_hcoeff_vector - -!=============================================================================== - end module seq_drydep_mod diff --git a/cesm/nuopc_cap_share/shr_fire_emis_mod.F90 b/cesm/nuopc_cap_share/shr_fire_emis_mod.F90 index 5558e8848..47e9cf117 100644 --- a/cesm/nuopc_cap_share/shr_fire_emis_mod.F90 +++ b/cesm/nuopc_cap_share/shr_fire_emis_mod.F90 @@ -115,7 +115,7 @@ subroutine shr_fire_emis_readnl( NLFileName, emis_nflds ) logical :: fire_emis_elevated = .true. integer :: i, tmp(1) character(*),parameter :: F00 = "('(shr_fire_emis_readnl) ',2a)" - character(len=*), parameter :: subname = '('//__FILE__//':shr_fire_emis_readnl)' + character(len=*), parameter :: subname='(shr_fire_emis_readnl)' !------------------------------------------------------------------ namelist /fire_emis_nl/ fire_emis_specifier, fire_emis_factors_file, fire_emis_elevated diff --git a/cesm/nuopc_cap_share/shr_megan_mod.F90 b/cesm/nuopc_cap_share/shr_megan_mod.F90 index ee01d3719..4273217c0 100644 --- a/cesm/nuopc_cap_share/shr_megan_mod.F90 +++ b/cesm/nuopc_cap_share/shr_megan_mod.F90 @@ -128,7 +128,7 @@ subroutine shr_megan_readnl( NLFileName, megan_nflds) integer :: rc integer :: i, tmp(1) character(*), parameter :: F00 = "('(shr_megan_readnl) ',2a)" - character(len=*), parameter :: subname = '('//__FILE__//':shr_megan_readnl)' + character(len=*), parameter :: subname='(shr_megan_readnl)' !-------------------------------------------------------------- namelist /megan_emis_nl/ megan_specifier, megan_factors_file, megan_mapped_emisfctrs diff --git a/cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 b/cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 index 0600b062f..fbd601c3c 100644 --- a/cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 +++ b/cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 @@ -54,7 +54,7 @@ subroutine shr_ozone_coupling_readnl(NLFilename, atm_ozone_frequency_val) integer :: mpicom character(len=*), parameter :: atm_ozone_frequency_not_present = 'NOT_PRESENT' - character(len=*), parameter :: subname = '('//__FILE__//':shr_ozone_coupling_readnl)' + character(len=*), parameter :: subname = '(shr_ozone_coupling_readnl) ' ! ------------------------------------------------------------------ namelist /ozone_coupling_nl/ atm_ozone_frequency diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 49eb08d33..923e9afa8 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -2023,30 +2023,6 @@ pio blocksize for box decompositions - - integer - 0 - run_pio - env_mach_pes.xml - Task count for asyncronous IO, only valid if PIO_ASYNC_INTERFACE is True - - - - integer - 0 - run_pio - env_mach_pes.xml - Stride of tasks for asyncronous IO, only valid if PIO_ASYNC_INTERFACE is True - - - - integer - 1 - run_pio - env_mach_pes.xml - RootPE of tasks for asyncronous IO, only valid if PIO_ASYNC_INTERFACE is True - - integer -1 diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 2fd8c6e3c..e35ff537d 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -36,42 +36,6 @@ - - integer - pio - PELAYOUT_attributes - - IO tasks FOR ASYNC IO, only valid if ASYNCIO is true. - - - $PIO_ASYNCIO_NTASKS - - - - - integer - pio - PELAYOUT_attributes - - IO task stride FOR ASYNC IO, only valid if ASYNCIO is true. - - - $PIO_ASYNCIO_STRIDE - - - - - integer - pio - PELAYOUT_attributes - - IO rootpe task FOR ASYNC IO, only valid if ASYNCIO is true. - - - $PIO_ASYNCIO_ROOTPE - - - char expdef @@ -4022,7 +3986,6 @@ $ESMF_VERBOSITY_LEVEL - char mapping @@ -4146,7 +4109,7 @@ $ROF_PIO_REARRANGER $GLC_PIO_REARRANGER $WAV_PIO_REARRANGER - $ESP_PIO_REARRANGER + -99 diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index a96fcfdd6..36dda2519 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -103,7 +103,7 @@ subroutine med_fldList_AddFld(flds, stdname, shortname) logical :: found integer :: mapsize, mrgsize type(med_fldList_entry_type), pointer :: newflds(:) - character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_AddFld)' + character(len=*), parameter :: subname='(med_fldList_AddFld)' ! ---------------------------------------------- if (associated(flds)) then @@ -210,7 +210,7 @@ subroutine med_fldList_AddMrg(flds, fldname, mrg_from, mrg_fld, mrg_type, mrg_fr ! local variables integer :: n, id - character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_AddMrg)' + character(len=*), parameter :: subname='(med_fldList_AddMrg)' ! ---------------------------------------------- id = 0 @@ -255,7 +255,7 @@ subroutine med_fldList_AddMap(flds, fldname, destcomp, maptype, mapnorm, mapfile integer :: id, n integer :: rc character(len=CX) :: lmapfile - character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_AddMap)' + character(len=*),parameter :: subname='(med_fldList_AddMap)' ! ---------------------------------------------- lmapfile = 'unset' if (present(mapfile)) lmapfile = mapfile @@ -334,7 +334,7 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num character(ESMF_MAXSTR), pointer :: ConnectedList(:) character(ESMF_MAXSTR), pointer :: NameSpaceList(:) character(ESMF_MAXSTR), pointer :: itemNameList(:) - character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_Realize)' + character(len=*),parameter :: subname='(med_fldList_Realize)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -488,7 +488,7 @@ subroutine SetScalarField(field, flds_scalar_name, flds_scalar_num, rc) ! local variables type(ESMF_Distgrid) :: distgrid type(ESMF_Grid) :: grid - character(len=*), parameter :: subname = '('//__FILE__//':SetScalarField)' + character(len=*), parameter :: subname='(SetScalarField)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -525,7 +525,7 @@ subroutine med_fldList_GetFldInfo_general(fldList, fldindex, stdname, shortname) character(len=*) , intent(out) :: shortname ! local variables - character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_GetFldInfo_general)' + character(len=*), parameter :: subname='(med_fldList_GetFldInfo_general)' ! ---------------------------------------------- stdname = fldList%flds(fldindex)%stdname @@ -544,7 +544,7 @@ subroutine med_fldList_GetFldInfo_stdname(fldList, fldindex_in, stdname_out) character(len=*) , intent(out) :: stdname_out ! local variables - character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_GetFldInfo_stdname)' + character(len=*), parameter :: subname='(med_fldList_GetFldInfo_stdname)' ! ---------------------------------------------- stdname_out = fldList%flds(fldindex_in)%stdname @@ -562,7 +562,7 @@ subroutine med_fldList_GetFldInfo_index(fldList, stdname_in, fldindex_out) ! local variables integer :: n - character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_GetFldInfo_index)' + character(len=*), parameter :: subname='(med_fldList_GetFldInfo_index)' ! ---------------------------------------------- fldindex_out = 0 @@ -588,7 +588,7 @@ subroutine med_fldList_GetFldInfo_merging(fldList, fldindex, compsrc, merge_fiel character(len=*) , intent(out) :: merge_fracname ! local variables - character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_GetFldInfo_merging)' + character(len=*), parameter :: subname='(med_fldList_GetFldInfo_merging)' ! ---------------------------------------------- merge_field = fldList%flds(fldindex)%merge_fields(compsrc) @@ -666,7 +666,7 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active) character(len=CL) :: mrgstr character(len=CL) :: cvalue logical :: init_mrgstr - character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_Document_Mapping)' + character(len=*),parameter :: subname = '(med_fldList_Document_Mapping)' !----------------------------------------------------------- !--------------------------------------- @@ -763,7 +763,7 @@ subroutine med_fldList_Document_Merging(logunit, med_coupling_active) character(len=CS) :: string character(len=CL) :: mrgstr logical :: init_mrgstr - character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_Document_Merging)' + character(len=*),parameter :: subname = '(med_fldList_Document_Mapping)' !----------------------------------------------------------- write(logunit,*) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index ff8fc32ed..48ac2a2ed 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -95,7 +95,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) character(len=CS) :: name logical :: wavice_coupling logical :: ocn2glc_coupling - character(len=*), parameter :: subname = '('//__FILE__//':esmFldsExchange_cesm)' + character(len=*) , parameter :: subname=' (esmFldsExchange_cesm) ' !-------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 2197fc81d..bfa23dc25 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -58,7 +58,7 @@ subroutine esmFldsExchange_hafs(gcomp, phase, rc) integer , intent(inout) :: rc ! local variables: - character(len=*), parameter :: subname = '('//__FILE__//':esmFldsExchange_hafs)' + character(len=*) , parameter :: subname='(esmFldsExchange_hafs)' !-------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -106,7 +106,7 @@ subroutine esmFldsExchange_hafs_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 = '('//__FILE__//':esmFldsExchange_hafs_advt)' + character(len=*) , parameter :: subname='(esmFldsExchange_hafs_advt)' !-------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -261,7 +261,7 @@ subroutine esmFldsExchange_hafs_fchk(gcomp, phase, rc) ! local variables: type(InternalState) :: is_local - character(len=*), parameter :: subname = '('//__FILE__//':esmFldsExchange_hafs_fchk)' + character(len=*) , parameter :: subname='(esmFldsExchange_hafs_fchk)' !-------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -319,7 +319,7 @@ subroutine esmFldsExchange_hafs_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 = '('//__FILE__//':esmFldsExchange_hafs_init)' + character(len=*) , parameter :: subname='(esmFldsExchange_hafs_init)' !-------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -498,7 +498,7 @@ subroutine esmFldsExchange_hafs_attr(gcomp, hafs_attr, rc) integer :: verbosity, diagnostic character(len=CL) :: cvalue logical :: isPresent, isSet - character(len=*), parameter :: subname = '('//__FILE__//':esmFldsExchange_hafs_attr)' + character(len=*) , parameter :: subname='(esmFldsExchange_hafs_attr)' !-------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index dbd34d797..9fe5b70ba 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -51,7 +51,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) character(len=CL) :: cvalue character(len=CS) :: fldname character(len=CS), allocatable :: flds(:), oflds(:), aflds(:), iflds(:) - character(len=*), parameter :: subname = '('//__FILE__//':esmFldsExchange_nems)' + character(len=*) , parameter :: subname='(esmFldsExchange_nems)' !-------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med.F90 b/mediator/med.F90 index 176ae8b2f..ac92f2638 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -59,7 +59,7 @@ module MED public SetServices public SetVM private InitializeP0 - private AdvertiseFields ! advertise fields + private InitializeIPDv03p1 ! advertise fields private InitializeIPDv03p3 ! realize connected Fields with transfer action "provide" private InitializeIPDv03p4 ! optionally modify the decomp/distr of transferred Grid/Mesh private InitializeIPDv03p5 ! realize all Fields with transfer action "accept" @@ -129,7 +129,7 @@ subroutine SetServices(gcomp, rc) integer, intent(out) :: rc ! local variables - character(len=*), parameter :: subname = '('//__FILE__//':SetServices)' + character(len=*),parameter :: subname=' (SetServices) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -161,7 +161,7 @@ subroutine SetServices(gcomp, rc) ! The valid values are: [will provide, can provide, cannot provide] call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p1"/), userRoutine=AdvertiseFields, rc=rc) + phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeIPDv03p1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ @@ -568,7 +568,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) character(len=CX) :: logfile character(len=CX) :: diagfile character(len=CX) :: do_budgets - character(len=*), parameter :: subname = '('//__FILE__//':InitializeP0)' + character(len=*),parameter :: subname=' (InitializeP0) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -647,7 +647,7 @@ end subroutine InitializeP0 !----------------------------------------------------------------------- - subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) + subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) ! Mediator advertises its import and export Fields and sets the ! TransferOfferGeomObject Attribute. @@ -677,7 +677,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) character(len=8) :: cnum type(InternalState) :: is_local integer :: stat - character(len=*), parameter :: subname = '('//__FILE__//':AdvertiseFields)' + character(len=*),parameter :: subname=' (Advertise Fields) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -912,7 +912,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - end subroutine AdvertiseFields + end subroutine InitializeIPDv03p1 !----------------------------------------------------------------------------- @@ -936,7 +936,7 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) type(InternalState) :: is_local type(ESMF_VM) :: vm integer :: n - character(len=*), parameter :: subname = '('//__FILE__//':InitializeIPDv03p3)' + character(len=*),parameter :: subname=' (Realize Fields with Transfer Provide) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -997,7 +997,7 @@ subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) ! local variables type(InternalState) :: is_local integer :: n1,n2 - character(len=*), parameter :: subname = '('//__FILE__//':InitializeIPDv03p4)' + character(len=*),parameter :: subname=' (Modify Decomp of Mesh/Grid) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1064,7 +1064,7 @@ subroutine realizeConnectedGrid(State,string,rc) integer , allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) character(ESMF_MAXSTR) , allocatable :: fieldNameList(:) type(ESMF_DistGridConnection) , allocatable :: connectionList(:) - character(len=*), parameter :: subname = '('//__FILE__//':realizeConnectedGrid)' + character(len=*),parameter :: subname=' (realizeConnectedGrid) ' !----------------------------------------------------------- ! All of the Fields that set their TransferOfferGeomObject Attribute @@ -1325,7 +1325,7 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) ! local variables type(InternalState) :: is_local integer :: n1,n2 - character(len=*), parameter :: subname = '('//__FILE__//':InitializeIPDv03p5)' + character(len=*),parameter :: subname=' (Realize Fields with Transfer Accept) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1397,7 +1397,7 @@ subroutine completeFieldInitialization(State,rc) integer, allocatable :: ungriddedLBound(:), ungriddedUBound(:) logical :: isPresent logical :: meshcreated - character(len=*), parameter :: subname = '('//__FILE__//':completeFieldInitialization)' + character(len=*),parameter :: subname=' (Complete Field Initialization) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1593,7 +1593,7 @@ subroutine DataInitialize(gcomp, rc) logical,save :: first_call = .true. real(r8) :: real_nx, real_ny character(len=CX) :: msgString - character(len=*), parameter :: subname = '('//__FILE__//':DataInitialize)' + character(len=*), parameter :: subname=' (Data Initialization) ' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -2202,7 +2202,7 @@ subroutine SetRunClock(gcomp, rc) logical, save :: stopalarmcreated=.false. integer :: alarmcount - character(len=*), parameter :: subname = '('//__FILE__//':SetRunClock)' + character(len=*),parameter :: subname=' (Set Run Clock) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -2287,7 +2287,7 @@ subroutine med_meshinfo_create(FB, mesh_info, FBArea, rc) real(r8), allocatable :: ownedElemCoords(:) real(r8), pointer :: dataptr(:) integer :: n, dimcount, fieldcount - character(len=*), parameter :: subname = '('//__FILE__//':med_meshinfo_create)' + character(len=*),parameter :: subname=' (module_MED:med_meshinfo_create) ' !------------------------------------------------------------------------------- rc= ESMF_SUCCESS @@ -2360,7 +2360,7 @@ subroutine med_grid_write(grid, fileName, rc) type(ESMF_ArrayBundle) :: arrayBundle integer :: tileCount logical :: isPresent - character(len=*), parameter :: subname = '('//__FILE__//':med_grid_write)' + character(len=*), parameter :: subname=' (Grid Write) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index b3ff0d710..2792d0a26 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -2751,7 +2751,7 @@ subroutine add_to_budget_diag(entries, index, name) integer :: oldsize logical :: found type(budget_diag_type), pointer :: new_entries(:) - character(len=*), parameter :: subname = '('//__FILE__//':add_to_budget_diag)' + character(len=*), parameter :: subname='(add_to_budget_diag)' !---------------------------------------------------------------------- if (associated(entries)) then diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 98e50a2d2..521ba0007 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -182,7 +182,7 @@ subroutine med_fraction_init(gcomp, rc) integer :: maptype integer :: fieldCount logical, save :: first_call = .true. - character(len=*), parameter :: subname = '('//__FILE__//':med_fraction_init)' + character(len=*),parameter :: subname=' (med_fraction_init)' !--------------------------------------- call t_startf('MED:'//subname) @@ -674,7 +674,7 @@ subroutine med_fraction_set(gcomp, rc) type(ESMF_Field) :: field_dst integer :: n integer :: maptype - character(len=*), parameter :: subname = '('//__FILE__//':med_fraction_set)' + character(len=*),parameter :: subname=' (med_fraction_set)' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 718064877..99baa2fe1 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -218,7 +218,7 @@ subroutine med_internalstate_init(gcomp, rc) character(len=CX) :: msgString character(len=3) :: name integer :: num_icesheets - character(len=*), parameter :: subname = '('//__FILE__//':med_internalstate_init)' + character(len=*),parameter :: subname=' (internalstate init) ' !----------------------------------------------------------- nullify(is_local%wrap) @@ -395,7 +395,7 @@ subroutine med_internalstate_coupling(gcomp, rc) character(len=CL) :: cvalue character(len=CX) :: msgString logical :: isPresent, isSet - character(len=*), parameter :: subname = '('//__FILE__//':med_internalstate_coupling)' + character(len=*),parameter :: subname=' (internalstate allowed coupling) ' !----------------------------------------------------------- nullify(is_local%wrap) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index ecad003c1..3717f5cba 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -109,7 +109,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun real(R8), pointer :: dataptr(:) type(ESMF_Mesh) :: mesh_src type(ESMF_Mesh) :: mesh_dst - character(len=*), parameter :: subname = '('//__FILE__//':med_map_RouteHandles_initfrom_esmflds)' + character(len=*), parameter :: subname=' (module_med_map: RouteHandles_init) ' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -297,7 +297,7 @@ subroutine med_map_routehandles_initfrom_fieldbundle(n1, n2, FBsrc, FBdst, mapin ! local variables type(ESMF_Field) :: fldsrc type(ESMF_Field) :: flddst - character(len=*), parameter :: subname = '('//__FILE__//':med_map_routehandles_initfrom_fieldbundle)' + character(len=*), parameter :: subname=' (module_MED_map:med_map_routehandles_initfrom_fieldbundle) ' !--------------------------------------------- rc = ESMF_SUCCESS @@ -370,7 +370,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, integer(I4), pointer :: dof(:) integer :: srcTermProcessing_Value = 0 type(ESMF_PoleMethod_Flag) :: polemethod - character(len=*), parameter :: subname = '('//__FILE__//':med_map_routehandles_initfrom_field)' + character(len=*), parameter :: subname=' (module_med_map: med_map_routehandles_initfrom_field) ' !--------------------------------------------- lmapfile = 'unset' @@ -641,7 +641,7 @@ logical function med_map_RH_is_created_RH3d(RHs,n1,n2,mapindex,rc) ! local variables integer :: rc1, rc2 - character(len=*), parameter :: subname = '('//__FILE__//':med_map_routehandles_initfrom_field)' + character(len=*), parameter :: subname=' (module_MED_map:med_map_RH_is_created_RH3d) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -666,7 +666,7 @@ logical function med_map_RH_is_created_RH1d(RHs,mapindex,rc) ! local variables integer :: rc1, rc2 logical :: mapexists - character(len=*), parameter :: subname = '('//__FILE__//':med_map_routehandles_initfrom_field)' + character(len=*), parameter :: subname=' (module_MED_map:med_map_RH_is_created_RH1d) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -736,7 +736,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & character(CL), allocatable :: fieldNameList(:) character(CS) :: mapnorm_mapindex character(len=CX) :: tmpstr - character(len=*), parameter :: subname = '('//__FILE__//':med_map_packed_field_create)' + character(len=*), parameter :: subname=' (module_MED_map:med_packed_field_create) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -937,7 +937,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d type(ESMF_Field) :: udst, vdst ! only used for 3d mapping of u,v real(r8), pointer :: data_norm(:) real(r8), pointer :: data_dst(:,:) - character(len=*), parameter :: subname = '('//__FILE__//':med_map_field_packed)' + character(len=*), parameter :: subname=' (module_MED_map:med_map_field_packed) ' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -1149,7 +1149,7 @@ subroutine med_map_field_normalized(field_src, field_dst, routehandles, maptype, integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields integer :: lsize_src integer :: lsize_dst - character(len=*), parameter :: subname = '('//__FILE__//':med_map_field_normalized)' + character(len=*), parameter :: subname=' (module_MED_map:med_map_field_normalized) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -1262,7 +1262,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r logical :: checkflag = .false. character(len=CS) :: lfldname real(ESMF_KIND_R8), parameter :: fillValue = 9.99e20_ESMF_KIND_R8 - character(len=*), parameter :: subname = '('//__FILE__//':med_map_field)' + character(len=*), parameter :: subname='(module_MED_map:med_map_field) ' !--------------------------------------------------- rc = ESMF_SUCCESS @@ -1365,7 +1365,7 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, rc) integer :: spatialDim real(r8), parameter :: deg2rad = shr_const_pi/180.0_R8 ! deg to rads logical :: first_time = .true. - character(len=*), parameter :: subname = '('//__FILE__//':med_map_uv_cart3d)' + character(len=*), parameter :: subname=' (module_MED_map:med_map_uv_cart3d) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index a62b7c6b9..bd1aa4f80 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -79,7 +79,7 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f real(r8), pointer :: dataptr1d(:) real(r8), pointer :: dataptr2d(:,:) logical :: zero_output - character(len=*), parameter :: subname = '('//__FILE__//':med_merge_auto_multi_fldbuns)' + character(len=*),parameter :: subname=' (module_med_merge_mod: med_merge_auto)' !--------------------------------------- call t_startf('MED:'//subname) @@ -244,7 +244,7 @@ subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo, real(r8), pointer :: dataptr1d(:) real(r8), pointer :: dataptr2d(:,:) logical :: zero_output - character(len=*), parameter :: subname = '('//__FILE__//':med_merge_auto_single_fldbun)' + character(len=*),parameter :: subname=' (module_med_merge_mod: med_merge_auto)' !--------------------------------------- call t_startf('MED:'//subname) @@ -364,7 +364,7 @@ subroutine med_merge_auto_field(merge_type, field_out, ungriddedUBound_out, & real(R8), pointer :: dpf1(:) real(R8), pointer :: dpf2(:,:) ! intput pointers to 1d and 2d fields real(R8), pointer :: dpw1(:) ! weight pointer - character(len=*), parameter :: subname = '('//__FILE__//':med_merge_auto_field)' + character(len=*),parameter :: subname=' (med_merge_mod: med_merge_auto_field)' !--------------------------------------- rc = ESMF_SUCCESS @@ -481,7 +481,7 @@ subroutine med_merge_auto_errcheck(compsrc, fldname_out, field_out, & type(ESMF_Field) :: field_in integer :: ungriddedUBound_in(1) ! size of ungridded dimension, if any character(len=CL) :: errmsg - character(len=*), parameter :: subname = '('//__FILE__//':med_merge_auto_errcheck)' + character(len=*),parameter :: subname=' (module_med_merge_mod: med_merge_errcheck)' !--------------------------------------- rc = ESMF_SUCCESS @@ -572,7 +572,7 @@ subroutine med_merge_field_1D(FBout, fnameout, & integer :: lb1,ub1,i,j,n logical :: wgtfound, FBinfound integer :: dbrc - character(len=*), parameter :: subname = '('//__FILE__//':med_merge_field_1D)' + character(len=*),parameter :: subname='(med_merge_field_1D)' ! ---------------------------------------------- if (dbug_flag > 10) then diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index a15c2d55c..f25b024cd 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -109,7 +109,7 @@ subroutine med_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, r real(R8), pointer :: dataptr1d(:) real(R8), pointer :: dataptr2d(:,:) character(ESMF_MAXSTR), allocatable :: lfieldNameList(:) - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_init_pointer)' + character(len=*), parameter :: subname='(med_methods_FB_init_pointer)' ! ---------------------------------------------- ! Create empty FBout @@ -262,7 +262,7 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S integer, allocatable :: gridToFieldMap(:) logical :: isPresent character(ESMF_MAXSTR), allocatable :: lfieldNameList(:) - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_init)' + character(len=*), parameter :: subname='(med_methods_FB_init)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -540,7 +540,7 @@ subroutine med_methods_FB_getNameN(FB, fieldnum, fieldname, rc) ! local variables integer :: fieldCount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_getNameN)' + character(len=*),parameter :: subname='(med_methods_FB_getNameN)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -586,7 +586,7 @@ subroutine med_methods_FB_getFieldN(FB, fieldnum, field, rc) ! local variables character(len=ESMF_MAXSTR) :: name - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_getFieldN)' + character(len=*),parameter :: subname='(med_methods_FB_getFieldN)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -624,7 +624,7 @@ subroutine med_methods_State_getNameN(State, fieldnum, fieldname, rc) ! local variables integer :: fieldCount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_getNameN)' + character(len=*),parameter :: subname='(med_methods_State_getNameN)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -671,7 +671,7 @@ subroutine med_methods_State_getNumFields(State, fieldnum, rc) ! local variables integer :: n,itemCount type(ESMF_Field), pointer :: fieldList(:) - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_getNumFields)' + character(len=*),parameter :: subname='(med_methods_State_getNumFields)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -718,7 +718,7 @@ subroutine med_methods_FB_reset(FB, value, rc) integer :: lrank real(R8), pointer :: fldptr1(:) real(R8), pointer :: fldptr2(:,:) - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_reset)' + character(len=*),parameter :: subname='(med_methods_FB_reset)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -796,7 +796,7 @@ subroutine med_methods_State_reset(State, value, rc) integer :: lrank real(R8), pointer :: fldptr1(:) real(R8), pointer :: fldptr2(:,:) - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_reset)' + character(len=*),parameter :: subname='(med_methods_State_reset)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -862,7 +862,7 @@ subroutine med_methods_FB_average(FB, count, rc) real(R8), pointer :: dataPtr1(:) real(R8), pointer :: dataPtr2(:,:) type(ESMF_Field) :: lfield - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_average)' + character(len=*),parameter :: subname='(med_methods_FB_average)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -941,7 +941,7 @@ subroutine med_methods_FB_diagnose(FB, string, rc) real(R8), pointer :: dataPtr1d(:) real(R8), pointer :: dataPtr2d(:,:) type(ESMF_Field) :: lfield - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_diagnose)' + character(len=*), parameter :: subname='(med_methods_FB_diagnose)' ! ---------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1021,7 +1021,7 @@ subroutine med_methods_Array_diagnose(array, string, rc) ! local variables character(len=CS) :: lstring real(R8), pointer :: dataPtr3d(:,:,:) - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Array_diagnose)' + character(len=*),parameter :: subname='(med_methods_Array_diagnose)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1075,7 +1075,7 @@ subroutine med_methods_State_diagnose(State, string, rc) real(R8), pointer :: dataPtr1d(:) real(R8), pointer :: dataPtr2d(:,:) type(ESMF_Field) :: lfield - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_diagnose)' + character(len=*),parameter :: subname='(med_methods_State_diagnose)' ! ---------------------------------------------- if (dbug_flag > 5) then @@ -1157,7 +1157,7 @@ subroutine med_methods_FB_Field_diagnose(FB, fieldname, string, rc) real(R8), pointer :: dataPtr2d(:,:) type(ESMF_Field) :: lfield integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_Field_diagnose)' + character(len=*),parameter :: subname='(med_methods_FB_Field_diagnose)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1222,7 +1222,7 @@ subroutine med_methods_Field_diagnose(field, fieldname, string, rc) character(len=CS) :: lstring real(R8), pointer :: dataPtr1d(:) real(R8), pointer :: dataPtr2d(:,:) - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Field_diagnose)' + character(len=*),parameter :: subname='(med_methods_Field_diagnose)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1284,7 +1284,7 @@ subroutine med_methods_FB_copy(FBout, FBin, rc) type(ESMF_FieldBundle), intent(inout) :: FBout type(ESMF_FieldBundle), intent(in) :: FBin integer , intent(out) :: rc - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_copy)' + character(len=*), parameter :: subname='(med_methods_FB_copy)' ! ---------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1327,7 +1327,7 @@ subroutine med_methods_FB_accum(FBout, FBin, copy, rc) real(R8), pointer :: dataPtri2(:,:) real(R8), pointer :: dataPtro2(:,:) type(ESMF_Field) :: lfield - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_accum)' + character(len=*), parameter :: subname='(med_methods_FB_accum)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1439,7 +1439,7 @@ logical function med_methods_FB_FldChk(FB, fldname, rc) integer , intent(out) :: rc ! local variables - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_accum)' + character(len=*), parameter :: subname='(med_methods_FB_FldChk)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1499,7 +1499,7 @@ subroutine med_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abort, rc) integer :: lrank, nnodes, nelements logical :: labort type(ESMF_GeomType_Flag) :: geomtype - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Field_GetFldPtr)' + character(len=*), parameter :: subname='(med_methods_Field_GetFldPtr)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1619,7 +1619,7 @@ subroutine med_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, rank, field, ! local variables type(ESMF_Field) :: lfield integer :: lrank - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_GetFldPtr)' + character(len=*), parameter :: subname='(med_methods_FB_GetFldPtr)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1670,7 +1670,7 @@ logical function med_methods_FieldPtr_Compare1(fldptr1, fldptr2, cstring, rc) integer , intent(out) :: rc ! local variables - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_GetFldPtr)' + character(len=*), parameter :: subname='(med_methods_FieldPtr_Compare1)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1707,7 +1707,7 @@ logical function med_methods_FieldPtr_Compare2(fldptr1, fldptr2, cstring, rc) integer , intent(out) :: rc ! local variables - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_GetFldPtr)' + character(len=*), parameter :: subname='(med_methods_FieldPtr_Compare2)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1750,7 +1750,7 @@ subroutine med_methods_State_GeomPrint(state, string, rc) integer :: fieldcount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) character(ESMF_MAXSTR) :: name - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_GeomPrint)' + character(len=*),parameter :: subname='(med_methods_State_GeomPrint)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1793,7 +1793,7 @@ subroutine med_methods_FB_GeomPrint(FB, string, rc) type(ESMF_Field) :: lfield integer :: fieldcount - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_GeomPrint)' + character(len=*),parameter :: subname='(med_methods_FB_GeomPrint)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1836,7 +1836,7 @@ subroutine med_methods_Field_GeomPrint(field, string, rc) real(R8), pointer :: dataPtr1(:) real(R8), pointer :: dataPtr2(:,:) type(ESMF_GeomType_Flag) :: geomtype - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Field_GeomPrint)' + character(len=*),parameter :: subname='(med_methods_Field_GeomPrint)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1918,7 +1918,7 @@ subroutine med_methods_Mesh_Print(mesh, string, rc) integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) type(ESMF_MeshStatus_Flag) :: meshStatus logical :: elemDGPresent, nodeDGPresent - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Mesh_Print)' + character(len=*),parameter :: subname='(med_methods_Mesh_Print)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -2082,7 +2082,7 @@ subroutine med_methods_Grid_Print(grid, string, rc) real(R8), pointer :: fldptrR81D(:) real(R8), pointer :: fldptrR82D(:,:) integer :: n1,n2,n3 - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Grid_Print)' + character(len=*),parameter :: subname='(med_methods_Grid_Print)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -2209,7 +2209,7 @@ subroutine med_methods_Clock_TimePrint(clock,string,rc) type(ESMF_TimeInterval) :: timeStep character(len=CS) :: timestr character(len=CL) :: lstring - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Clock_TimePrint)' + character(len=*), parameter :: subname='(med_methods_Clock_TimePrint)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -2281,7 +2281,7 @@ subroutine med_methods_State_GetScalar(state, scalar_id, scalar_value, flds_scal type(ESMF_Field) :: field real(R8), pointer :: farrayptr(:,:) real(r8) :: tmp(1) - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_GetScalar)' + character(len=*), parameter :: subname='(med_methods_State_GetScalar)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -2344,7 +2344,7 @@ subroutine med_methods_State_SetScalar(scalar_value, scalar_id, State, flds_scal type(ESMF_Field) :: field type(ESMF_VM) :: vm real(R8), pointer :: farrayptr(:,:) - character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_SetScalar)' + character(len=*), parameter :: subname='(med_methods_State_SetScalar)' ! ---------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 425919646..c0c442a7f 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -178,7 +178,7 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) integer :: n integer :: fieldcount type(InternalState) :: is_local - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_aofluxes_init_fldbuns)' + character(len=*),parameter :: subname=' (med_phases_aofluxes_init_fldbuns) ' !--------------------------------------- ! Create field bundles for mediator ocean/atmosphere flux computation @@ -275,7 +275,7 @@ subroutine med_phases_aofluxes_run(gcomp, rc) type(aoflux_out_type) , save :: aoflux_out logical , save :: aoflux_created logical , save :: first_call = .true. - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_aofluxes_run)' + character(len=*),parameter :: subname=' (med_phases_aofluxes_run) ' !--------------------------------------- rc = ESMF_SUCCESS @@ -505,7 +505,7 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Mesh) :: lmesh real(R8), pointer :: garea(:) => null() type(ESMF_CoordSys_Flag) :: coordSys - character(len=*), parameter :: subname = '('//__FILE__//':med_aofluxes_init_ogrid)' + character(len=*),parameter :: subname=' (med_aofluxes_init_ocngrid) ' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -615,8 +615,7 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Mesh) :: lmesh real(R8), pointer :: garea(:) => null() type(ESMF_CoordSys_Flag) :: coordSys - character(len=*), parameter :: subname = '('//__FILE__//':med_aofluxes_init_agrid)' - + character(len=*),parameter :: subname=' (med_aofluxes_init_atmgrid) ' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -776,7 +775,7 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_CoordSys_Flag) :: coordSys real(ESMF_KIND_R8) ,allocatable :: garea(:) character(ESMF_MAXSTR),allocatable :: fieldNameList(:) - character(len=*), parameter :: subname = '('//__FILE__//':med_aofluxes_init_xgrid)' + character(len=*),parameter :: subname=' (med_aofluxes_init_xgrid) ' !----------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 7fed47fe4..7cfc6fc89 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -181,7 +181,7 @@ subroutine med_phases_history_write(gcomp, rc) type(ESMF_TimeInterval) :: ringInterval integer :: ringInterval_length logical :: first_time = .true. - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_write)' + character(len=*), parameter :: subname='(med_phases_history_write)' !--------------------------------------- rc = ESMF_SUCCESS @@ -402,7 +402,7 @@ subroutine med_phases_history_write_med(gcomp, rc) character(CL) :: hist_n_in logical :: isPresent logical :: isSet - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_write_med)' + character(len=*), parameter :: subname='(med_phases_history_write_med)' !--------------------------------------- rc = ESMF_SUCCESS @@ -544,7 +544,7 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) character(len=CL) :: hist_file integer :: m logical :: isPresent, isSet - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_write_lnd2glc)' + character(len=*), parameter :: subname='(med_phases_history_write_lnd2glc)' !--------------------------------------- rc = ESMF_SUCCESS @@ -680,7 +680,7 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) real(r8) :: time_bnds(2) ! time bounds output logical :: write_now ! true => write to history type real(r8) :: tbnds(2) ! CF1.0 time bounds - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_write_comp_inst)' + character(len=*), parameter :: subname='(med_phases_history_write_inst_comp)' !--------------------------------------- rc = ESMF_SUCCESS @@ -839,7 +839,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) logical :: write_now ! true => write to history type real(r8) :: tbnds(2) ! CF1.0 time bounds character(CS) :: scalar_name - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_write_comp_avg)' + character(len=*), parameter :: subname='(med_phases_history_write_comp_avg)' !--------------------------------------- rc = ESMF_SUCCESS @@ -1059,7 +1059,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output character(CS), allocatable :: fieldNameList(:) - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_write_comp_aux)' + character(len=*), parameter :: subname='(med_phases_history_write_comp_aux)' !--------------------------------------- rc = ESMF_SUCCESS @@ -1531,7 +1531,7 @@ subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hi type(ESMF_TimeInterval) :: htimestep type(ESMF_TimeInterval) :: mtimestep, dtimestep integer :: msec, dsec - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_init_histclock)' + character(len=*), parameter :: subname='(med_phases_history_init_histclock) ' !--------------------------------------- rc = ESMF_SUCCESS @@ -1593,7 +1593,7 @@ subroutine med_phases_history_query_ifwrite(gcomp, hclock, alarmname, write_now, integer :: yr,mon,day,sec ! time units type(ESMF_TimeInterval) :: ringInterval integer :: ringInterval_length - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_query_ifwrite)' + character(len=*), parameter :: subname='(med_phases_history_query_ifwrite) ' !--------------------------------------- rc = ESMF_SUCCESS @@ -1707,7 +1707,7 @@ subroutine med_phases_history_set_timeinfo(gcomp, hclock, alarmname, & integer :: start_ymd ! Starting date YYYYMMDD logical :: isPresent logical :: isSet - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_set_timeinfo)' + character(len=*), parameter :: subname='(med_phases_history_set_timeinfo) ' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index b9c38b957..1fe8fb502 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -252,7 +252,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) real(R8), parameter :: const_deg2rad = shr_const_pi/180.0_R8 ! deg to rads character(CL) :: msg logical :: first_call = .true. - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_ocnalb_run)' + character(len=*) , parameter :: subname='(med_phases_ocnalb_run)' !--------------------------------------- rc = ESMF_SUCCESS @@ -463,7 +463,7 @@ subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, mastertask, rc) ! local variables character(len=CL) :: msgstr ! temporary character(len=CL) :: cvalue ! temporary - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_ocnalb_orbital_init)' + character(len=*) , parameter :: subname = "(med_phases_ocnalb_orbital_init)" !------------------------------------------- rc = ESMF_SUCCESS @@ -570,7 +570,7 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, character(len=CL) :: msgstr ! temporary logical :: lprint logical :: first_time = .true. - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_ocnalb_orbital_update)' + character(len=*) , parameter :: subname = "(med_phases_ocnalb_orbital_update)" !------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index 1be463731..ab6f65e2b 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -43,7 +43,7 @@ subroutine med_phases_post_atm(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_atm)' + character(len=*), parameter :: subname='(med_phases_post_atm)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index e01bddf8d..14610e710 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -98,7 +98,7 @@ subroutine med_phases_post_glc(gcomp, rc) logical :: first_call = .true. logical :: isPresent character(CL) :: cvalue - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_glc)' + character(len=*), parameter :: subname='(med_phases_post_glc)' !--------------------------------------- rc = ESMF_SUCCESS @@ -246,7 +246,7 @@ subroutine map_glc2lnd_init(gcomp, rc) integer :: fieldCount integer :: ns,n type(ESMF_Field), pointer :: fieldlist(:) - character(len=*), parameter :: subname = '('//__FILE__//':map_glc2lnd_init)' + character(len=*) , parameter :: subname='(map_glc2lnd_init)' !--------------------------------------- rc = ESMF_SUCCESS @@ -383,7 +383,7 @@ subroutine map_glc2lnd( gcomp, rc) real(r8), pointer :: dataptr1d_src(:) real(r8), pointer :: dataptr1d_dst(:) real(r8), pointer :: icemask_l(:) - character(len=*), parameter :: subname = '('//__FILE__//':map_glc2lnd)' + character(len=*), parameter :: subname = 'map_glc2lnd' !----------------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_post_ice_mod.F90 b/mediator/med_phases_post_ice_mod.F90 index fc4c84dfc..d081448e4 100644 --- a/mediator/med_phases_post_ice_mod.F90 +++ b/mediator/med_phases_post_ice_mod.F90 @@ -40,7 +40,7 @@ subroutine med_phases_post_ice(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_ice)' + character(len=*),parameter :: subname='(med_phases_post_ice)' !------------------------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_post_lnd_mod.F90 b/mediator/med_phases_post_lnd_mod.F90 index 49bd90255..d057506af 100644 --- a/mediator/med_phases_post_lnd_mod.F90 +++ b/mediator/med_phases_post_lnd_mod.F90 @@ -37,7 +37,7 @@ subroutine med_phases_post_lnd(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_lnd)' + character(len=*),parameter :: subname='(med_phases_post_lnd)' !------------------------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_post_ocn_mod.F90 b/mediator/med_phases_post_ocn_mod.F90 index a883890ca..abf766211 100644 --- a/mediator/med_phases_post_ocn_mod.F90 +++ b/mediator/med_phases_post_ocn_mod.F90 @@ -39,7 +39,7 @@ subroutine med_phases_post_ocn(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_ocn)' + character(len=*),parameter :: subname='(med_phases_post_ocn)' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index 0d5999cf0..ea478b0cc 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -36,7 +36,7 @@ subroutine med_phases_post_rof(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_rof)' + character(len=*), parameter :: subname='(med_phases_post_rof)' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_post_wav_mod.F90 b/mediator/med_phases_post_wav_mod.F90 index 57d0e61ab..31abf004c 100644 --- a/mediator/med_phases_post_wav_mod.F90 +++ b/mediator/med_phases_post_wav_mod.F90 @@ -35,7 +35,7 @@ subroutine med_phases_post_wav(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_wav)' + character(len=*),parameter :: subname='(med_phases_post_wav)' !------------------------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 9c44d9a75..8d41adbb8 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -53,7 +53,7 @@ subroutine med_phases_prep_atm(gcomp, rc) real(R8), pointer :: ifrac(:) real(R8), pointer :: ofrac(:) integer :: i, j, n, n1, ncnt - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_atm)' + character(len=*),parameter :: subname='(med_phases_prep_atm)' !------------------------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index a30b0118d..d47bbf46c 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -146,7 +146,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) character(len=CS) :: glc_renormalize_smb logical :: glc_coupled_fluxes integer :: ungriddedUBound_output(1) ! currently the size must equal 1 for rank 2 fieldds - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_glc_init)' + character(len=*),parameter :: subname=' (med_phases_prep_glc_init) ' !--------------------------------------- call t_startf('MED:'//subname) @@ -400,7 +400,7 @@ subroutine med_phases_prep_glc_accum_lnd(gcomp, rc) integer :: i,n real(r8), pointer :: data2d_in(:,:) real(r8), pointer :: data2d_out(:,:) - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_glc_accum_lnd)' + character(len=*),parameter :: subname=' (med_phases_prep_glc_accum) ' !--------------------------------------- call t_startf('MED:'//subname) @@ -458,7 +458,7 @@ subroutine med_phases_prep_glc_accum_ocn(gcomp, rc) integer :: i,n real(r8), pointer :: data2d_in(:,:) real(r8), pointer :: data2d_out(:,:) - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_glc_accum_ocn)' + character(len=*),parameter :: subname=' (med_phases_prep_glc_accum) ' !--------------------------------------- call t_startf('MED:'//subname) @@ -531,7 +531,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) logical :: do_avg logical :: isPresent, isSet logical :: write_histaux_l2x1yrg - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_glc_avg)' + character(len=*) , parameter :: subname=' (med_phases_prep_glc) ' !--------------------------------------- call t_startf('MED:'//subname) @@ -771,7 +771,7 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) character(len=3) :: cnum type(ESMF_Field), pointer :: fieldlist_lnd(:) type(ESMF_Field), pointer :: fieldlist_glc(:) - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_glc_map_lnd2glc)' + character(len=*) , parameter :: subname=' (med_phases_prep_glc_map_lnd2glc) ' !--------------------------------------- ! Get the internal state @@ -1063,7 +1063,7 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) real(r8) :: ablat_renorm_factor ! ratio between global ablation on the two grids real(r8) :: effective_area ! grid cell area multiplied by min(lfrac,icemask_l). real(r8), pointer :: area_g(:) ! areas on glc grid - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_glc_renormalize_smb)' + character(len=*), parameter :: subname=' (renormalize_smb) ' !--------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 4144225ae..0d78bbed0 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -59,7 +59,7 @@ subroutine med_phases_prep_ice(gcomp, rc) integer :: scalar_id real(r8) :: tmp(1) logical :: first_precip_fact_call = .true. - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_ice)' + character(len=*),parameter :: subname='(med_phases_prep_ice)' !--------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 4c27a4c38..81114c1bf 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -51,7 +51,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) logical :: first_call = .true. real(r8), pointer :: dataptr_scalar_lnd(:,:) real(r8), pointer :: dataptr_scalar_atm(:,:) - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_lnd)' + character(len=*), parameter :: subname='(med_phases_prep_lnd)' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 353350d73..35208a109 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -51,7 +51,7 @@ subroutine med_phases_prep_ocn_init(gcomp, rc) ! local variables type(InternalState) :: is_local - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_ocn_init)' + character(len=*),parameter :: subname=' (med_phases_prep_ocn_init) ' !--------------------------------------- rc = ESMF_SUCCESS @@ -99,7 +99,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) real(r8), pointer :: rofi(:), hrofi(:) real(r8), pointer :: areas(:) real(r8), allocatable :: hcorr(:) - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_ocn_accum)' + character(len=*), parameter :: subname='(med_phases_prep_ocn_accum)' !--------------------------------------- call t_startf('MED:'//subname) @@ -254,7 +254,7 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: ncnt - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_ocn_avg)' + character(len=*),parameter :: subname='(med_phases_prep_ocn_avg)' !--------------------------------------- rc = ESMF_SUCCESS @@ -365,7 +365,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) integer :: lsize real(R8) :: c1,c2,c3,c4 character(len=64), allocatable :: fldnames(:) - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_ocn_custom_cesm)' + character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_cesm)' !--------------------------------------- rc = ESMF_SUCCESS @@ -631,7 +631,7 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) real(R8), pointer :: ofrac(:) integer :: lsize real(R8) , parameter :: const_lhvap = 2.501e6_R8 ! latent heat of evaporation ~ J/kg - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_ocn_custom_nems)' + character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_nems)' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 008a2ae1b..e64eea43b 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -94,7 +94,7 @@ subroutine med_phases_prep_rof_init(gcomp, rc) type(ESMF_Mesh) :: mesh_r type(ESMF_Field) :: lfield character(len=CS), allocatable :: fldnames_temp(:) - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_rof_init)' + character(len=*),parameter :: subname=' (med_phases_prep_rof_init) ' !--------------------------------------- rc = ESMF_SUCCESS @@ -198,7 +198,7 @@ subroutine med_phases_prep_rof_accum(gcomp, rc) real(r8), pointer :: dataptr1d_accum(:) type(ESMF_Field) :: lfield type(ESMF_Field) :: lfield_accum - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_rof_accum)' + character(len=*), parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof_accum)' !--------------------------------------- call t_startf('MED:'//subname) @@ -281,7 +281,7 @@ subroutine med_phases_prep_rof(gcomp, rc) type(ESMF_Field) :: lfield_dst type(ESMF_Field) :: field_lfrac_lnd character(CL), pointer :: lfieldnamelist(:) - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_rof)' + character(len=*),parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof)' !--------------------------------------- call t_startf('MED:'//subname) @@ -462,7 +462,7 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) real(r8), pointer :: irrig_volr0_r(:) real(r8), pointer :: irrig_flux_l(:) real(r8), pointer :: irrig_flux_r(:) - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_rof_irrig)' + character(len=*), parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof_irrig)' !--------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 29eeecc32..a1bd85c1b 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -46,7 +46,7 @@ subroutine med_phases_prep_wav_init(gcomp, rc) ! local variables type(InternalState) :: is_local - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_wav_init)' + character(len=*),parameter :: subname=' (med_phases_prep_wav_init) ' !--------------------------------------- rc = ESMF_SUCCESS @@ -82,7 +82,7 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n, ncnt - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_wav_accum)' + character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' !--------------------------------------- call t_startf('MED:'//subname) @@ -138,7 +138,7 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: ncnt - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_wav_avg)' + character(len=*),parameter :: subname='(med_phases_prep_wav_avg)' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_profile_mod.F90 b/mediator/med_phases_profile_mod.F90 index 9876127ed..46d8f2a73 100644 --- a/mediator/med_phases_profile_mod.F90 +++ b/mediator/med_phases_profile_mod.F90 @@ -65,7 +65,7 @@ subroutine med_phases_profile(gcomp, rc) real(r8) :: msize, mrss, ringdays real(r8), save :: avgdt character(len=CL) :: walltimestr, nexttimestr - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_profile)' + character(len=*), parameter :: subname='(med_phases_profile)' !--------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 27bead2d8..5affb149a 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -66,7 +66,7 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) integer :: restart_n ! freq_n setting relative to freq_option logical :: isPresent logical :: isSet - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_restart_alarm_init)' + character(len=*), parameter :: subname='(med_phases_restart_alarm_init)' !--------------------------------------- rc = ESMF_SUCCESS @@ -182,7 +182,7 @@ subroutine med_phases_restart_write(gcomp, rc) character(ESMF_MAXSTR) :: tmpstr logical :: isPresent logical :: first_time = .true. - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_restart_write)' + character(len=*), parameter :: subname='(med_phases_restart_write)' !--------------------------------------- call t_startf('MED:'//subname) @@ -503,7 +503,7 @@ subroutine med_phases_restart_read(gcomp, rc) character(ESMF_MAXSTR) :: restart_pfile ! Local path to restart pointer filename character(ESMF_MAXSTR) :: cpl_inst_tag ! instance tag logical :: isPresent - character(len=*), parameter :: subname = '('//__FILE__//':med_phases_restart_read)' + character(len=*), parameter :: subname='(med_phases_restart_read)' !--------------------------------------- call t_startf('MED:'//subname) call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index 5bb15b574..14cd7464b 100644 --- a/mediator/med_time_mod.F90 +++ b/mediator/med_time_mod.F90 @@ -87,7 +87,7 @@ subroutine med_time_alarmInit( clock, alarm, option, & type(ESMF_Time) :: NextAlarm ! Next alarm time type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval integer :: sec - character(len=*), parameter :: subname = '('//__FILE__//':med_time_alarmInit)' + character(len=*), parameter :: subname = '(med_time_alarmInit): ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS From 978e0f2c39b7f17c144cf5890f37f80a0cdb01c5 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 12 Oct 2022 13:37:05 -0600 Subject: [PATCH 116/395] was not working when atm and lnd did not share all tasks --- cesm/nuopc_cap_share/shr_drydep_mod.F90 | 323 +++++++++++++----------- 1 file changed, 170 insertions(+), 153 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_drydep_mod.F90 b/cesm/nuopc_cap_share/shr_drydep_mod.F90 index ae67df4f9..8b6464da4 100644 --- a/cesm/nuopc_cap_share/shr_drydep_mod.F90 +++ b/cesm/nuopc_cap_share/shr_drydep_mod.F90 @@ -6,15 +6,17 @@ module shr_drydep_mod ! dry deposition of tracers !======================================================================== - use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet + use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet, ESMF_LOGMSG_INFO use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS + use ESMF , only : ESMF_LogWrite, ESMF_VMBroadCast use shr_sys_mod , only : shr_sys_abort use shr_kind_mod , only : r8 => shr_kind_r8, CS => SHR_KIND_CS, CX => SHR_KIND_CX use shr_const_mod , only : SHR_CONST_MWWV - use shr_mpi_mod , only : shr_mpi_bcast use shr_nl_mod , only : shr_nl_find_group_name use shr_log_mod , only : s_logunit => shr_log_Unit + use shr_file_mod , only : shr_file_getLogUnit use shr_infnan_mod , only : shr_infnan_posinf, assignment(=) + use nuopc_shr_methods, only : chkerr implicit none private @@ -32,8 +34,6 @@ module shr_drydep_mod integer, public, parameter :: NLUse = 11 ! Number of land-use types integer, private, protected :: NHen - logical, private :: drydep_initialized = .false. - ! public data members: real(r8), public, parameter :: ph = 1.e-5_r8 ! measure of the acidity (dimensionless) @@ -222,12 +222,15 @@ module shr_drydep_mod character(len=16), public, protected, allocatable :: species_name_table(:) !--- data for effective Henry's Law coefficient --- - real(r8), public, protected, allocatable :: dheff(:,:) + real(r8), public, protected, allocatable, target :: dheff(:,:) real(r8), private, parameter :: wh2o = SHR_CONST_MWWV real(r8), allocatable :: mol_wgts(:) character(len=500) :: dep_data_file = 'NONE' ! complete file path + character(len=*), parameter :: u_FILE_u = & + __FILE__ + !=============================================================================== CONTAINS @@ -263,6 +266,7 @@ subroutine shr_drydep_readnl(NLFilename, drydep_nflds) ! Read namelist and figure out the drydep field list to pass ! First check if file exists and if not, n_drydep will be zero !----------------------------------------------------------------------------- + call ESMF_LogWrite(subname//' start', ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS @@ -274,10 +278,11 @@ subroutine shr_drydep_readnl(NLFilename, drydep_nflds) 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) + call ESMF_VMGet(vm, localPet=localPet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (localPet==0) then + call shr_file_getLogUnit(s_logunit) inquire( file=trim(NLFileName), exist=exists) if ( exists ) then open(newunit=unitn, file=trim(NLFilename), status='old' ) @@ -293,8 +298,10 @@ subroutine shr_drydep_readnl(NLFilename, drydep_nflds) close( unitn ) end if end if - call shr_mpi_bcast( drydep_list, mpicom ) - call shr_mpi_bcast( dep_data_file, mpicom ) + call ESMF_LogWrite(subname//' bcast drydep_list', ESMF_LOGMSG_INFO) + call ESMF_VMBroadcast(vm, drydep_list, maxspc*32, 0) + call ESMF_LogWrite(subname//' bcast dep_data_file', ESMF_LOGMSG_INFO) + call ESMF_VMBroadcast(vm, dep_data_file, 500, 0) drydep_nflds = 0 @@ -314,25 +321,22 @@ subroutine shr_drydep_readnl(NLFilename, drydep_nflds) write(s_logunit,FI1) 'Number of dry deposition fields transfered is ', drydep_nflds end if end if - - if (.not. drydep_initialized) then - call shr_drydep_init() - end if + call shr_drydep_init() + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine shr_drydep_readnl !==================================================================================== subroutine shr_drydep_init( ) - - use shr_pio_mod, only: shr_pio_getiosys, shr_pio_getiotype - use pio use netcdf !======================================================================== ! Initialization of dry deposition fields ! reads drydep_inparm namelist and sets up CCSM driver list of fields for ! land-atmosphere communications. + ! This is called by both lnd and atm - we need to do this in order to + ! allow for these components to run on disjoint sets of tasks !======================================================================== !----- local ----- @@ -342,26 +346,27 @@ subroutine shr_drydep_init( ) type(ESMF_VM) :: vm integer :: localPet integer :: mpicom + integer :: bint(2) + real(kind=r8), pointer :: dptr(:) integer :: rc + logical, save :: drydep_initialized=.false. + character(len=256) :: msg !----- formats ----- character(*),parameter :: subName = '(shr_drydep_init) ' character(*),parameter :: F00 = "('(shr_drydep_init) ',8a)" - !----------------------------------------------------------------------------- - ! Return if this routine has already been called (e.g. cam and clm both call this) - !----------------------------------------------------------------------------- - if(allocated(foxd)) return + call ESMF_LogWrite(subname//' start', ESMF_LOGMSG_INFO) if (dep_data_file=='NONE' .or. len_trim(dep_data_file)==0) return rc = ESMF_SUCCESS call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) 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 (chkerr(rc,__LINE__,u_FILE_u)) return rc = nf90_noerr @@ -372,23 +377,29 @@ subroutine shr_drydep_init( ) rc = nf90_inq_dimid(fileid,'n_species_table',dimid) if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_dimid n_species_table') - rc = nf90_inquire_dimension(fileid,dimid,len=n_species_table) + rc = nf90_inquire_dimension(fileid,dimid,len=bint(1)) if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inquire_dimension n_species_table') rc = nf90_inq_dimid(fileid,'NHen',dimid) if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_dimid NHen') - rc = nf90_inquire_dimension(fileid,dimid,len=nHen) + rc = nf90_inquire_dimension(fileid,dimid,len=bint(2)) if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inquire_dimension nHen') endif - call shr_mpi_bcast( n_species_table, mpicom ) - call shr_mpi_bcast( nHen, mpicom ) - - allocate( mol_wgts(n_species_table) ) - allocate( dfoxd(n_species_table) ) - allocate( species_name_table(n_species_table) ) - allocate( dheff(nhen,n_species_table)) - + write(msg,*) subname//' bcast n_species_table', localPet, bint + call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO) + call ESMF_VMBroadcast(vm, bint, 2, 0, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + n_species_table = bint(1) + nHen = bint(2) + write(msg,*) subname//' after bcast n_species_table', n_species_table, nhen + call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO) + if(.not. allocated(mol_wgts)) allocate( mol_wgts(n_species_table) ) + if(.not. allocated(dfoxd)) allocate( dfoxd(n_species_table) ) + if(.not. allocated(species_name_table)) allocate( species_name_table(n_species_table) ) + if(.not. allocated(dheff)) allocate( dheff(nhen,n_species_table)) + ! This pointer is needed for ESMF_VMBroadcast + dptr => dheff(:,1) if (localPet==0) then rc = nf90_inq_varid(fileid,'mol_wghts',varid) if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_varid mol_wghts') @@ -413,141 +424,147 @@ subroutine shr_drydep_init( ) rc = nf90_close(fileid) if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_close') end if - call shr_mpi_bcast( mol_wgts, mpicom ) - call shr_mpi_bcast( dfoxd, mpicom ) - call shr_mpi_bcast( species_name_table, mpicom ) - call shr_mpi_bcast( dheff, mpicom ) + call ESMF_LogWrite(subname//' bcast mol_wgts', ESMF_LOGMSG_INFO) + call ESMF_VMBroadcast(vm, mol_wgts, n_species_table, 0, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//' bcast dfoxd', ESMF_LOGMSG_INFO) + call ESMF_VMBroadcast(vm, dfoxd, n_species_table, 0, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//' bcast species_name_table', ESMF_LOGMSG_INFO) + call ESMF_VMBroadcast(vm, species_name_table, 16*n_species_table, 0, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//' bcast dheff', ESMF_LOGMSG_INFO) + call ESMF_VMBroadcast(vm, dptr, nhen*n_species_table, 0, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return !----------------------------------------------------------------------------- ! Allocate and fill foxd, drat and mapping as well as species indices !----------------------------------------------------------------------------- - if ( n_drydep > 0 ) then - - allocate( foxd(n_drydep) ) - allocate( drat(n_drydep) ) - allocate( mapping(n_drydep) ) - - ! This initializes these variables to infinity. - foxd = shr_infnan_posinf - drat = shr_infnan_posinf - - mapping(:) = 0 - - end if - - h2_ndx=-1; ch4_ndx=-1; co_ndx=-1; mpan_ndx = -1; pan_ndx = -1; so2_ndx=-1; o3_ndx=-1; xpan_ndx=-1 - - !--- Loop over drydep species that need to be worked with --- - do i=1,n_drydep - if ( len_trim(drydep_list(i))==0 ) exit - - test_name = drydep_list(i) - - if( trim(test_name) == 'O3' ) then - test_name = 'OX' - end if + if ( .not. drydep_initialized ) then + if (n_drydep > 0) then + allocate( foxd(n_drydep) ) + allocate( drat(n_drydep) ) + allocate( mapping(n_drydep) ) + + ! This initializes these variables to infinity. + foxd = shr_infnan_posinf + drat = shr_infnan_posinf + + mapping(:) = 0 + endif - !--- Figure out if species maps to a species in the species table --- - do l = 1,n_species_table - if( trim( test_name ) == trim( species_name_table(l) ) ) then - mapping(i) = l - exit - end if - end do + h2_ndx=-1; ch4_ndx=-1; co_ndx=-1; mpan_ndx = -1; pan_ndx = -1; so2_ndx=-1; o3_ndx=-1; xpan_ndx=-1 - !--- If it doesn't map to a species in the species table find species close enough --- - if( mapping(i) < 1 ) then - select case( trim(test_name) ) - case( 'O3S', 'O3INERT' ) + !--- Loop over drydep species that need to be worked with --- + do i=1,n_drydep + if ( len_trim(drydep_list(i))==0 ) exit + + test_name = drydep_list(i) + + if( trim(test_name) == 'O3' ) then test_name = 'OX' - case( 'Pb' ) - test_name = 'HNO3' - case( 'SOGM','SOGI','SOGT','SOGB','SOGX' ) - test_name = 'CH3OOH' - case( 'SOA', 'SO4', 'CB1', 'CB2', 'OC1', 'OC2', 'NH4', 'SA1', 'SA2', 'SA3', 'SA4' ) - test_name = 'OX' ! this is just a place holder. values are explicitly set below - case( 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX' ) - test_name = 'OX' ! this is just a place holder. values are explicitly set below - case( 'SOAGbb0' ) - test_name = 'SOAGff0' - case( 'SOAGbb1' ) - test_name = 'SOAGff1' - case( 'SOAGbb2' ) - test_name = 'SOAGff2' - case( 'SOAGbb3' ) - test_name = 'SOAGff3' - case( 'SOAGbb4' ) - test_name = 'SOAGff4' - case( 'O3A' ) - test_name = 'OX' - case( 'XMPAN' ) - test_name = 'MPAN' - case( 'XPAN' ) - test_name = 'PAN' - case( 'XNO' ) - test_name = 'NO' - case( 'XNO2' ) - test_name = 'NO2' - case( 'XHNO3' ) - test_name = 'HNO3' - case( 'XONIT' ) - test_name = 'ONIT' - case( 'XONITR' ) - test_name = 'ONITR' - case( 'XHO2NO2') - test_name = 'HO2NO2' - case( 'XNH4NO3' ) - test_name = 'HNO3' - case( 'NH4NO3' ) - test_name = 'HNO3' - case default - test_name = 'blank' - end select - - !--- If found a match check the species table again --- - if( trim(test_name) /= 'blank' ) then - do l = 1,n_species_table - if( trim( test_name ) == trim( species_name_table(l) ) ) then - mapping(i) = l - exit - end if - end do - else - write(s_logunit,F00) trim(drydep_list(i)),' not in tables; will have dep vel = 0' - call shr_sys_abort( subName//': '//trim(drydep_list(i))//' is not in tables' ) end if - end if - - !--- Figure out the specific species indices --- - if ( trim(drydep_list(i)) == 'H2' ) h2_ndx = i - if ( trim(drydep_list(i)) == 'CO' ) co_ndx = i - if ( trim(drydep_list(i)) == 'CH4' ) ch4_ndx = i - if ( trim(drydep_list(i)) == 'MPAN' ) mpan_ndx = i - if ( trim(drydep_list(i)) == 'PAN' ) pan_ndx = i - if ( trim(drydep_list(i)) == 'SO2' ) so2_ndx = i - if ( trim(drydep_list(i)) == 'OX' .or. trim(drydep_list(i)) == 'O3' ) o3_ndx = i - if ( trim(drydep_list(i)) == 'O3A' ) o3a_ndx = i - if ( trim(drydep_list(i)) == 'XPAN' ) xpan_ndx = i - - if( mapping(i) > 0) then - l = mapping(i) - foxd(i) = dfoxd(l) - drat(i) = sqrt(mol_wgts(l)/wh2o) - endif - - enddo + + !--- Figure out if species maps to a species in the species table --- + do l = 1,n_species_table + if( trim( test_name ) == trim( species_name_table(l) ) ) then + mapping(i) = l + exit + end if + end do + + !--- If it doesn't map to a species in the species table find species close enough --- + if( mapping(i) < 1 ) then + select case( trim(test_name) ) + case( 'O3S', 'O3INERT' ) + test_name = 'OX' + case( 'Pb' ) + test_name = 'HNO3' + case( 'SOGM','SOGI','SOGT','SOGB','SOGX' ) + test_name = 'CH3OOH' + case( 'SOA', 'SO4', 'CB1', 'CB2', 'OC1', 'OC2', 'NH4', 'SA1', 'SA2', 'SA3', 'SA4' ) + test_name = 'OX' ! this is just a place holder. values are explicitly set below + case( 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX' ) + test_name = 'OX' ! this is just a place holder. values are explicitly set below + case( 'SOAGbb0' ) + test_name = 'SOAGff0' + case( 'SOAGbb1' ) + test_name = 'SOAGff1' + case( 'SOAGbb2' ) + test_name = 'SOAGff2' + case( 'SOAGbb3' ) + test_name = 'SOAGff3' + case( 'SOAGbb4' ) + test_name = 'SOAGff4' + case( 'O3A' ) + test_name = 'OX' + case( 'XMPAN' ) + test_name = 'MPAN' + case( 'XPAN' ) + test_name = 'PAN' + case( 'XNO' ) + test_name = 'NO' + case( 'XNO2' ) + test_name = 'NO2' + case( 'XHNO3' ) + test_name = 'HNO3' + case( 'XONIT' ) + test_name = 'ONIT' + case( 'XONITR' ) + test_name = 'ONITR' + case( 'XHO2NO2') + test_name = 'HO2NO2' + case( 'XNH4NO3' ) + test_name = 'HNO3' + case( 'NH4NO3' ) + test_name = 'HNO3' + case default + test_name = 'blank' + end select + + !--- If found a match check the species table again --- + if( trim(test_name) /= 'blank' ) then + do l = 1,n_species_table + if( trim( test_name ) == trim( species_name_table(l) ) ) then + mapping(i) = l + exit + end if + end do + else + write(s_logunit,F00) trim(drydep_list(i)),' not in tables; will have dep vel = 0' + call shr_sys_abort( subName//': '//trim(drydep_list(i))//' is not in tables' ) + end if + end if - where( rgss < 1._r8 ) - rgss = 1._r8 - endwhere + !--- Figure out the specific species indices --- + if ( trim(drydep_list(i)) == 'H2' ) h2_ndx = i + if ( trim(drydep_list(i)) == 'CO' ) co_ndx = i + if ( trim(drydep_list(i)) == 'CH4' ) ch4_ndx = i + if ( trim(drydep_list(i)) == 'MPAN' ) mpan_ndx = i + if ( trim(drydep_list(i)) == 'PAN' ) pan_ndx = i + if ( trim(drydep_list(i)) == 'SO2' ) so2_ndx = i + if ( trim(drydep_list(i)) == 'OX' .or. trim(drydep_list(i)) == 'O3' ) o3_ndx = i + if ( trim(drydep_list(i)) == 'O3A' ) o3a_ndx = i + if ( trim(drydep_list(i)) == 'XPAN' ) xpan_ndx = i + + if( mapping(i) > 0) then + l = mapping(i) + foxd(i) = dfoxd(l) + drat(i) = sqrt(mol_wgts(l)/wh2o) + endif + + enddo - where( rac < small_value) - rac = small_value - endwhere + where( rgss < 1._r8 ) + rgss = 1._r8 + endwhere + where( rac < small_value) + rac = small_value + endwhere + end if drydep_initialized = .true. - end subroutine shr_drydep_init !==================================================================================== From 1ba5eb4f2b91e8037aee6c57eda6da731f7faa42 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 13 Oct 2022 07:16:29 -0600 Subject: [PATCH 117/395] fix a bug introduced in PR 313 --- cesm/driver/esm_time_mod.F90 | 2 +- mediator/med_time_mod.F90 | 89 ++++++++++++++++++------------------ 2 files changed, 46 insertions(+), 45 deletions(-) diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index 7afcbc992..337b7bc56 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -522,7 +522,7 @@ subroutine esm_time_alarmInit( clock, alarm, option, & if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .true. - case (optNYears) + case (optNYears, trim(optNYears)//'s') call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index 14cd7464b..5ba7f30a7 100644 --- a/mediator/med_time_mod.F90 +++ b/mediator/med_time_mod.F90 @@ -28,13 +28,13 @@ module med_time_mod character(len=*), private, parameter :: & optNONE = "none" , & optNever = "never" , & - optNSteps = "nsteps" , & - optNSeconds = "nseconds" , & - optNMinutes = "nminutes" , & - optNHours = "nhours" , & - optNDays = "ndays" , & - optNMonths = "nmonths" , & - optNYears = "nyears" , & + optNSteps = "nstep" , & + optNSeconds = "nsecond" , & + optNMinutes = "nminute" , & + optNHours = "nhour" , & + optNDays = "nday" , & + optNMonths = "nmonth" , & + optNYears = "nyear" , & optMonthly = "monthly" , & optYearly = "yearly" , & optDate = "date" , & @@ -127,13 +127,14 @@ subroutine med_time_alarmInit( clock, alarm, option, & rc = ESMF_FAILURE return end if - else if (trim(option) == optNSteps .or. & - trim(option) == optNSeconds .or. & - trim(option) == optNMinutes .or. & - trim(option) == optNHours .or. & - trim(option) == optNDays .or. & - trim(option) == optNMonths .or. & - trim(option) == optNYears) then + else if (& + trim(option) == optNSteps .or. trim(option) == trim(optNSteps)//'s' .or. & + trim(option) == optNSeconds .or. trim(option) == trim(optNSeconds)//'s' .or. & + trim(option) == optNMinutes .or. trim(option) == trim(optNMinutes)//'s' .or. & + trim(option) == optNHours .or. trim(option) == trim(optNHours)//'s' .or. & + trim(option) == optNDays .or. trim(option) == trim(optNDays)//'s' .or. & + trim(option) == optNMonths .or. trim(option) == trim(optNMonths)//'s' .or. & + trim(option) == optNYears .or. trim(option) == trim(optNYears)//'s' ) then if (.not.present(opt_n)) then call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE @@ -179,40 +180,40 @@ subroutine med_time_alarmInit( clock, alarm, option, & if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .false. - case (optNSteps) - call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + case (optNSteps,trim(optNSteps)//'s') + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. - case (optNSeconds) - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + case (optNSeconds,trim(optNSeconds)//'s') + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. - case (optNMinutes) - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + case (optNMinutes,trim(optNMinutes)//'s') + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. - case (optNHours) - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + case (optNHours,trim(optNHours)//'s') + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. - case (optNDays) - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + case (optNDays,trim(optNDays)//'s') + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. - case (optNMonths) - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + case (optNMonths,trim(optNMonths)//'s') + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. case (optMonthly) call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) @@ -221,7 +222,7 @@ subroutine med_time_alarmInit( clock, alarm, option, & if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .true. - case (optNYears) + case (optNYears, trim(optNYears)//'s') call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n From 5081a8ecba142b9885ed2175a9d035ff2bf7fe60 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 13 Oct 2022 19:39:08 -0600 Subject: [PATCH 118/395] fixes to instantaneous output --- mediator/med_phases_history_mod.F90 | 68 +++++++++++++++++++++++++---- 1 file changed, 59 insertions(+), 9 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 7cfc6fc89..00783df89 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -1257,12 +1257,6 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! Write time sample to file if ( write_now ) then - ! Determine time_val and tbnds data for history as well as history file name - call med_phases_history_set_timeinfo(gcomp, auxcomp%files(nf)%clock, auxcomp%files(nf)%alarmname, & - time_val, time_bnds, time_units, auxcomp%files(nf)%histfile, auxcomp%files(nf)%doavg, & - auxname=auxcomp%files(nf)%auxname, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Set shorthand variables nx = is_local%wrap%nx(compid) ny = is_local%wrap%ny(compid) @@ -1272,6 +1266,13 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! Write header if (auxcomp%files(nf)%nt == 1) then + + ! Determine time_val and tbnds data for history as well as history file name + call med_phases_history_set_timeinfo(gcomp, auxcomp%files(nf)%clock, auxcomp%files(nf)%alarmname, & + time_val, time_bnds, time_units, auxcomp%files(nf)%histfile, auxcomp%files(nf)%doavg, & + auxname=auxcomp%files(nf)%auxname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! open file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1313,6 +1314,8 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! Close file if (auxcomp%files(nf)%nt == auxcomp%files(nf)%ntperfile) then + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_close(auxcomp%files(nf)%histfile, vm, file_ind=nf, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return auxcomp%files(nf)%nt = 0 @@ -1406,30 +1409,77 @@ subroutine med_phases_history_fldbun_accum(fldbun, fldbun_accum, count, rc) integer :: n type(ESMF_Field) :: lfield type(ESMF_Field) :: lfield_accum + integer :: fieldCount_accum + character(CL), pointer :: fieldnames_accum(:) integer :: fieldCount character(CL), pointer :: fieldnames(:) real(r8), pointer :: dataptr1d(:) real(r8), pointer :: dataptr2d(:,:) real(r8), pointer :: dataptr1d_accum(:) real(r8), pointer :: dataptr2d_accum(:,:) + integer :: ungriddedUBound_accum(1) integer :: ungriddedUBound(1) + character(len=64) :: msg !--------------------------------------- rc = ESMF_SUCCESS ! Accumulate field - call ESMF_FieldBundleGet(fldbun_accum, fieldCount=fieldCount, rc=rc) + call ESMF_FieldBundleGet(fldbun, fieldCount=fieldCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + write(msg,'(a,i0)') ' fldbun number of fields = ',fieldcount + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) allocate(fieldnames(fieldCount)) - call ESMF_FieldBundleGet(fldbun_accum, fieldNameList=fieldnames, rc=rc) + call ESMF_FieldBundleGet(fldbun, fieldNameList=fieldnames, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1, fieldcount call ESMF_FieldBundleGet(fldbun, fieldName=trim(fieldnames(n)), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(fldbun_accum, fieldName=trim(fieldnames(n)), field=lfield_accum, rc=rc) + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(msg,'(a,i0)') ' fldbun fieldname, ubound = '//trim(fieldnames(n)),ungriddedUBound(1) + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + end do + + call ESMF_FieldBundleGet(fldbun_accum, fieldCount=fieldCount_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(fieldnames_accum(fieldCount_accum)) + call ESMF_FieldBundleGet(fldbun_accum, fieldCount=fieldCount_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(msg,'(a,i0)') ' fldbun_accum number of fields = ',fieldcount_accum + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + write(6,*)'DEBUG: here1' + call ESMF_FieldBundleGet(fldbun_accum, fieldNameList=fieldnames_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(6,*)'DEBUG: here2' + do n = 1, fieldcount_accum + write(6,*)'DEBUG: n = ',n + call ESMF_FieldBundleGet(fldbun_accum, fieldName=trim(fieldnames_accum(n)), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + write(msg,'(a,i0)') ' fldbun_accum fieldname, ubound = '//trim(fieldnames(n)),ungriddedUBound(1) + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + end do + + do n = 1, fieldcount_accum + + call ESMF_FieldBundleGet(fldbun, fieldName=trim(fieldnames(n)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(fldbun_accum, fieldName=trim(fieldnames_accum(n)), field=lfield_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield_accum, ungriddedUBound=ungriddedUBound_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (ungriddedUBound(1) /= ungriddedUBound_accum(1)) then + call ESMF_LogWrite(" upper bounds for field and field_accum do not match", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + end if + if (ungriddedUBound(1) > 0) then call ESMF_FieldGet(lfield, farrayptr=dataptr2d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From f3f34b040244e7b5a937ac6d71c28889c78bf9e1 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 13 Oct 2022 19:55:18 -0600 Subject: [PATCH 119/395] fixes to time variable for instantaneous auxhist output --- mediator/med_phases_history_mod.F90 | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 00783df89..777979424 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -1264,14 +1264,20 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! Increment number of time samples on file auxcomp%files(nf)%nt = auxcomp%files(nf)%nt + 1 - ! Write header + ! Determine time_val and tbnds data for history as well as history file name if (auxcomp%files(nf)%nt == 1) then - - ! Determine time_val and tbnds data for history as well as history file name call med_phases_history_set_timeinfo(gcomp, auxcomp%files(nf)%clock, auxcomp%files(nf)%alarmname, & time_val, time_bnds, time_units, auxcomp%files(nf)%histfile, auxcomp%files(nf)%doavg, & auxname=auxcomp%files(nf)%auxname, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call med_phases_history_set_timeinfo(gcomp, auxcomp%files(nf)%clock, auxcomp%files(nf)%alarmname, & + time_val, time_bnds, time_units, auxcomp%files(nf)%histfile, auxcomp%files(nf)%doavg, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Write header + if (auxcomp%files(nf)%nt == 1) then ! open file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) From 7b96332518bba5cf9510cc292ee32836ceeda3e5 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 15 Oct 2022 19:45:13 -0600 Subject: [PATCH 120/395] fixed aux files 1-5 for atm --- mediator/med_methods_mod.F90 | 43 +++++++++++--------------- mediator/med_phases_history_mod.F90 | 47 ++++++++--------------------- 2 files changed, 29 insertions(+), 61 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index f25b024cd..5f66a8ebe 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -102,10 +102,8 @@ subroutine med_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, r integer :: lrank integer :: fieldCount integer :: ungriddedCount - integer :: gridToFieldMapCount integer :: ungriddedLBound(1) integer :: ungriddedUBound(1) - integer :: gridToFieldMap(1) real(R8), pointer :: dataptr1d(:) real(R8), pointer :: dataptr2d(:,:) character(ESMF_MAXSTR), allocatable :: lfieldNameList(:) @@ -165,16 +163,13 @@ subroutine med_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, r return end if - ! set ungridded dimensions and GridToFieldMap for field + ! set ungridded dimensions for field 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 - call ESMF_AttributeGet(lfield, name="GridToFieldMap", convention="NUOPC", & - purpose="Instance", valueList=gridToFieldMap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return ! get 2d pointer for field call ESMF_FieldGet(lfield, farrayptr=dataptr2d, rc=rc) @@ -183,7 +178,7 @@ subroutine med_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, r ! create new field with an ungridded dimension newfield = ESMF_FieldCreate(lmesh, dataptr2d, ESMF_INDEX_DELOCAL, & meshloc=meshloc, name=lfieldNameList(n), & - ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, gridToFieldMap=gridtoFieldMap, rc=rc) + ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, gridToFieldMap=(/2/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else if (lrank == 1) then @@ -256,10 +251,9 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S type(ESMF_StaggerLoc) :: staggerloc type(ESMF_MeshLoc) :: meshloc integer :: ungriddedCount + integer :: ungriddedCount_in integer, allocatable :: ungriddedLBound(:) integer, allocatable :: ungriddedUBound(:) - integer :: gridToFieldMapCount - integer, allocatable :: gridToFieldMap(:) logical :: isPresent character(ESMF_MAXSTR), allocatable :: lfieldNameList(:) character(len=*), parameter :: subname='(med_methods_FB_init)' @@ -359,7 +353,7 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S 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 STflds", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from STgeom", ESMF_LOGMSG_INFO) end if else call ESMF_LogWrite(trim(subname)//": ERROR fieldNameList, FBflds, STflds, FBgeom, or STgeom must be passed", & @@ -376,7 +370,7 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S if (trim(lfieldnamelist(n)) == trim(flds_scalar_name) .or. & trim(lfieldnamelist(n)) == '') then do n1 = n, fieldCount-1 - lfieldnamelist(n1) = lfieldnamelist(n1+1) + lfieldnamelist(n1) = lfieldnamelist(n1+1) enddo fieldCount = fieldCount - 1 endif @@ -445,8 +439,10 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S ! ungridded dimensions might be present in the input states or field bundles if (present(FBflds)) then - call med_methods_FB_getFieldN(FBflds, n, lfield, rc=rc) + call ESMF_FieldBundleGet(FBflds, fieldName=lfieldnamelist(n), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! call med_methods_FB_getFieldN(FBflds, n, lfield, rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return elseif (present(STflds)) then call med_methods_State_getNameN(STflds, n, lname, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -455,10 +451,14 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S end if ! Determine ungridded lower and upper bounds for lfield - ungriddedCount=0 ! initialize in case it was not set - call ESMF_AttributeGet(lfield, name="UngriddedLBound", convention="NUOPC", & - purpose="Instance", itemCount=ungriddedCount, isPresent=isPresent, rc=rc) + call ESMF_AttributeGet(lfield, name="UngriddedUBound", convention="NUOPC", & + purpose="Instance", itemCount=ungriddedCount_in, isPresent=isPresent, 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 @@ -471,20 +471,11 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S purpose="Instance", valueList=ungriddedUBound, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_AttributeGet(lfield, name="GridToFieldMap", convention="NUOPC", & - purpose="Instance", itemCount=gridToFieldMapCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(gridToFieldMap(gridToFieldMapCount)) - call ESMF_AttributeGet(lfield, name="GridToFieldMap", convention="NUOPC", & - purpose="Instance", valueList=gridToFieldMap, 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=gridToFieldMap) + ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, gridToFieldMap=(/2/)) if (chkerr(rc,__LINE__,u_FILE_u)) return - deallocate( ungriddedLbound, ungriddedUbound, gridToFieldMap) + deallocate( ungriddedLbound, ungriddedUbound) else ! No ungridded dimensions in field field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), rc=rc) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 777979424..7bf268179 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -896,7 +896,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid)) .and. .not. & ESMF_FieldBundleIsCreated(avgfile%FBaccum_import)) then call med_methods_FB_init(avgfile%FBaccum_import, scalar_name, & - FBgeom=is_local%wrap%FBImp(compid,compid), FBflds=is_local%wrap%FBimp(compid,compid), rc=rc) + STgeom=is_local%wrap%NStateImp(compid), STflds=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 @@ -905,7 +905,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid)) .and. .not. & ESMF_FieldBundleIsCreated(avgfile%FBaccum_export)) then call med_methods_FB_init(avgfile%FBaccum_export, scalar_name, & - FBgeom=is_local%wrap%FBExp(compid), FBflds=is_local%wrap%FBexp(compid), rc=rc) + STgeom=is_local%wrap%NStateExp(compid), STflds=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 @@ -1021,6 +1021,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! ----------------------------- use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleRemove + use ESMF , only : ESMF_Field, ESMF_FieldGet !DEBUG use med_constants_mod, only : czero => med_constants_czero use med_io_mod , only : med_io_write_time, med_io_define_time use med_methods_mod , only : med_methods_FB_init @@ -1058,6 +1059,10 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) integer :: yr,mon,day,sec ! time units real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output + !DEBUG + integer :: ungriddedUBound(1) + type(ESMF_Field) :: lfield + !DEBUG character(CS), allocatable :: fieldNameList(:) character(len=*), parameter :: subname='(med_phases_history_write_comp_aux)' !--------------------------------------- @@ -1166,7 +1171,8 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compid,compid)) .and. .not. & ESMF_FieldBundleIsCreated(auxcomp%files(nfcnt)%FBaccum)) then call med_methods_FB_init(auxcomp%files(nfcnt)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBImp(compid,compid), FBflds=is_local%wrap%FBImp(compid,compid), rc=rc) + STgeom=is_local%wrap%NStateImp(compid), STflds=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) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1430,47 +1436,18 @@ subroutine med_phases_history_fldbun_accum(fldbun, fldbun_accum, count, rc) rc = ESMF_SUCCESS - ! Accumulate field - call ESMF_FieldBundleGet(fldbun, fieldCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write(msg,'(a,i0)') ' fldbun number of fields = ',fieldcount - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) - allocate(fieldnames(fieldCount)) - call ESMF_FieldBundleGet(fldbun, fieldNameList=fieldnames, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1, fieldcount - call ESMF_FieldBundleGet(fldbun, fieldName=trim(fieldnames(n)), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write(msg,'(a,i0)') ' fldbun fieldname, ubound = '//trim(fieldnames(n)),ungriddedUBound(1) - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) - end do + ! Loop over field names in fldbun_accum call ESMF_FieldBundleGet(fldbun_accum, fieldCount=fieldCount_accum, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(fieldnames_accum(fieldCount_accum)) call ESMF_FieldBundleGet(fldbun_accum, fieldCount=fieldCount_accum, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - write(msg,'(a,i0)') ' fldbun_accum number of fields = ',fieldcount_accum - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) - write(6,*)'DEBUG: here1' call ESMF_FieldBundleGet(fldbun_accum, fieldNameList=fieldnames_accum, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - write(6,*)'DEBUG: here2' - do n = 1, fieldcount_accum - write(6,*)'DEBUG: n = ',n - call ESMF_FieldBundleGet(fldbun_accum, fieldName=trim(fieldnames_accum(n)), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write(msg,'(a,i0)') ' fldbun_accum fieldname, ubound = '//trim(fieldnames(n)),ungriddedUBound(1) - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) - end do do n = 1, fieldcount_accum - - call ESMF_FieldBundleGet(fldbun, fieldName=trim(fieldnames(n)), field=lfield, rc=rc) + call ESMF_FieldBundleGet(fldbun, fieldName=trim(fieldnames_accum(n)), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1500,7 +1477,7 @@ subroutine med_phases_history_fldbun_accum(fldbun, fldbun_accum, count, rc) dataptr1d_accum(:) = dataptr1d_accum(:) + dataptr1d(:) end if end do - deallocate(fieldnames) + deallocate(fieldnames_accum) ! Accumulate counter count = count + 1 From 4b36eb97f80699d9d03ffb556a5aa4c4e7e55fdd Mon Sep 17 00:00:00 2001 From: Matthew Dawson Date: Tue, 18 Oct 2022 13:31:44 -0600 Subject: [PATCH 121/395] add CAM linked lbs to exe build --- cime_config/buildexe | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cime_config/buildexe b/cime_config/buildexe index 7f1a64471..348a3382e 100755 --- a/cime_config/buildexe +++ b/cime_config/buildexe @@ -38,6 +38,7 @@ def _main_func(): num_esp = case.get_value("NUM_COMP_INST_ESP") ocn_model = case.get_value("COMP_OCN") gmake_args = get_standard_makefile_args(case) + link_libs = case.get_value("CAM_LINKED_LIBS", subgroup="build_component_cam") esmf_aware_threading = case.get_value("ESMF_AWARE_THREADING") # Determine valid components @@ -65,6 +66,9 @@ def _main_func(): if ocn_model == 'mom': gmake_args += "USE_FMS=TRUE" + if link_libs is not None: + gmake_args += 'USER_SLIBS="{}"'.format(link_libs) + comp_classes = case.get_values("COMP_CLASSES") for comp in comp_classes: model = case.get_value("COMP_{}".format(comp)) From 76306f69927f90859eaac1bd8da0e8a14a7873ee Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 2 Nov 2022 07:05:04 -0600 Subject: [PATCH 122/395] remove debug and obsolete statements --- mediator/med_methods_mod.F90 | 2 -- mediator/med_phases_history_mod.F90 | 4 ---- 2 files changed, 6 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 5f66a8ebe..203b1923d 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -441,8 +441,6 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S if (present(FBflds)) then call ESMF_FieldBundleGet(FBflds, fieldName=lfieldnamelist(n), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! call med_methods_FB_getFieldN(FBflds, n, lfield, rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return elseif (present(STflds)) then call med_methods_State_getNameN(STflds, n, lname, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 7bf268179..f98ece233 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -1059,10 +1059,6 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) integer :: yr,mon,day,sec ! time units real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output - !DEBUG - integer :: ungriddedUBound(1) - type(ESMF_Field) :: lfield - !DEBUG character(CS), allocatable :: fieldNameList(:) character(len=*), parameter :: subname='(med_phases_history_write_comp_aux)' !--------------------------------------- From 8763c7758ccb13bb3db641c554e4eccc4cd243c0 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Tue, 8 Nov 2022 13:47:10 -0500 Subject: [PATCH 123/395] fix unresolved merge conflict --- mediator/esmFldsExchange_nems_mod.F90 | 20 -------------------- 1 file changed, 20 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 5c04c7e3d..065b4a939 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -706,7 +706,6 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end do deallocate(flds) -<<<<<<< HEAD ! to wav: sea ice fraction, thickness and floe diameter allocate(flds(3)) flds = (/'Si_ifrac ', 'Si_floediam', 'Si_thick '/) @@ -726,21 +725,6 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end if end do deallocate(flds) -======= - ! to wav: sea ice fraction - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compwav)) then - call addfld(fldListFr(compice)%flds, 'Si_ifrac') - call addfld(fldListTo(compwav)%flds, 'Si_ifrac') - end if - else - if ( fldchk(is_local%wrap%FBexp(compwav) , 'Si_ifrac', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice,compice), 'Si_ifrac', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Si_ifrac', compwav, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compwav)%flds, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') - end if - end if ->>>>>>> escomp/master ! to wav: zonal sea water velocity from ocn ! to wav: meridional sea water velocity from ocn @@ -757,11 +741,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compwav) , trim(fldname), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), trim(fldname), rc=rc)) then -<<<<<<< HEAD call addmap(fldListFr(compocn)%flds, trim(fldname), compwav, mapbilnr_nstod , 'one', 'unset') -======= - call addmap(fldListFr(compocn)%flds, trim(fldname), compwav, mapfcopy , 'unset', 'unset') ->>>>>>> escomp/master call addmrg(fldListTo(compwav)%flds, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') end if end if From 02582eb8cfadae2777a9611a30ce9ae67f0df17d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 16 Nov 2022 15:52:10 -0700 Subject: [PATCH 124/395] needed for using ESMF_AWARE_THREADING=TRUE --- cesm/nuopc_cap_share/driver_pio_mod.F90 | 139 +++++++++++++----------- 1 file changed, 75 insertions(+), 64 deletions(-) diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index 0e743d669..0048eeca9 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -212,86 +212,97 @@ subroutine driver_pio_component_init(driver, ncomps, rc) if (ESMF_GridCompIsPetLocal(gcomp(i), rc=rc)) then call ESMF_GridCompGet(gcomp(i), vm=vm, name=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + io_compname(i) = trim(cval) - + call NUOPC_CompAttributeAdd(gcomp(i), attrList=(/'MCTID'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + write(cval, *) io_compid(i) call NUOPC_CompAttributeSet(gcomp(i), name="MCTID", value=trim(cval), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, mpiCommunicator=comp_comm, localPet=comp_rank, petCount=npets, & - ssiLocalPetCount=default_stride, rc=rc) + call ESMF_VMGet(vm, mpiCommunicator=comp_comm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompAttributeGet(gcomp(i), name="pio_stride", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_stride - if(pio_comp_settings(i)%pio_stride <= 0 .or. pio_comp_settings(i)%pio_stride > npets) then - pio_comp_settings(i)%pio_stride = min(npets, default_stride) - endif - - call NUOPC_CompAttributeGet(gcomp(i), name="pio_rearranger", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_rearranger - - call NUOPC_CompAttributeGet(gcomp(i), name="pio_numiotasks", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_numiotasks - - if(pio_comp_settings(i)%pio_numiotasks < 0 .or. pio_comp_settings(i)%pio_numiotasks > npets) then - pio_comp_settings(i)%pio_numiotasks = max(1,npets/pio_comp_settings(i)%pio_stride) - endif + if(comp_comm .ne. MPI_COMM_NULL) then + call ESMF_VMGet(vm, petCount=npets, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp(i), name="pio_root", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_root - - if(pio_comp_settings(i)%pio_root < 0 .or. pio_comp_settings(i)%pio_root > npets) then - pio_comp_settings(i)%pio_root = 0 - endif - + call ESMF_VMGet(vm, localPet=comp_rank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, ssiLocalPetCount=default_stride, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp(i), name="pio_typename", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp(i), name="pio_stride", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_stride + if(pio_comp_settings(i)%pio_stride <= 0 .or. pio_comp_settings(i)%pio_stride > npets) then + pio_comp_settings(i)%pio_stride = min(npets, default_stride) + endif + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_rearranger", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_rearranger + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_numiotasks", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_numiotasks - select case (trim(cval)) - case ('pnetcdf') - pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_PNETCDF - case ('netcdf') - pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF - case ('netcdf4p') - pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF4P - case ('netcdf4c') - pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF4C - case DEFAULT - write (msgstr, *) "Invalid PIO_TYPENAME Setting for component ", trim(cval) - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) - return - end select + if(pio_comp_settings(i)%pio_numiotasks < 0 .or. pio_comp_settings(i)%pio_numiotasks > npets) then + pio_comp_settings(i)%pio_numiotasks = max(1,npets/pio_comp_settings(i)%pio_stride) + endif + + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_root", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_root - call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_async_interface(i) = (trim(cval) == '.true.') + if(pio_comp_settings(i)%pio_root < 0 .or. pio_comp_settings(i)%pio_root > npets) then + pio_comp_settings(i)%pio_root = 0 + endif - call NUOPC_CompAttributeGet(gcomp(i), name="pio_netcdf_format", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call driver_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) - if (pio_async_interface(i)) then - do_async_init = do_async_init + 1 - else - if(pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then - pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req = pio_comp_settings(i)%pio_numiotasks - endif - if(pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then - pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req = pio_comp_settings(i)%pio_numiotasks + call NUOPC_CompAttributeGet(gcomp(i), name="pio_typename", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + select case (trim(cval)) + case ('pnetcdf') + pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_PNETCDF + case ('netcdf') + pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF + case ('netcdf4p') + pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF4P + case ('netcdf4c') + pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF4C + case DEFAULT + write (msgstr, *) "Invalid PIO_TYPENAME Setting for component ", trim(cval) + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return + end select + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + pio_async_interface(i) = (trim(cval) == '.true.') + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_netcdf_format", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call driver_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) + + if (pio_async_interface(i)) then + do_async_init = do_async_init + 1 + else + if(pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req = pio_comp_settings(i)%pio_numiotasks + endif + if(pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req = pio_comp_settings(i)%pio_numiotasks + endif + call pio_init(comp_rank ,comp_comm ,pio_comp_settings(i)%pio_numiotasks, 0, pio_comp_settings(i)%pio_stride, & + pio_comp_settings(i)%pio_rearranger, iosystems(i), pio_comp_settings(i)%pio_root, & + pio_rearr_opts) endif - call pio_init(comp_rank ,comp_comm ,pio_comp_settings(i)%pio_numiotasks, 0, pio_comp_settings(i)%pio_stride, & - pio_comp_settings(i)%pio_rearranger, iosystems(i), pio_comp_settings(i)%pio_root, & - pio_rearr_opts) endif endif enddo From 0cf254ce4186a0f8e7fbe710ce4ca4d6075ef65d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 17 Nov 2022 14:25:57 -0700 Subject: [PATCH 125/395] code clean up suggested in review --- cesm/nuopc_cap_share/driver_pio_mod.F90 | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index 0048eeca9..2584ab1dd 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -226,13 +226,7 @@ subroutine driver_pio_component_init(driver, ncomps, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if(comp_comm .ne. MPI_COMM_NULL) then - call ESMF_VMGet(vm, petCount=npets, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localPet=comp_rank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, ssiLocalPetCount=default_stride, rc=rc) + call ESMF_VMGet(vm, petCount=npets, localPet=comp_rank, ssiLocalPetCount=default_stride, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp(i), name="pio_stride", value=cval, rc=rc) @@ -254,7 +248,6 @@ subroutine driver_pio_component_init(driver, ncomps, rc) pio_comp_settings(i)%pio_numiotasks = max(1,npets/pio_comp_settings(i)%pio_stride) endif - call NUOPC_CompAttributeGet(gcomp(i), name="pio_root", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cval, *) pio_comp_settings(i)%pio_root @@ -263,7 +256,6 @@ subroutine driver_pio_component_init(driver, ncomps, rc) pio_comp_settings(i)%pio_root = 0 endif - call NUOPC_CompAttributeGet(gcomp(i), name="pio_typename", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From ef76dd1297243014307b9dcd6845fa63a62e1383 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Sat, 19 Nov 2022 08:37:42 -0700 Subject: [PATCH 126/395] make fldList a singly linked list --- mediator/esmFlds.F90 | 289 ++-- mediator/esmFldsExchange_cesm_mod.F90 | 1924 ++++++++++++------------- mediator/med.F90 | 4 +- mediator/med_merge_mod.F90 | 10 +- mediator/med_phases_prep_rof_mod.F90 | 2 +- 5 files changed, 1103 insertions(+), 1126 deletions(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index 36dda2519..422312021 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -39,6 +39,7 @@ module esmflds character(CS), allocatable :: merge_fields(:) character(CS), allocatable :: merge_types(:) character(CS), allocatable :: merge_fracnames(:) + type(med_fldList_entry_type), pointer :: next => null() end type med_fldList_entry_type ! The above would be the field name to merge from @@ -47,7 +48,7 @@ module esmflds ! merge_type(comptm) = 'copy' (could also have 'copy_with_weighting') type, public :: med_fldList_type - type (med_fldList_entry_type), pointer :: flds(:) => null() + type (med_fldList_entry_type) :: fields end type med_fldList_type interface med_fldList_GetFldInfo ; module procedure & @@ -94,33 +95,26 @@ subroutine med_fldList_AddFld(flds, stdname, shortname) ! 5) point flds => newflds ! ---------------------------------------------- - type(med_fldList_entry_type) , pointer :: flds(:) + type(med_fldList_entry_type) , target :: fields character(len=*) , intent(in) :: stdname character(len=*) , intent(in) , optional :: shortname ! local variables - integer :: n,oldsize,id logical :: found integer :: mapsize, mrgsize - type(med_fldList_entry_type), pointer :: newflds(:) + type(med_fldList_entry_type), pointer :: newfld character(len=*), parameter :: subname='(med_fldList_AddFld)' ! ---------------------------------------------- - if (associated(flds)) then - oldsize = size(flds) - found = .false. - do n= 1,oldsize - if (trim(stdname) == trim(flds(n)%stdname)) then - found = .true. - exit - end if - end do - else - oldsize = 0 - found = .false. - end if - id = oldsize + 1 - + newfld => fields + found = .false. + do while(newfld%next) + if (trim(stdname) == trim(newfld%stdname)) then + found = .true. + exit + end if + newfld => newfld%next + enddo ! create new entry if fldname is not in original list mapsize = ncomps @@ -129,77 +123,40 @@ subroutine med_fldList_AddFld(flds, stdname, shortname) if (.not. found) then ! 1) allocate newfld to be size (one element larger than input flds) - allocate(newflds(id)) - - ! 2) copy flds into first N-1 elements of newflds - do n = 1,oldsize - newflds(n)%stdname = flds(n)%stdname - newflds(n)%shortname = flds(n)%shortname - - allocate(newflds(n)%mapindex(mapsize)) - allocate(newflds(n)%mapnorm(mapsize)) - allocate(newflds(n)%mapfile(mapsize)) - allocate(newflds(n)%merge_fields(mrgsize)) - allocate(newflds(n)%merge_types(mrgsize)) - allocate(newflds(n)%merge_fracnames(mrgsize)) - - newflds(n)%mapindex(:) = flds(n)%mapindex(:) - newflds(n)%mapnorm(:) = flds(n)%mapnorm(:) - newflds(n)%mapfile(:) = flds(n)%mapfile(:) - newflds(n)%merge_fields(:) = flds(n)%merge_fields(:) - newflds(n)%merge_types(:) = flds(n)%merge_types(:) - newflds(n)%merge_fracnames(:) = flds(n)%merge_fracnames(:) - - deallocate(flds(n)%mapindex) - deallocate(flds(n)%mapnorm) - deallocate(flds(n)%mapfile) - deallocate(flds(n)%merge_fields) - deallocate(flds(n)%merge_types) - deallocate(flds(n)%merge_fracnames) - end do + allocate(newfld%next) + newfld => newfld%next - ! 3) deallocate / nullify flds - if (oldsize > 0) then - deallocate(flds) - nullify(flds) - end if - - ! 4) point flds => new_flds - flds => newflds - - ! 5) now update flds information for new entry - flds(id)%stdname = trim(stdname) + ! 2) now update flds information for new entry + newfld%stdname = trim(stdname) if (present(shortname)) then - flds(id)%shortname = trim(shortname) + newfld%shortname = trim(shortname) else - flds(id)%shortname = trim(stdname) + newfld%shortname = trim(stdname) end if - allocate(flds(id)%mapindex(mapsize)) - allocate(flds(id)%mapnorm(mapsize)) - allocate(flds(id)%mapfile(mapsize)) - allocate(flds(id)%merge_fields(mrgsize)) - allocate(flds(id)%merge_types(mrgsize)) - allocate(flds(id)%merge_fracnames(mrgsize)) - flds(id)%mapindex(:) = mapunset - flds(id)%mapnorm(:) = 'unset' - flds(id)%mapfile(:) = 'unset' - flds(id)%merge_fields(:) = 'unset' - flds(id)%merge_types(:) = 'unset' - flds(id)%merge_fracnames(:) = 'unset' + allocate(newfld%mapindex(mapsize)) + allocate(newfld%mapnorm(mapsize)) + allocate(newfld%mapfile(mapsize)) + allocate(newfld%merge_fields(mrgsize)) + allocate(newfld%merge_types(mrgsize)) + allocate(newfld%merge_fracnames(mrgsize)) + newfld%mapindex(:) = mapunset + newfld%mapnorm(:) = 'unset' + newfld%mapfile(:) = 'unset' + newfld%merge_fields(:) = 'unset' + newfld%merge_types(:) = 'unset' + newfld%merge_fracnames(:) = 'unset' end if end subroutine med_fldList_AddFld !================================================================================ - subroutine med_fldList_AddMrg(flds, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname) + subroutine med_fldList_AddMrg(flds, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname, rc) ! ---------------------------------------------- ! Determine mrg entry or entries in flds aray ! ---------------------------------------------- - use ESMF, only : ESMF_LogWrite, ESMF_END_ABORT, ESMF_LOGMSG_ERROR, ESMF_Finalize - ! input/output variables type(med_fldList_entry_type) , pointer :: flds(:) character(len=*) , intent(in) :: fldname @@ -207,92 +164,97 @@ subroutine med_fldList_AddMrg(flds, fldname, mrg_from, mrg_fld, mrg_type, mrg_fr character(len=*) , intent(in) :: mrg_fld character(len=*) , intent(in) :: mrg_type character(len=*) , intent(in), optional :: mrg_fracname + integer , intent(out), optional :: rc ! local variables - integer :: n, id + integer :: lrc + type(med_fldList_entry_type), pointer :: newfld character(len=*), parameter :: subname='(med_fldList_AddMrg)' ! ---------------------------------------------- + + newfld => med_fldList_GetFld(flds, fldname, lrc) + if (present(rc)) rc = lrc + if (chkerr(lrc,__LINE__,u_FILE_u)) return - id = 0 - do n= 1,size(flds) - if (trim(fldname) == trim(flds(n)%stdname)) then - id = n - exit - end if - end do - if (id == 0) then - do n = 1,size(flds) - write(6,*) trim(subname)//' input flds entry is ',trim(flds(n)%stdname) - end do - call ESMF_LogWrite(subname // 'ERROR: fldname '// trim(fldname) // ' not found in input flds', ESMF_LOGMSG_ERROR) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if - - n = mrg_from - flds(id)%merge_fields(n) = mrg_fld - flds(id)%merge_types(n) = mrg_type + newfld%merge_fields(n) = mrg_fld + newfld%merge_types(n) = mrg_type if (present(mrg_fracname)) then - flds(id)%merge_fracnames(n) = mrg_fracname + newfld%merge_fracnames(n) = mrg_fracname end if end subroutine med_fldList_AddMrg + function med_fldList_GetFld(flds, fldname, rc) result(newfld) + use ESMF, only : ESMF_LogWrite, ESMF_END_ABORT, ESMF_LOGMSG_ERROR, ESMF_Finalize + + type(med_fldList_entry_type) , intent(in), target :: fields + character(len=*) , intent(in) :: fldname + + type(med_fldList_entry_type), pointer :: newfld + integer :: rc + + newfld => fields + rc = ESMF_FAILURE + do while(associated(newfld%next)) + if(trim(fldname) .eq. newfld%stdname) then + rc = ESMF_SUCCESS + exit + endif + newfld => newfld%next + enddo + if(rc /= ESMF_SUCCESS) then + newfld => fields + do while(associated(newfld%next)) + write(6,*) trim(subname)//' input flds entry is ',trim(newfld%stdname) + newfld => newfld%next + end do + call ESMF_LogWrite(subname // 'ERROR: fldname '// trim(fldname) // ' not found in input flds', ESMF_LOGMSG_INFO) + return + endif + + end function med_fldList_GetFld !================================================================================ - subroutine med_fldList_AddMap(flds, fldname, destcomp, maptype, mapnorm, mapfile) + subroutine med_fldList_AddMap(flds, fldname, destcomp, maptype, mapnorm, mapfile, rc) use ESMF, only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_LogWrite, ESMF_LOGMSG_INFO ! intput/output variables - type(med_fldList_entry_type) , intent(inout) :: flds(:) - character(len=*) , intent(in) :: fldname integer , intent(in) :: destcomp integer , intent(in) :: maptype character(len=*) , intent(in) :: mapnorm character(len=*), optional , intent(in) :: mapfile + integer , intent(out) :: rc ! local variables + type(med_fldList_entry_type), pointer :: newfld integer :: id, n - integer :: rc character(len=CX) :: lmapfile character(len=*),parameter :: subname='(med_fldList_AddMap)' ! ---------------------------------------------- lmapfile = 'unset' + rc = ESMF_FAILURE if (present(mapfile)) lmapfile = mapfile - id = 0 - do n = 1,size(flds) - if (trim(fldname) == trim(flds(n)%stdname)) then - id = n - exit - end if - end do - if (id == 0) then - do n = 1,size(flds) - write(6,*) trim(subname)//' input flds entry is ',trim(flds(n)%stdname) - end do - call ESMF_LogWrite(subname // 'ERROR: fldname '// trim(fldname) // ' not found in input flds', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - + newfld => med_fldList_GetFld(flds, fldname, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Note - default values are already set for the fld entries - so only non-default ! values need to be set below ! If mapindex is mapfcopy - create a redistribution route handle ! If mapfile is idmap - create a redistribution route nhandle ! If mapfile is unset then create the mapping route handle at run time - flds(id)%mapindex(destcomp) = maptype - flds(id)%mapnorm(destcomp) = trim(mapnorm) - flds(id)%mapfile(destcomp) = trim(lmapfile) + newfld%mapindex(destcomp) = maptype + newfld%mapnorm(destcomp) = trim(mapnorm) + newfld%mapfile(destcomp) = trim(lmapfile) ! overwrite values if appropriate - if (flds(id)%mapindex(destcomp) == mapfcopy) then - flds(id)%mapfile(destcomp) = 'unset' - flds(id)%mapnorm(destcomp) = 'unset' - else if (trim(flds(id)%mapfile(destcomp)) == 'idmap') then - flds(id)%mapindex(destcomp) = mapfcopy - flds(id)%mapnorm(destcomp) = 'unset' + if (newfld%mapindex(destcomp) == mapfcopy) then + newfld%mapfile(destcomp) = 'unset' + newfld%mapnorm(destcomp) = 'unset' + else if (trim(newfld%mapfile(destcomp)) == 'idmap') then + newfld%mapindex(destcomp) = mapfcopy + newfld%mapnorm(destcomp) = 'unset' end if end subroutine med_fldList_AddMap @@ -515,40 +477,53 @@ end subroutine med_fldList_Realize !================================================================================ - subroutine med_fldList_GetFldInfo_general(fldList, fldindex, stdname, shortname) + subroutine med_fldList_GetFldInfo(fldList, fldindex, stdname, shortname, merge_field, merge_type, merge_fracname) ! ---------------------------------------------- ! Get field info ! ---------------------------------------------- type(med_fldList_type) , intent(in) :: fldList integer , intent(in) :: fldindex - character(len=*) , intent(out) :: stdname - character(len=*) , intent(out) :: shortname + integer , optional, intent(in) :: compsrc + character(len=*) , optional, intent(out) :: stdname + character(len=*) , optional, intent(out) :: shortname + character(len=*) , optional, intent(out) :: merge_fields + character(len=*) , optional, intent(out) :: merge_type + character(len=*) , optional, intent(out) :: merge_fracname ! local variables + type(med_fldList_entry_type), pointer :: newfld + integer :: i + integer :: lcompsrc character(len=*), parameter :: subname='(med_fldList_GetFldInfo_general)' ! ---------------------------------------------- + i = 0 + lcompsrc = 1 + newfld => fldList%fields + do while(newfld) + i = i+1 + if (i==fldindex) exit + newfld => newfld%next + enddo + if(present(stdname)) then + stdname = fldList%fields%stdname + endif + if(present(shortname)) then + shortname = fldList%fields%shortname + endif + if(present(merge_fields)) then + if(present(compsrc)) lcompsrc = compsrc + merge_field = fldList%fields%merge_fields(compsrc) + endif + if(present(merge_type)) then + if(present(compsrc)) lcompsrc = compsrc + merge_type = fldList%fields%merge_types(compsrc) + endif + if(present(merge_fracname)) then + if(present(compsrc)) lcompsrc = compsrc + merge_fracname = fldList%fields%merge_fracnames(compsrc) + endif - stdname = fldList%flds(fldindex)%stdname - shortname = fldList%flds(fldindex)%shortname - - end subroutine med_fldList_GetFldInfo_general - - !================================================================================ - - subroutine med_fldList_GetFldInfo_stdname(fldList, fldindex_in, stdname_out) - ! ---------------------------------------------- - ! Get field info - ! ---------------------------------------------- - type(med_fldList_type) , intent(in) :: fldList - integer , intent(in) :: fldindex_in - character(len=*) , intent(out) :: stdname_out - - ! local variables - character(len=*), parameter :: subname='(med_fldList_GetFldInfo_stdname)' - ! ---------------------------------------------- - - stdname_out = fldList%flds(fldindex_in)%stdname - end subroutine med_fldList_GetFldInfo_stdname + end subroutine med_fldList_GetFldInfo !================================================================================ @@ -602,15 +577,17 @@ end subroutine med_fldList_GetFldInfo_merging integer function med_fldList_GetNumFlds(fldList) ! input/output variables - type(med_fldList_type), intent(in) :: fldList + type(med_fldList_type), intent(in), target :: fldList ! ---------------------------------------------- - - if (associated(fldList%flds)) then - med_fldList_GetNumFlds = size(fldList%flds) - else - med_fldList_GetNumFlds = 0 - end if - + type(med_fldList_entry_type), pointer :: newfld + + newfld => fldList + med_fldList_GetNumFlds = 0 + do while(newfld%next) + med_fldList_GetNumFlds = med_fldList_GetNumFlds + 1 + newfld => newfld%next + end do + end function med_fldList_GetNumFlds !================================================================================ diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 48ac2a2ed..be820095a 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -238,8 +238,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) 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)) + call addfld(fldListFr(n)%fields, trim(cvalue)) + call addfld(fldListTo(n)%fields, trim(cvalue)) end do end if @@ -251,11 +251,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to med: masks from components !---------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Sl_lfrin') - call addfld(fldListFr(compocn)%flds, 'So_omask') - call addfld(fldListFr(compice)%flds, 'Si_imask') + call addfld(fldListFr(complnd)%fields, 'Sl_lfrin') + call addfld(fldListFr(compocn)%fields, 'So_omask') + call addfld(fldListFr(compice)%fields, 'Si_imask') do ns = 1,is_local%wrap%num_icesheets - call addfld(fldlistFr(compglc(ns))%flds, 'Sg_area') + call addfld(fldlistFr(compglc(ns))%fields, 'Sg_area') end do else call addmap(fldListFr(compocn)%flds, 'So_omask', compice, mapfcopy, 'unset', 'unset') @@ -265,35 +265,35 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to med: atm and ocn fields required for atm/ocn flux calculation' ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_u') - call addfld(fldListFr(compatm)%flds, 'Sa_v') - call addfld(fldListFr(compatm)%flds, 'Sa_z') - call addfld(fldListFr(compatm)%flds, 'Sa_tbot') - call addfld(fldListFr(compatm)%flds, 'Sa_pbot') - call addfld(fldListFr(compatm)%flds, 'Sa_shum') - call addfld(fldListFr(compatm)%flds, 'Sa_ptem') - call addfld(fldListFr(compatm)%flds, 'Sa_dens') + call addfld(fldListFr(compatm)%fields, 'Sa_u') + call addfld(fldListFr(compatm)%fields, 'Sa_v') + call addfld(fldListFr(compatm)%fields, 'Sa_z') + call addfld(fldListFr(compatm)%fields, 'Sa_tbot') + call addfld(fldListFr(compatm)%fields, 'Sa_pbot') + call addfld(fldListFr(compatm)%fields, 'Sa_shum') + call addfld(fldListFr(compatm)%fields, 'Sa_ptem') + call addfld(fldListFr(compatm)%fields, 'Sa_dens') if (flds_wiso) then - call addfld(fldListFr(compatm)%flds, 'Sa_shum_wiso') + call addfld(fldListFr(compatm)%fields, 'Sa_shum_wiso') end if else if (is_local%wrap%aoflux_grid == 'ogrid') then if (mapuv_with_cart3d) then - call addmap(fldListFr(compatm)%flds, 'Sa_u' , compocn, mappatch_uv3d, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%flds, 'Sa_v' , compocn, mappatch_uv3d, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Sa_u' , compocn, mappatch_uv3d, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Sa_v' , compocn, mappatch_uv3d, 'one', atm2ocn_map) else - call addmap(fldListFr(compatm)%flds, 'Sa_u' , compocn, mappatch, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%flds, 'Sa_v' , compocn, mappatch, 'one', atm2ocn_map) - end if - call addmap(fldListFr(compatm)%flds, 'Sa_z' , compocn, mapbilnr, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%flds, 'Sa_tbot', compocn, mapbilnr, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%flds, 'Sa_pbot', compocn, mapbilnr, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%flds, 'Sa_shum', compocn, mapbilnr, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%flds, 'Sa_ptem', compocn, mapbilnr, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%flds, 'Sa_dens', compocn, mapbilnr, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Sa_u' , compocn, mappatch, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Sa_v' , compocn, mappatch, 'one', atm2ocn_map) + end if + call addmap(fldListFr(compatm)%fields, 'Sa_z' , compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Sa_tbot', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Sa_pbot', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Sa_shum', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Sa_ptem', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Sa_dens', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_map) if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_shum_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_shum_wiso', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Sa_shum_wiso', compocn, mapbilnr, 'one', atm2ocn_map) end if end if end if @@ -302,16 +302,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to med: swnet fluxes used for budget calculation ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Fall_swnet') - call addfld(fldListFr(compice)%flds, 'Faii_swnet') - call addfld(fldListFr(compatm)%flds, 'Faxa_swnet') + call addfld(fldListFr(complnd)%fields, 'Fall_swnet') + call addfld(fldListFr(compice)%fields, 'Faii_swnet') + call addfld(fldListFr(compatm)%fields, 'Faxa_swnet') else if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swnet', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_swnet', compice, mapconsf, 'one' , atm2ice_map) - call addmap(fldListFr(compatm)%flds, 'Faxa_swnet', compocn, mapconsf, 'one' , atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Faxa_swnet', compice, mapconsf, 'one' , atm2ice_map) + call addmap(fldListFr(compatm)%fields, 'Faxa_swnet', compocn, mapconsf, 'one' , atm2ocn_map) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_swnet', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Faii_swnet', compocn, mapfcopy, 'unset', 'unset') + call addmap(fldListFr(compice)%fields, 'Faii_swnet', compocn, mapfcopy, 'unset', 'unset') end if end if @@ -323,26 +323,26 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: height at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_z') - call addfld(fldListTo(complnd)%flds, 'Sa_z') + call addfld(fldListFr(compatm)%fields, 'Sa_z') + call addfld(fldListTo(complnd)%fields, 'Sa_z') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_z', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_z', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_z', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Sa_z', mrg_from=compatm, mrg_fld='Sa_z', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Sa_z', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Sa_z', mrg_from=compatm, mrg_fld='Sa_z', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: surface height from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_topo') - call addfld(fldListTo(complnd)%flds, 'Sa_topo') + call addfld(fldListFr(compatm)%fields, 'Sa_topo') + call addfld(fldListTo(complnd)%fields, 'Sa_topo') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_topo', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_topo', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_topo', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Sa_topo', mrg_from=compatm, mrg_fld='Sa_topo', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Sa_topo', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Sa_topo', mrg_from=compatm, mrg_fld='Sa_topo', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -350,99 +350,99 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: meridional wind at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_u') - call addfld(fldListTo(complnd)%flds, 'Sa_u') + call addfld(fldListFr(compatm)%fields, 'Sa_u') + call addfld(fldListTo(complnd)%fields, 'Sa_u') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_u', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_u', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_u', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Sa_u', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_v') - call addfld(fldListTo(complnd)%flds, 'Sa_v') + call addfld(fldListFr(compatm)%fields, 'Sa_v') + call addfld(fldListTo(complnd)%fields, 'Sa_v') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_v', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_v', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_v', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Sa_v', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: pressure at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_pbot') - call addfld(fldListTo(complnd)%flds, 'Sa_pbot') + call addfld(fldListFr(compatm)%fields, 'Sa_pbot') + call addfld(fldListTo(complnd)%fields, 'Sa_pbot') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_pbot', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_pbot', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_pbot', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Sa_pbot', mrg_from=compatm, mrg_fld='Sa_pbot', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Sa_pbot', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Sa_pbot', mrg_from=compatm, mrg_fld='Sa_pbot', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: o3 at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_o3') - call addfld(fldListTo(complnd)%flds, 'Sa_o3') + call addfld(fldListFr(compatm)%fields, 'Sa_o3') + call addfld(fldListTo(complnd)%fields, 'Sa_o3') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_o3', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_o3', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_o3', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Sa_o3', mrg_from=compatm, mrg_fld='Sa_o3', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Sa_o3', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Sa_o3', mrg_from=compatm, mrg_fld='Sa_o3', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: temperature at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_tbot') - call addfld(fldListTo(complnd)%flds, 'Sa_tbot') + call addfld(fldListFr(compatm)%fields, 'Sa_tbot') + call addfld(fldListTo(complnd)%fields, 'Sa_tbot') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_tbot', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_tbot', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_tbot', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Sa_tbot', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: potential temperature at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_ptem') - call addfld(fldListTo(complnd)%flds, 'Sa_ptem') + call addfld(fldListFr(compatm)%fields, 'Sa_ptem') + call addfld(fldListTo(complnd)%fields, 'Sa_ptem') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_ptem', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_ptem', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_ptem', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Sa_ptem', mrg_from=compatm, mrg_fld='Sa_ptem', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Sa_ptem', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Sa_ptem', mrg_from=compatm, mrg_fld='Sa_ptem', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: specific humidity at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_shum') - call addfld(fldListTo(complnd)%flds, 'Sa_shum') + call addfld(fldListFr(compatm)%fields, 'Sa_shum') + call addfld(fldListTo(complnd)%fields, 'Sa_shum') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_shum', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_shum', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Sa_shum', mrg_from=compatm, mrg_fld='Sa_shum', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Sa_shum', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Sa_shum', mrg_from=compatm, mrg_fld='Sa_shum', mrg_type='copy') end if end if if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_shum_wiso') - call addfld(fldListTo(complnd)%flds, 'Sa_shum_wiso') + call addfld(fldListFr(compatm)%fields, 'Sa_shum_wiso') + call addfld(fldListTo(complnd)%fields, 'Sa_shum_wiso') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_shum_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_shum_wiso', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Sa_shum_wiso', mrg_from=compatm, mrg_fld='Sa_shum_wiso', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Sa_shum_wiso', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Sa_shum_wiso', mrg_from=compatm, mrg_fld='Sa_shum_wiso', mrg_type='copy') end if end if end if @@ -450,59 +450,59 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: convective and large scale precipitation rate water equivalent from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_rainc') - call addfld(fldListTo(complnd)%flds, 'Faxa_rainc') + call addfld(fldListFr(compatm)%fields, 'Faxa_rainc') + call addfld(fldListTo(complnd)%fields, 'Faxa_rainc') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_rainc', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_rainc', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rainc', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Faxa_rainc', mrg_from=compatm, mrg_fld='Faxa_rainc', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_rainc', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Faxa_rainc', mrg_from=compatm, mrg_fld='Faxa_rainc', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_rainl') - call addfld(fldListTo(complnd)%flds, 'Faxa_rainl') + call addfld(fldListFr(compatm)%fields, 'Faxa_rainl') + call addfld(fldListTo(complnd)%fields, 'Faxa_rainl') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_rainl', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_rainl', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rainl', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Faxa_rainl', mrg_from=compatm, mrg_fld='Faxa_rainl', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_rainl', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Faxa_rainl', mrg_from=compatm, mrg_fld='Faxa_rainl', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: convective and large-scale (stable) snow rate from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_snowc') - call addfld(fldListTo(complnd)%flds, 'Faxa_snowc') + call addfld(fldListFr(compatm)%fields, 'Faxa_snowc') + call addfld(fldListTo(complnd)%fields, 'Faxa_snowc') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_snowc', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_snowc', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snowc', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Faxa_snowc', mrg_from=compatm, mrg_fld='Faxa_snowc', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_snowc', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Faxa_snowc', mrg_from=compatm, mrg_fld='Faxa_snowc', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_snowl') - call addfld(fldListTo(complnd)%flds, 'Faxa_snowl') + call addfld(fldListFr(compatm)%fields, 'Faxa_snowl') + call addfld(fldListTo(complnd)%fields, 'Faxa_snowl') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_snowl', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_snowl', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snowl', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Faxa_snowl', mrg_from=compatm, mrg_fld='Faxa_snowl', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_snowl', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Faxa_snowl', mrg_from=compatm, mrg_fld='Faxa_snowl', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: downward longwave heat flux from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_lwdn') - call addfld(fldListTo(complnd)%flds, 'Faxa_lwdn') + call addfld(fldListFr(compatm)%fields, 'Faxa_lwdn') + call addfld(fldListTo(complnd)%fields, 'Faxa_lwdn') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_lwdn', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_lwdn', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_lwdn', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Faxa_lwdn', mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_lwdn', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Faxa_lwdn', mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -512,53 +512,53 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: downward Diffuse visible incident solar radiation from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_swndr') - call addfld(fldListTo(complnd)%flds, 'Faxa_swndr') + call addfld(fldListFr(compatm)%fields, 'Faxa_swndr') + call addfld(fldListTo(complnd)%fields, 'Faxa_swndr') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_swndr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_swndr', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_swndr', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Faxa_swndr', mrg_from=compatm, mrg_fld='Faxa_swndr', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_swndr', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Faxa_swndr', mrg_from=compatm, mrg_fld='Faxa_swndr', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_swvdr') - call addfld(fldListTo(complnd)%flds, 'Faxa_swvdr') + call addfld(fldListFr(compatm)%fields, 'Faxa_swvdr') + call addfld(fldListTo(complnd)%fields, 'Faxa_swvdr') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_swvdr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_swvdr', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_swvdr', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Faxa_swvdr', mrg_from=compatm, mrg_fld='Faxa_swvdr', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_swvdr', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Faxa_swvdr', mrg_from=compatm, mrg_fld='Faxa_swvdr', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_swndf') - call addfld(fldListTo(complnd)%flds, 'Faxa_swndf') + call addfld(fldListFr(compatm)%fields, 'Faxa_swndf') + call addfld(fldListTo(complnd)%fields, 'Faxa_swndf') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_swndf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_swndf', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_swndf', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Faxa_swndf', mrg_from=compatm, mrg_fld='Faxa_swndf', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_swndf', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Faxa_swndf', mrg_from=compatm, mrg_fld='Faxa_swndf', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_swvdf') - call addfld(fldListTo(complnd)%flds, 'Faxa_swvdf') + call addfld(fldListFr(compatm)%fields, 'Faxa_swvdf') + call addfld(fldListTo(complnd)%fields, 'Faxa_swvdf') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_swvdf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_swvdf', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_swvdf', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Faxa_swvdf', mrg_from=compatm, mrg_fld='Faxa_swvdf', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_swvdf', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Faxa_swvdf', mrg_from=compatm, mrg_fld='Faxa_swvdf', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_bcph') - call addfld(fldListTo(complnd)%flds, 'Faxa_bcph') + call addfld(fldListFr(compatm)%fields, 'Faxa_bcph') + call addfld(fldListTo(complnd)%fields, 'Faxa_bcph') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_bcph', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_bcph', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_bcph', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Faxa_bcph', mrg_from=compatm, mrg_fld='Faxa_bcph', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_bcph', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Faxa_bcph', mrg_from=compatm, mrg_fld='Faxa_bcph', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -572,13 +572,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! - hydrophylic organic carbon wet deposition flux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_ocph') - call addfld(fldListTo(complnd)%flds, 'Faxa_ocph') + call addfld(fldListFr(compatm)%fields, 'Faxa_ocph') + call addfld(fldListTo(complnd)%fields, 'Faxa_ocph') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_ocph', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_ocph', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_ocph', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Faxa_ocph', mrg_from=compatm, mrg_fld='Faxa_ocph', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_ocph', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Faxa_ocph', mrg_from=compatm, mrg_fld='Faxa_ocph', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -586,36 +586,36 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: dust dry deposition flux (sizes 1-4) from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_dstwet') - call addfld(fldListTo(complnd)%flds, 'Faxa_dstwet') + call addfld(fldListFr(compatm)%fields, 'Faxa_dstwet') + call addfld(fldListTo(complnd)%fields, 'Faxa_dstwet') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_dstwet', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_dstwet', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_dstwet', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Faxa_dstwet', mrg_from=compatm, mrg_fld='Faxa_dstwet', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_dstwet', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Faxa_dstwet', mrg_from=compatm, mrg_fld='Faxa_dstwet', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_dstdry') - call addfld(fldListTo(complnd)%flds, 'Faxa_dstdry') + call addfld(fldListFr(compatm)%fields, 'Faxa_dstdry') + call addfld(fldListTo(complnd)%fields, 'Faxa_dstdry') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_dstdry', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_dstdry', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_dstdry', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Faxa_dstdry', mrg_from=compatm, mrg_fld='Faxa_dstdry', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_dstdry', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Faxa_dstdry', mrg_from=compatm, mrg_fld='Faxa_dstdry', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: nitrogen deposition fields from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_ndep') - call addfld(fldListTo(complnd)%flds, 'Faxa_ndep') + call addfld(fldListFr(compatm)%fields, 'Faxa_ndep') + call addfld(fldListTo(complnd)%fields, 'Faxa_ndep') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_ndep', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_ndep', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_ndep', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Faxa_ndep', mrg_from=compatm, mrg_fld='Faxa_ndep', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_ndep', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Faxa_ndep', mrg_from=compatm, mrg_fld='Faxa_ndep', mrg_type='copy') end if end if @@ -627,87 +627,87 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: tributary channel depth ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(comprof)%flds, 'Flrr_volr') - call addfld(fldListTo(complnd)%flds, 'Flrr_volr') + call addfld(fldListFr(comprof)%fields, 'Flrr_volr') + call addfld(fldListTo(complnd)%fields, 'Flrr_volr') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volr', rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Flrr_volr', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Flrr_volr', mrg_from=comprof, mrg_fld='Flrr_volr', mrg_type='copy') + call addmap(fldListFr(comprof)%fields, 'Flrr_volr', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Flrr_volr', mrg_from=comprof, mrg_fld='Flrr_volr', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(comprof)%flds, 'Flrr_volrmch') - call addfld(fldListTo(complnd)%flds, 'Flrr_volrmch') + call addfld(fldListFr(comprof)%fields, 'Flrr_volrmch') + call addfld(fldListTo(complnd)%fields, 'Flrr_volrmch') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volrmch', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volrmch', rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Flrr_volrmch', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Flrr_volrmch', mrg_from=comprof, mrg_fld='Flrr_volrmch', mrg_type='copy') + call addmap(fldListFr(comprof)%fields, 'Flrr_volrmch', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Flrr_volrmch', mrg_from=comprof, mrg_fld='Flrr_volrmch', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(comprof)%flds, 'Flrr_flood') - call addfld(fldListTo(complnd)%flds, 'Flrr_flood') + call addfld(fldListFr(comprof)%fields, 'Flrr_flood') + call addfld(fldListTo(complnd)%fields, 'Flrr_flood') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_flood', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood', rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Flrr_flood', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Flrr_flood', mrg_from=comprof, mrg_fld='Flrr_flood', mrg_type='copy') + call addmap(fldListFr(comprof)%fields, 'Flrr_flood', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Flrr_flood', mrg_from=comprof, mrg_fld='Flrr_flood', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(comprof)%flds, 'Sr_tdepth') - call addfld(fldListTo(complnd)%flds, 'Sr_tdepth') + call addfld(fldListFr(comprof)%fields, 'Sr_tdepth') + call addfld(fldListTo(complnd)%fields, 'Sr_tdepth') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Sr_tdepth', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Sr_tdepth', rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Sr_tdepth', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Sr_tdepth', mrg_from=comprof, mrg_fld='Sr_tdepth', mrg_type='copy') + call addmap(fldListFr(comprof)%fields, 'Sr_tdepth', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Sr_tdepth', mrg_from=comprof, mrg_fld='Sr_tdepth', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(comprof)%flds, 'Sr_tdepth_max') - call addfld(fldListTo(complnd)%flds, 'Sr_tdepth_max') + call addfld(fldListFr(comprof)%fields, 'Sr_tdepth_max') + call addfld(fldListTo(complnd)%fields, 'Sr_tdepth_max') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Sr_tdepth_max', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Sr_tdepth_max', rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Sr_tdepth_max', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Sr_tdepth_max', mrg_from=comprof, mrg_fld='Sr_tdepth_max', mrg_type='copy') + call addmap(fldListFr(comprof)%fields, 'Sr_tdepth_max', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Sr_tdepth_max', mrg_from=comprof, mrg_fld='Sr_tdepth_max', mrg_type='copy') end if end if if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(comprof)%flds, 'Flrr_volr_wiso') - call addfld(fldListTo(complnd)%flds, 'Flrr_volr_wiso') + call addfld(fldListFr(comprof)%fields, 'Flrr_volr_wiso') + call addfld(fldListTo(complnd)%fields, 'Flrr_volr_wiso') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volr_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volr_wiso', rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Flrr_volr_wiso', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Flrr_volr_wiso', & + call addmap(fldListFr(comprof)%fields, 'Flrr_volr_wiso', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Flrr_volr_wiso', & mrg_from=comprof, mrg_fld='Flrr_volr_wiso', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(comprof)%flds, 'Flrr_volrmch_wiso') - call addfld(fldListTo(complnd)%flds, 'Flrr_volrmch_wiso') + call addfld(fldListFr(comprof)%fields, 'Flrr_volrmch_wiso') + call addfld(fldListTo(complnd)%fields, 'Flrr_volrmch_wiso') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volrmch_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volrmch_wiso', rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Flrr_volrmch_wiso', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Flrr_volrmch_wiso', & + call addmap(fldListFr(comprof)%fields, 'Flrr_volrmch_wiso', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Flrr_volrmch_wiso', & mrg_from=comprof, mrg_fld='Flrr_volrmch_wiso', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(comprof)%flds, 'Flrr_flood_wiso') - call addfld(fldListTo(complnd)%flds, 'Flrr_flood_wiso') + call addfld(fldListFr(comprof)%fields, 'Flrr_flood_wiso') + call addfld(fldListTo(complnd)%fields, 'Flrr_flood_wiso') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_flood_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood_wiso', rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Flrr_flood_wiso', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Flrr_flood_wiso', & + call addmap(fldListFr(comprof)%fields, 'Flrr_flood_wiso', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Flrr_flood_wiso', & mrg_from=comprof, mrg_fld='Flrr_flood_wiso', mrg_type='copy') end if end if @@ -725,24 +725,24 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (phase == 'advertise') then do ns = 1, is_local%wrap%num_icesheets - call addfld(fldListFr(compglc(ns))%flds, 'Sg_icemask') ! ice sheet grid coverage - call addfld(fldListFr(compglc(ns))%flds, 'Sg_icemask_coupled_fluxes') - call addfld(fldListFr(compglc(ns))%flds, 'Sg_ice_covered') ! fraction of glacier area - call addfld(fldListFr(compglc(ns))%flds, 'Sg_topo') ! surface height of glacer - call addfld(fldListFr(compglc(ns))%flds, 'Flgg_hflx') ! downward heat flux from glacier interior + call addfld(fldListFr(compglc(ns))%fields, 'Sg_icemask') ! ice sheet grid coverage + call addfld(fldListFr(compglc(ns))%fields, 'Sg_icemask_coupled_fluxes') + call addfld(fldListFr(compglc(ns))%fields, 'Sg_ice_covered') ! fraction of glacier area + call addfld(fldListFr(compglc(ns))%fields, 'Sg_topo') ! surface height of glacer + call addfld(fldListFr(compglc(ns))%fields, 'Flgg_hflx') ! downward heat flux from glacier interior end do - call addfld(fldListTo(complnd)%flds, 'Sg_icemask') - call addfld(fldListTo(complnd)%flds, 'Sg_icemask_coupled_fluxes') - call addfld(fldListTo(complnd)%flds, 'Sg_ice_covered_elev') - call addfld(fldListTo(complnd)%flds, 'Sg_topo_elev') - call addfld(fldListTo(complnd)%flds, 'Flgg_hflx_elev') + call addfld(fldListTo(complnd)%fields, 'Sg_icemask') + call addfld(fldListTo(complnd)%fields, 'Sg_icemask_coupled_fluxes') + call addfld(fldListTo(complnd)%fields, 'Sg_ice_covered_elev') + call addfld(fldListTo(complnd)%fields, 'Sg_topo_elev') + call addfld(fldListTo(complnd)%fields, 'Flgg_hflx_elev') else ! custom merge in med_phases_prep_lnd for Sg_icemask and Sg_icemask_coupled_fluxes ! custom map merge in med_phases_prep_lnd for Sg_ice_covered_elev, Sg_topo_elev and Flgg_hflx_elev if ( fldchk(is_local%wrap%FBExp(complnd), 'Sg_icemask', rc=rc)) then do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Sg_icemask', rc=rc)) then - call addmap(fldListFr(compglc(ns))%flds, 'Sg_icemask', & + call addmap(fldListFr(compglc(ns))%fields, 'Sg_icemask', & complnd, mapconsd, 'one', 'unset') end if end do @@ -750,7 +750,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBExp(complnd), 'Sg_icemask_coupled_fluxes', rc=rc)) then do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Sg_icemask_coupled_fluxes', rc=rc)) then - call addmap(fldListFr(compglc(ns))%flds, 'Sg_icemask_coupled_fluxes', & + call addmap(fldListFr(compglc(ns))%fields, 'Sg_icemask_coupled_fluxes', & complnd, mapconsd, 'one', 'unset') end if end do @@ -766,9 +766,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !---------------------------------------------------------- if (phase == 'advertise') then ! the following are computed in med_phases_prep_atm - call addfld(fldListTo(compatm)%flds, 'Sl_lfrac') - call addfld(fldListTo(compatm)%flds, 'Si_ifrac') - call addfld(fldListTo(compatm)%flds, 'So_ofrac') + call addfld(fldListTo(compatm)%fields, 'Sl_lfrac') + call addfld(fldListTo(compatm)%fields, 'Si_ifrac') + call addfld(fldListTo(compatm)%fields, 'So_ofrac') end if ! --------------------------------------------------------------------- @@ -778,108 +778,108 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: merged diffuse albedo (near-infrared radiation) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Sl_avsdr') - call addfld(fldListFr(compice)%flds, 'Si_avsdr') - call addfld(fldListMed_ocnalb%flds , 'So_avsdr') - call addfld(fldListTo(compatm)%flds, 'Sx_avsdr') + call addfld(fldListFr(complnd)%fields, 'Sl_avsdr') + call addfld(fldListFr(compice)%fields, 'Si_avsdr') + call addfld(fldListMed_ocnalb%fields , 'So_avsdr') + call addfld(fldListTo(compatm)%fields, 'Sx_avsdr') else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_avsdr', rc=rc)) then ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_avsdr', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Sl_avsdr', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sx_avsdr', & + call addmap(fldListFr(complnd)%fields, 'Sl_avsdr', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sx_avsdr', & mrg_from=complnd, mrg_fld='Sl_avsdr', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_avsdr', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Si_avsdr', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sx_avsdr', & + call addmap(fldListFr(compice)%fields, 'Si_avsdr', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sx_avsdr', & mrg_from=compice, mrg_fld='Si_avsdr', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_avsdr', rc=rc)) then - call addmap(fldListMed_ocnalb%flds , 'So_avsdr', compatm, mapconsf, 'ofrac', ocn2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sx_avsdr', & + call addmap(fldListMed_ocnalb%fields , 'So_avsdr', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sx_avsdr', & mrg_from=compmed, mrg_fld='So_avsdr', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Sl_avsdf') - call addfld(fldListFr(compice)%flds, 'Si_avsdf') - call addfld(fldListMed_ocnalb%flds , 'So_avsdf') - call addfld(fldListTo(compatm)%flds, 'Sx_avsdf') + call addfld(fldListFr(complnd)%fields, 'Sl_avsdf') + call addfld(fldListFr(compice)%fields, 'Si_avsdf') + call addfld(fldListMed_ocnalb%fields , 'So_avsdf') + call addfld(fldListTo(compatm)%fields, 'Sx_avsdf') else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_avsdf', rc=rc)) then ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_avsdf', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Sl_avsdf', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sx_avsdf', & + call addmap(fldListFr(complnd)%fields, 'Sl_avsdf', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sx_avsdf', & mrg_from=complnd, mrg_fld='Sl_avsdf', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_avsdf', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Si_avsdf', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sx_avsdf', & + call addmap(fldListFr(compice)%fields, 'Si_avsdf', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sx_avsdf', & mrg_from=compice, mrg_fld='Si_avsdf', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_avsdf', rc=rc)) then - call addmap(fldListMed_ocnalb%flds , 'So_avsdf', compatm, mapconsf, 'ofrac', ocn2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sx_avsdf', & + call addmap(fldListMed_ocnalb%fields , 'So_avsdf', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sx_avsdf', & mrg_from=compmed, mrg_fld='So_avsdf', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Sl_anidr') - call addfld(fldListFr(compice)%flds, 'Si_anidr') - call addfld(fldListMed_ocnalb%flds , 'So_anidr') - call addfld(fldListTo(compatm)%flds, 'Sx_anidr') + call addfld(fldListFr(complnd)%fields, 'Sl_anidr') + call addfld(fldListFr(compice)%fields, 'Si_anidr') + call addfld(fldListMed_ocnalb%fields , 'So_anidr') + call addfld(fldListTo(compatm)%fields, 'Sx_anidr') else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_anidr', rc=rc)) then ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_anidr', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Sl_anidr', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sx_anidr', & + call addmap(fldListFr(complnd)%fields, 'Sl_anidr', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sx_anidr', & mrg_from=complnd, mrg_fld='Sl_anidr', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_anidr', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Si_anidr', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sx_anidr', & + call addmap(fldListFr(compice)%fields, 'Si_anidr', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sx_anidr', & mrg_from=compice, mrg_fld='Si_anidr', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_anidr', rc=rc)) then - call addmap(fldListMed_ocnalb%flds , 'So_anidr', compatm, mapconsf, 'ofrac', ocn2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sx_anidr', & + call addmap(fldListMed_ocnalb%fields , 'So_anidr', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sx_anidr', & mrg_from=compmed, mrg_fld='So_anidr', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Sl_anidf') - call addfld(fldListFr(compice)%flds, 'Si_anidf') - call addfld(fldListMed_ocnalb%flds , 'So_anidf') - call addfld(fldListTo(compatm)%flds, 'Sx_anidf') + call addfld(fldListFr(complnd)%fields, 'Sl_anidf') + call addfld(fldListFr(compice)%fields, 'Si_anidf') + call addfld(fldListMed_ocnalb%fields , 'So_anidf') + call addfld(fldListTo(compatm)%fields, 'Sx_anidf') else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_anidf', rc=rc)) then ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_anidf', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Sl_anidf', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sx_anidf', & + call addmap(fldListFr(complnd)%fields, 'Sl_anidf', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sx_anidf', & mrg_from=complnd, mrg_fld='Sl_anidf', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_anidf', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Si_anidf', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sx_anidf', & + call addmap(fldListFr(compice)%fields, 'Si_anidf', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sx_anidf', & mrg_from=compice, mrg_fld='Si_anidf', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_anidf', rc=rc)) then - call addmap(fldListMed_ocnalb%flds , 'So_anidf', compatm, mapconsf, 'ofrac', ocn2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sx_anidf', & + call addmap(fldListMed_ocnalb%fields , 'So_anidf', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sx_anidf', & mrg_from=compmed, mrg_fld='So_anidf', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -893,81 +893,81 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds , 'Sl_tref') - call addfld(fldListFr(compice)%flds , 'Si_tref') - call addfld(fldListMed_aoflux%flds , 'So_tref') - call addfld(fldListTo(compatm)%flds , 'Sx_tref') + call addfld(fldListFr(complnd)%fields , 'Sl_tref') + call addfld(fldListFr(compice)%fields , 'Si_tref') + call addfld(fldListMed_aoflux%fields , 'So_tref') + call addfld(fldListTo(compatm)%fields , '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(fldListFr(complnd)%flds , 'Sl_tref', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Sx_tref', & + call addmap(fldListFr(complnd)%fields , 'Sl_tref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Sx_tref', & mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_tref', rc=rc)) then - call addmap(fldListFr(compice)%flds , 'Si_tref', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Sx_tref', & + call addmap(fldListFr(compice)%fields , 'Si_tref', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields , '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(fldListMed_aoflux%flds , 'So_tref', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap(fldListMed_aoflux%fields , 'So_tref', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%flds , 'Sx_tref', & + call addmrg(fldListTo(compatm)%fields , '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(fldListFr(complnd)%flds , 'Sl_u10') - call addfld(fldListFr(compice)%flds , 'Si_u10') - call addfld(fldListMed_aoflux%flds , 'So_u10') - call addfld(fldListTo(compatm)%flds , 'Sx_u10') + call addfld(fldListFr(complnd)%fields , 'Sl_u10') + call addfld(fldListFr(compice)%fields , 'Si_u10') + call addfld(fldListMed_aoflux%fields , 'So_u10') + call addfld(fldListTo(compatm)%fields , '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(fldListFr(complnd)%flds , 'Sl_u10', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Sx_u10', & + call addmap(fldListFr(complnd)%fields , 'Sl_u10', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Sx_u10', & mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_u10', rc=rc)) then - call addmap(fldListFr(compice)%flds , 'Si_u10', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Sx_u10', & + call addmap(fldListFr(compice)%fields , 'Si_u10', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields , '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(fldListMed_aoflux%flds, 'So_u10', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap(fldListMed_aoflux%fields, 'So_u10', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%flds , 'Sx_u10', & + call addmrg(fldListTo(compatm)%fields , '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(fldListFr(complnd)%flds , 'Sl_qref') - call addfld(fldListFr(compice)%flds , 'Si_qref') - call addfld(fldListMed_aoflux%flds , 'So_qref') - call addfld(fldListTo(compatm)%flds , 'Sx_qref') + call addfld(fldListFr(complnd)%fields , 'Sl_qref') + call addfld(fldListFr(compice)%fields , 'Si_qref') + call addfld(fldListMed_aoflux%fields , 'So_qref') + call addfld(fldListTo(compatm)%fields , '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(fldListFr(complnd)%flds , 'Sl_qref', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Sx_qref', & + call addmap(fldListFr(complnd)%fields , 'Sl_qref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Sx_qref', & mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref', rc=rc)) then - call addmap(fldListFr(compice)%flds , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Sx_qref', & + call addmap(fldListFr(compice)%fields , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields , '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(fldListMed_aoflux%flds, 'So_qref', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap(fldListMed_aoflux%fields, 'So_qref', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%flds , 'Sx_qref', & + call addmrg(fldListTo(compatm)%fields , 'Sx_qref', & mrg_from=compmed, mrg_fld='So_qref', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -975,27 +975,27 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds , 'Sl_qref_wiso') - call addfld(fldListFr(compice)%flds , 'Si_qref_wiso') - call addfld(fldListMed_aoflux%flds , 'So_qref_wiso') - call addfld(fldListTo(compatm)%flds , 'Sx_qref_wiso') + call addfld(fldListFr(complnd)%fields , 'Sl_qref_wiso') + call addfld(fldListFr(compice)%fields , 'Si_qref_wiso') + call addfld(fldListMed_aoflux%fields , 'So_qref_wiso') + call addfld(fldListTo(compatm)%fields , 'Sx_qref_wiso') else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref_wiso', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref_wiso', rc=rc)) then - call addmap(fldListFr(complnd)%flds , 'Sl_qref_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Sx_qref_wiso', & + call addmap(fldListFr(complnd)%fields , 'Sl_qref_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Sx_qref_wiso', & mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref_wiso', rc=rc)) then - call addmap(fldListFr(compice)%flds , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Sx_qref_wiso', & + call addmap(fldListFr(compice)%fields , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Sx_qref_wiso', & mrg_from=compice, mrg_fld='Si_qref_wiso', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_qref_wiso', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%flds , 'So_qref_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) ! map ocn->atm + call addmap(fldListMed_aoflux%fields , 'So_qref_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) ! map ocn->atm end if - call addmrg(fldListTo(compatm)%flds , 'Sx_qref_wiso', & + call addmrg(fldListTo(compatm)%fields , 'Sx_qref_wiso', & mrg_from=compmed, mrg_fld='So_qref_wiso', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1009,81 +1009,81 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: merged reference specific water isoptope humidity at 2 meters ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds , 'Sl_tref') - call addfld(fldListFr(compice)%flds , 'Si_tref') - call addfld(fldListMed_aoflux%flds , 'So_tref') - call addfld(fldListTo(compatm)%flds , 'Sx_tref') + call addfld(fldListFr(complnd)%fields , 'Sl_tref') + call addfld(fldListFr(compice)%fields , 'Si_tref') + call addfld(fldListMed_aoflux%fields , 'So_tref') + call addfld(fldListTo(compatm)%fields , '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(fldListFr(complnd)%flds , 'Sl_tref', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Sx_tref', & + call addmap(fldListFr(complnd)%fields , 'Sl_tref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Sx_tref', & mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_tref', rc=rc)) then - call addmap(fldListFr(compice)%flds , 'Si_tref', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Sx_tref', & + call addmap(fldListFr(compice)%fields , 'Si_tref', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields , '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(fldListMed_aoflux%flds , 'So_tref', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap(fldListMed_aoflux%fields , 'So_tref', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%flds , 'Sx_tref', & + call addmrg(fldListTo(compatm)%fields , '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(fldListFr(complnd)%flds , 'Sl_u10') - call addfld(fldListFr(compice)%flds , 'Si_u10') - call addfld(fldListMed_aoflux%flds , 'So_u10') - call addfld(fldListTo(compatm)%flds , 'Sx_u10') + call addfld(fldListFr(complnd)%fields , 'Sl_u10') + call addfld(fldListFr(compice)%fields , 'Si_u10') + call addfld(fldListMed_aoflux%fields , 'So_u10') + call addfld(fldListTo(compatm)%fields , '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(fldListFr(complnd)%flds , 'Sl_u10', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Sx_u10', & + call addmap(fldListFr(complnd)%fields , 'Sl_u10', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Sx_u10', & mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_u10', rc=rc)) then - call addmap(fldListFr(compice)%flds , 'Si_u10', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Sx_u10', & + call addmap(fldListFr(compice)%fields , 'Si_u10', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields , '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(fldListMed_aoflux%flds, 'So_u10', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap(fldListMed_aoflux%fields, 'So_u10', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%flds , 'Sx_u10', & + call addmrg(fldListTo(compatm)%fields , '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(fldListFr(complnd)%flds , 'Sl_qref') - call addfld(fldListFr(compice)%flds , 'Si_qref') - call addfld(fldListMed_aoflux%flds , 'So_qref') - call addfld(fldListTo(compatm)%flds , 'Sx_qref') + call addfld(fldListFr(complnd)%fields , 'Sl_qref') + call addfld(fldListFr(compice)%fields , 'Si_qref') + call addfld(fldListMed_aoflux%fields , 'So_qref') + call addfld(fldListTo(compatm)%fields , '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(fldListFr(complnd)%flds , 'Sl_qref', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Sx_qref', & + call addmap(fldListFr(complnd)%fields , 'Sl_qref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Sx_qref', & mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref', rc=rc)) then - call addmap(fldListFr(compice)%flds , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Sx_qref', & + call addmap(fldListFr(compice)%fields , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields , '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(fldListMed_aoflux%flds, 'So_qref', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap(fldListMed_aoflux%fields, 'So_qref', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%flds , 'Sx_qref', & + call addmrg(fldListTo(compatm)%fields , 'Sx_qref', & mrg_from=compmed, mrg_fld='So_qref', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1091,27 +1091,27 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds , 'Sl_qref_wiso') - call addfld(fldListFr(compice)%flds , 'Si_qref_wiso') - call addfld(fldListMed_aoflux%flds , 'So_qref_wiso') - call addfld(fldListTo(compatm)%flds , 'Sx_qref_wiso') + call addfld(fldListFr(complnd)%fields , 'Sl_qref_wiso') + call addfld(fldListFr(compice)%fields , 'Si_qref_wiso') + call addfld(fldListMed_aoflux%fields , 'So_qref_wiso') + call addfld(fldListTo(compatm)%fields , 'Sx_qref_wiso') else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref_wiso', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref_wiso', rc=rc)) then - call addmap(fldListFr(complnd)%flds , 'Sl_qref_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Sx_qref_wiso', & + call addmap(fldListFr(complnd)%fields , 'Sl_qref_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Sx_qref_wiso', & mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref_wiso', rc=rc)) then - call addmap(fldListFr(compice)%flds , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Sx_qref_wiso', & + call addmap(fldListFr(compice)%fields , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Sx_qref_wiso', & mrg_from=compice, mrg_fld='Si_qref_wiso', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_qref_wiso', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%flds, 'So_qref_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap(fldListMed_aoflux%fields, 'So_qref_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%flds , 'Sx_qref_wiso', & + call addmrg(fldListTo(compatm)%fields , 'Sx_qref_wiso', & mrg_from=compmed, mrg_fld='So_qref_wiso', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1127,162 +1127,162 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: evaporation water flux from water isotopes ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListTo(compatm)%flds, 'Faxx_taux') - call addfld(fldListFr(complnd)%flds, 'Fall_taux') - call addfld(fldListFr(compice)%flds, 'Faii_taux') - call addfld(fldListMed_aoflux%flds , 'Faox_taux') + call addfld(fldListTo(compatm)%fields, 'Faxx_taux') + call addfld(fldListFr(complnd)%fields, 'Fall_taux') + call addfld(fldListFr(compice)%fields, 'Faii_taux') + call addfld(fldListMed_aoflux%fields , 'Faox_taux') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_taux', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_taux', rc=rc)) then - call addmap(fldListFr(complnd)%flds , 'Fall_taux', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Faxx_taux', & + call addmap(fldListFr(complnd)%fields , 'Fall_taux', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Faxx_taux', & mrg_from=complnd, mrg_fld='Fall_taux', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_taux', rc=rc)) then - call addmap(fldListFr(compice)%flds , 'Faii_taux', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Faxx_taux', & + call addmap(fldListFr(compice)%fields , 'Faii_taux', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Faxx_taux', & mrg_from=compice, mrg_fld='Faii_taux', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_taux', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%flds , 'Faox_taux', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap(fldListMed_aoflux%fields , 'Faox_taux', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%flds , 'Faxx_taux', & + call addmrg(fldListTo(compatm)%fields , 'Faxx_taux', & mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfld(fldListTo(compatm)%flds, 'Faxx_tauy') - call addfld(fldListFr(complnd)%flds, 'Fall_tauy') - call addfld(fldListFr(compice)%flds, 'Faii_tauy') - call addfld(fldListMed_aoflux%flds , 'Faox_tauy') + call addfld(fldListTo(compatm)%fields, 'Faxx_tauy') + call addfld(fldListFr(complnd)%fields, 'Fall_tauy') + call addfld(fldListFr(compice)%fields, 'Faii_tauy') + call addfld(fldListMed_aoflux%fields , 'Faox_tauy') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_tauy', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_tauy', rc=rc)) then - call addmap(fldListFr(complnd)%flds , 'Fall_tauy', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Faxx_tauy', & + call addmap(fldListFr(complnd)%fields , 'Fall_tauy', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Faxx_tauy', & mrg_from=complnd, mrg_fld='Fall_tauy', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_tauy', rc=rc)) then - call addmap(fldListFr(compice)%flds , 'Faii_tauy', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Faxx_tauy', & + call addmap(fldListFr(compice)%fields , 'Faii_tauy', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Faxx_tauy', & mrg_from=compice, mrg_fld='Faii_tauy', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_tauy', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%flds , 'Faox_tauy', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap(fldListMed_aoflux%fields , 'Faox_tauy', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%flds , 'Faxx_tauy', & + call addmrg(fldListTo(compatm)%fields , 'Faxx_tauy', & mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfld(fldListTo(compatm)%flds, 'Faxx_lat') - call addfld(fldListFr(complnd)%flds, 'Fall_lat') - call addfld(fldListFr(compice)%flds, 'Faii_lat') - call addfld(fldListMed_aoflux%flds , 'Faox_lat') + call addfld(fldListTo(compatm)%fields, 'Faxx_lat') + call addfld(fldListFr(complnd)%fields, 'Fall_lat') + call addfld(fldListFr(compice)%fields, 'Faii_lat') + call addfld(fldListMed_aoflux%fields , 'Faox_lat') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lat', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lat', rc=rc)) then - call addmap(fldListFr(complnd)%flds , 'Fall_lat', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Faxx_lat', & + call addmap(fldListFr(complnd)%fields , 'Fall_lat', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Faxx_lat', & mrg_from=complnd, mrg_fld='Fall_lat', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_lat', rc=rc)) then - call addmap(fldListFr(compice)%flds , 'Faii_lat', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Faxx_lat', & + call addmap(fldListFr(compice)%fields , 'Faii_lat', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Faxx_lat', & mrg_from=compice, mrg_fld='Faii_lat', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lat', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%flds , 'Faox_lat', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap(fldListMed_aoflux%fields , 'Faox_lat', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%flds , 'Faxx_lat', & + call addmrg(fldListTo(compatm)%fields , 'Faxx_lat', & mrg_from=compmed, mrg_fld='Faox_lat', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfld(fldListTo(compatm)%flds, 'Faxx_sen') - call addfld(fldListFr(complnd)%flds, 'Fall_sen') - call addfld(fldListFr(compice)%flds, 'Faii_sen') - call addfld(fldListMed_aoflux%flds , 'Faox_sen') + call addfld(fldListTo(compatm)%fields, 'Faxx_sen') + call addfld(fldListFr(complnd)%fields, 'Fall_sen') + call addfld(fldListFr(compice)%fields, 'Faii_sen') + call addfld(fldListMed_aoflux%fields , 'Faox_sen') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_sen', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_sen', rc=rc)) then - call addmap(fldListFr(complnd)%flds , 'Fall_sen', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Faxx_sen', & + call addmap(fldListFr(complnd)%fields , 'Fall_sen', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Faxx_sen', & mrg_from=complnd, mrg_fld='Fall_sen', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_sen', rc=rc)) then - call addmap(fldListFr(compice)%flds , 'Faii_sen', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Faxx_sen', & + call addmap(fldListFr(compice)%fields , 'Faii_sen', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Faxx_sen', & mrg_from=compice, mrg_fld='Faii_sen', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_sen', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%flds , 'Faox_sen', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap(fldListMed_aoflux%fields , 'Faox_sen', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%flds , 'Faxx_sen', & + call addmrg(fldListTo(compatm)%fields , 'Faxx_sen', & mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfld(fldListTo(compatm)%flds, 'Faxx_evap') - call addfld(fldListFr(complnd)%flds, 'Fall_evap') - call addfld(fldListFr(compice)%flds, 'Faii_evap') - call addfld(fldListMed_aoflux%flds , 'Faox_evap') + call addfld(fldListTo(compatm)%fields, 'Faxx_evap') + call addfld(fldListFr(complnd)%fields, 'Fall_evap') + call addfld(fldListFr(compice)%fields, 'Faii_evap') + call addfld(fldListMed_aoflux%fields , 'Faox_evap') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap', rc=rc)) then - call addmap(fldListFr(complnd)%flds , 'Fall_evap', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Faxx_evap', & + call addmap(fldListFr(complnd)%fields , 'Fall_evap', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Faxx_evap', & mrg_from=complnd, mrg_fld='Fall_evap', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap', rc=rc)) then - call addmap(fldListFr(compice)%flds , 'Faii_evap', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Faxx_evap', & + call addmap(fldListFr(compice)%fields , 'Faii_evap', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Faxx_evap', & mrg_from=compice, mrg_fld='Faii_evap', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_evap', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%flds , 'Faox_evap', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap(fldListMed_aoflux%fields , 'Faox_evap', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%flds , 'Faxx_evap', & + call addmrg(fldListTo(compatm)%fields , 'Faxx_evap', & mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfld(fldListTo(compatm)%flds, 'Faxx_lwup') - call addfld(fldListFr(complnd)%flds, 'Fall_lwup') - call addfld(fldListFr(compice)%flds, 'Faii_lwup') - call addfld(fldListMed_aoflux%flds , 'Faox_lwup') + call addfld(fldListTo(compatm)%fields, 'Faxx_lwup') + call addfld(fldListFr(complnd)%fields, 'Fall_lwup') + call addfld(fldListFr(compice)%fields, 'Faii_lwup') + call addfld(fldListMed_aoflux%fields , 'Faox_lwup') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lwup', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lwup', rc=rc)) then - call addmap(fldListFr(complnd)%flds , 'Fall_lwup', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Faxx_lwup', & + call addmap(fldListFr(complnd)%fields , 'Fall_lwup', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Faxx_lwup', & mrg_from=complnd, mrg_fld='Fall_lwup', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_lwup', rc=rc)) then - call addmap(fldListFr(compice)%flds , 'Faii_lwup', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Faxx_lwup', & + call addmap(fldListFr(compice)%fields , 'Faii_lwup', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Faxx_lwup', & mrg_from=compice, mrg_fld='Faii_lwup', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lwup', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%flds, 'Faox_lwup', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap(fldListMed_aoflux%fields, 'Faox_lwup', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%flds, 'Faxx_lwup', & + call addmrg(fldListTo(compatm)%fields, 'Faxx_lwup', & mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1290,27 +1290,27 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListTo(compatm)%flds, 'Faxx_evap_wiso') - call addfld(fldListFr(complnd)%flds, 'Fall_evap_wiso') - call addfld(fldListFr(compice)%flds, 'Faii_evap_wiso') - call addfld(fldListMed_aoflux%flds , 'Faox_evap_wiso') + call addfld(fldListTo(compatm)%fields, 'Faxx_evap_wiso') + call addfld(fldListFr(complnd)%fields, 'Fall_evap_wiso') + call addfld(fldListFr(compice)%fields, 'Faii_evap_wiso') + call addfld(fldListMed_aoflux%fields , 'Faox_evap_wiso') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap_wiso', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap_wiso', rc=rc)) then - call addmap(fldListFr(complnd)%flds , 'Fall_evap_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Faxx_evap_wiso', & + call addmap(fldListFr(complnd)%fields , 'Fall_evap_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Faxx_evap_wiso', & mrg_from=complnd, mrg_fld='Fall_evap_wiso', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap_wiso', rc=rc)) then - call addmap(fldListFr(compice)%flds , 'Faii_evap_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds , 'Faxx_evap_wiso', & + call addmap(fldListFr(compice)%fields , 'Faii_evap_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields , 'Faxx_evap_wiso', & mrg_from=compice, mrg_fld='Faii_evap_wiso', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_evap_wiso', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%flds, 'Faox_evap_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap(fldListMed_aoflux%fields, 'Faox_evap_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%flds , 'Faxx_evap_wiso', & + call addmrg(fldListTo(compatm)%fields , 'Faxx_evap_wiso', & mrg_from=compmed, mrg_fld='Faox_evap_wiso', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1321,31 +1321,31 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: merged surface temperature and unmerged temperatures from ice and ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Sl_t') - call addfld(fldListFr(compice)%flds, 'Si_t') - call addfld(fldListFr(compocn)%flds, 'So_t') - call addfld(fldListTo(compatm)%flds, 'So_t') - call addfld(fldListTo(compatm)%flds, 'Sx_t') + call addfld(fldListFr(complnd)%fields, 'Sl_t') + call addfld(fldListFr(compice)%fields, 'Si_t') + call addfld(fldListFr(compocn)%fields, 'So_t') + call addfld(fldListTo(compatm)%fields, 'So_t') + call addfld(fldListTo(compatm)%fields, 'Sx_t') else if (fldchk(is_local%wrap%FBexp(compatm), 'Sx_t', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_t', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Sl_t', compatm, mapconsf , 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sx_t', & + call addmap(fldListFr(complnd)%fields, 'Sl_t', compatm, mapconsf , 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sx_t', & mrg_from=complnd, mrg_fld='Sl_t', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_t', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Si_t', compatm, mapconsf , 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sx_t', & + call addmap(fldListFr(compice)%fields, 'Si_t', compatm, mapconsf , 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sx_t', & mrg_from=compice, mrg_fld='Si_t', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_t', rc=rc)) then - call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapconsf, 'ofrac', ocn2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sx_t', & + call addmap(fldListFr(compocn)%fields, 'So_t', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sx_t', & mrg_from=compocn, mrg_fld='So_t', mrg_type='merge', mrg_fracname='ofrac') end if end if if (fldchk(is_local%wrap%FBexp(compatm), 'So_t', rc=rc)) then - call addmrg(fldListTo(compatm)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + call addmrg(fldListTo(compatm)%fields, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') end if end if @@ -1355,33 +1355,33 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: mean snow volume per unit area from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compice)%flds, 'Si_snowh') - call addfld(fldListTo(compatm)%flds, 'Si_snowh') + call addfld(fldListFr(compice)%fields, 'Si_snowh') + call addfld(fldListTo(compatm)%fields, 'Si_snowh') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Si_snowh', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), 'Si_snowh', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Si_snowh', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Si_snowh', mrg_from=compice, mrg_fld='Si_snowh', mrg_type='copy') + call addmap(fldListFr(compice)%fields, 'Si_snowh', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Si_snowh', mrg_from=compice, mrg_fld='Si_snowh', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compice)%flds, 'Si_vice') - call addfld(fldListTo(compatm)%flds, 'Si_vice') + call addfld(fldListFr(compice)%fields, 'Si_vice') + call addfld(fldListTo(compatm)%fields, 'Si_vice') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Si_vice', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), 'Si_vice', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Si_vice', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Si_vice', mrg_from=compice, mrg_fld='Si_vice', mrg_type='copy') + call addmap(fldListFr(compice)%fields, 'Si_vice', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Si_vice', mrg_from=compice, mrg_fld='Si_vice', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compice)%flds, 'Si_vsno') - call addfld(fldListTo(compatm)%flds, 'Si_vsno') + call addfld(fldListFr(compice)%fields, 'Si_vsno') + call addfld(fldListTo(compatm)%fields, 'Si_vsno') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Si_vsno', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), 'Si_vsno', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Si_vsno', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Si_vsno', mrg_from=compice, mrg_fld='Si_vsno', mrg_type='copy') + call addmap(fldListFr(compice)%fields, 'Si_vsno', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Si_vsno', mrg_from=compice, mrg_fld='Si_vsno', mrg_type='copy') end if end if @@ -1391,39 +1391,39 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: surface fraction velocity from med aoflux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListMed_aoflux%flds , 'So_ssq') - call addfld(fldListTo(compatm)%flds , 'So_ssq') + call addfld(fldListMed_aoflux%fields , 'So_ssq') + call addfld(fldListTo(compatm)%fields , 'So_ssq') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'So_ssq', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'So_ssq', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%flds , 'So_ssq', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap(fldListMed_aoflux%fields , 'So_ssq', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%flds , 'So_ssq', mrg_from=compmed, mrg_fld='So_ssq', mrg_type='copy') + call addmrg(fldListTo(compatm)%fields , 'So_ssq', mrg_from=compmed, mrg_fld='So_ssq', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListMed_aoflux%flds , 'So_re') - call addfld(fldListTo(compatm)%flds , 'So_re') + call addfld(fldListMed_aoflux%fields , 'So_re') + call addfld(fldListTo(compatm)%fields , 'So_re') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'So_re', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'So_re', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%flds , 'So_re', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap(fldListMed_aoflux%fields , 'So_re', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%flds , 'So_re', mrg_from=compmed, mrg_fld='So_re', mrg_type='copy') + call addmrg(fldListTo(compatm)%fields , 'So_re', mrg_from=compmed, mrg_fld='So_re', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListMed_aoflux%flds , 'So_ustar') - call addfld(fldListTo(compatm)%flds , 'So_ustar') + call addfld(fldListMed_aoflux%fields , 'So_ustar') + call addfld(fldListTo(compatm)%fields , 'So_ustar') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'So_ustar', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'So_ustar', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%flds , 'So_ustar', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap(fldListMed_aoflux%fields , 'So_ustar', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%flds , 'So_ustar', mrg_from=compmed, mrg_fld='So_ustar', mrg_type='copy') + call addmrg(fldListTo(compatm)%fields , 'So_ustar', mrg_from=compmed, mrg_fld='So_ustar', mrg_type='copy') end if end if @@ -1433,59 +1433,59 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: surface snow water equivalent from land ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Sl_fv') - call addfld(fldListTo(compatm)%flds, 'Sl_fv') + call addfld(fldListFr(complnd)%fields, 'Sl_fv') + call addfld(fldListTo(compatm)%fields, 'Sl_fv') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_fv', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_fv', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Sl_fv', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sl_fv', mrg_from=complnd, mrg_fld='Sl_fv', mrg_type='copy') + call addmap(fldListFr(complnd)%fields, 'Sl_fv', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sl_fv', mrg_from=complnd, mrg_fld='Sl_fv', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Sl_ram1') - call addfld(fldListTo(compatm)%flds, 'Sl_ram1') + call addfld(fldListFr(complnd)%fields, 'Sl_ram1') + call addfld(fldListTo(compatm)%fields, 'Sl_ram1') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_ram1', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_ram1', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Sl_ram1', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sl_ram1', mrg_from=complnd, mrg_fld='Sl_ram1', mrg_type='copy') + call addmap(fldListFr(complnd)%fields, 'Sl_ram1', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sl_ram1', mrg_from=complnd, mrg_fld='Sl_ram1', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Sl_snowh') - call addfld(fldListTo(compatm)%flds, 'Sl_snowh') + call addfld(fldListFr(complnd)%fields, 'Sl_snowh') + call addfld(fldListTo(compatm)%fields, 'Sl_snowh') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_snowh', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_snowh', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Sl_snowh', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sl_snowh', mrg_from=complnd, mrg_fld='Sl_snowh', mrg_type='copy') + call addmap(fldListFr(complnd)%fields, 'Sl_snowh', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sl_snowh', mrg_from=complnd, mrg_fld='Sl_snowh', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! CARMA fields (volumetric soil water) !----------------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Sl_soilw') - call addfld(fldListTo(compatm)%flds, 'Sl_soilw') + call addfld(fldListFr(complnd)%fields, 'Sl_soilw') + call addfld(fldListTo(compatm)%fields, 'Sl_soilw') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_soilw', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_soilw', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Sl_soilw', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sl_soilw', mrg_from=complnd, mrg_fld='Sl_soilw', mrg_type='copy') + call addmap(fldListFr(complnd)%fields, 'Sl_soilw', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sl_soilw', mrg_from=complnd, mrg_fld='Sl_soilw', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to atm: dust fluxes from land (4 sizes) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Fall_flxdst') - call addfld(fldListTo(compatm)%flds, 'Fall_flxdst') + call addfld(fldListFr(complnd)%fields, 'Fall_flxdst') + call addfld(fldListTo(compatm)%fields, 'Fall_flxdst') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_flxdst', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_flxdst', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Fall_flxdst', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Fall_flxdst', & + call addmap(fldListFr(complnd)%fields, 'Fall_flxdst', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Fall_flxdst', & mrg_from=complnd, mrg_fld='Fall_flxdst', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if @@ -1493,13 +1493,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: MEGAN emissions fluxes from land !----------------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Fall_voc') - call addfld(fldListTo(compatm)%flds, 'Fall_voc') + call addfld(fldListFr(complnd)%fields, 'Fall_voc') + call addfld(fldListTo(compatm)%fields, 'Fall_voc') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_voc', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_voc', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Fall_voc', compatm, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(compatm)%flds, 'Fall_voc', & + call addmap(fldListFr(complnd)%fields, 'Fall_voc', compatm, mapconsf, 'one', atm2lnd_map) + call addmrg(fldListTo(compatm)%fields, 'Fall_voc', & mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='merge', mrg_fracname='lfrac') end if end if @@ -1508,38 +1508,38 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------------------------------------------------------- ! 'wild fire emission fluxes' if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Fall_fire') - call addfld(fldListTo(compatm)%flds, 'Fall_fire') + call addfld(fldListFr(complnd)%fields, 'Fall_fire') + call addfld(fldListTo(compatm)%fields, 'Fall_fire') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_fire', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_fire', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Fall_fire', compatm, mapconsf, 'one', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Fall_fire', & + call addmap(fldListFr(complnd)%fields, 'Fall_fire', compatm, mapconsf, 'one', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Fall_fire', & mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='merge', mrg_fracname='lfrac') end if end if ! 'wild fire plume height' if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Sl_fztop') - call addfld(fldListTo(compatm)%flds, 'Sl_fztop') + call addfld(fldListFr(complnd)%fields, 'Sl_fztop') + call addfld(fldListTo(compatm)%fields, 'Sl_fztop') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Sl_fztop', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Sl_fztop', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Sl_fztop', compatm, mapconsf, 'one', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sl_fztop', mrg_from=complnd, mrg_fld='Sl_fztop', mrg_type='copy') + call addmap(fldListFr(complnd)%fields, 'Sl_fztop', compatm, mapconsf, 'one', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sl_fztop', mrg_from=complnd, mrg_fld='Sl_fztop', mrg_type='copy') end if end if !----------------------------------------------------------------------------- ! to atm: dry deposition velocities from land !----------------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Sl_ddvel') - call addfld(fldListTo(compatm)%flds, 'Sl_ddvel') + call addfld(fldListFr(complnd)%fields, 'Sl_ddvel') + call addfld(fldListTo(compatm)%fields, 'Sl_ddvel') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Sl_ddvel', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Sl_ddvel', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Sl_ddvel', compatm, mapconsf, 'one', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Sl_ddvel', mrg_from=complnd, mrg_fld='Sl_ddvel', mrg_type='copy') + call addmap(fldListFr(complnd)%fields, 'Sl_ddvel', compatm, mapconsf, 'one', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Sl_ddvel', mrg_from=complnd, mrg_fld='Sl_ddvel', mrg_type='copy') end if end if @@ -1551,11 +1551,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: fractional ice coverage wrt ocean from ice !---------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compice)%flds, 'Si_ifrac') - call addfld(fldListTo(compocn)%flds, 'Si_ifrac') + call addfld(fldListFr(compice)%fields, 'Si_ifrac') + call addfld(fldListTo(compocn)%fields, 'Si_ifrac') else - call addmap(fldListFr(compice)%flds, 'Si_ifrac', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') + call addmap(fldListFr(compice)%fields, 'Si_ifrac', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%fields, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') end if ! --------------------------------------------------------------------- @@ -1566,57 +1566,57 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: downward diffuse visible incident solar radiation from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_lwdn') - call addfld(fldListTo(compocn)%flds, 'Faxa_lwdn') + call addfld(fldListFr(compatm)%fields, 'Faxa_lwdn') + call addfld(fldListTo(compocn)%fields, 'Faxa_lwdn') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_lwdn', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_lwdn', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_lwdn', & + call addmap(fldListFr(compatm)%fields, 'Faxa_lwdn', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%fields, 'Faxa_lwdn', & mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_swndr') - call addfld(fldListTo(compocn)%flds, 'Faxa_swndr') + call addfld(fldListFr(compatm)%fields, 'Faxa_swndr') + call addfld(fldListTo(compocn)%fields, 'Faxa_swndr') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_swndr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndr', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_swndr', & + call addmap(fldListFr(compatm)%fields, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%fields, 'Faxa_swndr', & mrg_from=compatm, mrg_fld='Faxa_swndr', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_swndf') - call addfld(fldListTo(compocn)%flds, 'Faxa_swndf') + call addfld(fldListFr(compatm)%fields, 'Faxa_swndf') + call addfld(fldListTo(compocn)%fields, 'Faxa_swndf') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_swndf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndf', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_swndf', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_swndf', & + call addmap(fldListFr(compatm)%fields, 'Faxa_swndf', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%fields, 'Faxa_swndf', & mrg_from=compatm, mrg_fld='Faxa_swndf', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_swvdr') - call addfld(fldListTo(compocn)%flds, 'Faxa_swvdr') + call addfld(fldListFr(compatm)%fields, 'Faxa_swvdr') + call addfld(fldListTo(compocn)%fields, 'Faxa_swvdr') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_swvdr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdr', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_swvdr', & + call addmap(fldListFr(compatm)%fields, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%fields, 'Faxa_swvdr', & mrg_from=compatm, mrg_fld='Faxa_swvdr', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_swvdf') - call addfld(fldListTo(compocn)%flds, 'Faxa_swvdf') + call addfld(fldListFr(compatm)%fields, 'Faxa_swvdf') + call addfld(fldListTo(compocn)%fields, 'Faxa_swvdf') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_swvdf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdf', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_swvdf', & + call addmap(fldListFr(compatm)%fields, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%fields, 'Faxa_swvdf', & mrg_from=compatm, mrg_fld='Faxa_swvdf', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if @@ -1625,12 +1625,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: surface upward longwave heat flux from mediator ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListMed_aoflux%flds , 'Faox_lwup') - call addfld(fldListTo(compocn)%flds , 'Foxx_lwup') + call addfld(fldListMed_aoflux%fields , 'Faox_lwup') + call addfld(fldListTo(compocn)%fields , 'Foxx_lwup') else if ( fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lwup', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn), 'Foxx_lwup', rc=rc)) then - call addmrg(fldListTo(compocn)%flds, 'Foxx_lwup', & + call addmrg(fldListTo(compocn)%fields, 'Foxx_lwup', & mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1638,18 +1638,18 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: merged longwave net heat flux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds , 'Faxa_lwdn') - call addfld(fldListMed_aoflux%flds , 'Faox_lwup' ) - call addfld(fldListTo(compocn)%flds , 'Foxx_lwnet') + call addfld(fldListFr(compatm)%fields , 'Faxa_lwdn') + call addfld(fldListMed_aoflux%fields , 'Faox_lwup' ) + call addfld(fldListTo(compocn)%fields , 'Foxx_lwnet') else ! (mom6) (send longwave net to ocn via auto merge) if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_lwnet', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_lwup' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn' , rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_lwdn', compocn, mapconsf, 'one' , atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Foxx_lwnet', & + call addmap(fldListFr(compatm)%fields, 'Faxa_lwdn', compocn, mapconsf, 'one' , atm2ocn_map) + call addmrg(fldListTo(compocn)%fields, 'Foxx_lwnet', & mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') - call addmrg(fldListTo(compocn)%flds, 'Foxx_lwnet', & + call addmrg(fldListTo(compocn)%fields, 'Foxx_lwnet', & mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1657,13 +1657,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: downward shortwave heat flux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_swdn') - call addfld(fldListTo(compocn)%flds, 'Faxa_swdn') + call addfld(fldListFr(compatm)%fields, 'Faxa_swdn') + call addfld(fldListTo(compocn)%fields, 'Faxa_swdn') else if (fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_swdn', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_swdn', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_swdn', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_swdn', & + call addmap(fldListFr(compatm)%fields, 'Faxa_swdn', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%fields, 'Faxa_swdn', & mrg_from=compatm, mrg_fld='Faxa_swdn', mrg_type='copy') end if end if @@ -1671,28 +1671,28 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: net shortwave radiation from med ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_swvdr') - call addfld(fldListFr(compatm)%flds, 'Faxa_swndr') - call addfld(fldListFr(compatm)%flds, 'Faxa_swvdf') - call addfld(fldListFr(compatm)%flds, 'Faxa_swndf') + call addfld(fldListFr(compatm)%fields, 'Faxa_swvdr') + call addfld(fldListFr(compatm)%fields, 'Faxa_swndr') + call addfld(fldListFr(compatm)%fields, 'Faxa_swvdf') + call addfld(fldListFr(compatm)%fields, 'Faxa_swndf') - call addfld(fldListFr(compice)%flds, 'Fioi_swpen') - call addfld(fldListFr(compice)%flds, 'Fioi_swpen_vdr') - call addfld(fldListFr(compice)%flds, 'Fioi_swpen_vdf') - call addfld(fldListFr(compice)%flds, 'Fioi_swpen_idr') - call addfld(fldListFr(compice)%flds, 'Fioi_swpen_idf') + call addfld(fldListFr(compice)%fields, 'Fioi_swpen') + call addfld(fldListFr(compice)%fields, 'Fioi_swpen_vdr') + call addfld(fldListFr(compice)%fields, 'Fioi_swpen_vdf') + call addfld(fldListFr(compice)%fields, 'Fioi_swpen_idr') + call addfld(fldListFr(compice)%fields, 'Fioi_swpen_idf') - call addfld(fldListTo(compocn)%flds, 'Foxx_swnet') - call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_vdr') - call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_vdf') - call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_idr') - call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_idf') + call addfld(fldListTo(compocn)%fields, 'Foxx_swnet') + call addfld(fldListTo(compocn)%fields, 'Foxx_swnet_vdr') + call addfld(fldListTo(compocn)%fields, 'Foxx_swnet_vdf') + call addfld(fldListTo(compocn)%fields, 'Foxx_swnet_idr') + call addfld(fldListTo(compocn)%fields, 'Foxx_swnet_idf') else ! Net shortwave ocean (custom calculation in prep_phases_ocn_mod.F90) ! import swpen from ice without bands if (fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Fioi_swpen', compocn, mapfcopy, 'unset', 'unset') + call addmap(fldListFr(compice)%fields, 'Fioi_swpen', compocn, mapfcopy, 'unset', 'unset') end if ! import swpen from ice by bands @@ -1700,10 +1700,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_idr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_idf', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Fioi_swpen_vdr', compocn, mapfcopy, 'unset', 'unset') - call addmap(fldListFr(compice)%flds, 'Fioi_swpen_vdf', compocn, mapfcopy, 'unset', 'unset') - call addmap(fldListFr(compice)%flds, 'Fioi_swpen_idr', compocn, mapfcopy, 'unset', 'unset') - call addmap(fldListFr(compice)%flds, 'Fioi_swpen_idf', compocn, mapfcopy, 'unset', 'unset') + call addmap(fldListFr(compice)%fields, 'Fioi_swpen_vdr', compocn, mapfcopy, 'unset', 'unset') + call addmap(fldListFr(compice)%fields, 'Fioi_swpen_vdf', compocn, mapfcopy, 'unset', 'unset') + call addmap(fldListFr(compice)%fields, 'Fioi_swpen_idr', compocn, mapfcopy, 'unset', 'unset') + call addmap(fldListFr(compice)%fields, 'Fioi_swpen_idf', compocn, mapfcopy, 'unset', 'unset') end if ! import sw from atm by bands @@ -1716,10 +1716,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc))) then - call addmap(fldListFr(compatm)%flds, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%flds, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%flds, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%flds, 'Faxa_swndf', compocn, mapconsf, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Faxa_swndf', compocn, mapconsf, 'one', atm2ocn_map) end if end if @@ -1729,27 +1729,27 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_i2o_per_cat) then if (phase == 'advertise') then ! 'fractional ice coverage wrt ocean for each thickness category ' - call addfld(fldListFr(compice)%flds, 'Si_ifrac_n') - call addfld(fldListTo(compocn)%flds, 'Si_ifrac_n') + call addfld(fldListFr(compice)%fields, 'Si_ifrac_n') + call addfld(fldListTo(compocn)%fields, 'Si_ifrac_n') ! net shortwave radiation penetrating into ocean for each thickness category - call addfld(fldListFr(compice)%flds, 'Fioi_swpen_ifrac_n') - call addfld(fldListTo(compocn)%flds, 'Fioi_swpen_ifrac_n') + call addfld(fldListFr(compice)%fields, 'Fioi_swpen_ifrac_n') + call addfld(fldListTo(compocn)%fields, 'Fioi_swpen_ifrac_n') ! 'fractional atmosphere coverage wrt ocean' (computed in med_phases_prep_ocn) - call addfld(fldListTo(compocn)%flds, 'Sf_afrac') + call addfld(fldListTo(compocn)%fields, 'Sf_afrac') ! 'fractional atmosphere coverage used in radiation computations wrt ocean' (computed in med_phases_prep_ocn) - call addfld(fldListTo(compocn)%flds, 'Sf_afracr') + call addfld(fldListTo(compocn)%fields, 'Sf_afracr') ! 'net shortwave radiation times atmosphere fraction' (computed in med_phases_prep_ocn) - call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_afracr') + call addfld(fldListTo(compocn)%fields, 'Foxx_swnet_afracr') else - call addmap(fldListFr(compice)%flds, 'Si_ifrac_n', & + call addmap(fldListFr(compice)%fields, 'Si_ifrac_n', & compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Si_ifrac_n', & + call addmrg(fldListTo(compocn)%fields, 'Si_ifrac_n', & mrg_from=compice, mrg_fld='Si_ifrac_n', mrg_type='copy') - call addmap(fldListFr(compice)%flds, 'Fioi_swpen_ifrac_n', & + call addmap(fldListFr(compice)%fields, 'Fioi_swpen_ifrac_n', & compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Fioi_swpen_ifrac_n', & + call addmrg(fldListTo(compocn)%fields, 'Fioi_swpen_ifrac_n', & mrg_from=compice, mrg_fld='Fioi_swpen_ifrac_n', mrg_type='copy') ! Note that 'Sf_afrac, 'Sf_afracr' and 'Foxx_swnet_afracr' will have explicit merging in med_phases_prep_ocn end if @@ -1761,12 +1761,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_rainc') - call addfld(fldListFr(compatm)%flds, 'Faxa_rainl') - call addfld(fldListTo(compocn)%flds, 'Faxa_rain' ) - call addfld(fldListFr(compatm)%flds, 'Faxa_snowc') - call addfld(fldListFr(compatm)%flds, 'Faxa_snowl') - call addfld(fldListTo(compocn)%flds, 'Faxa_snow' ) + call addfld(fldListFr(compatm)%fields, 'Faxa_rainc') + call addfld(fldListFr(compatm)%fields, 'Faxa_rainl') + call addfld(fldListTo(compocn)%fields, 'Faxa_rain' ) + call addfld(fldListFr(compatm)%fields, 'Faxa_snowc') + call addfld(fldListFr(compatm)%fields, 'Faxa_snowl') + call addfld(fldListTo(compocn)%fields, 'Faxa_snow' ) else ! TODO: why are we not merging Faxa_rain and Faxa_snow if they are sent from atm wiht ofrac ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization @@ -1774,47 +1774,47 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain' , rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rainl', compocn, mapconsf, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%flds, 'Faxa_rainc', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', & + call addmap(fldListFr(compatm)%fields, 'Faxa_rainl', compocn, mapconsf, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Faxa_rainc', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%fields, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', & mrg_type='sum_with_weights', mrg_fracname='ofrac') end if if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snowl', compocn, mapconsf, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%flds, 'Faxa_snowc', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_snow' , & + call addmap(fldListFr(compatm)%fields, 'Faxa_snowl', compocn, mapconsf, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Faxa_snowc', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%fields, 'Faxa_snow' , & mrg_from=compatm, mrg_fld='Faxa_snowc:Faxa_snowl', mrg_type='sum_with_weights', mrg_fracname='ofrac') end if end if if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_rainc_wiso') - call addfld(fldListFr(compatm)%flds, 'Faxa_rainl_wiso') - call addfld(fldListTo(compocn)%flds, 'Faxa_rain_wiso' ) - call addfld(fldListFr(compatm)%flds, 'Faxa_snowc_wiso') - call addfld(fldListFr(compatm)%flds, 'Faxa_snowl_wiso') - call addfld(fldListFr(compatm)%flds, 'Faxa_snow_wiso' ) + call addfld(fldListFr(compatm)%fields, 'Faxa_rainc_wiso') + call addfld(fldListFr(compatm)%fields, 'Faxa_rainl_wiso') + call addfld(fldListTo(compocn)%fields, 'Faxa_rain_wiso' ) + call addfld(fldListFr(compatm)%fields, 'Faxa_snowc_wiso') + call addfld(fldListFr(compatm)%fields, 'Faxa_snowl_wiso') + call addfld(fldListFr(compatm)%fields, 'Faxa_snow_wiso' ) else ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization ! which by default is not actually used if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain_wiso' , rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rainl_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%flds, 'Faxa_rainc_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_rain_wiso' , & + call addmap(fldListFr(compatm)%fields, 'Faxa_rainl_wiso', compocn, mapconsf, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Faxa_rainc_wiso', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%fields, 'Faxa_rain_wiso' , & mrg_from=compatm, mrg_fld=trim('Faxa_rainc_wiso')//':'//trim('Faxa_rainl_wiso'), & mrg_type='sum_with_weights', mrg_fracname='ofrac') end if if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snowl_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%flds, 'Faxa_snowc_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_snow_wiso', & + call addmap(fldListFr(compatm)%fields, 'Faxa_snowl_wiso', compocn, mapconsf, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Faxa_snowc_wiso', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%fields, 'Faxa_snow_wiso', & mrg_from=compatm, mrg_fld=trim('Faxa_snowc_wiso')//':'//trim('Faxa_snowl_wiso'), & mrg_type='sum_with_weights', mrg_fracname='ofrac') end if @@ -1825,14 +1825,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: merged sensible heat flux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds , 'Faxa_sen') - call addfld(fldListMed_aoflux%flds , 'Faox_sen') - call addfld(fldListFr(compice)%flds , 'Fioi_melth') - call addfld(fldListTo(compocn)%flds , 'Foxx_sen') + call addfld(fldListFr(compatm)%fields , 'Faxa_sen') + call addfld(fldListMed_aoflux%fields , 'Faox_sen') + call addfld(fldListFr(compice)%fields , 'Fioi_melth') + call addfld(fldListTo(compocn)%fields , 'Foxx_sen') else if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_sen', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_sen', rc=rc)) then - call addmrg(fldListTo(compocn)%flds, 'Foxx_sen', & + call addmrg(fldListTo(compocn)%fields, 'Foxx_sen', & mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1841,29 +1841,29 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: surface latent heat flux and evaporation water flux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_lat' ) - call addfld(fldListMed_aoflux%flds , 'Faox_lat' ) - call addfld(fldListMed_aoflux%flds , 'Faox_evap') - call addfld(fldListTo(compocn)%flds, 'Foxx_lat' ) - call addfld(fldListTo(compocn)%flds, 'Foxx_evap') + call addfld(fldListFr(compatm)%fields, 'Faxa_lat' ) + call addfld(fldListMed_aoflux%fields , 'Faox_lat' ) + call addfld(fldListMed_aoflux%fields , 'Faox_evap') + call addfld(fldListTo(compocn)%fields, 'Foxx_lat' ) + call addfld(fldListTo(compocn)%fields, 'Foxx_evap') else if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat', rc=rc)) then - call addmrg(fldListTo(compocn)%flds, 'Foxx_lat', & + call addmrg(fldListTo(compocn)%fields, 'Foxx_lat', & mrg_from=compmed, mrg_fld='Faox_lat', mrg_type='merge', mrg_fracname='ofrac') end if if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap', rc=rc)) then - call addmrg(fldListTo(compocn)%flds, 'Foxx_evap', & + call addmrg(fldListTo(compocn)%fields, 'Foxx_evap', & mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='merge', mrg_fracname='ofrac') end if end if if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListMed_aoflux%flds , 'Faox_lat_wiso' ) - call addfld(fldListTo(compocn)%flds, 'Foxx_lat_wiso' ) + call addfld(fldListMed_aoflux%fields , 'Faox_lat_wiso' ) + call addfld(fldListTo(compocn)%fields, 'Foxx_lat_wiso' ) else if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat_wiso', rc=rc)) then - call addmrg(fldListTo(compocn)%flds, 'Foxx_lat_wiso', & + call addmrg(fldListTo(compocn)%fields, 'Foxx_lat_wiso', & mrg_from=compmed, mrg_fld='Faox_lat_wiso', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1876,11 +1876,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! If the aoflux grid is ogrid - then nothing needs to be done to send to the ocean ! All other mappings are set in med_phases_aoflux_mod.F90 if (phase == 'advertise') then - call addfld(fldListMed_aoflux%flds , 'So_duu10n') - call addfld(fldListTo(compocn)%flds, 'So_duu10n') + call addfld(fldListMed_aoflux%fields , 'So_duu10n') + call addfld(fldListTo(compocn)%fields, 'So_duu10n') else if (fldchk(is_local%wrap%FBExp(compocn), 'So_duu10n', rc=rc)) then - call addmrg(fldListTo(compocn)%flds, 'So_duu10n', mrg_from=compmed, mrg_fld='So_duu10n', mrg_type='copy') + call addmrg(fldListTo(compocn)%fields, 'So_duu10n', mrg_from=compmed, mrg_fld='So_duu10n', mrg_type='copy') end if end if @@ -1888,14 +1888,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: sea level pressure from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_pslv') - call addfld(fldListTo(compocn)%flds, 'Sa_pslv') + call addfld(fldListFr(compatm)%fields, 'Sa_pslv') + call addfld(fldListTo(compocn)%fields, 'Sa_pslv') else if ( fldchk(is_local%wrap%FBImp(compatm, compatm), 'Sa_pslv', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Sa_pslv', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compice, mapbilnr, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Sa_pslv', & + call addmap(fldListFr(compatm)%fields, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Sa_pslv', compice, mapbilnr, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%fields, 'Sa_pslv', & mrg_from=compatm, mrg_fld='Sa_pslv', mrg_type='copy') end if end if @@ -1914,46 +1914,46 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: nitrogen deposition fields (2) from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListTo(compocn)%flds, 'Faxa_bcph') - call addfld(fldListFr(compatm)%flds, 'Faxa_bcph') + call addfld(fldListTo(compocn)%fields, 'Faxa_bcph') + call addfld(fldListFr(compatm)%fields, 'Faxa_bcph') else if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_bcph', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_bcph', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_bcph', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_bcph', & + call addmap(fldListFr(compatm)%fields, 'Faxa_bcph', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%fields, 'Faxa_bcph', & mrg_from=compatm, mrg_fld='Faxa_bcph', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addfld(fldListTo(compocn)%flds, 'Faxa_ocph') - call addfld(fldListFr(compatm)%flds, 'Faxa_ocph') + call addfld(fldListTo(compocn)%fields, 'Faxa_ocph') + call addfld(fldListFr(compatm)%fields, 'Faxa_ocph') else if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_ocph', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_ocph', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_ocph', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_ocph', & + call addmap(fldListFr(compatm)%fields, 'Faxa_ocph', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%fields, 'Faxa_ocph', & mrg_from=compatm, mrg_fld='Faxa_ocph', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addfld(fldListTo(compocn)%flds, 'Faxa_dstwet') - call addfld(fldListFr(compatm)%flds, 'Faxa_dstwet') + call addfld(fldListTo(compocn)%fields, 'Faxa_dstwet') + call addfld(fldListFr(compatm)%fields, 'Faxa_dstwet') else if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_dstwet', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_dstwet', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_dstwet', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_dstwet', & + call addmap(fldListFr(compatm)%fields, 'Faxa_dstwet', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%fields, 'Faxa_dstwet', & mrg_from=compatm, mrg_fld='Faxa_dstwet', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addfld(fldListTo(compocn)%flds, 'Faxa_dstdry') - call addfld(fldListFr(compatm)%flds, 'Faxa_dstdry') + call addfld(fldListTo(compocn)%fields, 'Faxa_dstdry') + call addfld(fldListFr(compatm)%fields, 'Faxa_dstdry') else if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_dstdry', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_dstdry', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_dstdry', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_dstdry', & + call addmap(fldListFr(compatm)%fields, 'Faxa_dstdry', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg(fldListTo(compocn)%fields, 'Faxa_dstdry', & mrg_from=compatm, mrg_fld='Faxa_dstdry', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if @@ -1966,44 +1966,44 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Note - do not need to add addmap or addmrg for the following since they ! will be computed directly in med_phases_prep_ocn if (phase == 'advertise') then - call addfld(fldListTo(compocn)%flds, 'Foxx_hrain') - call addfld(fldListTo(compocn)%flds, 'Foxx_hsnow') - call addfld(fldListTo(compocn)%flds, 'Foxx_hevap') - call addfld(fldListTo(compocn)%flds, 'Foxx_hcond') - call addfld(fldListTo(compocn)%flds, 'Foxx_hrofl') - call addfld(fldListTo(compocn)%flds, 'Foxx_hrofi') + call addfld(fldListTo(compocn)%fields, 'Foxx_hrain') + call addfld(fldListTo(compocn)%fields, 'Foxx_hsnow') + call addfld(fldListTo(compocn)%fields, 'Foxx_hevap') + call addfld(fldListTo(compocn)%fields, 'Foxx_hcond') + call addfld(fldListTo(compocn)%fields, 'Foxx_hrofl') + call addfld(fldListTo(compocn)%fields, 'Foxx_hrofi') end if ! --------------------------------------------------------------------- ! to ocn: merge zonal and meridional surface stress from ice and (atm or med) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListTo(compocn)%flds , 'Foxx_taux') - call addfld(fldListFr(compice)%flds , 'Fioi_taux') - call addfld(fldListMed_aoflux%flds , 'Faox_taux') + call addfld(fldListTo(compocn)%fields , 'Foxx_taux') + call addfld(fldListFr(compice)%fields , 'Fioi_taux') + call addfld(fldListMed_aoflux%fields , 'Faox_taux') else if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_taux', rc=rc)) then if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Foxx_taux', & + call addmap(fldListFr(compice)%fields, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%fields, 'Foxx_taux', & mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') end if - call addmrg(fldListTo(compocn)%flds, 'Foxx_taux', & + call addmrg(fldListTo(compocn)%fields, 'Foxx_taux', & mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addfld(fldListTo(compocn)%flds , 'Foxx_tauy') - call addfld(fldListFr(compice)%flds , 'Fioi_tauy') - call addfld(fldListMed_aoflux%flds , 'Faox_tauy') + call addfld(fldListTo(compocn)%fields , 'Foxx_tauy') + call addfld(fldListFr(compice)%fields , 'Fioi_tauy') + call addfld(fldListMed_aoflux%fields , 'Faox_tauy') else if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_tauy', rc=rc)) then if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_tauy', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Foxx_tauy', & + call addmap(fldListFr(compice)%fields, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%fields, 'Foxx_tauy', & mrg_from=compice, mrg_fld='Fioi_tauy', mrg_type='merge', mrg_fracname='ifrac') end if - call addmrg(fldListTo(compocn)%flds, 'Foxx_tauy', & + call addmrg(fldListTo(compocn)%fields, 'Foxx_tauy', & mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -2011,25 +2011,25 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: water flux due to melting ice from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compice)%flds , 'Fioi_meltw') - call addfld(fldListTo(compocn)%flds , 'Fioi_meltw') + call addfld(fldListFr(compice)%fields , 'Fioi_meltw') + call addfld(fldListTo(compocn)%fields , 'Fioi_meltw') else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Fioi_meltw', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_meltw', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Fioi_meltw', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Fioi_meltw', & + call addmap(fldListFr(compice)%fields, 'Fioi_meltw', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%fields, 'Fioi_meltw', & mrg_from=compice, mrg_fld='Fioi_meltw', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(compice)%flds , 'Fioi_meltw_wiso') - call addfld(fldListTo(compocn)%flds , 'Fioi_meltw_wiso') + call addfld(fldListFr(compice)%fields , 'Fioi_meltw_wiso') + call addfld(fldListTo(compocn)%fields , 'Fioi_meltw_wiso') else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Fioi_meltw_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_meltw_wiso', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Fioi_meltw_wiso', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Fioi_meltw_wiso', & + call addmap(fldListFr(compice)%fields, 'Fioi_meltw_wiso', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%fields, 'Fioi_meltw_wiso', & mrg_from=compice, mrg_fld='Fioi_meltw_wiso', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if @@ -2038,13 +2038,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: heat flux from melting ice from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compice)%flds, 'Fioi_melth') - call addfld(fldListTo(compocn)%flds, 'Fioi_melth') + call addfld(fldListFr(compice)%fields, 'Fioi_melth') + call addfld(fldListTo(compocn)%fields, 'Fioi_melth') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_melth', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_melth', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Fioi_melth', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Fioi_melth', & + call addmap(fldListFr(compice)%fields, 'Fioi_melth', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%fields, 'Fioi_melth', & mrg_from=compice, mrg_fld='Fioi_melth', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if @@ -2052,13 +2052,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: salt flux from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compice)%flds, 'Fioi_salt') - call addfld(fldListTo(compocn)%flds, 'Fioi_salt') + call addfld(fldListFr(compice)%fields, 'Fioi_salt') + call addfld(fldListTo(compocn)%fields, 'Fioi_salt') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_salt', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_salt', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Fioi_salt', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Fioi_salt', & + call addmap(fldListFr(compice)%fields, 'Fioi_salt', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%fields, 'Fioi_salt', & mrg_from=compice, mrg_fld='Fioi_salt', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if @@ -2066,13 +2066,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: hydrophylic black carbon deposition flux from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compice)%flds, 'Fioi_bcphi') - call addfld(fldListTo(compocn)%flds, 'Fioi_bcphi') + call addfld(fldListFr(compice)%fields, 'Fioi_bcphi') + call addfld(fldListTo(compocn)%fields, 'Fioi_bcphi') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_bcphi', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_bcphi', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Fioi_bcphi', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Fioi_bcphi', & + call addmap(fldListFr(compice)%fields, 'Fioi_bcphi', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%fields, 'Fioi_bcphi', & mrg_from=compice, mrg_fld='Fioi_bcphi', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if @@ -2080,13 +2080,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: hydrophobic black carbon deposition flux from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compice)%flds, 'Fioi_bcpho') - call addfld(fldListTo(compocn)%flds, 'Fioi_bcpho') + call addfld(fldListFr(compice)%fields, 'Fioi_bcpho') + call addfld(fldListTo(compocn)%fields, 'Fioi_bcpho') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_bcpho', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_bcpho', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Fioi_bcpho', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Fioi_bcpho', & + call addmap(fldListFr(compice)%fields, 'Fioi_bcpho', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%fields, 'Fioi_bcpho', & mrg_from=compice, mrg_fld='Fioi_bcpho', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if @@ -2094,13 +2094,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: dust flux from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compice)%flds, 'Fioi_flxdst') - call addfld(fldListTo(compocn)%flds, 'Fioi_flxdst') + call addfld(fldListFr(compice)%fields, 'Fioi_flxdst') + call addfld(fldListTo(compocn)%fields, 'Fioi_flxdst') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_flxdst', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_flxdst', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Fioi_flxdst', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Fioi_flxdst', & + call addmap(fldListFr(compice)%fields, 'Fioi_flxdst', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%fields, 'Fioi_flxdst', & mrg_from=compice, mrg_fld='Fioi_flxdst', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if @@ -2116,38 +2116,38 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! fldlistFr(comprof) in order to be mapped correctly but the ocean ! does not receive it so it is advertised but it will! not be connected do ns = 1, is_local%wrap%num_icesheets - call addfld(fldListFr(compglc(ns))%flds, 'Fogg_rofl') + call addfld(fldListFr(compglc(ns))%fields, 'Fogg_rofl') end do - call addfld(fldListFr(comprof)%flds, 'Forr_rofl') - call addfld(fldListTo(compocn)%flds, 'Foxx_rofl') - call addfld(fldListTo(compocn)%flds, 'Flrr_flood') + call addfld(fldListFr(comprof)%fields, 'Forr_rofl') + call addfld(fldListTo(compocn)%fields, 'Foxx_rofl') + call addfld(fldListTo(compocn)%fields, 'Flrr_flood') do ns = 1, is_local%wrap%num_icesheets - call addfld(fldListFr(compglc(ns))%flds, 'Fogg_rofi') + call addfld(fldListFr(compglc(ns))%fields, 'Fogg_rofi') end do - call addfld(fldListFr(comprof)%flds, 'Forr_rofi') - call addfld(fldListTo(compocn)%flds, 'Foxx_rofi') + call addfld(fldListFr(comprof)%fields, 'Forr_rofi') + call addfld(fldListTo(compocn)%fields, 'Foxx_rofi') else if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc)) then ! liquid from river and possibly flood from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl' , rc=rc)) then if (trim(rof2ocn_liq_rmap) == 'unset') then - call addmap(fldListFr(comprof)%flds, 'Forr_rofl', compocn, mapconsd, 'none', 'unset') + call addmap(fldListFr(comprof)%fields, 'Forr_rofl', compocn, mapconsd, 'none', 'unset') else - call addmap(fldListFr(comprof)%flds, 'Forr_rofl', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) + call addmap(fldListFr(comprof)%fields, 'Forr_rofl', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) end if if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood', rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Flrr_flood', compocn, mapconsd, 'one', rof2ocn_fmap) - call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl:Flrr_flood', mrg_type='sum') + call addmap(fldListFr(comprof)%fields, 'Flrr_flood', compocn, mapconsd, 'one', rof2ocn_fmap) + call addmrg(fldListTo(compocn)%fields, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl:Flrr_flood', mrg_type='sum') else - call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl', mrg_type='sum') + call addmrg(fldListTo(compocn)%fields, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl', mrg_type='sum') end if end if ! liquid from glc to ocean do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofl' , rc=rc)) then ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmap(fldListFr(compglc(ns))%flds, 'Fogg_rofl', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) - call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl', mrg_from=compglc(ns), mrg_fld='Fogg_rofl', mrg_type='sum') + call addmap(fldListFr(compglc(ns))%fields, 'Fogg_rofl', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) + call addmrg(fldListTo(compocn)%fields, 'Foxx_rofl', mrg_from=compglc(ns), mrg_fld='Fogg_rofl', mrg_type='sum') end if end do end if @@ -2155,18 +2155,18 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! ice from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi' , rc=rc)) then if (trim(rof2ocn_ice_rmap) == 'unset') then - call addmap(fldListFr(comprof)%flds, 'Forr_rofi', compocn, mapconsd, 'none', 'unset') + call addmap(fldListFr(comprof)%fields, 'Forr_rofi', compocn, mapconsd, 'none', 'unset') else - call addmap(fldListFr(comprof)%flds, 'Forr_rofi', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) + call addmap(fldListFr(comprof)%fields, 'Forr_rofi', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) end if - call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') + call addmrg(fldListTo(compocn)%fields, 'Foxx_rofi', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') end if ! ice from glc to ocean do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofi' , rc=rc)) then ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmap(fldListFr(compglc(ns))%flds, 'Fogg_rofi', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) - call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi', mrg_from=compglc(ns), mrg_fld='Fogg_rofi', mrg_type='sum') + call addmap(fldListFr(compglc(ns))%fields, 'Fogg_rofi', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) + call addmrg(fldListTo(compocn)%fields, 'Foxx_rofi', mrg_from=compglc(ns), mrg_fld='Fogg_rofi', mrg_type='sum') end if end do end if @@ -2175,31 +2175,31 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_wiso) then if (phase == 'advertise') then do ns = 1, is_local%wrap%num_icesheets - call addfld(fldListFr(compglc(ns))%flds, 'Fogg_rofl_wiso') + call addfld(fldListFr(compglc(ns))%fields, 'Fogg_rofl_wiso') end do - call addfld(fldListFr(comprof)%flds, 'Forr_rofl_wiso') - call addfld(fldListTo(compocn)%flds, 'Foxx_rofl_wiso') - call addfld(fldListTo(compocn)%flds, 'Flrr_flood_wiso') + call addfld(fldListFr(comprof)%fields, 'Forr_rofl_wiso') + call addfld(fldListTo(compocn)%fields, 'Foxx_rofl_wiso') + call addfld(fldListTo(compocn)%fields, 'Flrr_flood_wiso') do ns = 1, is_local%wrap%num_icesheets - call addfld(fldListFr(compglc(ns))%flds, 'Fogg_rofi_wiso') + call addfld(fldListFr(compglc(ns))%fields, 'Fogg_rofi_wiso') end do - call addfld(fldListFr(comprof)%flds, 'Forr_rofi_wiso') - call addfld(fldListTo(compocn)%flds, 'Foxx_rofi_wiso') + call addfld(fldListFr(comprof)%fields, 'Forr_rofi_wiso') + call addfld(fldListTo(compocn)%fields, 'Foxx_rofi_wiso') else if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl_wiso' , rc=rc)) then ! liquid from river and possibly flood from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_wiso' , rc=rc)) then if (trim(rof2ocn_liq_rmap) == 'unset') then - call addmap(fldListFr(comprof)%flds, 'Forr_rofl_wiso', compocn, mapconsd, 'none', 'unset') + call addmap(fldListFr(comprof)%fields, 'Forr_rofl_wiso', compocn, mapconsd, 'none', 'unset') else - call addmap(fldListFr(comprof)%flds, 'Forr_rofl_wiso', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) + call addmap(fldListFr(comprof)%fields, 'Forr_rofl_wiso', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) end if if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood_wiso', rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Flrr_flood_wiso', compocn, mapconsd, 'one', rof2ocn_fmap) - call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl_wiso', & + call addmap(fldListFr(comprof)%fields, 'Flrr_flood_wiso', compocn, mapconsd, 'one', rof2ocn_fmap) + call addmrg(fldListTo(compocn)%fields, 'Foxx_rofl_wiso', & mrg_from=comprof, mrg_fld='Forr_rofl:Flrr_flood', mrg_type='sum') else - call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl_wiso', & + call addmrg(fldListTo(compocn)%fields, 'Foxx_rofl_wiso', & mrg_from=comprof, mrg_fld='Forr_rofl', mrg_type='sum') end if end if @@ -2207,8 +2207,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofl_wiso' , rc=rc)) then ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmap(fldListFr(compglc(ns))%flds, 'Fogg_rofl_wiso', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) - call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl_wiso', & + call addmap(fldListFr(compglc(ns))%fields, 'Fogg_rofl_wiso', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) + call addmrg(fldListTo(compocn)%fields, 'Foxx_rofl_wiso', & mrg_from=compglc(ns), mrg_fld='Fogg_rofl_wiso', mrg_type='sum') end if end do @@ -2217,18 +2217,18 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! ice from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_wiso' , rc=rc)) then if (trim(rof2ocn_ice_rmap) == 'unset') then - call addmap(fldListFr(comprof)%flds, 'Forr_rofi_wiso', compocn, mapconsd, 'none', 'unset') + call addmap(fldListFr(comprof)%fields, 'Forr_rofi_wiso', compocn, mapconsd, 'none', 'unset') else - call addmap(fldListFr(comprof)%flds, 'Forr_rofi_wiso', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) + call addmap(fldListFr(comprof)%fields, 'Forr_rofi_wiso', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) end if - call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi_wiso', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') + call addmrg(fldListTo(compocn)%fields, 'Foxx_rofi_wiso', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') end if ! ice from glc to ocean do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofi_wiso' , rc=rc)) then ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmap(fldListFr(compglc(ns))%flds, 'Fogg_rofi_wiso', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) - call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi_wiso', & + call addmap(fldListFr(compglc(ns))%fields, 'Fogg_rofi_wiso', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) + call addmrg(fldListTo(compocn)%fields, 'Foxx_rofi_wiso', & mrg_from=compglc(ns), mrg_fld='Fogg_rofi_wiso', mrg_type='sum') end if end do @@ -2240,78 +2240,78 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: Langmuir multiplier from wave !----------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compwav)%flds, 'Sw_lamult') - call addfld(fldListTo(compocn)%flds, 'Sw_lamult') + call addfld(fldListFr(compwav)%fields, 'Sw_lamult') + call addfld(fldListTo(compocn)%fields, 'Sw_lamult') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_lamult', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_lamult', rc=rc)) then - call addmap(fldListFr(compwav)%flds, 'Sw_lamult', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) - call addmrg(fldListTo(compocn)%flds, 'Sw_lamult', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') + call addmap(fldListFr(compwav)%fields, 'Sw_lamult', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg(fldListTo(compocn)%fields, 'Sw_lamult', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') end if end if !----------------------------- ! to ocn: Stokes drift u component from wave !----------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compwav)%flds, 'Sw_ustokes') - call addfld(fldListTo(compocn)%flds, 'Sw_ustokes') + call addfld(fldListFr(compwav)%fields, 'Sw_ustokes') + call addfld(fldListTo(compocn)%fields, 'Sw_ustokes') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes', rc=rc)) then - call addmap(fldListFr(compwav)%flds, 'Sw_ustokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) - call addmrg(fldListTo(compocn)%flds, 'Sw_ustokes', mrg_from=compwav, mrg_fld='Sw_ustokes', mrg_type='copy') + call addmap(fldListFr(compwav)%fields, 'Sw_ustokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg(fldListTo(compocn)%fields, 'Sw_ustokes', mrg_from=compwav, mrg_fld='Sw_ustokes', mrg_type='copy') end if end if !----------------------------- ! to ocn: Stokes drift v component from wave !----------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compwav)%flds, 'Sw_vstokes') - call addfld(fldListTo(compocn)%flds, 'Sw_vstokes') + call addfld(fldListFr(compwav)%fields, 'Sw_vstokes') + call addfld(fldListTo(compocn)%fields, 'Sw_vstokes') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes', rc=rc)) then - call addmap(fldListFr(compwav)%flds, 'Sw_vstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) - call addmrg(fldListTo(compocn)%flds, 'Sw_vstokes', mrg_from=compwav, mrg_fld='Sw_vstokes', mrg_type='copy') + call addmap(fldListFr(compwav)%fields, 'Sw_vstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg(fldListTo(compocn)%fields, 'Sw_vstokes', mrg_from=compwav, mrg_fld='Sw_vstokes', mrg_type='copy') end if end if !----------------------------- ! to ocn: Stokes drift depth from wave !----------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compwav)%flds, 'Sw_hstokes') - call addfld(fldListTo(compocn)%flds, 'Sw_hstokes') + call addfld(fldListFr(compwav)%fields, 'Sw_hstokes') + call addfld(fldListTo(compocn)%fields, 'Sw_hstokes') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_hstokes', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_hstokes', rc=rc)) then - call addmap(fldListFr(compwav)%flds, 'Sw_hstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) - call addmrg(fldListTo(compocn)%flds, 'Sw_hstokes', mrg_from=compwav, mrg_fld='Sw_hstokes', mrg_type='copy') + call addmap(fldListFr(compwav)%fields, 'Sw_hstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg(fldListTo(compocn)%fields, 'Sw_hstokes', mrg_from=compwav, mrg_fld='Sw_hstokes', mrg_type='copy') end if end if !----------------------------- ! to ocn: Partitioned stokes drift components in x-direction !----------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compwav)%flds, 'Sw_pstokes_x') - call addfld(fldListTo(compocn)%flds, 'Sw_pstokes_x') + call addfld(fldListFr(compwav)%fields, 'Sw_pstokes_x') + call addfld(fldListTo(compocn)%fields, 'Sw_pstokes_x') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_pstokes_x', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_pstokes_x', rc=rc)) then - call addmap(fldListFr(compwav)%flds, 'Sw_pstokes_x', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) - call addmrg(fldListTo(compocn)%flds, 'Sw_pstokes_x', mrg_from=compwav, mrg_fld='Sw_pstokes_x', mrg_type='copy') + call addmap(fldListFr(compwav)%fields, 'Sw_pstokes_x', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg(fldListTo(compocn)%fields, 'Sw_pstokes_x', mrg_from=compwav, mrg_fld='Sw_pstokes_x', mrg_type='copy') end if end if !----------------------------- ! to ocn: Stokes drift depth from wave !----------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compwav)%flds, 'Sw_pstokes_y') - call addfld(fldListTo(compocn)%flds, 'Sw_pstokes_y') + call addfld(fldListFr(compwav)%fields, 'Sw_pstokes_y') + call addfld(fldListTo(compocn)%fields, 'Sw_pstokes_y') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_pstokes_y', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_pstokes_y', rc=rc)) then - call addmap(fldListFr(compwav)%flds, 'Sw_pstokes_y', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) - call addmrg(fldListTo(compocn)%flds, 'Sw_pstokes_y', mrg_from=compwav, mrg_fld='Sw_pstokes_y', mrg_type='copy') + call addmap(fldListFr(compwav)%fields, 'Sw_pstokes_y', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg(fldListTo(compocn)%fields, 'Sw_pstokes_y', mrg_from=compwav, mrg_fld='Sw_pstokes_y', mrg_type='copy') end if end if @@ -2323,13 +2323,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: downward longwave heat flux from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_lwdn') - call addfld(fldListTo(compice)%flds, 'Faxa_lwdn') + call addfld(fldListFr(compatm)%fields, 'Faxa_lwdn') + call addfld(fldListTo(compice)%fields, 'Faxa_lwdn') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_lwdn', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_lwdn', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Faxa_lwdn', mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_lwdn', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Faxa_lwdn', mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2339,43 +2339,43 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: downward Diffuse visible incident solar radiation from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_swndr') - call addfld(fldListTo(compice)%flds, 'Faxa_swndr') + call addfld(fldListFr(compatm)%fields, 'Faxa_swndr') + call addfld(fldListTo(compice)%fields, 'Faxa_swndr') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_swndr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndr', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_swndr', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Faxa_swndr', mrg_from=compatm, mrg_fld='Faxa_swndr', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_swndr', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Faxa_swndr', mrg_from=compatm, mrg_fld='Faxa_swndr', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_swvdr') - call addfld(fldListTo(compice)%flds, 'Faxa_swvdr') + call addfld(fldListFr(compatm)%fields, 'Faxa_swvdr') + call addfld(fldListTo(compice)%fields, 'Faxa_swvdr') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_swvdr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdr', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_swvdr', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Faxa_swvdr', mrg_from=compatm, mrg_fld='Faxa_swvdr', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_swvdr', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Faxa_swvdr', mrg_from=compatm, mrg_fld='Faxa_swvdr', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_swndf') - call addfld(fldListTo(compice)%flds, 'Faxa_swndf') + call addfld(fldListFr(compatm)%fields, 'Faxa_swndf') + call addfld(fldListTo(compice)%fields, 'Faxa_swndf') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_swndf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndf', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_swndf', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Faxa_swndf', mrg_from=compatm, mrg_fld='Faxa_swndf', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_swndf', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Faxa_swndf', mrg_from=compatm, mrg_fld='Faxa_swndf', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_swvdf') - call addfld(fldListTo(compice)%flds, 'Faxa_swvdf') + call addfld(fldListFr(compatm)%fields, 'Faxa_swvdf') + call addfld(fldListTo(compice)%fields, 'Faxa_swvdf') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_swvdf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdf', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_swvdf', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Faxa_swvdf', mrg_from=compatm, mrg_fld='Faxa_swvdf', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_swvdf', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Faxa_swvdf', mrg_from=compatm, mrg_fld='Faxa_swvdf', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2384,13 +2384,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: hydrophylic black carbon wet deposition flux from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_bcph') - call addfld(fldListTo(compice)%flds, 'Faxa_bcph') + call addfld(fldListFr(compatm)%fields, 'Faxa_bcph') + call addfld(fldListTo(compice)%fields, 'Faxa_bcph') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_bcph', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_bcph', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_bcph', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Faxa_bcph', mrg_from=compatm, mrg_fld='Faxa_bcph', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_bcph', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Faxa_bcph', mrg_from=compatm, mrg_fld='Faxa_bcph', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2399,13 +2399,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: hydrophylic organic carbon wet deposition flux from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_ocph') - call addfld(fldListTo(compice)%flds, 'Faxa_ocph') + call addfld(fldListFr(compatm)%fields, 'Faxa_ocph') + call addfld(fldListTo(compice)%fields, 'Faxa_ocph') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_ocph', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_ocph', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_ocph', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Faxa_ocph', mrg_from=compatm, mrg_fld='Faxa_ocph', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_ocph', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Faxa_ocph', mrg_from=compatm, mrg_fld='Faxa_ocph', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2415,13 +2415,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: dust wet deposition flux (size 4) from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_dstwet') - call addfld(fldListTo(compice)%flds, 'Faxa_dstwet') + call addfld(fldListFr(compatm)%fields, 'Faxa_dstwet') + call addfld(fldListTo(compice)%fields, 'Faxa_dstwet') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_dstwet', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_dstwet', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_dstwet', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Faxa_dstwet', mrg_from=compatm, mrg_fld='Faxa_dstwet', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_dstwet', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Faxa_dstwet', mrg_from=compatm, mrg_fld='Faxa_dstwet', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2431,13 +2431,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: dust dry deposition flux (size 4) from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_dstdry') - call addfld(fldListTo(compice)%flds, 'Faxa_dstdry') + call addfld(fldListFr(compatm)%fields, 'Faxa_dstdry') + call addfld(fldListTo(compice)%fields, 'Faxa_dstdry') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_dstdry', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_dstdry', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_dstdry', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Faxa_dstdry', mrg_from=compatm, mrg_fld='Faxa_dstdry', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_dstdry', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Faxa_dstdry', mrg_from=compatm, mrg_fld='Faxa_dstdry', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2445,83 +2445,83 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: rain and snow rate from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_rainc') - call addfld(fldListFr(compatm)%flds, 'Faxa_rainl') - call addfld(fldListFr(compatm)%flds, 'Faxa_rain' ) - call addfld(fldListTo(compice)%flds, 'Faxa_rain' ) + call addfld(fldListFr(compatm)%fields, 'Faxa_rainc') + call addfld(fldListFr(compatm)%fields, 'Faxa_rainl') + call addfld(fldListFr(compatm)%fields, 'Faxa_rain' ) + call addfld(fldListTo(compice)%fields, 'Faxa_rain' ) else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rainc', compice, mapconsf, 'one', atm2ice_map) - call addmap(fldListFr(compatm)%flds, 'Faxa_rainl', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', mrg_type='sum') + call addmap(fldListFr(compatm)%fields, 'Faxa_rainc', compice, mapconsf, 'one', atm2ice_map) + call addmap(fldListFr(compatm)%fields, 'Faxa_rainl', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', mrg_type='sum') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rain', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rain', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_rain', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rain', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_snowc') - call addfld(fldListFr(compatm)%flds, 'Faxa_snowl') - call addfld(fldListFr(compatm)%flds, 'Faxa_snow' ) - call addfld(fldListTo(compice)%flds, 'Faxa_snow' ) + call addfld(fldListFr(compatm)%fields, 'Faxa_snowc') + call addfld(fldListFr(compatm)%fields, 'Faxa_snowl') + call addfld(fldListFr(compatm)%fields, 'Faxa_snow' ) + call addfld(fldListTo(compice)%fields, 'Faxa_snow' ) else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snowc', compice, mapconsf, 'one', atm2ice_map) - call addmap(fldListFr(compatm)%flds, 'Faxa_snowl', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Faxa_snow' , & + call addmap(fldListFr(compatm)%fields, 'Faxa_snowc', compice, mapconsf, 'one', atm2ice_map) + call addmap(fldListFr(compatm)%fields, 'Faxa_snowl', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Faxa_snow' , & mrg_from=compatm, mrg_fld='Faxa_snowc:Faxa_snowl', mrg_type='sum') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snow', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Faxa_snow', & + call addmap(fldListFr(compatm)%fields, 'Faxa_snow', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Faxa_snow', & mrg_from=compatm, mrg_fld='Faxa_snow', mrg_type='copy') end if end if if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_rainc_wiso') - call addfld(fldListFr(compatm)%flds, 'Faxa_rainl_wiso') - call addfld(fldListFr(compatm)%flds, 'Faxa_rain_wiso' ) - call addfld(fldListTo(compice)%flds, 'Faxa_rain_wiso' ) + call addfld(fldListFr(compatm)%fields, 'Faxa_rainc_wiso') + call addfld(fldListFr(compatm)%fields, 'Faxa_rainl_wiso') + call addfld(fldListFr(compatm)%fields, 'Faxa_rain_wiso' ) + call addfld(fldListTo(compice)%fields, 'Faxa_rain_wiso' ) else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain_wiso' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rainc_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmap(fldListFr(compatm)%flds, 'Faxa_rainl_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Faxa_rain_wiso' , & + call addmap(fldListFr(compatm)%fields, 'Faxa_rainc_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmap(fldListFr(compatm)%fields, 'Faxa_rainl_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Faxa_rain_wiso' , & mrg_from=compatm, mrg_fld='Faxa_rainc_wiso:Faxa_rainl_wiso', mrg_type='sum') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rain_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Faxa_rain_wiso', & + call addmap(fldListFr(compatm)%fields, 'Faxa_rain_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Faxa_rain_wiso', & mrg_from=compatm, mrg_fld='Faxa_rain_wiso', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_snowc_wiso') - call addfld(fldListFr(compatm)%flds, 'Faxa_snowl_wiso') - call addfld(fldListFr(compatm)%flds, 'Faxa_snow_wiso' ) - call addfld(fldListTo(compice)%flds, 'Faxa_snow_wiso' ) + call addfld(fldListFr(compatm)%fields, 'Faxa_snowc_wiso') + call addfld(fldListFr(compatm)%fields, 'Faxa_snowl_wiso') + call addfld(fldListFr(compatm)%fields, 'Faxa_snow_wiso' ) + call addfld(fldListTo(compice)%fields, 'Faxa_snow_wiso' ) else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snowc_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmap(fldListFr(compatm)%flds, 'Faxa_snowl_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Faxa_snow_wiso' , & + call addmap(fldListFr(compatm)%fields, 'Faxa_snowc_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmap(fldListFr(compatm)%fields, 'Faxa_snowl_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Faxa_snow_wiso' , & mrg_from=compatm, mrg_fld='Faxa_snowc_wiso:Faxa_snowl_wiso', mrg_type='sum') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snow_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Faxa_snow_wiso', mrg_from=compatm, mrg_fld='Faxa_snow_wiso', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Faxa_snow_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Faxa_snow_wiso', mrg_from=compatm, mrg_fld='Faxa_snow_wiso', mrg_type='copy') end if end if end if @@ -2530,65 +2530,65 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: height at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_z') - call addfld(fldListTo(compice)%flds, 'Sa_z') + call addfld(fldListFr(compatm)%fields, 'Sa_z') + call addfld(fldListTo(compice)%fields, 'Sa_z') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_z', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_z', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_z', compice, mapbilnr, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Sa_z', mrg_from=compatm, mrg_fld='Sa_z', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Sa_z', compice, mapbilnr, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Sa_z', mrg_from=compatm, mrg_fld='Sa_z', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to ice: pressure at the lowest model level fromatm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_pbot') - call addfld(fldListTo(compice)%flds, 'Sa_pbot') + call addfld(fldListFr(compatm)%fields, 'Sa_pbot') + call addfld(fldListTo(compice)%fields, 'Sa_pbot') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_pbot', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_pbot', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_pbot', compice, mapbilnr, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Sa_pbot', mrg_from=compatm, mrg_fld='Sa_pbot', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Sa_pbot', compice, mapbilnr, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Sa_pbot', mrg_from=compatm, mrg_fld='Sa_pbot', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to ice: temperature at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_tbot') - call addfld(fldListTo(compice)%flds, 'Sa_tbot') + call addfld(fldListFr(compatm)%fields, 'Sa_tbot') + call addfld(fldListTo(compice)%fields, 'Sa_tbot') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_tbot', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_tbot', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_tbot', compice, mapbilnr, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Sa_tbot', compice, mapbilnr, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to ice: potential temperature at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_ptem') - call addfld(fldListTo(compice)%flds, 'Sa_ptem') + call addfld(fldListFr(compatm)%fields, 'Sa_ptem') + call addfld(fldListTo(compice)%fields, 'Sa_ptem') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_ptem', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_ptem', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_ptem', compice, mapbilnr, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Sa_ptem', mrg_from=compatm, mrg_fld='Sa_ptem', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Sa_ptem', compice, mapbilnr, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Sa_ptem', mrg_from=compatm, mrg_fld='Sa_ptem', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to ice: density at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_dens') - call addfld(fldListTo(compice)%flds, 'Sa_dens') + call addfld(fldListFr(compatm)%fields, 'Sa_dens') + call addfld(fldListTo(compice)%fields, 'Sa_dens') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_dens', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_dens', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_dens', compice, mapbilnr, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Sa_dens', mrg_from=compatm, mrg_fld='Sa_dens', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Sa_dens', compice, mapbilnr, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Sa_dens', mrg_from=compatm, mrg_fld='Sa_dens', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2596,31 +2596,31 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: meridional wind at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_u') - call addfld(fldListTo(compice)%flds, 'Sa_u') + call addfld(fldListFr(compatm)%fields, 'Sa_u') + call addfld(fldListTo(compice)%fields, 'Sa_u') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_u', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_u', rc=rc)) then if (mapuv_with_cart3d) then - call addmap(fldListFr(compatm)%flds, 'Sa_u', compice, mappatch_uv3d, 'one', atm2ice_map) + call addmap(fldListFr(compatm)%fields, 'Sa_u', compice, mappatch_uv3d, 'one', atm2ice_map) else - call addmap(fldListFr(compatm)%flds, 'Sa_u', compice, mappatch, 'one', atm2ice_map) + call addmap(fldListFr(compatm)%fields, 'Sa_u', compice, mappatch, 'one', atm2ice_map) end if - call addmrg(fldListTo(compice)%flds, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') + call addmrg(fldListTo(compice)%fields, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_v') - call addfld(fldListTo(compice)%flds, 'Sa_v') + call addfld(fldListFr(compatm)%fields, 'Sa_v') + call addfld(fldListTo(compice)%fields, 'Sa_v') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_v', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_v', rc=rc)) then if (mapuv_with_cart3d) then - call addmap(fldListFr(compatm)%flds, 'Sa_v', compice, mappatch_uv3d, 'one', atm2ice_map) + call addmap(fldListFr(compatm)%fields, 'Sa_v', compice, mappatch_uv3d, 'one', atm2ice_map) else - call addmap(fldListFr(compatm)%flds, 'Sa_v', compice, mappatch, 'one', atm2ice_map) + call addmap(fldListFr(compatm)%fields, 'Sa_v', compice, mappatch, 'one', atm2ice_map) end if - call addmrg(fldListTo(compice)%flds, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') + call addmrg(fldListTo(compice)%fields, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2628,24 +2628,24 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: specific humidity for water isotopes at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_shum') - call addfld(fldListTo(compice)%flds, 'Sa_shum') + call addfld(fldListFr(compatm)%fields, 'Sa_shum') + call addfld(fldListTo(compice)%fields, 'Sa_shum') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_shum', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_shum', compice, mapbilnr, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Sa_shum', mrg_from=compatm, mrg_fld='Sa_shum', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Sa_shum', compice, mapbilnr, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Sa_shum', mrg_from=compatm, mrg_fld='Sa_shum', mrg_type='copy') end if end if if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_shum_wiso') - call addfld(fldListTo(compice)%flds, 'Sa_shum_wiso') + call addfld(fldListFr(compatm)%fields, 'Sa_shum_wiso') + call addfld(fldListTo(compice)%fields, 'Sa_shum_wiso') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_shum_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_shum_wiso', compice, mapbilnr, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%flds, 'Sa_shum_wiso', mrg_from=compatm, mrg_fld='Sa_shum_wiso', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Sa_shum_wiso', compice, mapbilnr, 'one', atm2ice_map) + call addmrg(fldListTo(compice)%fields, 'Sa_shum_wiso', mrg_from=compatm, mrg_fld='Sa_shum_wiso', mrg_type='copy') end if end if end if @@ -2654,26 +2654,26 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: sea surface temperature from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compocn)%flds, 'So_t') - call addfld(fldListTo(compice)%flds, 'So_t') + call addfld(fldListFr(compocn)%fields, 'So_t') + call addfld(fldListTo(compice)%fields, 'So_t') else if ( fldchk(is_local%wrap%FBexp(compice) , 'So_t', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_t', rc=rc)) then - call addmap(fldListFr(compocn)%flds, 'So_t', compice, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compice)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + call addmap(fldListFr(compocn)%fields, 'So_t', compice, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compice)%fields, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to ice: sea surface salinity from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compocn)%flds, 'So_s') - call addfld(fldListTo(compice)%flds, 'So_s') + call addfld(fldListFr(compocn)%fields, 'So_s') + call addfld(fldListTo(compice)%fields, 'So_s') else if ( fldchk(is_local%wrap%FBexp(compice) , 'So_s', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_s', rc=rc)) then - call addmap(fldListFr(compocn)%flds, 'So_s', compice, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compice)%flds, 'So_s', mrg_from=compocn, mrg_fld='So_s', mrg_type='copy') + call addmap(fldListFr(compocn)%fields, 'So_s', compice, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compice)%fields, 'So_s', mrg_from=compocn, mrg_fld='So_s', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2681,23 +2681,23 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: meridional sea water velocity from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compocn)%flds, 'So_u') - call addfld(fldListTo(compice)%flds, 'So_u') + call addfld(fldListFr(compocn)%fields, 'So_u') + call addfld(fldListTo(compice)%fields, 'So_u') else if ( fldchk(is_local%wrap%FBexp(compice) , 'So_u', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_u', rc=rc)) then - call addmap(fldListFr(compocn)%flds, 'So_u', compice, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compice)%flds, 'So_u', mrg_from=compocn, mrg_fld='So_u', mrg_type='copy') + call addmap(fldListFr(compocn)%fields, 'So_u', compice, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compice)%fields, 'So_u', mrg_from=compocn, mrg_fld='So_u', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compocn)%flds, 'So_v') - call addfld(fldListTo(compice)%flds, 'So_v') + call addfld(fldListFr(compocn)%fields, 'So_v') + call addfld(fldListTo(compice)%fields, 'So_v') else if ( fldchk(is_local%wrap%FBexp(compice) , 'So_v', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_v', rc=rc)) then - call addmap(fldListFr(compocn)%flds, 'So_v', compice, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compice)%flds, 'So_v', mrg_from=compocn, mrg_fld='So_v', mrg_type='copy') + call addmap(fldListFr(compocn)%fields, 'So_v', compice, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compice)%fields, 'So_v', mrg_from=compocn, mrg_fld='So_v', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2705,36 +2705,36 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: meridional sea surface slope from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compocn)%flds, 'So_dhdx') - call addfld(fldListTo(compice)%flds, 'So_dhdx') + call addfld(fldListFr(compocn)%fields, 'So_dhdx') + call addfld(fldListTo(compice)%fields, 'So_dhdx') else if ( fldchk(is_local%wrap%FBexp(compice) , 'So_dhdx', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_dhdx', rc=rc)) then - call addmap(fldListFr(compocn)%flds, 'So_dhdx', compice, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compice)%flds, 'So_dhdx', mrg_from=compocn, mrg_fld='So_dhdx', mrg_type='copy') + call addmap(fldListFr(compocn)%fields, 'So_dhdx', compice, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compice)%fields, 'So_dhdx', mrg_from=compocn, mrg_fld='So_dhdx', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compocn)%flds, 'So_dhdy') - call addfld(fldListTo(compice)%flds, 'So_dhdy') + call addfld(fldListFr(compocn)%fields, 'So_dhdy') + call addfld(fldListTo(compice)%fields, 'So_dhdy') else if ( fldchk(is_local%wrap%FBexp(compice) , 'So_dhdy', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_dhdy', rc=rc)) then - call addmap(fldListFr(compocn)%flds, 'So_dhdy', compice, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compice)%flds, 'So_dhdy', mrg_from=compocn, mrg_fld='So_dhdy', mrg_type='copy') + call addmap(fldListFr(compocn)%fields, 'So_dhdy', compice, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compice)%fields, 'So_dhdy', mrg_from=compocn, mrg_fld='So_dhdy', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to ice: ocean melt and freeze potential from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compocn)%flds, 'Fioo_q') - call addfld(fldListTo(compice)%flds, 'Fioo_q') + call addfld(fldListFr(compocn)%fields, 'Fioo_q') + call addfld(fldListTo(compice)%fields, 'Fioo_q') else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'Fioo_q', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compice) , 'Fioo_q', rc=rc)) then - call addmap(fldListFr(compocn)%flds, 'Fioo_q', compice, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compice)%flds, 'Fioo_q', mrg_from=compocn, mrg_fld='Fioo_q', mrg_type='copy') + call addmap(fldListFr(compocn)%fields, 'Fioo_q', compice, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compice)%fields, 'Fioo_q', mrg_from=compocn, mrg_fld='Fioo_q', mrg_type='copy') end if end if !----------------------------- @@ -2742,13 +2742,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------- if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(compocn)%flds, 'So_roce_wiso') - call addfld(fldListTo(compice)%flds, 'So_roce_wiso') + call addfld(fldListFr(compocn)%fields, 'So_roce_wiso') + call addfld(fldListTo(compice)%fields, 'So_roce_wiso') else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_roce_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compice) , 'So_roce_wiso', rc=rc)) then - call addmap(fldListFr(compocn)%flds, 'So_roce_wiso', compice, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compice)%flds, 'So_roce_wiso', mrg_from=compocn, mrg_fld='So_roce_wiso', mrg_type='copy') + call addmap(fldListFr(compocn)%fields, 'So_roce_wiso', compice, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compice)%fields, 'So_roce_wiso', mrg_from=compocn, mrg_fld='So_roce_wiso', mrg_type='copy') end if end if end if @@ -2757,43 +2757,43 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: frozen runoff from rof and glc ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(comprof)%flds, 'Firr_rofi') ! water flux into sea ice due to runoff (frozen) + call addfld(fldListFr(comprof)%fields, 'Firr_rofi') ! water flux into sea ice due to runoff (frozen) do ns = 1, is_local%wrap%num_icesheets - call addfld(fldListFr(compglc(ns))%flds, 'Figg_rofi') ! glc frozen runoff_iceberg flux to ice + call addfld(fldListFr(compglc(ns))%fields, 'Figg_rofi') ! glc frozen runoff_iceberg flux to ice end do - call addfld(fldListTo(compice)%flds, 'Fixx_rofi') ! total frozen water flux into sea ice + call addfld(fldListTo(compice)%fields, 'Fixx_rofi') ! total frozen water flux into sea ice else if ( fldchk(is_local%wrap%FBExp(compice), 'Fixx_rofi', rc=rc)) then if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi', rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Forr_rofi', compice, mapconsf, 'none', rof2ocn_ice_rmap) - call addmrg(fldListTo(compice)%flds, 'Fixx_rofi', mrg_from=comprof, mrg_fld='Firr_rofi', mrg_type='sum') + call addmap(fldListFr(comprof)%fields, 'Forr_rofi', compice, mapconsf, 'none', rof2ocn_ice_rmap) + call addmrg(fldListTo(compice)%fields, 'Fixx_rofi', mrg_from=comprof, mrg_fld='Firr_rofi', mrg_type='sum') end if do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Figg_rofi', rc=rc)) then - call addmap(fldListFr(compglc(ns))%flds, 'Figg_rofi', compice, mapconsf, 'one' , glc2ice_rmap) - call addmrg(fldListTo(compice)%flds, 'Fixx_rofi', mrg_from=compglc(ns), mrg_fld='Figg_rofi', mrg_type='sum') + call addmap(fldListFr(compglc(ns))%fields, 'Figg_rofi', compice, mapconsf, 'one' , glc2ice_rmap) + call addmrg(fldListTo(compice)%fields, 'Fixx_rofi', mrg_from=compglc(ns), mrg_fld='Figg_rofi', mrg_type='sum') end if end do end if end if if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(comprof)%flds, 'Firr_rofi_wiso') ! water flux into sea ice due to runoff (frozen) + call addfld(fldListFr(comprof)%fields, 'Firr_rofi_wiso') ! water flux into sea ice due to runoff (frozen) do ns = 1, is_local%wrap%num_icesheets - call addfld(fldListFr(compglc(ns))%flds, 'Figg_rofi_wiso') ! glc frozen runoff_iceberg flux to ice + call addfld(fldListFr(compglc(ns))%fields, 'Figg_rofi_wiso') ! glc frozen runoff_iceberg flux to ice end do - call addfld(fldListTo(compice)%flds, 'Fixx_rofi_wiso') ! total frozen water flux into sea ice + call addfld(fldListTo(compice)%fields, 'Fixx_rofi_wiso') ! total frozen water flux into sea ice else if ( fldchk(is_local%wrap%FBExp(compice), 'Fixx_rofi_wiso', rc=rc)) then if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_wiso', rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Forr_rofi_wiso', compice, mapconsf, 'none', rof2ocn_ice_rmap) - call addmrg(fldListTo(compice)%flds, 'Fixx_rofi_wiso', & + call addmap(fldListFr(comprof)%fields, 'Forr_rofi_wiso', compice, mapconsf, 'none', rof2ocn_ice_rmap) + call addmrg(fldListTo(compice)%fields, 'Fixx_rofi_wiso', & mrg_from=comprof, mrg_fld='Firr_rofi_wiso', mrg_type='sum') end if do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Figg_rofi_wiso', rc=rc)) then - call addmap(fldListFr(compglc(ns))%flds, 'Figg_rofi_wiso', compice, mapconsf, 'one' , glc2ice_rmap) - call addmrg(fldListTo(compice)%flds, 'Fixx_rofi_wiso', & + call addmap(fldListFr(compglc(ns))%fields, 'Figg_rofi_wiso', compice, mapconsf, 'one' , glc2ice_rmap) + call addmrg(fldListTo(compice)%fields, 'Fixx_rofi_wiso', & mrg_from=compglc(ns), mrg_fld='Figg_rofi_wiso', mrg_type='sum') end if end do @@ -2806,13 +2806,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- if (wavice_coupling) then if (phase == 'advertise') then - call addfld(fldListFr(compwav)%flds, 'Sw_elevation_spectrum') - call addfld(fldListTo(compice)%flds, 'Sw_elevation_spectrum') + call addfld(fldListFr(compwav)%fields, 'Sw_elevation_spectrum') + call addfld(fldListTo(compice)%fields, 'Sw_elevation_spectrum') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Sw_elevation_spectrum', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav,compwav), 'Sw_elevation_spectrum', rc=rc)) then - call addmap(fldListFr(compwav)%flds, 'Sw_elevation_spectrum', compice, mapbilnr, 'one', 'unset') - call addmrg(fldListTo(compice)%flds, 'Sw_elevation_spectrum', & + call addmap(fldListFr(compwav)%fields, 'Sw_elevation_spectrum', compice, mapbilnr, 'one', 'unset') + call addmrg(fldListTo(compice)%fields, 'Sw_elevation_spectrum', & mrg_from=compwav, mrg_fld='Sw_elevation_spectrum', mrg_type='copy') end if end if @@ -2826,14 +2826,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to wav: fractional ice coverage wrt ocean from ice !---------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compice)%flds, 'Si_ifrac') - call addfld(fldListTo(compwav)%flds, 'Si_ifrac') + call addfld(fldListFr(compice)%fields, 'Si_ifrac') + call addfld(fldListTo(compwav)%fields, 'Si_ifrac') else if ( fldchk(is_local%wrap%FBexp(compwav) , 'Si_ifrac', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_ifrac', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap(fldListFr(compice)%flds, 'Si_ifrac', compwav, mapbilnr, 'one', ice2wav_smap) - call addmrg(fldListTo(compwav)%flds, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') + call addmap(fldListFr(compice)%fields, 'Si_ifrac', compwav, mapbilnr, 'one', ice2wav_smap) + call addmrg(fldListTo(compwav)%fields, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') end if end if !---------------------------------------------------------- @@ -2841,13 +2841,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !---------------------------------------------------------- if (wavice_coupling) then if (phase == 'advertise') then - call addfld(fldListFr(compice)%flds, 'Si_thick') - call addfld(fldListTo(compwav)%flds, 'Si_thick') + call addfld(fldListFr(compice)%fields, 'Si_thick') + call addfld(fldListTo(compwav)%fields, 'Si_thick') else if (fldchk(is_local%wrap%FBexp(compwav) , 'Si_thick', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_thick', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Si_thick', compwav, mapbilnr, 'one', ice2wav_smap) - call addmrg(fldListTo(compwav)%flds, 'Si_thick', mrg_from=compice, mrg_fld='Si_thick', mrg_type='copy') + call addmap(fldListFr(compice)%fields, 'Si_thick', compwav, mapbilnr, 'one', ice2wav_smap) + call addmrg(fldListTo(compwav)%fields, 'Si_thick', mrg_from=compice, mrg_fld='Si_thick', mrg_type='copy') end if end if end if @@ -2856,13 +2856,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !---------------------------------------------------------- if (wavice_coupling) then if (phase == 'advertise') then - call addfld(fldListFr(compice)%flds, 'Si_floediam') - call addfld(fldListTo(compwav)%flds, 'Si_floediam') + call addfld(fldListFr(compice)%fields, 'Si_floediam') + call addfld(fldListTo(compwav)%fields, 'Si_floediam') else if (fldchk(is_local%wrap%FBexp(compwav) , 'Si_floediam', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_floediam', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Si_floediam', compwav, mapbilnr, 'one', ice2wav_smap) - call addmrg(fldListTo(compwav)%flds, 'Si_floediam', mrg_from=compice, mrg_fld='Si_floediam', mrg_type='copy') + call addmap(fldListFr(compice)%fields, 'Si_floediam', compwav, mapbilnr, 'one', ice2wav_smap) + call addmrg(fldListTo(compwav)%fields, 'Si_floediam', mrg_from=compice, mrg_fld='Si_floediam', mrg_type='copy') end if end if end if @@ -2870,39 +2870,39 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to wav: ocean surface temperature from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compocn)%flds, 'So_t') - call addfld(fldListTo(compwav)%flds, 'So_t') + call addfld(fldListFr(compocn)%fields, 'So_t') + call addfld(fldListTo(compwav)%fields, 'So_t') else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_t', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compwav) , 'So_t', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap(fldListFr(compocn)%flds, 'So_t', compwav, mapbilnr, 'one', ocn2wav_smap) - call addmrg(fldListTo(compwav)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + call addmap(fldListFr(compocn)%fields, 'So_t', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmrg(fldListTo(compwav)%fields, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to wav: ocean currents from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compocn)%flds, 'So_u') - call addfld(fldListTo(compwav)%flds, 'So_u') + call addfld(fldListFr(compocn)%fields, 'So_u') + call addfld(fldListTo(compwav)%fields, 'So_u') else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_u', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compwav) , 'So_u', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap(fldListFr(compocn)%flds, 'So_u', compwav, mapbilnr, 'one', ocn2wav_smap) - call addmrg(fldListTo(compwav)%flds, 'So_u', mrg_from=compocn, mrg_fld='So_u', mrg_type='copy') + call addmap(fldListFr(compocn)%fields, 'So_u', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmrg(fldListTo(compwav)%fields, 'So_u', mrg_from=compocn, mrg_fld='So_u', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compocn)%flds, 'So_v') - call addfld(fldListTo(compwav)%flds, 'So_v') + call addfld(fldListFr(compocn)%fields, 'So_v') + call addfld(fldListTo(compwav)%fields, 'So_v') else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_v', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compwav) , 'So_v', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap(fldListFr(compocn)%flds, 'So_v', compwav, mapbilnr, 'one', ocn2wav_smap) - call addmrg(fldListTo(compwav)%flds, 'So_v', mrg_from=compocn, mrg_fld='So_v', mrg_type='copy') + call addmap(fldListFr(compocn)%fields, 'So_v', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmrg(fldListTo(compwav)%fields, 'So_v', mrg_from=compocn, mrg_fld='So_v', mrg_type='copy') end if end if @@ -2910,14 +2910,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to wav: ocean boundary layer depth from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compocn)%flds, 'So_bldepth') - call addfld(fldListTo(compwav)%flds, 'So_bldepth') + call addfld(fldListFr(compocn)%fields, 'So_bldepth') + call addfld(fldListTo(compwav)%fields, 'So_bldepth') else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_bldepth', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compwav) , 'So_bldepth', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap(fldListFr(compocn)%flds, 'So_bldepth', compwav, mapbilnr, 'one', ocn2wav_smap) - call addmrg(fldListTo(compwav)%flds, 'So_bldepth', mrg_from=compocn, mrg_fld='So_bldepth', mrg_type='copy') + call addmap(fldListFr(compocn)%fields, 'So_bldepth', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmrg(fldListTo(compwav)%fields, 'So_bldepth', mrg_from=compocn, mrg_fld='So_bldepth', mrg_type='copy') end if end if @@ -2925,23 +2925,23 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to wav: zonal and meridional winds at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_u') - call addfld(fldListTo(compwav)%flds, 'Sa_u') + call addfld(fldListFr(compatm)%fields, 'Sa_u') + call addfld(fldListTo(compwav)%fields, 'Sa_u') else if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_u', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_u', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_u', compwav, mapbilnr, 'one', atm2wav_map) - call addmrg(fldListTo(compwav)%flds, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Sa_u', compwav, mapbilnr, 'one', atm2wav_map) + call addmrg(fldListTo(compwav)%fields, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_v') - call addfld(fldListTo(compwav)%flds, 'Sa_v') + call addfld(fldListFr(compatm)%fields, 'Sa_v') + call addfld(fldListTo(compwav)%fields, 'Sa_v') else if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_v', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_v', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_v', compwav, mapbilnr, 'one', atm2wav_map) - call addmrg(fldListTo(compwav)%flds, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Sa_v', compwav, mapbilnr, 'one', atm2wav_map) + call addmrg(fldListTo(compwav)%fields, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') end if end if @@ -2949,13 +2949,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to wav: temperature at lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_tbot') - call addfld(fldListTo(compwav)%flds, 'Sa_tbot') + call addfld(fldListFr(compatm)%fields, 'Sa_tbot') + call addfld(fldListTo(compwav)%fields, 'Sa_tbot') else if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_tbot', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_tbot', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_tbot', compwav, mapbilnr, 'one', atm2wav_map) - call addmrg(fldListTo(compwav)%flds, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') + call addmap(fldListFr(compatm)%fields, 'Sa_tbot', compwav, mapbilnr, 'one', atm2wav_map) + call addmrg(fldListTo(compwav)%fields, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') end if end if @@ -2967,13 +2967,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to rof: water flux from land (liquid surface) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Flrl_rofsur') - call addfld(fldListTo(comprof)%flds, 'Flrl_rofsur') + call addfld(fldListFr(complnd)%fields, 'Flrl_rofsur') + call addfld(fldListTo(comprof)%fields, 'Flrl_rofsur') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsur', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsur', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Flrl_rofsur', comprof, mapconsf, 'lfrac', lnd2rof_map) - call addmrg(fldListTo(comprof)%flds, 'Flrl_rofsur', & + call addmap(fldListFr(complnd)%fields, 'Flrl_rofsur', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrg(fldListTo(comprof)%fields, 'Flrl_rofsur', & mrg_from=complnd, mrg_fld='Flrl_rofsur', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if @@ -2982,13 +2982,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to rof: water flux from land (ice surface) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Flrl_rofi') - call addfld(fldListTo(comprof)%flds, 'Flrl_rofi') + call addfld(fldListFr(complnd)%fields, 'Flrl_rofi') + call addfld(fldListTo(comprof)%fields, 'Flrl_rofi') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofi', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofi', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Flrl_rofi', comprof, mapconsf, 'lfrac', lnd2rof_map) - call addmrg(fldListTo(comprof)%flds, 'Flrl_rofi', & + call addmap(fldListFr(complnd)%fields, 'Flrl_rofi', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrg(fldListTo(comprof)%fields, 'Flrl_rofi', & mrg_from=complnd, mrg_fld='Flrl_rofi', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if @@ -2997,13 +2997,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to rof: water flux from land (liquid glacier, wetland, and lake) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Flrl_rofgwl') - call addfld(fldListTo(comprof)%flds, 'Flrl_rofgwl') + call addfld(fldListFr(complnd)%fields, 'Flrl_rofgwl') + call addfld(fldListTo(comprof)%fields, 'Flrl_rofgwl') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofgwl', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofgwl', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Flrl_rofgwl', comprof, mapconsf, 'lfrac', lnd2rof_map) - call addmrg(fldListTo(comprof)%flds, 'Flrl_rofgwl', & + call addmap(fldListFr(complnd)%fields, 'Flrl_rofgwl', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrg(fldListTo(comprof)%fields, 'Flrl_rofgwl', & mrg_from=complnd, mrg_fld='Flrl_rofgwl', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if @@ -3012,13 +3012,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to rof: water flux from land (liquid subsurface) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Flrl_rofsub') - call addfld(fldListTo(comprof)%flds, 'Flrl_rofsub') + call addfld(fldListFr(complnd)%fields, 'Flrl_rofsub') + call addfld(fldListTo(comprof)%fields, 'Flrl_rofsub') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsub', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsub', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Flrl_rofsub', comprof, mapconsf, 'lfrac', lnd2rof_map) - call addmrg(fldListTo(comprof)%flds, 'Flrl_rofsub', & + call addmap(fldListFr(complnd)%fields, 'Flrl_rofsub', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrg(fldListTo(comprof)%fields, 'Flrl_rofsub', & mrg_from=complnd, mrg_fld='Flrl_rofsub', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if @@ -3027,13 +3027,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to rof: irrigation flux from land (withdrawal from rivers) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Flrl_irrig') - call addfld(fldListTo(comprof)%flds, 'Flrl_irrig') + call addfld(fldListFr(complnd)%fields, 'Flrl_irrig') + call addfld(fldListTo(comprof)%fields, 'Flrl_irrig') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_irrig', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_irrig', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Flrl_irrig', comprof, mapconsf, 'lfrac', lnd2rof_map) - call addmrg(fldListTo(comprof)%flds, 'Flrl_irrig', & + call addmap(fldListFr(complnd)%fields, 'Flrl_irrig', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrg(fldListTo(comprof)%fields, 'Flrl_irrig', & mrg_from=complnd, mrg_fld='Flrl_irrig', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if @@ -3053,25 +3053,25 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Note : Sl_topo is sent from lnd -> med, but is NOT sent to glc (only used for the remapping in the mediator) if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Sl_tsrf_elev') ! surface temperature of glacier (1->glc_nec+1) - call addfld(fldListFr(complnd)%flds, 'Sl_topo_elev') ! surface heights of glacier (1->glc_nec+1) - call addfld(fldListFr(complnd)%flds, 'Flgl_qice_elev') ! glacier ice flux (1->glc_nec+1) + call addfld(fldListFr(complnd)%fields, 'Sl_tsrf_elev') ! surface temperature of glacier (1->glc_nec+1) + call addfld(fldListFr(complnd)%fields, 'Sl_topo_elev') ! surface heights of glacier (1->glc_nec+1) + call addfld(fldListFr(complnd)%fields, 'Flgl_qice_elev') ! glacier ice flux (1->glc_nec+1) do ns = 1,is_local%wrap%num_icesheets - call addfld(fldListTo(compglc(ns))%flds, 'Sl_tsrf') - call addfld(fldListTo(compglc(ns))%flds, 'Flgl_qice') + call addfld(fldListTo(compglc(ns))%fields, 'Sl_tsrf') + call addfld(fldListTo(compglc(ns))%fields, 'Flgl_qice') end do else ! custom mapping, accumulation and merging will be done in prep_glc_mod.F90 do ns = 1,is_local%wrap%num_icesheets if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Flgl_qice_elev', rc=rc)) then - call addmap(FldListFr(complnd)%flds, 'Flgl_qice_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') + call addmap(FldListFr(complnd)%fields, 'Flgl_qice_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') end if if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Sl_tsrf_elev' , rc=rc)) then - call addmap(FldListFr(complnd)%flds, 'Sl_tsrf_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') + call addmap(FldListFr(complnd)%fields, 'Sl_tsrf_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') end if if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Sl_topo_elev' , rc=rc)) then ! This is needed just for mappingn to glc - but is not sent as a field - call addmap(FldListFr(complnd)%flds, 'Sl_topo_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') + call addmap(FldListFr(complnd)%fields, 'Sl_topo_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') end if end do end if @@ -3081,21 +3081,21 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------- if (is_local%wrap%ocn2glc_coupling) then if (phase == 'advertise') then - call addfld(fldListFr(compocn)%flds, 'So_t_depth') - call addfld(fldListFr(compocn)%flds, 'So_s_depth') + call addfld(fldListFr(compocn)%fields, 'So_t_depth') + call addfld(fldListFr(compocn)%fields, 'So_s_depth') do ns = 1,is_local%wrap%num_icesheets - call addfld(fldListTo(compglc(ns))%flds, 'So_t_depth') - call addfld(fldListTo(compglc(ns))%flds, 'So_s_depth') + call addfld(fldListTo(compglc(ns))%fields, 'So_t_depth') + call addfld(fldListTo(compglc(ns))%fields, 'So_s_depth') end do else ! custom mapping, accumulation and merging will be done in prep_glc_mod.F90 ! the following is used to create the route handle do ns = 1,is_local%wrap%num_icesheets if ( fldchk(is_local%wrap%FBImp(compocn,compocn) , 'So_t_depth', rc=rc)) then - call addmap(FldListFr(compocn)%flds, 'So_t_depth', compglc(ns), mapbilnr, 'none', 'unset') + call addmap(FldListFr(compocn)%fields, 'So_t_depth', compglc(ns), mapbilnr, 'none', 'unset') end if if ( fldchk(is_local%wrap%FBImp(compocn,compocn) , 'So_s_depth', rc=rc)) then - call addmap(FldListFr(compocn)%flds, 'So_s_depth', compglc(ns), mapbilnr, 'none', 'unset') + call addmap(FldListFr(compocn)%fields, 'So_s_depth', compglc(ns), mapbilnr, 'none', 'unset') end if end do end if @@ -3125,16 +3125,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd and ocn: prognostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_co2prog') - call addfld(fldListTo(complnd)%flds, 'Sa_co2prog') - call addfld(fldListTo(compocn)%flds, 'Sa_co2prog') + call addfld(fldListFr(compatm)%fields, 'Sa_co2prog') + call addfld(fldListTo(complnd)%fields, 'Sa_co2prog') + call addfld(fldListTo(compocn)%fields, 'Sa_co2prog') else - call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) - call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) + call addmap(fldListFr(compatm)%fields, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) - call addmrg(fldListTo(complnd)%flds, 'Sa_co2prog', & + call addmrg(fldListTo(complnd)%fields, 'Sa_co2prog', & mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - call addmrg(fldListTo(compocn)%flds, 'Sa_co2prog', & + call addmrg(fldListTo(compocn)%fields, 'Sa_co2prog', & mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') end if @@ -3142,16 +3142,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd and ocn: diagnostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_co2diag') - call addfld(fldListTo(complnd)%flds, 'Sa_co2diag') - call addfld(fldListTo(compocn)%flds, 'Sa_co2diag') + call addfld(fldListFr(compatm)%fields, 'Sa_co2diag') + call addfld(fldListTo(complnd)%fields, 'Sa_co2diag') + call addfld(fldListTo(compocn)%fields, 'Sa_co2diag') else - call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) - call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) + call addmap(fldListFr(compatm)%fields, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) - call addmrg(fldListTo(complnd)%flds, 'Sa_co2diag', & + call addmrg(fldListTo(complnd)%fields, 'Sa_co2diag', & mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - call addmrg(fldListTo(compocn)%flds, 'Sa_co2diag', & + call addmrg(fldListTo(compocn)%fields, 'Sa_co2diag', & mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') end if @@ -3161,11 +3161,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: prognostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_co2prog') - call addfld(fldListTo(complnd)%flds, 'Sa_co2prog') + call addfld(fldListFr(compatm)%fields, 'Sa_co2prog') + call addfld(fldListTo(complnd)%fields, 'Sa_co2prog') else - call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Sa_co2prog', & + call addmap(fldListFr(compatm)%fields, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Sa_co2prog', & mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') end if @@ -3173,11 +3173,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: diagnostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_co2diag') - call addfld(fldListTo(complnd)%flds, 'Sa_co2diag') + call addfld(fldListFr(compatm)%fields, 'Sa_co2diag') + call addfld(fldListTo(complnd)%fields, 'Sa_co2diag') else - call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Sa_co2diag', & + call addmap(fldListFr(compatm)%fields, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%fields, 'Sa_co2diag', & mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') end if @@ -3185,11 +3185,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: surface flux of CO2 from land ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Fall_fco2_lnd') - call addfld(fldListTo(compatm)%flds, 'Fall_fco2_lnd') + call addfld(fldListFr(complnd)%fields, 'Fall_fco2_lnd') + call addfld(fldListTo(compatm)%fields, 'Fall_fco2_lnd') else - call addmap(fldListFr(complnd)%flds, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Fall_fco2_lnd', & + call addmap(fldListFr(complnd)%fields, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Fall_fco2_lnd', & mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if @@ -3199,16 +3199,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd and ocn: prognostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_co2prog') - call addfld(fldListTo(complnd)%flds, 'Sa_co2prog') - call addfld(fldListTo(compocn)%flds, 'Sa_co2prog') + call addfld(fldListFr(compatm)%fields, 'Sa_co2prog') + call addfld(fldListTo(complnd)%fields, 'Sa_co2prog') + call addfld(fldListTo(compocn)%fields, 'Sa_co2prog') else - call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) - call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) + call addmap(fldListFr(compatm)%fields, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) - call addmrg(fldListTo(complnd)%flds, 'Sa_co2prog', & + call addmrg(fldListTo(complnd)%fields, 'Sa_co2prog', & mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - call addmrg(fldListTo(compocn)%flds, 'Sa_co2prog', & + call addmrg(fldListTo(compocn)%fields, 'Sa_co2prog', & mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') end if @@ -3216,16 +3216,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd and ocn: diagnostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_co2diag') - call addfld(fldListTo(complnd)%flds, 'Sa_co2diag') - call addfld(fldListTo(compocn)%flds, 'Sa_co2diag') + call addfld(fldListFr(compatm)%fields, 'Sa_co2diag') + call addfld(fldListTo(complnd)%fields, 'Sa_co2diag') + call addfld(fldListTo(compocn)%fields, 'Sa_co2diag') else - call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) - call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%fields, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) + call addmap(fldListFr(compatm)%fields, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) - call addmrg(fldListTo(complnd)%flds, 'Sa_co2diag', & + call addmrg(fldListTo(complnd)%fields, 'Sa_co2diag', & mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - call addmrg(fldListTo(compocn)%flds, 'Sa_co2diag', & + call addmrg(fldListTo(compocn)%fields, 'Sa_co2diag', & mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') end if @@ -3233,11 +3233,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: surface flux of CO2 from land ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Fall_fco2_lnd') - call addfld(fldListTo(compatm)%flds, 'Fall_fco2_lnd') + call addfld(fldListFr(complnd)%fields, 'Fall_fco2_lnd') + call addfld(fldListTo(compatm)%fields, 'Fall_fco2_lnd') else - call addmap(fldListFr(complnd)%flds, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) - call addmrg(fldListTo(compatm)%flds, 'Fall_fco2_lnd', & + call addmap(fldListFr(complnd)%fields, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) + call addmrg(fldListTo(compatm)%fields, 'Fall_fco2_lnd', & mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if @@ -3245,10 +3245,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: surface flux of CO2 from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compocn)%flds, 'Faoo_fco2_ocn') - call addfld(fldListTo(compatm)%flds, 'Faoo_fco2_ocn') + call addfld(fldListFr(compocn)%fields, 'Faoo_fco2_ocn') + call addfld(fldListTo(compatm)%fields, 'Faoo_fco2_ocn') else - call addmap(fldListFr(compocn)%flds, 'Faoo_fco2_ocn', compatm, mapconsd, 'one', ocn2atm_map) + call addmap(fldListFr(compocn)%fields, 'Faoo_fco2_ocn', compatm, mapconsd, 'one', ocn2atm_map) ! custom merge in med_phases_prep_atm end if endif diff --git a/mediator/med.F90 b/mediator/med.F90 index ac92f2638..25b16aa0a 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -874,7 +874,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) if (mastertask) write(logunit,*) nflds = med_fldList_GetNumFlds(fldListFr(ncomp)) do n = 1,nflds - call med_fldList_GetFldInfo(fldListFr(ncomp), n, stdname, shortname) + call med_fldList_GetFldInfo(fldListFr(ncomp), n, stdname=stdname, shortname=shortname) if (mastertask) then write(logunit,'(a)') trim(subname)//':Fr_'//trim(compname(ncomp))//': '//trim(shortname) end if @@ -891,7 +891,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) end do nflds = med_fldList_GetNumFlds(fldListTo(ncomp)) do n = 1,nflds - call med_fldList_GetFldInfo(fldListTo(ncomp), n, stdname, shortname) + call med_fldList_GetFldInfo(fldListTo(ncomp), n, stdname=stdname, shortname=shortname) if (mastertask) then write(logunit,'(a)') trim(subname)//':To_'//trim(compname(ncomp))//': '//trim(shortname) end if diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index bd1aa4f80..223b1da25 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -101,7 +101,7 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f num_merge_fields = med_fldList_GetNumFlds(fldListTo) allocate(merge_field_names(num_merge_fields)) do nfld_in = 1,num_merge_fields - call med_fldList_GetFldInfo(fldListTo, nfld_in, merge_field_names(nfld_in)) + call med_fldList_GetFldInfo(fldListTo, nfld_in, stdname=merge_field_names(nfld_in)) end do ! Want to loop over all of the fields in FBout here - and find the corresponding index in fldListTo(compxxx) @@ -112,7 +112,7 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f zero_output = .true. ! Loop over the field in fldListTo - do nfld_in = 1,med_fldList_GetNumFlds(fldListTo) + do nfld_in = 1,num_merge_fields if (trim(merge_field_names(nfld_in)) == trim(fieldnamelist(nfld_out))) then @@ -130,7 +130,7 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f end if ! Determine the merge information for the import field - call med_fldList_GetFldInfo(fldListTo, nfld_in, compsrc, merge_fields, merge_type, merge_fracname) + call med_fldList_GetFldInfo(fldListTo, nfld_in, compsrc=compsrc, merge_fields=merge_fields, merge_type=merge_type, merge_fracname=merge_fracname) if (merge_type /= 'unset' .and. merge_field /= 'unset') then ! If merge_field is a colon delimited string then cycle through every field - otherwise by default nm @@ -266,7 +266,7 @@ subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo, num_merge_fields = med_fldList_GetNumFlds(fldListTo) allocate(merge_field_names(num_merge_fields)) do nfld_in = 1,num_merge_fields - call med_fldList_GetFldInfo(fldListTo, nfld_in, merge_field_names(nfld_in)) + call med_fldList_GetFldInfo(fldListTo, nfld_in, stdname=merge_field_names(nfld_in)) end do ! Loop over all fields in output field bundle FBOut @@ -282,7 +282,7 @@ subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo, ! If the merge field name from the source components is not set, then simply go to the next component ! Determine the merge information for the import field - call med_fldList_GetFldInfo(fldListTo, nfld_in, compsrc, merge_fields, merge_type, merge_fracname) + call med_fldList_GetFldInfo(fldListTo, nfld_in, compsrc=compsrc, merge_fields=merge_fields, merge_type=merge_type, merge_fracname=merge_fracname) if (merge_type /= 'unset' .and. merge_field /= 'unset') then diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index e64eea43b..011b9a2b0 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -109,7 +109,7 @@ subroutine med_phases_prep_rof_init(gcomp, rc) nflds = med_fldlist_getnumflds(fldlistTo(comprof)) allocate(fldnames_temp(nflds)) do n = 1,nflds - call med_fldList_GetFldInfo(fldListTo(comprof), n, fldnames_temp(n)) + call med_fldList_GetFldInfo(fldListTo(comprof), n, stdname=fldnames_temp(n)) end do do n = 1,nflds if (trim(fldnames_temp(n)) == trim(is_local%wrap%flds_scalar_name)) then From cc86157cc5d2bd754771fcf1ee0f4e9032b40663 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Sat, 19 Nov 2022 14:32:30 -0700 Subject: [PATCH 127/395] one the way to fully functional linked list implementation --- mediator/esmFlds.F90 | 357 +++-- mediator/esmFldsExchange_cesm_mod.F90 | 1940 +++++++++++++------------ mediator/esmFldsExchange_hafs_mod.F90 | 58 +- mediator/esmFldsExchange_nems_mod.F90 | 259 ++-- mediator/med_map_mod.F90 | 26 +- mediator/med_phases_prep_ice_mod.F90 | 5 +- mediator/med_phases_prep_lnd_mod.F90 | 4 +- mediator/med_phases_prep_rof_mod.F90 | 13 +- mediator/med_phases_prep_wav_mod.F90 | 4 +- 9 files changed, 1396 insertions(+), 1270 deletions(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index 422312021..01c148b9a 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -1,9 +1,9 @@ module esmflds - + use ESMF, only : ESMF_SUCCESS, ESMF_FAILURE 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 : ncomps, compname, compocn, compatm use med_internalstate_mod, only : mapfcopy, mapnames, mapunset - + use med_utils_mod , only : chkerr => med_utils_ChkErr implicit none private @@ -12,16 +12,31 @@ module esmflds !----------------------------------------------- public :: med_fldList_init1 - public :: med_fldList_AddFld - public :: med_fldList_AddMap - public :: med_fldList_AddMrg + + public :: med_fldList_AddFldFrom + public :: med_fldList_AddMapFrom + public :: med_fldList_AddMrgFrom + public :: med_fldList_AddFldTo + public :: med_fldList_AddMapTo + public :: med_fldList_AddMrgTo + + public :: med_fldList_AddOcnalbFld + + public :: med_fldList_AddaofluxFld + public :: med_fldList_AddaofluxMap + + private :: med_fldList_AddFld + private :: med_fldList_AddMap + private :: med_fldList_AddMrg + public :: med_fldList_GetFldNames public :: med_fldList_GetNumFlds public :: med_fldList_GetFldInfo public :: med_fldList_Realize public :: med_fldList_Document_Mapping public :: med_fldList_Document_Merging - + public :: med_fldList_GetFldListFr + public :: med_fldList_GetFldListTo !----------------------------------------------- ! Types and instantiations that determine fields, mappings, mergings !----------------------------------------------- @@ -51,21 +66,14 @@ module esmflds type (med_fldList_entry_type) :: fields end type med_fldList_type - interface med_fldList_GetFldInfo ; module procedure & - med_fldList_GetFldInfo_general, & - med_fldList_GetFldInfo_stdname, & - med_fldList_GetFldInfo_merging, & - med_fldList_GetFldInfo_index - end interface - !----------------------------------------------- ! Instantiate derived types !----------------------------------------------- - type (med_fldList_type), allocatable, public :: fldListTo(:) ! advertise fields to components - type (med_fldList_type), allocatable, public :: fldListFr(:) ! advertise fields from components + type (med_fldList_type), allocatable, target :: fldListTo(:) ! advertise fields to components + type (med_fldList_type), allocatable, target :: fldListFr(:) ! advertise fields from components - type (med_fldList_type), public :: fldListMed_aoflux - type (med_fldList_type), public :: fldListMed_ocnalb + type (med_fldList_type), target :: fldListMed_aoflux + type (med_fldList_type), target :: fldListMed_ocnalb integer :: rc character(len=CL) :: infostr @@ -81,8 +89,57 @@ subroutine med_fldlist_init1() allocate(fldlistFr(ncomps)) end subroutine med_fldlist_init1 + function med_fldList_GetFldListFr(index) result(fldList) + integer, intent(in) :: index + type(med_fldList_type), pointer :: fldList + + fldList => fldListFr(index) + end function Med_FldList_GetFldListFr + + function med_fldList_GetFldListTo(index) result(fldList) + integer, intent(in) :: index + type(med_fldList_type), pointer :: fldList + + fldList => fldListTo(index) + end function Med_FldList_GetFldListTo + + !================================================================================ - subroutine med_fldList_AddFld(flds, stdname, shortname) + subroutine med_fldList_AddFldFrom(index, stdname, shortname) + integer, intent(in) :: index + character(len=*) , intent(in) :: stdname + character(len=*) , intent(in) , optional :: shortname + + call med_fldList_AddFld(FldListFr(index)%fields, stdname, shortname) + + end subroutine med_fldList_AddFldFrom + !================================================================================ + subroutine med_fldList_AddaofluxFld(stdname, shortname) + character(len=*) , intent(in) :: stdname + character(len=*) , intent(in) , optional :: shortname + + call med_fldList_AddFld(fldListMed_aoflux%fields, stdname, shortname) + + end subroutine med_fldList_AddaofluxFld + !================================================================================ + subroutine med_fldList_AddocnalbFld(stdname, shortname) + character(len=*) , intent(in) :: stdname + character(len=*) , intent(in) , optional :: shortname + + call med_fldList_AddFld(fldListMed_ocnalb%fields, stdname, shortname) + + end subroutine med_fldList_AddocnalbFld + !================================================================================ + subroutine med_fldList_AddFldTo(index, stdname, shortname) + integer, intent(in) :: index + character(len=*) , intent(in) :: stdname + character(len=*) , intent(in) , optional :: shortname + + call med_fldList_AddFld(FldListTo(index)%fields, stdname, shortname) + + end subroutine med_fldList_AddFldTo + + subroutine med_fldList_AddFld(fields, stdname, shortname) ! ---------------------------------------------- ! Add an entry to to the flds array ! Use pointers to create an extensible allocatable array. @@ -108,7 +165,7 @@ subroutine med_fldList_AddFld(flds, stdname, shortname) newfld => fields found = .false. - do while(newfld%next) + do while(associated(newfld%next)) if (trim(stdname) == trim(newfld%stdname)) then found = .true. exit @@ -150,15 +207,33 @@ subroutine med_fldList_AddFld(flds, stdname, shortname) end subroutine med_fldList_AddFld !================================================================================ + subroutine med_fldList_AddMrgFrom(index, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname, rc) - subroutine med_fldList_AddMrg(flds, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname, rc) + ! ---------------------------------------------- + ! Determine mrg entry or entries in flds aray + ! ---------------------------------------------- + + ! input/output variables + integer , intent(in) :: index + character(len=*) , intent(in) :: fldname + integer , intent(in) :: mrg_from + character(len=*) , intent(in) :: mrg_fld + character(len=*) , intent(in) :: mrg_type + character(len=*) , intent(in), optional :: mrg_fracname + integer , intent(out), optional :: rc + + call med_FldList_addMrg(fldListFr(index)%fields, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname) + + end subroutine med_fldList_AddMrgFrom + !================================================================================ + subroutine med_fldList_AddMrgTo(index, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname, rc) ! ---------------------------------------------- ! Determine mrg entry or entries in flds aray ! ---------------------------------------------- ! input/output variables - type(med_fldList_entry_type) , pointer :: flds(:) + integer , intent(in) :: index character(len=*) , intent(in) :: fldname integer , intent(in) :: mrg_from character(len=*) , intent(in) :: mrg_fld @@ -166,32 +241,49 @@ subroutine med_fldList_AddMrg(flds, fldname, mrg_from, mrg_fld, mrg_type, mrg_fr character(len=*) , intent(in), optional :: mrg_fracname integer , intent(out), optional :: rc + call med_FldList_addMrg(fldListTo(index)%fields, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname) + + end subroutine med_fldList_AddMrgTo + subroutine med_fldList_AddMrg(flds, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname) + + ! ---------------------------------------------- + ! Determine mrg entry or entries in flds aray + ! ---------------------------------------------- + + ! input/output variables + type(med_fldList_entry_type) , intent(in), target :: flds + character(len=*) , intent(in) :: fldname + integer , intent(in) :: mrg_from + character(len=*) , intent(in) :: mrg_fld + character(len=*) , intent(in) :: mrg_type + character(len=*) , intent(in), optional :: mrg_fracname + ! local variables - integer :: lrc + integer :: rc type(med_fldList_entry_type), pointer :: newfld character(len=*), parameter :: subname='(med_fldList_AddMrg)' ! ---------------------------------------------- - newfld => med_fldList_GetFld(flds, fldname, lrc) - if (present(rc)) rc = lrc - if (chkerr(lrc,__LINE__,u_FILE_u)) return + newfld => med_fldList_GetFld(flds, fldname, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - newfld%merge_fields(n) = mrg_fld - newfld%merge_types(n) = mrg_type + newfld%merge_fields(mrg_from) = mrg_fld + newfld%merge_types(mrg_from) = mrg_type if (present(mrg_fracname)) then - newfld%merge_fracnames(n) = mrg_fracname + newfld%merge_fracnames(mrg_from) = mrg_fracname end if end subroutine med_fldList_AddMrg - function med_fldList_GetFld(flds, fldname, rc) result(newfld) - use ESMF, only : ESMF_LogWrite, ESMF_END_ABORT, ESMF_LOGMSG_ERROR, ESMF_Finalize + function med_fldList_GetFld(fields, fldname, rc) result(newfld) + use ESMF, only : ESMF_LogWrite, ESMF_END_ABORT, ESMF_LOGMSG_ERROR, ESMF_Finalize, ESMF_LOGMSG_INFO type(med_fldList_entry_type) , intent(in), target :: fields character(len=*) , intent(in) :: fldname type(med_fldList_entry_type), pointer :: newfld integer :: rc + character(len=*), parameter :: subname='(med_fldList_GetFld)' newfld => fields rc = ESMF_FAILURE @@ -214,29 +306,63 @@ function med_fldList_GetFld(flds, fldname, rc) result(newfld) end function med_fldList_GetFld !================================================================================ + subroutine med_fldList_AddMapFrom(index, fldname, destcomp, maptype, mapnorm, mapfile) + integer, intent(in) :: index + character(len=*) , intent(in) :: fldname + integer , intent(in) :: destcomp + integer , intent(in) :: maptype + character(len=*) , intent(in) :: mapnorm + character(len=*), optional , intent(in) :: mapfile + + call med_fldList_AddMap(FldListFr(index)%fields, fldname, destcomp, maptype, mapnorm, mapfile) + + end subroutine med_fldList_AddMapFrom + !================================================================================ + subroutine med_fldList_AddMapTo(index, fldname, destcomp, maptype, mapnorm, mapfile) + integer, intent(in) :: index + character(len=*) , intent(in) :: fldname + integer , intent(in) :: destcomp + integer , intent(in) :: maptype + character(len=*) , intent(in) :: mapnorm + character(len=*), optional , intent(in) :: mapfile + + call med_fldList_AddMap(FldListTo(index)%fields, fldname, destcomp, maptype, mapnorm, mapfile) + + end subroutine med_fldList_AddMapTo + !================================================================================ + subroutine med_fldList_AddaofluxMap(fldname, destcomp, maptype, mapnorm, mapfile) + character(len=*) , intent(in) :: fldname + integer , intent(in) :: destcomp + integer , intent(in) :: maptype + character(len=*) , intent(in) :: mapnorm + character(len=*), optional , intent(in) :: mapfile + + call med_fldList_AddMap(fldlistmed_aoflux%fields, fldname, destcomp, maptype, mapnorm, mapfile) + + end subroutine med_fldList_AddaofluxMap - subroutine med_fldList_AddMap(flds, fldname, destcomp, maptype, mapnorm, mapfile, rc) + subroutine med_fldList_AddMap(fields, fldname, destcomp, maptype, mapnorm, mapfile) use ESMF, only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_LogWrite, ESMF_LOGMSG_INFO ! intput/output variables + type(med_fldList_entry_type) , intent(in), target :: fields + character(len=*) , intent(in) :: fldname integer , intent(in) :: destcomp integer , intent(in) :: maptype character(len=*) , intent(in) :: mapnorm character(len=*), optional , intent(in) :: mapfile - integer , intent(out) :: rc ! local variables type(med_fldList_entry_type), pointer :: newfld - integer :: id, n + integer :: id, n, rc character(len=CX) :: lmapfile character(len=*),parameter :: subname='(med_fldList_AddMap)' ! ---------------------------------------------- lmapfile = 'unset' - rc = ESMF_FAILURE if (present(mapfile)) lmapfile = mapfile - newfld => med_fldList_GetFld(flds, fldname, rc) + newfld => med_fldList_GetFld(fields, fldname, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Note - default values are already set for the fld entries - so only non-default ! values need to be set below @@ -275,7 +401,7 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num use ESMF , only : ESMF_RC_ARG_BAD, ESMF_LogSetError, operator(==) ! input/output variables type(ESMF_State) , intent(inout) :: state - type(med_fldlist_type), intent(in) :: fldList + type(med_fldlist_type) , intent(in), target :: fldList character(len=*) , intent(in) :: flds_scalar_name integer , intent(in) :: flds_scalar_num character(len=*) , intent(in) :: tag @@ -284,8 +410,9 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num type(ESMF_Mesh) , intent(in) , optional :: mesh ! local variables - integer :: n, nflds + type(med_fldList_entry_type), pointer :: newfld integer :: itemCount + integer :: n type(ESMF_Field) :: field character(CS) :: shortname character(CS) :: stdname @@ -353,7 +480,6 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num enddo #endif - nflds = size(fldList%flds) call ESMF_StateGet(state, stateIntent=stateIntent, rc=rc) if (stateIntent==ESMF_STATEINTENT_EXPORT) then transferActionAttr="ProducerTransferAction" @@ -368,8 +494,9 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num return ! bail out endif - do n = 1, nflds - shortname = fldList%flds(n)%shortname + newfld => fldList%fields + do while(associated(newfld%next)) + shortname = newfld%shortname ! call ESMF_LogWrite(subname//' fld = '//trim(shortname), ESMF_LOGMSG_INFO) if (NUOPC_IsConnected(state, fieldName=shortname)) then @@ -477,13 +604,16 @@ end subroutine med_fldList_Realize !================================================================================ - subroutine med_fldList_GetFldInfo(fldList, fldindex, stdname, shortname, merge_field, merge_type, merge_fracname) + subroutine med_fldList_GetFldInfo(fldList, fldindex, compsrc, stdname, shortname, mapindex, mapFile, mapnorm, merge_fields, merge_type, merge_fracname) ! ---------------------------------------------- ! Get field info ! ---------------------------------------------- - type(med_fldList_type) , intent(in) :: fldList - integer , intent(in) :: fldindex + type(med_fldList_type) , intent(in), target :: fldList + integer , intent(in) :: fldindex integer , optional, intent(in) :: compsrc + integer , optional, intent(out) :: mapindex + character(len=*) , optional, intent(out) :: mapfile + character(len=*) , optional, intent(out) :: mapnorm character(len=*) , optional, intent(out) :: stdname character(len=*) , optional, intent(out) :: shortname character(len=*) , optional, intent(out) :: merge_fields @@ -499,81 +629,47 @@ subroutine med_fldList_GetFldInfo(fldList, fldindex, stdname, shortname, merge_f i = 0 lcompsrc = 1 newfld => fldList%fields - do while(newfld) + do while(associated(newfld%next)) i = i+1 if (i==fldindex) exit newfld => newfld%next enddo if(present(stdname)) then - stdname = fldList%fields%stdname + stdname = newfld%stdname endif if(present(shortname)) then - shortname = fldList%fields%shortname + shortname = newfld%shortname + endif + + if(present(mapindex)) then + if(present(compsrc)) lcompsrc = compsrc + mapindex = newfld%mapindex(compsrc) + endif + if(present(mapfile)) then + if(present(compsrc)) lcompsrc = compsrc + mapfile = newfld%mapfile(compsrc) + endif + if(present(mapnorm)) then + if(present(compsrc)) lcompsrc = compsrc + mapnorm = newfld%mapnorm(compsrc) endif if(present(merge_fields)) then if(present(compsrc)) lcompsrc = compsrc - merge_field = fldList%fields%merge_fields(compsrc) + merge_fields = newfld%merge_fields(compsrc) endif if(present(merge_type)) then if(present(compsrc)) lcompsrc = compsrc - merge_type = fldList%fields%merge_types(compsrc) + merge_type = newfld%merge_types(compsrc) endif if(present(merge_fracname)) then if(present(compsrc)) lcompsrc = compsrc - merge_fracname = fldList%fields%merge_fracnames(compsrc) + merge_fracname = newfld%merge_fracnames(compsrc) endif end subroutine med_fldList_GetFldInfo !================================================================================ - subroutine med_fldList_GetFldInfo_index(fldList, stdname_in, fldindex_out) - ! ---------------------------------------------- - ! Get field info - ! ---------------------------------------------- - type(med_fldList_type) , intent(in) :: fldList - character(len=*) , intent(in) :: stdname_in - integer , intent(out) :: fldindex_out - - ! local variables - integer :: n - character(len=*), parameter :: subname='(med_fldList_GetFldInfo_index)' - ! ---------------------------------------------- - - fldindex_out = 0 - if (associated(fldList%flds)) then - do n = 1,size(fldList%flds) - if (trim(fldList%flds(n)%stdname) == stdname_in) fldindex_out = n - enddo - endif - - end subroutine med_fldList_GetFldInfo_index - - !================================================================================ - - subroutine med_fldList_GetFldInfo_merging(fldList, fldindex, compsrc, merge_field, merge_type, merge_fracname) - ! ---------------------------------------------- - ! Get field merge info - ! ---------------------------------------------- - type(med_fldList_type) , intent(in) :: fldList - integer , intent(in) :: fldindex - integer , intent(in) :: compsrc - character(len=*) , intent(out) :: merge_field - character(len=*) , intent(out) :: merge_type - character(len=*) , intent(out) :: merge_fracname - - ! local variables - character(len=*), parameter :: subname='(med_fldList_GetFldInfo_merging)' - ! ---------------------------------------------- - - merge_field = fldList%flds(fldindex)%merge_fields(compsrc) - merge_type = fldList%flds(fldindex)%merge_types(compsrc) - merge_fracname = fldList%flds(fldindex)%merge_fracnames(compsrc) - - end subroutine med_fldList_GetFldInfo_merging - - !================================================================================ - integer function med_fldList_GetNumFlds(fldList) ! input/output variables @@ -581,9 +677,9 @@ integer function med_fldList_GetNumFlds(fldList) ! ---------------------------------------------- type(med_fldList_entry_type), pointer :: newfld - newfld => fldList + newfld => fldList%fields med_fldList_GetNumFlds = 0 - do while(newfld%next) + do while(associated(newfld%next)) med_fldList_GetNumFlds = med_fldList_GetNumFlds + 1 newfld => newfld%next end do @@ -592,31 +688,35 @@ end function med_fldList_GetNumFlds !================================================================================ - subroutine med_fldList_GetFldNames(flds, fldnames, rc) + subroutine med_fldList_GetFldNames(fields, fldnames, rc) use ESMF, only : ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_SUCCESS, ESMF_LogWrite ! input/output variables - type(med_fldList_entry_type) , pointer :: flds(:) - character(len=*) , pointer :: fldnames(:) + type(med_fldList_entry_type) , intent(in), target :: fields + character(len=*) , intent(out), pointer :: fldnames(:) integer, optional , intent(out) :: rc !local variables + type(med_fldList_entry_type), pointer :: newfld integer :: n ! ---------------------------------------------- rc = ESMF_SUCCESS - if (associated(flds) .and. associated(fldnames)) then - do n = 1,size(flds) - fldnames(n) = trim(flds(n)%shortname) - end do - else - call ESMF_LogWrite("med_fldList_GetFldNames: ERROR either flds or fldnames have not been allocate ", & + if (.not. associated(fldnames) .or. .not. allocated(fields%mapindex)) then + call ESMF_LogWrite("med_fldList_GetFldNames: ERROR either fields or fldnames have not been allocate ", & ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return - end if + endif + n = 0 + newfld => fields + do while(associated(newfld%next)) + n = n+1 + fldnames(n) = trim(newfld%shortname) + newfld => newfld%next + enddo end subroutine med_fldList_GetFldNames @@ -643,6 +743,7 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active) character(len=CL) :: mrgstr character(len=CL) :: cvalue logical :: init_mrgstr + type(med_fldList_entry_type), pointer :: newfld character(len=*),parameter :: subname = '(med_fldList_Document_Mapping)' !----------------------------------------------------------- @@ -657,12 +758,13 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active) if (nsrc /= ndst .and. med_coupling_active(nsrc,ndst)) then ! Write all the mappings for fields from the src to the destination component write(logunit,*)' ' - do n = 1,size(fldListFr(nsrc)%flds) - mapindex = fldListFr(nsrc)%flds(n)%mapindex(ndst) + newfld => fldListFr(nsrc)%fields + do while(associated(newfld%next)) + mapindex = newfld%mapindex(ndst) if ( mapindex /= mapunset) then - fldname = trim(fldListFr(nsrc)%flds(n)%stdname) - mapnorm = trim(fldListFr(nsrc)%flds(n)%mapnorm(ndst)) - mapfile = trim(fldListFr(nsrc)%flds(n)%mapfile(ndst)) + fldname = trim(newfld%stdname) + mapnorm = trim(newfld%mapnorm(ndst)) + mapfile = trim(newfld%mapfile(ndst)) if (trim(mapnorm) == 'unset') then cvalue = ' mapping '//trim(compname(nsrc))//'->'//trim(compname(ndst)) //' '//trim(fldname) // & @@ -677,6 +779,7 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active) write(logunit,101) trim(cvalue) end if end if + newfld => newfld%next end do end if @@ -686,13 +789,14 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active) ! ocn-> atm mappings for atm/ocn fluxes computed in mediator on the ocn grid nsrc = compocn ndst = compatm - if (med_coupling_active(nsrc,ndst) .and. associated(fldListMed_aoflux%flds)) then - do n = 1,size(fldListMed_aoflux%flds) - mapindex = fldlistMed_aoflux%flds(n)%mapindex(ndst) + if (med_coupling_active(nsrc,ndst) .and. allocated(fldListMed_aoflux%fields%mapindex)) then + newfld => fldListMed_aoflux%fields + do while(associated(newfld%next)) + mapindex = newfld%mapindex(ndst) if ( mapindex /= mapunset) then - fldname = trim(fldlistMed_aoflux%flds(n)%stdname) - mapnorm = trim(fldlistMed_aoflux%flds(n)%mapnorm(ndst)) - mapfile = trim(fldlistMed_aoflux%flds(n)%mapfile(ndst)) + fldname = trim(newfld%stdname) + mapnorm = trim(newfld%mapnorm(ndst)) + mapfile = trim(newfld%mapfile(ndst)) if (trim(mapnorm) == 'unset') then cvalue = ' mapping '//trim(compname(nsrc))//'->'//trim(compname(ndst)) //' '//trim(fldname) // & @@ -707,6 +811,7 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active) write(logunit,101) trim(cvalue) end if end if + newfld => newfld%next end do end if @@ -740,6 +845,7 @@ subroutine med_fldList_Document_Merging(logunit, med_coupling_active) character(len=CS) :: string character(len=CL) :: mrgstr logical :: init_mrgstr + type(med_fldList_entry_type), pointer :: newfld character(len=*),parameter :: subname = '(med_fldList_Document_Mapping)' !----------------------------------------------------------- @@ -751,8 +857,9 @@ subroutine med_fldList_Document_Merging(logunit, med_coupling_active) prefix = '(merge_to_'//trim(dst_comp)//')' ! Loop over all flds in the destination component and determine merging data - do nf = 1,size(fldListTo(ndst)%flds) - dst_field = fldListTo(ndst)%flds(nf)%stdname + newfld => fldListTo(ndst)%fields + do while(associated(newfld%next)) + dst_field = newfld%stdname ! Loop over all possible source components for destination component field mrgstr = ' ' @@ -760,9 +867,9 @@ subroutine med_fldList_Document_Merging(logunit, med_coupling_active) if (nsrc /= ndst .and. med_coupling_active(nsrc,ndst)) then src_comp = compname(nsrc) - merge_field = fldListTo(ndst)%flds(nf)%merge_fields(nsrc) - merge_type = fldListTo(ndst)%flds(nf)%merge_types(nsrc) - merge_frac = fldListTo(ndst)%flds(nf)%merge_fracnames(nsrc) + merge_field = newfld%merge_fields(nsrc) + merge_type = newfld%merge_types(nsrc) + merge_frac = newfld%merge_fracnames(nsrc) if (merge_type == 'merge' .or. merge_type == 'sum_with_weights') then string = trim(merge_frac)//'*'//trim(merge_field)//'('//trim(src_comp)//')' @@ -788,7 +895,7 @@ subroutine med_fldList_Document_Merging(logunit, med_coupling_active) end if end if end if - + newfld => newfld%next end do ! end loop over nsrc if (mrgstr /= ' ') then write(logunit,'(a)') trim(mrgstr) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index be820095a..652946ad0 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -78,10 +78,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf use med_internalstate_mod , only : coupling_mode use med_internalstate_mod , only : map_glc2ocn_ice, map_glc2ocn_liq, map_rof2ocn_ice, map_rof2ocn_liq - use esmFlds , only : addfld => med_fldList_AddFld - use esmFlds , only : addmap => med_fldList_AddMap - use esmFlds , only : addmrg => med_fldList_AddMrg - use esmflds , only : fldListTo, fldListFr, fldListMed_aoflux, fldListMed_ocnalb + use esmFlds , only : addocnalbfld => med_fldList_AddocnalbFld + use esmFlds , only : addaofluxfld => med_fldList_AddaofluxFld + use esmFlds , only : addaofluxMap => med_fldList_AddaofluxMap + + use esmFlds , only : addfldTo => med_fldList_AddFldTo + use esmFlds , only : addfldFrom => med_fldList_AddFldFrom + use esmFlds , only : addmapTo => med_fldList_AddMapTo + use esmFlds , only : addmapFrom => med_fldList_AddMapFrom + use esmFlds , only : addmrgTo => med_fldList_AddMrgTo + use esmFlds , only : addmrgFrom => med_fldList_AddMrgFrom ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -238,8 +244,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) 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)%fields, trim(cvalue)) - call addfld(fldListTo(n)%fields, trim(cvalue)) + call addfldFrom(n, trim(cvalue)) + call addfldTo(n, trim(cvalue)) end do end if @@ -251,49 +257,49 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to med: masks from components !---------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Sl_lfrin') - call addfld(fldListFr(compocn)%fields, 'So_omask') - call addfld(fldListFr(compice)%fields, 'Si_imask') + call addfldFrom(complnd, 'Sl_lfrin') + call addfldFrom(compocn, 'So_omask') + call addfldFrom(compice, 'Si_imask') do ns = 1,is_local%wrap%num_icesheets - call addfld(fldlistFr(compglc(ns))%fields, 'Sg_area') + call addfldFrom(compglc(ns), 'Sg_area') end do else - call addmap(fldListFr(compocn)%flds, 'So_omask', compice, mapfcopy, 'unset', 'unset') + call addmapFrom(compocn, 'So_omask', compice, mapfcopy, 'unset', 'unset') end if ! --------------------------------------------------------------------- ! to med: atm and ocn fields required for atm/ocn flux calculation' ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_u') - call addfld(fldListFr(compatm)%fields, 'Sa_v') - call addfld(fldListFr(compatm)%fields, 'Sa_z') - call addfld(fldListFr(compatm)%fields, 'Sa_tbot') - call addfld(fldListFr(compatm)%fields, 'Sa_pbot') - call addfld(fldListFr(compatm)%fields, 'Sa_shum') - call addfld(fldListFr(compatm)%fields, 'Sa_ptem') - call addfld(fldListFr(compatm)%fields, 'Sa_dens') + call addFldFrom(compatm, 'Sa_u') + call addFldFrom(compatm, 'Sa_v') + call addFldFrom(compatm, 'Sa_z') + call addFldFrom(compatm, 'Sa_tbot') + call addFldFrom(compatm, 'Sa_pbot') + call addFldFrom(compatm, 'Sa_shum') + call addFldFrom(compatm, 'Sa_ptem') + call addFldFrom(compatm, 'Sa_dens') if (flds_wiso) then - call addfld(fldListFr(compatm)%fields, 'Sa_shum_wiso') + call addFldFrom(compatm, 'Sa_shum_wiso') end if else if (is_local%wrap%aoflux_grid == 'ogrid') then if (mapuv_with_cart3d) then - call addmap(fldListFr(compatm)%fields, 'Sa_u' , compocn, mappatch_uv3d, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%fields, 'Sa_v' , compocn, mappatch_uv3d, 'one', atm2ocn_map) + call addmapFrom(compatm, 'Sa_u' , compocn, mappatch_uv3d, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Sa_v' , compocn, mappatch_uv3d, 'one', atm2ocn_map) else - call addmap(fldListFr(compatm)%fields, 'Sa_u' , compocn, mappatch, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%fields, 'Sa_v' , compocn, mappatch, 'one', atm2ocn_map) - end if - call addmap(fldListFr(compatm)%fields, 'Sa_z' , compocn, mapbilnr, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%fields, 'Sa_tbot', compocn, mapbilnr, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%fields, 'Sa_pbot', compocn, mapbilnr, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%fields, 'Sa_shum', compocn, mapbilnr, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%fields, 'Sa_ptem', compocn, mapbilnr, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%fields, 'Sa_dens', compocn, mapbilnr, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%fields, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Sa_u' , compocn, mappatch, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Sa_v' , compocn, mappatch, 'one', atm2ocn_map) + end if + call addMapFrom(compatm, 'Sa_z' , compocn, mapbilnr, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Sa_tbot', compocn, mapbilnr, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Sa_pbot', compocn, mapbilnr, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Sa_shum', compocn, mapbilnr, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Sa_ptem', compocn, mapbilnr, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Sa_dens', compocn, mapbilnr, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_map) if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_shum_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_shum_wiso', compocn, mapbilnr, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Sa_shum_wiso', compocn, mapbilnr, 'one', atm2ocn_map) end if end if end if @@ -302,16 +308,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to med: swnet fluxes used for budget calculation ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Fall_swnet') - call addfld(fldListFr(compice)%fields, 'Faii_swnet') - call addfld(fldListFr(compatm)%fields, 'Faxa_swnet') + call addFldFrom(complnd, 'Fall_swnet') + call addfldFrom(compice, 'Faii_swnet') + call addFldFrom(compatm, 'Faxa_swnet') else if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swnet', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_swnet', compice, mapconsf, 'one' , atm2ice_map) - call addmap(fldListFr(compatm)%fields, 'Faxa_swnet', compocn, mapconsf, 'one' , atm2ocn_map) + call addMapFrom(compatm, 'Faxa_swnet', compice, mapconsf, 'one' , atm2ice_map) + call addMapFrom(compatm, 'Faxa_swnet', compocn, mapconsf, 'one' , atm2ocn_map) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_swnet', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Faii_swnet', compocn, mapfcopy, 'unset', 'unset') + call addMapFrom(compice, 'Faii_swnet', compocn, mapfcopy, 'unset', 'unset') end if end if @@ -323,26 +329,26 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: height at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_z') - call addfld(fldListTo(complnd)%fields, 'Sa_z') + call addFldFrom(compatm, 'Sa_z') + call addfldTo(complnd, 'Sa_z') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_z', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_z', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_z', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Sa_z', mrg_from=compatm, mrg_fld='Sa_z', mrg_type='copy') + call addMapFrom(compatm, 'Sa_z', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Sa_z', mrg_from=compatm, mrg_fld='Sa_z', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: surface height from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_topo') - call addfld(fldListTo(complnd)%fields, 'Sa_topo') + call addFldFrom(compatm, 'Sa_topo') + call addfldTo(complnd, 'Sa_topo') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_topo', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_topo', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_topo', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Sa_topo', mrg_from=compatm, mrg_fld='Sa_topo', mrg_type='copy') + call addMapFrom(compatm, 'Sa_topo', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Sa_topo', mrg_from=compatm, mrg_fld='Sa_topo', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -350,99 +356,99 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: meridional wind at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_u') - call addfld(fldListTo(complnd)%fields, 'Sa_u') + call addFldFrom(compatm, 'Sa_u') + call addfldTo(complnd, 'Sa_u') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_u', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_u', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_u', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') + call addMapFrom(compatm, 'Sa_u', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_v') - call addfld(fldListTo(complnd)%fields, 'Sa_v') + call addFldFrom(compatm, 'Sa_v') + call addfldTo(complnd, 'Sa_v') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_v', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_v', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_v', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') + call addMapFrom(compatm, 'Sa_v', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: pressure at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_pbot') - call addfld(fldListTo(complnd)%fields, 'Sa_pbot') + call addFldFrom(compatm, 'Sa_pbot') + call addfldTo(complnd, 'Sa_pbot') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_pbot', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_pbot', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_pbot', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Sa_pbot', mrg_from=compatm, mrg_fld='Sa_pbot', mrg_type='copy') + call addMapFrom(compatm, 'Sa_pbot', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Sa_pbot', mrg_from=compatm, mrg_fld='Sa_pbot', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: o3 at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_o3') - call addfld(fldListTo(complnd)%fields, 'Sa_o3') + call addFldFrom(compatm, 'Sa_o3') + call addfldTo(complnd, 'Sa_o3') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_o3', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_o3', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_o3', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Sa_o3', mrg_from=compatm, mrg_fld='Sa_o3', mrg_type='copy') + call addMapFrom(compatm, 'Sa_o3', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Sa_o3', mrg_from=compatm, mrg_fld='Sa_o3', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: temperature at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_tbot') - call addfld(fldListTo(complnd)%fields, 'Sa_tbot') + call addFldFrom(compatm, 'Sa_tbot') + call addfldTo(complnd, 'Sa_tbot') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_tbot', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_tbot', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_tbot', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') + call addMapFrom(compatm, 'Sa_tbot', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: potential temperature at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_ptem') - call addfld(fldListTo(complnd)%fields, 'Sa_ptem') + call addFldFrom(compatm, 'Sa_ptem') + call addfldTo(complnd, 'Sa_ptem') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_ptem', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_ptem', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_ptem', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Sa_ptem', mrg_from=compatm, mrg_fld='Sa_ptem', mrg_type='copy') + call addMapFrom(compatm, 'Sa_ptem', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Sa_ptem', mrg_from=compatm, mrg_fld='Sa_ptem', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: specific humidity at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_shum') - call addfld(fldListTo(complnd)%fields, 'Sa_shum') + call addFldFrom(compatm, 'Sa_shum') + call addfldTo(complnd, 'Sa_shum') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_shum', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_shum', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Sa_shum', mrg_from=compatm, mrg_fld='Sa_shum', mrg_type='copy') + call addMapFrom(compatm, 'Sa_shum', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Sa_shum', mrg_from=compatm, mrg_fld='Sa_shum', mrg_type='copy') end if end if if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_shum_wiso') - call addfld(fldListTo(complnd)%fields, 'Sa_shum_wiso') + call addFldFrom(compatm, 'Sa_shum_wiso') + call addfldTo(complnd, 'Sa_shum_wiso') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_shum_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_shum_wiso', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Sa_shum_wiso', mrg_from=compatm, mrg_fld='Sa_shum_wiso', mrg_type='copy') + call addMapFrom(compatm, 'Sa_shum_wiso', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Sa_shum_wiso', mrg_from=compatm, mrg_fld='Sa_shum_wiso', mrg_type='copy') end if end if end if @@ -450,59 +456,59 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: convective and large scale precipitation rate water equivalent from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_rainc') - call addfld(fldListTo(complnd)%fields, 'Faxa_rainc') + call addFldFrom(compatm, 'Faxa_rainc') + call addfldTo(complnd, 'Faxa_rainc') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_rainc', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_rainc', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_rainc', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Faxa_rainc', mrg_from=compatm, mrg_fld='Faxa_rainc', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_rainc', complnd, mapconsf, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Faxa_rainc', mrg_from=compatm, mrg_fld='Faxa_rainc', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_rainl') - call addfld(fldListTo(complnd)%fields, 'Faxa_rainl') + call addFldFrom(compatm, 'Faxa_rainl') + call addfldTo(complnd, 'Faxa_rainl') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_rainl', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_rainl', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_rainl', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Faxa_rainl', mrg_from=compatm, mrg_fld='Faxa_rainl', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_rainl', complnd, mapconsf, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Faxa_rainl', mrg_from=compatm, mrg_fld='Faxa_rainl', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: convective and large-scale (stable) snow rate from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_snowc') - call addfld(fldListTo(complnd)%fields, 'Faxa_snowc') + call addFldFrom(compatm, 'Faxa_snowc') + call addfldTo(complnd, 'Faxa_snowc') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_snowc', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_snowc', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_snowc', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Faxa_snowc', mrg_from=compatm, mrg_fld='Faxa_snowc', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_snowc', complnd, mapconsf, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Faxa_snowc', mrg_from=compatm, mrg_fld='Faxa_snowc', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_snowl') - call addfld(fldListTo(complnd)%fields, 'Faxa_snowl') + call addFldFrom(compatm, 'Faxa_snowl') + call addfldTo(complnd, 'Faxa_snowl') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_snowl', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_snowl', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_snowl', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Faxa_snowl', mrg_from=compatm, mrg_fld='Faxa_snowl', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_snowl', complnd, mapconsf, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Faxa_snowl', mrg_from=compatm, mrg_fld='Faxa_snowl', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: downward longwave heat flux from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_lwdn') - call addfld(fldListTo(complnd)%fields, 'Faxa_lwdn') + call addFldFrom(compatm, 'Faxa_lwdn') + call addfldTo(complnd, 'Faxa_lwdn') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_lwdn', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_lwdn', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_lwdn', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Faxa_lwdn', mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_lwdn', complnd, mapconsf, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Faxa_lwdn', mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -512,53 +518,53 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: downward Diffuse visible incident solar radiation from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_swndr') - call addfld(fldListTo(complnd)%fields, 'Faxa_swndr') + call addFldFrom(compatm, 'Faxa_swndr') + call addfldTo(complnd, 'Faxa_swndr') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_swndr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_swndr', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_swndr', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Faxa_swndr', mrg_from=compatm, mrg_fld='Faxa_swndr', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_swndr', complnd, mapconsf, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Faxa_swndr', mrg_from=compatm, mrg_fld='Faxa_swndr', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_swvdr') - call addfld(fldListTo(complnd)%fields, 'Faxa_swvdr') + call addFldFrom(compatm, 'Faxa_swvdr') + call addfldTo(complnd, 'Faxa_swvdr') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_swvdr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_swvdr', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_swvdr', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Faxa_swvdr', mrg_from=compatm, mrg_fld='Faxa_swvdr', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_swvdr', complnd, mapconsf, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Faxa_swvdr', mrg_from=compatm, mrg_fld='Faxa_swvdr', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_swndf') - call addfld(fldListTo(complnd)%fields, 'Faxa_swndf') + call addFldFrom(compatm, 'Faxa_swndf') + call addfldTo(complnd, 'Faxa_swndf') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_swndf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_swndf', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_swndf', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Faxa_swndf', mrg_from=compatm, mrg_fld='Faxa_swndf', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_swndf', complnd, mapconsf, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Faxa_swndf', mrg_from=compatm, mrg_fld='Faxa_swndf', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_swvdf') - call addfld(fldListTo(complnd)%fields, 'Faxa_swvdf') + call addFldFrom(compatm, 'Faxa_swvdf') + call addfldTo(complnd, 'Faxa_swvdf') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_swvdf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_swvdf', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_swvdf', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Faxa_swvdf', mrg_from=compatm, mrg_fld='Faxa_swvdf', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_swvdf', complnd, mapconsf, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Faxa_swvdf', mrg_from=compatm, mrg_fld='Faxa_swvdf', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_bcph') - call addfld(fldListTo(complnd)%fields, 'Faxa_bcph') + call addFldFrom(compatm, 'Faxa_bcph') + call addfldTo(complnd, 'Faxa_bcph') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_bcph', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_bcph', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_bcph', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Faxa_bcph', mrg_from=compatm, mrg_fld='Faxa_bcph', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_bcph', complnd, mapconsf, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Faxa_bcph', mrg_from=compatm, mrg_fld='Faxa_bcph', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -572,13 +578,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! - hydrophylic organic carbon wet deposition flux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_ocph') - call addfld(fldListTo(complnd)%fields, 'Faxa_ocph') + call addFldFrom(compatm, 'Faxa_ocph') + call addfldTo(complnd, 'Faxa_ocph') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_ocph', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_ocph', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_ocph', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Faxa_ocph', mrg_from=compatm, mrg_fld='Faxa_ocph', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_ocph', complnd, mapconsf, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Faxa_ocph', mrg_from=compatm, mrg_fld='Faxa_ocph', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -586,36 +592,36 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: dust dry deposition flux (sizes 1-4) from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_dstwet') - call addfld(fldListTo(complnd)%fields, 'Faxa_dstwet') + call addFldFrom(compatm, 'Faxa_dstwet') + call addfldTo(complnd, 'Faxa_dstwet') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_dstwet', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_dstwet', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_dstwet', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Faxa_dstwet', mrg_from=compatm, mrg_fld='Faxa_dstwet', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_dstwet', complnd, mapconsf, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Faxa_dstwet', mrg_from=compatm, mrg_fld='Faxa_dstwet', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_dstdry') - call addfld(fldListTo(complnd)%fields, 'Faxa_dstdry') + call addFldFrom(compatm, 'Faxa_dstdry') + call addfldTo(complnd, 'Faxa_dstdry') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_dstdry', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_dstdry', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_dstdry', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Faxa_dstdry', mrg_from=compatm, mrg_fld='Faxa_dstdry', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_dstdry', complnd, mapconsf, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Faxa_dstdry', mrg_from=compatm, mrg_fld='Faxa_dstdry', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: nitrogen deposition fields from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_ndep') - call addfld(fldListTo(complnd)%fields, 'Faxa_ndep') + call addFldFrom(compatm, 'Faxa_ndep') + call addfldTo(complnd, 'Faxa_ndep') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_ndep', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_ndep', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_ndep', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Faxa_ndep', mrg_from=compatm, mrg_fld='Faxa_ndep', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_ndep', complnd, mapconsf, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Faxa_ndep', mrg_from=compatm, mrg_fld='Faxa_ndep', mrg_type='copy') end if end if @@ -627,87 +633,87 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: tributary channel depth ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(comprof)%fields, 'Flrr_volr') - call addfld(fldListTo(complnd)%fields, 'Flrr_volr') + call addfldFrom(comprof, 'Flrr_volr') + call addfldTo(complnd, 'Flrr_volr') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volr', rc=rc)) then - call addmap(fldListFr(comprof)%fields, 'Flrr_volr', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Flrr_volr', mrg_from=comprof, mrg_fld='Flrr_volr', mrg_type='copy') + call addmapFrom(comprof, 'Flrr_volr', complnd, mapconsf, 'one', rof2lnd_map) + call addmrgTo(complnd, 'Flrr_volr', mrg_from=comprof, mrg_fld='Flrr_volr', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(comprof)%fields, 'Flrr_volrmch') - call addfld(fldListTo(complnd)%fields, 'Flrr_volrmch') + call addfldFrom(comprof, 'Flrr_volrmch') + call addfldTo(complnd, 'Flrr_volrmch') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volrmch', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volrmch', rc=rc)) then - call addmap(fldListFr(comprof)%fields, 'Flrr_volrmch', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Flrr_volrmch', mrg_from=comprof, mrg_fld='Flrr_volrmch', mrg_type='copy') + call addmapFrom(comprof, 'Flrr_volrmch', complnd, mapconsf, 'one', rof2lnd_map) + call addmrgTo(complnd, 'Flrr_volrmch', mrg_from=comprof, mrg_fld='Flrr_volrmch', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(comprof)%fields, 'Flrr_flood') - call addfld(fldListTo(complnd)%fields, 'Flrr_flood') + call addfldFrom(comprof, 'Flrr_flood') + call addfldTo(complnd, 'Flrr_flood') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_flood', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood', rc=rc)) then - call addmap(fldListFr(comprof)%fields, 'Flrr_flood', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Flrr_flood', mrg_from=comprof, mrg_fld='Flrr_flood', mrg_type='copy') + call addmapFrom(comprof, 'Flrr_flood', complnd, mapconsf, 'one', rof2lnd_map) + call addmrgTo(complnd, 'Flrr_flood', mrg_from=comprof, mrg_fld='Flrr_flood', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(comprof)%fields, 'Sr_tdepth') - call addfld(fldListTo(complnd)%fields, 'Sr_tdepth') + call addfldFrom(comprof, 'Sr_tdepth') + call addfldTo(complnd, 'Sr_tdepth') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Sr_tdepth', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Sr_tdepth', rc=rc)) then - call addmap(fldListFr(comprof)%fields, 'Sr_tdepth', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Sr_tdepth', mrg_from=comprof, mrg_fld='Sr_tdepth', mrg_type='copy') + call addmapFrom(comprof, 'Sr_tdepth', complnd, mapconsf, 'one', rof2lnd_map) + call addmrgTo(complnd, 'Sr_tdepth', mrg_from=comprof, mrg_fld='Sr_tdepth', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(comprof)%fields, 'Sr_tdepth_max') - call addfld(fldListTo(complnd)%fields, 'Sr_tdepth_max') + call addfldFrom(comprof, 'Sr_tdepth_max') + call addfldTo(complnd, 'Sr_tdepth_max') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Sr_tdepth_max', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Sr_tdepth_max', rc=rc)) then - call addmap(fldListFr(comprof)%fields, 'Sr_tdepth_max', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Sr_tdepth_max', mrg_from=comprof, mrg_fld='Sr_tdepth_max', mrg_type='copy') + call addmapFrom(comprof, 'Sr_tdepth_max', complnd, mapconsf, 'one', rof2lnd_map) + call addmrgTo(complnd, 'Sr_tdepth_max', mrg_from=comprof, mrg_fld='Sr_tdepth_max', mrg_type='copy') end if end if if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(comprof)%fields, 'Flrr_volr_wiso') - call addfld(fldListTo(complnd)%fields, 'Flrr_volr_wiso') + call addfldFrom(comprof, 'Flrr_volr_wiso') + call addfldTo(complnd, 'Flrr_volr_wiso') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volr_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volr_wiso', rc=rc)) then - call addmap(fldListFr(comprof)%fields, 'Flrr_volr_wiso', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Flrr_volr_wiso', & + call addmapFrom(comprof, 'Flrr_volr_wiso', complnd, mapconsf, 'one', rof2lnd_map) + call addmrgTo(complnd, 'Flrr_volr_wiso', & mrg_from=comprof, mrg_fld='Flrr_volr_wiso', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(comprof)%fields, 'Flrr_volrmch_wiso') - call addfld(fldListTo(complnd)%fields, 'Flrr_volrmch_wiso') + call addfldFrom(comprof, 'Flrr_volrmch_wiso') + call addfldTo(complnd, 'Flrr_volrmch_wiso') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volrmch_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volrmch_wiso', rc=rc)) then - call addmap(fldListFr(comprof)%fields, 'Flrr_volrmch_wiso', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Flrr_volrmch_wiso', & + call addmapFrom(comprof, 'Flrr_volrmch_wiso', complnd, mapconsf, 'one', rof2lnd_map) + call addmrgTo(complnd, 'Flrr_volrmch_wiso', & mrg_from=comprof, mrg_fld='Flrr_volrmch_wiso', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(comprof)%fields, 'Flrr_flood_wiso') - call addfld(fldListTo(complnd)%fields, 'Flrr_flood_wiso') + call addfldFrom(comprof, 'Flrr_flood_wiso') + call addfldTo(complnd, 'Flrr_flood_wiso') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_flood_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood_wiso', rc=rc)) then - call addmap(fldListFr(comprof)%fields, 'Flrr_flood_wiso', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Flrr_flood_wiso', & + call addmapFrom(comprof, 'Flrr_flood_wiso', complnd, mapconsf, 'one', rof2lnd_map) + call addmrgTo(complnd, 'Flrr_flood_wiso', & mrg_from=comprof, mrg_fld='Flrr_flood_wiso', mrg_type='copy') end if end if @@ -725,24 +731,24 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (phase == 'advertise') then do ns = 1, is_local%wrap%num_icesheets - call addfld(fldListFr(compglc(ns))%fields, 'Sg_icemask') ! ice sheet grid coverage - call addfld(fldListFr(compglc(ns))%fields, 'Sg_icemask_coupled_fluxes') - call addfld(fldListFr(compglc(ns))%fields, 'Sg_ice_covered') ! fraction of glacier area - call addfld(fldListFr(compglc(ns))%fields, 'Sg_topo') ! surface height of glacer - call addfld(fldListFr(compglc(ns))%fields, 'Flgg_hflx') ! downward heat flux from glacier interior + call addfldFrom(compglc(ns), 'Sg_icemask') ! ice sheet grid coverage + call addfldFrom(compglc(ns), 'Sg_icemask_coupled_fluxes') + call addfldFrom(compglc(ns), 'Sg_ice_covered') ! fraction of glacier area + call addfldFrom(compglc(ns), 'Sg_topo') ! surface height of glacer + call addfldFrom(compglc(ns), 'Flgg_hflx') ! downward heat flux from glacier interior end do - call addfld(fldListTo(complnd)%fields, 'Sg_icemask') - call addfld(fldListTo(complnd)%fields, 'Sg_icemask_coupled_fluxes') - call addfld(fldListTo(complnd)%fields, 'Sg_ice_covered_elev') - call addfld(fldListTo(complnd)%fields, 'Sg_topo_elev') - call addfld(fldListTo(complnd)%fields, 'Flgg_hflx_elev') + call addfldTo(complnd, 'Sg_icemask') + call addfldTo(complnd, 'Sg_icemask_coupled_fluxes') + call addfldTo(complnd, 'Sg_ice_covered_elev') + call addfldTo(complnd, 'Sg_topo_elev') + call addfldTo(complnd, 'Flgg_hflx_elev') else ! custom merge in med_phases_prep_lnd for Sg_icemask and Sg_icemask_coupled_fluxes ! custom map merge in med_phases_prep_lnd for Sg_ice_covered_elev, Sg_topo_elev and Flgg_hflx_elev if ( fldchk(is_local%wrap%FBExp(complnd), 'Sg_icemask', rc=rc)) then do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Sg_icemask', rc=rc)) then - call addmap(fldListFr(compglc(ns))%fields, 'Sg_icemask', & + call addmapFrom(compglc(ns), 'Sg_icemask', & complnd, mapconsd, 'one', 'unset') end if end do @@ -750,7 +756,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBExp(complnd), 'Sg_icemask_coupled_fluxes', rc=rc)) then do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Sg_icemask_coupled_fluxes', rc=rc)) then - call addmap(fldListFr(compglc(ns))%fields, 'Sg_icemask_coupled_fluxes', & + call addmapFrom(compglc(ns), 'Sg_icemask_coupled_fluxes', & complnd, mapconsd, 'one', 'unset') end if end do @@ -766,9 +772,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !---------------------------------------------------------- if (phase == 'advertise') then ! the following are computed in med_phases_prep_atm - call addfld(fldListTo(compatm)%fields, 'Sl_lfrac') - call addfld(fldListTo(compatm)%fields, 'Si_ifrac') - call addfld(fldListTo(compatm)%fields, 'So_ofrac') + call addfldTo(compatm, 'Sl_lfrac') + call addfldTo(compatm, 'Si_ifrac') + call addfldTo(compatm, 'So_ofrac') end if ! --------------------------------------------------------------------- @@ -778,108 +784,108 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: merged diffuse albedo (near-infrared radiation) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Sl_avsdr') - call addfld(fldListFr(compice)%fields, 'Si_avsdr') - call addfld(fldListMed_ocnalb%fields , 'So_avsdr') - call addfld(fldListTo(compatm)%fields, 'Sx_avsdr') + call addFldFrom(complnd, 'Sl_avsdr') + call addfldFrom(compice, 'Si_avsdr') + call addocnalbFld('So_avsdr') + call addfldTo(compatm, 'Sx_avsdr') else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_avsdr', rc=rc)) then ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_avsdr', rc=rc)) then - call addmap(fldListFr(complnd)%fields, 'Sl_avsdr', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sx_avsdr', & + call addmapFrom(complnd, 'Sl_avsdr', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm, 'Sx_avsdr', & mrg_from=complnd, mrg_fld='Sl_avsdr', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_avsdr', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Si_avsdr', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sx_avsdr', & + call addMapFrom(compice, 'Si_avsdr', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(compatm, 'Sx_avsdr', & mrg_from=compice, mrg_fld='Si_avsdr', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_avsdr', rc=rc)) then - call addmap(fldListMed_ocnalb%fields , 'So_avsdr', compatm, mapconsf, 'ofrac', ocn2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sx_avsdr', & + call addocnalpmap( 'So_avsdr', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmrgTo(compatm, 'Sx_avsdr', & mrg_from=compmed, mrg_fld='So_avsdr', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Sl_avsdf') - call addfld(fldListFr(compice)%fields, 'Si_avsdf') - call addfld(fldListMed_ocnalb%fields , 'So_avsdf') - call addfld(fldListTo(compatm)%fields, 'Sx_avsdf') + call addFldFrom(complnd, 'Sl_avsdf') + call addfldFrom(compice, 'Si_avsdf') + call addocnalbFld( 'So_avsdf') + call addfldTo(compatm, 'Sx_avsdf') else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_avsdf', rc=rc)) then ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_avsdf', rc=rc)) then - call addmap(fldListFr(complnd)%fields, 'Sl_avsdf', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sx_avsdf', & + call addmapFrom(complnd, 'Sl_avsdf', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm, 'Sx_avsdf', & mrg_from=complnd, mrg_fld='Sl_avsdf', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_avsdf', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Si_avsdf', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sx_avsdf', & + call addMapFrom(compice, 'Si_avsdf', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(compatm, 'Sx_avsdf', & mrg_from=compice, mrg_fld='Si_avsdf', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_avsdf', rc=rc)) then - call addmap(fldListMed_ocnalb%fields , 'So_avsdf', compatm, mapconsf, 'ofrac', ocn2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sx_avsdf', & + call addocnalpmap( 'So_avsdf', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmrgTo(compatm, 'Sx_avsdf', & mrg_from=compmed, mrg_fld='So_avsdf', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Sl_anidr') - call addfld(fldListFr(compice)%fields, 'Si_anidr') - call addfld(fldListMed_ocnalb%fields , 'So_anidr') - call addfld(fldListTo(compatm)%fields, 'Sx_anidr') + call addFldFrom(complnd, 'Sl_anidr') + call addfldFrom(compice, 'Si_anidr') + call addocnalbFld( 'So_anidr') + call addfldTo(compatm, 'Sx_anidr') else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_anidr', rc=rc)) then ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_anidr', rc=rc)) then - call addmap(fldListFr(complnd)%fields, 'Sl_anidr', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sx_anidr', & + call addmapFrom(complnd, 'Sl_anidr', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm, 'Sx_anidr', & mrg_from=complnd, mrg_fld='Sl_anidr', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_anidr', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Si_anidr', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sx_anidr', & + call addMapFrom(compice, 'Si_anidr', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(compatm, 'Sx_anidr', & mrg_from=compice, mrg_fld='Si_anidr', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_anidr', rc=rc)) then - call addmap(fldListMed_ocnalb%fields , 'So_anidr', compatm, mapconsf, 'ofrac', ocn2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sx_anidr', & + call addocnalpmap( 'So_anidr', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmrgTo(compatm, 'Sx_anidr', & mrg_from=compmed, mrg_fld='So_anidr', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Sl_anidf') - call addfld(fldListFr(compice)%fields, 'Si_anidf') - call addfld(fldListMed_ocnalb%fields , 'So_anidf') - call addfld(fldListTo(compatm)%fields, 'Sx_anidf') + call addFldFrom(complnd, 'Sl_anidf') + call addfldFrom(compice, 'Si_anidf') + call addocnalbFld( 'So_anidf') + call addfldTo(compatm, 'Sx_anidf') else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_anidf', rc=rc)) then ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_anidf', rc=rc)) then - call addmap(fldListFr(complnd)%fields, 'Sl_anidf', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sx_anidf', & + call addmapFrom(complnd, 'Sl_anidf', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm, 'Sx_anidf', & mrg_from=complnd, mrg_fld='Sl_anidf', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_anidf', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Si_anidf', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sx_anidf', & + call addMapFrom(compice, 'Si_anidf', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(compatm, 'Sx_anidf', & mrg_from=compice, mrg_fld='Si_anidf', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_anidf', rc=rc)) then - call addmap(fldListMed_ocnalb%fields , 'So_anidf', compatm, mapconsf, 'ofrac', ocn2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sx_anidf', & + call addocnalpmap( 'So_anidf', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmrgTo(compatm, 'Sx_anidf', & mrg_from=compmed, mrg_fld='So_anidf', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -893,81 +899,81 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields , 'Sl_tref') - call addfld(fldListFr(compice)%fields , 'Si_tref') - call addfld(fldListMed_aoflux%fields , 'So_tref') - call addfld(fldListTo(compatm)%fields , 'Sx_tref') + call addFldFrom(complnd , 'Sl_tref') + call addfldFrom(compice , 'Si_tref') + call addaofluxFld('So_tref') + call addfldTo(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(fldListFr(complnd)%fields , 'Sl_tref', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Sx_tref', & + call addmapFrom(complnd , 'Sl_tref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm , 'Sx_tref', & mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_tref', rc=rc)) then - call addmap(fldListFr(compice)%fields , 'Si_tref', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Sx_tref', & + call addMapFrom(compice , 'Si_tref', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(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(fldListMed_aoflux%fields , 'So_tref', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addaofluxmap('So_tref', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%fields , 'Sx_tref', & + call addmrgTo(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(fldListFr(complnd)%fields , 'Sl_u10') - call addfld(fldListFr(compice)%fields , 'Si_u10') - call addfld(fldListMed_aoflux%fields , 'So_u10') - call addfld(fldListTo(compatm)%fields , 'Sx_u10') + call addFldFrom(complnd , 'Sl_u10') + call addfldFrom(compice , 'Si_u10') + call addaofluxFld('So_u10') + call addfldTo(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(fldListFr(complnd)%fields , 'Sl_u10', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Sx_u10', & + call addmapFrom(complnd , 'Sl_u10', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm , 'Sx_u10', & mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_u10', rc=rc)) then - call addmap(fldListFr(compice)%fields , 'Si_u10', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Sx_u10', & + call addMapFrom(compice , 'Si_u10', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(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(fldListMed_aoflux%fields, 'So_u10', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addaofluxmap('So_u10', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%fields , 'Sx_u10', & + call addmrgTo(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(fldListFr(complnd)%fields , 'Sl_qref') - call addfld(fldListFr(compice)%fields , 'Si_qref') - call addfld(fldListMed_aoflux%fields , 'So_qref') - call addfld(fldListTo(compatm)%fields , 'Sx_qref') + call addFldFrom(complnd , 'Sl_qref') + call addfldFrom(compice , 'Si_qref') + call addaofluxFld('So_qref') + call addfldTo(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(fldListFr(complnd)%fields , 'Sl_qref', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Sx_qref', & + call addmapFrom(complnd , 'Sl_qref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm , 'Sx_qref', & mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref', rc=rc)) then - call addmap(fldListFr(compice)%fields , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Sx_qref', & + call addMapFrom(compice , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(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(fldListMed_aoflux%fields, 'So_qref', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addaofluxmap('So_qref', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%fields , 'Sx_qref', & + call addmrgTo(compatm , 'Sx_qref', & mrg_from=compmed, mrg_fld='So_qref', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -975,27 +981,27 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields , 'Sl_qref_wiso') - call addfld(fldListFr(compice)%fields , 'Si_qref_wiso') - call addfld(fldListMed_aoflux%fields , 'So_qref_wiso') - call addfld(fldListTo(compatm)%fields , 'Sx_qref_wiso') + call addFldFrom(complnd , 'Sl_qref_wiso') + call addfldFrom(compice , 'Si_qref_wiso') + call addaofluxFld('So_qref_wiso') + call addfldTo(compatm , 'Sx_qref_wiso') else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref_wiso', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref_wiso', rc=rc)) then - call addmap(fldListFr(complnd)%fields , 'Sl_qref_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Sx_qref_wiso', & + call addmapFrom(complnd , 'Sl_qref_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm , 'Sx_qref_wiso', & mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref_wiso', rc=rc)) then - call addmap(fldListFr(compice)%fields , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Sx_qref_wiso', & + call addMapFrom(compice , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(compatm , 'Sx_qref_wiso', & mrg_from=compice, mrg_fld='Si_qref_wiso', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_qref_wiso', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%fields , 'So_qref_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) ! map ocn->atm + call addaofluxmap( 'So_qref_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) ! map ocn->atm end if - call addmrg(fldListTo(compatm)%fields , 'Sx_qref_wiso', & + call addmrgTo(compatm , 'Sx_qref_wiso', & mrg_from=compmed, mrg_fld='So_qref_wiso', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1009,81 +1015,81 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: merged reference specific water isoptope humidity at 2 meters ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields , 'Sl_tref') - call addfld(fldListFr(compice)%fields , 'Si_tref') - call addfld(fldListMed_aoflux%fields , 'So_tref') - call addfld(fldListTo(compatm)%fields , 'Sx_tref') + call addFldFrom(complnd , 'Sl_tref') + call addfldFrom(compice , 'Si_tref') + call addaofluxFld('So_tref') + call addfldTo(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(fldListFr(complnd)%fields , 'Sl_tref', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Sx_tref', & + call addmapFrom(complnd , 'Sl_tref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm , 'Sx_tref', & mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_tref', rc=rc)) then - call addmap(fldListFr(compice)%fields , 'Si_tref', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Sx_tref', & + call addMapFrom(compice , 'Si_tref', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(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(fldListMed_aoflux%fields , 'So_tref', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addaofluxmap('So_tref', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%fields , 'Sx_tref', & + call addmrgTo(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(fldListFr(complnd)%fields , 'Sl_u10') - call addfld(fldListFr(compice)%fields , 'Si_u10') - call addfld(fldListMed_aoflux%fields , 'So_u10') - call addfld(fldListTo(compatm)%fields , 'Sx_u10') + call addFldFrom(complnd , 'Sl_u10') + call addfldFrom(compice , 'Si_u10') + call addaofluxFld('So_u10') + call addfldTo(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(fldListFr(complnd)%fields , 'Sl_u10', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Sx_u10', & + call addmapFrom(complnd , 'Sl_u10', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm , 'Sx_u10', & mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_u10', rc=rc)) then - call addmap(fldListFr(compice)%fields , 'Si_u10', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Sx_u10', & + call addMapFrom(compice , 'Si_u10', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(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(fldListMed_aoflux%fields, 'So_u10', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addaofluxmap('So_u10', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%fields , 'Sx_u10', & + call addmrgTo(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(fldListFr(complnd)%fields , 'Sl_qref') - call addfld(fldListFr(compice)%fields , 'Si_qref') - call addfld(fldListMed_aoflux%fields , 'So_qref') - call addfld(fldListTo(compatm)%fields , 'Sx_qref') + call addFldFrom(complnd , 'Sl_qref') + call addfldFrom(compice , 'Si_qref') + call addaofluxFld('So_qref') + call addfldTo(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(fldListFr(complnd)%fields , 'Sl_qref', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Sx_qref', & + call addmapFrom(complnd , 'Sl_qref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm , 'Sx_qref', & mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref', rc=rc)) then - call addmap(fldListFr(compice)%fields , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Sx_qref', & + call addMapFrom(compice , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(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(fldListMed_aoflux%fields, 'So_qref', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addaofluxmap('So_qref', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%fields , 'Sx_qref', & + call addmrgTo(compatm , 'Sx_qref', & mrg_from=compmed, mrg_fld='So_qref', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1091,27 +1097,27 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields , 'Sl_qref_wiso') - call addfld(fldListFr(compice)%fields , 'Si_qref_wiso') - call addfld(fldListMed_aoflux%fields , 'So_qref_wiso') - call addfld(fldListTo(compatm)%fields , 'Sx_qref_wiso') + call addFldFrom(complnd , 'Sl_qref_wiso') + call addfldFrom(compice , 'Si_qref_wiso') + call addaofluxFld('So_qref_wiso') + call addfldTo(compatm , 'Sx_qref_wiso') else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref_wiso', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref_wiso', rc=rc)) then - call addmap(fldListFr(complnd)%fields , 'Sl_qref_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Sx_qref_wiso', & + call addmapFrom(complnd , 'Sl_qref_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm , 'Sx_qref_wiso', & mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref_wiso', rc=rc)) then - call addmap(fldListFr(compice)%fields , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Sx_qref_wiso', & + call addMapFrom(compice , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(compatm , 'Sx_qref_wiso', & mrg_from=compice, mrg_fld='Si_qref_wiso', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_qref_wiso', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%fields, 'So_qref_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addaofluxmap('So_qref_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%fields , 'Sx_qref_wiso', & + call addmrgTo(compatm , 'Sx_qref_wiso', & mrg_from=compmed, mrg_fld='So_qref_wiso', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1127,162 +1133,162 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: evaporation water flux from water isotopes ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListTo(compatm)%fields, 'Faxx_taux') - call addfld(fldListFr(complnd)%fields, 'Fall_taux') - call addfld(fldListFr(compice)%fields, 'Faii_taux') - call addfld(fldListMed_aoflux%fields , 'Faox_taux') + call addfldTo(compatm, 'Faxx_taux') + call addFldFrom(complnd, 'Fall_taux') + call addfldFrom(compice, 'Faii_taux') + call addaofluxFld( 'Faox_taux') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_taux', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_taux', rc=rc)) then - call addmap(fldListFr(complnd)%fields , 'Fall_taux', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Faxx_taux', & + call addmapFrom(complnd , 'Fall_taux', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm , 'Faxx_taux', & mrg_from=complnd, mrg_fld='Fall_taux', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_taux', rc=rc)) then - call addmap(fldListFr(compice)%fields , 'Faii_taux', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Faxx_taux', & + call addMapFrom(compice , 'Faii_taux', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(compatm , 'Faxx_taux', & mrg_from=compice, mrg_fld='Faii_taux', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_taux', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%fields , 'Faox_taux', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addaofluxmap('Faox_taux', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%fields , 'Faxx_taux', & + call addmrgTo(compatm , 'Faxx_taux', & mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfld(fldListTo(compatm)%fields, 'Faxx_tauy') - call addfld(fldListFr(complnd)%fields, 'Fall_tauy') - call addfld(fldListFr(compice)%fields, 'Faii_tauy') - call addfld(fldListMed_aoflux%fields , 'Faox_tauy') + call addfldTo(compatm, 'Faxx_tauy') + call addFldFrom(complnd, 'Fall_tauy') + call addfldFrom(compice, 'Faii_tauy') + call addaoflusFld( 'Faox_tauy') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_tauy', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_tauy', rc=rc)) then - call addmap(fldListFr(complnd)%fields , 'Fall_tauy', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Faxx_tauy', & + call addmapFrom(complnd , 'Fall_tauy', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm , 'Faxx_tauy', & mrg_from=complnd, mrg_fld='Fall_tauy', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_tauy', rc=rc)) then - call addmap(fldListFr(compice)%fields , 'Faii_tauy', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Faxx_tauy', & + call addMapFrom(compice , 'Faii_tauy', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(compatm , 'Faxx_tauy', & mrg_from=compice, mrg_fld='Faii_tauy', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_tauy', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%fields , 'Faox_tauy', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addaofluxmap('Faox_tauy', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%fields , 'Faxx_tauy', & + call addmrgTo(compatm , 'Faxx_tauy', & mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfld(fldListTo(compatm)%fields, 'Faxx_lat') - call addfld(fldListFr(complnd)%fields, 'Fall_lat') - call addfld(fldListFr(compice)%fields, 'Faii_lat') - call addfld(fldListMed_aoflux%fields , 'Faox_lat') + call addfldTo(compatm, 'Faxx_lat') + call addFldFrom(complnd, 'Fall_lat') + call addfldFrom(compice, 'Faii_lat') + call addaoflusFld( 'Faox_lat') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lat', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lat', rc=rc)) then - call addmap(fldListFr(complnd)%fields , 'Fall_lat', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Faxx_lat', & + call addmapFrom(complnd , 'Fall_lat', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm , 'Faxx_lat', & mrg_from=complnd, mrg_fld='Fall_lat', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_lat', rc=rc)) then - call addmap(fldListFr(compice)%fields , 'Faii_lat', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Faxx_lat', & + call addMapFrom(compice , 'Faii_lat', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(compatm , 'Faxx_lat', & mrg_from=compice, mrg_fld='Faii_lat', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lat', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%fields , 'Faox_lat', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addaofluxmap('Faox_lat', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%fields , 'Faxx_lat', & + call addmrgTo(compatm , 'Faxx_lat', & mrg_from=compmed, mrg_fld='Faox_lat', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfld(fldListTo(compatm)%fields, 'Faxx_sen') - call addfld(fldListFr(complnd)%fields, 'Fall_sen') - call addfld(fldListFr(compice)%fields, 'Faii_sen') - call addfld(fldListMed_aoflux%fields , 'Faox_sen') + call addfldTo(compatm, 'Faxx_sen') + call addFldFrom(complnd, 'Fall_sen') + call addfldFrom(compice, 'Faii_sen') + call addaoflusFld( 'Faox_sen') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_sen', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_sen', rc=rc)) then - call addmap(fldListFr(complnd)%fields , 'Fall_sen', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Faxx_sen', & + call addmapFrom(complnd , 'Fall_sen', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm , 'Faxx_sen', & mrg_from=complnd, mrg_fld='Fall_sen', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_sen', rc=rc)) then - call addmap(fldListFr(compice)%fields , 'Faii_sen', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Faxx_sen', & + call addMapFrom(compice , 'Faii_sen', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(compatm , 'Faxx_sen', & mrg_from=compice, mrg_fld='Faii_sen', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_sen', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%fields , 'Faox_sen', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addaofluxmap('Faox_sen', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%fields , 'Faxx_sen', & + call addmrgTo(compatm , 'Faxx_sen', & mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfld(fldListTo(compatm)%fields, 'Faxx_evap') - call addfld(fldListFr(complnd)%fields, 'Fall_evap') - call addfld(fldListFr(compice)%fields, 'Faii_evap') - call addfld(fldListMed_aoflux%fields , 'Faox_evap') + call addfldTo(compatm, 'Faxx_evap') + call addFldFrom(complnd, 'Fall_evap') + call addfldFrom(compice, 'Faii_evap') + call addaoflusFld( 'Faox_evap') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap', rc=rc)) then - call addmap(fldListFr(complnd)%fields , 'Fall_evap', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Faxx_evap', & + call addmapFrom(complnd , 'Fall_evap', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm , 'Faxx_evap', & mrg_from=complnd, mrg_fld='Fall_evap', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap', rc=rc)) then - call addmap(fldListFr(compice)%fields , 'Faii_evap', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Faxx_evap', & + call addMapFrom(compice , 'Faii_evap', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(compatm , 'Faxx_evap', & mrg_from=compice, mrg_fld='Faii_evap', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_evap', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%fields , 'Faox_evap', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addaofluxmap('Faox_evap', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%fields , 'Faxx_evap', & + call addmrgTo(compatm , 'Faxx_evap', & mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfld(fldListTo(compatm)%fields, 'Faxx_lwup') - call addfld(fldListFr(complnd)%fields, 'Fall_lwup') - call addfld(fldListFr(compice)%fields, 'Faii_lwup') - call addfld(fldListMed_aoflux%fields , 'Faox_lwup') + call addfldTo(compatm, 'Faxx_lwup') + call addFldFrom(complnd, 'Fall_lwup') + call addfldFrom(compice, 'Faii_lwup') + call addaoflusFld( 'Faox_lwup') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lwup', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lwup', rc=rc)) then - call addmap(fldListFr(complnd)%fields , 'Fall_lwup', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Faxx_lwup', & + call addmapFrom(complnd , 'Fall_lwup', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm , 'Faxx_lwup', & mrg_from=complnd, mrg_fld='Fall_lwup', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_lwup', rc=rc)) then - call addmap(fldListFr(compice)%fields , 'Faii_lwup', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Faxx_lwup', & + call addMapFrom(compice , 'Faii_lwup', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(compatm , 'Faxx_lwup', & mrg_from=compice, mrg_fld='Faii_lwup', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lwup', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%fields, 'Faox_lwup', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addaofluxmap('Faox_lwup', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%fields, 'Faxx_lwup', & + call addmrgTo(compatm, 'Faxx_lwup', & mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1290,27 +1296,27 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListTo(compatm)%fields, 'Faxx_evap_wiso') - call addfld(fldListFr(complnd)%fields, 'Fall_evap_wiso') - call addfld(fldListFr(compice)%fields, 'Faii_evap_wiso') - call addfld(fldListMed_aoflux%fields , 'Faox_evap_wiso') + call addfldTo(compatm, 'Faxx_evap_wiso') + call addFldFrom(complnd, 'Fall_evap_wiso') + call addfldFrom(compice, 'Faii_evap_wiso') + call addaoflusFld( 'Faox_evap_wiso') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap_wiso', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap_wiso', rc=rc)) then - call addmap(fldListFr(complnd)%fields , 'Fall_evap_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Faxx_evap_wiso', & + call addmapFrom(complnd , 'Fall_evap_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm , 'Faxx_evap_wiso', & mrg_from=complnd, mrg_fld='Fall_evap_wiso', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap_wiso', rc=rc)) then - call addmap(fldListFr(compice)%fields , 'Faii_evap_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields , 'Faxx_evap_wiso', & + call addMapFrom(compice , 'Faii_evap_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(compatm , 'Faxx_evap_wiso', & mrg_from=compice, mrg_fld='Faii_evap_wiso', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_evap_wiso', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%fields, 'Faox_evap_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addaofluxmap('Faox_evap_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%fields , 'Faxx_evap_wiso', & + call addmrgTo(compatm , 'Faxx_evap_wiso', & mrg_from=compmed, mrg_fld='Faox_evap_wiso', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1321,31 +1327,31 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: merged surface temperature and unmerged temperatures from ice and ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Sl_t') - call addfld(fldListFr(compice)%fields, 'Si_t') - call addfld(fldListFr(compocn)%fields, 'So_t') - call addfld(fldListTo(compatm)%fields, 'So_t') - call addfld(fldListTo(compatm)%fields, 'Sx_t') + call addFldFrom(complnd, 'Sl_t') + call addfldFrom(compice, 'Si_t') + call addfldFrom(compocn, 'So_t') + call addfldTo(compatm, 'So_t') + call addfldTo(compatm, 'Sx_t') else if (fldchk(is_local%wrap%FBexp(compatm), 'Sx_t', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_t', rc=rc)) then - call addmap(fldListFr(complnd)%fields, 'Sl_t', compatm, mapconsf , 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sx_t', & + call addmapFrom(complnd, 'Sl_t', compatm, mapconsf , 'lfrin', lnd2atm_map) + call addmrgTo(compatm, 'Sx_t', & mrg_from=complnd, mrg_fld='Sl_t', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_t', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Si_t', compatm, mapconsf , 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sx_t', & + call addMapFrom(compice, 'Si_t', compatm, mapconsf , 'ifrac', ice2atm_map) + call addmrgTo(compatm, 'Sx_t', & mrg_from=compice, mrg_fld='Si_t', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_t', rc=rc)) then - call addmap(fldListFr(compocn)%fields, 'So_t', compatm, mapconsf, 'ofrac', ocn2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sx_t', & + call addmapFrom(compocn, 'So_t', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmrgTo(compatm, 'Sx_t', & mrg_from=compocn, mrg_fld='So_t', mrg_type='merge', mrg_fracname='ofrac') end if end if if (fldchk(is_local%wrap%FBexp(compatm), 'So_t', rc=rc)) then - call addmrg(fldListTo(compatm)%fields, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + call addmrgTo(compatm, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') end if end if @@ -1355,33 +1361,33 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: mean snow volume per unit area from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compice)%fields, 'Si_snowh') - call addfld(fldListTo(compatm)%fields, 'Si_snowh') + call addfldFrom(compice, 'Si_snowh') + call addfldTo(compatm, 'Si_snowh') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Si_snowh', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), 'Si_snowh', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Si_snowh', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Si_snowh', mrg_from=compice, mrg_fld='Si_snowh', mrg_type='copy') + call addMapFrom(compice, 'Si_snowh', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(compatm, 'Si_snowh', mrg_from=compice, mrg_fld='Si_snowh', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compice)%fields, 'Si_vice') - call addfld(fldListTo(compatm)%fields, 'Si_vice') + call addfldFrom(compice, 'Si_vice') + call addfldTo(compatm, 'Si_vice') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Si_vice', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), 'Si_vice', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Si_vice', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Si_vice', mrg_from=compice, mrg_fld='Si_vice', mrg_type='copy') + call addMapFrom(compice, 'Si_vice', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(compatm, 'Si_vice', mrg_from=compice, mrg_fld='Si_vice', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compice)%fields, 'Si_vsno') - call addfld(fldListTo(compatm)%fields, 'Si_vsno') + call addfldFrom(compice, 'Si_vsno') + call addfldTo(compatm, 'Si_vsno') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Si_vsno', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), 'Si_vsno', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Si_vsno', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Si_vsno', mrg_from=compice, mrg_fld='Si_vsno', mrg_type='copy') + call addMapFrom(compice, 'Si_vsno', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrgTo(compatm, 'Si_vsno', mrg_from=compice, mrg_fld='Si_vsno', mrg_type='copy') end if end if @@ -1391,39 +1397,39 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: surface fraction velocity from med aoflux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListMed_aoflux%fields , 'So_ssq') - call addfld(fldListTo(compatm)%fields , 'So_ssq') + call addaofluxFld('So_ssq') + call addfldTo(compatm , 'So_ssq') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'So_ssq', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'So_ssq', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%fields , 'So_ssq', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addaofluxmap( 'So_ssq', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%fields , 'So_ssq', mrg_from=compmed, mrg_fld='So_ssq', mrg_type='copy') + call addmrgTo(compatm , 'So_ssq', mrg_from=compmed, mrg_fld='So_ssq', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListMed_aoflux%fields , 'So_re') - call addfld(fldListTo(compatm)%fields , 'So_re') + call addaofluxFld('So_re') + call addfldTo(compatm , 'So_re') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'So_re', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'So_re', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%fields , 'So_re', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addaofluxmap( 'So_re', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%fields , 'So_re', mrg_from=compmed, mrg_fld='So_re', mrg_type='copy') + call addmrgTo(compatm , 'So_re', mrg_from=compmed, mrg_fld='So_re', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListMed_aoflux%fields , 'So_ustar') - call addfld(fldListTo(compatm)%fields , 'So_ustar') + call addaofluxFld('So_ustar') + call addfldTo(compatm , 'So_ustar') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'So_ustar', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'So_ustar', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%fields , 'So_ustar', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addaofluxmap( 'So_ustar', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrg(fldListTo(compatm)%fields , 'So_ustar', mrg_from=compmed, mrg_fld='So_ustar', mrg_type='copy') + call addmrgTo(compatm , 'So_ustar', mrg_from=compmed, mrg_fld='So_ustar', mrg_type='copy') end if end if @@ -1433,59 +1439,59 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: surface snow water equivalent from land ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Sl_fv') - call addfld(fldListTo(compatm)%fields, 'Sl_fv') + call addFldFrom(complnd, 'Sl_fv') + call addfldTo(compatm, 'Sl_fv') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_fv', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_fv', rc=rc)) then - call addmap(fldListFr(complnd)%fields, 'Sl_fv', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sl_fv', mrg_from=complnd, mrg_fld='Sl_fv', mrg_type='copy') + call addmapFrom(complnd, 'Sl_fv', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm, 'Sl_fv', mrg_from=complnd, mrg_fld='Sl_fv', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Sl_ram1') - call addfld(fldListTo(compatm)%fields, 'Sl_ram1') + call addFldFrom(complnd, 'Sl_ram1') + call addfldTo(compatm, 'Sl_ram1') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_ram1', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_ram1', rc=rc)) then - call addmap(fldListFr(complnd)%fields, 'Sl_ram1', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sl_ram1', mrg_from=complnd, mrg_fld='Sl_ram1', mrg_type='copy') + call addmapFrom(complnd, 'Sl_ram1', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm, 'Sl_ram1', mrg_from=complnd, mrg_fld='Sl_ram1', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Sl_snowh') - call addfld(fldListTo(compatm)%fields, 'Sl_snowh') + call addFldFrom(complnd, 'Sl_snowh') + call addfldTo(compatm, 'Sl_snowh') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_snowh', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_snowh', rc=rc)) then - call addmap(fldListFr(complnd)%fields, 'Sl_snowh', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sl_snowh', mrg_from=complnd, mrg_fld='Sl_snowh', mrg_type='copy') + call addmapFrom(complnd, 'Sl_snowh', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm, 'Sl_snowh', mrg_from=complnd, mrg_fld='Sl_snowh', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! CARMA fields (volumetric soil water) !----------------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Sl_soilw') - call addfld(fldListTo(compatm)%fields, 'Sl_soilw') + call addFldFrom(complnd, 'Sl_soilw') + call addfldTo(compatm, 'Sl_soilw') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_soilw', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_soilw', rc=rc)) then - call addmap(fldListFr(complnd)%fields, 'Sl_soilw', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sl_soilw', mrg_from=complnd, mrg_fld='Sl_soilw', mrg_type='copy') + call addmapFrom(complnd, 'Sl_soilw', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm, 'Sl_soilw', mrg_from=complnd, mrg_fld='Sl_soilw', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to atm: dust fluxes from land (4 sizes) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Fall_flxdst') - call addfld(fldListTo(compatm)%fields, 'Fall_flxdst') + call addFldFrom(complnd, 'Fall_flxdst') + call addfldTo(compatm, 'Fall_flxdst') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_flxdst', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_flxdst', rc=rc)) then - call addmap(fldListFr(complnd)%fields, 'Fall_flxdst', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Fall_flxdst', & + call addmapFrom(complnd, 'Fall_flxdst', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrgTo(compatm, 'Fall_flxdst', & mrg_from=complnd, mrg_fld='Fall_flxdst', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if @@ -1493,13 +1499,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: MEGAN emissions fluxes from land !----------------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Fall_voc') - call addfld(fldListTo(compatm)%fields, 'Fall_voc') + call addFldFrom(complnd, 'Fall_voc') + call addfldTo(compatm, 'Fall_voc') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_voc', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_voc', rc=rc)) then - call addmap(fldListFr(complnd)%fields, 'Fall_voc', compatm, mapconsf, 'one', atm2lnd_map) - call addmrg(fldListTo(compatm)%fields, 'Fall_voc', & + call addmapFrom(complnd, 'Fall_voc', compatm, mapconsf, 'one', atm2lnd_map) + call addmrgTo(compatm, 'Fall_voc', & mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='merge', mrg_fracname='lfrac') end if end if @@ -1508,38 +1514,38 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------------------------------------------------------- ! 'wild fire emission fluxes' if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Fall_fire') - call addfld(fldListTo(compatm)%fields, 'Fall_fire') + call addFldFrom(complnd, 'Fall_fire') + call addfldTo(compatm, 'Fall_fire') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_fire', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_fire', rc=rc)) then - call addmap(fldListFr(complnd)%fields, 'Fall_fire', compatm, mapconsf, 'one', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Fall_fire', & + call addmapFrom(complnd, 'Fall_fire', compatm, mapconsf, 'one', lnd2atm_map) + call addmrgTo(compatm, 'Fall_fire', & mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='merge', mrg_fracname='lfrac') end if end if ! 'wild fire plume height' if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Sl_fztop') - call addfld(fldListTo(compatm)%fields, 'Sl_fztop') + call addFldFrom(complnd, 'Sl_fztop') + call addfldTo(compatm, 'Sl_fztop') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Sl_fztop', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Sl_fztop', rc=rc)) then - call addmap(fldListFr(complnd)%fields, 'Sl_fztop', compatm, mapconsf, 'one', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sl_fztop', mrg_from=complnd, mrg_fld='Sl_fztop', mrg_type='copy') + call addmapFrom(complnd, 'Sl_fztop', compatm, mapconsf, 'one', lnd2atm_map) + call addmrgTo(compatm, 'Sl_fztop', mrg_from=complnd, mrg_fld='Sl_fztop', mrg_type='copy') end if end if !----------------------------------------------------------------------------- ! to atm: dry deposition velocities from land !----------------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Sl_ddvel') - call addfld(fldListTo(compatm)%fields, 'Sl_ddvel') + call addFldFrom(complnd, 'Sl_ddvel') + call addfldTo(compatm, 'Sl_ddvel') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Sl_ddvel', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Sl_ddvel', rc=rc)) then - call addmap(fldListFr(complnd)%fields, 'Sl_ddvel', compatm, mapconsf, 'one', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Sl_ddvel', mrg_from=complnd, mrg_fld='Sl_ddvel', mrg_type='copy') + call addmapFrom(complnd, 'Sl_ddvel', compatm, mapconsf, 'one', lnd2atm_map) + call addmrgTo(compatm, 'Sl_ddvel', mrg_from=complnd, mrg_fld='Sl_ddvel', mrg_type='copy') end if end if @@ -1551,11 +1557,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: fractional ice coverage wrt ocean from ice !---------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compice)%fields, 'Si_ifrac') - call addfld(fldListTo(compocn)%fields, 'Si_ifrac') + call addfldFrom(compice, 'Si_ifrac') + call addFldTo(compocn, 'Si_ifrac') else - call addmap(fldListFr(compice)%fields, 'Si_ifrac', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%fields, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') + call addMapFrom(compice, 'Si_ifrac', compocn, mapfcopy, 'unset', 'unset') + call addmrgTo(compocn, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') end if ! --------------------------------------------------------------------- @@ -1566,57 +1572,57 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: downward diffuse visible incident solar radiation from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_lwdn') - call addfld(fldListTo(compocn)%fields, 'Faxa_lwdn') + call addFldFrom(compatm, 'Faxa_lwdn') + call addFldTo(compocn, 'Faxa_lwdn') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_lwdn', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_lwdn', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%fields, 'Faxa_lwdn', & + call addMapFrom(compatm, 'Faxa_lwdn', compocn, mapconsf, 'one', atm2ocn_map) + call addmrgTo(compocn, 'Faxa_lwdn', & mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_swndr') - call addfld(fldListTo(compocn)%fields, 'Faxa_swndr') + call addFldFrom(compatm, 'Faxa_swndr') + call addFldTo(compocn, 'Faxa_swndr') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_swndr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndr', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%fields, 'Faxa_swndr', & + call addMapFrom(compatm, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_map) + call addmrgTo(compocn, 'Faxa_swndr', & mrg_from=compatm, mrg_fld='Faxa_swndr', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_swndf') - call addfld(fldListTo(compocn)%fields, 'Faxa_swndf') + call addFldFrom(compatm, 'Faxa_swndf') + call addFldTo(compocn, 'Faxa_swndf') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_swndf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndf', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_swndf', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%fields, 'Faxa_swndf', & + call addMapFrom(compatm, 'Faxa_swndf', compocn, mapconsf, 'one', atm2ocn_map) + call addmrgTo(compocn, 'Faxa_swndf', & mrg_from=compatm, mrg_fld='Faxa_swndf', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_swvdr') - call addfld(fldListTo(compocn)%fields, 'Faxa_swvdr') + call addFldFrom(compatm, 'Faxa_swvdr') + call addFldTo(compocn, 'Faxa_swvdr') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_swvdr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdr', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%fields, 'Faxa_swvdr', & + call addMapFrom(compatm, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_map) + call addmrgTo(compocn, 'Faxa_swvdr', & mrg_from=compatm, mrg_fld='Faxa_swvdr', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_swvdf') - call addfld(fldListTo(compocn)%fields, 'Faxa_swvdf') + call addFldFrom(compatm, 'Faxa_swvdf') + call addFldTo(compocn, 'Faxa_swvdf') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_swvdf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdf', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%fields, 'Faxa_swvdf', & + call addMapFrom(compatm, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_map) + call addmrgTo(compocn, 'Faxa_swvdf', & mrg_from=compatm, mrg_fld='Faxa_swvdf', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if @@ -1625,12 +1631,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: surface upward longwave heat flux from mediator ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListMed_aoflux%fields , 'Faox_lwup') - call addfld(fldListTo(compocn)%fields , 'Foxx_lwup') + call addaofluxFld('Faox_lwup') + call addFldTo(compocn , 'Foxx_lwup') else if ( fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lwup', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn), 'Foxx_lwup', rc=rc)) then - call addmrg(fldListTo(compocn)%fields, 'Foxx_lwup', & + call addmrgTo(compocn, 'Foxx_lwup', & mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1638,18 +1644,18 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: merged longwave net heat flux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields , 'Faxa_lwdn') - call addfld(fldListMed_aoflux%fields , 'Faox_lwup' ) - call addfld(fldListTo(compocn)%fields , 'Foxx_lwnet') + call addFldFrom(compatm , 'Faxa_lwdn') + call addaofluxFld('Faox_lwup' ) + call addFldTo(compocn , 'Foxx_lwnet') else ! (mom6) (send longwave net to ocn via auto merge) if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_lwnet', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_lwup' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn' , rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_lwdn', compocn, mapconsf, 'one' , atm2ocn_map) - call addmrg(fldListTo(compocn)%fields, 'Foxx_lwnet', & + call addMapFrom(compatm, 'Faxa_lwdn', compocn, mapconsf, 'one' , atm2ocn_map) + call addmrgTo(compocn, 'Foxx_lwnet', & mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') - call addmrg(fldListTo(compocn)%fields, 'Foxx_lwnet', & + call addmrgTo(compocn, 'Foxx_lwnet', & mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1657,13 +1663,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: downward shortwave heat flux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_swdn') - call addfld(fldListTo(compocn)%fields, 'Faxa_swdn') + call addFldFrom(compatm, 'Faxa_swdn') + call addFldTo(compocn, 'Faxa_swdn') else if (fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_swdn', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_swdn', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_swdn', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%fields, 'Faxa_swdn', & + call addMapFrom(compatm, 'Faxa_swdn', compocn, mapconsf, 'one', atm2ocn_map) + call addmrgTo(compocn, 'Faxa_swdn', & mrg_from=compatm, mrg_fld='Faxa_swdn', mrg_type='copy') end if end if @@ -1671,28 +1677,28 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: net shortwave radiation from med ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_swvdr') - call addfld(fldListFr(compatm)%fields, 'Faxa_swndr') - call addfld(fldListFr(compatm)%fields, 'Faxa_swvdf') - call addfld(fldListFr(compatm)%fields, 'Faxa_swndf') + call addFldFrom(compatm, 'Faxa_swvdr') + call addFldFrom(compatm, 'Faxa_swndr') + call addFldFrom(compatm, 'Faxa_swvdf') + call addFldFrom(compatm, 'Faxa_swndf') - call addfld(fldListFr(compice)%fields, 'Fioi_swpen') - call addfld(fldListFr(compice)%fields, 'Fioi_swpen_vdr') - call addfld(fldListFr(compice)%fields, 'Fioi_swpen_vdf') - call addfld(fldListFr(compice)%fields, 'Fioi_swpen_idr') - call addfld(fldListFr(compice)%fields, 'Fioi_swpen_idf') + call addfldFrom(compice, 'Fioi_swpen') + call addfldFrom(compice, 'Fioi_swpen_vdr') + call addfldFrom(compice, 'Fioi_swpen_vdf') + call addfldFrom(compice, 'Fioi_swpen_idr') + call addfldFrom(compice, 'Fioi_swpen_idf') - call addfld(fldListTo(compocn)%fields, 'Foxx_swnet') - call addfld(fldListTo(compocn)%fields, 'Foxx_swnet_vdr') - call addfld(fldListTo(compocn)%fields, 'Foxx_swnet_vdf') - call addfld(fldListTo(compocn)%fields, 'Foxx_swnet_idr') - call addfld(fldListTo(compocn)%fields, 'Foxx_swnet_idf') + call addFldTo(compocn, 'Foxx_swnet') + call addFldTo(compocn, 'Foxx_swnet_vdr') + call addFldTo(compocn, 'Foxx_swnet_vdf') + call addFldTo(compocn, 'Foxx_swnet_idr') + call addFldTo(compocn, 'Foxx_swnet_idf') else ! Net shortwave ocean (custom calculation in prep_phases_ocn_mod.F90) ! import swpen from ice without bands if (fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Fioi_swpen', compocn, mapfcopy, 'unset', 'unset') + call addMapFrom(compice, 'Fioi_swpen', compocn, mapfcopy, 'unset', 'unset') end if ! import swpen from ice by bands @@ -1700,10 +1706,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_idr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_idf', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Fioi_swpen_vdr', compocn, mapfcopy, 'unset', 'unset') - call addmap(fldListFr(compice)%fields, 'Fioi_swpen_vdf', compocn, mapfcopy, 'unset', 'unset') - call addmap(fldListFr(compice)%fields, 'Fioi_swpen_idr', compocn, mapfcopy, 'unset', 'unset') - call addmap(fldListFr(compice)%fields, 'Fioi_swpen_idf', compocn, mapfcopy, 'unset', 'unset') + call addMapFrom(compice, 'Fioi_swpen_vdr', compocn, mapfcopy, 'unset', 'unset') + call addMapFrom(compice, 'Fioi_swpen_vdf', compocn, mapfcopy, 'unset', 'unset') + call addMapFrom(compice, 'Fioi_swpen_idr', compocn, mapfcopy, 'unset', 'unset') + call addMapFrom(compice, 'Fioi_swpen_idf', compocn, mapfcopy, 'unset', 'unset') end if ! import sw from atm by bands @@ -1716,10 +1722,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc))) then - call addmap(fldListFr(compatm)%fields, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%fields, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%fields, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%fields, 'Faxa_swndf', compocn, mapconsf, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Faxa_swndf', compocn, mapconsf, 'one', atm2ocn_map) end if end if @@ -1729,27 +1735,27 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_i2o_per_cat) then if (phase == 'advertise') then ! 'fractional ice coverage wrt ocean for each thickness category ' - call addfld(fldListFr(compice)%fields, 'Si_ifrac_n') - call addfld(fldListTo(compocn)%fields, 'Si_ifrac_n') + call addfldFrom(compice, 'Si_ifrac_n') + call addFldTo(compocn, 'Si_ifrac_n') ! net shortwave radiation penetrating into ocean for each thickness category - call addfld(fldListFr(compice)%fields, 'Fioi_swpen_ifrac_n') - call addfld(fldListTo(compocn)%fields, 'Fioi_swpen_ifrac_n') + call addfldFrom(compice, 'Fioi_swpen_ifrac_n') + call addFldTo(compocn, 'Fioi_swpen_ifrac_n') ! 'fractional atmosphere coverage wrt ocean' (computed in med_phases_prep_ocn) - call addfld(fldListTo(compocn)%fields, 'Sf_afrac') + call addFldTo(compocn, 'Sf_afrac') ! 'fractional atmosphere coverage used in radiation computations wrt ocean' (computed in med_phases_prep_ocn) - call addfld(fldListTo(compocn)%fields, 'Sf_afracr') + call addFldTo(compocn, 'Sf_afracr') ! 'net shortwave radiation times atmosphere fraction' (computed in med_phases_prep_ocn) - call addfld(fldListTo(compocn)%fields, 'Foxx_swnet_afracr') + call addFldTo(compocn, 'Foxx_swnet_afracr') else - call addmap(fldListFr(compice)%fields, 'Si_ifrac_n', & + call addMapFrom(compice, 'Si_ifrac_n', & compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%fields, 'Si_ifrac_n', & + call addmrgTo(compocn, 'Si_ifrac_n', & mrg_from=compice, mrg_fld='Si_ifrac_n', mrg_type='copy') - call addmap(fldListFr(compice)%fields, 'Fioi_swpen_ifrac_n', & + call addMapFrom(compice, 'Fioi_swpen_ifrac_n', & compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%fields, 'Fioi_swpen_ifrac_n', & + call addmrgTo(compocn, 'Fioi_swpen_ifrac_n', & mrg_from=compice, mrg_fld='Fioi_swpen_ifrac_n', mrg_type='copy') ! Note that 'Sf_afrac, 'Sf_afracr' and 'Foxx_swnet_afracr' will have explicit merging in med_phases_prep_ocn end if @@ -1761,12 +1767,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_rainc') - call addfld(fldListFr(compatm)%fields, 'Faxa_rainl') - call addfld(fldListTo(compocn)%fields, 'Faxa_rain' ) - call addfld(fldListFr(compatm)%fields, 'Faxa_snowc') - call addfld(fldListFr(compatm)%fields, 'Faxa_snowl') - call addfld(fldListTo(compocn)%fields, 'Faxa_snow' ) + call addFldFrom(compatm, 'Faxa_rainc') + call addFldFrom(compatm, 'Faxa_rainl') + call addFldTo(compocn, 'Faxa_rain' ) + call addFldFrom(compatm, 'Faxa_snowc') + call addFldFrom(compatm, 'Faxa_snowl') + call addFldTo(compocn, 'Faxa_snow' ) else ! TODO: why are we not merging Faxa_rain and Faxa_snow if they are sent from atm wiht ofrac ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization @@ -1774,47 +1780,47 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain' , rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_rainl', compocn, mapconsf, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%fields, 'Faxa_rainc', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%fields, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', & + call addMapFrom(compatm, 'Faxa_rainl', compocn, mapconsf, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Faxa_rainc', compocn, mapconsf, 'one', atm2ocn_map) + call addmrgTo(compocn, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', & mrg_type='sum_with_weights', mrg_fracname='ofrac') end if if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_snowl', compocn, mapconsf, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%fields, 'Faxa_snowc', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%fields, 'Faxa_snow' , & + call addMapFrom(compatm, 'Faxa_snowl', compocn, mapconsf, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Faxa_snowc', compocn, mapconsf, 'one', atm2ocn_map) + call addmrgTo(compocn, 'Faxa_snow' , & mrg_from=compatm, mrg_fld='Faxa_snowc:Faxa_snowl', mrg_type='sum_with_weights', mrg_fracname='ofrac') end if end if if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_rainc_wiso') - call addfld(fldListFr(compatm)%fields, 'Faxa_rainl_wiso') - call addfld(fldListTo(compocn)%fields, 'Faxa_rain_wiso' ) - call addfld(fldListFr(compatm)%fields, 'Faxa_snowc_wiso') - call addfld(fldListFr(compatm)%fields, 'Faxa_snowl_wiso') - call addfld(fldListFr(compatm)%fields, 'Faxa_snow_wiso' ) + call addFldFrom(compatm, 'Faxa_rainc_wiso') + call addFldFrom(compatm, 'Faxa_rainl_wiso') + call addFldTo(compocn, 'Faxa_rain_wiso' ) + call addFldFrom(compatm, 'Faxa_snowc_wiso') + call addFldFrom(compatm, 'Faxa_snowl_wiso') + call addFldFrom(compatm, 'Faxa_snow_wiso' ) else ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization ! which by default is not actually used if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain_wiso' , rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_rainl_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%fields, 'Faxa_rainc_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%fields, 'Faxa_rain_wiso' , & + call addMapFrom(compatm, 'Faxa_rainl_wiso', compocn, mapconsf, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Faxa_rainc_wiso', compocn, mapconsf, 'one', atm2ocn_map) + call addmrgTo(compocn, 'Faxa_rain_wiso' , & mrg_from=compatm, mrg_fld=trim('Faxa_rainc_wiso')//':'//trim('Faxa_rainl_wiso'), & mrg_type='sum_with_weights', mrg_fracname='ofrac') end if if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_snowl_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%fields, 'Faxa_snowc_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%fields, 'Faxa_snow_wiso', & + call addMapFrom(compatm, 'Faxa_snowl_wiso', compocn, mapconsf, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Faxa_snowc_wiso', compocn, mapconsf, 'one', atm2ocn_map) + call addmrgTo(compocn, 'Faxa_snow_wiso', & mrg_from=compatm, mrg_fld=trim('Faxa_snowc_wiso')//':'//trim('Faxa_snowl_wiso'), & mrg_type='sum_with_weights', mrg_fracname='ofrac') end if @@ -1825,14 +1831,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: merged sensible heat flux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields , 'Faxa_sen') - call addfld(fldListMed_aoflux%fields , 'Faox_sen') - call addfld(fldListFr(compice)%fields , 'Fioi_melth') - call addfld(fldListTo(compocn)%fields , 'Foxx_sen') + call addFldFrom(compatm , 'Faxa_sen') + call addaofluxFld('Faox_sen') + call addfldFrom(compice , 'Fioi_melth') + call addFldTo(compocn , 'Foxx_sen') else if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_sen', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_sen', rc=rc)) then - call addmrg(fldListTo(compocn)%fields, 'Foxx_sen', & + call addmrgTo(compocn, 'Foxx_sen', & mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1841,29 +1847,29 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: surface latent heat flux and evaporation water flux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_lat' ) - call addfld(fldListMed_aoflux%fields , 'Faox_lat' ) - call addfld(fldListMed_aoflux%fields , 'Faox_evap') - call addfld(fldListTo(compocn)%fields, 'Foxx_lat' ) - call addfld(fldListTo(compocn)%fields, 'Foxx_evap') + call addFldFrom(compatm, 'Faxa_lat' ) + call addaoflusFld( 'Faox_lat' ) + call addaoflusFld( 'Faox_evap') + call addFldTo(compocn, 'Foxx_lat' ) + call addFldTo(compocn, 'Foxx_evap') else if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat', rc=rc)) then - call addmrg(fldListTo(compocn)%fields, 'Foxx_lat', & + call addmrgTo(compocn, 'Foxx_lat', & mrg_from=compmed, mrg_fld='Faox_lat', mrg_type='merge', mrg_fracname='ofrac') end if if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap', rc=rc)) then - call addmrg(fldListTo(compocn)%fields, 'Foxx_evap', & + call addmrgTo(compocn, 'Foxx_evap', & mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='merge', mrg_fracname='ofrac') end if end if if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListMed_aoflux%fields , 'Faox_lat_wiso' ) - call addfld(fldListTo(compocn)%fields, 'Foxx_lat_wiso' ) + call addaoflusFld( 'Faox_lat_wiso' ) + call addFldTo(compocn, 'Foxx_lat_wiso' ) else if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat_wiso', rc=rc)) then - call addmrg(fldListTo(compocn)%fields, 'Foxx_lat_wiso', & + call addmrgTo(compocn, 'Foxx_lat_wiso', & mrg_from=compmed, mrg_fld='Faox_lat_wiso', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1876,11 +1882,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! If the aoflux grid is ogrid - then nothing needs to be done to send to the ocean ! All other mappings are set in med_phases_aoflux_mod.F90 if (phase == 'advertise') then - call addfld(fldListMed_aoflux%fields , 'So_duu10n') - call addfld(fldListTo(compocn)%fields, 'So_duu10n') + call addaoflusFld( 'So_duu10n') + call addFldTo(compocn, 'So_duu10n') else if (fldchk(is_local%wrap%FBExp(compocn), 'So_duu10n', rc=rc)) then - call addmrg(fldListTo(compocn)%fields, 'So_duu10n', mrg_from=compmed, mrg_fld='So_duu10n', mrg_type='copy') + call addmrgTo(compocn, 'So_duu10n', mrg_from=compmed, mrg_fld='So_duu10n', mrg_type='copy') end if end if @@ -1888,14 +1894,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: sea level pressure from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_pslv') - call addfld(fldListTo(compocn)%fields, 'Sa_pslv') + call addFldFrom(compatm, 'Sa_pslv') + call addFldTo(compocn, 'Sa_pslv') else if ( fldchk(is_local%wrap%FBImp(compatm, compatm), 'Sa_pslv', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Sa_pslv', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_map) - call addmap(fldListFr(compatm)%fields, 'Sa_pslv', compice, mapbilnr, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%fields, 'Sa_pslv', & + call addMapFrom(compatm, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Sa_pslv', compice, mapbilnr, 'one', atm2ocn_map) + call addmrgTo(compocn, 'Sa_pslv', & mrg_from=compatm, mrg_fld='Sa_pslv', mrg_type='copy') end if end if @@ -1914,46 +1920,46 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: nitrogen deposition fields (2) from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListTo(compocn)%fields, 'Faxa_bcph') - call addfld(fldListFr(compatm)%fields, 'Faxa_bcph') + call addFldTo(compocn, 'Faxa_bcph') + call addFldFrom(compatm, 'Faxa_bcph') else if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_bcph', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_bcph', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_bcph', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%fields, 'Faxa_bcph', & + call addMapFrom(compatm, 'Faxa_bcph', compocn, mapconsf, 'one', atm2ocn_map) + call addmrgTo(compocn, 'Faxa_bcph', & mrg_from=compatm, mrg_fld='Faxa_bcph', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addfld(fldListTo(compocn)%fields, 'Faxa_ocph') - call addfld(fldListFr(compatm)%fields, 'Faxa_ocph') + call addFldTo(compocn, 'Faxa_ocph') + call addFldFrom(compatm, 'Faxa_ocph') else if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_ocph', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_ocph', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_ocph', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%fields, 'Faxa_ocph', & + call addMapFrom(compatm, 'Faxa_ocph', compocn, mapconsf, 'one', atm2ocn_map) + call addmrgTo(compocn, 'Faxa_ocph', & mrg_from=compatm, mrg_fld='Faxa_ocph', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addfld(fldListTo(compocn)%fields, 'Faxa_dstwet') - call addfld(fldListFr(compatm)%fields, 'Faxa_dstwet') + call addFldTo(compocn, 'Faxa_dstwet') + call addFldFrom(compatm, 'Faxa_dstwet') else if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_dstwet', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_dstwet', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_dstwet', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%fields, 'Faxa_dstwet', & + call addMapFrom(compatm, 'Faxa_dstwet', compocn, mapconsf, 'one', atm2ocn_map) + call addmrgTo(compocn, 'Faxa_dstwet', & mrg_from=compatm, mrg_fld='Faxa_dstwet', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addfld(fldListTo(compocn)%fields, 'Faxa_dstdry') - call addfld(fldListFr(compatm)%fields, 'Faxa_dstdry') + call addFldTo(compocn, 'Faxa_dstdry') + call addFldFrom(compatm, 'Faxa_dstdry') else if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_dstdry', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_dstdry', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_dstdry', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%fields, 'Faxa_dstdry', & + call addMapFrom(compatm, 'Faxa_dstdry', compocn, mapconsf, 'one', atm2ocn_map) + call addmrgTo(compocn, 'Faxa_dstdry', & mrg_from=compatm, mrg_fld='Faxa_dstdry', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if @@ -1966,44 +1972,44 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Note - do not need to add addmap or addmrg for the following since they ! will be computed directly in med_phases_prep_ocn if (phase == 'advertise') then - call addfld(fldListTo(compocn)%fields, 'Foxx_hrain') - call addfld(fldListTo(compocn)%fields, 'Foxx_hsnow') - call addfld(fldListTo(compocn)%fields, 'Foxx_hevap') - call addfld(fldListTo(compocn)%fields, 'Foxx_hcond') - call addfld(fldListTo(compocn)%fields, 'Foxx_hrofl') - call addfld(fldListTo(compocn)%fields, 'Foxx_hrofi') + call addFldTo(compocn, 'Foxx_hrain') + call addFldTo(compocn, 'Foxx_hsnow') + call addFldTo(compocn, 'Foxx_hevap') + call addFldTo(compocn, 'Foxx_hcond') + call addFldTo(compocn, 'Foxx_hrofl') + call addFldTo(compocn, 'Foxx_hrofi') end if ! --------------------------------------------------------------------- ! to ocn: merge zonal and meridional surface stress from ice and (atm or med) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListTo(compocn)%fields , 'Foxx_taux') - call addfld(fldListFr(compice)%fields , 'Fioi_taux') - call addfld(fldListMed_aoflux%fields , 'Faox_taux') + call addFldTo(compocn , 'Foxx_taux') + call addfldFrom(compice , 'Fioi_taux') + call addaofluxFld('Faox_taux') else if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_taux', rc=rc)) then if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%fields, 'Foxx_taux', & + call addMapFrom(compice, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') + call addmrgTo(compocn, 'Foxx_taux', & mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') end if - call addmrg(fldListTo(compocn)%fields, 'Foxx_taux', & + call addmrgTo(compocn, 'Foxx_taux', & mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addfld(fldListTo(compocn)%fields , 'Foxx_tauy') - call addfld(fldListFr(compice)%fields , 'Fioi_tauy') - call addfld(fldListMed_aoflux%fields , 'Faox_tauy') + call addFldTo(compocn , 'Foxx_tauy') + call addfldFrom(compice , 'Fioi_tauy') + call addaofluxFld('Faox_tauy') else if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_tauy', rc=rc)) then if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_tauy', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%fields, 'Foxx_tauy', & + call addMapFrom(compice, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') + call addmrgTo(compocn, 'Foxx_tauy', & mrg_from=compice, mrg_fld='Fioi_tauy', mrg_type='merge', mrg_fracname='ifrac') end if - call addmrg(fldListTo(compocn)%fields, 'Foxx_tauy', & + call addmrgTo(compocn, 'Foxx_tauy', & mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -2011,25 +2017,25 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: water flux due to melting ice from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compice)%fields , 'Fioi_meltw') - call addfld(fldListTo(compocn)%fields , 'Fioi_meltw') + call addfldFrom(compice , 'Fioi_meltw') + call addFldTo(compocn , 'Fioi_meltw') else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Fioi_meltw', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_meltw', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Fioi_meltw', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%fields, 'Fioi_meltw', & + call addMapFrom(compice, 'Fioi_meltw', compocn, mapfcopy, 'unset', 'unset') + call addmrgTo(compocn, 'Fioi_meltw', & mrg_from=compice, mrg_fld='Fioi_meltw', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(compice)%fields , 'Fioi_meltw_wiso') - call addfld(fldListTo(compocn)%fields , 'Fioi_meltw_wiso') + call addfldFrom(compice , 'Fioi_meltw_wiso') + call addFldTo(compocn , 'Fioi_meltw_wiso') else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Fioi_meltw_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_meltw_wiso', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Fioi_meltw_wiso', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%fields, 'Fioi_meltw_wiso', & + call addMapFrom(compice, 'Fioi_meltw_wiso', compocn, mapfcopy, 'unset', 'unset') + call addmrgTo(compocn, 'Fioi_meltw_wiso', & mrg_from=compice, mrg_fld='Fioi_meltw_wiso', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if @@ -2038,13 +2044,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: heat flux from melting ice from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compice)%fields, 'Fioi_melth') - call addfld(fldListTo(compocn)%fields, 'Fioi_melth') + call addfldFrom(compice, 'Fioi_melth') + call addFldTo(compocn, 'Fioi_melth') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_melth', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_melth', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Fioi_melth', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%fields, 'Fioi_melth', & + call addMapFrom(compice, 'Fioi_melth', compocn, mapfcopy, 'unset', 'unset') + call addmrgTo(compocn, 'Fioi_melth', & mrg_from=compice, mrg_fld='Fioi_melth', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if @@ -2052,13 +2058,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: salt flux from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compice)%fields, 'Fioi_salt') - call addfld(fldListTo(compocn)%fields, 'Fioi_salt') + call addfldFrom(compice, 'Fioi_salt') + call addFldTo(compocn, 'Fioi_salt') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_salt', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_salt', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Fioi_salt', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%fields, 'Fioi_salt', & + call addMapFrom(compice, 'Fioi_salt', compocn, mapfcopy, 'unset', 'unset') + call addmrgTo(compocn, 'Fioi_salt', & mrg_from=compice, mrg_fld='Fioi_salt', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if @@ -2066,13 +2072,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: hydrophylic black carbon deposition flux from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compice)%fields, 'Fioi_bcphi') - call addfld(fldListTo(compocn)%fields, 'Fioi_bcphi') + call addfldFrom(compice, 'Fioi_bcphi') + call addFldTo(compocn, 'Fioi_bcphi') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_bcphi', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_bcphi', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Fioi_bcphi', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%fields, 'Fioi_bcphi', & + call addMapFrom(compice, 'Fioi_bcphi', compocn, mapfcopy, 'unset', 'unset') + call addmrgTo(compocn, 'Fioi_bcphi', & mrg_from=compice, mrg_fld='Fioi_bcphi', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if @@ -2080,13 +2086,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: hydrophobic black carbon deposition flux from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compice)%fields, 'Fioi_bcpho') - call addfld(fldListTo(compocn)%fields, 'Fioi_bcpho') + call addfldFrom(compice, 'Fioi_bcpho') + call addFldTo(compocn, 'Fioi_bcpho') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_bcpho', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_bcpho', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Fioi_bcpho', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%fields, 'Fioi_bcpho', & + call addMapFrom(compice, 'Fioi_bcpho', compocn, mapfcopy, 'unset', 'unset') + call addmrgTo(compocn, 'Fioi_bcpho', & mrg_from=compice, mrg_fld='Fioi_bcpho', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if @@ -2094,13 +2100,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: dust flux from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compice)%fields, 'Fioi_flxdst') - call addfld(fldListTo(compocn)%fields, 'Fioi_flxdst') + call addfldFrom(compice, 'Fioi_flxdst') + call addFldTo(compocn, 'Fioi_flxdst') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_flxdst', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_flxdst', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Fioi_flxdst', compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%fields, 'Fioi_flxdst', & + call addMapFrom(compice, 'Fioi_flxdst', compocn, mapfcopy, 'unset', 'unset') + call addmrgTo(compocn, 'Fioi_flxdst', & mrg_from=compice, mrg_fld='Fioi_flxdst', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if @@ -2116,38 +2122,38 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! fldlistFr(comprof) in order to be mapped correctly but the ocean ! does not receive it so it is advertised but it will! not be connected do ns = 1, is_local%wrap%num_icesheets - call addfld(fldListFr(compglc(ns))%fields, 'Fogg_rofl') + call addfldFrom(compglc(ns), 'Fogg_rofl') end do - call addfld(fldListFr(comprof)%fields, 'Forr_rofl') - call addfld(fldListTo(compocn)%fields, 'Foxx_rofl') - call addfld(fldListTo(compocn)%fields, 'Flrr_flood') + call addfldFrom(comprof, 'Forr_rofl') + call addFldTo(compocn, 'Foxx_rofl') + call addFldTo(compocn, 'Flrr_flood') do ns = 1, is_local%wrap%num_icesheets - call addfld(fldListFr(compglc(ns))%fields, 'Fogg_rofi') + call addfldFrom(compglc(ns), 'Fogg_rofi') end do - call addfld(fldListFr(comprof)%fields, 'Forr_rofi') - call addfld(fldListTo(compocn)%fields, 'Foxx_rofi') + call addfldFrom(comprof, 'Forr_rofi') + call addFldTo(compocn, 'Foxx_rofi') else if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc)) then ! liquid from river and possibly flood from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl' , rc=rc)) then if (trim(rof2ocn_liq_rmap) == 'unset') then - call addmap(fldListFr(comprof)%fields, 'Forr_rofl', compocn, mapconsd, 'none', 'unset') + call addmapFrom(comprof, 'Forr_rofl', compocn, mapconsd, 'none', 'unset') else - call addmap(fldListFr(comprof)%fields, 'Forr_rofl', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) + call addmapFrom(comprof, 'Forr_rofl', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) end if if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood', rc=rc)) then - call addmap(fldListFr(comprof)%fields, 'Flrr_flood', compocn, mapconsd, 'one', rof2ocn_fmap) - call addmrg(fldListTo(compocn)%fields, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl:Flrr_flood', mrg_type='sum') + call addmapFrom(comprof, 'Flrr_flood', compocn, mapconsd, 'one', rof2ocn_fmap) + call addmrgTo(compocn, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl:Flrr_flood', mrg_type='sum') else - call addmrg(fldListTo(compocn)%fields, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl', mrg_type='sum') + call addmrgTo(compocn, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl', mrg_type='sum') end if end if ! liquid from glc to ocean do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofl' , rc=rc)) then ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmap(fldListFr(compglc(ns))%fields, 'Fogg_rofl', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) - call addmrg(fldListTo(compocn)%fields, 'Foxx_rofl', mrg_from=compglc(ns), mrg_fld='Fogg_rofl', mrg_type='sum') + call addmapFrom(compglc(ns), 'Fogg_rofl', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) + call addmrgTo(compocn, 'Foxx_rofl', mrg_from=compglc(ns), mrg_fld='Fogg_rofl', mrg_type='sum') end if end do end if @@ -2155,18 +2161,18 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! ice from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi' , rc=rc)) then if (trim(rof2ocn_ice_rmap) == 'unset') then - call addmap(fldListFr(comprof)%fields, 'Forr_rofi', compocn, mapconsd, 'none', 'unset') + call addmapFrom(comprof, 'Forr_rofi', compocn, mapconsd, 'none', 'unset') else - call addmap(fldListFr(comprof)%fields, 'Forr_rofi', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) + call addmapFrom(comprof, 'Forr_rofi', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) end if - call addmrg(fldListTo(compocn)%fields, 'Foxx_rofi', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') + call addmrgTo(compocn, 'Foxx_rofi', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') end if ! ice from glc to ocean do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofi' , rc=rc)) then ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmap(fldListFr(compglc(ns))%fields, 'Fogg_rofi', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) - call addmrg(fldListTo(compocn)%fields, 'Foxx_rofi', mrg_from=compglc(ns), mrg_fld='Fogg_rofi', mrg_type='sum') + call addmapFrom(compglc(ns), 'Fogg_rofi', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) + call addmrgTo(compocn, 'Foxx_rofi', mrg_from=compglc(ns), mrg_fld='Fogg_rofi', mrg_type='sum') end if end do end if @@ -2175,31 +2181,31 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_wiso) then if (phase == 'advertise') then do ns = 1, is_local%wrap%num_icesheets - call addfld(fldListFr(compglc(ns))%fields, 'Fogg_rofl_wiso') + call addfldFrom(compglc(ns), 'Fogg_rofl_wiso') end do - call addfld(fldListFr(comprof)%fields, 'Forr_rofl_wiso') - call addfld(fldListTo(compocn)%fields, 'Foxx_rofl_wiso') - call addfld(fldListTo(compocn)%fields, 'Flrr_flood_wiso') + call addfldFrom(comprof, 'Forr_rofl_wiso') + call addFldTo(compocn, 'Foxx_rofl_wiso') + call addFldTo(compocn, 'Flrr_flood_wiso') do ns = 1, is_local%wrap%num_icesheets - call addfld(fldListFr(compglc(ns))%fields, 'Fogg_rofi_wiso') + call addfldFrom(compglc(ns), 'Fogg_rofi_wiso') end do - call addfld(fldListFr(comprof)%fields, 'Forr_rofi_wiso') - call addfld(fldListTo(compocn)%fields, 'Foxx_rofi_wiso') + call addfldFrom(comprof, 'Forr_rofi_wiso') + call addFldTo(compocn, 'Foxx_rofi_wiso') else if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl_wiso' , rc=rc)) then ! liquid from river and possibly flood from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_wiso' , rc=rc)) then if (trim(rof2ocn_liq_rmap) == 'unset') then - call addmap(fldListFr(comprof)%fields, 'Forr_rofl_wiso', compocn, mapconsd, 'none', 'unset') + call addmapFrom(comprof, 'Forr_rofl_wiso', compocn, mapconsd, 'none', 'unset') else - call addmap(fldListFr(comprof)%fields, 'Forr_rofl_wiso', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) + call addmapFrom(comprof, 'Forr_rofl_wiso', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) end if if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood_wiso', rc=rc)) then - call addmap(fldListFr(comprof)%fields, 'Flrr_flood_wiso', compocn, mapconsd, 'one', rof2ocn_fmap) - call addmrg(fldListTo(compocn)%fields, 'Foxx_rofl_wiso', & + call addmapFrom(comprof, 'Flrr_flood_wiso', compocn, mapconsd, 'one', rof2ocn_fmap) + call addmrgTo(compocn, 'Foxx_rofl_wiso', & mrg_from=comprof, mrg_fld='Forr_rofl:Flrr_flood', mrg_type='sum') else - call addmrg(fldListTo(compocn)%fields, 'Foxx_rofl_wiso', & + call addmrgTo(compocn, 'Foxx_rofl_wiso', & mrg_from=comprof, mrg_fld='Forr_rofl', mrg_type='sum') end if end if @@ -2207,8 +2213,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofl_wiso' , rc=rc)) then ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmap(fldListFr(compglc(ns))%fields, 'Fogg_rofl_wiso', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) - call addmrg(fldListTo(compocn)%fields, 'Foxx_rofl_wiso', & + call addmapFrom(compglc(ns), 'Fogg_rofl_wiso', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) + call addmrgTo(compocn, 'Foxx_rofl_wiso', & mrg_from=compglc(ns), mrg_fld='Fogg_rofl_wiso', mrg_type='sum') end if end do @@ -2217,18 +2223,18 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! ice from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_wiso' , rc=rc)) then if (trim(rof2ocn_ice_rmap) == 'unset') then - call addmap(fldListFr(comprof)%fields, 'Forr_rofi_wiso', compocn, mapconsd, 'none', 'unset') + call addmapFrom(comprof, 'Forr_rofi_wiso', compocn, mapconsd, 'none', 'unset') else - call addmap(fldListFr(comprof)%fields, 'Forr_rofi_wiso', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) + call addmapFrom(comprof, 'Forr_rofi_wiso', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) end if - call addmrg(fldListTo(compocn)%fields, 'Foxx_rofi_wiso', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') + call addmrgTo(compocn, 'Foxx_rofi_wiso', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') end if ! ice from glc to ocean do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofi_wiso' , rc=rc)) then ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmap(fldListFr(compglc(ns))%fields, 'Fogg_rofi_wiso', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) - call addmrg(fldListTo(compocn)%fields, 'Foxx_rofi_wiso', & + call addmapFrom(compglc(ns), 'Fogg_rofi_wiso', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) + call addmrgTo(compocn, 'Foxx_rofi_wiso', & mrg_from=compglc(ns), mrg_fld='Fogg_rofi_wiso', mrg_type='sum') end if end do @@ -2240,78 +2246,78 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: Langmuir multiplier from wave !----------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compwav)%fields, 'Sw_lamult') - call addfld(fldListTo(compocn)%fields, 'Sw_lamult') + call addfldFrom(compwav, 'Sw_lamult') + call addFldTo(compocn, 'Sw_lamult') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_lamult', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_lamult', rc=rc)) then - call addmap(fldListFr(compwav)%fields, 'Sw_lamult', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) - call addmrg(fldListTo(compocn)%fields, 'Sw_lamult', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') + call addmapFrom(compwav, 'Sw_lamult', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrgTo(compocn, 'Sw_lamult', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') end if end if !----------------------------- ! to ocn: Stokes drift u component from wave !----------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compwav)%fields, 'Sw_ustokes') - call addfld(fldListTo(compocn)%fields, 'Sw_ustokes') + call addfldFrom(compwav, 'Sw_ustokes') + call addFldTo(compocn, 'Sw_ustokes') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes', rc=rc)) then - call addmap(fldListFr(compwav)%fields, 'Sw_ustokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) - call addmrg(fldListTo(compocn)%fields, 'Sw_ustokes', mrg_from=compwav, mrg_fld='Sw_ustokes', mrg_type='copy') + call addmapFrom(compwav, 'Sw_ustokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrgTo(compocn, 'Sw_ustokes', mrg_from=compwav, mrg_fld='Sw_ustokes', mrg_type='copy') end if end if !----------------------------- ! to ocn: Stokes drift v component from wave !----------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compwav)%fields, 'Sw_vstokes') - call addfld(fldListTo(compocn)%fields, 'Sw_vstokes') + call addfldFrom(compwav, 'Sw_vstokes') + call addFldTo(compocn, 'Sw_vstokes') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes', rc=rc)) then - call addmap(fldListFr(compwav)%fields, 'Sw_vstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) - call addmrg(fldListTo(compocn)%fields, 'Sw_vstokes', mrg_from=compwav, mrg_fld='Sw_vstokes', mrg_type='copy') + call addmapFrom(compwav, 'Sw_vstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrgTo(compocn, 'Sw_vstokes', mrg_from=compwav, mrg_fld='Sw_vstokes', mrg_type='copy') end if end if !----------------------------- ! to ocn: Stokes drift depth from wave !----------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compwav)%fields, 'Sw_hstokes') - call addfld(fldListTo(compocn)%fields, 'Sw_hstokes') + call addfldFrom(compwav, 'Sw_hstokes') + call addFldTo(compocn, 'Sw_hstokes') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_hstokes', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_hstokes', rc=rc)) then - call addmap(fldListFr(compwav)%fields, 'Sw_hstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) - call addmrg(fldListTo(compocn)%fields, 'Sw_hstokes', mrg_from=compwav, mrg_fld='Sw_hstokes', mrg_type='copy') + call addmapFrom(compwav, 'Sw_hstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrgTo(compocn, 'Sw_hstokes', mrg_from=compwav, mrg_fld='Sw_hstokes', mrg_type='copy') end if end if !----------------------------- ! to ocn: Partitioned stokes drift components in x-direction !----------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compwav)%fields, 'Sw_pstokes_x') - call addfld(fldListTo(compocn)%fields, 'Sw_pstokes_x') + call addfldFrom(compwav, 'Sw_pstokes_x') + call addFldTo(compocn, 'Sw_pstokes_x') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_pstokes_x', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_pstokes_x', rc=rc)) then - call addmap(fldListFr(compwav)%fields, 'Sw_pstokes_x', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) - call addmrg(fldListTo(compocn)%fields, 'Sw_pstokes_x', mrg_from=compwav, mrg_fld='Sw_pstokes_x', mrg_type='copy') + call addmapFrom(compwav, 'Sw_pstokes_x', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrgTo(compocn, 'Sw_pstokes_x', mrg_from=compwav, mrg_fld='Sw_pstokes_x', mrg_type='copy') end if end if !----------------------------- ! to ocn: Stokes drift depth from wave !----------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compwav)%fields, 'Sw_pstokes_y') - call addfld(fldListTo(compocn)%fields, 'Sw_pstokes_y') + call addfldFrom(compwav, 'Sw_pstokes_y') + call addFldTo(compocn, 'Sw_pstokes_y') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_pstokes_y', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_pstokes_y', rc=rc)) then - call addmap(fldListFr(compwav)%fields, 'Sw_pstokes_y', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) - call addmrg(fldListTo(compocn)%fields, 'Sw_pstokes_y', mrg_from=compwav, mrg_fld='Sw_pstokes_y', mrg_type='copy') + call addmapFrom(compwav, 'Sw_pstokes_y', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrgTo(compocn, 'Sw_pstokes_y', mrg_from=compwav, mrg_fld='Sw_pstokes_y', mrg_type='copy') end if end if @@ -2323,13 +2329,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: downward longwave heat flux from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_lwdn') - call addfld(fldListTo(compice)%fields, 'Faxa_lwdn') + call addFldFrom(compatm, 'Faxa_lwdn') + call addfldTo(compice, 'Faxa_lwdn') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_lwdn', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_lwdn', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Faxa_lwdn', mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_lwdn', compice, mapconsf, 'one', atm2ice_map) + call addmrgTo(compice, 'Faxa_lwdn', mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2339,43 +2345,43 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: downward Diffuse visible incident solar radiation from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_swndr') - call addfld(fldListTo(compice)%fields, 'Faxa_swndr') + call addFldFrom(compatm, 'Faxa_swndr') + call addfldTo(compice, 'Faxa_swndr') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_swndr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndr', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_swndr', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Faxa_swndr', mrg_from=compatm, mrg_fld='Faxa_swndr', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_swndr', compice, mapconsf, 'one', atm2ice_map) + call addmrgTo(compice, 'Faxa_swndr', mrg_from=compatm, mrg_fld='Faxa_swndr', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_swvdr') - call addfld(fldListTo(compice)%fields, 'Faxa_swvdr') + call addFldFrom(compatm, 'Faxa_swvdr') + call addfldTo(compice, 'Faxa_swvdr') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_swvdr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdr', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_swvdr', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Faxa_swvdr', mrg_from=compatm, mrg_fld='Faxa_swvdr', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_swvdr', compice, mapconsf, 'one', atm2ice_map) + call addmrgTo(compice, 'Faxa_swvdr', mrg_from=compatm, mrg_fld='Faxa_swvdr', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_swndf') - call addfld(fldListTo(compice)%fields, 'Faxa_swndf') + call addFldFrom(compatm, 'Faxa_swndf') + call addfldTo(compice, 'Faxa_swndf') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_swndf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndf', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_swndf', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Faxa_swndf', mrg_from=compatm, mrg_fld='Faxa_swndf', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_swndf', compice, mapconsf, 'one', atm2ice_map) + call addmrgTo(compice, 'Faxa_swndf', mrg_from=compatm, mrg_fld='Faxa_swndf', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_swvdf') - call addfld(fldListTo(compice)%fields, 'Faxa_swvdf') + call addFldFrom(compatm, 'Faxa_swvdf') + call addfldTo(compice, 'Faxa_swvdf') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_swvdf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdf', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_swvdf', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Faxa_swvdf', mrg_from=compatm, mrg_fld='Faxa_swvdf', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_swvdf', compice, mapconsf, 'one', atm2ice_map) + call addmrgTo(compice, 'Faxa_swvdf', mrg_from=compatm, mrg_fld='Faxa_swvdf', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2384,13 +2390,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: hydrophylic black carbon wet deposition flux from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_bcph') - call addfld(fldListTo(compice)%fields, 'Faxa_bcph') + call addFldFrom(compatm, 'Faxa_bcph') + call addfldTo(compice, 'Faxa_bcph') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_bcph', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_bcph', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_bcph', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Faxa_bcph', mrg_from=compatm, mrg_fld='Faxa_bcph', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_bcph', compice, mapconsf, 'one', atm2ice_map) + call addmrgTo(compice, 'Faxa_bcph', mrg_from=compatm, mrg_fld='Faxa_bcph', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2399,13 +2405,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: hydrophylic organic carbon wet deposition flux from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_ocph') - call addfld(fldListTo(compice)%fields, 'Faxa_ocph') + call addFldFrom(compatm, 'Faxa_ocph') + call addfldTo(compice, 'Faxa_ocph') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_ocph', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_ocph', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_ocph', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Faxa_ocph', mrg_from=compatm, mrg_fld='Faxa_ocph', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_ocph', compice, mapconsf, 'one', atm2ice_map) + call addmrgTo(compice, 'Faxa_ocph', mrg_from=compatm, mrg_fld='Faxa_ocph', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2415,13 +2421,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: dust wet deposition flux (size 4) from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_dstwet') - call addfld(fldListTo(compice)%fields, 'Faxa_dstwet') + call addFldFrom(compatm, 'Faxa_dstwet') + call addfldTo(compice, 'Faxa_dstwet') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_dstwet', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_dstwet', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_dstwet', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Faxa_dstwet', mrg_from=compatm, mrg_fld='Faxa_dstwet', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_dstwet', compice, mapconsf, 'one', atm2ice_map) + call addmrgTo(compice, 'Faxa_dstwet', mrg_from=compatm, mrg_fld='Faxa_dstwet', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2431,13 +2437,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: dust dry deposition flux (size 4) from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_dstdry') - call addfld(fldListTo(compice)%fields, 'Faxa_dstdry') + call addFldFrom(compatm, 'Faxa_dstdry') + call addfldTo(compice, 'Faxa_dstdry') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_dstdry', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_dstdry', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_dstdry', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Faxa_dstdry', mrg_from=compatm, mrg_fld='Faxa_dstdry', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_dstdry', compice, mapconsf, 'one', atm2ice_map) + call addmrgTo(compice, 'Faxa_dstdry', mrg_from=compatm, mrg_fld='Faxa_dstdry', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2445,83 +2451,83 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: rain and snow rate from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_rainc') - call addfld(fldListFr(compatm)%fields, 'Faxa_rainl') - call addfld(fldListFr(compatm)%fields, 'Faxa_rain' ) - call addfld(fldListTo(compice)%fields, 'Faxa_rain' ) + call addFldFrom(compatm, 'Faxa_rainc') + call addFldFrom(compatm, 'Faxa_rainl') + call addFldFrom(compatm, 'Faxa_rain' ) + call addfldTo(compice, 'Faxa_rain' ) else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_rainc', compice, mapconsf, 'one', atm2ice_map) - call addmap(fldListFr(compatm)%fields, 'Faxa_rainl', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', mrg_type='sum') + call addMapFrom(compatm, 'Faxa_rainc', compice, mapconsf, 'one', atm2ice_map) + call addMapFrom(compatm, 'Faxa_rainl', compice, mapconsf, 'one', atm2ice_map) + call addmrgTo(compice, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', mrg_type='sum') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_rain', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rain', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_rain', compice, mapconsf, 'one', atm2ice_map) + call addmrgTo(compice, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rain', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_snowc') - call addfld(fldListFr(compatm)%fields, 'Faxa_snowl') - call addfld(fldListFr(compatm)%fields, 'Faxa_snow' ) - call addfld(fldListTo(compice)%fields, 'Faxa_snow' ) + call addFldFrom(compatm, 'Faxa_snowc') + call addFldFrom(compatm, 'Faxa_snowl') + call addFldFrom(compatm, 'Faxa_snow' ) + call addfldTo(compice, 'Faxa_snow' ) else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_snowc', compice, mapconsf, 'one', atm2ice_map) - call addmap(fldListFr(compatm)%fields, 'Faxa_snowl', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Faxa_snow' , & + call addMapFrom(compatm, 'Faxa_snowc', compice, mapconsf, 'one', atm2ice_map) + call addMapFrom(compatm, 'Faxa_snowl', compice, mapconsf, 'one', atm2ice_map) + call addmrgTo(compice, 'Faxa_snow' , & mrg_from=compatm, mrg_fld='Faxa_snowc:Faxa_snowl', mrg_type='sum') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_snow', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Faxa_snow', & + call addMapFrom(compatm, 'Faxa_snow', compice, mapconsf, 'one', atm2ice_map) + call addmrgTo(compice, 'Faxa_snow', & mrg_from=compatm, mrg_fld='Faxa_snow', mrg_type='copy') end if end if if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_rainc_wiso') - call addfld(fldListFr(compatm)%fields, 'Faxa_rainl_wiso') - call addfld(fldListFr(compatm)%fields, 'Faxa_rain_wiso' ) - call addfld(fldListTo(compice)%fields, 'Faxa_rain_wiso' ) + call addFldFrom(compatm, 'Faxa_rainc_wiso') + call addFldFrom(compatm, 'Faxa_rainl_wiso') + call addFldFrom(compatm, 'Faxa_rain_wiso' ) + call addfldTo(compice, 'Faxa_rain_wiso' ) else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain_wiso' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_rainc_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmap(fldListFr(compatm)%fields, 'Faxa_rainl_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Faxa_rain_wiso' , & + call addMapFrom(compatm, 'Faxa_rainc_wiso', compice, mapconsf, 'one', atm2ice_map) + call addMapFrom(compatm, 'Faxa_rainl_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmrgTo(compice, 'Faxa_rain_wiso' , & mrg_from=compatm, mrg_fld='Faxa_rainc_wiso:Faxa_rainl_wiso', mrg_type='sum') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_rain_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Faxa_rain_wiso', & + call addMapFrom(compatm, 'Faxa_rain_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmrgTo(compice, 'Faxa_rain_wiso', & mrg_from=compatm, mrg_fld='Faxa_rain_wiso', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Faxa_snowc_wiso') - call addfld(fldListFr(compatm)%fields, 'Faxa_snowl_wiso') - call addfld(fldListFr(compatm)%fields, 'Faxa_snow_wiso' ) - call addfld(fldListTo(compice)%fields, 'Faxa_snow_wiso' ) + call addFldFrom(compatm, 'Faxa_snowc_wiso') + call addFldFrom(compatm, 'Faxa_snowl_wiso') + call addFldFrom(compatm, 'Faxa_snow_wiso' ) + call addfldTo(compice, 'Faxa_snow_wiso' ) else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_snowc_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmap(fldListFr(compatm)%fields, 'Faxa_snowl_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Faxa_snow_wiso' , & + call addMapFrom(compatm, 'Faxa_snowc_wiso', compice, mapconsf, 'one', atm2ice_map) + call addMapFrom(compatm, 'Faxa_snowl_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmrgTo(compice, 'Faxa_snow_wiso' , & mrg_from=compatm, mrg_fld='Faxa_snowc_wiso:Faxa_snowl_wiso', mrg_type='sum') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Faxa_snow_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Faxa_snow_wiso', mrg_from=compatm, mrg_fld='Faxa_snow_wiso', mrg_type='copy') + call addMapFrom(compatm, 'Faxa_snow_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmrgTo(compice, 'Faxa_snow_wiso', mrg_from=compatm, mrg_fld='Faxa_snow_wiso', mrg_type='copy') end if end if end if @@ -2530,65 +2536,65 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: height at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_z') - call addfld(fldListTo(compice)%fields, 'Sa_z') + call addFldFrom(compatm, 'Sa_z') + call addfldTo(compice, 'Sa_z') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_z', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_z', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_z', compice, mapbilnr, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Sa_z', mrg_from=compatm, mrg_fld='Sa_z', mrg_type='copy') + call addMapFrom(compatm, 'Sa_z', compice, mapbilnr, 'one', atm2ice_map) + call addmrgTo(compice, 'Sa_z', mrg_from=compatm, mrg_fld='Sa_z', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to ice: pressure at the lowest model level fromatm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_pbot') - call addfld(fldListTo(compice)%fields, 'Sa_pbot') + call addFldFrom(compatm, 'Sa_pbot') + call addfldTo(compice, 'Sa_pbot') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_pbot', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_pbot', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_pbot', compice, mapbilnr, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Sa_pbot', mrg_from=compatm, mrg_fld='Sa_pbot', mrg_type='copy') + call addMapFrom(compatm, 'Sa_pbot', compice, mapbilnr, 'one', atm2ice_map) + call addmrgTo(compice, 'Sa_pbot', mrg_from=compatm, mrg_fld='Sa_pbot', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to ice: temperature at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_tbot') - call addfld(fldListTo(compice)%fields, 'Sa_tbot') + call addFldFrom(compatm, 'Sa_tbot') + call addfldTo(compice, 'Sa_tbot') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_tbot', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_tbot', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_tbot', compice, mapbilnr, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') + call addMapFrom(compatm, 'Sa_tbot', compice, mapbilnr, 'one', atm2ice_map) + call addmrgTo(compice, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to ice: potential temperature at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_ptem') - call addfld(fldListTo(compice)%fields, 'Sa_ptem') + call addFldFrom(compatm, 'Sa_ptem') + call addfldTo(compice, 'Sa_ptem') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_ptem', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_ptem', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_ptem', compice, mapbilnr, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Sa_ptem', mrg_from=compatm, mrg_fld='Sa_ptem', mrg_type='copy') + call addMapFrom(compatm, 'Sa_ptem', compice, mapbilnr, 'one', atm2ice_map) + call addmrgTo(compice, 'Sa_ptem', mrg_from=compatm, mrg_fld='Sa_ptem', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to ice: density at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_dens') - call addfld(fldListTo(compice)%fields, 'Sa_dens') + call addFldFrom(compatm, 'Sa_dens') + call addfldTo(compice, 'Sa_dens') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_dens', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_dens', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_dens', compice, mapbilnr, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Sa_dens', mrg_from=compatm, mrg_fld='Sa_dens', mrg_type='copy') + call addMapFrom(compatm, 'Sa_dens', compice, mapbilnr, 'one', atm2ice_map) + call addmrgTo(compice, 'Sa_dens', mrg_from=compatm, mrg_fld='Sa_dens', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2596,31 +2602,31 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: meridional wind at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_u') - call addfld(fldListTo(compice)%fields, 'Sa_u') + call addFldFrom(compatm, 'Sa_u') + call addfldTo(compice, 'Sa_u') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_u', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_u', rc=rc)) then if (mapuv_with_cart3d) then - call addmap(fldListFr(compatm)%fields, 'Sa_u', compice, mappatch_uv3d, 'one', atm2ice_map) + call addMapFrom(compatm, 'Sa_u', compice, mappatch_uv3d, 'one', atm2ice_map) else - call addmap(fldListFr(compatm)%fields, 'Sa_u', compice, mappatch, 'one', atm2ice_map) + call addMapFrom(compatm, 'Sa_u', compice, mappatch, 'one', atm2ice_map) end if - call addmrg(fldListTo(compice)%fields, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') + call addmrgTo(compice, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_v') - call addfld(fldListTo(compice)%fields, 'Sa_v') + call addFldFrom(compatm, 'Sa_v') + call addfldTo(compice, 'Sa_v') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_v', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_v', rc=rc)) then if (mapuv_with_cart3d) then - call addmap(fldListFr(compatm)%fields, 'Sa_v', compice, mappatch_uv3d, 'one', atm2ice_map) + call addMapFrom(compatm, 'Sa_v', compice, mappatch_uv3d, 'one', atm2ice_map) else - call addmap(fldListFr(compatm)%fields, 'Sa_v', compice, mappatch, 'one', atm2ice_map) + call addMapFrom(compatm, 'Sa_v', compice, mappatch, 'one', atm2ice_map) end if - call addmrg(fldListTo(compice)%fields, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') + call addmrgTo(compice, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2628,24 +2634,24 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: specific humidity for water isotopes at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_shum') - call addfld(fldListTo(compice)%fields, 'Sa_shum') + call addFldFrom(compatm, 'Sa_shum') + call addfldTo(compice, 'Sa_shum') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_shum', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_shum', compice, mapbilnr, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Sa_shum', mrg_from=compatm, mrg_fld='Sa_shum', mrg_type='copy') + call addMapFrom(compatm, 'Sa_shum', compice, mapbilnr, 'one', atm2ice_map) + call addmrgTo(compice, 'Sa_shum', mrg_from=compatm, mrg_fld='Sa_shum', mrg_type='copy') end if end if if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_shum_wiso') - call addfld(fldListTo(compice)%fields, 'Sa_shum_wiso') + call addFldFrom(compatm, 'Sa_shum_wiso') + call addfldTo(compice, 'Sa_shum_wiso') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_shum_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_shum_wiso', compice, mapbilnr, 'one', atm2ice_map) - call addmrg(fldListTo(compice)%fields, 'Sa_shum_wiso', mrg_from=compatm, mrg_fld='Sa_shum_wiso', mrg_type='copy') + call addMapFrom(compatm, 'Sa_shum_wiso', compice, mapbilnr, 'one', atm2ice_map) + call addmrgTo(compice, 'Sa_shum_wiso', mrg_from=compatm, mrg_fld='Sa_shum_wiso', mrg_type='copy') end if end if end if @@ -2654,26 +2660,26 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: sea surface temperature from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compocn)%fields, 'So_t') - call addfld(fldListTo(compice)%fields, 'So_t') + call addfldFrom(compocn, 'So_t') + call addfldTo(compice, 'So_t') else if ( fldchk(is_local%wrap%FBexp(compice) , 'So_t', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_t', rc=rc)) then - call addmap(fldListFr(compocn)%fields, 'So_t', compice, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compice)%fields, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + call addmapFrom(compocn, 'So_t', compice, mapfcopy , 'unset', 'unset') + call addmrgTo(compice, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to ice: sea surface salinity from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compocn)%fields, 'So_s') - call addfld(fldListTo(compice)%fields, 'So_s') + call addfldFrom(compocn, 'So_s') + call addfldTo(compice, 'So_s') else if ( fldchk(is_local%wrap%FBexp(compice) , 'So_s', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_s', rc=rc)) then - call addmap(fldListFr(compocn)%fields, 'So_s', compice, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compice)%fields, 'So_s', mrg_from=compocn, mrg_fld='So_s', mrg_type='copy') + call addmapFrom(compocn, 'So_s', compice, mapfcopy , 'unset', 'unset') + call addmrgTo(compice, 'So_s', mrg_from=compocn, mrg_fld='So_s', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2681,23 +2687,23 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: meridional sea water velocity from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compocn)%fields, 'So_u') - call addfld(fldListTo(compice)%fields, 'So_u') + call addfldFrom(compocn, 'So_u') + call addfldTo(compice, 'So_u') else if ( fldchk(is_local%wrap%FBexp(compice) , 'So_u', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_u', rc=rc)) then - call addmap(fldListFr(compocn)%fields, 'So_u', compice, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compice)%fields, 'So_u', mrg_from=compocn, mrg_fld='So_u', mrg_type='copy') + call addmapFrom(compocn, 'So_u', compice, mapfcopy , 'unset', 'unset') + call addmrgTo(compice, 'So_u', mrg_from=compocn, mrg_fld='So_u', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compocn)%fields, 'So_v') - call addfld(fldListTo(compice)%fields, 'So_v') + call addfldFrom(compocn, 'So_v') + call addfldTo(compice, 'So_v') else if ( fldchk(is_local%wrap%FBexp(compice) , 'So_v', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_v', rc=rc)) then - call addmap(fldListFr(compocn)%fields, 'So_v', compice, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compice)%fields, 'So_v', mrg_from=compocn, mrg_fld='So_v', mrg_type='copy') + call addmapFrom(compocn, 'So_v', compice, mapfcopy , 'unset', 'unset') + call addmrgTo(compice, 'So_v', mrg_from=compocn, mrg_fld='So_v', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2705,36 +2711,36 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: meridional sea surface slope from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compocn)%fields, 'So_dhdx') - call addfld(fldListTo(compice)%fields, 'So_dhdx') + call addfldFrom(compocn, 'So_dhdx') + call addfldTo(compice, 'So_dhdx') else if ( fldchk(is_local%wrap%FBexp(compice) , 'So_dhdx', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_dhdx', rc=rc)) then - call addmap(fldListFr(compocn)%fields, 'So_dhdx', compice, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compice)%fields, 'So_dhdx', mrg_from=compocn, mrg_fld='So_dhdx', mrg_type='copy') + call addmapFrom(compocn, 'So_dhdx', compice, mapfcopy , 'unset', 'unset') + call addmrgTo(compice, 'So_dhdx', mrg_from=compocn, mrg_fld='So_dhdx', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compocn)%fields, 'So_dhdy') - call addfld(fldListTo(compice)%fields, 'So_dhdy') + call addfldFrom(compocn, 'So_dhdy') + call addfldTo(compice, 'So_dhdy') else if ( fldchk(is_local%wrap%FBexp(compice) , 'So_dhdy', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_dhdy', rc=rc)) then - call addmap(fldListFr(compocn)%fields, 'So_dhdy', compice, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compice)%fields, 'So_dhdy', mrg_from=compocn, mrg_fld='So_dhdy', mrg_type='copy') + call addmapFrom(compocn, 'So_dhdy', compice, mapfcopy , 'unset', 'unset') + call addmrgTo(compice, 'So_dhdy', mrg_from=compocn, mrg_fld='So_dhdy', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to ice: ocean melt and freeze potential from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compocn)%fields, 'Fioo_q') - call addfld(fldListTo(compice)%fields, 'Fioo_q') + call addfldFrom(compocn, 'Fioo_q') + call addfldTo(compice, 'Fioo_q') else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'Fioo_q', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compice) , 'Fioo_q', rc=rc)) then - call addmap(fldListFr(compocn)%fields, 'Fioo_q', compice, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compice)%fields, 'Fioo_q', mrg_from=compocn, mrg_fld='Fioo_q', mrg_type='copy') + call addmapFrom(compocn, 'Fioo_q', compice, mapfcopy, 'unset', 'unset') + call addmrgTo(compice, 'Fioo_q', mrg_from=compocn, mrg_fld='Fioo_q', mrg_type='copy') end if end if !----------------------------- @@ -2742,13 +2748,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------- if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(compocn)%fields, 'So_roce_wiso') - call addfld(fldListTo(compice)%fields, 'So_roce_wiso') + call addfldFrom(compocn, 'So_roce_wiso') + call addfldTo(compice, 'So_roce_wiso') else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_roce_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compice) , 'So_roce_wiso', rc=rc)) then - call addmap(fldListFr(compocn)%fields, 'So_roce_wiso', compice, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compice)%fields, 'So_roce_wiso', mrg_from=compocn, mrg_fld='So_roce_wiso', mrg_type='copy') + call addmapFrom(compocn, 'So_roce_wiso', compice, mapfcopy, 'unset', 'unset') + call addmrgTo(compice, 'So_roce_wiso', mrg_from=compocn, mrg_fld='So_roce_wiso', mrg_type='copy') end if end if end if @@ -2757,43 +2763,43 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: frozen runoff from rof and glc ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(comprof)%fields, 'Firr_rofi') ! water flux into sea ice due to runoff (frozen) + call addfldFrom(comprof, 'Firr_rofi') ! water flux into sea ice due to runoff (frozen) do ns = 1, is_local%wrap%num_icesheets - call addfld(fldListFr(compglc(ns))%fields, 'Figg_rofi') ! glc frozen runoff_iceberg flux to ice + call addfldFrom(compglc(ns), 'Figg_rofi') ! glc frozen runoff_iceberg flux to ice end do - call addfld(fldListTo(compice)%fields, 'Fixx_rofi') ! total frozen water flux into sea ice + call addfldTo(compice, 'Fixx_rofi') ! total frozen water flux into sea ice else if ( fldchk(is_local%wrap%FBExp(compice), 'Fixx_rofi', rc=rc)) then if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi', rc=rc)) then - call addmap(fldListFr(comprof)%fields, 'Forr_rofi', compice, mapconsf, 'none', rof2ocn_ice_rmap) - call addmrg(fldListTo(compice)%fields, 'Fixx_rofi', mrg_from=comprof, mrg_fld='Firr_rofi', mrg_type='sum') + call addmapFrom(comprof, 'Forr_rofi', compice, mapconsf, 'none', rof2ocn_ice_rmap) + call addmrgTo(compice, 'Fixx_rofi', mrg_from=comprof, mrg_fld='Firr_rofi', mrg_type='sum') end if do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Figg_rofi', rc=rc)) then - call addmap(fldListFr(compglc(ns))%fields, 'Figg_rofi', compice, mapconsf, 'one' , glc2ice_rmap) - call addmrg(fldListTo(compice)%fields, 'Fixx_rofi', mrg_from=compglc(ns), mrg_fld='Figg_rofi', mrg_type='sum') + call addmapFrom(compglc(ns), 'Figg_rofi', compice, mapconsf, 'one' , glc2ice_rmap) + call addmrgTo(compice, 'Fixx_rofi', mrg_from=compglc(ns), mrg_fld='Figg_rofi', mrg_type='sum') end if end do end if end if if (flds_wiso) then if (phase == 'advertise') then - call addfld(fldListFr(comprof)%fields, 'Firr_rofi_wiso') ! water flux into sea ice due to runoff (frozen) + call addfldFrom(comprof, 'Firr_rofi_wiso') ! water flux into sea ice due to runoff (frozen) do ns = 1, is_local%wrap%num_icesheets - call addfld(fldListFr(compglc(ns))%fields, 'Figg_rofi_wiso') ! glc frozen runoff_iceberg flux to ice + call addfldFrom(compglc(ns), 'Figg_rofi_wiso') ! glc frozen runoff_iceberg flux to ice end do - call addfld(fldListTo(compice)%fields, 'Fixx_rofi_wiso') ! total frozen water flux into sea ice + call addfldTo(compice, 'Fixx_rofi_wiso') ! total frozen water flux into sea ice else if ( fldchk(is_local%wrap%FBExp(compice), 'Fixx_rofi_wiso', rc=rc)) then if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_wiso', rc=rc)) then - call addmap(fldListFr(comprof)%fields, 'Forr_rofi_wiso', compice, mapconsf, 'none', rof2ocn_ice_rmap) - call addmrg(fldListTo(compice)%fields, 'Fixx_rofi_wiso', & + call addmapFrom(comprof, 'Forr_rofi_wiso', compice, mapconsf, 'none', rof2ocn_ice_rmap) + call addmrgTo(compice, 'Fixx_rofi_wiso', & mrg_from=comprof, mrg_fld='Firr_rofi_wiso', mrg_type='sum') end if do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Figg_rofi_wiso', rc=rc)) then - call addmap(fldListFr(compglc(ns))%fields, 'Figg_rofi_wiso', compice, mapconsf, 'one' , glc2ice_rmap) - call addmrg(fldListTo(compice)%fields, 'Fixx_rofi_wiso', & + call addmapFrom(compglc(ns), 'Figg_rofi_wiso', compice, mapconsf, 'one' , glc2ice_rmap) + call addmrgTo(compice, 'Fixx_rofi_wiso', & mrg_from=compglc(ns), mrg_fld='Figg_rofi_wiso', mrg_type='sum') end if end do @@ -2806,13 +2812,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- if (wavice_coupling) then if (phase == 'advertise') then - call addfld(fldListFr(compwav)%fields, 'Sw_elevation_spectrum') - call addfld(fldListTo(compice)%fields, 'Sw_elevation_spectrum') + call addfldFrom(compwav, 'Sw_elevation_spectrum') + call addfldTo(compice, 'Sw_elevation_spectrum') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Sw_elevation_spectrum', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav,compwav), 'Sw_elevation_spectrum', rc=rc)) then - call addmap(fldListFr(compwav)%fields, 'Sw_elevation_spectrum', compice, mapbilnr, 'one', 'unset') - call addmrg(fldListTo(compice)%fields, 'Sw_elevation_spectrum', & + call addmapFrom(compwav, 'Sw_elevation_spectrum', compice, mapbilnr, 'one', 'unset') + call addmrgTo(compice, 'Sw_elevation_spectrum', & mrg_from=compwav, mrg_fld='Sw_elevation_spectrum', mrg_type='copy') end if end if @@ -2826,14 +2832,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to wav: fractional ice coverage wrt ocean from ice !---------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compice)%fields, 'Si_ifrac') - call addfld(fldListTo(compwav)%fields, 'Si_ifrac') + call addfldFrom(compice, 'Si_ifrac') + call addfldTo(compwav, 'Si_ifrac') else if ( fldchk(is_local%wrap%FBexp(compwav) , 'Si_ifrac', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_ifrac', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap(fldListFr(compice)%fields, 'Si_ifrac', compwav, mapbilnr, 'one', ice2wav_smap) - call addmrg(fldListTo(compwav)%fields, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') + call addMapFrom(compice, 'Si_ifrac', compwav, mapbilnr, 'one', ice2wav_smap) + call addmrgTo(compwav, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') end if end if !---------------------------------------------------------- @@ -2841,13 +2847,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !---------------------------------------------------------- if (wavice_coupling) then if (phase == 'advertise') then - call addfld(fldListFr(compice)%fields, 'Si_thick') - call addfld(fldListTo(compwav)%fields, 'Si_thick') + call addfldFrom(compice, 'Si_thick') + call addfldTo(compwav, 'Si_thick') else if (fldchk(is_local%wrap%FBexp(compwav) , 'Si_thick', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_thick', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Si_thick', compwav, mapbilnr, 'one', ice2wav_smap) - call addmrg(fldListTo(compwav)%fields, 'Si_thick', mrg_from=compice, mrg_fld='Si_thick', mrg_type='copy') + call addMapFrom(compice, 'Si_thick', compwav, mapbilnr, 'one', ice2wav_smap) + call addmrgTo(compwav, 'Si_thick', mrg_from=compice, mrg_fld='Si_thick', mrg_type='copy') end if end if end if @@ -2856,13 +2862,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !---------------------------------------------------------- if (wavice_coupling) then if (phase == 'advertise') then - call addfld(fldListFr(compice)%fields, 'Si_floediam') - call addfld(fldListTo(compwav)%fields, 'Si_floediam') + call addfldFrom(compice, 'Si_floediam') + call addfldTo(compwav, 'Si_floediam') else if (fldchk(is_local%wrap%FBexp(compwav) , 'Si_floediam', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_floediam', rc=rc)) then - call addmap(fldListFr(compice)%fields, 'Si_floediam', compwav, mapbilnr, 'one', ice2wav_smap) - call addmrg(fldListTo(compwav)%fields, 'Si_floediam', mrg_from=compice, mrg_fld='Si_floediam', mrg_type='copy') + call addMapFrom(compice, 'Si_floediam', compwav, mapbilnr, 'one', ice2wav_smap) + call addmrgTo(compwav, 'Si_floediam', mrg_from=compice, mrg_fld='Si_floediam', mrg_type='copy') end if end if end if @@ -2870,39 +2876,39 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to wav: ocean surface temperature from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compocn)%fields, 'So_t') - call addfld(fldListTo(compwav)%fields, 'So_t') + call addfldFrom(compocn, 'So_t') + call addfldTo(compwav, 'So_t') else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_t', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compwav) , 'So_t', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap(fldListFr(compocn)%fields, 'So_t', compwav, mapbilnr, 'one', ocn2wav_smap) - call addmrg(fldListTo(compwav)%fields, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + call addmapFrom(compocn, 'So_t', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmrgTo(compwav, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to wav: ocean currents from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compocn)%fields, 'So_u') - call addfld(fldListTo(compwav)%fields, 'So_u') + call addfldFrom(compocn, 'So_u') + call addfldTo(compwav, 'So_u') else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_u', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compwav) , 'So_u', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap(fldListFr(compocn)%fields, 'So_u', compwav, mapbilnr, 'one', ocn2wav_smap) - call addmrg(fldListTo(compwav)%fields, 'So_u', mrg_from=compocn, mrg_fld='So_u', mrg_type='copy') + call addmapFrom(compocn, 'So_u', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmrgTo(compwav, 'So_u', mrg_from=compocn, mrg_fld='So_u', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compocn)%fields, 'So_v') - call addfld(fldListTo(compwav)%fields, 'So_v') + call addfldFrom(compocn, 'So_v') + call addfldTo(compwav, 'So_v') else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_v', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compwav) , 'So_v', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap(fldListFr(compocn)%fields, 'So_v', compwav, mapbilnr, 'one', ocn2wav_smap) - call addmrg(fldListTo(compwav)%fields, 'So_v', mrg_from=compocn, mrg_fld='So_v', mrg_type='copy') + call addmapFrom(compocn, 'So_v', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmrgTo(compwav, 'So_v', mrg_from=compocn, mrg_fld='So_v', mrg_type='copy') end if end if @@ -2910,14 +2916,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to wav: ocean boundary layer depth from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compocn)%fields, 'So_bldepth') - call addfld(fldListTo(compwav)%fields, 'So_bldepth') + call addfldFrom(compocn, 'So_bldepth') + call addfldTo(compwav, 'So_bldepth') else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_bldepth', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compwav) , 'So_bldepth', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap(fldListFr(compocn)%fields, 'So_bldepth', compwav, mapbilnr, 'one', ocn2wav_smap) - call addmrg(fldListTo(compwav)%fields, 'So_bldepth', mrg_from=compocn, mrg_fld='So_bldepth', mrg_type='copy') + call addmapFrom(compocn, 'So_bldepth', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmrgTo(compwav, 'So_bldepth', mrg_from=compocn, mrg_fld='So_bldepth', mrg_type='copy') end if end if @@ -2925,23 +2931,23 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to wav: zonal and meridional winds at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_u') - call addfld(fldListTo(compwav)%fields, 'Sa_u') + call addFldFrom(compatm, 'Sa_u') + call addfldTo(compwav, 'Sa_u') else if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_u', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_u', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_u', compwav, mapbilnr, 'one', atm2wav_map) - call addmrg(fldListTo(compwav)%fields, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') + call addMapFrom(compatm, 'Sa_u', compwav, mapbilnr, 'one', atm2wav_map) + call addmrgTo(compwav, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_v') - call addfld(fldListTo(compwav)%fields, 'Sa_v') + call addFldFrom(compatm, 'Sa_v') + call addfldTo(compwav, 'Sa_v') else if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_v', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_v', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_v', compwav, mapbilnr, 'one', atm2wav_map) - call addmrg(fldListTo(compwav)%fields, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') + call addMapFrom(compatm, 'Sa_v', compwav, mapbilnr, 'one', atm2wav_map) + call addmrgTo(compwav, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') end if end if @@ -2949,13 +2955,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to wav: temperature at lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_tbot') - call addfld(fldListTo(compwav)%fields, 'Sa_tbot') + call addFldFrom(compatm, 'Sa_tbot') + call addfldTo(compwav, 'Sa_tbot') else if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_tbot', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_tbot', rc=rc)) then - call addmap(fldListFr(compatm)%fields, 'Sa_tbot', compwav, mapbilnr, 'one', atm2wav_map) - call addmrg(fldListTo(compwav)%fields, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') + call addMapFrom(compatm, 'Sa_tbot', compwav, mapbilnr, 'one', atm2wav_map) + call addmrgTo(compwav, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') end if end if @@ -2967,13 +2973,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to rof: water flux from land (liquid surface) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Flrl_rofsur') - call addfld(fldListTo(comprof)%fields, 'Flrl_rofsur') + call addFldFrom(complnd, 'Flrl_rofsur') + call addfldTo(comprof, 'Flrl_rofsur') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsur', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsur', rc=rc)) then - call addmap(fldListFr(complnd)%fields, 'Flrl_rofsur', comprof, mapconsf, 'lfrac', lnd2rof_map) - call addmrg(fldListTo(comprof)%fields, 'Flrl_rofsur', & + call addmapFrom(complnd, 'Flrl_rofsur', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrgTo(comprof, 'Flrl_rofsur', & mrg_from=complnd, mrg_fld='Flrl_rofsur', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if @@ -2982,13 +2988,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to rof: water flux from land (ice surface) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Flrl_rofi') - call addfld(fldListTo(comprof)%fields, 'Flrl_rofi') + call addFldFrom(complnd, 'Flrl_rofi') + call addfldTo(comprof, 'Flrl_rofi') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofi', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofi', rc=rc)) then - call addmap(fldListFr(complnd)%fields, 'Flrl_rofi', comprof, mapconsf, 'lfrac', lnd2rof_map) - call addmrg(fldListTo(comprof)%fields, 'Flrl_rofi', & + call addmapFrom(complnd, 'Flrl_rofi', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrgTo(comprof, 'Flrl_rofi', & mrg_from=complnd, mrg_fld='Flrl_rofi', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if @@ -2997,13 +3003,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to rof: water flux from land (liquid glacier, wetland, and lake) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Flrl_rofgwl') - call addfld(fldListTo(comprof)%fields, 'Flrl_rofgwl') + call addFldFrom(complnd, 'Flrl_rofgwl') + call addfldTo(comprof, 'Flrl_rofgwl') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofgwl', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofgwl', rc=rc)) then - call addmap(fldListFr(complnd)%fields, 'Flrl_rofgwl', comprof, mapconsf, 'lfrac', lnd2rof_map) - call addmrg(fldListTo(comprof)%fields, 'Flrl_rofgwl', & + call addmapFrom(complnd, 'Flrl_rofgwl', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrgTo(comprof, 'Flrl_rofgwl', & mrg_from=complnd, mrg_fld='Flrl_rofgwl', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if @@ -3012,13 +3018,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to rof: water flux from land (liquid subsurface) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Flrl_rofsub') - call addfld(fldListTo(comprof)%fields, 'Flrl_rofsub') + call addFldFrom(complnd, 'Flrl_rofsub') + call addfldTo(comprof, 'Flrl_rofsub') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsub', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsub', rc=rc)) then - call addmap(fldListFr(complnd)%fields, 'Flrl_rofsub', comprof, mapconsf, 'lfrac', lnd2rof_map) - call addmrg(fldListTo(comprof)%fields, 'Flrl_rofsub', & + call addmapFrom(complnd, 'Flrl_rofsub', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrgTo(comprof, 'Flrl_rofsub', & mrg_from=complnd, mrg_fld='Flrl_rofsub', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if @@ -3027,13 +3033,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to rof: irrigation flux from land (withdrawal from rivers) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Flrl_irrig') - call addfld(fldListTo(comprof)%fields, 'Flrl_irrig') + call addFldFrom(complnd, 'Flrl_irrig') + call addfldTo(comprof, 'Flrl_irrig') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_irrig', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_irrig', rc=rc)) then - call addmap(fldListFr(complnd)%fields, 'Flrl_irrig', comprof, mapconsf, 'lfrac', lnd2rof_map) - call addmrg(fldListTo(comprof)%fields, 'Flrl_irrig', & + call addmapFrom(complnd, 'Flrl_irrig', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrgTo(comprof, 'Flrl_irrig', & mrg_from=complnd, mrg_fld='Flrl_irrig', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if @@ -3053,25 +3059,25 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Note : Sl_topo is sent from lnd -> med, but is NOT sent to glc (only used for the remapping in the mediator) if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Sl_tsrf_elev') ! surface temperature of glacier (1->glc_nec+1) - call addfld(fldListFr(complnd)%fields, 'Sl_topo_elev') ! surface heights of glacier (1->glc_nec+1) - call addfld(fldListFr(complnd)%fields, 'Flgl_qice_elev') ! glacier ice flux (1->glc_nec+1) + call addFldFrom(complnd, 'Sl_tsrf_elev') ! surface temperature of glacier (1->glc_nec+1) + call addFldFrom(complnd, 'Sl_topo_elev') ! surface heights of glacier (1->glc_nec+1) + call addFldFrom(complnd, 'Flgl_qice_elev') ! glacier ice flux (1->glc_nec+1) do ns = 1,is_local%wrap%num_icesheets - call addfld(fldListTo(compglc(ns))%fields, 'Sl_tsrf') - call addfld(fldListTo(compglc(ns))%fields, 'Flgl_qice') + call addfldTo(compglc(ns), 'Sl_tsrf') + call addfldTo(compglc(ns), 'Flgl_qice') end do else ! custom mapping, accumulation and merging will be done in prep_glc_mod.F90 do ns = 1,is_local%wrap%num_icesheets if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Flgl_qice_elev', rc=rc)) then - call addmap(FldListFr(complnd)%fields, 'Flgl_qice_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') + call addmapFrom(complnd, 'Flgl_qice_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') end if if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Sl_tsrf_elev' , rc=rc)) then - call addmap(FldListFr(complnd)%fields, 'Sl_tsrf_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') + call addmapFrom(complnd, 'Sl_tsrf_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') end if if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Sl_topo_elev' , rc=rc)) then ! This is needed just for mappingn to glc - but is not sent as a field - call addmap(FldListFr(complnd)%fields, 'Sl_topo_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') + call addmapFrom(complnd, 'Sl_topo_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') end if end do end if @@ -3081,21 +3087,21 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------- if (is_local%wrap%ocn2glc_coupling) then if (phase == 'advertise') then - call addfld(fldListFr(compocn)%fields, 'So_t_depth') - call addfld(fldListFr(compocn)%fields, 'So_s_depth') + call addfldFrom(compocn, 'So_t_depth') + call addfldFrom(compocn, 'So_s_depth') do ns = 1,is_local%wrap%num_icesheets - call addfld(fldListTo(compglc(ns))%fields, 'So_t_depth') - call addfld(fldListTo(compglc(ns))%fields, 'So_s_depth') + call addfldTo(compglc(ns), 'So_t_depth') + call addfldTo(compglc(ns), 'So_s_depth') end do else ! custom mapping, accumulation and merging will be done in prep_glc_mod.F90 ! the following is used to create the route handle do ns = 1,is_local%wrap%num_icesheets if ( fldchk(is_local%wrap%FBImp(compocn,compocn) , 'So_t_depth', rc=rc)) then - call addmap(FldListFr(compocn)%fields, 'So_t_depth', compglc(ns), mapbilnr, 'none', 'unset') + call addmapFrom(compocn, 'So_t_depth', compglc(ns), mapbilnr, 'none', 'unset') end if if ( fldchk(is_local%wrap%FBImp(compocn,compocn) , 'So_s_depth', rc=rc)) then - call addmap(FldListFr(compocn)%fields, 'So_s_depth', compglc(ns), mapbilnr, 'none', 'unset') + call addmapFrom(compocn, 'So_s_depth', compglc(ns), mapbilnr, 'none', 'unset') end if end do end if @@ -3125,16 +3131,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd and ocn: prognostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_co2prog') - call addfld(fldListTo(complnd)%fields, 'Sa_co2prog') - call addfld(fldListTo(compocn)%fields, 'Sa_co2prog') + call addFldFrom(compatm, 'Sa_co2prog') + call addfldTo(complnd, 'Sa_co2prog') + call addFldTo(compocn, 'Sa_co2prog') else - call addmap(fldListFr(compatm)%fields, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) - call addmap(fldListFr(compatm)%fields, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) + call addMapFrom(compatm, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) - call addmrg(fldListTo(complnd)%fields, 'Sa_co2prog', & + call addmrgTo(complnd, 'Sa_co2prog', & mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - call addmrg(fldListTo(compocn)%fields, 'Sa_co2prog', & + call addmrgTo(compocn, 'Sa_co2prog', & mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') end if @@ -3142,16 +3148,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd and ocn: diagnostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_co2diag') - call addfld(fldListTo(complnd)%fields, 'Sa_co2diag') - call addfld(fldListTo(compocn)%fields, 'Sa_co2diag') + call addFldFrom(compatm, 'Sa_co2diag') + call addfldTo(complnd, 'Sa_co2diag') + call addFldTo(compocn, 'Sa_co2diag') else - call addmap(fldListFr(compatm)%fields, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) - call addmap(fldListFr(compatm)%fields, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) + call addMapFrom(compatm, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) - call addmrg(fldListTo(complnd)%fields, 'Sa_co2diag', & + call addmrgTo(complnd, 'Sa_co2diag', & mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - call addmrg(fldListTo(compocn)%fields, 'Sa_co2diag', & + call addmrgTo(compocn, 'Sa_co2diag', & mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') end if @@ -3161,11 +3167,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: prognostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_co2prog') - call addfld(fldListTo(complnd)%fields, 'Sa_co2prog') + call addFldFrom(compatm, 'Sa_co2prog') + call addfldTo(complnd, 'Sa_co2prog') else - call addmap(fldListFr(compatm)%fields, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Sa_co2prog', & + call addMapFrom(compatm, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Sa_co2prog', & mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') end if @@ -3173,11 +3179,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: diagnostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_co2diag') - call addfld(fldListTo(complnd)%fields, 'Sa_co2diag') + call addFldFrom(compatm, 'Sa_co2diag') + call addfldTo(complnd, 'Sa_co2diag') else - call addmap(fldListFr(compatm)%fields, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%fields, 'Sa_co2diag', & + call addMapFrom(compatm, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrgTo(complnd, 'Sa_co2diag', & mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') end if @@ -3185,11 +3191,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: surface flux of CO2 from land ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Fall_fco2_lnd') - call addfld(fldListTo(compatm)%fields, 'Fall_fco2_lnd') + call addFldFrom(complnd, 'Fall_fco2_lnd') + call addfldTo(compatm, 'Fall_fco2_lnd') else - call addmap(fldListFr(complnd)%fields, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Fall_fco2_lnd', & + call addmapFrom(complnd, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) + call addmrgTo(compatm, 'Fall_fco2_lnd', & mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if @@ -3199,16 +3205,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd and ocn: prognostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_co2prog') - call addfld(fldListTo(complnd)%fields, 'Sa_co2prog') - call addfld(fldListTo(compocn)%fields, 'Sa_co2prog') + call addFldFrom(compatm, 'Sa_co2prog') + call addfldTo(complnd, 'Sa_co2prog') + call addFldTo(compocn, 'Sa_co2prog') else - call addmap(fldListFr(compatm)%fields, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) - call addmap(fldListFr(compatm)%fields, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) + call addMapFrom(compatm, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) - call addmrg(fldListTo(complnd)%fields, 'Sa_co2prog', & + call addmrgTo(complnd, 'Sa_co2prog', & mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - call addmrg(fldListTo(compocn)%fields, 'Sa_co2prog', & + call addmrgTo(compocn, 'Sa_co2prog', & mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') end if @@ -3216,16 +3222,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd and ocn: diagnostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%fields, 'Sa_co2diag') - call addfld(fldListTo(complnd)%fields, 'Sa_co2diag') - call addfld(fldListTo(compocn)%fields, 'Sa_co2diag') + call addFldFrom(compatm, 'Sa_co2diag') + call addfldTo(complnd, 'Sa_co2diag') + call addFldTo(compocn, 'Sa_co2diag') else - call addmap(fldListFr(compatm)%fields, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) - call addmap(fldListFr(compatm)%fields, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) + call addMapFrom(compatm, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) + call addMapFrom(compatm, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) - call addmrg(fldListTo(complnd)%fields, 'Sa_co2diag', & + call addmrgTo(complnd, 'Sa_co2diag', & mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - call addmrg(fldListTo(compocn)%fields, 'Sa_co2diag', & + call addmrgTo(compocn, 'Sa_co2diag', & mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') end if @@ -3233,11 +3239,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: surface flux of CO2 from land ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(complnd)%fields, 'Fall_fco2_lnd') - call addfld(fldListTo(compatm)%fields, 'Fall_fco2_lnd') + call addFldFrom(complnd, 'Fall_fco2_lnd') + call addfldTo(compatm, 'Fall_fco2_lnd') else - call addmap(fldListFr(complnd)%fields, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) - call addmrg(fldListTo(compatm)%fields, 'Fall_fco2_lnd', & + call addmapFrom(complnd, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) + call addmrgTo(compatm, 'Fall_fco2_lnd', & mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if @@ -3245,10 +3251,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: surface flux of CO2 from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compocn)%fields, 'Faoo_fco2_ocn') - call addfld(fldListTo(compatm)%fields, 'Faoo_fco2_ocn') + call addfldFrom(compocn, 'Faoo_fco2_ocn') + call addfldTo(compatm, 'Faoo_fco2_ocn') else - call addmap(fldListFr(compocn)%fields, 'Faoo_fco2_ocn', compatm, mapconsd, 'one', ocn2atm_map) + call addmapFrom(compocn, 'Faoo_fco2_ocn', compatm, mapconsd, 'one', ocn2atm_map) ! custom merge in med_phases_prep_atm end if endif diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index bfa23dc25..26eaf2e03 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -13,8 +13,6 @@ module esmFldsExchange_hafs_mod use med_internalstate_mod , only : compwav 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 @@ -88,7 +86,8 @@ end subroutine esmFldsExchange_hafs subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) - use esmFlds, only : addfld => med_fldList_AddFld + use esmFlds, only : addfldTo => med_fldList_AddFldTo + use esmFlds, only : addfldFrom => med_fldList_AddFldFrom ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -124,8 +123,8 @@ subroutine esmFldsExchange_hafs_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 addfldFrom(n, trim(cvalue)) + call addfldTo(n, trim(cvalue)) end do end if @@ -142,12 +141,12 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) !---------------------------------------------------------- ! to med: masks from components !---------------------------------------------------------- - call addfld(fldListFr(compocn)%flds, 'So_omask') + call addfldFrom(compocn, 'So_omask') !---------------------------------------------------------- ! to med: frac from components !---------------------------------------------------------- - call addfld(fldListTo(compatm)%flds, 'So_ofrac') + call addfldTo(compatm, 'So_ofrac') !===================================================================== ! FIELDS TO ATMOSPHERE @@ -161,8 +160,8 @@ subroutine esmFldsExchange_hafs_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 addfldFrom(compocn, trim(fldname)) + call addfldTo(compatm, trim(fldname)) end do deallocate(S_flds) end if @@ -175,8 +174,8 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) S_flds = (/'Sw_z0'/) ! wave_z0_roughness_length do n = 1,size(S_flds) fldname = trim(S_flds(n)) - call addfld(fldListFr(compwav)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) + call addfldFrom(compwav, trim(fldname)) + call addfldTo(compatm, trim(fldname)) end do deallocate(S_flds) end if @@ -198,8 +197,8 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) 'Sa_tskn' /) ! 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 addfldFrom(compatm, trim(fldname)) + call addfldTo(compocn, trim(fldname)) end do deallocate(S_flds) end if @@ -219,8 +218,8 @@ subroutine esmFldsExchange_hafs_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 addfldFrom(compatm, trim(fldname1)) + call addfldTo(compocn, trim(fldname2)) end do deallocate(F_flds) end if @@ -237,8 +236,8 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) S_flds = (/'Sa_u10m', 'Sa_v10m'/) do n = 1,size(S_flds) fldname = trim(S_flds(n)) - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(compwav)%flds, trim(fldname)) + call addfldFrom(compatm, trim(fldname)) + call addfldTo(compwav, trim(fldname)) end do deallocate(S_flds) end if @@ -298,9 +297,8 @@ subroutine esmFldsExchange_hafs_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 + use esmFlds , only : addmapFrom => med_fldList_AddMapFrom + use esmFlds , only : addmrgTo => med_fldList_AddMrgTo ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -371,9 +369,9 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) 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(fldListFr(compocn)%flds, trim(fldname), compatm, & + call addmapFrom(compocn, trim(fldname), compatm, & mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%ocn2atm_smap) - call addmrg(fldListTo(compatm)%flds, trim(fldname), & + call addmrgTo(compatm, trim(fldname), & mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') end if end do @@ -391,9 +389,9 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav,compwav),trim(fldname),rc=rc) & ) then - call addmap(fldListFr(compwav)%flds, trim(fldname), compatm, & + call addmapFrom(compwav, trim(fldname), compatm, & mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%wav2atm_smap) - call addmrg(fldListTo(compatm)%flds, trim(fldname), & + call addmrgTo(compatm, trim(fldname), & mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') end if end do @@ -420,9 +418,9 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) 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, & + call addmapFrom(compatm, trim(fldname), compocn, & mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) - call addmrg(fldListTo(compocn)%flds, trim(fldname), & + call addmrgTo(compocn, trim(fldname), & mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') end if end do @@ -447,9 +445,9 @@ subroutine esmFldsExchange_hafs_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, & + call addmapFrom(compatm, trim(fldname1), compocn, & mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) - call addmrg(fldListTo(compocn)%flds, trim(fldname2), & + call addmrgTo(compocn, trim(fldname2), & mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') end if end do @@ -471,9 +469,9 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compwav),trim(fldname),rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname),rc=rc) & ) then - call addmap(fldListFr(compatm)%flds, trim(fldname), compwav, & + call addmapFrom(compatm, trim(fldname), compwav, & mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2wav_smap) - call addmrg(fldListTo(compwav)%flds, trim(fldname), & + call addmrgTo(compwav, trim(fldname), & mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') end if end do diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 6424da65b..a17461592 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -33,10 +33,13 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use med_internalstate_mod , only : mapconsf_aofrac, mapbilnr_nstod use med_internalstate_mod , only : coupling_mode, mapnames use esmFlds , only : med_fldList_type - use esmFlds , only : addfld => med_fldList_AddFld - use esmFlds , only : addmap => med_fldList_AddMap - use esmFlds , only : addmrg => med_fldList_AddMrg - use esmflds , only : fldListTo, fldListFr, fldListMed_aoflux, fldListMed_ocnalb + use esmFlds , only : addfldTo => med_fldList_AddFldTo + use esmFlds , only : addmapTo => med_fldList_AddMapTo + use esmFlds , only : addmrgTo => med_fldList_AddMrgTo + use esmFlds , only : addfldFrom => med_fldList_AddFldFrom + use esmFlds , only : addmapFrom => med_fldList_AddMapFrom + use esmFlds , only : addmrgFrom => med_fldList_AddMrgFrom + use med_internalstate_mod , only : InternalState, mastertask, logunit ! input/output parameters: @@ -81,8 +84,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) 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)) + call addFldTo(n, trim(cvalue)) + call addfldFrom(n, trim(cvalue)) end do end if @@ -92,13 +95,13 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! masks from components if (phase == 'advertise') then - if (is_local%wrap%comp_present(compice)) call addfld(fldListFr(compice)%flds, 'Si_imask') - if (is_local%wrap%comp_present(compocn)) call addfld(fldListFr(compocn)%flds, 'So_omask') - if (is_local%wrap%comp_present(complnd)) call addfld(fldListFr(complnd)%flds, 'Sl_lfrin') + if (is_local%wrap%comp_present(compice)) call addfldFrom(compice, 'Si_imask') + if (is_local%wrap%comp_present(compocn)) call addfldFrom(compocn, 'So_omask') + if (is_local%wrap%comp_present(complnd)) call addFldFrom(complnd, 'Sl_lfrin') else 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, 'So_omask', compice, mapfcopy, 'unset', 'unset') + call addMapFrom(compocn, 'So_omask', compice, mapfcopy, 'unset', 'unset') end if end if @@ -111,11 +114,11 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) )then - call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfldFrom(compatm, trim(fldname)) end if else if ( fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'one', 'unset') + call addmapFrom(compatm, trim(fldname), compocn, maptype, 'one', 'unset') end if end if end do @@ -128,7 +131,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then - call addfld(fldListMed_aoflux%flds, trim(fldname)) + call addaofluxfld(trim(fldname)) end if end do deallocate(flds) @@ -143,11 +146,11 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) )then - call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfldFrom(compatm, trim(fldname)) end if else if ( fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'one', 'unset') + call addmapFrom(compatm, trim(fldname), compocn, maptype, 'one', 'unset') end if end if end do @@ -161,7 +164,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then - call addfld(fldListMed_aoflux%flds, trim(fldname)) + call addaofluxfld(trim(fldname)) end if end do deallocate(flds) @@ -169,7 +172,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! TODO: unused, but required to maintain B4B repro for mediator restarts; should be removed if (phase == 'advertise') then - call addfld(fldListFr(compice)%flds, 'mean_sw_pen_to_ocn') + call addfldFrom(compice, 'mean_sw_pen_to_ocn') end if !===================================================================== @@ -179,16 +182,16 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to atm: fractions (computed in med_phases_prep_atm) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm)) then - call addfld(fldListFr(compice)%flds, 'Si_ifrac') - call addfld(fldListTo(compatm)%flds, 'Si_ifrac') + call addfldFrom(compice, 'Si_ifrac') + call addfldTo(compatm, 'Si_ifrac') end if ! ofrac used by atm if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compatm)) then - call addfld(fldListFr(compatm)%flds, 'Sa_ofrac') + call addfldFrom(compatm, 'Sa_ofrac') end if ! lfrac used by atm if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%comp_present(compatm)) then - call addfld(fldListTo(compatm)%flds, 'Sl_lfrac') + call addfldTo(compatm, 'Sl_lfrac') end if end if @@ -208,14 +211,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm)) then - call addfld(fldListFr(compice)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) + call addfldFrom(compice, trim(fldname)) + call addfldTo(compatm, trim(fldname)) end if else 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(fldListFr(compice)%flds, trim(fldname), compatm, maptype, 'ifrac', 'unset') - call addmrg(fldListTo(compatm)%flds, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + call addmapFrom(compice, trim(fldname), compatm, maptype, 'ifrac', 'unset') + call addmrgTo(compatm, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') end if end if end do @@ -227,14 +230,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm)) then - call addfld(fldListFr(compice)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) + call addfldFrom(compice, trim(fldname)) + call addfldTo(compatm, trim(fldname)) end if else 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(fldListFr(compice)%flds, trim(fldname), compatm, maptype, 'ifrac', 'unset') - call addmrg(fldListTo(compatm)%flds, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + call addmapFrom(compice, trim(fldname), compatm, maptype, 'ifrac', 'unset') + call addmrgTo(compatm, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') end if end if end do @@ -243,28 +246,28 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to atm: unmerged surface temperatures from ocn if (phase == 'advertise') then if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compatm)) then - call addfld(fldListFr(compocn)%flds, 'So_t') - call addfld(fldListTo(compatm)%flds, 'So_t') + call addfldFrom(compocn, 'So_t') + call addfldTo(compatm, 'So_t') end if else if ( fldchk(is_local%wrap%FBexp(compatm) , 'So_t', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_t', rc=rc)) then - call addmap(fldListFr(compocn)%flds, 'So_t', compatm, maptype, 'ofrac', 'unset') - call addmrg(fldListTo(compatm)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + call addMapFrom(compocn, 'So_t', compatm, maptype, 'ofrac', 'unset') + call addmrgTo(compatm, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') end if end if ! to atm: unmerged surface temperatures from lnd if (phase == 'advertise') then if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%comp_present(compatm)) then - call addfld(fldListFr(complnd)%flds, 'Sl_t') - call addfld(fldListTo(compatm)%flds, 'Sl_t') + call addFldFrom(complnd, 'Sl_t') + call addfldTo(compatm, 'Sl_t') end if else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_t', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_t', rc=rc)) then - call addmap(fldListFr(complnd)%flds, 'Sl_t', compatm, maptype, 'lfrin', 'unset') - call addmrg(fldListTo(compatm)%flds, 'Sl_t', mrg_from=complnd, mrg_fld='Sl_t', mrg_type='copy') + call addmapFrom(complnd, 'Sl_t', compatm, maptype, 'lfrin', 'unset') + call addmrgTo(compatm, 'Sl_t', mrg_from=complnd, mrg_fld='Sl_t', mrg_type='copy') end if end if @@ -280,16 +283,16 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) flds = (/ 'lat ', 'sen ', 'lwup', 'taux', 'tauy' /) if (phase == 'advertise') then do n = 1,size(flds) - call addfld(fldListMed_aoflux%flds , 'Faox_'//trim(flds(n))) - call addfld(fldListTo(compatm)%flds, 'Faox_'//trim(flds(n))) + call addaofluxfld('Faox_'//trim(flds(n))) + call addfldTo(compatm, 'Faox_'//trim(flds(n))) end do else do n = 1,size(flds) if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_'//trim(flds(n)), rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap(fldListMed_aoflux%flds, 'Faox_'//trim(flds(n)), compatm, maptype, 'ofrac', 'unset') + call addaofluxmap('Faox_'//trim(flds(n)), compatm, maptype, 'ofrac', 'unset') end if - call addmrg(fldListTo(compatm)%flds, 'Faox_'//trim(flds(n)), mrg_from=compmed, mrg_fld='Faox_'//trim(flds(n)), mrg_type='copy') + call addmrgTo(compatm, 'Faox_'//trim(flds(n)), mrg_from=compmed, mrg_fld='Faox_'//trim(flds(n)), mrg_type='copy') end if end do end if @@ -300,14 +303,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to atm: surface roughness length from wav if (phase == 'advertise') then if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compatm)) then - call addfld(fldListFr(compwav)%flds, 'Sw_z0') - call addfld(fldListTo(compatm)%flds, 'Sw_z0') + call addfldFrom(compwav, 'Sw_z0') + call addfldTo(compatm, 'Sw_z0') end if else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sw_z0', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav,compwav), 'Sw_z0', rc=rc)) then - call addmap(fldListFr(compwav)%flds, 'Sw_z0', compatm, mapnstod_consf, 'one', 'unset') - call addmrg(fldListTo(compatm)%flds, 'Sw_z0', mrg_from=compwav, mrg_fld='Sw_z0', mrg_type='copy') + call addmapFrom(compwav, 'Sw_z0', compatm, mapnstod_consf, 'one', 'unset') + call addmrgTo(compatm, 'Sw_z0', mrg_from=compwav, mrg_fld='Sw_z0', mrg_type='copy') end if end if @@ -318,14 +321,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ocn: sea level pressure from atm if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld(fldListFr(compatm)%flds, 'Sa_pslv') - call addfld(fldListTo(compocn)%flds, 'Sa_pslv') + call addfldFrom(compatm, 'Sa_pslv') + call addFldTo(compocn, 'Sa_pslv') end if else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Sa_pslv', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_pslv', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, maptype, 'one', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Sa_pslv', mrg_from=compatm, mrg_fld='Sa_pslv', mrg_type='copy') + call addmapFrom(compatm, 'Sa_pslv', compocn, maptype, 'one', 'unset') + call addmrgTo(compocn, 'Sa_pslv', mrg_from=compatm, mrg_fld='Sa_pslv', mrg_type='copy') end if end if @@ -343,13 +346,13 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) do n = 1,size(oflds) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld(fldListFr(compatm)%flds, trim(aflds(n))) - call addfld(fldListTo(compocn)%flds, trim(oflds(n))) + call addfldFrom(compatm, trim(aflds(n))) + call addFldTo(compocn, trim(oflds(n))) end if else if ( fldchk(is_local%wrap%FBexp(compocn) , trim(oflds(n)), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), trim(aflds(n)), rc=rc)) then - call addmap(fldListFr(compatm)%flds, trim(aflds(n)), compocn, maptype, 'one', 'unset') + call addmapFrom(compatm, trim(aflds(n)), compocn, maptype, 'one', 'unset') end if end if end do @@ -357,13 +360,13 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) do n = 1,size(oflds) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then - call addfld(fldListFr(compice)%flds, trim(iflds(n))) - call addfld(fldListTo(compocn)%flds, trim(oflds(n))) + call addfldFrom(compice, trim(iflds(n))) + call addFldTo(compocn, trim(oflds(n))) end if else if ( fldchk(is_local%wrap%FBexp(compocn) , trim(oflds(n)), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), trim(iflds(n)), rc=rc)) then - call addmap(fldListFr(compice)%flds, trim(iflds(n)), compocn, mapfcopy, 'unset', 'unset') + call addmapFrom(compice, trim(iflds(n)), compocn, mapfcopy, 'unset', 'unset') end if end if end do @@ -378,14 +381,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(compocn)%flds, trim(fldname)) + call addfldFrom(compatm, trim(fldname)) + call addFldTo(compocn, trim(fldname)) end if else 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, maptype, 'one', 'unset') - call addmrg(fldListTo(compocn)%flds, trim(fldname), & + call addmapFrom(compatm, trim(fldname), compocn, maptype, 'one', 'unset') + call addmrgTo(compocn, trim(fldname), & mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if @@ -405,16 +408,16 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm) & .and. is_local%wrap%comp_present(compocn)) then - call addfld(fldListFr(compice)%flds, trim(iflds(n))) - call addfld(fldListFr(compatm)%flds, trim(aflds(n))) - call addfld(fldListTo(compocn)%flds, trim(oflds(n))) + call addfldFrom(compice, trim(iflds(n))) + call addfldFrom(compatm, trim(aflds(n))) + call addFldTo(compocn, trim(oflds(n))) end if else if ( fldchk(is_local%wrap%FBexp(compocn) , trim(oflds(n)), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), trim(iflds(n)), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), trim(aflds(n)), rc=rc)) then - call addmap(fldListFr(compice)%flds, trim(iflds(n)), compocn, mapfcopy, 'unset', 'unset') - call addmap(fldListFr(compatm)%flds, trim(aflds(n)), compocn, mapconsf_aofrac, 'aofrac', 'unset') + call addmapFrom(compice, trim(iflds(n)), compocn, mapfcopy, 'unset', 'unset') + call addmapFrom(compatm, trim(aflds(n)), compocn, mapconsf_aofrac, 'aofrac', 'unset') end if end if end do @@ -425,14 +428,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ocn: net long wave via auto merge if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld(fldListFr(compatm)%flds, 'Faxa_lwnet') - call addfld(fldListTo(compocn)%flds, 'Faxa_lwnet') + call addfldFrom(compatm, 'Faxa_lwnet') + call addFldTo(compocn, 'Faxa_lwnet') end if else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_lwnet', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwnet', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_lwnet', compocn, mapconsf_aofrac, 'aofrac', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Faxa_lwnet', & + call addmapFrom(compatm, 'Faxa_lwnet', compocn, mapconsf_aofrac, 'aofrac', 'unset') + call addmrgTo(compocn, 'Faxa_lwnet', & mrg_from=compatm, mrg_fld='Faxa_lwnet', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if @@ -440,26 +443,26 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ocn: merged sensible heat flux (custom merge in med_phases_prep_ocn) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld(fldListFr(compatm)%flds, 'Faxa_sen') - call addfld(fldListTo(compocn)%flds, 'Faxa_sen') + call addfldFrom(compatm, 'Faxa_sen') + call addFldTo(compocn, 'Faxa_sen') end if else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_sen', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_sen', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_sen', compocn, mapconsf_aofrac, 'aofrac', 'unset') + call addmapFrom(compatm, 'Faxa_sen', compocn, mapconsf_aofrac, 'aofrac', 'unset') end if end if ! to ocn: evaporation water flux (custom merge in med_phases_prep_ocn) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld(fldListFr(compatm)%flds, 'Faxa_lat') - call addfld(fldListTo(compocn)%flds, 'Faxa_evap') + call addfldFrom(compatm, 'Faxa_lat') + call addFldTo(compocn, 'Faxa_evap') end if else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_evap', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lat' , rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, mapconsf_aofrac, 'aofrac', 'unset') + call addmapFrom(compatm, 'Faxa_lat', compocn, mapconsf_aofrac, 'aofrac', 'unset') end if end if else if (trim(coupling_mode) == 'nems_orig_data' .or. trim(coupling_mode) == 'nems_frac_aoflux') then @@ -470,18 +473,18 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) do n = 1,size(flds) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then - call addfld(fldListMed_aoflux%flds , 'Faox_'//trim(flds(n))) - call addfld(fldListFr(compice)%flds , 'Fioi_'//trim(flds(n))) - call addfld(fldListTo(compocn)%flds , 'Foxx_'//trim(flds(n))) + call addaofluxfld('Faox_'//trim(flds(n))) + call addfldFrom(compice , 'Fioi_'//trim(flds(n))) + call addFldTo(compocn , 'Foxx_'//trim(flds(n))) end if else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_'//trim(flds(n)), rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_'//trim(flds(n)), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_'//trim(flds(n)), rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Fioi_'//trim(flds(n)), compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Foxx_'//trim(flds(n)), & + call addmapFrom(compice, 'Fioi_'//trim(flds(n)), compocn, mapfcopy, 'unset', 'unset') + call addmrgTo(compocn, 'Foxx_'//trim(flds(n)), & mrg_from=compmed, mrg_fld='Faox_'//trim(flds(n)), mrg_type='merge', mrg_fracname='ofrac') - call addmrg(fldListTo(compocn)%flds, 'Foxx_'//trim(flds(n)), & + call addmrgTo(compocn, 'Foxx_'//trim(flds(n)), & mrg_from=compice, mrg_fld='Fioi_'//trim(flds(n)), mrg_type='merge', mrg_fracname='ifrac') end if end if @@ -491,18 +494,18 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ocn: long wave net via auto merge if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld(fldListMed_aoflux%flds , 'Faox_lwup') - call addfld(fldListFr(compatm)%flds, 'Faxa_lwdn') - call addfld(fldListTo(compocn)%flds, 'Foxx_lwnet') + call addaofluxfld('Faox_lwup') + call addfldFrom(compatm, 'Faxa_lwdn') + call addFldTo(compocn, 'Foxx_lwnet') end if else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_lwnet', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_lwup' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn' , rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_lwdn', compocn, maptype, 'one', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Foxx_lwnet', & + call addmapFrom(compatm, 'Faxa_lwdn', compocn, maptype, 'one', 'unset') + call addmrgTo(compocn, 'Foxx_lwnet', & mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') - call addmrg(fldListTo(compocn)%flds, 'Foxx_lwnet', & + call addmrgTo(compocn, 'Foxx_lwnet', & mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -510,13 +513,13 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ocn: sensible heat flux from mediator via auto merge if (phase == 'advertise') then if (is_local%wrap%comp_present(compocn)) then - call addfld(fldListMed_aoflux%flds , 'Faox_sen') - call addfld(fldListTo(compocn)%flds, 'Faox_sen') + call addaofluxfld('Faox_sen') + call addFldTo(compocn, 'Faox_sen') end if else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faox_sen', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_sen' , rc=rc)) then - call addmrg(fldListTo(compocn)%flds, 'Faox_sen', & + call addmrgTo(compocn, 'Faox_sen', & mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if @@ -524,13 +527,13 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ocn: evaporation water flux from mediator via auto merge if (phase == 'advertise') then if (is_local%wrap%comp_present(compocn)) then - call addfld(fldListMed_aoflux%flds , 'Faox_evap') - call addfld(fldListTo(compocn)%flds, 'Faox_evap') + call addaofluxfld('Faox_evap') + call addFldTo(compocn, 'Faox_evap') end if else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faox_evap', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_evap' , rc=rc)) then - call addmrg(fldListTo(compocn)%flds, 'Faox_evap', & + call addmrgTo(compocn, 'Faox_evap', & mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if @@ -545,14 +548,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then - call addfld(fldListFr(compice)%flds, trim(fldname)) - call addfld(fldListTo(compocn)%flds, trim(fldname)) + call addfldFrom(compice, trim(fldname)) + call addFldTo(compocn, trim(fldname)) end if else if ( fldchk(is_local%wrap%FBexp(compocn) , trim(fldname), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), trim(fldname), rc=rc)) then - call addmap(fldListFr(compice)%flds, trim(fldname), compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, trim(fldname), & + call addmapFrom(compice, trim(fldname), compocn, mapfcopy, 'unset', 'unset') + call addmrgTo(compocn, trim(fldname), & mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if @@ -567,14 +570,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compocn)) then - call addfld(fldListFr(compwav)%flds, trim(fldname)) - call addfld(fldListTo(compocn)%flds, trim(fldname)) + call addfldFrom(compwav, trim(fldname)) + call addFldTo(compocn, trim(fldname)) end if else if ( fldchk(is_local%wrap%FBexp(compocn) , trim(fldname), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav,compwav), trim(fldname), rc=rc)) then - call addmap(fldListFr(compwav)%flds, trim(fldname), compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, trim(fldname), mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') + call addmapFrom(compwav, trim(fldname), compocn, mapfcopy, 'unset', 'unset') + call addmrgTo(compocn, trim(fldname), mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') end if end if end do @@ -600,14 +603,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compice)) then - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(compice)%flds, trim(fldname)) + call addfldFrom(compatm, trim(fldname)) + call addFldTo(compice, trim(fldname)) end if else 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, maptype, 'one', 'unset') - call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + call addmapFrom(compatm, trim(fldname), compice, maptype, 'one', 'unset') + call addmrgTo(compice, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') end if end if end do @@ -627,14 +630,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compice)) then - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(compice)%flds, trim(fldname)) + call addfldFrom(compatm, trim(fldname)) + call addFldTo(compice, trim(fldname)) endif else 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, maptype, 'one', 'unset') - call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + call addmapFrom(compatm, trim(fldname), compice, maptype, 'one', 'unset') + call addmrgTo(compice, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') end if end if end do @@ -655,14 +658,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compice)) then - call addfld(fldListFr(compocn)%flds, trim(fldname)) - call addfld(fldListTo(compice)%flds, trim(fldname)) + call addfldFrom(compocn, trim(fldname)) + call addFldTo(compice, trim(fldname)) endif else 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') + call addMapFrom(compocn, trim(fldname), compice, mapfcopy , 'unset', 'unset') + call addmrgTo(compice, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') end if end if end do @@ -679,14 +682,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compwav)) then - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(compwav)%flds, trim(fldname)) + call addfldFrom(compatm, trim(fldname)) + call addfldTo(compwav, trim(fldname)) end if else if ( fldchk(is_local%wrap%FBexp(compwav) , trim(fldname), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap(fldListFr(compatm)%flds, trim(fldname), compwav, mapnstod_consf, 'one', 'unset') - call addmrg(fldListTo(compwav)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + call addmapFrom(compatm, trim(fldname), compwav, mapnstod_consf, 'one', 'unset') + call addmrgTo(compwav, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') end if end if end do @@ -695,14 +698,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to wav: sea ice fraction if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compwav)) then - call addfld(fldListFr(compice)%flds, 'Si_ifrac') - call addfld(fldListTo(compwav)%flds, 'Si_ifrac') + call addfldFrom(compice, 'Si_ifrac') + call addfldTo(compwav, 'Si_ifrac') end if else if ( fldchk(is_local%wrap%FBexp(compwav) , 'Si_ifrac', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), 'Si_ifrac', rc=rc)) then - call addmap(fldListFr(compice)%flds, 'Si_ifrac', compwav, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compwav)%flds, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') + call addmapFrom(compice, 'Si_ifrac', compwav, mapfcopy , 'unset', 'unset') + call addmrgTo(compwav, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') end if end if @@ -715,14 +718,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compwav)) then - call addfld(fldListFr(compocn)%flds, trim(fldname)) - call addfld(fldListTo(compwav)%flds, trim(fldname)) + call addfldFrom(compocn, trim(fldname)) + call addfldTo(compwav, trim(fldname)) end if else if ( fldchk(is_local%wrap%FBexp(compwav) , trim(fldname), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), trim(fldname), rc=rc)) then - call addmap(fldListFr(compocn)%flds, trim(fldname), compwav, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compwav)%flds, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + call addMapFrom(compocn, trim(fldname), compwav, mapfcopy , 'unset', 'unset') + call addmrgTo(compwav, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') end if end if end do @@ -753,14 +756,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(complnd)) then - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(complnd)%flds, trim(fldname)) + call addfldFrom(compatm, trim(fldname)) + call addfldTo(complnd, trim(fldname)) end if else if ( fldchk(is_local%wrap%FBexp(complnd) , trim(fldname), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap(fldListFr(compatm)%flds, trim(fldname), complnd, maptype, 'one', 'unset') - call addmrg(fldListTo(complnd)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + call addmapFrom(compatm, trim(fldname), complnd, maptype, 'one', 'unset') + call addmrgTo(complnd, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') end if end if end do diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index eec1df850..6b8142a0f 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -83,7 +83,8 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun use ESMF , only : ESMF_Mesh, ESMF_TYPEKIND_R8, ESMF_MESHLOC_ELEMENT use med_methods_mod , only : med_methods_FB_getFieldN, med_methods_FB_getNameN use med_constants_mod , only : czero => med_constants_czero - use esmFlds , only : fldListFr + use esmFlds , only : med_fldList_GetfldListFr, med_fldList_GetNumFlds, med_fldlist_type + use esmFlds , only : med_fldList_GetFldInfo use med_internalstate_mod , only : mapunset, compname, compocn, compatm use med_internalstate_mod , only : ncomps, nmappers, compname, mapnames, mapfcopy @@ -109,6 +110,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun real(R8), pointer :: dataptr(:) type(ESMF_Mesh) :: mesh_src type(ESMF_Mesh) :: mesh_dst + type(med_fldlist_type), pointer :: FldListFr character(len=*), parameter :: subname=' (module_med_map: RouteHandles_init) ' !----------------------------------------------------------- @@ -156,10 +158,11 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun end if ! Loop over fields - do nf = 1,size(fldListFr(n1)%flds) + fldListFr => med_fldList_getFldListFr(n1) + do nf = 1,med_fldList_GetNumFlds(fldlistFr) ! Determine the mapping type for mapping field nf from n1 to n2 - mapindex = fldListFr(n1)%flds(nf)%mapindex(n2) + call med_fldList_GetFldInfo(fldListFr, nf, compsrc=n2, mapindex=mapindex) if (mapindex /= mapunset) then ! determine if route handle has already been created @@ -169,7 +172,8 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun ! Create route handle for target mapindex if route handle is required ! (i.e. mapindex /= mapunset) and route handle has not already been created if (.not. mapexists) then - mapfile = trim(fldListFr(n1)%flds(nf)%mapfile(n2)) + !~ mapfile = trim(fldListFr%fields(nf)%mapfile(n2)) + call med_fldList_GetFldInfo(fldListFr, nf, compsrc=n2, mapfile=mapfile) call med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, & mapindex, is_local%wrap%rh(n1,n2,:), mapfile=trim(mapfile), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -177,6 +181,8 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun end if ! end if mapindex is mapunset end do ! loop over fields + + end if ! if coupling active end if ! if n1 not equal to n2 end do ! loop over n2 @@ -718,7 +724,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & ! input/output variables integer , intent(in) :: destcomp character(len=*) , intent(in) :: flds_scalar_name - type(med_fldList_entry_type) , pointer :: fldsSrc(:) ! array over mapping types + type(med_fldList_entry_type) , target :: fieldsSrc ! mapping types top of LL type(ESMF_FieldBundle) , intent(in) :: FBSrc type(ESMF_FieldBundle) , intent(inout) :: FBDst type(packed_data_type) , intent(inout) :: packed_data(:) ! array over mapping types @@ -792,14 +798,16 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & ! Loop over source field bundle do nf = 1, fieldCount ! Loop over the fldsSrc types - do ns = 1,size(fldsSrc) + numflds = med_fldlist_GetNumFlds(fldsSrc) + do ns = 1,numflds ! Note that fieldnamelist is an array of names for the source fields ! The assumption is that there is only one mapping normalization ! for any given mapping type - if ( fldsSrc(ns)%mapindex(destcomp) == mapindex .and. & - trim(fldsSrc(ns)%shortname) == trim(fieldnamelist(nf))) then + call med_fldList_GetFldInfo(fldsSrc, ns, compsrc=destcomp, shortname=shortname, mapindex=destindex) + if ( destindex == mapindex .and. & + trim(shortname) == trim(fieldnamelist(nf))) then ! Set the normalization to the input - packed_data(mapindex)%mapnorm = fldsSrc(ns)%mapnorm(destcomp) + call med_FldList_GetFldInfo(fldsSrc, ns, compsrc=destcomp, mapnorm=packed_data(mapindex)%mapnorm=mapnorm) if (mapnorm_mapindex == 'not_set') then mapnorm_mapindex = packed_data(mapindex)%mapnorm write(tmpstr,*)'Map type '//trim(mapnames(mapindex)) & diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 0d78bbed0..6b8f9c8a1 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -39,7 +39,7 @@ subroutine med_phases_prep_ice(gcomp, rc) use med_internalstate_mod , only : InternalState, logunit, mastertask use med_internalstate_mod , only : compatm, compice, compocn, comprof use med_internalstate_mod , only : coupling_mode - use esmFlds , only : fldListTo + use esmFlds , only : med_fldList_GetFldListTo use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -85,7 +85,8 @@ subroutine med_phases_prep_ice(gcomp, rc) is_local%wrap%FBExp(compice), & is_local%wrap%FBFrac(compice), & is_local%wrap%FBImp(:,compice), & - fldListTo(compice), rc=rc) + med_fldList_GetFldListTo(compice), & + rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Apply precipitation factor from ocean (that scales atm rain and snow to ice) if appropriate diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index ed1181f99..0ed527b8f 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -27,7 +27,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND - use esmFlds , only : fldListTo + use esmFlds , only : med_fldList_GetFldListTo use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag @@ -89,7 +89,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) is_local%wrap%FBExp(complnd), & is_local%wrap%FBFrac(complnd), & is_local%wrap%FBImp(:,complnd), & - fldListTo(complnd), rc=rc) + med_fldList_GetFldListTo(complnd), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//trim(subname)//' merge') diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 011b9a2b0..f332fbad0 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -80,7 +80,8 @@ subroutine med_phases_prep_rof_init(gcomp, rc) use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleGet, ESMF_FieldBundleAdd use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_TYPEKIND_R8 - use esmFlds , only : fldListFr, fldlistTo, med_fldlist_GetNumFlds, med_fldlist_getFldInfo + use esmFlds , only : med_fldList_GetfldListFr, med_fldList_GetfldlistTo, med_fldlist_GetNumFlds, med_fldlist_getFldInfo + use esmFlds , only : med_fldList_type use med_map_mod , only : med_map_packed_field_create ! input/output variables @@ -93,6 +94,7 @@ subroutine med_phases_prep_rof_init(gcomp, rc) type(ESMF_Mesh) :: mesh_l type(ESMF_Mesh) :: mesh_r type(ESMF_Field) :: lfield + type(med_fldList_type), pointer :: fldListTo character(len=CS), allocatable :: fldnames_temp(:) character(len=*),parameter :: subname=' (med_phases_prep_rof_init) ' !--------------------------------------- @@ -106,10 +108,11 @@ subroutine med_phases_prep_rof_init(gcomp, rc) ! Determine lnd2rof_flds (module variable) - note that fldListTo is set in esmFldsExchange_cesm.F90 ! Remove scalar field from lnd2rof_flds - nflds = med_fldlist_getnumflds(fldlistTo(comprof)) + fldListTo => med_fldList_GetfldlistTo(comprof) + nflds = med_fldlist_getnumflds(fldListTo) allocate(fldnames_temp(nflds)) do n = 1,nflds - call med_fldList_GetFldInfo(fldListTo(comprof), n, stdname=fldnames_temp(n)) + call med_fldList_GetFldInfo(fldListTo, n, stdname=fldnames_temp(n)) end do do n = 1,nflds if (trim(fldnames_temp(n)) == trim(is_local%wrap%flds_scalar_name)) then @@ -157,11 +160,11 @@ subroutine med_phases_prep_rof_init(gcomp, rc) call fldbun_reset(FBlndAccum2rof_r, value=0.0_r8, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return lndAccum2rof_cnt = 0 - + fldList = med_fldList_GetFldListFr(complnd) ! Create packed mapping from rof->lnd call med_map_packed_field_create(destcomp=comprof, & flds_scalar_name=is_local%wrap%flds_scalar_name, & - fldsSrc=fldListFr(complnd)%flds, & + fldsSrc=med_fldlist_getfldListFr(complnd), & FBSrc=FBLndAccum2rof_l, FBDst=FBLndAccum2rof_r, & packed_data=is_local%wrap%packed_data(complnd,comprof,:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index a1bd85c1b..4fdd630ea 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -17,7 +17,7 @@ module med_phases_prep_wav_mod use med_methods_mod , only : FB_average => med_methods_FB_average use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset - use esmFlds , only : fldListTo + use esmFlds , only : med_fldList_GetfldListTo use med_internalstate_mod , only : compwav use perf_mod , only : t_startf, t_stopf @@ -103,7 +103,7 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) is_local%wrap%FBExp(compwav), & is_local%wrap%FBFrac(compwav), & is_local%wrap%FBImp(:,compwav), & - fldListTo(compwav), rc=rc) + med_fldList_GetfldListTo(compwav), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! wave accumulator From fbb8ef5c0590af68defbd1faef95a227ec6be459 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Sat, 19 Nov 2022 14:38:39 -0700 Subject: [PATCH 128/395] save work --- mediator/med_map_mod.F90 | 12 +++++++----- mediator/med_phases_prep_rof_mod.F90 | 2 +- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 6b8142a0f..d2e5b3057 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -713,10 +713,10 @@ end function med_map_RH_is_created_RH1d !================================================================================ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & - fldsSrc, FBSrc, FBDst, packed_data, rc) + fieldsSrc, FBSrc, FBDst, packed_data, rc) use ESMF - use esmFlds , only : med_fldList_entry_type + use esmFlds , only : med_fldList_entry_type, med_fldList_getNumFlds use med_internalstate_mod , only : nmappers use med_internalstate_mod , only : ncomps, compatm, compice, compocn, compname, mapnames use med_internalstate_mod , only : packed_data_type @@ -743,6 +743,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & type(ESMF_Mesh) :: lmesh_src type(ESMF_Mesh) :: lmesh_dst integer :: mapindex + integer :: numFlds type(ESMF_Field), pointer :: fieldlist_src(:) type(ESMF_Field), pointer :: fieldlist_dst(:) character(CL), allocatable :: fieldNameList(:) @@ -798,16 +799,17 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & ! Loop over source field bundle do nf = 1, fieldCount ! Loop over the fldsSrc types - numflds = med_fldlist_GetNumFlds(fldsSrc) + + numflds = med_fldlist_GetNumFlds(fieldsSrc) do ns = 1,numflds ! Note that fieldnamelist is an array of names for the source fields ! The assumption is that there is only one mapping normalization ! for any given mapping type - call med_fldList_GetFldInfo(fldsSrc, ns, compsrc=destcomp, shortname=shortname, mapindex=destindex) + call med_fldList_GetFldInfo(fieldsSrc, ns, compsrc=destcomp, shortname=shortname, mapindex=destindex) if ( destindex == mapindex .and. & trim(shortname) == trim(fieldnamelist(nf))) then ! Set the normalization to the input - call med_FldList_GetFldInfo(fldsSrc, ns, compsrc=destcomp, mapnorm=packed_data(mapindex)%mapnorm=mapnorm) + call med_FldList_GetFldInfo(fieldsSrc, ns, compsrc=destcomp, mapnorm=packed_data(mapindex)%mapnorm=mapnorm) if (mapnorm_mapindex == 'not_set') then mapnorm_mapindex = packed_data(mapindex)%mapnorm write(tmpstr,*)'Map type '//trim(mapnames(mapindex)) & diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index f332fbad0..47430d685 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -164,7 +164,7 @@ subroutine med_phases_prep_rof_init(gcomp, rc) ! Create packed mapping from rof->lnd call med_map_packed_field_create(destcomp=comprof, & flds_scalar_name=is_local%wrap%flds_scalar_name, & - fldsSrc=med_fldlist_getfldListFr(complnd), & + fldsSrc=fldList, & FBSrc=FBLndAccum2rof_l, FBDst=FBLndAccum2rof_r, & packed_data=is_local%wrap%packed_data(complnd,comprof,:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 69f31b84bbbc76174a24e911be3a582345412fd7 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Sun, 20 Nov 2022 07:53:02 -0700 Subject: [PATCH 129/395] compiles now --- mediator/esmFlds.F90 | 26 ++++++++++++++++++++ mediator/esmFldsExchange_cesm_mod.F90 | 29 +++++++++++----------- mediator/esmFldsExchange_nems_mod.F90 | 4 ++- mediator/med.F90 | 35 +++++++++++++++------------ mediator/med_map_mod.F90 | 20 ++++++++------- mediator/med_phases_aofluxes_mod.F90 | 16 +++++++----- mediator/med_phases_post_glc_mod.F90 | 1 - mediator/med_phases_prep_atm_mod.F90 | 6 ++--- mediator/med_phases_prep_ocn_mod.F90 | 6 ++--- mediator/med_phases_prep_rof_mod.F90 | 14 +++++------ 10 files changed, 98 insertions(+), 59 deletions(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index 01c148b9a..018f164c7 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -21,6 +21,7 @@ module esmflds public :: med_fldList_AddMrgTo public :: med_fldList_AddOcnalbFld + public :: med_fldList_AddocnalbMap public :: med_fldList_AddaofluxFld public :: med_fldList_AddaofluxMap @@ -37,6 +38,8 @@ module esmflds public :: med_fldList_Document_Merging public :: med_fldList_GetFldListFr public :: med_fldList_GetFldListTo + public :: med_fldList_GetaofluxFldList + public :: med_fldList_GetocnalbFldList !----------------------------------------------- ! Types and instantiations that determine fields, mappings, mergings !----------------------------------------------- @@ -89,6 +92,18 @@ subroutine med_fldlist_init1() allocate(fldlistFr(ncomps)) end subroutine med_fldlist_init1 + function med_fldList_GetaofluxFldList() result(fldList) + type(med_fldList_type), pointer :: fldList + + fldList => fldListMed_aoflux + end function Med_FldList_GetaofluxFldList + + function med_fldList_GetocnalbFldList() result(fldList) + type(med_fldList_type), pointer :: fldList + + fldList => fldListMed_ocnalb + end function Med_FldList_GetocnalbFldList + function med_fldList_GetFldListFr(index) result(fldList) integer, intent(in) :: index type(med_fldList_type), pointer :: fldList @@ -341,6 +356,17 @@ subroutine med_fldList_AddaofluxMap(fldname, destcomp, maptype, mapnorm, mapfile end subroutine med_fldList_AddaofluxMap + subroutine med_fldList_AddocnalbMap(fldname, destcomp, maptype, mapnorm, mapfile) + character(len=*) , intent(in) :: fldname + integer , intent(in) :: destcomp + integer , intent(in) :: maptype + character(len=*) , intent(in) :: mapnorm + character(len=*), optional , intent(in) :: mapfile + + call med_fldList_AddMap(fldlistmed_ocnalb%fields, fldname, destcomp, maptype, mapnorm, mapfile) + + end subroutine med_fldList_AddocnalbMap + subroutine med_fldList_AddMap(fields, fldname, destcomp, maptype, mapnorm, mapfile) use ESMF, only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_LogWrite, ESMF_LOGMSG_INFO diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 652946ad0..e957ea699 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -81,6 +81,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) use esmFlds , only : addocnalbfld => med_fldList_AddocnalbFld use esmFlds , only : addaofluxfld => med_fldList_AddaofluxFld use esmFlds , only : addaofluxMap => med_fldList_AddaofluxMap + use esmFlds , only : addocnalbMap => med_fldList_AddocnalbMap use esmFlds , only : addfldTo => med_fldList_AddFldTo use esmFlds , only : addfldFrom => med_fldList_AddFldFrom @@ -803,7 +804,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=compice, mrg_fld='Si_avsdr', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_avsdr', rc=rc)) then - call addocnalpmap( 'So_avsdr', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addocnalbmap( 'So_avsdr', compatm, mapconsf, 'ofrac', ocn2atm_map) call addmrgTo(compatm, 'Sx_avsdr', & mrg_from=compmed, mrg_fld='So_avsdr', mrg_type='merge', mrg_fracname='ofrac') end if @@ -830,7 +831,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=compice, mrg_fld='Si_avsdf', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_avsdf', rc=rc)) then - call addocnalpmap( 'So_avsdf', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addocnalbmap( 'So_avsdf', compatm, mapconsf, 'ofrac', ocn2atm_map) call addmrgTo(compatm, 'Sx_avsdf', & mrg_from=compmed, mrg_fld='So_avsdf', mrg_type='merge', mrg_fracname='ofrac') end if @@ -857,7 +858,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=compice, mrg_fld='Si_anidr', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_anidr', rc=rc)) then - call addocnalpmap( 'So_anidr', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addocnalbmap( 'So_anidr', compatm, mapconsf, 'ofrac', ocn2atm_map) call addmrgTo(compatm, 'Sx_anidr', & mrg_from=compmed, mrg_fld='So_anidr', mrg_type='merge', mrg_fracname='ofrac') end if @@ -884,7 +885,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=compice, mrg_fld='Si_anidf', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_anidf', rc=rc)) then - call addocnalpmap( 'So_anidf', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addocnalbmap( 'So_anidf', compatm, mapconsf, 'ofrac', ocn2atm_map) call addmrgTo(compatm, 'Sx_anidf', & mrg_from=compmed, mrg_fld='So_anidf', mrg_type='merge', mrg_fracname='ofrac') end if @@ -1163,7 +1164,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfldTo(compatm, 'Faxx_tauy') call addFldFrom(complnd, 'Fall_tauy') call addfldFrom(compice, 'Faii_tauy') - call addaoflusFld( 'Faox_tauy') + call addaofluxFld( 'Faox_tauy') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_tauy', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_tauy', rc=rc)) then @@ -1190,7 +1191,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfldTo(compatm, 'Faxx_lat') call addFldFrom(complnd, 'Fall_lat') call addfldFrom(compice, 'Faii_lat') - call addaoflusFld( 'Faox_lat') + call addaofluxFld( 'Faox_lat') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lat', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lat', rc=rc)) then @@ -1217,7 +1218,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfldTo(compatm, 'Faxx_sen') call addFldFrom(complnd, 'Fall_sen') call addfldFrom(compice, 'Faii_sen') - call addaoflusFld( 'Faox_sen') + call addaofluxFld( 'Faox_sen') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_sen', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_sen', rc=rc)) then @@ -1244,7 +1245,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfldTo(compatm, 'Faxx_evap') call addFldFrom(complnd, 'Fall_evap') call addfldFrom(compice, 'Faii_evap') - call addaoflusFld( 'Faox_evap') + call addaofluxFld( 'Faox_evap') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap', rc=rc)) then @@ -1271,7 +1272,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfldTo(compatm, 'Faxx_lwup') call addFldFrom(complnd, 'Fall_lwup') call addfldFrom(compice, 'Faii_lwup') - call addaoflusFld( 'Faox_lwup') + call addaofluxFld( 'Faox_lwup') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lwup', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lwup', rc=rc)) then @@ -1299,7 +1300,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfldTo(compatm, 'Faxx_evap_wiso') call addFldFrom(complnd, 'Fall_evap_wiso') call addfldFrom(compice, 'Faii_evap_wiso') - call addaoflusFld( 'Faox_evap_wiso') + call addaofluxFld( 'Faox_evap_wiso') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap_wiso', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap_wiso', rc=rc)) then @@ -1848,8 +1849,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- if (phase == 'advertise') then call addFldFrom(compatm, 'Faxa_lat' ) - call addaoflusFld( 'Faox_lat' ) - call addaoflusFld( 'Faox_evap') + call addaofluxFld( 'Faox_lat' ) + call addaofluxFld( 'Faox_evap') call addFldTo(compocn, 'Foxx_lat' ) call addFldTo(compocn, 'Foxx_evap') else @@ -1865,7 +1866,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_wiso) then if (phase == 'advertise') then - call addaoflusFld( 'Faox_lat_wiso' ) + call addaofluxFld( 'Faox_lat_wiso' ) call addFldTo(compocn, 'Foxx_lat_wiso' ) else if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat_wiso', rc=rc)) then @@ -1882,7 +1883,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! If the aoflux grid is ogrid - then nothing needs to be done to send to the ocean ! All other mappings are set in med_phases_aoflux_mod.F90 if (phase == 'advertise') then - call addaoflusFld( 'So_duu10n') + call addaofluxFld( 'So_duu10n') call addFldTo(compocn, 'So_duu10n') else if (fldchk(is_local%wrap%FBExp(compocn), 'So_duu10n', rc=rc)) then diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index a17461592..8095d1494 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -39,7 +39,9 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use esmFlds , only : addfldFrom => med_fldList_AddFldFrom use esmFlds , only : addmapFrom => med_fldList_AddMapFrom use esmFlds , only : addmrgFrom => med_fldList_AddMrgFrom - + use esmFlds , only : addaofluxFld => med_fldList_addaofluxFld + use esmFlds , only : addaofluxMap => med_fldList_addaofluxMap + use med_internalstate_mod , only : InternalState, mastertask, logunit ! input/output parameters: diff --git a/mediator/med.F90 b/mediator/med.F90 index 25b16aa0a..bc61d8ff3 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -44,10 +44,10 @@ module MED use med_internalstate_mod , only : ncomps, compname use med_internalstate_mod , only : compmed, compatm, compocn, compice, complnd, comprof, compwav, compglc use med_internalstate_mod , only : coupling_mode, aoflux_code, aoflux_ccpp_suite - use esmFlds , only : fldListMed_ocnalb + use esmFlds , only : med_fldList_GetocnalbfldList, med_fldList_type use esmFlds , only : med_fldList_GetNumFlds, med_fldList_GetFldNames, med_fldList_GetFldInfo use esmFlds , only : med_fldList_Document_Mapping, med_fldList_Document_Merging - use esmFlds , only : fldListFr, fldListTo, med_fldList_Realize + use esmFlds , only : med_fldList_GetfldListFr, med_fldList_GetfldListTo, med_fldList_Realize use esmFldsExchange_nems_mod , only : esmFldsExchange_nems use esmFldsExchange_cesm_mod , only : esmFldsExchange_cesm use esmFldsExchange_hafs_mod , only : esmFldsExchange_hafs @@ -676,6 +676,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) character(len=CS) :: cvalue character(len=8) :: cnum type(InternalState) :: is_local + type(med_fldlist_type), pointer :: fldListFr, fldListTo integer :: stat character(len=*),parameter :: subname=' (Advertise Fields) ' !----------------------------------------------------------- @@ -872,9 +873,10 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) do ncomp = 1,ncomps if (ncomp /= compmed) then if (mastertask) write(logunit,*) - nflds = med_fldList_GetNumFlds(fldListFr(ncomp)) - do n = 1,nflds - call med_fldList_GetFldInfo(fldListFr(ncomp), n, stdname=stdname, shortname=shortname) + fldListFr => med_fldList_GetFldListFr(ncomp) + nflds = med_fldList_GetNumFlds(fldListFr) + do n=1,nflds + call med_fldList_GetFldInfo(fldListFr, n, stdname=stdname, shortname=shortname) if (mastertask) then write(logunit,'(a)') trim(subname)//':Fr_'//trim(compname(ncomp))//': '//trim(shortname) end if @@ -889,9 +891,11 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//':Fr_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) end do - nflds = med_fldList_GetNumFlds(fldListTo(ncomp)) + + fldListTo => med_fldList_GetFldListTo(ncomp) + nflds = med_fldList_GetNumFlds(fldListTo) do n = 1,nflds - call med_fldList_GetFldInfo(fldListTo(ncomp), n, stdname=stdname, shortname=shortname) + call med_fldList_GetFldInfo(fldListTo, n, stdname=stdname, shortname=shortname) if (mastertask) then write(logunit,'(a)') trim(subname)//':To_'//trim(compname(ncomp))//': '//trim(shortname) end if @@ -958,7 +962,7 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) if (ESMF_StateIsCreated(is_local%wrap%NStateImp(n), rc=rc)) then call ESMF_StateSet(is_local%wrap%NStateImp(n), stateIntent=ESMF_StateIntent_Import, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_fldList_Realize(is_local%wrap%NStateImp(n), fldListFr(n), & + call med_fldList_Realize(is_local%wrap%NStateImp(n), med_fldList_GetfldListFr(n), & is_local%wrap%flds_scalar_name, is_local%wrap%flds_scalar_num, & tag=subname//':Fr_'//trim(compname(n)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -966,7 +970,7 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n), rc=rc)) then call ESMF_StateSet(is_local%wrap%NStateExp(n), stateIntent=ESMF_StateIntent_Export, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_fldList_Realize(is_local%wrap%NStateExp(n), fldListTo(n), & + call med_fldList_Realize(is_local%wrap%NStateExp(n), med_fldList_getfldListTo(n), & is_local%wrap%flds_scalar_name, is_local%wrap%flds_scalar_num, & tag=subname//':To_'//trim(compname(n)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1564,7 +1568,7 @@ subroutine DataInitialize(gcomp, rc) use med_diag_mod , only : med_diag_zero, med_diag_init use med_map_mod , only : med_map_routehandles_init, med_map_packed_field_create use med_io_mod , only : med_io_init - use esmFlds , only : fldListMed_aoflux + use esmFlds , only : med_fldList_GetaofluxfldList ! input/output variables type(ESMF_GridComp) :: gcomp @@ -1578,6 +1582,7 @@ subroutine DataInitialize(gcomp, rc) type(ESMF_Time) :: time type(ESMF_Field) :: field type(ESMF_StateItem_Flag) :: itemType + type(med_fldList_type), pointer :: fldListMed_ocnalb logical :: atCorrectTime, connected integer :: n1,n2,n,ns integer :: nsrc,ndst @@ -1723,10 +1728,11 @@ subroutine DataInitialize(gcomp, rc) if ( is_local%wrap%med_coupling_active(compocn,compatm) .or. is_local%wrap%med_coupling_active(compatm,compocn)) then ! Create field bundles for mediator ocean albedo computation + fldListMed_ocnalb => med_fldlist_getocnalbFldList() fieldCount = med_fldList_GetNumFlds(fldListMed_ocnalb) if (fieldCount > 0) then allocate(fldnames(fieldCount)) - call med_fldList_getfldnames(fldListMed_ocnalb%flds, fldnames, rc=rc) + call med_fldList_getfldnames(fldListMed_ocnalb%fields, fldnames, 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) @@ -1751,8 +1757,7 @@ subroutine DataInitialize(gcomp, rc) ! NOTE: this section must be done BEFORE the second call to esmFldsExchange ! Create field bundles for mediator ocean albedo computation - - fieldCount = med_fldList_GetNumFlds(fldListMed_aoflux) + fieldCount = med_fldList_GetNumFlds(med_fldList_getaofluxfldList()) if ( fieldCount > 0 ) then if ( is_local%wrap%med_coupling_active(compocn,compatm) .or. & is_local%wrap%med_coupling_active(compatm,compocn)) then @@ -1807,7 +1812,7 @@ subroutine DataInitialize(gcomp, rc) if (is_local%wrap%med_coupling_active(nsrc,ndst)) then call med_map_packed_field_create(ndst, & is_local%wrap%flds_scalar_name, & - fldsSrc=fldListFr(nsrc)%flds, & + fieldsSrc=med_fldList_GetfldListFr(nsrc), & FBSrc=is_local%wrap%FBImp(nsrc,nsrc), & FBDst=is_local%wrap%FBImp(nsrc,ndst), & packed_data=is_local%wrap%packed_data(nsrc,ndst,:), rc=rc) @@ -1819,7 +1824,7 @@ subroutine DataInitialize(gcomp, rc) ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a)) then call med_map_packed_field_create(compatm, & is_local%wrap%flds_scalar_name, & - fldsSrc=fldListMed_ocnalb%flds, & + fieldsSrc=med_fldList_getocnalbfldList(), & FBSrc=is_local%wrap%FBMed_ocnalb_o, & FBDst=is_local%wrap%FBMed_ocnalb_a, & packed_data=is_local%wrap%packed_data_ocnalb_o2a(:), rc=rc) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index d2e5b3057..5ecf488ad 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -716,7 +716,8 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & fieldsSrc, FBSrc, FBDst, packed_data, rc) use ESMF - use esmFlds , only : med_fldList_entry_type, med_fldList_getNumFlds + use esmFlds , only : med_fldList_entry_type, med_fldList_getNumFlds, med_fldList_type + use esmFlds , only : med_fldList_getFldInfo use med_internalstate_mod , only : nmappers use med_internalstate_mod , only : ncomps, compatm, compice, compocn, compname, mapnames use med_internalstate_mod , only : packed_data_type @@ -724,7 +725,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & ! input/output variables integer , intent(in) :: destcomp character(len=*) , intent(in) :: flds_scalar_name - type(med_fldList_entry_type) , target :: fieldsSrc ! mapping types top of LL + type(med_fldList_type) , intent(in) :: fieldsSrc ! mapping types top of LL type(ESMF_FieldBundle) , intent(in) :: FBSrc type(ESMF_FieldBundle) , intent(inout) :: FBDst type(packed_data_type) , intent(inout) :: packed_data(:) ! array over mapping types @@ -746,6 +747,8 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & integer :: numFlds type(ESMF_Field), pointer :: fieldlist_src(:) type(ESMF_Field), pointer :: fieldlist_dst(:) + character(CL) :: shortname + integer :: destindex character(CL), allocatable :: fieldNameList(:) character(CS) :: mapnorm_mapindex character(len=CX) :: tmpstr @@ -794,13 +797,12 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & ! Determine the normalization type for each packed_data mapping element ! Loop over mapping types + numflds = med_fldlist_GetNumFlds(fieldsSrc) do mapindex = 1,nmappers mapnorm_mapindex = 'not_set' ! Loop over source field bundle do nf = 1, fieldCount ! Loop over the fldsSrc types - - numflds = med_fldlist_GetNumFlds(fieldsSrc) do ns = 1,numflds ! Note that fieldnamelist is an array of names for the source fields ! The assumption is that there is only one mapping normalization @@ -809,7 +811,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & if ( destindex == mapindex .and. & trim(shortname) == trim(fieldnamelist(nf))) then ! Set the normalization to the input - call med_FldList_GetFldInfo(fieldsSrc, ns, compsrc=destcomp, mapnorm=packed_data(mapindex)%mapnorm=mapnorm) + call med_FldList_GetFldInfo(fieldsSrc, ns, compsrc=destcomp, mapnorm=packed_data(mapindex)%mapnorm) if (mapnorm_mapindex == 'not_set') then mapnorm_mapindex = packed_data(mapindex)%mapnorm write(tmpstr,*)'Map type '//trim(mapnames(mapindex)) & @@ -850,10 +852,10 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & do nf = 1, fieldCount ! Loop over the fldsSrc types - do ns = 1,size(fldsSrc) - - if ( fldsSrc(ns)%mapindex(destcomp) == mapindex .and. & - trim(fldsSrc(ns)%shortname) == trim(fieldnamelist(nf))) then + do ns = 1,numFlds + call med_fldList_GetFldInfo(fieldsSrc, ns, compsrc=destcomp, shortname=shortname, mapindex=destIndex) + if ( destIndex == mapindex .and. & + trim(shortname) == trim(fieldnamelist(nf))) then ! Determine mapping of indices into packed field bundle ! Get source field diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index c0c442a7f..fcbf27a08 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -166,7 +166,8 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) use ESMF , only : ESMF_FieldBundleIsCreated use esmFlds , only : med_fldList_GetNumFlds use esmFlds , only : med_fldList_GetFldNames - use esmFlds , only : fldListMed_aoflux + use esmFlds , only : med_fldList_GetaofluxfldList + use esmFlds , only : med_fldList_type use med_methods_mod , only : FB_init => med_methods_FB_init use med_internalstate_mod, only : compname @@ -177,13 +178,14 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) ! local variables integer :: n integer :: fieldcount + type(med_fldList_type), pointer :: fldListMed_aoflux type(InternalState) :: is_local character(len=*),parameter :: subname=' (med_phases_aofluxes_init_fldbuns) ' !--------------------------------------- ! Create field bundles for mediator ocean/atmosphere flux computation ! This is needed regardless of the grid on which the atm/ocn flux computation is done on - + fldListMed_aoflux => med_fldList_GetaofluxFldList() ! Get the internal state from the mediator Component. nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) @@ -192,7 +194,7 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) ! Set module variable fldnames_aof_out fieldCount = med_fldList_GetNumFlds(fldListMed_aoflux) allocate(fldnames_aof_out(fieldCount)) - call med_fldList_getfldnames(fldListMed_aoflux%flds, fldnames_aof_out, rc=rc) + call med_fldList_getfldnames(fldListMed_aoflux%fields, fldnames_aof_out, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Initialize FBMed_aoflux_a @@ -487,7 +489,8 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) ! -------------------------------------------- use ESMF , only : ESMF_FieldBundleIsCreated - use esmFlds , only : fldListMed_aoflux + use esmFlds , only : med_fldlist_GetaofluxfldList + use esmFlds , only : med_fldList_type use med_map_mod , only : med_map_packed_field_create ! Arguments @@ -497,6 +500,7 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) integer , intent(out) :: rc ! ! Local variables + type(med_fldList_type), pointer :: FldListMed_aoflux type(InternalState) :: is_local character(len=CX) :: tmpstr integer :: lsize @@ -509,7 +513,7 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) !----------------------------------------------------------------------- rc = ESMF_SUCCESS - + FldListMed_aoflux => med_fldlist_GetaofluxFldList() ! Get the internal state from the mediator Component. nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) @@ -570,7 +574,7 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) call med_map_packed_field_create(destcomp=compatm, & flds_scalar_name=is_local%wrap%flds_scalar_name, & - fldsSrc=fldListMed_aoflux%flds, & + fieldsSrc=fldListMed_aoflux, & FBSrc=is_local%wrap%FBMed_aoflux_o, & FBDst=is_local%wrap%FBMed_aoflux_a, & packed_data=is_local%wrap%packed_data_aoflux_o2a(:), rc=rc) diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index 14610e710..891ee5ddb 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -17,7 +17,6 @@ module med_phases_post_glc_mod use med_internalstate_mod , only : compatm, compice, complnd, comprof, compocn, compname, compglc use med_internalstate_mod , only : mapbilnr, mapconsd, compname use med_internalstate_mod , only : InternalState, mastertask, logunit - use esmFlds , only : fldListTo use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_methods_mod , only : fldbun_fldchk => med_methods_FB_fldchk use med_methods_mod , only : fldbun_getmesh => med_methods_FB_getmesh diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 8d41adbb8..caa9f4851 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -18,7 +18,7 @@ module med_phases_prep_atm_mod use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, mastertask use med_internalstate_mod , only : compatm, compocn, compice, compname, coupling_mode - use esmFlds , only : fldListTo, fldListMed_aoflux + use esmFlds , only : med_fldlist_GetfldListTo use perf_mod , only : t_startf, t_stopf use med_phases_aofluxes_mod, only : med_aofluxes_map_xgrid2agrid_output use med_phases_aofluxes_mod, only : med_aofluxes_map_ogrid2agrid_output @@ -139,7 +139,7 @@ subroutine med_phases_prep_atm(gcomp, rc) is_local%wrap%FBExp(compatm), & is_local%wrap%FBFrac(compatm), & is_local%wrap%FBImp(:,compatm), & - fldListTo(compatm), & + med_fldList_GetfldListTo(compatm), & FBMed1=is_local%wrap%FBMed_ocnalb_a, & FBMed2=is_local%wrap%FBMed_aoflux_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -151,7 +151,7 @@ subroutine med_phases_prep_atm(gcomp, rc) is_local%wrap%FBExp(compatm), & is_local%wrap%FBFrac(compatm), & is_local%wrap%FBImp(:,compatm), & - fldListTo(compatm), rc=rc) + med_fldList_GetfldListTo(compatm), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 35208a109..d2e1e4ffe 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -19,7 +19,7 @@ module med_phases_prep_ocn_mod use med_methods_mod , only : FB_average => med_methods_FB_average use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset - use esmFlds , only : fldListTo + use esmFlds , only : med_fldList_GetfldListTo use med_internalstate_mod , only : compocn, compatm, compice, coupling_mode use perf_mod , only : t_startf, t_stopf @@ -124,7 +124,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) is_local%wrap%FBExp(compocn), & is_local%wrap%FBFrac(compocn), & is_local%wrap%FBImp(:,compocn), & - fldListTo(compocn), & + med_fldList_GetfldListTo(compocn), & FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'nems_frac' .or. & @@ -135,7 +135,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) is_local%wrap%FBExp(compocn), & is_local%wrap%FBFrac(compocn), & is_local%wrap%FBImp(:,compocn), & - fldListTo(compocn), rc=rc) + med_fldList_GetfldListTo(compocn), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 47430d685..a30d67c6f 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -94,7 +94,7 @@ subroutine med_phases_prep_rof_init(gcomp, rc) type(ESMF_Mesh) :: mesh_l type(ESMF_Mesh) :: mesh_r type(ESMF_Field) :: lfield - type(med_fldList_type), pointer :: fldListTo + type(med_fldList_type), pointer :: fldList character(len=CS), allocatable :: fldnames_temp(:) character(len=*),parameter :: subname=' (med_phases_prep_rof_init) ' !--------------------------------------- @@ -108,11 +108,11 @@ subroutine med_phases_prep_rof_init(gcomp, rc) ! Determine lnd2rof_flds (module variable) - note that fldListTo is set in esmFldsExchange_cesm.F90 ! Remove scalar field from lnd2rof_flds - fldListTo => med_fldList_GetfldlistTo(comprof) - nflds = med_fldlist_getnumflds(fldListTo) + fldList => med_fldList_GetfldlistTo(comprof) + nflds = med_fldlist_getnumflds(fldList) allocate(fldnames_temp(nflds)) do n = 1,nflds - call med_fldList_GetFldInfo(fldListTo, n, stdname=fldnames_temp(n)) + call med_fldList_GetFldInfo(fldList, n, stdname=fldnames_temp(n)) end do do n = 1,nflds if (trim(fldnames_temp(n)) == trim(is_local%wrap%flds_scalar_name)) then @@ -164,7 +164,7 @@ subroutine med_phases_prep_rof_init(gcomp, rc) ! Create packed mapping from rof->lnd call med_map_packed_field_create(destcomp=comprof, & flds_scalar_name=is_local%wrap%flds_scalar_name, & - fldsSrc=fldList, & + fieldsSrc=fldList, & FBSrc=FBLndAccum2rof_l, FBDst=FBLndAccum2rof_r, & packed_data=is_local%wrap%packed_data(complnd,comprof,:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -262,7 +262,7 @@ subroutine med_phases_prep_rof(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use esmFlds , only : fldListTo + use esmFlds , only : med_fldList_GetfldListTo use med_map_mod , only : med_map_field_packed use med_merge_mod , only : med_merge_auto use med_constants_mod , only : czero => med_constants_czero @@ -374,7 +374,7 @@ subroutine med_phases_prep_rof(gcomp, rc) end if call med_merge_auto(compsrc=complnd, FBout=is_local%wrap%FBExp(comprof), & - FBfrac=is_local%wrap%FBFrac(comprof), FBin=FBlndAccum2rof_r, fldListTo=fldListTo(comprof), rc=rc) + FBfrac=is_local%wrap%FBFrac(comprof), FBin=FBlndAccum2rof_r, fldListTo=med_fldList_GetfldListTo(comprof), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then From 9d01b7b7bf723599105be9a85bff02cdc9bd1002 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Sun, 20 Nov 2022 08:16:07 -0700 Subject: [PATCH 130/395] save warnings in log --- cesm/driver/util.F90 | 5 +++-- cime_config/buildexe | 2 ++ 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/cesm/driver/util.F90 b/cesm/driver/util.F90 index d8e97316f..614d1c745 100644 --- a/cesm/driver/util.F90 +++ b/cesm/driver/util.F90 @@ -4,8 +4,9 @@ module util ! CustomFieldDictionaryProto utility module !----------------------------------------------------------------------------- - use ESMF - use NUOPC + use ESMF, only : ESMF_SUCCESS, ESMF_MAXSTR, ESMF_IOFmt_flag, ESMF_LogWrite + use ESMF, only : ESMF_LOGMSG_INFO, ESMF_LOGERR_PASSTHRU, ESMF_LOGFoundError + use NUOPC, only : nuopc_freeFormat, nuopc_freeformatLog, nuopc_fieldDictionaryEgest implicit none diff --git a/cime_config/buildexe b/cime_config/buildexe index 7f1a64471..406f660a3 100755 --- a/cime_config/buildexe +++ b/cime_config/buildexe @@ -111,6 +111,8 @@ def _main_func(): rc, out, err = run_cmd(cmd,from_dir=bld_root) expect(rc==0,"Command {} failed rc={}\nout={}\nerr={}".format(cmd,rc,out,err)) + if err: + logger.info(err) logger.info(out) ############################################################################### From 2dc15974078867d32389881f4605730cc8ebc64f Mon Sep 17 00:00:00 2001 From: James Edwards Date: Sun, 20 Nov 2022 08:20:50 -0700 Subject: [PATCH 131/395] debugging --- mediator/med.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/mediator/med.F90 b/mediator/med.F90 index bc61d8ff3..a72a2e1d7 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -877,6 +877,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) nflds = med_fldList_GetNumFlds(fldListFr) do n=1,nflds call med_fldList_GetFldInfo(fldListFr, n, stdname=stdname, shortname=shortname) + print *,__FILE__,__LINE__,n,trim(stdname),trim(shortname) if (mastertask) then write(logunit,'(a)') trim(subname)//':Fr_'//trim(compname(ncomp))//': '//trim(shortname) end if From d494fa5127fc399e718cb3b1bf363f89946b16a7 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 21 Nov 2022 12:17:35 -0700 Subject: [PATCH 132/395] now passing SMS_Ld3.f19_g17_rx1.A.cheyenne_intel --- mediator/esmFlds.F90 | 264 ++++++++++++++++---------- mediator/esmFldsExchange_cesm_mod.F90 | 2 - mediator/esmFldsExchange_nems_mod.F90 | 2 - mediator/med.F90 | 11 +- mediator/med_merge_mod.F90 | 82 ++++---- 5 files changed, 203 insertions(+), 158 deletions(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index 018f164c7..bbe60fc45 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -1,9 +1,11 @@ module esmflds - use ESMF, only : ESMF_SUCCESS, ESMF_FAILURE - 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 : ncomps, compname, compocn, compatm + use ESMF, only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_ERROR, ESMF_LOGWRITE + use ESMF, only : ESMF_FINALIZE, ESMF_END_ABORT + + 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 : ncomps, compname, compocn, compatm, compice use med_internalstate_mod, only : mapfcopy, mapnames, mapunset - use med_utils_mod , only : chkerr => med_utils_ChkErr + use med_utils_mod , only : chkerr => med_utils_ChkErr implicit none private @@ -15,9 +17,9 @@ module esmflds public :: med_fldList_AddFldFrom public :: med_fldList_AddMapFrom - public :: med_fldList_AddMrgFrom +! public :: med_fldList_AddMrgFrom public :: med_fldList_AddFldTo - public :: med_fldList_AddMapTo +! public :: med_fldList_AddMapTo public :: med_fldList_AddMrgTo public :: med_fldList_AddOcnalbFld @@ -29,10 +31,11 @@ module esmflds private :: med_fldList_AddFld private :: med_fldList_AddMap private :: med_fldList_AddMrg - + private :: med_fldList_findName public :: med_fldList_GetFldNames public :: med_fldList_GetNumFlds public :: med_fldList_GetFldInfo + public :: med_fld_GetFldInfo public :: med_fldList_Realize public :: med_fldList_Document_Mapping public :: med_fldList_Document_Merging @@ -154,6 +157,29 @@ subroutine med_fldList_AddFldTo(index, stdname, shortname) end subroutine med_fldList_AddFldTo + subroutine med_fldList_findName(fields, stdname, found, lastfld) + ! on return if found == .true. lastfield is the field matching stdname + ! if found == .false. lastfield is the last field in the list + type(med_fldList_entry_type) , intent(in), target :: fields + character(len=*) , intent(in) :: stdname + logical , intent(out) :: found + type(med_fldList_entry_type) , intent(out), pointer :: lastfld + + lastfld => fields + found = .false. + do while(associated(lastfld%next)) + if (trim(stdname) == trim(lastfld%stdname)) then + found = .true. + exit + end if + lastfld => lastfld%next + enddo + ! Check the last lastfld + if (trim(stdname) == trim(lastfld%stdname)) then + found = .true. + end if + end subroutine med_fldList_findName + subroutine med_fldList_AddFld(fields, stdname, shortname) ! ---------------------------------------------- ! Add an entry to to the flds array @@ -177,26 +203,20 @@ subroutine med_fldList_AddFld(fields, stdname, shortname) type(med_fldList_entry_type), pointer :: newfld character(len=*), parameter :: subname='(med_fldList_AddFld)' ! ---------------------------------------------- - - newfld => fields - found = .false. - do while(associated(newfld%next)) - if (trim(stdname) == trim(newfld%stdname)) then - found = .true. - exit - end if - newfld => newfld%next - enddo + + call med_fldList_findName(fields, stdname, found, newfld) ! create new entry if fldname is not in original list - + mapsize = ncomps mrgsize = ncomps if (.not. found) then - ! 1) allocate newfld to be size (one element larger than input flds) - allocate(newfld%next) - newfld => newfld%next + ! the if statement allows the first entry to be filed + if(allocated(newfld%mapindex)) then + allocate(newfld%next) + newfld => newfld%next + endif ! 2) now update flds information for new entry newfld%stdname = trim(stdname) @@ -222,24 +242,23 @@ subroutine med_fldList_AddFld(fields, stdname, shortname) end subroutine med_fldList_AddFld !================================================================================ - subroutine med_fldList_AddMrgFrom(index, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname, rc) - +! subroutine med_fldList_AddMrgFrom(index, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname, rc) ! ---------------------------------------------- ! Determine mrg entry or entries in flds aray ! ---------------------------------------------- ! input/output variables - integer , intent(in) :: index - character(len=*) , intent(in) :: fldname - integer , intent(in) :: mrg_from - character(len=*) , intent(in) :: mrg_fld - character(len=*) , intent(in) :: mrg_type - character(len=*) , intent(in), optional :: mrg_fracname - integer , intent(out), optional :: rc - - call med_FldList_addMrg(fldListFr(index)%fields, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname) +! integer , intent(in) :: index +! character(len=*) , intent(in) :: fldname +! integer , intent(in) :: mrg_from +! character(len=*) , intent(in) :: mrg_fld +! character(len=*) , intent(in) :: mrg_type +! character(len=*) , intent(in), optional :: mrg_fracname +! integer , intent(out), optional :: rc + +! call med_FldList_addMrg(fldListFr(index)%fields, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname) - end subroutine med_fldList_AddMrgFrom +! end subroutine med_fldList_AddMrgFrom !================================================================================ subroutine med_fldList_AddMrgTo(index, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname, rc) @@ -278,7 +297,7 @@ subroutine med_fldList_AddMrg(flds, fldname, mrg_from, mrg_fld, mrg_type, mrg_fr type(med_fldList_entry_type), pointer :: newfld character(len=*), parameter :: subname='(med_fldList_AddMrg)' ! ---------------------------------------------- - + newfld => med_fldList_GetFld(flds, fldname, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -297,25 +316,22 @@ function med_fldList_GetFld(fields, fldname, rc) result(newfld) character(len=*) , intent(in) :: fldname type(med_fldList_entry_type), pointer :: newfld + logical :: found integer :: rc character(len=*), parameter :: subname='(med_fldList_GetFld)' - newfld => fields - rc = ESMF_FAILURE - do while(associated(newfld%next)) - if(trim(fldname) .eq. newfld%stdname) then - rc = ESMF_SUCCESS - exit - endif - newfld => newfld%next - enddo - if(rc /= ESMF_SUCCESS) then + + call med_fldList_findName(fields, fldname, found, newfld) + + rc = ESMF_SUCCESS + if(.not. found) then + rc = ESMF_FAILURE newfld => fields - do while(associated(newfld%next)) + do while(associated(newfld)) write(6,*) trim(subname)//' input flds entry is ',trim(newfld%stdname) newfld => newfld%next end do - call ESMF_LogWrite(subname // 'ERROR: fldname '// trim(fldname) // ' not found in input flds', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname // 'ERROR: fldname '// trim(fldname) // ' not found in input flds', ESMF_LOGMSG_ERROR) return endif @@ -333,17 +349,20 @@ subroutine med_fldList_AddMapFrom(index, fldname, destcomp, maptype, mapnorm, ma end subroutine med_fldList_AddMapFrom !================================================================================ - subroutine med_fldList_AddMapTo(index, fldname, destcomp, maptype, mapnorm, mapfile) - integer, intent(in) :: index - character(len=*) , intent(in) :: fldname - integer , intent(in) :: destcomp - integer , intent(in) :: maptype - character(len=*) , intent(in) :: mapnorm - character(len=*), optional , intent(in) :: mapfile - - call med_fldList_AddMap(FldListTo(index)%fields, fldname, destcomp, maptype, mapnorm, mapfile) - - end subroutine med_fldList_AddMapTo +! subroutine med_fldList_AddMapTo(index, fldname, destcomp, maptype, mapnorm, mapfile) +! integer, intent(in) :: index +! character(len=*) , intent(in) :: fldname +! integer , intent(in) :: destcomp +! integer , intent(in) :: maptype +! character(len=*) , intent(in) :: mapnorm +! character(len=*), optional , intent(in) :: mapfile +! +! if(index == compice .and. trim(fldname) .eq. 'cpl_scalars') then +! call ESMF_Finalize(endflag=ESMF_END_ABORT) +! endif +! call med_fldList_AddMap(FldListTo(index)%fields, fldname, destcomp, maptype, mapnorm, mapfile) +! +! end subroutine med_fldList_AddMapTo !================================================================================ subroutine med_fldList_AddaofluxMap(fldname, destcomp, maptype, mapnorm, mapfile) character(len=*) , intent(in) :: fldname @@ -521,7 +540,7 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num endif newfld => fldList%fields - do while(associated(newfld%next)) + do while(associated(newfld)) shortname = newfld%shortname ! call ESMF_LogWrite(subname//' fld = '//trim(shortname), ESMF_LOGMSG_INFO) @@ -568,9 +587,6 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num call NUOPC_Realize(state, field=field, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - ! call ESMF_FieldPrint(field=field, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - endif else @@ -581,7 +597,7 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return end if - + newfld => newfld%next end do call ESMF_LogWrite(subname//' done ', ESMF_LOGMSG_INFO) @@ -630,7 +646,7 @@ end subroutine med_fldList_Realize !================================================================================ - subroutine med_fldList_GetFldInfo(fldList, fldindex, compsrc, stdname, shortname, mapindex, mapFile, mapnorm, merge_fields, merge_type, merge_fracname) + subroutine med_fldList_GetFldInfo(fldList, fldindex, compsrc, stdname, shortname, mapindex, mapFile, mapnorm, merge_fields, merge_type, merge_fracname, rc) ! ---------------------------------------------- ! Get field info ! ---------------------------------------------- @@ -645,21 +661,52 @@ subroutine med_fldList_GetFldInfo(fldList, fldindex, compsrc, stdname, shortname character(len=*) , optional, intent(out) :: merge_fields character(len=*) , optional, intent(out) :: merge_type character(len=*) , optional, intent(out) :: merge_fracname + integer , optional, intent(out) :: rc ! local variables type(med_fldList_entry_type), pointer :: newfld integer :: i integer :: lcompsrc - character(len=*), parameter :: subname='(med_fldList_GetFldInfo_general)' + character(len=*), parameter :: subname='(med_fldList_GetFldInfo)' ! ---------------------------------------------- i = 0 lcompsrc = 1 newfld => fldList%fields - do while(associated(newfld%next)) + do while(associated(newfld)) i = i+1 if (i==fldindex) exit newfld => newfld%next enddo + + call med_fld_GetFldInfo(newfld, compsrc, stdname, shortname, mapindex, mapFile, mapnorm, merge_fields, merge_type, merge_fracname, rc) + + end subroutine med_fldList_GetFldInfo + + subroutine med_fld_GetFldInfo(newfld, compsrc, stdname, shortname, mapindex, mapFile, mapnorm, merge_fields, merge_type, merge_fracname, rc) + ! ---------------------------------------------- + ! Get field info + ! ---------------------------------------------- + type(med_fldList_entry_type) , intent(in) :: newfld + integer , optional, intent(in) :: compsrc + integer , optional, intent(out) :: mapindex + character(len=*) , optional, intent(out) :: mapfile + character(len=*) , optional, intent(out) :: mapnorm + character(len=*) , optional, intent(out) :: stdname + character(len=*) , optional, intent(out) :: shortname + character(len=*) , optional, intent(out) :: merge_fields + character(len=*) , optional, intent(out) :: merge_type + character(len=*) , optional, intent(out) :: merge_fracname + integer , optional, intent(out) :: rc + + ! local variables + integer :: lrc + integer :: lcompsrc + character(len=*), parameter :: subname='(med_fld_GetFldInfo)' + lrc = ESMF_SUCCESS + + lcompsrc = -1 + if(present(compsrc)) lcompsrc = compsrc + if(present(stdname)) then stdname = newfld%stdname endif @@ -668,31 +715,41 @@ subroutine med_fldList_GetFldInfo(fldList, fldindex, compsrc, stdname, shortname endif if(present(mapindex)) then - if(present(compsrc)) lcompsrc = compsrc - mapindex = newfld%mapindex(compsrc) + if(lcompsrc < 0) call med_fldList_compsrcerror(lrc) + mapindex = newfld%mapindex(lcompsrc) endif if(present(mapfile)) then - if(present(compsrc)) lcompsrc = compsrc - mapfile = newfld%mapfile(compsrc) + if(lcompsrc < 0) call med_fldList_compsrcerror(lrc) + mapfile = newfld%mapfile(lcompsrc) endif if(present(mapnorm)) then - if(present(compsrc)) lcompsrc = compsrc - mapnorm = newfld%mapnorm(compsrc) + if(lcompsrc < 0) call med_fldList_compsrcerror(lrc) + mapnorm = newfld%mapnorm(lcompsrc) endif if(present(merge_fields)) then - if(present(compsrc)) lcompsrc = compsrc - merge_fields = newfld%merge_fields(compsrc) + if(lcompsrc < 0) call med_fldList_compsrcerror(lrc) + merge_fields = newfld%merge_fields(lcompsrc) endif if(present(merge_type)) then - if(present(compsrc)) lcompsrc = compsrc - merge_type = newfld%merge_types(compsrc) + if(lcompsrc < 0) call med_fldList_compsrcerror(lrc) + merge_type = newfld%merge_types(lcompsrc) endif if(present(merge_fracname)) then - if(present(compsrc)) lcompsrc = compsrc - merge_fracname = newfld%merge_fracnames(compsrc) + if(lcompsrc < 0) call med_fldList_compsrcerror(lrc) + merge_fracname = newfld%merge_fracnames(lcompsrc) endif + if(present(rc)) rc=lrc + + end subroutine med_fld_GetFldInfo + + subroutine med_fldList_compsrcerror(rc) + integer, intent(out) :: rc + call ESMF_LogWrite("In med_fld_GetFldInfo a field requiring compsrc was requested but compsrc was not provided. ", & + ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + end subroutine med_fldList_compsrcerror - end subroutine med_fldList_GetFldInfo !================================================================================ @@ -705,7 +762,7 @@ integer function med_fldList_GetNumFlds(fldList) newfld => fldList%fields med_fldList_GetNumFlds = 0 - do while(associated(newfld%next)) + do while(associated(newfld)) med_fldList_GetNumFlds = med_fldList_GetNumFlds + 1 newfld => newfld%next end do @@ -716,11 +773,11 @@ end function med_fldList_GetNumFlds subroutine med_fldList_GetFldNames(fields, fldnames, rc) - use ESMF, only : ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_SUCCESS, ESMF_LogWrite + use ESMF, only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_SUCCESS, ESMF_LogWrite ! input/output variables type(med_fldList_entry_type) , intent(in), target :: fields - character(len=*) , intent(out), pointer :: fldnames(:) + character(len=*) , intent(inout), pointer :: fldnames(:) integer, optional , intent(out) :: rc !local variables @@ -728,17 +785,16 @@ subroutine med_fldList_GetFldNames(fields, fldnames, rc) integer :: n ! ---------------------------------------------- - rc = ESMF_SUCCESS - + if(present(rc)) rc = ESMF_SUCCESS if (.not. associated(fldnames) .or. .not. allocated(fields%mapindex)) then call ESMF_LogWrite("med_fldList_GetFldNames: ERROR either fields or fldnames have not been allocate ", & - ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE + ESMF_LOGMSG_ERROR) + if(present(rc)) rc = ESMF_FAILURE return endif n = 0 newfld => fields - do while(associated(newfld%next)) + do while(associated(newfld)) n = n+1 fldnames(n) = trim(newfld%shortname) newfld => newfld%next @@ -785,12 +841,11 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active) ! Write all the mappings for fields from the src to the destination component write(logunit,*)' ' newfld => fldListFr(nsrc)%fields - do while(associated(newfld%next)) + do while(associated(newfld)) mapindex = newfld%mapindex(ndst) if ( mapindex /= mapunset) then - fldname = trim(newfld%stdname) - mapnorm = trim(newfld%mapnorm(ndst)) - mapfile = trim(newfld%mapfile(ndst)) + call med_fld_GetFldInfo(newfld, compsrc=ndst, stdname=fldname, mapnorm=mapnorm, mapfile=mapfile, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return if (trim(mapnorm) == 'unset') then cvalue = ' mapping '//trim(compname(nsrc))//'->'//trim(compname(ndst)) //' '//trim(fldname) // & @@ -817,13 +872,12 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active) ndst = compatm if (med_coupling_active(nsrc,ndst) .and. allocated(fldListMed_aoflux%fields%mapindex)) then newfld => fldListMed_aoflux%fields - do while(associated(newfld%next)) - mapindex = newfld%mapindex(ndst) + do while(associated(newfld)) + call med_fld_GetFldInfo(newfld, compsrc=ndst, mapindex=mapindex, rc=rc) if ( mapindex /= mapunset) then - fldname = trim(newfld%stdname) - mapnorm = trim(newfld%mapnorm(ndst)) - mapfile = trim(newfld%mapfile(ndst)) - + call med_fld_GetFldInfo(newfld, stdname=fldname, compsrc=ndst, mapnorm=mapnorm, mapfile=mapfile, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (trim(mapnorm) == 'unset') then cvalue = ' mapping '//trim(compname(nsrc))//'->'//trim(compname(ndst)) //' '//trim(fldname) // & ' via '// trim(mapnames(mapindex)) @@ -872,7 +926,7 @@ subroutine med_fldList_Document_Merging(logunit, med_coupling_active) character(len=CL) :: mrgstr logical :: init_mrgstr type(med_fldList_entry_type), pointer :: newfld - character(len=*),parameter :: subname = '(med_fldList_Document_Mapping)' + character(len=*),parameter :: subname = '(med_fldList_Document_Merging)' !----------------------------------------------------------- write(logunit,*) @@ -884,18 +938,18 @@ subroutine med_fldList_Document_Merging(logunit, med_coupling_active) ! Loop over all flds in the destination component and determine merging data newfld => fldListTo(ndst)%fields - do while(associated(newfld%next)) - dst_field = newfld%stdname - + do while(associated(newfld)) + call med_fld_GetFldInfo(newfld, stdname=dst_field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Loop over all possible source components for destination component field mrgstr = ' ' do nsrc = 1,ncomps if (nsrc /= ndst .and. med_coupling_active(nsrc,ndst)) then src_comp = compname(nsrc) - merge_field = newfld%merge_fields(nsrc) - merge_type = newfld%merge_types(nsrc) - merge_frac = newfld%merge_fracnames(nsrc) + call med_fld_GetFldInfo(newfld, compsrc=nsrc, merge_fields=merge_field, merge_type=merge_type, merge_fracname=merge_frac, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return if (merge_type == 'merge' .or. merge_type == 'sum_with_weights') then string = trim(merge_frac)//'*'//trim(merge_field)//'('//trim(src_comp)//')' @@ -921,12 +975,12 @@ subroutine med_fldList_Document_Merging(logunit, med_coupling_active) end if end if end if - newfld => newfld%next end do ! end loop over nsrc if (mrgstr /= ' ') then write(logunit,'(a)') trim(mrgstr) end if - end do ! end loop over nf + newfld => newfld%next + end do ! end loop over fields end do ! end loop over ndst end subroutine med_fldList_Document_Merging diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index e957ea699..1be6c3cf8 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -85,10 +85,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) use esmFlds , only : addfldTo => med_fldList_AddFldTo use esmFlds , only : addfldFrom => med_fldList_AddFldFrom - use esmFlds , only : addmapTo => med_fldList_AddMapTo use esmFlds , only : addmapFrom => med_fldList_AddMapFrom use esmFlds , only : addmrgTo => med_fldList_AddMrgTo - use esmFlds , only : addmrgFrom => med_fldList_AddMrgFrom ! input/output parameters: type(ESMF_GridComp) :: gcomp diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 8095d1494..8e9ecc61d 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -34,11 +34,9 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use med_internalstate_mod , only : coupling_mode, mapnames use esmFlds , only : med_fldList_type use esmFlds , only : addfldTo => med_fldList_AddFldTo - use esmFlds , only : addmapTo => med_fldList_AddMapTo use esmFlds , only : addmrgTo => med_fldList_AddMrgTo use esmFlds , only : addfldFrom => med_fldList_AddFldFrom use esmFlds , only : addmapFrom => med_fldList_AddMapFrom - use esmFlds , only : addmrgFrom => med_fldList_AddMrgFrom use esmFlds , only : addaofluxFld => med_fldList_addaofluxFld use esmFlds , only : addaofluxMap => med_fldList_addaofluxMap diff --git a/mediator/med.F90 b/mediator/med.F90 index a72a2e1d7..f62b0d3db 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -658,7 +658,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_END_ABORT, ESMF_Finalize, ESMF_MAXSTR use NUOPC , only : NUOPC_AddNamespace, NUOPC_Advertise, NUOPC_AddNestedState use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd - use esmFlds, only : med_fldlist_init1 + use esmFlds, only : med_fldlist_init1, med_fld_GetFldInfo, med_fldList_entry_type use med_phases_history_mod, only : med_phases_history_init use med_internalstate_mod , only : atm_name @@ -677,6 +677,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) character(len=8) :: cnum type(InternalState) :: is_local type(med_fldlist_type), pointer :: fldListFr, fldListTo + type(med_fldList_entry_type), pointer :: fld integer :: stat character(len=*),parameter :: subname=' (Advertise Fields) ' !----------------------------------------------------------- @@ -877,7 +878,6 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) nflds = med_fldList_GetNumFlds(fldListFr) do n=1,nflds call med_fldList_GetFldInfo(fldListFr, n, stdname=stdname, shortname=shortname) - print *,__FILE__,__LINE__,n,trim(stdname),trim(shortname) if (mastertask) then write(logunit,'(a)') trim(subname)//':Fr_'//trim(compname(ncomp))//': '//trim(shortname) end if @@ -894,9 +894,9 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) end do fldListTo => med_fldList_GetFldListTo(ncomp) - nflds = med_fldList_GetNumFlds(fldListTo) - do n = 1,nflds - call med_fldList_GetFldInfo(fldListTo, n, stdname=stdname, shortname=shortname) + fld => fldListTo%fields + do while(associated(fld)) + call med_fld_GetFldInfo(fld, stdname=stdname, shortname=shortname, rc=rc) if (mastertask) then write(logunit,'(a)') trim(subname)//':To_'//trim(compname(ncomp))//': '//trim(shortname) end if @@ -910,6 +910,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) TransferOfferGeomObject=transferOffer, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//':To_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) + fld => fld%next end do end if end do ! end of ncomps loop diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index 223b1da25..c984b1e3f 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -13,7 +13,9 @@ module med_merge_mod use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr use esmFlds , only : med_fldList_type use esmFlds , only : med_fldList_GetNumFlds - use esmFlds , only : med_fldList_GetFldInfo + use esmFlds , only : med_fld_GetFldInfo + use esmFlds , only : med_fldList_entry_type + use esmFlds , only : med_fldList_GetFldNames use perf_mod , only : t_startf, t_stopf implicit none @@ -56,12 +58,13 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f type(ESMF_FieldBundle) , intent(inout) :: FBOut ! Merged output field bundle type(ESMF_FieldBundle) , intent(inout) :: FBfrac ! Fraction data for FBOut type(ESMF_FieldBundle) , intent(in) :: FBImp(:) ! Array of field bundles each mapping to the FBOut mesh - type(med_fldList_type) , intent(in) :: fldListTo ! Information for merging + type(med_fldList_type) , intent(in) , target :: fldListTo ! Information for merging type(ESMF_FieldBundle) , intent(in) , optional :: FBMed1 ! mediator field bundle type(ESMF_FieldBundle) , intent(in) , optional :: FBMed2 ! mediator field bundle integer , intent(out) :: rc ! local variables + type(med_fldList_entry_type), pointer :: fldptr integer :: nfld_out,nfld_in,nm integer :: compsrc integer :: num_merge_fields @@ -70,8 +73,8 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f character(CL) :: merge_field character(CS) :: merge_type character(CS) :: merge_fracname - character(CS), allocatable :: merge_field_names(:) - logical :: error_check = .false. ! TODO: make this an input argument + character(CS), pointer :: merge_field_names(:) + logical :: error_check = .true. ! TODO: make this an input argument integer :: ungriddedUBound_out(1) ! size of ungridded dimension integer :: fieldcount character(CL) , pointer :: fieldnamelist(:) @@ -98,23 +101,21 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f call ESMF_FieldBundleGet(FBOut, fieldnamelist=fieldnamelist, fieldlist=fieldlist, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - num_merge_fields = med_fldList_GetNumFlds(fldListTo) - allocate(merge_field_names(num_merge_fields)) - do nfld_in = 1,num_merge_fields - call med_fldList_GetFldInfo(fldListTo, nfld_in, stdname=merge_field_names(nfld_in)) - end do - ! Want to loop over all of the fields in FBout here - and find the corresponding index in fldListTo(compxxx) ! for that field name - then call the corresponding merge routine below appropriately ! Loop over all fields in field bundle FBOut do nfld_out = 1,fieldcount zero_output = .true. + call ESMF_FieldGet(fieldlist(nfld_out), ungriddedUBound=ungriddedUbound_out, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Loop over the field in fldListTo - do nfld_in = 1,num_merge_fields - - if (trim(merge_field_names(nfld_in)) == trim(fieldnamelist(nfld_out))) then + fldptr => fldListTo%fields + nfld_in = 0 + do while(associated(fldptr)) + nfld_in = nfld_in + 1 + if (trim(fldptr%stdname) == trim(fieldnamelist(nfld_out))) then ! Loop over all possible source components in the merging arrays returned from the above call ! If the merge field name from the source components is not set, then simply go to the next component @@ -128,9 +129,10 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f else if (.not. coupling_active(compsrc)) then CYCLE end if - + ! Determine the merge information for the import field - call med_fldList_GetFldInfo(fldListTo, nfld_in, compsrc=compsrc, merge_fields=merge_fields, merge_type=merge_type, merge_fracname=merge_fracname) + call med_fld_GetFldInfo(fldptr, compsrc=compsrc, merge_fields=merge_fields, merge_type=merge_type, merge_fracname=merge_fracname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return if (merge_type /= 'unset' .and. merge_field /= 'unset') then ! If merge_field is a colon delimited string then cycle through every field - otherwise by default nm @@ -138,13 +140,8 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f num_merge_colon_fields = merge_listGetNum(merge_fields) do nm = 1,num_merge_colon_fields ! Determine merge field name from source field - if (num_merge_fields == 1) then - merge_field = trim(merge_fields) - else - call merge_listGetName(merge_fields, nm, merge_field, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - + call merge_listGetName(merge_fields, nm, merge_field, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Perform error checks if (error_check) then call med_merge_auto_errcheck(compsrc, fieldnamelist(nfld_out), fieldlist(nfld_out), & @@ -155,8 +152,6 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f ! Initialize initial output field data to zero before doing merge if (zero_output) then - call ESMF_FieldGet(fieldlist(nfld_out), ungriddedUBound=ungriddedUbound_out, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return if (ungriddedUBound_out(1) > 0) then call ESMF_FieldGet(fieldlist(nfld_out), farrayPtr=dataptr2d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -190,6 +185,7 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f end if ! end of check of merge_type and merge_field not unset end do ! end of compsrc loop end if ! end of check if stdname and fldname are the same + fldptr => fldptr%next end do ! end of loop over fldsListTo end do ! end of loop over fields in FBOut @@ -225,10 +221,11 @@ subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo, type(ESMF_FieldBundle) , intent(inout) :: FBOut ! Merged output field bundle type(ESMF_FieldBundle) , intent(inout) :: FBfrac ! Fraction data for FBOut type(ESMF_FieldBundle) , intent(in) :: FBIn ! Single field bundle to merge to the FBOut mesh - type(med_fldList_type) , intent(in) :: fldListTo ! Information for merging + type(med_fldList_type) , intent(in), target :: fldListTo ! Information for merging integer , intent(out) :: rc ! local variables + type(med_fldList_entry_type), pointer :: fldptr integer :: nfld_out,nfld_in,nm integer :: num_merge_fields integer :: num_merge_colon_fields @@ -236,7 +233,7 @@ subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo, character(CL) :: merge_field character(CS) :: merge_type character(CS) :: merge_fracname - character(CS), allocatable :: merge_field_names(:) + character(CS) :: merge_field_name integer :: ungriddedUBound_out(1) ! size of ungridded dimension integer :: fieldcount character(CL) , pointer :: fieldnamelist(:) @@ -263,26 +260,26 @@ subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo, call ESMF_FieldBundleGet(FBOut, fieldnamelist=fieldnamelist, fieldlist=fieldlist, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - num_merge_fields = med_fldList_GetNumFlds(fldListTo) - allocate(merge_field_names(num_merge_fields)) - do nfld_in = 1,num_merge_fields - call med_fldList_GetFldInfo(fldListTo, nfld_in, stdname=merge_field_names(nfld_in)) - end do - ! Loop over all fields in output field bundle FBOut do nfld_out = 1,fieldcount zero_output = .true. + call ESMF_FieldGet(fieldlist(nfld_out), ungriddedUBound=ungriddedUbound_out, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Loop over the field in fldListTo to get fieldname and merging type - do nfld_in = 1,med_fldList_GetNumFlds(fldListTo) - - if (trim(merge_field_names(nfld_in)) == trim(fieldnamelist(nfld_out))) then + fldptr => fldListTo%fields + nfld_in = 0 + do while(associated(fldptr)) + nfld_in = nfld_in+1 + call med_fld_GetFldInfo(fldptr, stdname=merge_field_name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (trim(merge_field_name) == trim(fieldnamelist(nfld_out))) then ! Loop over all possible source components in the merging arrays returned from the above call ! If the merge field name from the source components is not set, then simply go to the next component ! Determine the merge information for the import field - call med_fldList_GetFldInfo(fldListTo, nfld_in, compsrc=compsrc, merge_fields=merge_fields, merge_type=merge_type, merge_fracname=merge_fracname) + call med_fld_GetFldInfo(fldptr, compsrc=compsrc, merge_fields=merge_fields, merge_type=merge_type, merge_fracname=merge_fracname) if (merge_type /= 'unset' .and. merge_field /= 'unset') then @@ -291,17 +288,11 @@ subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo, num_merge_colon_fields = merge_listGetNum(merge_fields) do nm = 1,num_merge_colon_fields ! Determine merge field name from source field - if (num_merge_fields == 1) then - merge_field = trim(merge_fields) - else - call merge_listGetName(merge_fields, nm, merge_field, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + call merge_listGetName(merge_fields, nm, merge_field, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Initialize initial output field data to zero before doing merge if (zero_output) then - call ESMF_FieldGet(fieldlist(nfld_out), ungriddedUBound=ungriddedUbound_out, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return if (ungriddedUBound_out(1) > 0) then call ESMF_FieldGet(fieldlist(nfld_out), farrayPtr=dataptr2d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -322,6 +313,7 @@ subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo, end do ! end of nm loop end if ! end of check of merge_type and merge_field not unset end if ! end of check if stdname and fldname are the same + fldptr => fldptr%next end do ! end of loop over fldsListTo end do ! end of loop over fields in FBOut @@ -364,6 +356,7 @@ subroutine med_merge_auto_field(merge_type, field_out, ungriddedUBound_out, & real(R8), pointer :: dpf1(:) real(R8), pointer :: dpf2(:,:) ! intput pointers to 1d and 2d fields real(R8), pointer :: dpw1(:) ! weight pointer + character(CL) :: name character(len=*),parameter :: subname=' (med_merge_mod: med_merge_auto_field)' !--------------------------------------- @@ -398,6 +391,7 @@ 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 + if (ungriddedUBound_out(1) > 0) then call ESMF_FieldGet(field_in, farrayPtr=dpf2, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From 13020c75515e5de438625aa619d4615707b87720 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 21 Nov 2022 13:07:59 -0700 Subject: [PATCH 133/395] some cleanup --- mediator/esmFlds.F90 | 46 +++++++++++--------------------------------- 1 file changed, 11 insertions(+), 35 deletions(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index bbe60fc45..3786bb7ac 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -17,9 +17,7 @@ module esmflds public :: med_fldList_AddFldFrom public :: med_fldList_AddMapFrom -! public :: med_fldList_AddMrgFrom public :: med_fldList_AddFldTo -! public :: med_fldList_AddMapTo public :: med_fldList_AddMrgTo public :: med_fldList_AddOcnalbFld @@ -206,7 +204,6 @@ subroutine med_fldList_AddFld(fields, stdname, shortname) call med_fldList_findName(fields, stdname, found, newfld) ! create new entry if fldname is not in original list - mapsize = ncomps mrgsize = ncomps @@ -242,24 +239,7 @@ subroutine med_fldList_AddFld(fields, stdname, shortname) end subroutine med_fldList_AddFld !================================================================================ -! subroutine med_fldList_AddMrgFrom(index, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname, rc) - ! ---------------------------------------------- - ! Determine mrg entry or entries in flds aray - ! ---------------------------------------------- - ! input/output variables -! integer , intent(in) :: index -! character(len=*) , intent(in) :: fldname -! integer , intent(in) :: mrg_from -! character(len=*) , intent(in) :: mrg_fld -! character(len=*) , intent(in) :: mrg_type -! character(len=*) , intent(in), optional :: mrg_fracname -! integer , intent(out), optional :: rc - -! call med_FldList_addMrg(fldListFr(index)%fields, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname) - -! end subroutine med_fldList_AddMrgFrom - !================================================================================ subroutine med_fldList_AddMrgTo(index, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname, rc) ! ---------------------------------------------- @@ -278,6 +258,9 @@ subroutine med_fldList_AddMrgTo(index, fldname, mrg_from, mrg_fld, mrg_type, mrg call med_FldList_addMrg(fldListTo(index)%fields, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname) end subroutine med_fldList_AddMrgTo + + !================================================================================ + subroutine med_fldList_AddMrg(flds, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname) ! ---------------------------------------------- @@ -336,7 +319,9 @@ function med_fldList_GetFld(fields, fldname, rc) result(newfld) endif end function med_fldList_GetFld + !================================================================================ + subroutine med_fldList_AddMapFrom(index, fldname, destcomp, maptype, mapnorm, mapfile) integer, intent(in) :: index character(len=*) , intent(in) :: fldname @@ -348,22 +333,9 @@ subroutine med_fldList_AddMapFrom(index, fldname, destcomp, maptype, mapnorm, ma call med_fldList_AddMap(FldListFr(index)%fields, fldname, destcomp, maptype, mapnorm, mapfile) end subroutine med_fldList_AddMapFrom + !================================================================================ -! subroutine med_fldList_AddMapTo(index, fldname, destcomp, maptype, mapnorm, mapfile) -! integer, intent(in) :: index -! character(len=*) , intent(in) :: fldname -! integer , intent(in) :: destcomp -! integer , intent(in) :: maptype -! character(len=*) , intent(in) :: mapnorm -! character(len=*), optional , intent(in) :: mapfile -! -! if(index == compice .and. trim(fldname) .eq. 'cpl_scalars') then -! call ESMF_Finalize(endflag=ESMF_END_ABORT) -! endif -! call med_fldList_AddMap(FldListTo(index)%fields, fldname, destcomp, maptype, mapnorm, mapfile) -! -! end subroutine med_fldList_AddMapTo - !================================================================================ + subroutine med_fldList_AddaofluxMap(fldname, destcomp, maptype, mapnorm, mapfile) character(len=*) , intent(in) :: fldname integer , intent(in) :: destcomp @@ -375,6 +347,8 @@ subroutine med_fldList_AddaofluxMap(fldname, destcomp, maptype, mapnorm, mapfile end subroutine med_fldList_AddaofluxMap + !================================================================================ + subroutine med_fldList_AddocnalbMap(fldname, destcomp, maptype, mapnorm, mapfile) character(len=*) , intent(in) :: fldname integer , intent(in) :: destcomp @@ -386,6 +360,8 @@ subroutine med_fldList_AddocnalbMap(fldname, destcomp, maptype, mapnorm, mapfile end subroutine med_fldList_AddocnalbMap + !================================================================================ + subroutine med_fldList_AddMap(fields, fldname, destcomp, maptype, mapnorm, mapfile) use ESMF, only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_LogWrite, ESMF_LOGMSG_INFO From 662e171fff1d7f772bd5543c289a5a9a880b1ff3 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Mon, 21 Nov 2022 14:10:06 -0700 Subject: [PATCH 134/395] more clean-up --- mediator/esmFlds.F90 | 12 ++++-------- mediator/med_merge_mod.F90 | 2 +- 2 files changed, 5 insertions(+), 9 deletions(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index 3786bb7ac..e2d16efe3 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -166,16 +166,12 @@ subroutine med_fldList_findName(fields, stdname, found, lastfld) lastfld => fields found = .false. do while(associated(lastfld%next)) - if (trim(stdname) == trim(lastfld%stdname)) then - found = .true. - exit - end if + if (trim(stdname) == trim(lastfld%stdname)) exit lastfld => lastfld%next enddo - ! Check the last lastfld - if (trim(stdname) == trim(lastfld%stdname)) then - found = .true. - end if + ! Check the lastfld + if (trim(stdname) == trim(lastfld%stdname)) found = .true. + end subroutine med_fldList_findName subroutine med_fldList_AddFld(fields, stdname, shortname) diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index c984b1e3f..e44b2e19e 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -74,7 +74,7 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f character(CS) :: merge_type character(CS) :: merge_fracname character(CS), pointer :: merge_field_names(:) - logical :: error_check = .true. ! TODO: make this an input argument + logical :: error_check = .false. ! TODO: make this an input argument integer :: ungriddedUBound_out(1) ! size of ungridded dimension integer :: fieldcount character(CL) , pointer :: fieldnamelist(:) From 40ba09b30201f461c25df137e3f3c8d01e3ae757 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 21 Nov 2022 15:48:11 -0700 Subject: [PATCH 135/395] more list translation --- mediator/med.F90 | 7 ++++--- mediator/med_map_mod.F90 | 35 +++++++++++++++++++++-------------- mediator/med_merge_mod.F90 | 2 -- 3 files changed, 25 insertions(+), 19 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index f62b0d3db..c3ea331eb 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -875,9 +875,9 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) if (ncomp /= compmed) then if (mastertask) write(logunit,*) fldListFr => med_fldList_GetFldListFr(ncomp) - nflds = med_fldList_GetNumFlds(fldListFr) - do n=1,nflds - call med_fldList_GetFldInfo(fldListFr, n, stdname=stdname, shortname=shortname) + fld => fldListFr%fields + do while(associated(fld)) + call med_fld_GetFldInfo(fld, stdname=stdname, shortname=shortname) if (mastertask) then write(logunit,'(a)') trim(subname)//':Fr_'//trim(compname(ncomp))//': '//trim(shortname) end if @@ -891,6 +891,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) TransferOfferGeomObject=transferOffer, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//':Fr_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) + fld => fld%next end do fldListTo => med_fldList_GetFldListTo(ncomp) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 5ecf488ad..8cac3e5db 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -83,8 +83,8 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun use ESMF , only : ESMF_Mesh, ESMF_TYPEKIND_R8, ESMF_MESHLOC_ELEMENT use med_methods_mod , only : med_methods_FB_getFieldN, med_methods_FB_getNameN use med_constants_mod , only : czero => med_constants_czero - use esmFlds , only : med_fldList_GetfldListFr, med_fldList_GetNumFlds, med_fldlist_type - use esmFlds , only : med_fldList_GetFldInfo + use esmFlds , only : med_fldList_GetfldListFr, med_fldlist_type + use esmFlds , only : med_fld_GetFldInfo, med_fldList_entry_type use med_internalstate_mod , only : mapunset, compname, compocn, compatm use med_internalstate_mod , only : ncomps, nmappers, compname, mapnames, mapfcopy @@ -111,6 +111,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun type(ESMF_Mesh) :: mesh_src type(ESMF_Mesh) :: mesh_dst type(med_fldlist_type), pointer :: FldListFr + type(med_fldlist_entry_type), pointer :: fldptr character(len=*), parameter :: subname=' (module_med_map: RouteHandles_init) ' !----------------------------------------------------------- @@ -159,10 +160,11 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun ! Loop over fields fldListFr => med_fldList_getFldListFr(n1) - do nf = 1,med_fldList_GetNumFlds(fldlistFr) - + fldptr => fldListFr%fields + nf = 0 + do while(associated(fldptr)) ! Determine the mapping type for mapping field nf from n1 to n2 - call med_fldList_GetFldInfo(fldListFr, nf, compsrc=n2, mapindex=mapindex) + call med_fld_GetFldInfo(fldptr, compsrc=n2, mapindex=mapindex) if (mapindex /= mapunset) then ! determine if route handle has already been created @@ -173,13 +175,14 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun ! (i.e. mapindex /= mapunset) and route handle has not already been created if (.not. mapexists) then !~ mapfile = trim(fldListFr%fields(nf)%mapfile(n2)) - call med_fldList_GetFldInfo(fldListFr, nf, compsrc=n2, mapfile=mapfile) + call med_fld_GetFldInfo(fldptr, compsrc=n2, mapfile=mapfile) call med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, & mapindex, is_local%wrap%rh(n1,n2,:), mapfile=trim(mapfile), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if end if ! end if mapindex is mapunset + fldptr => fldptr%next end do ! loop over fields @@ -717,7 +720,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & use ESMF use esmFlds , only : med_fldList_entry_type, med_fldList_getNumFlds, med_fldList_type - use esmFlds , only : med_fldList_getFldInfo + use esmFlds , only : med_fld_getFldInfo use med_internalstate_mod , only : nmappers use med_internalstate_mod , only : ncomps, compatm, compice, compocn, compname, mapnames use med_internalstate_mod , only : packed_data_type @@ -725,7 +728,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & ! input/output variables integer , intent(in) :: destcomp character(len=*) , intent(in) :: flds_scalar_name - type(med_fldList_type) , intent(in) :: fieldsSrc ! mapping types top of LL + type(med_fldList_type) , intent(in), target :: fieldsSrc ! mapping types top of LL type(ESMF_FieldBundle) , intent(in) :: FBSrc type(ESMF_FieldBundle) , intent(inout) :: FBDst type(packed_data_type) , intent(inout) :: packed_data(:) ! array over mapping types @@ -747,6 +750,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & integer :: numFlds type(ESMF_Field), pointer :: fieldlist_src(:) type(ESMF_Field), pointer :: fieldlist_dst(:) + type(med_fldlist_entry_type), pointer :: fldptr character(CL) :: shortname integer :: destindex character(CL), allocatable :: fieldNameList(:) @@ -797,21 +801,21 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & ! Determine the normalization type for each packed_data mapping element ! Loop over mapping types - numflds = med_fldlist_GetNumFlds(fieldsSrc) do mapindex = 1,nmappers mapnorm_mapindex = 'not_set' ! Loop over source field bundle do nf = 1, fieldCount ! Loop over the fldsSrc types - do ns = 1,numflds + fldptr => fieldsSrc%fields + do while(associated(fldptr)) ! Note that fieldnamelist is an array of names for the source fields ! The assumption is that there is only one mapping normalization ! for any given mapping type - call med_fldList_GetFldInfo(fieldsSrc, ns, compsrc=destcomp, shortname=shortname, mapindex=destindex) + call med_fld_GetFldInfo(fldptr, compsrc=destcomp, shortname=shortname, mapindex=destindex) if ( destindex == mapindex .and. & trim(shortname) == trim(fieldnamelist(nf))) then ! Set the normalization to the input - call med_FldList_GetFldInfo(fieldsSrc, ns, compsrc=destcomp, mapnorm=packed_data(mapindex)%mapnorm) + call med_Fld_GetFldInfo(fldptr, compsrc=destcomp, mapnorm=packed_data(mapindex)%mapnorm) if (mapnorm_mapindex == 'not_set') then mapnorm_mapindex = packed_data(mapindex)%mapnorm write(tmpstr,*)'Map type '//trim(mapnames(mapindex)) & @@ -831,6 +835,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & end if end if end if + fldptr => fldptr%next end do end do end do @@ -852,8 +857,9 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & do nf = 1, fieldCount ! Loop over the fldsSrc types - do ns = 1,numFlds - call med_fldList_GetFldInfo(fieldsSrc, ns, compsrc=destcomp, shortname=shortname, mapindex=destIndex) + fldptr => fieldsSrc%fields + do while(associated(fldptr)) + call med_fld_GetFldInfo(fldptr, compsrc=destcomp, shortname=shortname, mapindex=destIndex) if ( destIndex == mapindex .and. & trim(shortname) == trim(fieldnamelist(nf))) then @@ -884,6 +890,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & end if end if! end if source field is mapped to destination field with mapindex + fldptr => fldptr%next end do ! end loop over FBSrc fields end do ! end loop over fldsSrc elements diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index e44b2e19e..e06ea3476 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -12,10 +12,8 @@ module med_merge_mod use med_methods_mod , only : FB_FldChk => med_methods_FB_FldChk use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr use esmFlds , only : med_fldList_type - use esmFlds , only : med_fldList_GetNumFlds use esmFlds , only : med_fld_GetFldInfo use esmFlds , only : med_fldList_entry_type - use esmFlds , only : med_fldList_GetFldNames use perf_mod , only : t_startf, t_stopf implicit none From 75650c9053513c75c49e34c4c71c03724469e931 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 22 Nov 2022 07:51:34 -0700 Subject: [PATCH 136/395] more loop structure changes --- mediator/med_phases_prep_rof_mod.F90 | 30 ++++++++++++++-------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index a30d67c6f..6ca1e85b4 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -80,8 +80,8 @@ subroutine med_phases_prep_rof_init(gcomp, rc) use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleGet, ESMF_FieldBundleAdd use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_TYPEKIND_R8 - use esmFlds , only : med_fldList_GetfldListFr, med_fldList_GetfldlistTo, med_fldlist_GetNumFlds, med_fldlist_getFldInfo - use esmFlds , only : med_fldList_type + use esmFlds , only : med_fldList_GetfldListFr, med_fldList_GetfldlistTo, med_fldlist_GetNumFlds, med_fld_getFldInfo + use esmFlds , only : med_fldList_type, med_fldList_entry_type use med_map_mod , only : med_map_packed_field_create ! input/output variables @@ -95,6 +95,8 @@ subroutine med_phases_prep_rof_init(gcomp, rc) type(ESMF_Mesh) :: mesh_r type(ESMF_Field) :: lfield type(med_fldList_type), pointer :: fldList + type(med_fldList_entry_type), pointer :: fldptr + character(len=CS) :: fldname character(len=CS), allocatable :: fldnames_temp(:) character(len=*),parameter :: subname=' (med_phases_prep_rof_init) ' !--------------------------------------- @@ -111,23 +113,21 @@ subroutine med_phases_prep_rof_init(gcomp, rc) fldList => med_fldList_GetfldlistTo(comprof) nflds = med_fldlist_getnumflds(fldList) allocate(fldnames_temp(nflds)) - do n = 1,nflds - call med_fldList_GetFldInfo(fldList, n, stdname=fldnames_temp(n)) - end do - do n = 1,nflds - if (trim(fldnames_temp(n)) == trim(is_local%wrap%flds_scalar_name)) then - do n1 = n, nflds-1 - fldnames_temp(n1) = fldnames_temp(n1+1) - enddo - nflds = nflds - 1 + fldptr => fldList%fields + n = 0 + do while(associated(fldptr)) + n = n+1 + call med_fld_GetFldInfo(fldptr, stdname=fldname) + if (trim(fldname) .ne. trim(is_local%wrap%flds_scalar_name)) then + fldnames_temp(n) = fldname endif + fldptr => fldptr%next enddo - allocate(lnd2rof_flds(nflds)) - do n = 1,nflds - lnd2rof_flds(n) = trim(fldnames_temp(n)) - end do + allocate(lnd2rof_flds(n)) + lnd2rof_flds = fldnames_temp(1:n) deallocate(fldnames_temp) + ! Get lnd and rof meshes call fldbun_getmesh(is_local%wrap%FBImp(complnd,complnd), mesh_l, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From 5c653fcf15289f959fce6da4c4ac693cbf8586d8 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 23 Nov 2022 10:49:59 -0700 Subject: [PATCH 137/395] fix a pointer bug --- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 4 +- mediator/esmFlds.F90 | 17 +- mediator/med.F90 | 30 +-- mediator/med_merge_mod.F90 | 214 ++++++++++----------- mediator/med_phases_ocnalb_mod.F90 | 2 + mediator/med_phases_prep_rof_mod.F90 | 16 +- 6 files changed, 140 insertions(+), 143 deletions(-) diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index 8d472902b..ad6adfee3 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -149,8 +149,6 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) rc = ESMF_SUCCESS - shrlogunit = 6 - if (mastertask) then call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -170,6 +168,8 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) else logUnit = 6 endif + shrlogunit = logunit + ! TODO: shr_file mod is deprecated and should be removed. call shr_file_setLogUnit (logunit) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index e2d16efe3..c1334bdac 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -3,7 +3,7 @@ module esmflds use ESMF, only : ESMF_FINALIZE, ESMF_END_ABORT 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 : ncomps, compname, compocn, compatm, compice + use med_internalstate_mod, only : ncomps, compname, compocn, compatm, compice, comprof use med_internalstate_mod, only : mapfcopy, mapnames, mapunset use med_utils_mod , only : chkerr => med_utils_ChkErr implicit none @@ -29,7 +29,7 @@ module esmflds private :: med_fldList_AddFld private :: med_fldList_AddMap private :: med_fldList_AddMrg - private :: med_fldList_findName + public :: med_fldList_findName public :: med_fldList_GetFldNames public :: med_fldList_GetNumFlds public :: med_fldList_GetFldInfo @@ -48,6 +48,7 @@ module esmflds type, public :: med_fldList_entry_type character(CS) :: stdname character(CS) :: shortname + type(med_fldList_entry_type), pointer :: next => null() ! Mapping fldsFr data - for mediator import fields integer , allocatable :: mapindex(:) @@ -58,7 +59,6 @@ module esmflds character(CS), allocatable :: merge_fields(:) character(CS), allocatable :: merge_types(:) character(CS), allocatable :: merge_fracnames(:) - type(med_fldList_entry_type), pointer :: next => null() end type med_fldList_entry_type ! The above would be the field name to merge from @@ -158,7 +158,7 @@ end subroutine med_fldList_AddFldTo subroutine med_fldList_findName(fields, stdname, found, lastfld) ! on return if found == .true. lastfield is the field matching stdname ! if found == .false. lastfield is the last field in the list - type(med_fldList_entry_type) , intent(in), target :: fields + type(med_fldList_entry_type) , intent(in), target :: fields character(len=*) , intent(in) :: stdname logical , intent(out) :: found type(med_fldList_entry_type) , intent(out), pointer :: lastfld @@ -252,7 +252,7 @@ subroutine med_fldList_AddMrgTo(index, fldname, mrg_from, mrg_fld, mrg_type, mrg integer , intent(out), optional :: rc call med_FldList_addMrg(fldListTo(index)%fields, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname) - + end subroutine med_fldList_AddMrgTo !================================================================================ @@ -279,7 +279,6 @@ subroutine med_fldList_AddMrg(flds, fldname, mrg_from, mrg_fld, mrg_type, mrg_fr newfld => med_fldList_GetFld(flds, fldname, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - newfld%merge_fields(mrg_from) = mrg_fld newfld%merge_types(mrg_from) = mrg_type if (present(mrg_fracname)) then @@ -649,7 +648,11 @@ subroutine med_fldList_GetFldInfo(fldList, fldindex, compsrc, stdname, shortname if (i==fldindex) exit newfld => newfld%next enddo - + if( .not. associated(newfld)) then + call ESMF_LogWrite(subname//' No field found', ESMF_LOGMSG_ERROR) + if(present(rc)) rc = ESMF_FAILURE + return + endif call med_fld_GetFldInfo(newfld, compsrc, stdname, shortname, mapindex, mapFile, mapnorm, merge_fields, merge_type, merge_fracname, rc) end subroutine med_fldList_GetFldInfo diff --git a/mediator/med.F90 b/mediator/med.F90 index c3ea331eb..11d5d6747 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -550,6 +550,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) use med_internalstate_mod, only : mastertask, logunit, diagunit #ifdef CESMCOUPLED use nuopc_shr_methods, only : set_component_logging + use shr_log_mod, only : shr_log_unit #endif type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -561,7 +562,6 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) character(len=CL) :: cvalue integer :: localPet integer :: i - integer :: shrlogunit logical :: isPresent, isSet character(len=CX) :: msgString character(len=CX) :: diro @@ -593,7 +593,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) logfile = 'mediator.log' end if #ifdef CESMCOUPLED - call set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) + call set_component_logging(gcomp, mastertask, logunit, shr_log_unit, rc) #else open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) #endif @@ -1813,17 +1813,18 @@ subroutine DataInitialize(gcomp, rc) do ndst = 1,ncomps do nsrc = 1,ncomps if (is_local%wrap%med_coupling_active(nsrc,ndst)) then - call med_map_packed_field_create(ndst, & - is_local%wrap%flds_scalar_name, & - fieldsSrc=med_fldList_GetfldListFr(nsrc), & - FBSrc=is_local%wrap%FBImp(nsrc,nsrc), & - FBDst=is_local%wrap%FBImp(nsrc,ndst), & - packed_data=is_local%wrap%packed_data(nsrc,ndst,:), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do - end do - if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o) .and. & + call med_map_packed_field_create(ndst, & + is_local%wrap%flds_scalar_name, & + fieldsSrc=med_fldList_GetfldListFr(nsrc), & + FBSrc=is_local%wrap%FBImp(nsrc,nsrc), & + FBDst=is_local%wrap%FBImp(nsrc,ndst), & + packed_data=is_local%wrap%packed_data(nsrc,ndst,:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end do + end do + + if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o) .and. & ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a)) then call med_map_packed_field_create(compatm, & is_local%wrap%flds_scalar_name, & @@ -1833,7 +1834,6 @@ subroutine DataInitialize(gcomp, rc) packed_data=is_local%wrap%packed_data_ocnalb_o2a(:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - !--------------------------------------- ! Initialize ocn export accumulation field bundle !--------------------------------------- @@ -1869,7 +1869,6 @@ subroutine DataInitialize(gcomp, rc) call med_phases_prep_rof_init(gcomp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - !--------------------------------------- ! Set the data initialize flag to false !--------------------------------------- @@ -2174,6 +2173,7 @@ subroutine DataInitialize(gcomp, rc) ESMF_LOGMSG_INFO) end if + if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index e06ea3476..2f2cf42f8 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -14,6 +14,7 @@ module med_merge_mod use esmFlds , only : med_fldList_type use esmFlds , only : med_fld_GetFldInfo use esmFlds , only : med_fldList_entry_type + use esmFlds , only : med_fldList_findName use perf_mod , only : t_startf, t_stopf implicit none @@ -80,6 +81,7 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f real(r8), pointer :: dataptr1d(:) real(r8), pointer :: dataptr2d(:,:) logical :: zero_output + logical :: found character(len=*),parameter :: subname=' (module_med_merge_mod: med_merge_auto)' !--------------------------------------- @@ -108,83 +110,76 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f call ESMF_FieldGet(fieldlist(nfld_out), ungriddedUBound=ungriddedUbound_out, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Loop over the field in fldListTo - fldptr => fldListTo%fields - nfld_in = 0 - do while(associated(fldptr)) - nfld_in = nfld_in + 1 - if (trim(fldptr%stdname) == trim(fieldnamelist(nfld_out))) then - - ! Loop over all possible source components in the merging arrays returned from the above call - ! If the merge field name from the source components is not set, then simply go to the next component - do compsrc = 1,size(FBImp) - - ! Cycle if coupling is not active or mediator input is not present and compsrc is mediator - if (compsrc == compmed) then - if (.not. present(FBMed1) .and. .not. present(FBMed2)) then - CYCLE - end if - else if (.not. coupling_active(compsrc)) then + ! Find the next fieldname + call med_fldList_findName(fldListTo%fields, fieldnamelist(nfld_out), found, fldptr) + if (found) then + ! Loop over all possible source components in the merging arrays returned from the above call + ! If the merge field name from the source components is not set, then simply go to the next component + do compsrc = 1,size(FBImp) + ! Cycle if coupling is not active or mediator input is not present and compsrc is mediator + if (compsrc == compmed) then + if (.not. present(FBMed1) .and. .not. present(FBMed2)) then CYCLE end if + else if (.not. coupling_active(compsrc)) then + CYCLE + end if - ! Determine the merge information for the import field - call med_fld_GetFldInfo(fldptr, compsrc=compsrc, merge_fields=merge_fields, merge_type=merge_type, merge_fracname=merge_fracname, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Determine the merge information for the import field + call med_fld_GetFldInfo(fldptr, compsrc=compsrc, merge_fields=merge_fields, merge_type=merge_type, merge_fracname=merge_fracname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - if (merge_type /= 'unset' .and. merge_field /= 'unset') then + if (merge_type /= 'unset' .and. merge_field /= 'unset') then ! If merge_field is a colon delimited string then cycle through every field - otherwise by default nm ! will only equal 1 - num_merge_colon_fields = merge_listGetNum(merge_fields) - do nm = 1,num_merge_colon_fields - ! Determine merge field name from source field - call merge_listGetName(merge_fields, nm, merge_field, rc) + num_merge_colon_fields = merge_listGetNum(merge_fields) + do nm = 1,num_merge_colon_fields + ! Determine merge field name from source field + call merge_listGetName(merge_fields, nm, merge_field, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Perform error checks + if (error_check) then + call med_merge_auto_errcheck(compsrc, fieldnamelist(nfld_out), fieldlist(nfld_out), & + ungriddedUBound_out, trim(merge_field), FBImp(compsrc), & + FBMed1=FBMed1, FBMed2=FBMed2, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Perform error checks - if (error_check) then - call med_merge_auto_errcheck(compsrc, fieldnamelist(nfld_out), fieldlist(nfld_out), & - ungriddedUBound_out, trim(merge_field), FBImp(compsrc), & - FBMed1=FBMed1, FBMed2=FBMed2, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if ! end of error check - - ! Initialize initial output field data to zero before doing merge - if (zero_output) then - if (ungriddedUBound_out(1) > 0) then - call ESMF_FieldGet(fieldlist(nfld_out), farrayPtr=dataptr2d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - dataptr2d(:,:) = czero - else - call ESMF_FieldGet(fieldlist(nfld_out), farrayPtr=dataptr1d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - dataptr1d(:) = czero - end if - zero_output = .false. - end if + end if ! end of error check - ! Perform merge - if ((present(FBMed1) .or. present(FBMed2)) .and. compsrc == compmed) then - if (FB_FldChk(FBMed1, trim(merge_field), rc=rc)) then - call med_merge_auto_field(trim(merge_type), fieldlist(nfld_out), ungriddedUBound_out, & - FB=FBMed1, FBFld=merge_field, FBw=FBfrac, fldw=trim(merge_fracname), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (FB_FldChk(FBMed2, trim(merge_field), rc=rc)) then - call med_merge_auto_field(trim(merge_type), fieldlist(nfld_out), ungriddedUBound_out, & - FB=FBMed2, FBFld=merge_field, FBw=FBfrac, fldw=trim(merge_fracname), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + ! Initialize initial output field data to zero before doing merge + if (zero_output) then + if (ungriddedUBound_out(1) > 0) then + call ESMF_FieldGet(fieldlist(nfld_out), farrayPtr=dataptr2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr2d(:,:) = czero else + call ESMF_FieldGet(fieldlist(nfld_out), farrayPtr=dataptr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr1d(:) = czero + end if + zero_output = .false. + end if + + ! Perform merge + if ((present(FBMed1) .or. present(FBMed2)) .and. compsrc == compmed) then + if (FB_FldChk(FBMed1, trim(merge_field), rc=rc)) then + call med_merge_auto_field(trim(merge_type), fieldlist(nfld_out), ungriddedUBound_out, & + FB=FBMed1, FBFld=merge_field, FBw=FBfrac, fldw=trim(merge_fracname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else if (FB_FldChk(FBMed2, trim(merge_field), rc=rc)) then call med_merge_auto_field(trim(merge_type), fieldlist(nfld_out), ungriddedUBound_out, & - FB=FBImp(compsrc), FBFld=merge_field, FBw=FBfrac, fldw=trim(merge_fracname), rc=rc) + FB=FBMed2, FBFld=merge_field, FBw=FBfrac, fldw=trim(merge_fracname), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + else + call med_merge_auto_field(trim(merge_type), fieldlist(nfld_out), ungriddedUBound_out, & + FB=FBImp(compsrc), FBFld=merge_field, FBw=FBfrac, fldw=trim(merge_fracname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - end do ! end of nm loop - end if ! end of check of merge_type and merge_field not unset - end do ! end of compsrc loop - end if ! end of check if stdname and fldname are the same - fldptr => fldptr%next - end do ! end of loop over fldsListTo + end do ! end of nm loop + end if ! end of check of merge_type and merge_field not unset + end do ! end of compsrc loop + end if ! end if found end do ! end of loop over fields in FBOut deallocate(fieldnamelist) @@ -213,7 +208,6 @@ subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo, use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR use ESMF , only : ESMF_LogSetError - ! input/output variables integer , intent(in) :: compsrc type(ESMF_FieldBundle) , intent(inout) :: FBOut ! Merged output field bundle @@ -239,6 +233,7 @@ subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo, real(r8), pointer :: dataptr1d(:) real(r8), pointer :: dataptr2d(:,:) logical :: zero_output + logical :: found character(len=*),parameter :: subname=' (module_med_merge_mod: med_merge_auto)' !--------------------------------------- @@ -264,55 +259,43 @@ subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo, call ESMF_FieldGet(fieldlist(nfld_out), ungriddedUBound=ungriddedUbound_out, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Loop over the field in fldListTo to get fieldname and merging type - fldptr => fldListTo%fields - nfld_in = 0 - do while(associated(fldptr)) - nfld_in = nfld_in+1 - call med_fld_GetFldInfo(fldptr, stdname=merge_field_name, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (trim(merge_field_name) == trim(fieldnamelist(nfld_out))) then - - ! Loop over all possible source components in the merging arrays returned from the above call - ! If the merge field name from the source components is not set, then simply go to the next component - - ! Determine the merge information for the import field - call med_fld_GetFldInfo(fldptr, compsrc=compsrc, merge_fields=merge_fields, merge_type=merge_type, merge_fracname=merge_fracname) - - if (merge_type /= 'unset' .and. merge_field /= 'unset') then - - ! If merge_field is a colon delimited string then cycle through every field - otherwise by default nm - ! will only equal 1 - num_merge_colon_fields = merge_listGetNum(merge_fields) - do nm = 1,num_merge_colon_fields - ! Determine merge field name from source field - call merge_listGetName(merge_fields, nm, merge_field, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Initialize initial output field data to zero before doing merge - if (zero_output) then - if (ungriddedUBound_out(1) > 0) then - call ESMF_FieldGet(fieldlist(nfld_out), farrayPtr=dataptr2d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - dataptr2d(:,:) = czero - else - call ESMF_FieldGet(fieldlist(nfld_out), farrayPtr=dataptr1d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - dataptr1d(:) = czero - end if - zero_output = .false. + ! Find the next fieldname + call med_fldList_findName(fldListTo%fields, fieldnamelist(nfld_out), found, fldptr) + if(found) then + ! Determine the merge information for the import field + call med_fld_GetFldInfo(fldptr, compsrc=compsrc, merge_fields=merge_fields, merge_type=merge_type, merge_fracname=merge_fracname) + if (merge_type /= 'unset' .and. merge_fields /= 'unset') then + + ! If merge_field is a colon delimited string then cycle through every field - otherwise by default nm + ! will only equal 1 + num_merge_colon_fields = merge_listGetNum(merge_fields) + do nm = 1,num_merge_colon_fields + ! Determine merge field name from source field + call merge_listGetName(merge_fields, nm, merge_field, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Initialize initial output field data to zero before doing merge + if (zero_output) then + if (ungriddedUBound_out(1) > 0) then + call ESMF_FieldGet(fieldlist(nfld_out), farrayPtr=dataptr2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr2d(:,:) = czero + else + call ESMF_FieldGet(fieldlist(nfld_out), farrayPtr=dataptr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr1d(:) = czero end if - - ! Perform merge - call med_merge_auto_field(trim(merge_type), fieldlist(nfld_out), ungriddedUBound_out, & - FB=FBIn, FBFld=merge_field, FBw=FBfrac, fldw=trim(merge_fracname), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - end do ! end of nm loop - end if ! end of check of merge_type and merge_field not unset - end if ! end of check if stdname and fldname are the same - fldptr => fldptr%next - end do ! end of loop over fldsListTo + zero_output = .false. + end if + + ! Perform merge + call med_merge_auto_field(trim(merge_type), fieldlist(nfld_out), ungriddedUBound_out, & + FB=FBIn, FBFld=merge_field, FBw=FBfrac, fldw=trim(merge_fracname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end do ! end of nm loop + end if ! end of check of merge_type and merge_field not unset + end if ! end of check if stdname and fldname are the same end do ! end of loop over fields in FBOut deallocate(fieldnamelist) @@ -748,7 +731,10 @@ subroutine merge_listGetName(list, k, name, rc) !--------------------------------------- rc = ESMF_SUCCESS - + if(k==1) then + name = trim(list) + return + endif ! check that this is a valid list valid_list = .true. nChar = len_trim(list) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 1fe8fb502..0fd6773c1 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -11,6 +11,7 @@ module med_phases_ocnalb_mod #ifdef CESMCOUPLED use shr_orb_mod , only : shr_orb_cosz, shr_orb_decl use shr_orb_mod , only : shr_orb_params, SHR_ORB_UNDEF_INT, SHR_ORB_UNDEF_REAL + use shr_log_mod , only : shr_log_unit #endif implicit none @@ -594,6 +595,7 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, end if eccen = orb_eccen + shr_log_unit = logunit call shr_orb_params(orb_year, eccen, orb_obliq, orb_mvelp, obliqr, lambm0, mvelpp, lprint) if ( eccen == SHR_ORB_UNDEF_REAL .or. obliqr == SHR_ORB_UNDEF_REAL .or. & diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 6ca1e85b4..0a8999231 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -116,9 +116,9 @@ subroutine med_phases_prep_rof_init(gcomp, rc) fldptr => fldList%fields n = 0 do while(associated(fldptr)) - n = n+1 call med_fld_GetFldInfo(fldptr, stdname=fldname) if (trim(fldname) .ne. trim(is_local%wrap%flds_scalar_name)) then + n = n+1 fldnames_temp(n) = fldname endif fldptr => fldptr%next @@ -127,7 +127,6 @@ subroutine med_phases_prep_rof_init(gcomp, rc) lnd2rof_flds = fldnames_temp(1:n) deallocate(fldnames_temp) - ! Get lnd and rof meshes call fldbun_getmesh(is_local%wrap%FBImp(complnd,complnd), mesh_l, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -139,6 +138,7 @@ subroutine med_phases_prep_rof_init(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return FBlndAccum2rof_r = ESMF_FieldBundleCreate(name='FBlndAccum2rof_r', rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(lnd2rof_flds) lfield = ESMF_FieldCreate(mesh_l, ESMF_TYPEKIND_R8, name=lnd2rof_flds(n), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -155,13 +155,17 @@ subroutine med_phases_prep_rof_init(gcomp, rc) end do ! Initialize field bundles and accumulation count + call fldbun_reset(FBlndAccum2rof_l, value=0.0_r8, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_reset(FBlndAccum2rof_r, value=0.0_r8, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return lndAccum2rof_cnt = 0 - fldList = med_fldList_GetFldListFr(complnd) + + fldList => med_fldList_GetFldListFr(complnd) ! Create packed mapping from rof->lnd + call med_map_packed_field_create(destcomp=comprof, & flds_scalar_name=is_local%wrap%flds_scalar_name, & fieldsSrc=fldList, & @@ -262,7 +266,7 @@ subroutine med_phases_prep_rof(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use esmFlds , only : med_fldList_GetfldListTo + use esmFlds , only : med_fldList_GetfldListTo, med_fldList_type use med_map_mod , only : med_map_field_packed use med_merge_mod , only : med_merge_auto use med_constants_mod , only : czero => med_constants_czero @@ -283,6 +287,7 @@ subroutine med_phases_prep_rof(gcomp, rc) type(ESMF_Field) :: lfield_src type(ESMF_Field) :: lfield_dst type(ESMF_Field) :: field_lfrac_lnd + type(med_fldList_type), pointer :: fldList character(CL), pointer :: lfieldnamelist(:) character(len=*),parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof)' !--------------------------------------- @@ -301,6 +306,7 @@ subroutine med_phases_prep_rof(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + fldList => med_fldList_GetfldListTo(comprof) !--------------------------------------- ! Average import from land accumuled FB !--------------------------------------- @@ -374,7 +380,7 @@ subroutine med_phases_prep_rof(gcomp, rc) end if call med_merge_auto(compsrc=complnd, FBout=is_local%wrap%FBExp(comprof), & - FBfrac=is_local%wrap%FBFrac(comprof), FBin=FBlndAccum2rof_r, fldListTo=med_fldList_GetfldListTo(comprof), rc=rc) + FBfrac=is_local%wrap%FBFrac(comprof), FBin=FBlndAccum2rof_r, fldListTo=fldList, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then From 24aff18b776e7c9438329cd373200d5bf773e1d9 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 23 Nov 2022 15:33:23 -0700 Subject: [PATCH 138/395] fix findname --- mediator/esmFlds.F90 | 2 +- mediator/med_merge_mod.F90 | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index c1334bdac..eb57728cf 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -48,7 +48,6 @@ module esmflds type, public :: med_fldList_entry_type character(CS) :: stdname character(CS) :: shortname - type(med_fldList_entry_type), pointer :: next => null() ! Mapping fldsFr data - for mediator import fields integer , allocatable :: mapindex(:) @@ -59,6 +58,7 @@ module esmflds character(CS), allocatable :: merge_fields(:) character(CS), allocatable :: merge_types(:) character(CS), allocatable :: merge_fracnames(:) + type(med_fldList_entry_type), pointer :: next => null() end type med_fldList_entry_type ! The above would be the field name to merge from diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index 2f2cf42f8..7139fffd9 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -731,10 +731,7 @@ subroutine merge_listGetName(list, k, name, rc) !--------------------------------------- rc = ESMF_SUCCESS - if(k==1) then - name = trim(list) - return - endif + ! check that this is a valid list valid_list = .true. nChar = len_trim(list) @@ -748,6 +745,9 @@ subroutine merge_listGetName(list, k, name, rc) valid_list = .false. else if (index(trim(list),listDel2) > 0) then ! found zero length field valid_list = .false. + else if (index(trim(list),listDel) == 0) then ! found a single field + name = trim(list) + return end if if (.not. valid_list) then write(logunit,*) "ERROR: invalid list = ",trim(list) From c6a597f4419f780e5537c647c6c5bac1dc26224b Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sun, 27 Nov 2022 07:56:27 -0700 Subject: [PATCH 139/395] fix wave elevation spectrum for UFS --- mediator/esmFldsExchange_nems_mod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index a1d7784b2..95bdb879d 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -673,15 +673,15 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compwav)) then - call addfld(fldListFr(compwav)%flds, 'Sw_elevation_spectrum') - call addfld(fldListTo(compice)%flds, 'Sw_elevation_spectrum') + call addfldFrom(compwav, 'Sw_elevation_spectrum') + call addfldTo(compice, 'Sw_elevation_spectrum') end if else if ( fldchk(is_local%wrap%FBExp(compice) , 'Sw_elevation_spectrum', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav,compwav), 'Sw_elevation_spectrum', rc=rc)) then - call addmap(fldListFr(compwav)%flds, 'Sw_elevation_spectrum', compice, mapbilnr_nstod, 'one', 'unset') - call addmrg(fldListTo(compice)%flds, 'Sw_elevation_spectrum', & - mrg_from=compwav, mrg_fld='Sw_elevation_spectrum', mrg_type='copy') + call addMapFrom(compwav, 'Sw_elevation_spectrum', compice, mapbilnr_nstod, 'one', 'unset') + call addmrgTo(compice, 'Sw_elevation_spectrum', mrg_from=compwav, & + mrg_fld='Sw_elevation_spectrum', mrg_type='copy') end if end if From c33b88a9f51801388a216c1053a08ce56b3c8d1f Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 28 Nov 2022 07:34:35 -0700 Subject: [PATCH 140/395] add a bit more debug info --- mediator/esmFlds.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index eb57728cf..ec8983c8c 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -758,11 +758,13 @@ subroutine med_fldList_GetFldNames(fields, fldnames, rc) !local variables type(med_fldList_entry_type), pointer :: newfld integer :: n + character(len=CL) :: msg ! ---------------------------------------------- if(present(rc)) rc = ESMF_SUCCESS if (.not. associated(fldnames) .or. .not. allocated(fields%mapindex)) then - call ESMF_LogWrite("med_fldList_GetFldNames: ERROR either fields or fldnames have not been allocate ", & + write(msg, *) "med_fldList_GetFldNames: ERROR either fields or fldnames have not been allocated. ",associated(fldnames), allocated(fields%mapindex) + call ESMF_LogWrite(msg) ESMF_LOGMSG_ERROR) if(present(rc)) rc = ESMF_FAILURE return From d9f141b748e43c4f317544fc7f9ed5fe7beb039d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 28 Nov 2022 07:54:01 -0700 Subject: [PATCH 141/395] add a bit more debug info --- mediator/esmFlds.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index ec8983c8c..7ebcb7edc 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -764,8 +764,7 @@ subroutine med_fldList_GetFldNames(fields, fldnames, rc) if(present(rc)) rc = ESMF_SUCCESS if (.not. associated(fldnames) .or. .not. allocated(fields%mapindex)) then write(msg, *) "med_fldList_GetFldNames: ERROR either fields or fldnames have not been allocated. ",associated(fldnames), allocated(fields%mapindex) - call ESMF_LogWrite(msg) - ESMF_LOGMSG_ERROR) + call ESMF_LogWrite(msg, ESMF_LOGMSG_ERROR) if(present(rc)) rc = ESMF_FAILURE return endif From b4c68ebbfc9a72e5fc25ae1a12d7fc26c836ecf2 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 28 Nov 2022 10:47:55 -0700 Subject: [PATCH 142/395] a fix to get the num field count correct --- mediator/esmFlds.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index 7ebcb7edc..0abbb4b47 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -737,7 +737,7 @@ integer function med_fldList_GetNumFlds(fldList) newfld => fldList%fields med_fldList_GetNumFlds = 0 - do while(associated(newfld)) + do while(allocated(newfld%mapindex)) med_fldList_GetNumFlds = med_fldList_GetNumFlds + 1 newfld => newfld%next end do From 628b134012bfa87e4340b3bf0fa25c85b99074aa Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 28 Nov 2022 13:04:09 -0700 Subject: [PATCH 143/395] add protection --- mediator/esmFlds.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index 0abbb4b47..8d26594d1 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -737,8 +737,10 @@ integer function med_fldList_GetNumFlds(fldList) newfld => fldList%fields med_fldList_GetNumFlds = 0 - do while(allocated(newfld%mapindex)) - med_fldList_GetNumFlds = med_fldList_GetNumFlds + 1 + do while(associated(newfld)) + if(allocated(newfld%mapindex)) then + med_fldList_GetNumFlds = med_fldList_GetNumFlds + 1 + endif newfld => newfld%next end do From eb78801aecb8f481bdd3adb9d659c255429e2146 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 29 Nov 2022 14:12:06 -0700 Subject: [PATCH 144/395] response to git review --- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 1 - mediator/esmFlds.F90 | 109 +- mediator/esmFldsExchange_cesm_mod.F90 | 1942 ++++++++++---------- mediator/esmFldsExchange_hafs_mod.F90 | 56 +- mediator/esmFldsExchange_nems_mod.F90 | 260 +-- mediator/med.F90 | 2 +- mediator/med_phases_prep_atm_mod.F90 | 9 +- mediator/med_phases_prep_lnd_mod.F90 | 7 +- mediator/med_phases_prep_ocn_mod.F90 | 10 +- 9 files changed, 1212 insertions(+), 1184 deletions(-) diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index ad6adfee3..1a6c43c24 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -170,7 +170,6 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) endif shrlogunit = logunit - ! TODO: shr_file mod is deprecated and should be removed. call shr_file_setLogUnit (logunit) end subroutine set_component_logging diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index 8d26594d1..46de218f6 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -3,7 +3,7 @@ module esmflds use ESMF, only : ESMF_FINALIZE, ESMF_END_ABORT 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 : ncomps, compname, compocn, compatm, compice, comprof + use med_internalstate_mod, only : compname, compocn, compatm, compice, comprof use med_internalstate_mod, only : mapfcopy, mapnames, mapunset use med_utils_mod , only : chkerr => med_utils_ChkErr implicit none @@ -15,16 +15,16 @@ module esmflds public :: med_fldList_init1 - public :: med_fldList_AddFldFrom - public :: med_fldList_AddMapFrom - public :: med_fldList_AddFldTo - public :: med_fldList_AddMrgTo + public :: med_fldList_addfld_from + public :: med_fldList_addmap_from + public :: med_fldList_addfld_to + public :: med_fldList_addmrg_to - public :: med_fldList_AddOcnalbFld - public :: med_fldList_AddocnalbMap + public :: med_fldList_addfld_ocnalb + public :: med_fldList_addmap_ocnalb - public :: med_fldList_AddaofluxFld - public :: med_fldList_AddaofluxMap + public :: med_fldList_addfld_aoflux + public :: med_fldList_addmap_aoflux private :: med_fldList_AddFld private :: med_fldList_AddMap @@ -54,8 +54,7 @@ module esmflds character(CS), allocatable :: mapnorm(:) character(CX), allocatable :: mapfile(:) - ! Merging fldsTo data - for mediator export fields - character(CS), allocatable :: merge_fields(:) + ! Merging fldsTo data - for mediator export field character(CS), allocatable :: merge_fields(:) character(CS), allocatable :: merge_types(:) character(CS), allocatable :: merge_fracnames(:) type(med_fldList_entry_type), pointer :: next => null() @@ -88,23 +87,30 @@ module esmflds contains !================================================================================ - subroutine med_fldlist_init1() + subroutine med_fldlist_init1(ncomps) + integer, intent(in) :: ncomps allocate(fldlistTo(ncomps)) allocate(fldlistFr(ncomps)) end subroutine med_fldlist_init1 + !================================================================================ + function med_fldList_GetaofluxFldList() result(fldList) type(med_fldList_type), pointer :: fldList fldList => fldListMed_aoflux end function Med_FldList_GetaofluxFldList + !================================================================================ + function med_fldList_GetocnalbFldList() result(fldList) type(med_fldList_type), pointer :: fldList fldList => fldListMed_ocnalb end function Med_FldList_GetocnalbFldList + !================================================================================ + function med_fldList_GetFldListFr(index) result(fldList) integer, intent(in) :: index type(med_fldList_type), pointer :: fldList @@ -112,6 +118,8 @@ function med_fldList_GetFldListFr(index) result(fldList) fldList => fldListFr(index) end function Med_FldList_GetFldListFr + !================================================================================ + function med_fldList_GetFldListTo(index) result(fldList) integer, intent(in) :: index type(med_fldList_type), pointer :: fldList @@ -119,41 +127,49 @@ function med_fldList_GetFldListTo(index) result(fldList) fldList => fldListTo(index) end function Med_FldList_GetFldListTo - !================================================================================ - subroutine med_fldList_AddFldFrom(index, stdname, shortname) + + subroutine med_fldList_addfld_from(index, stdname, shortname) integer, intent(in) :: index character(len=*) , intent(in) :: stdname character(len=*) , intent(in) , optional :: shortname call med_fldList_AddFld(FldListFr(index)%fields, stdname, shortname) - end subroutine med_fldList_AddFldFrom + end subroutine med_fldList_addfld_from + !================================================================================ - subroutine med_fldList_AddaofluxFld(stdname, shortname) + + subroutine med_fldList_addfld_aoflux(stdname, shortname) character(len=*) , intent(in) :: stdname character(len=*) , intent(in) , optional :: shortname call med_fldList_AddFld(fldListMed_aoflux%fields, stdname, shortname) - end subroutine med_fldList_AddaofluxFld + end subroutine med_fldList_addfld_aoflux + !================================================================================ - subroutine med_fldList_AddocnalbFld(stdname, shortname) + + subroutine med_fldList_addfld_ocnalb(stdname, shortname) character(len=*) , intent(in) :: stdname character(len=*) , intent(in) , optional :: shortname call med_fldList_AddFld(fldListMed_ocnalb%fields, stdname, shortname) - end subroutine med_fldList_AddocnalbFld + end subroutine med_fldList_addfld_ocnalb + !================================================================================ - subroutine med_fldList_AddFldTo(index, stdname, shortname) + + subroutine med_fldList_addfld_to(index, stdname, shortname) integer, intent(in) :: index character(len=*) , intent(in) :: stdname character(len=*) , intent(in) , optional :: shortname call med_fldList_AddFld(FldListTo(index)%fields, stdname, shortname) - end subroutine med_fldList_AddFldTo + end subroutine med_fldList_addfld_to + + !================================================================================ subroutine med_fldList_findName(fields, stdname, found, lastfld) ! on return if found == .true. lastfield is the field matching stdname @@ -174,6 +190,8 @@ subroutine med_fldList_findName(fields, stdname, found, lastfld) end subroutine med_fldList_findName + !================================================================================ + subroutine med_fldList_AddFld(fields, stdname, shortname) ! ---------------------------------------------- ! Add an entry to to the flds array @@ -200,8 +218,8 @@ subroutine med_fldList_AddFld(fields, stdname, shortname) call med_fldList_findName(fields, stdname, found, newfld) ! create new entry if fldname is not in original list - mapsize = ncomps - mrgsize = ncomps + mapsize = size(fldListTo) + mrgsize = size(fldListFrom) if (.not. found) then ! 1) allocate newfld to be size (one element larger than input flds) @@ -236,7 +254,7 @@ end subroutine med_fldList_AddFld !================================================================================ - subroutine med_fldList_AddMrgTo(index, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname, rc) + subroutine med_fldList_addmrg_to(index, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname, rc) ! ---------------------------------------------- ! Determine mrg entry or entries in flds aray @@ -253,7 +271,7 @@ subroutine med_fldList_AddMrgTo(index, fldname, mrg_from, mrg_fld, mrg_type, mrg call med_FldList_addMrg(fldListTo(index)%fields, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname) - end subroutine med_fldList_AddMrgTo + end subroutine med_fldList_addmrg_to !================================================================================ @@ -287,6 +305,8 @@ subroutine med_fldList_AddMrg(flds, fldname, mrg_from, mrg_fld, mrg_type, mrg_fr end subroutine med_fldList_AddMrg + !================================================================================ + function med_fldList_GetFld(fields, fldname, rc) result(newfld) use ESMF, only : ESMF_LogWrite, ESMF_END_ABORT, ESMF_LOGMSG_ERROR, ESMF_Finalize, ESMF_LOGMSG_INFO @@ -317,7 +337,7 @@ end function med_fldList_GetFld !================================================================================ - subroutine med_fldList_AddMapFrom(index, fldname, destcomp, maptype, mapnorm, mapfile) + subroutine med_fldList_addmap_from(index, fldname, destcomp, maptype, mapnorm, mapfile) integer, intent(in) :: index character(len=*) , intent(in) :: fldname integer , intent(in) :: destcomp @@ -327,11 +347,11 @@ subroutine med_fldList_AddMapFrom(index, fldname, destcomp, maptype, mapnorm, ma call med_fldList_AddMap(FldListFr(index)%fields, fldname, destcomp, maptype, mapnorm, mapfile) - end subroutine med_fldList_AddMapFrom + end subroutine med_fldList_addmap_from !================================================================================ - subroutine med_fldList_AddaofluxMap(fldname, destcomp, maptype, mapnorm, mapfile) + subroutine med_fldList_addmap_aoflux(fldname, destcomp, maptype, mapnorm, mapfile) character(len=*) , intent(in) :: fldname integer , intent(in) :: destcomp integer , intent(in) :: maptype @@ -340,11 +360,11 @@ subroutine med_fldList_AddaofluxMap(fldname, destcomp, maptype, mapnorm, mapfile call med_fldList_AddMap(fldlistmed_aoflux%fields, fldname, destcomp, maptype, mapnorm, mapfile) - end subroutine med_fldList_AddaofluxMap + end subroutine med_fldList_addmap_aoflux !================================================================================ - subroutine med_fldList_AddocnalbMap(fldname, destcomp, maptype, mapnorm, mapfile) + subroutine med_fldList_addmap_ocnalb(fldname, destcomp, maptype, mapnorm, mapfile) character(len=*) , intent(in) :: fldname integer , intent(in) :: destcomp integer , intent(in) :: maptype @@ -353,7 +373,7 @@ subroutine med_fldList_AddocnalbMap(fldname, destcomp, maptype, mapnorm, mapfile call med_fldList_AddMap(fldlistmed_ocnalb%fields, fldname, destcomp, maptype, mapnorm, mapfile) - end subroutine med_fldList_AddocnalbMap + end subroutine med_fldList_addmap_ocnalb !================================================================================ @@ -657,6 +677,8 @@ subroutine med_fldList_GetFldInfo(fldList, fldindex, compsrc, stdname, shortname end subroutine med_fldList_GetFldInfo + !================================================================================ + subroutine med_fld_GetFldInfo(newfld, compsrc, stdname, shortname, mapindex, mapFile, mapnorm, merge_fields, merge_type, merge_fracname, rc) ! ---------------------------------------------- ! Get field info @@ -715,17 +737,16 @@ subroutine med_fld_GetFldInfo(newfld, compsrc, stdname, shortname, mapindex, map endif if(present(rc)) rc=lrc + contains + subroutine med_fldList_compsrcerror(rc) + integer, intent(out) :: rc + call ESMF_LogWrite("In med_fld_GetFldInfo a field requiring compsrc was requested but compsrc was not provided. ", & + ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + end subroutine med_fldList_compsrcerror end subroutine med_fld_GetFldInfo - subroutine med_fldList_compsrcerror(rc) - integer, intent(out) :: rc - call ESMF_LogWrite("In med_fld_GetFldInfo a field requiring compsrc was requested but compsrc was not provided. ", & - ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end subroutine med_fldList_compsrcerror - - !================================================================================ integer function med_fldList_GetNumFlds(fldList) @@ -812,9 +833,9 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active) !--------------------------------------- ! Loop over src components - do nsrc = 1,ncomps + do nsrc = 1,size(fldListFr) ! Loop over all possible destination components for each src component - do ndst = 1,ncomps + do ndst = 1,size(fldListTo) if (nsrc /= ndst .and. med_coupling_active(nsrc,ndst)) then ! Write all the mappings for fields from the src to the destination component write(logunit,*)' ' @@ -910,7 +931,7 @@ subroutine med_fldList_Document_Merging(logunit, med_coupling_active) write(logunit,*) ! Loop over destination components - do ndst = 1,ncomps + do ndst = 1,size(fldListTo) dst_comp = trim(compname(ndst)) prefix = '(merge_to_'//trim(dst_comp)//')' @@ -922,7 +943,7 @@ subroutine med_fldList_Document_Merging(logunit, med_coupling_active) ! Loop over all possible source components for destination component field mrgstr = ' ' - do nsrc = 1,ncomps + do nsrc = 1,size(fldListFr) if (nsrc /= ndst .and. med_coupling_active(nsrc,ndst)) then src_comp = compname(nsrc) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 1be6c3cf8..149c7791d 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -78,15 +78,15 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf use med_internalstate_mod , only : coupling_mode use med_internalstate_mod , only : map_glc2ocn_ice, map_glc2ocn_liq, map_rof2ocn_ice, map_rof2ocn_liq - use esmFlds , only : addocnalbfld => med_fldList_AddocnalbFld - use esmFlds , only : addaofluxfld => med_fldList_AddaofluxFld - use esmFlds , only : addaofluxMap => med_fldList_AddaofluxMap - use esmFlds , only : addocnalbMap => med_fldList_AddocnalbMap + use esmFlds , only : addfld_ocnalb => med_fldList_addfld_ocnalb + use esmFlds , only : addfld_aoflux => med_fldList_addfld_aoflux + use esmFlds , only : addmap_aoflux => med_fldList_addmap_aoflux + use esmFlds , only : addmap_ocnalb => med_fldList_addmap_ocnalb - use esmFlds , only : addfldTo => med_fldList_AddFldTo - use esmFlds , only : addfldFrom => med_fldList_AddFldFrom - use esmFlds , only : addmapFrom => med_fldList_AddMapFrom - use esmFlds , only : addmrgTo => med_fldList_AddMrgTo + use esmFlds , only : addfld_to => med_fldList_addfld_to + use esmFlds , only : addfld_from => med_fldList_addfld_from + use esmFlds , only : addmap_from => med_fldList_addmap_from + use esmFlds , only : addmrg_to => med_fldList_addmrg_to ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -243,8 +243,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ncomps - call addfldFrom(n, trim(cvalue)) - call addfldTo(n, trim(cvalue)) + call addfld_from(n, trim(cvalue)) + call addfld_to(n, trim(cvalue)) end do end if @@ -256,49 +256,49 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to med: masks from components !---------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(complnd, 'Sl_lfrin') - call addfldFrom(compocn, 'So_omask') - call addfldFrom(compice, 'Si_imask') + call addfld_from(complnd, 'Sl_lfrin') + call addfld_from(compocn, 'So_omask') + call addfld_from(compice, 'Si_imask') do ns = 1,is_local%wrap%num_icesheets - call addfldFrom(compglc(ns), 'Sg_area') + call addfld_from(compglc(ns), 'Sg_area') end do else - call addmapFrom(compocn, 'So_omask', compice, mapfcopy, 'unset', 'unset') + call addmap_from(compocn, 'So_omask', compice, mapfcopy, 'unset', 'unset') end if ! --------------------------------------------------------------------- ! to med: atm and ocn fields required for atm/ocn flux calculation' ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_u') - call addFldFrom(compatm, 'Sa_v') - call addFldFrom(compatm, 'Sa_z') - call addFldFrom(compatm, 'Sa_tbot') - call addFldFrom(compatm, 'Sa_pbot') - call addFldFrom(compatm, 'Sa_shum') - call addFldFrom(compatm, 'Sa_ptem') - call addFldFrom(compatm, 'Sa_dens') + call addfld_from(compatm, 'Sa_u') + call addfld_from(compatm, 'Sa_v') + call addfld_from(compatm, 'Sa_z') + call addfld_from(compatm, 'Sa_tbot') + call addfld_from(compatm, 'Sa_pbot') + call addfld_from(compatm, 'Sa_shum') + call addfld_from(compatm, 'Sa_ptem') + call addfld_from(compatm, 'Sa_dens') if (flds_wiso) then - call addFldFrom(compatm, 'Sa_shum_wiso') + call addfld_from(compatm, 'Sa_shum_wiso') end if else if (is_local%wrap%aoflux_grid == 'ogrid') then if (mapuv_with_cart3d) then - call addmapFrom(compatm, 'Sa_u' , compocn, mappatch_uv3d, 'one', atm2ocn_map) - call addMapFrom(compatm, 'Sa_v' , compocn, mappatch_uv3d, 'one', atm2ocn_map) + call addmap_from(compatm, 'Sa_u' , compocn, mappatch_uv3d, 'one', atm2ocn_map) + call addmap_from(compatm, 'Sa_v' , compocn, mappatch_uv3d, 'one', atm2ocn_map) else - call addMapFrom(compatm, 'Sa_u' , compocn, mappatch, 'one', atm2ocn_map) - call addMapFrom(compatm, 'Sa_v' , compocn, mappatch, 'one', atm2ocn_map) - end if - call addMapFrom(compatm, 'Sa_z' , compocn, mapbilnr, 'one', atm2ocn_map) - call addMapFrom(compatm, 'Sa_tbot', compocn, mapbilnr, 'one', atm2ocn_map) - call addMapFrom(compatm, 'Sa_pbot', compocn, mapbilnr, 'one', atm2ocn_map) - call addMapFrom(compatm, 'Sa_shum', compocn, mapbilnr, 'one', atm2ocn_map) - call addMapFrom(compatm, 'Sa_ptem', compocn, mapbilnr, 'one', atm2ocn_map) - call addMapFrom(compatm, 'Sa_dens', compocn, mapbilnr, 'one', atm2ocn_map) - call addMapFrom(compatm, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap_from(compatm, 'Sa_u' , compocn, mappatch, 'one', atm2ocn_map) + call addmap_from(compatm, 'Sa_v' , compocn, mappatch, 'one', atm2ocn_map) + end if + call addmap_from(compatm, 'Sa_z' , compocn, mapbilnr, 'one', atm2ocn_map) + call addmap_from(compatm, 'Sa_tbot', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap_from(compatm, 'Sa_pbot', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap_from(compatm, 'Sa_shum', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap_from(compatm, 'Sa_ptem', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap_from(compatm, 'Sa_dens', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap_from(compatm, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_map) if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_shum_wiso', rc=rc)) then - call addMapFrom(compatm, 'Sa_shum_wiso', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap_from(compatm, 'Sa_shum_wiso', compocn, mapbilnr, 'one', atm2ocn_map) end if end if end if @@ -307,16 +307,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to med: swnet fluxes used for budget calculation ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(complnd, 'Fall_swnet') - call addfldFrom(compice, 'Faii_swnet') - call addFldFrom(compatm, 'Faxa_swnet') + call addfld_from(complnd, 'Fall_swnet') + call addfld_from(compice, 'Faii_swnet') + call addfld_from(compatm, 'Faxa_swnet') else if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swnet', rc=rc)) then - call addMapFrom(compatm, 'Faxa_swnet', compice, mapconsf, 'one' , atm2ice_map) - call addMapFrom(compatm, 'Faxa_swnet', compocn, mapconsf, 'one' , atm2ocn_map) + call addmap_from(compatm, 'Faxa_swnet', compice, mapconsf, 'one' , atm2ice_map) + call addmap_from(compatm, 'Faxa_swnet', compocn, mapconsf, 'one' , atm2ocn_map) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_swnet', rc=rc)) then - call addMapFrom(compice, 'Faii_swnet', compocn, mapfcopy, 'unset', 'unset') + call addmap_from(compice, 'Faii_swnet', compocn, mapfcopy, 'unset', 'unset') end if end if @@ -328,26 +328,26 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: height at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_z') - call addfldTo(complnd, 'Sa_z') + call addfld_from(compatm, 'Sa_z') + call addfld_to(complnd, 'Sa_z') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_z', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_z', rc=rc)) then - call addMapFrom(compatm, 'Sa_z', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Sa_z', mrg_from=compatm, mrg_fld='Sa_z', mrg_type='copy') + call addmap_from(compatm, 'Sa_z', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Sa_z', mrg_from=compatm, mrg_fld='Sa_z', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: surface height from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_topo') - call addfldTo(complnd, 'Sa_topo') + call addfld_from(compatm, 'Sa_topo') + call addfld_to(complnd, 'Sa_topo') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_topo', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_topo', rc=rc)) then - call addMapFrom(compatm, 'Sa_topo', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Sa_topo', mrg_from=compatm, mrg_fld='Sa_topo', mrg_type='copy') + call addmap_from(compatm, 'Sa_topo', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Sa_topo', mrg_from=compatm, mrg_fld='Sa_topo', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -355,99 +355,99 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: meridional wind at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_u') - call addfldTo(complnd, 'Sa_u') + call addfld_from(compatm, 'Sa_u') + call addfld_to(complnd, 'Sa_u') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_u', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_u', rc=rc)) then - call addMapFrom(compatm, 'Sa_u', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') + call addmap_from(compatm, 'Sa_u', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') end if end if if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_v') - call addfldTo(complnd, 'Sa_v') + call addfld_from(compatm, 'Sa_v') + call addfld_to(complnd, 'Sa_v') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_v', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_v', rc=rc)) then - call addMapFrom(compatm, 'Sa_v', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') + call addmap_from(compatm, 'Sa_v', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: pressure at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_pbot') - call addfldTo(complnd, 'Sa_pbot') + call addfld_from(compatm, 'Sa_pbot') + call addfld_to(complnd, 'Sa_pbot') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_pbot', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_pbot', rc=rc)) then - call addMapFrom(compatm, 'Sa_pbot', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Sa_pbot', mrg_from=compatm, mrg_fld='Sa_pbot', mrg_type='copy') + call addmap_from(compatm, 'Sa_pbot', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Sa_pbot', mrg_from=compatm, mrg_fld='Sa_pbot', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: o3 at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_o3') - call addfldTo(complnd, 'Sa_o3') + call addfld_from(compatm, 'Sa_o3') + call addfld_to(complnd, 'Sa_o3') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_o3', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_o3', rc=rc)) then - call addMapFrom(compatm, 'Sa_o3', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Sa_o3', mrg_from=compatm, mrg_fld='Sa_o3', mrg_type='copy') + call addmap_from(compatm, 'Sa_o3', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Sa_o3', mrg_from=compatm, mrg_fld='Sa_o3', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: temperature at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_tbot') - call addfldTo(complnd, 'Sa_tbot') + call addfld_from(compatm, 'Sa_tbot') + call addfld_to(complnd, 'Sa_tbot') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_tbot', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_tbot', rc=rc)) then - call addMapFrom(compatm, 'Sa_tbot', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') + call addmap_from(compatm, 'Sa_tbot', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: potential temperature at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_ptem') - call addfldTo(complnd, 'Sa_ptem') + call addfld_from(compatm, 'Sa_ptem') + call addfld_to(complnd, 'Sa_ptem') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_ptem', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_ptem', rc=rc)) then - call addMapFrom(compatm, 'Sa_ptem', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Sa_ptem', mrg_from=compatm, mrg_fld='Sa_ptem', mrg_type='copy') + call addmap_from(compatm, 'Sa_ptem', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Sa_ptem', mrg_from=compatm, mrg_fld='Sa_ptem', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: specific humidity at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_shum') - call addfldTo(complnd, 'Sa_shum') + call addfld_from(compatm, 'Sa_shum') + call addfld_to(complnd, 'Sa_shum') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_shum', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum', rc=rc)) then - call addMapFrom(compatm, 'Sa_shum', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Sa_shum', mrg_from=compatm, mrg_fld='Sa_shum', mrg_type='copy') + call addmap_from(compatm, 'Sa_shum', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Sa_shum', mrg_from=compatm, mrg_fld='Sa_shum', mrg_type='copy') end if end if if (flds_wiso) then if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_shum_wiso') - call addfldTo(complnd, 'Sa_shum_wiso') + call addfld_from(compatm, 'Sa_shum_wiso') + call addfld_to(complnd, 'Sa_shum_wiso') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_shum_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum_wiso', rc=rc)) then - call addMapFrom(compatm, 'Sa_shum_wiso', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Sa_shum_wiso', mrg_from=compatm, mrg_fld='Sa_shum_wiso', mrg_type='copy') + call addmap_from(compatm, 'Sa_shum_wiso', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Sa_shum_wiso', mrg_from=compatm, mrg_fld='Sa_shum_wiso', mrg_type='copy') end if end if end if @@ -455,59 +455,59 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: convective and large scale precipitation rate water equivalent from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_rainc') - call addfldTo(complnd, 'Faxa_rainc') + call addfld_from(compatm, 'Faxa_rainc') + call addfld_to(complnd, 'Faxa_rainc') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_rainc', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_rainc', rc=rc)) then - call addMapFrom(compatm, 'Faxa_rainc', complnd, mapconsf, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Faxa_rainc', mrg_from=compatm, mrg_fld='Faxa_rainc', mrg_type='copy') + call addmap_from(compatm, 'Faxa_rainc', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Faxa_rainc', mrg_from=compatm, mrg_fld='Faxa_rainc', mrg_type='copy') end if end if if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_rainl') - call addfldTo(complnd, 'Faxa_rainl') + call addfld_from(compatm, 'Faxa_rainl') + call addfld_to(complnd, 'Faxa_rainl') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_rainl', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_rainl', rc=rc)) then - call addMapFrom(compatm, 'Faxa_rainl', complnd, mapconsf, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Faxa_rainl', mrg_from=compatm, mrg_fld='Faxa_rainl', mrg_type='copy') + call addmap_from(compatm, 'Faxa_rainl', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Faxa_rainl', mrg_from=compatm, mrg_fld='Faxa_rainl', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: convective and large-scale (stable) snow rate from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_snowc') - call addfldTo(complnd, 'Faxa_snowc') + call addfld_from(compatm, 'Faxa_snowc') + call addfld_to(complnd, 'Faxa_snowc') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_snowc', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_snowc', rc=rc)) then - call addMapFrom(compatm, 'Faxa_snowc', complnd, mapconsf, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Faxa_snowc', mrg_from=compatm, mrg_fld='Faxa_snowc', mrg_type='copy') + call addmap_from(compatm, 'Faxa_snowc', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Faxa_snowc', mrg_from=compatm, mrg_fld='Faxa_snowc', mrg_type='copy') end if end if if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_snowl') - call addfldTo(complnd, 'Faxa_snowl') + call addfld_from(compatm, 'Faxa_snowl') + call addfld_to(complnd, 'Faxa_snowl') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_snowl', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_snowl', rc=rc)) then - call addMapFrom(compatm, 'Faxa_snowl', complnd, mapconsf, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Faxa_snowl', mrg_from=compatm, mrg_fld='Faxa_snowl', mrg_type='copy') + call addmap_from(compatm, 'Faxa_snowl', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Faxa_snowl', mrg_from=compatm, mrg_fld='Faxa_snowl', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: downward longwave heat flux from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_lwdn') - call addfldTo(complnd, 'Faxa_lwdn') + call addfld_from(compatm, 'Faxa_lwdn') + call addfld_to(complnd, 'Faxa_lwdn') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_lwdn', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_lwdn', rc=rc)) then - call addMapFrom(compatm, 'Faxa_lwdn', complnd, mapconsf, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Faxa_lwdn', mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='copy') + call addmap_from(compatm, 'Faxa_lwdn', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Faxa_lwdn', mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -517,53 +517,53 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: downward Diffuse visible incident solar radiation from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_swndr') - call addfldTo(complnd, 'Faxa_swndr') + call addfld_from(compatm, 'Faxa_swndr') + call addfld_to(complnd, 'Faxa_swndr') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_swndr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_swndr', rc=rc)) then - call addMapFrom(compatm, 'Faxa_swndr', complnd, mapconsf, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Faxa_swndr', mrg_from=compatm, mrg_fld='Faxa_swndr', mrg_type='copy') + call addmap_from(compatm, 'Faxa_swndr', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Faxa_swndr', mrg_from=compatm, mrg_fld='Faxa_swndr', mrg_type='copy') end if end if if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_swvdr') - call addfldTo(complnd, 'Faxa_swvdr') + call addfld_from(compatm, 'Faxa_swvdr') + call addfld_to(complnd, 'Faxa_swvdr') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_swvdr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_swvdr', rc=rc)) then - call addMapFrom(compatm, 'Faxa_swvdr', complnd, mapconsf, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Faxa_swvdr', mrg_from=compatm, mrg_fld='Faxa_swvdr', mrg_type='copy') + call addmap_from(compatm, 'Faxa_swvdr', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Faxa_swvdr', mrg_from=compatm, mrg_fld='Faxa_swvdr', mrg_type='copy') end if end if if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_swndf') - call addfldTo(complnd, 'Faxa_swndf') + call addfld_from(compatm, 'Faxa_swndf') + call addfld_to(complnd, 'Faxa_swndf') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_swndf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_swndf', rc=rc)) then - call addMapFrom(compatm, 'Faxa_swndf', complnd, mapconsf, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Faxa_swndf', mrg_from=compatm, mrg_fld='Faxa_swndf', mrg_type='copy') + call addmap_from(compatm, 'Faxa_swndf', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Faxa_swndf', mrg_from=compatm, mrg_fld='Faxa_swndf', mrg_type='copy') end if end if if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_swvdf') - call addfldTo(complnd, 'Faxa_swvdf') + call addfld_from(compatm, 'Faxa_swvdf') + call addfld_to(complnd, 'Faxa_swvdf') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_swvdf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_swvdf', rc=rc)) then - call addMapFrom(compatm, 'Faxa_swvdf', complnd, mapconsf, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Faxa_swvdf', mrg_from=compatm, mrg_fld='Faxa_swvdf', mrg_type='copy') + call addmap_from(compatm, 'Faxa_swvdf', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Faxa_swvdf', mrg_from=compatm, mrg_fld='Faxa_swvdf', mrg_type='copy') end if end if if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_bcph') - call addfldTo(complnd, 'Faxa_bcph') + call addfld_from(compatm, 'Faxa_bcph') + call addfld_to(complnd, 'Faxa_bcph') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_bcph', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_bcph', rc=rc)) then - call addMapFrom(compatm, 'Faxa_bcph', complnd, mapconsf, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Faxa_bcph', mrg_from=compatm, mrg_fld='Faxa_bcph', mrg_type='copy') + call addmap_from(compatm, 'Faxa_bcph', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Faxa_bcph', mrg_from=compatm, mrg_fld='Faxa_bcph', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -577,13 +577,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! - hydrophylic organic carbon wet deposition flux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_ocph') - call addfldTo(complnd, 'Faxa_ocph') + call addfld_from(compatm, 'Faxa_ocph') + call addfld_to(complnd, 'Faxa_ocph') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_ocph', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_ocph', rc=rc)) then - call addMapFrom(compatm, 'Faxa_ocph', complnd, mapconsf, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Faxa_ocph', mrg_from=compatm, mrg_fld='Faxa_ocph', mrg_type='copy') + call addmap_from(compatm, 'Faxa_ocph', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Faxa_ocph', mrg_from=compatm, mrg_fld='Faxa_ocph', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -591,36 +591,36 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: dust dry deposition flux (sizes 1-4) from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_dstwet') - call addfldTo(complnd, 'Faxa_dstwet') + call addfld_from(compatm, 'Faxa_dstwet') + call addfld_to(complnd, 'Faxa_dstwet') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_dstwet', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_dstwet', rc=rc)) then - call addMapFrom(compatm, 'Faxa_dstwet', complnd, mapconsf, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Faxa_dstwet', mrg_from=compatm, mrg_fld='Faxa_dstwet', mrg_type='copy') + call addmap_from(compatm, 'Faxa_dstwet', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Faxa_dstwet', mrg_from=compatm, mrg_fld='Faxa_dstwet', mrg_type='copy') end if end if if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_dstdry') - call addfldTo(complnd, 'Faxa_dstdry') + call addfld_from(compatm, 'Faxa_dstdry') + call addfld_to(complnd, 'Faxa_dstdry') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_dstdry', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_dstdry', rc=rc)) then - call addMapFrom(compatm, 'Faxa_dstdry', complnd, mapconsf, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Faxa_dstdry', mrg_from=compatm, mrg_fld='Faxa_dstdry', mrg_type='copy') + call addmap_from(compatm, 'Faxa_dstdry', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Faxa_dstdry', mrg_from=compatm, mrg_fld='Faxa_dstdry', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to lnd: nitrogen deposition fields from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_ndep') - call addfldTo(complnd, 'Faxa_ndep') + call addfld_from(compatm, 'Faxa_ndep') + call addfld_to(complnd, 'Faxa_ndep') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_ndep', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_ndep', rc=rc)) then - call addMapFrom(compatm, 'Faxa_ndep', complnd, mapconsf, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Faxa_ndep', mrg_from=compatm, mrg_fld='Faxa_ndep', mrg_type='copy') + call addmap_from(compatm, 'Faxa_ndep', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Faxa_ndep', mrg_from=compatm, mrg_fld='Faxa_ndep', mrg_type='copy') end if end if @@ -632,87 +632,87 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: tributary channel depth ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(comprof, 'Flrr_volr') - call addfldTo(complnd, 'Flrr_volr') + call addfld_from(comprof, 'Flrr_volr') + call addfld_to(complnd, 'Flrr_volr') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volr', rc=rc)) then - call addmapFrom(comprof, 'Flrr_volr', complnd, mapconsf, 'one', rof2lnd_map) - call addmrgTo(complnd, 'Flrr_volr', mrg_from=comprof, mrg_fld='Flrr_volr', mrg_type='copy') + call addmap_from(comprof, 'Flrr_volr', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg_to(complnd, 'Flrr_volr', mrg_from=comprof, mrg_fld='Flrr_volr', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfldFrom(comprof, 'Flrr_volrmch') - call addfldTo(complnd, 'Flrr_volrmch') + call addfld_from(comprof, 'Flrr_volrmch') + call addfld_to(complnd, 'Flrr_volrmch') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volrmch', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volrmch', rc=rc)) then - call addmapFrom(comprof, 'Flrr_volrmch', complnd, mapconsf, 'one', rof2lnd_map) - call addmrgTo(complnd, 'Flrr_volrmch', mrg_from=comprof, mrg_fld='Flrr_volrmch', mrg_type='copy') + call addmap_from(comprof, 'Flrr_volrmch', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg_to(complnd, 'Flrr_volrmch', mrg_from=comprof, mrg_fld='Flrr_volrmch', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfldFrom(comprof, 'Flrr_flood') - call addfldTo(complnd, 'Flrr_flood') + call addfld_from(comprof, 'Flrr_flood') + call addfld_to(complnd, 'Flrr_flood') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_flood', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood', rc=rc)) then - call addmapFrom(comprof, 'Flrr_flood', complnd, mapconsf, 'one', rof2lnd_map) - call addmrgTo(complnd, 'Flrr_flood', mrg_from=comprof, mrg_fld='Flrr_flood', mrg_type='copy') + call addmap_from(comprof, 'Flrr_flood', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg_to(complnd, 'Flrr_flood', mrg_from=comprof, mrg_fld='Flrr_flood', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfldFrom(comprof, 'Sr_tdepth') - call addfldTo(complnd, 'Sr_tdepth') + call addfld_from(comprof, 'Sr_tdepth') + call addfld_to(complnd, 'Sr_tdepth') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Sr_tdepth', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Sr_tdepth', rc=rc)) then - call addmapFrom(comprof, 'Sr_tdepth', complnd, mapconsf, 'one', rof2lnd_map) - call addmrgTo(complnd, 'Sr_tdepth', mrg_from=comprof, mrg_fld='Sr_tdepth', mrg_type='copy') + call addmap_from(comprof, 'Sr_tdepth', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg_to(complnd, 'Sr_tdepth', mrg_from=comprof, mrg_fld='Sr_tdepth', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfldFrom(comprof, 'Sr_tdepth_max') - call addfldTo(complnd, 'Sr_tdepth_max') + call addfld_from(comprof, 'Sr_tdepth_max') + call addfld_to(complnd, 'Sr_tdepth_max') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Sr_tdepth_max', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Sr_tdepth_max', rc=rc)) then - call addmapFrom(comprof, 'Sr_tdepth_max', complnd, mapconsf, 'one', rof2lnd_map) - call addmrgTo(complnd, 'Sr_tdepth_max', mrg_from=comprof, mrg_fld='Sr_tdepth_max', mrg_type='copy') + call addmap_from(comprof, 'Sr_tdepth_max', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg_to(complnd, 'Sr_tdepth_max', mrg_from=comprof, mrg_fld='Sr_tdepth_max', mrg_type='copy') end if end if if (flds_wiso) then if (phase == 'advertise') then - call addfldFrom(comprof, 'Flrr_volr_wiso') - call addfldTo(complnd, 'Flrr_volr_wiso') + call addfld_from(comprof, 'Flrr_volr_wiso') + call addfld_to(complnd, 'Flrr_volr_wiso') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volr_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volr_wiso', rc=rc)) then - call addmapFrom(comprof, 'Flrr_volr_wiso', complnd, mapconsf, 'one', rof2lnd_map) - call addmrgTo(complnd, 'Flrr_volr_wiso', & + call addmap_from(comprof, 'Flrr_volr_wiso', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg_to(complnd, 'Flrr_volr_wiso', & mrg_from=comprof, mrg_fld='Flrr_volr_wiso', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfldFrom(comprof, 'Flrr_volrmch_wiso') - call addfldTo(complnd, 'Flrr_volrmch_wiso') + call addfld_from(comprof, 'Flrr_volrmch_wiso') + call addfld_to(complnd, 'Flrr_volrmch_wiso') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volrmch_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volrmch_wiso', rc=rc)) then - call addmapFrom(comprof, 'Flrr_volrmch_wiso', complnd, mapconsf, 'one', rof2lnd_map) - call addmrgTo(complnd, 'Flrr_volrmch_wiso', & + call addmap_from(comprof, 'Flrr_volrmch_wiso', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg_to(complnd, 'Flrr_volrmch_wiso', & mrg_from=comprof, mrg_fld='Flrr_volrmch_wiso', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfldFrom(comprof, 'Flrr_flood_wiso') - call addfldTo(complnd, 'Flrr_flood_wiso') + call addfld_from(comprof, 'Flrr_flood_wiso') + call addfld_to(complnd, 'Flrr_flood_wiso') else if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_flood_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood_wiso', rc=rc)) then - call addmapFrom(comprof, 'Flrr_flood_wiso', complnd, mapconsf, 'one', rof2lnd_map) - call addmrgTo(complnd, 'Flrr_flood_wiso', & + call addmap_from(comprof, 'Flrr_flood_wiso', complnd, mapconsf, 'one', rof2lnd_map) + call addmrg_to(complnd, 'Flrr_flood_wiso', & mrg_from=comprof, mrg_fld='Flrr_flood_wiso', mrg_type='copy') end if end if @@ -730,24 +730,24 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (phase == 'advertise') then do ns = 1, is_local%wrap%num_icesheets - call addfldFrom(compglc(ns), 'Sg_icemask') ! ice sheet grid coverage - call addfldFrom(compglc(ns), 'Sg_icemask_coupled_fluxes') - call addfldFrom(compglc(ns), 'Sg_ice_covered') ! fraction of glacier area - call addfldFrom(compglc(ns), 'Sg_topo') ! surface height of glacer - call addfldFrom(compglc(ns), 'Flgg_hflx') ! downward heat flux from glacier interior + call addfld_from(compglc(ns), 'Sg_icemask') ! ice sheet grid coverage + call addfld_from(compglc(ns), 'Sg_icemask_coupled_fluxes') + call addfld_from(compglc(ns), 'Sg_ice_covered') ! fraction of glacier area + call addfld_from(compglc(ns), 'Sg_topo') ! surface height of glacer + call addfld_from(compglc(ns), 'Flgg_hflx') ! downward heat flux from glacier interior end do - call addfldTo(complnd, 'Sg_icemask') - call addfldTo(complnd, 'Sg_icemask_coupled_fluxes') - call addfldTo(complnd, 'Sg_ice_covered_elev') - call addfldTo(complnd, 'Sg_topo_elev') - call addfldTo(complnd, 'Flgg_hflx_elev') + call addfld_to(complnd, 'Sg_icemask') + call addfld_to(complnd, 'Sg_icemask_coupled_fluxes') + call addfld_to(complnd, 'Sg_ice_covered_elev') + call addfld_to(complnd, 'Sg_topo_elev') + call addfld_to(complnd, 'Flgg_hflx_elev') else ! custom merge in med_phases_prep_lnd for Sg_icemask and Sg_icemask_coupled_fluxes ! custom map merge in med_phases_prep_lnd for Sg_ice_covered_elev, Sg_topo_elev and Flgg_hflx_elev if ( fldchk(is_local%wrap%FBExp(complnd), 'Sg_icemask', rc=rc)) then do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Sg_icemask', rc=rc)) then - call addmapFrom(compglc(ns), 'Sg_icemask', & + call addmap_from(compglc(ns), 'Sg_icemask', & complnd, mapconsd, 'one', 'unset') end if end do @@ -755,7 +755,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBExp(complnd), 'Sg_icemask_coupled_fluxes', rc=rc)) then do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Sg_icemask_coupled_fluxes', rc=rc)) then - call addmapFrom(compglc(ns), 'Sg_icemask_coupled_fluxes', & + call addmap_from(compglc(ns), 'Sg_icemask_coupled_fluxes', & complnd, mapconsd, 'one', 'unset') end if end do @@ -771,9 +771,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !---------------------------------------------------------- if (phase == 'advertise') then ! the following are computed in med_phases_prep_atm - call addfldTo(compatm, 'Sl_lfrac') - call addfldTo(compatm, 'Si_ifrac') - call addfldTo(compatm, 'So_ofrac') + call addfld_to(compatm, 'Sl_lfrac') + call addfld_to(compatm, 'Si_ifrac') + call addfld_to(compatm, 'So_ofrac') end if ! --------------------------------------------------------------------- @@ -783,108 +783,108 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: merged diffuse albedo (near-infrared radiation) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(complnd, 'Sl_avsdr') - call addfldFrom(compice, 'Si_avsdr') - call addocnalbFld('So_avsdr') - call addfldTo(compatm, 'Sx_avsdr') + call addfld_from(complnd, 'Sl_avsdr') + call addfld_from(compice, 'Si_avsdr') + call addfld_ocnalb('So_avsdr') + call addfld_to(compatm, 'Sx_avsdr') else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_avsdr', rc=rc)) then ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_avsdr', rc=rc)) then - call addmapFrom(complnd, 'Sl_avsdr', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm, 'Sx_avsdr', & + call addmap_from(complnd, 'Sl_avsdr', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm, 'Sx_avsdr', & mrg_from=complnd, mrg_fld='Sl_avsdr', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_avsdr', rc=rc)) then - call addMapFrom(compice, 'Si_avsdr', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm, 'Sx_avsdr', & + call addmap_from(compice, 'Si_avsdr', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg_to(compatm, 'Sx_avsdr', & mrg_from=compice, mrg_fld='Si_avsdr', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_avsdr', rc=rc)) then - call addocnalbmap( 'So_avsdr', compatm, mapconsf, 'ofrac', ocn2atm_map) - call addmrgTo(compatm, 'Sx_avsdr', & + call addmap_ocnalb( 'So_avsdr', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmrg_to(compatm, 'Sx_avsdr', & mrg_from=compmed, mrg_fld='So_avsdr', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addFldFrom(complnd, 'Sl_avsdf') - call addfldFrom(compice, 'Si_avsdf') - call addocnalbFld( 'So_avsdf') - call addfldTo(compatm, 'Sx_avsdf') + call addfld_from(complnd, 'Sl_avsdf') + call addfld_from(compice, 'Si_avsdf') + call addfld_ocnalb( 'So_avsdf') + call addfld_to(compatm, 'Sx_avsdf') else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_avsdf', rc=rc)) then ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_avsdf', rc=rc)) then - call addmapFrom(complnd, 'Sl_avsdf', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm, 'Sx_avsdf', & + call addmap_from(complnd, 'Sl_avsdf', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm, 'Sx_avsdf', & mrg_from=complnd, mrg_fld='Sl_avsdf', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_avsdf', rc=rc)) then - call addMapFrom(compice, 'Si_avsdf', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm, 'Sx_avsdf', & + call addmap_from(compice, 'Si_avsdf', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg_to(compatm, 'Sx_avsdf', & mrg_from=compice, mrg_fld='Si_avsdf', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_avsdf', rc=rc)) then - call addocnalbmap( 'So_avsdf', compatm, mapconsf, 'ofrac', ocn2atm_map) - call addmrgTo(compatm, 'Sx_avsdf', & + call addmap_ocnalb( 'So_avsdf', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmrg_to(compatm, 'Sx_avsdf', & mrg_from=compmed, mrg_fld='So_avsdf', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addFldFrom(complnd, 'Sl_anidr') - call addfldFrom(compice, 'Si_anidr') - call addocnalbFld( 'So_anidr') - call addfldTo(compatm, 'Sx_anidr') + call addfld_from(complnd, 'Sl_anidr') + call addfld_from(compice, 'Si_anidr') + call addfld_ocnalb( 'So_anidr') + call addfld_to(compatm, 'Sx_anidr') else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_anidr', rc=rc)) then ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_anidr', rc=rc)) then - call addmapFrom(complnd, 'Sl_anidr', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm, 'Sx_anidr', & + call addmap_from(complnd, 'Sl_anidr', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm, 'Sx_anidr', & mrg_from=complnd, mrg_fld='Sl_anidr', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_anidr', rc=rc)) then - call addMapFrom(compice, 'Si_anidr', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm, 'Sx_anidr', & + call addmap_from(compice, 'Si_anidr', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg_to(compatm, 'Sx_anidr', & mrg_from=compice, mrg_fld='Si_anidr', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_anidr', rc=rc)) then - call addocnalbmap( 'So_anidr', compatm, mapconsf, 'ofrac', ocn2atm_map) - call addmrgTo(compatm, 'Sx_anidr', & + call addmap_ocnalb( 'So_anidr', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmrg_to(compatm, 'Sx_anidr', & mrg_from=compmed, mrg_fld='So_anidr', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addFldFrom(complnd, 'Sl_anidf') - call addfldFrom(compice, 'Si_anidf') - call addocnalbFld( 'So_anidf') - call addfldTo(compatm, 'Sx_anidf') + call addfld_from(complnd, 'Sl_anidf') + call addfld_from(compice, 'Si_anidf') + call addfld_ocnalb( 'So_anidf') + call addfld_to(compatm, 'Sx_anidf') else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_anidf', rc=rc)) then ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_anidf', rc=rc)) then - call addmapFrom(complnd, 'Sl_anidf', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm, 'Sx_anidf', & + call addmap_from(complnd, 'Sl_anidf', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm, 'Sx_anidf', & mrg_from=complnd, mrg_fld='Sl_anidf', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_anidf', rc=rc)) then - call addMapFrom(compice, 'Si_anidf', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm, 'Sx_anidf', & + call addmap_from(compice, 'Si_anidf', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg_to(compatm, 'Sx_anidf', & mrg_from=compice, mrg_fld='Si_anidf', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_anidf', rc=rc)) then - call addocnalbmap( 'So_anidf', compatm, mapconsf, 'ofrac', ocn2atm_map) - call addmrgTo(compatm, 'Sx_anidf', & + call addmap_ocnalb( 'So_anidf', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmrg_to(compatm, 'Sx_anidf', & mrg_from=compmed, mrg_fld='So_anidf', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -898,81 +898,81 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(complnd , 'Sl_tref') - call addfldFrom(compice , 'Si_tref') - call addaofluxFld('So_tref') - call addfldTo(compatm , 'Sx_tref') + 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 addmapFrom(complnd , 'Sl_tref', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm , 'Sx_tref', & + call addmap_from(complnd , 'Sl_tref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm , 'Sx_tref', & mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_tref', rc=rc)) then - call addMapFrom(compice , 'Si_tref', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm , 'Sx_tref', & + 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 addaofluxmap('So_tref', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap_aoflux('So_tref', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrgTo(compatm , 'Sx_tref', & + 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 addFldFrom(complnd , 'Sl_u10') - call addfldFrom(compice , 'Si_u10') - call addaofluxFld('So_u10') - call addfldTo(compatm , 'Sx_u10') + 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 addmapFrom(complnd , 'Sl_u10', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm , 'Sx_u10', & + call addmap_from(complnd , 'Sl_u10', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm , 'Sx_u10', & mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_u10', rc=rc)) then - call addMapFrom(compice , 'Si_u10', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm , 'Sx_u10', & + 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 addaofluxmap('So_u10', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap_aoflux('So_u10', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrgTo(compatm , 'Sx_u10', & + 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 addFldFrom(complnd , 'Sl_qref') - call addfldFrom(compice , 'Si_qref') - call addaofluxFld('So_qref') - call addfldTo(compatm , 'Sx_qref') + 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 addmapFrom(complnd , 'Sl_qref', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm , 'Sx_qref', & + call addmap_from(complnd , 'Sl_qref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm , 'Sx_qref', & mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref', rc=rc)) then - call addMapFrom(compice , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm , 'Sx_qref', & + 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 addaofluxmap('So_qref', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap_aoflux('So_qref', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrgTo(compatm , 'Sx_qref', & + call addmrg_to(compatm , 'Sx_qref', & mrg_from=compmed, mrg_fld='So_qref', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -980,27 +980,27 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_wiso) then if (phase == 'advertise') then - call addFldFrom(complnd , 'Sl_qref_wiso') - call addfldFrom(compice , 'Si_qref_wiso') - call addaofluxFld('So_qref_wiso') - call addfldTo(compatm , 'Sx_qref_wiso') + call addfld_from(complnd , 'Sl_qref_wiso') + call addfld_from(compice , 'Si_qref_wiso') + call addfld_aoflux('So_qref_wiso') + call addfld_to(compatm , 'Sx_qref_wiso') else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref_wiso', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref_wiso', rc=rc)) then - call addmapFrom(complnd , 'Sl_qref_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm , 'Sx_qref_wiso', & + call addmap_from(complnd , 'Sl_qref_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm , 'Sx_qref_wiso', & mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref_wiso', rc=rc)) then - call addMapFrom(compice , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm , 'Sx_qref_wiso', & + call addmap_from(compice , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg_to(compatm , 'Sx_qref_wiso', & mrg_from=compice, mrg_fld='Si_qref_wiso', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_qref_wiso', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addaofluxmap( 'So_qref_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) ! map ocn->atm + call addmap_aoflux( 'So_qref_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) ! map ocn->atm end if - call addmrgTo(compatm , 'Sx_qref_wiso', & + call addmrg_to(compatm , 'Sx_qref_wiso', & mrg_from=compmed, mrg_fld='So_qref_wiso', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1014,81 +1014,81 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: merged reference specific water isoptope humidity at 2 meters ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(complnd , 'Sl_tref') - call addfldFrom(compice , 'Si_tref') - call addaofluxFld('So_tref') - call addfldTo(compatm , 'Sx_tref') + 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 addmapFrom(complnd , 'Sl_tref', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm , 'Sx_tref', & + call addmap_from(complnd , 'Sl_tref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm , 'Sx_tref', & mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_tref', rc=rc)) then - call addMapFrom(compice , 'Si_tref', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm , 'Sx_tref', & + 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 addaofluxmap('So_tref', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap_aoflux('So_tref', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrgTo(compatm , 'Sx_tref', & + 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 addFldFrom(complnd , 'Sl_u10') - call addfldFrom(compice , 'Si_u10') - call addaofluxFld('So_u10') - call addfldTo(compatm , 'Sx_u10') + 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 addmapFrom(complnd , 'Sl_u10', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm , 'Sx_u10', & + call addmap_from(complnd , 'Sl_u10', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm , 'Sx_u10', & mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_u10', rc=rc)) then - call addMapFrom(compice , 'Si_u10', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm , 'Sx_u10', & + 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 addaofluxmap('So_u10', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap_aoflux('So_u10', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrgTo(compatm , 'Sx_u10', & + 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 addFldFrom(complnd , 'Sl_qref') - call addfldFrom(compice , 'Si_qref') - call addaofluxFld('So_qref') - call addfldTo(compatm , 'Sx_qref') + 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 addmapFrom(complnd , 'Sl_qref', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm , 'Sx_qref', & + call addmap_from(complnd , 'Sl_qref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm , 'Sx_qref', & mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref', rc=rc)) then - call addMapFrom(compice , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm , 'Sx_qref', & + 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 addaofluxmap('So_qref', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap_aoflux('So_qref', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrgTo(compatm , 'Sx_qref', & + call addmrg_to(compatm , 'Sx_qref', & mrg_from=compmed, mrg_fld='So_qref', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1096,27 +1096,27 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_wiso) then if (phase == 'advertise') then - call addFldFrom(complnd , 'Sl_qref_wiso') - call addfldFrom(compice , 'Si_qref_wiso') - call addaofluxFld('So_qref_wiso') - call addfldTo(compatm , 'Sx_qref_wiso') + call addfld_from(complnd , 'Sl_qref_wiso') + call addfld_from(compice , 'Si_qref_wiso') + call addfld_aoflux('So_qref_wiso') + call addfld_to(compatm , 'Sx_qref_wiso') else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref_wiso', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref_wiso', rc=rc)) then - call addmapFrom(complnd , 'Sl_qref_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm , 'Sx_qref_wiso', & + call addmap_from(complnd , 'Sl_qref_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm , 'Sx_qref_wiso', & mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref_wiso', rc=rc)) then - call addMapFrom(compice , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm , 'Sx_qref_wiso', & + call addmap_from(compice , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg_to(compatm , 'Sx_qref_wiso', & mrg_from=compice, mrg_fld='Si_qref_wiso', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_qref_wiso', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addaofluxmap('So_qref_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap_aoflux('So_qref_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrgTo(compatm , 'Sx_qref_wiso', & + call addmrg_to(compatm , 'Sx_qref_wiso', & mrg_from=compmed, mrg_fld='So_qref_wiso', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1132,162 +1132,162 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: evaporation water flux from water isotopes ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfldTo(compatm, 'Faxx_taux') - call addFldFrom(complnd, 'Fall_taux') - call addfldFrom(compice, 'Faii_taux') - call addaofluxFld( 'Faox_taux') + call addfld_to(compatm, 'Faxx_taux') + call addfld_from(complnd, 'Fall_taux') + call addfld_from(compice, 'Faii_taux') + call addfld_aoflux( 'Faox_taux') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_taux', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_taux', rc=rc)) then - call addmapFrom(complnd , 'Fall_taux', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm , 'Faxx_taux', & + call addmap_from(complnd , 'Fall_taux', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm , 'Faxx_taux', & mrg_from=complnd, mrg_fld='Fall_taux', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_taux', rc=rc)) then - call addMapFrom(compice , 'Faii_taux', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm , 'Faxx_taux', & + call addmap_from(compice , 'Faii_taux', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg_to(compatm , 'Faxx_taux', & mrg_from=compice, mrg_fld='Faii_taux', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_taux', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addaofluxmap('Faox_taux', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap_aoflux('Faox_taux', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrgTo(compatm , 'Faxx_taux', & + call addmrg_to(compatm , 'Faxx_taux', & mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfldTo(compatm, 'Faxx_tauy') - call addFldFrom(complnd, 'Fall_tauy') - call addfldFrom(compice, 'Faii_tauy') - call addaofluxFld( 'Faox_tauy') + call addfld_to(compatm, 'Faxx_tauy') + call addfld_from(complnd, 'Fall_tauy') + call addfld_from(compice, 'Faii_tauy') + call addfld_aoflux( 'Faox_tauy') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_tauy', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_tauy', rc=rc)) then - call addmapFrom(complnd , 'Fall_tauy', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm , 'Faxx_tauy', & + call addmap_from(complnd , 'Fall_tauy', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm , 'Faxx_tauy', & mrg_from=complnd, mrg_fld='Fall_tauy', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_tauy', rc=rc)) then - call addMapFrom(compice , 'Faii_tauy', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm , 'Faxx_tauy', & + call addmap_from(compice , 'Faii_tauy', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg_to(compatm , 'Faxx_tauy', & mrg_from=compice, mrg_fld='Faii_tauy', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_tauy', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addaofluxmap('Faox_tauy', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap_aoflux('Faox_tauy', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrgTo(compatm , 'Faxx_tauy', & + call addmrg_to(compatm , 'Faxx_tauy', & mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfldTo(compatm, 'Faxx_lat') - call addFldFrom(complnd, 'Fall_lat') - call addfldFrom(compice, 'Faii_lat') - call addaofluxFld( 'Faox_lat') + call addfld_to(compatm, 'Faxx_lat') + call addfld_from(complnd, 'Fall_lat') + call addfld_from(compice, 'Faii_lat') + call addfld_aoflux( 'Faox_lat') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lat', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lat', rc=rc)) then - call addmapFrom(complnd , 'Fall_lat', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm , 'Faxx_lat', & + call addmap_from(complnd , 'Fall_lat', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm , 'Faxx_lat', & mrg_from=complnd, mrg_fld='Fall_lat', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_lat', rc=rc)) then - call addMapFrom(compice , 'Faii_lat', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm , 'Faxx_lat', & + call addmap_from(compice , 'Faii_lat', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg_to(compatm , 'Faxx_lat', & mrg_from=compice, mrg_fld='Faii_lat', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lat', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addaofluxmap('Faox_lat', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap_aoflux('Faox_lat', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrgTo(compatm , 'Faxx_lat', & + call addmrg_to(compatm , 'Faxx_lat', & mrg_from=compmed, mrg_fld='Faox_lat', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfldTo(compatm, 'Faxx_sen') - call addFldFrom(complnd, 'Fall_sen') - call addfldFrom(compice, 'Faii_sen') - call addaofluxFld( 'Faox_sen') + call addfld_to(compatm, 'Faxx_sen') + call addfld_from(complnd, 'Fall_sen') + call addfld_from(compice, 'Faii_sen') + call addfld_aoflux( 'Faox_sen') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_sen', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_sen', rc=rc)) then - call addmapFrom(complnd , 'Fall_sen', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm , 'Faxx_sen', & + call addmap_from(complnd , 'Fall_sen', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm , 'Faxx_sen', & mrg_from=complnd, mrg_fld='Fall_sen', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_sen', rc=rc)) then - call addMapFrom(compice , 'Faii_sen', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm , 'Faxx_sen', & + call addmap_from(compice , 'Faii_sen', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg_to(compatm , 'Faxx_sen', & mrg_from=compice, mrg_fld='Faii_sen', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_sen', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addaofluxmap('Faox_sen', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap_aoflux('Faox_sen', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrgTo(compatm , 'Faxx_sen', & + call addmrg_to(compatm , 'Faxx_sen', & mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfldTo(compatm, 'Faxx_evap') - call addFldFrom(complnd, 'Fall_evap') - call addfldFrom(compice, 'Faii_evap') - call addaofluxFld( 'Faox_evap') + call addfld_to(compatm, 'Faxx_evap') + call addfld_from(complnd, 'Fall_evap') + call addfld_from(compice, 'Faii_evap') + call addfld_aoflux( 'Faox_evap') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap', rc=rc)) then - call addmapFrom(complnd , 'Fall_evap', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm , 'Faxx_evap', & + call addmap_from(complnd , 'Fall_evap', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm , 'Faxx_evap', & mrg_from=complnd, mrg_fld='Fall_evap', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap', rc=rc)) then - call addMapFrom(compice , 'Faii_evap', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm , 'Faxx_evap', & + call addmap_from(compice , 'Faii_evap', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg_to(compatm , 'Faxx_evap', & mrg_from=compice, mrg_fld='Faii_evap', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_evap', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addaofluxmap('Faox_evap', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap_aoflux('Faox_evap', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrgTo(compatm , 'Faxx_evap', & + call addmrg_to(compatm , 'Faxx_evap', & mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='merge', mrg_fracname='ofrac') end if end if end if if (phase == 'advertise') then - call addfldTo(compatm, 'Faxx_lwup') - call addFldFrom(complnd, 'Fall_lwup') - call addfldFrom(compice, 'Faii_lwup') - call addaofluxFld( 'Faox_lwup') + call addfld_to(compatm, 'Faxx_lwup') + call addfld_from(complnd, 'Fall_lwup') + call addfld_from(compice, 'Faii_lwup') + call addfld_aoflux( 'Faox_lwup') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lwup', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lwup', rc=rc)) then - call addmapFrom(complnd , 'Fall_lwup', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm , 'Faxx_lwup', & + call addmap_from(complnd , 'Fall_lwup', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm , 'Faxx_lwup', & mrg_from=complnd, mrg_fld='Fall_lwup', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_lwup', rc=rc)) then - call addMapFrom(compice , 'Faii_lwup', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm , 'Faxx_lwup', & + call addmap_from(compice , 'Faii_lwup', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg_to(compatm , 'Faxx_lwup', & mrg_from=compice, mrg_fld='Faii_lwup', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lwup', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addaofluxmap('Faox_lwup', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap_aoflux('Faox_lwup', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrgTo(compatm, 'Faxx_lwup', & + call addmrg_to(compatm, 'Faxx_lwup', & mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1295,27 +1295,27 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_wiso) then if (phase == 'advertise') then - call addfldTo(compatm, 'Faxx_evap_wiso') - call addFldFrom(complnd, 'Fall_evap_wiso') - call addfldFrom(compice, 'Faii_evap_wiso') - call addaofluxFld( 'Faox_evap_wiso') + call addfld_to(compatm, 'Faxx_evap_wiso') + call addfld_from(complnd, 'Fall_evap_wiso') + call addfld_from(compice, 'Faii_evap_wiso') + call addfld_aoflux( 'Faox_evap_wiso') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap_wiso', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap_wiso', rc=rc)) then - call addmapFrom(complnd , 'Fall_evap_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm , 'Faxx_evap_wiso', & + call addmap_from(complnd , 'Fall_evap_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm , 'Faxx_evap_wiso', & mrg_from=complnd, mrg_fld='Fall_evap_wiso', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap_wiso', rc=rc)) then - call addMapFrom(compice , 'Faii_evap_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm , 'Faxx_evap_wiso', & + call addmap_from(compice , 'Faii_evap_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg_to(compatm , 'Faxx_evap_wiso', & mrg_from=compice, mrg_fld='Faii_evap_wiso', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_evap_wiso', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addaofluxmap('Faox_evap_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap_aoflux('Faox_evap_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrgTo(compatm , 'Faxx_evap_wiso', & + call addmrg_to(compatm , 'Faxx_evap_wiso', & mrg_from=compmed, mrg_fld='Faox_evap_wiso', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1326,31 +1326,31 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: merged surface temperature and unmerged temperatures from ice and ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(complnd, 'Sl_t') - call addfldFrom(compice, 'Si_t') - call addfldFrom(compocn, 'So_t') - call addfldTo(compatm, 'So_t') - call addfldTo(compatm, 'Sx_t') + call addfld_from(complnd, 'Sl_t') + call addfld_from(compice, 'Si_t') + call addfld_from(compocn, 'So_t') + call addfld_to(compatm, 'So_t') + call addfld_to(compatm, 'Sx_t') else if (fldchk(is_local%wrap%FBexp(compatm), 'Sx_t', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_t', rc=rc)) then - call addmapFrom(complnd, 'Sl_t', compatm, mapconsf , 'lfrin', lnd2atm_map) - call addmrgTo(compatm, 'Sx_t', & + call addmap_from(complnd, 'Sl_t', compatm, mapconsf , 'lfrin', lnd2atm_map) + call addmrg_to(compatm, 'Sx_t', & mrg_from=complnd, mrg_fld='Sl_t', mrg_type='merge', mrg_fracname='lfrac') end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_t', rc=rc)) then - call addMapFrom(compice, 'Si_t', compatm, mapconsf , 'ifrac', ice2atm_map) - call addmrgTo(compatm, 'Sx_t', & + call addmap_from(compice, 'Si_t', compatm, mapconsf , 'ifrac', ice2atm_map) + call addmrg_to(compatm, 'Sx_t', & mrg_from=compice, mrg_fld='Si_t', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_t', rc=rc)) then - call addmapFrom(compocn, 'So_t', compatm, mapconsf, 'ofrac', ocn2atm_map) - call addmrgTo(compatm, 'Sx_t', & + call addmap_from(compocn, 'So_t', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmrg_to(compatm, 'Sx_t', & mrg_from=compocn, mrg_fld='So_t', mrg_type='merge', mrg_fracname='ofrac') end if end if if (fldchk(is_local%wrap%FBexp(compatm), 'So_t', rc=rc)) then - call addmrgTo(compatm, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + call addmrg_to(compatm, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') end if end if @@ -1360,33 +1360,33 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: mean snow volume per unit area from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(compice, 'Si_snowh') - call addfldTo(compatm, 'Si_snowh') + call addfld_from(compice, 'Si_snowh') + call addfld_to(compatm, 'Si_snowh') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Si_snowh', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), 'Si_snowh', rc=rc)) then - call addMapFrom(compice, 'Si_snowh', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm, 'Si_snowh', mrg_from=compice, mrg_fld='Si_snowh', mrg_type='copy') + call addmap_from(compice, 'Si_snowh', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg_to(compatm, 'Si_snowh', mrg_from=compice, mrg_fld='Si_snowh', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfldFrom(compice, 'Si_vice') - call addfldTo(compatm, 'Si_vice') + call addfld_from(compice, 'Si_vice') + call addfld_to(compatm, 'Si_vice') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Si_vice', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), 'Si_vice', rc=rc)) then - call addMapFrom(compice, 'Si_vice', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm, 'Si_vice', mrg_from=compice, mrg_fld='Si_vice', mrg_type='copy') + call addmap_from(compice, 'Si_vice', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg_to(compatm, 'Si_vice', mrg_from=compice, mrg_fld='Si_vice', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfldFrom(compice, 'Si_vsno') - call addfldTo(compatm, 'Si_vsno') + call addfld_from(compice, 'Si_vsno') + call addfld_to(compatm, 'Si_vsno') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Si_vsno', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), 'Si_vsno', rc=rc)) then - call addMapFrom(compice, 'Si_vsno', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrgTo(compatm, 'Si_vsno', mrg_from=compice, mrg_fld='Si_vsno', mrg_type='copy') + call addmap_from(compice, 'Si_vsno', compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg_to(compatm, 'Si_vsno', mrg_from=compice, mrg_fld='Si_vsno', mrg_type='copy') end if end if @@ -1396,39 +1396,39 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: surface fraction velocity from med aoflux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addaofluxFld('So_ssq') - call addfldTo(compatm , 'So_ssq') + call addfld_aoflux('So_ssq') + call addfld_to(compatm , 'So_ssq') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'So_ssq', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'So_ssq', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addaofluxmap( 'So_ssq', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap_aoflux( 'So_ssq', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrgTo(compatm , 'So_ssq', mrg_from=compmed, mrg_fld='So_ssq', mrg_type='copy') + call addmrg_to(compatm , 'So_ssq', mrg_from=compmed, mrg_fld='So_ssq', mrg_type='copy') end if end if if (phase == 'advertise') then - call addaofluxFld('So_re') - call addfldTo(compatm , 'So_re') + call addfld_aoflux('So_re') + call addfld_to(compatm , 'So_re') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'So_re', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'So_re', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addaofluxmap( 'So_re', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap_aoflux( 'So_re', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrgTo(compatm , 'So_re', mrg_from=compmed, mrg_fld='So_re', mrg_type='copy') + call addmrg_to(compatm , 'So_re', mrg_from=compmed, mrg_fld='So_re', mrg_type='copy') end if end if if (phase == 'advertise') then - call addaofluxFld('So_ustar') - call addfldTo(compatm , 'So_ustar') + call addfld_aoflux('So_ustar') + call addfld_to(compatm , 'So_ustar') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'So_ustar', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'So_ustar', rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addaofluxmap( 'So_ustar', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addmap_aoflux( 'So_ustar', compatm, mapconsf, 'ofrac', ocn2atm_map) end if - call addmrgTo(compatm , 'So_ustar', mrg_from=compmed, mrg_fld='So_ustar', mrg_type='copy') + call addmrg_to(compatm , 'So_ustar', mrg_from=compmed, mrg_fld='So_ustar', mrg_type='copy') end if end if @@ -1438,59 +1438,59 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: surface snow water equivalent from land ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(complnd, 'Sl_fv') - call addfldTo(compatm, 'Sl_fv') + call addfld_from(complnd, 'Sl_fv') + call addfld_to(compatm, 'Sl_fv') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_fv', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_fv', rc=rc)) then - call addmapFrom(complnd, 'Sl_fv', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm, 'Sl_fv', mrg_from=complnd, mrg_fld='Sl_fv', mrg_type='copy') + call addmap_from(complnd, 'Sl_fv', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm, 'Sl_fv', mrg_from=complnd, mrg_fld='Sl_fv', mrg_type='copy') end if end if if (phase == 'advertise') then - call addFldFrom(complnd, 'Sl_ram1') - call addfldTo(compatm, 'Sl_ram1') + call addfld_from(complnd, 'Sl_ram1') + call addfld_to(compatm, 'Sl_ram1') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_ram1', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_ram1', rc=rc)) then - call addmapFrom(complnd, 'Sl_ram1', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm, 'Sl_ram1', mrg_from=complnd, mrg_fld='Sl_ram1', mrg_type='copy') + call addmap_from(complnd, 'Sl_ram1', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm, 'Sl_ram1', mrg_from=complnd, mrg_fld='Sl_ram1', mrg_type='copy') end if end if if (phase == 'advertise') then - call addFldFrom(complnd, 'Sl_snowh') - call addfldTo(compatm, 'Sl_snowh') + call addfld_from(complnd, 'Sl_snowh') + call addfld_to(compatm, 'Sl_snowh') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_snowh', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_snowh', rc=rc)) then - call addmapFrom(complnd, 'Sl_snowh', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm, 'Sl_snowh', mrg_from=complnd, mrg_fld='Sl_snowh', mrg_type='copy') + call addmap_from(complnd, 'Sl_snowh', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm, 'Sl_snowh', mrg_from=complnd, mrg_fld='Sl_snowh', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! CARMA fields (volumetric soil water) !----------------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(complnd, 'Sl_soilw') - call addfldTo(compatm, 'Sl_soilw') + call addfld_from(complnd, 'Sl_soilw') + call addfld_to(compatm, 'Sl_soilw') else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_soilw', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_soilw', rc=rc)) then - call addmapFrom(complnd, 'Sl_soilw', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm, 'Sl_soilw', mrg_from=complnd, mrg_fld='Sl_soilw', mrg_type='copy') + call addmap_from(complnd, 'Sl_soilw', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm, 'Sl_soilw', mrg_from=complnd, mrg_fld='Sl_soilw', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to atm: dust fluxes from land (4 sizes) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(complnd, 'Fall_flxdst') - call addfldTo(compatm, 'Fall_flxdst') + call addfld_from(complnd, 'Fall_flxdst') + call addfld_to(compatm, 'Fall_flxdst') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_flxdst', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_flxdst', rc=rc)) then - call addmapFrom(complnd, 'Fall_flxdst', compatm, mapconsf, 'lfrin', lnd2atm_map) - call addmrgTo(compatm, 'Fall_flxdst', & + call addmap_from(complnd, 'Fall_flxdst', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg_to(compatm, 'Fall_flxdst', & mrg_from=complnd, mrg_fld='Fall_flxdst', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if @@ -1498,13 +1498,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: MEGAN emissions fluxes from land !----------------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(complnd, 'Fall_voc') - call addfldTo(compatm, 'Fall_voc') + call addfld_from(complnd, 'Fall_voc') + call addfld_to(compatm, 'Fall_voc') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_voc', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_voc', rc=rc)) then - call addmapFrom(complnd, 'Fall_voc', compatm, mapconsf, 'one', atm2lnd_map) - call addmrgTo(compatm, 'Fall_voc', & + call addmap_from(complnd, 'Fall_voc', compatm, mapconsf, 'one', atm2lnd_map) + call addmrg_to(compatm, 'Fall_voc', & mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='merge', mrg_fracname='lfrac') end if end if @@ -1513,38 +1513,38 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------------------------------------------------------- ! 'wild fire emission fluxes' if (phase == 'advertise') then - call addFldFrom(complnd, 'Fall_fire') - call addfldTo(compatm, 'Fall_fire') + call addfld_from(complnd, 'Fall_fire') + call addfld_to(compatm, 'Fall_fire') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_fire', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_fire', rc=rc)) then - call addmapFrom(complnd, 'Fall_fire', compatm, mapconsf, 'one', lnd2atm_map) - call addmrgTo(compatm, 'Fall_fire', & + call addmap_from(complnd, 'Fall_fire', compatm, mapconsf, 'one', lnd2atm_map) + call addmrg_to(compatm, 'Fall_fire', & mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='merge', mrg_fracname='lfrac') end if end if ! 'wild fire plume height' if (phase == 'advertise') then - call addFldFrom(complnd, 'Sl_fztop') - call addfldTo(compatm, 'Sl_fztop') + call addfld_from(complnd, 'Sl_fztop') + call addfld_to(compatm, 'Sl_fztop') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Sl_fztop', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Sl_fztop', rc=rc)) then - call addmapFrom(complnd, 'Sl_fztop', compatm, mapconsf, 'one', lnd2atm_map) - call addmrgTo(compatm, 'Sl_fztop', mrg_from=complnd, mrg_fld='Sl_fztop', mrg_type='copy') + call addmap_from(complnd, 'Sl_fztop', compatm, mapconsf, 'one', lnd2atm_map) + call addmrg_to(compatm, 'Sl_fztop', mrg_from=complnd, mrg_fld='Sl_fztop', mrg_type='copy') end if end if !----------------------------------------------------------------------------- ! to atm: dry deposition velocities from land !----------------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(complnd, 'Sl_ddvel') - call addfldTo(compatm, 'Sl_ddvel') + call addfld_from(complnd, 'Sl_ddvel') + call addfld_to(compatm, 'Sl_ddvel') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Sl_ddvel', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Sl_ddvel', rc=rc)) then - call addmapFrom(complnd, 'Sl_ddvel', compatm, mapconsf, 'one', lnd2atm_map) - call addmrgTo(compatm, 'Sl_ddvel', mrg_from=complnd, mrg_fld='Sl_ddvel', mrg_type='copy') + call addmap_from(complnd, 'Sl_ddvel', compatm, mapconsf, 'one', lnd2atm_map) + call addmrg_to(compatm, 'Sl_ddvel', mrg_from=complnd, mrg_fld='Sl_ddvel', mrg_type='copy') end if end if @@ -1556,11 +1556,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: fractional ice coverage wrt ocean from ice !---------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(compice, 'Si_ifrac') - call addFldTo(compocn, 'Si_ifrac') + call addfld_from(compice, 'Si_ifrac') + call addfld_to(compocn, 'Si_ifrac') else - call addMapFrom(compice, 'Si_ifrac', compocn, mapfcopy, 'unset', 'unset') - call addmrgTo(compocn, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') + 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') end if ! --------------------------------------------------------------------- @@ -1571,57 +1571,57 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: downward diffuse visible incident solar radiation from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_lwdn') - call addFldTo(compocn, 'Faxa_lwdn') + call addfld_from(compatm, 'Faxa_lwdn') + call addfld_to(compocn, 'Faxa_lwdn') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_lwdn', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn', rc=rc)) then - call addMapFrom(compatm, 'Faxa_lwdn', compocn, mapconsf, 'one', atm2ocn_map) - call addmrgTo(compocn, 'Faxa_lwdn', & + call addmap_from(compatm, 'Faxa_lwdn', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Faxa_lwdn', & mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_swndr') - call addFldTo(compocn, 'Faxa_swndr') + call addfld_from(compatm, 'Faxa_swndr') + call addfld_to(compocn, 'Faxa_swndr') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_swndr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndr', rc=rc)) then - call addMapFrom(compatm, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_map) - call addmrgTo(compocn, 'Faxa_swndr', & + call addmap_from(compatm, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Faxa_swndr', & mrg_from=compatm, mrg_fld='Faxa_swndr', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_swndf') - call addFldTo(compocn, 'Faxa_swndf') + call addfld_from(compatm, 'Faxa_swndf') + call addfld_to(compocn, 'Faxa_swndf') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_swndf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndf', rc=rc)) then - call addMapFrom(compatm, 'Faxa_swndf', compocn, mapconsf, 'one', atm2ocn_map) - call addmrgTo(compocn, 'Faxa_swndf', & + call addmap_from(compatm, 'Faxa_swndf', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Faxa_swndf', & mrg_from=compatm, mrg_fld='Faxa_swndf', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_swvdr') - call addFldTo(compocn, 'Faxa_swvdr') + call addfld_from(compatm, 'Faxa_swvdr') + call addfld_to(compocn, 'Faxa_swvdr') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_swvdr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdr', rc=rc)) then - call addMapFrom(compatm, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_map) - call addmrgTo(compocn, 'Faxa_swvdr', & + call addmap_from(compatm, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Faxa_swvdr', & mrg_from=compatm, mrg_fld='Faxa_swvdr', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_swvdf') - call addFldTo(compocn, 'Faxa_swvdf') + call addfld_from(compatm, 'Faxa_swvdf') + call addfld_to(compocn, 'Faxa_swvdf') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_swvdf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdf', rc=rc)) then - call addMapFrom(compatm, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_map) - call addmrgTo(compocn, 'Faxa_swvdf', & + call addmap_from(compatm, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Faxa_swvdf', & mrg_from=compatm, mrg_fld='Faxa_swvdf', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if @@ -1630,12 +1630,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: surface upward longwave heat flux from mediator ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addaofluxFld('Faox_lwup') - call addFldTo(compocn , 'Foxx_lwup') + call addfld_aoflux('Faox_lwup') + call addfld_to(compocn , 'Foxx_lwup') else if ( fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lwup', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn), 'Foxx_lwup', rc=rc)) then - call addmrgTo(compocn, 'Foxx_lwup', & + call addmrg_to(compocn, 'Foxx_lwup', & mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1643,18 +1643,18 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: merged longwave net heat flux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm , 'Faxa_lwdn') - call addaofluxFld('Faox_lwup' ) - call addFldTo(compocn , 'Foxx_lwnet') + call addfld_from(compatm , 'Faxa_lwdn') + call addfld_aoflux('Faox_lwup' ) + call addfld_to(compocn , 'Foxx_lwnet') else ! (mom6) (send longwave net to ocn via auto merge) if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_lwnet', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_lwup' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn' , rc=rc)) then - call addMapFrom(compatm, 'Faxa_lwdn', compocn, mapconsf, 'one' , atm2ocn_map) - call addmrgTo(compocn, 'Foxx_lwnet', & + call addmap_from(compatm, 'Faxa_lwdn', compocn, mapconsf, 'one' , atm2ocn_map) + call addmrg_to(compocn, 'Foxx_lwnet', & mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') - call addmrgTo(compocn, 'Foxx_lwnet', & + call addmrg_to(compocn, 'Foxx_lwnet', & mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1662,13 +1662,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: downward shortwave heat flux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_swdn') - call addFldTo(compocn, 'Faxa_swdn') + call addfld_from(compatm, 'Faxa_swdn') + call addfld_to(compocn, 'Faxa_swdn') else if (fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_swdn', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_swdn', rc=rc)) then - call addMapFrom(compatm, 'Faxa_swdn', compocn, mapconsf, 'one', atm2ocn_map) - call addmrgTo(compocn, 'Faxa_swdn', & + call addmap_from(compatm, 'Faxa_swdn', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Faxa_swdn', & mrg_from=compatm, mrg_fld='Faxa_swdn', mrg_type='copy') end if end if @@ -1676,28 +1676,28 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: net shortwave radiation from med ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_swvdr') - call addFldFrom(compatm, 'Faxa_swndr') - call addFldFrom(compatm, 'Faxa_swvdf') - call addFldFrom(compatm, 'Faxa_swndf') + call addfld_from(compatm, 'Faxa_swvdr') + call addfld_from(compatm, 'Faxa_swndr') + call addfld_from(compatm, 'Faxa_swvdf') + call addfld_from(compatm, 'Faxa_swndf') - call addfldFrom(compice, 'Fioi_swpen') - call addfldFrom(compice, 'Fioi_swpen_vdr') - call addfldFrom(compice, 'Fioi_swpen_vdf') - call addfldFrom(compice, 'Fioi_swpen_idr') - call addfldFrom(compice, 'Fioi_swpen_idf') + call addfld_from(compice, 'Fioi_swpen') + call addfld_from(compice, 'Fioi_swpen_vdr') + call addfld_from(compice, 'Fioi_swpen_vdf') + call addfld_from(compice, 'Fioi_swpen_idr') + call addfld_from(compice, 'Fioi_swpen_idf') - call addFldTo(compocn, 'Foxx_swnet') - call addFldTo(compocn, 'Foxx_swnet_vdr') - call addFldTo(compocn, 'Foxx_swnet_vdf') - call addFldTo(compocn, 'Foxx_swnet_idr') - call addFldTo(compocn, 'Foxx_swnet_idf') + call addfld_to(compocn, 'Foxx_swnet') + call addfld_to(compocn, 'Foxx_swnet_vdr') + call addfld_to(compocn, 'Foxx_swnet_vdf') + call addfld_to(compocn, 'Foxx_swnet_idr') + call addfld_to(compocn, 'Foxx_swnet_idf') else ! Net shortwave ocean (custom calculation in prep_phases_ocn_mod.F90) ! import swpen from ice without bands if (fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen', rc=rc)) then - call addMapFrom(compice, 'Fioi_swpen', compocn, mapfcopy, 'unset', 'unset') + call addmap_from(compice, 'Fioi_swpen', compocn, mapfcopy, 'unset', 'unset') end if ! import swpen from ice by bands @@ -1705,10 +1705,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_idr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_idf', rc=rc)) then - call addMapFrom(compice, 'Fioi_swpen_vdr', compocn, mapfcopy, 'unset', 'unset') - call addMapFrom(compice, 'Fioi_swpen_vdf', compocn, mapfcopy, 'unset', 'unset') - call addMapFrom(compice, 'Fioi_swpen_idr', compocn, mapfcopy, 'unset', 'unset') - call addMapFrom(compice, 'Fioi_swpen_idf', compocn, mapfcopy, 'unset', 'unset') + call addmap_from(compice, 'Fioi_swpen_vdr', compocn, mapfcopy, 'unset', 'unset') + call addmap_from(compice, 'Fioi_swpen_vdf', compocn, mapfcopy, 'unset', 'unset') + call addmap_from(compice, 'Fioi_swpen_idr', compocn, mapfcopy, 'unset', 'unset') + call addmap_from(compice, 'Fioi_swpen_idf', compocn, mapfcopy, 'unset', 'unset') end if ! import sw from atm by bands @@ -1721,10 +1721,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc))) then - call addMapFrom(compatm, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_map) - call addMapFrom(compatm, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_map) - call addMapFrom(compatm, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_map) - call addMapFrom(compatm, 'Faxa_swndf', compocn, mapconsf, 'one', atm2ocn_map) + call addmap_from(compatm, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_map) + call addmap_from(compatm, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_map) + call addmap_from(compatm, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_map) + call addmap_from(compatm, 'Faxa_swndf', compocn, mapconsf, 'one', atm2ocn_map) end if end if @@ -1734,27 +1734,27 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_i2o_per_cat) then if (phase == 'advertise') then ! 'fractional ice coverage wrt ocean for each thickness category ' - call addfldFrom(compice, 'Si_ifrac_n') - call addFldTo(compocn, 'Si_ifrac_n') + call addfld_from(compice, 'Si_ifrac_n') + call addfld_to(compocn, 'Si_ifrac_n') ! net shortwave radiation penetrating into ocean for each thickness category - call addfldFrom(compice, 'Fioi_swpen_ifrac_n') - call addFldTo(compocn, 'Fioi_swpen_ifrac_n') + call addfld_from(compice, 'Fioi_swpen_ifrac_n') + call addfld_to(compocn, 'Fioi_swpen_ifrac_n') ! 'fractional atmosphere coverage wrt ocean' (computed in med_phases_prep_ocn) - call addFldTo(compocn, 'Sf_afrac') + call addfld_to(compocn, 'Sf_afrac') ! 'fractional atmosphere coverage used in radiation computations wrt ocean' (computed in med_phases_prep_ocn) - call addFldTo(compocn, 'Sf_afracr') + call addfld_to(compocn, 'Sf_afracr') ! 'net shortwave radiation times atmosphere fraction' (computed in med_phases_prep_ocn) - call addFldTo(compocn, 'Foxx_swnet_afracr') + call addfld_to(compocn, 'Foxx_swnet_afracr') else - call addMapFrom(compice, 'Si_ifrac_n', & + call addmap_from(compice, 'Si_ifrac_n', & compocn, mapfcopy, 'unset', 'unset') - call addmrgTo(compocn, 'Si_ifrac_n', & + call addmrg_to(compocn, 'Si_ifrac_n', & mrg_from=compice, mrg_fld='Si_ifrac_n', mrg_type='copy') - call addMapFrom(compice, 'Fioi_swpen_ifrac_n', & + call addmap_from(compice, 'Fioi_swpen_ifrac_n', & compocn, mapfcopy, 'unset', 'unset') - call addmrgTo(compocn, 'Fioi_swpen_ifrac_n', & + call addmrg_to(compocn, 'Fioi_swpen_ifrac_n', & mrg_from=compice, mrg_fld='Fioi_swpen_ifrac_n', mrg_type='copy') ! Note that 'Sf_afrac, 'Sf_afracr' and 'Foxx_swnet_afracr' will have explicit merging in med_phases_prep_ocn end if @@ -1766,12 +1766,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_rainc') - call addFldFrom(compatm, 'Faxa_rainl') - call addFldTo(compocn, 'Faxa_rain' ) - call addFldFrom(compatm, 'Faxa_snowc') - call addFldFrom(compatm, 'Faxa_snowl') - call addFldTo(compocn, 'Faxa_snow' ) + call addfld_from(compatm, 'Faxa_rainc') + call addfld_from(compatm, 'Faxa_rainl') + call addfld_to(compocn, 'Faxa_rain' ) + call addfld_from(compatm, 'Faxa_snowc') + call addfld_from(compatm, 'Faxa_snowl') + call addfld_to(compocn, 'Faxa_snow' ) else ! TODO: why are we not merging Faxa_rain and Faxa_snow if they are sent from atm wiht ofrac ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization @@ -1779,47 +1779,47 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain' , rc=rc)) then - call addMapFrom(compatm, 'Faxa_rainl', compocn, mapconsf, 'one', atm2ocn_map) - call addMapFrom(compatm, 'Faxa_rainc', compocn, mapconsf, 'one', atm2ocn_map) - call addmrgTo(compocn, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', & + call addmap_from(compatm, 'Faxa_rainl', compocn, mapconsf, 'one', atm2ocn_map) + call addmap_from(compatm, 'Faxa_rainc', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', & mrg_type='sum_with_weights', mrg_fracname='ofrac') end if if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc', rc=rc)) then - call addMapFrom(compatm, 'Faxa_snowl', compocn, mapconsf, 'one', atm2ocn_map) - call addMapFrom(compatm, 'Faxa_snowc', compocn, mapconsf, 'one', atm2ocn_map) - call addmrgTo(compocn, 'Faxa_snow' , & + call addmap_from(compatm, 'Faxa_snowl', compocn, mapconsf, 'one', atm2ocn_map) + call addmap_from(compatm, 'Faxa_snowc', compocn, mapconsf, 'one', atm2ocn_map) + 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 end if if (flds_wiso) then if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_rainc_wiso') - call addFldFrom(compatm, 'Faxa_rainl_wiso') - call addFldTo(compocn, 'Faxa_rain_wiso' ) - call addFldFrom(compatm, 'Faxa_snowc_wiso') - call addFldFrom(compatm, 'Faxa_snowl_wiso') - call addFldFrom(compatm, 'Faxa_snow_wiso' ) + call addfld_from(compatm, 'Faxa_rainc_wiso') + call addfld_from(compatm, 'Faxa_rainl_wiso') + call addfld_to(compocn, 'Faxa_rain_wiso' ) + call addfld_from(compatm, 'Faxa_snowc_wiso') + call addfld_from(compatm, 'Faxa_snowl_wiso') + call addfld_from(compatm, 'Faxa_snow_wiso' ) else ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization ! which by default is not actually used if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain_wiso' , rc=rc)) then - call addMapFrom(compatm, 'Faxa_rainl_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addMapFrom(compatm, 'Faxa_rainc_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmrgTo(compocn, 'Faxa_rain_wiso' , & + call addmap_from(compatm, 'Faxa_rainl_wiso', compocn, mapconsf, 'one', atm2ocn_map) + call addmap_from(compatm, 'Faxa_rainc_wiso', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Faxa_rain_wiso' , & mrg_from=compatm, mrg_fld=trim('Faxa_rainc_wiso')//':'//trim('Faxa_rainl_wiso'), & mrg_type='sum_with_weights', mrg_fracname='ofrac') end if if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc_wiso', rc=rc)) then - call addMapFrom(compatm, 'Faxa_snowl_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addMapFrom(compatm, 'Faxa_snowc_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmrgTo(compocn, 'Faxa_snow_wiso', & + call addmap_from(compatm, 'Faxa_snowl_wiso', compocn, mapconsf, 'one', atm2ocn_map) + call addmap_from(compatm, 'Faxa_snowc_wiso', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Faxa_snow_wiso', & mrg_from=compatm, mrg_fld=trim('Faxa_snowc_wiso')//':'//trim('Faxa_snowl_wiso'), & mrg_type='sum_with_weights', mrg_fracname='ofrac') end if @@ -1830,14 +1830,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: merged sensible heat flux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm , 'Faxa_sen') - call addaofluxFld('Faox_sen') - call addfldFrom(compice , 'Fioi_melth') - call addFldTo(compocn , 'Foxx_sen') + call addfld_from(compatm , 'Faxa_sen') + call addfld_aoflux('Faox_sen') + call addfld_from(compice , 'Fioi_melth') + call addfld_to(compocn , 'Foxx_sen') else if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_sen', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_sen', rc=rc)) then - call addmrgTo(compocn, 'Foxx_sen', & + call addmrg_to(compocn, 'Foxx_sen', & mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1846,29 +1846,29 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: surface latent heat flux and evaporation water flux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_lat' ) - call addaofluxFld( 'Faox_lat' ) - call addaofluxFld( 'Faox_evap') - call addFldTo(compocn, 'Foxx_lat' ) - call addFldTo(compocn, 'Foxx_evap') + call addfld_from(compatm, 'Faxa_lat' ) + call addfld_aoflux( 'Faox_lat' ) + call addfld_aoflux( 'Faox_evap') + call addfld_to(compocn, 'Foxx_lat' ) + call addfld_to(compocn, 'Foxx_evap') else if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat', rc=rc)) then - call addmrgTo(compocn, 'Foxx_lat', & + call addmrg_to(compocn, 'Foxx_lat', & mrg_from=compmed, mrg_fld='Faox_lat', mrg_type='merge', mrg_fracname='ofrac') end if if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap', rc=rc)) then - call addmrgTo(compocn, 'Foxx_evap', & + call addmrg_to(compocn, 'Foxx_evap', & mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='merge', mrg_fracname='ofrac') end if end if if (flds_wiso) then if (phase == 'advertise') then - call addaofluxFld( 'Faox_lat_wiso' ) - call addFldTo(compocn, 'Foxx_lat_wiso' ) + call addfld_aoflux( 'Faox_lat_wiso' ) + call addfld_to(compocn, 'Foxx_lat_wiso' ) else if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat_wiso', rc=rc)) then - call addmrgTo(compocn, 'Foxx_lat_wiso', & + call addmrg_to(compocn, 'Foxx_lat_wiso', & mrg_from=compmed, mrg_fld='Faox_lat_wiso', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -1881,11 +1881,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! If the aoflux grid is ogrid - then nothing needs to be done to send to the ocean ! All other mappings are set in med_phases_aoflux_mod.F90 if (phase == 'advertise') then - call addaofluxFld( 'So_duu10n') - call addFldTo(compocn, 'So_duu10n') + call addfld_aoflux( 'So_duu10n') + call addfld_to(compocn, 'So_duu10n') else if (fldchk(is_local%wrap%FBExp(compocn), 'So_duu10n', rc=rc)) then - call addmrgTo(compocn, 'So_duu10n', mrg_from=compmed, mrg_fld='So_duu10n', mrg_type='copy') + call addmrg_to(compocn, 'So_duu10n', mrg_from=compmed, mrg_fld='So_duu10n', mrg_type='copy') end if end if @@ -1893,14 +1893,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: sea level pressure from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_pslv') - call addFldTo(compocn, 'Sa_pslv') + call addfld_from(compatm, 'Sa_pslv') + call addfld_to(compocn, 'Sa_pslv') else if ( fldchk(is_local%wrap%FBImp(compatm, compatm), 'Sa_pslv', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Sa_pslv', rc=rc)) then - call addMapFrom(compatm, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_map) - call addMapFrom(compatm, 'Sa_pslv', compice, mapbilnr, 'one', atm2ocn_map) - call addmrgTo(compocn, 'Sa_pslv', & + call addmap_from(compatm, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap_from(compatm, 'Sa_pslv', compice, mapbilnr, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Sa_pslv', & mrg_from=compatm, mrg_fld='Sa_pslv', mrg_type='copy') end if end if @@ -1919,46 +1919,46 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: nitrogen deposition fields (2) from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldTo(compocn, 'Faxa_bcph') - call addFldFrom(compatm, 'Faxa_bcph') + call addfld_to(compocn, 'Faxa_bcph') + call addfld_from(compatm, 'Faxa_bcph') else if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_bcph', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_bcph', rc=rc)) then - call addMapFrom(compatm, 'Faxa_bcph', compocn, mapconsf, 'one', atm2ocn_map) - call addmrgTo(compocn, 'Faxa_bcph', & + call addmap_from(compatm, 'Faxa_bcph', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Faxa_bcph', & mrg_from=compatm, mrg_fld='Faxa_bcph', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addFldTo(compocn, 'Faxa_ocph') - call addFldFrom(compatm, 'Faxa_ocph') + call addfld_to(compocn, 'Faxa_ocph') + call addfld_from(compatm, 'Faxa_ocph') else if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_ocph', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_ocph', rc=rc)) then - call addMapFrom(compatm, 'Faxa_ocph', compocn, mapconsf, 'one', atm2ocn_map) - call addmrgTo(compocn, 'Faxa_ocph', & + call addmap_from(compatm, 'Faxa_ocph', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Faxa_ocph', & mrg_from=compatm, mrg_fld='Faxa_ocph', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addFldTo(compocn, 'Faxa_dstwet') - call addFldFrom(compatm, 'Faxa_dstwet') + call addfld_to(compocn, 'Faxa_dstwet') + call addfld_from(compatm, 'Faxa_dstwet') else if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_dstwet', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_dstwet', rc=rc)) then - call addMapFrom(compatm, 'Faxa_dstwet', compocn, mapconsf, 'one', atm2ocn_map) - call addmrgTo(compocn, 'Faxa_dstwet', & + call addmap_from(compatm, 'Faxa_dstwet', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Faxa_dstwet', & mrg_from=compatm, mrg_fld='Faxa_dstwet', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addFldTo(compocn, 'Faxa_dstdry') - call addFldFrom(compatm, 'Faxa_dstdry') + call addfld_to(compocn, 'Faxa_dstdry') + call addfld_from(compatm, 'Faxa_dstdry') else if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_dstdry', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_dstdry', rc=rc)) then - call addMapFrom(compatm, 'Faxa_dstdry', compocn, mapconsf, 'one', atm2ocn_map) - call addmrgTo(compocn, 'Faxa_dstdry', & + call addmap_from(compatm, 'Faxa_dstdry', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Faxa_dstdry', & mrg_from=compatm, mrg_fld='Faxa_dstdry', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if @@ -1971,44 +1971,44 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Note - do not need to add addmap or addmrg for the following since they ! will be computed directly in med_phases_prep_ocn if (phase == 'advertise') then - call addFldTo(compocn, 'Foxx_hrain') - call addFldTo(compocn, 'Foxx_hsnow') - call addFldTo(compocn, 'Foxx_hevap') - call addFldTo(compocn, 'Foxx_hcond') - call addFldTo(compocn, 'Foxx_hrofl') - call addFldTo(compocn, 'Foxx_hrofi') + call addfld_to(compocn, 'Foxx_hrain') + call addfld_to(compocn, 'Foxx_hsnow') + call addfld_to(compocn, 'Foxx_hevap') + call addfld_to(compocn, 'Foxx_hcond') + call addfld_to(compocn, 'Foxx_hrofl') + call addfld_to(compocn, 'Foxx_hrofi') end if ! --------------------------------------------------------------------- ! to ocn: merge zonal and meridional surface stress from ice and (atm or med) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldTo(compocn , 'Foxx_taux') - call addfldFrom(compice , 'Fioi_taux') - call addaofluxFld('Faox_taux') + call addfld_to(compocn , 'Foxx_taux') + call addfld_from(compice , 'Fioi_taux') + call addfld_aoflux('Faox_taux') else if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_taux', rc=rc)) then if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then - call addMapFrom(compice, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') - call addmrgTo(compocn, 'Foxx_taux', & + 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') end if - call addmrgTo(compocn, 'Foxx_taux', & + call addmrg_to(compocn, 'Foxx_taux', & mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if if (phase == 'advertise') then - call addFldTo(compocn , 'Foxx_tauy') - call addfldFrom(compice , 'Fioi_tauy') - call addaofluxFld('Faox_tauy') + call addfld_to(compocn , 'Foxx_tauy') + call addfld_from(compice , 'Fioi_tauy') + call addfld_aoflux('Faox_tauy') else if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_tauy', rc=rc)) then if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_tauy', rc=rc)) then - call addMapFrom(compice, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') - call addmrgTo(compocn, 'Foxx_tauy', & + 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') end if - call addmrgTo(compocn, 'Foxx_tauy', & + call addmrg_to(compocn, 'Foxx_tauy', & mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -2016,25 +2016,25 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: water flux due to melting ice from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(compice , 'Fioi_meltw') - call addFldTo(compocn , 'Fioi_meltw') + call addfld_from(compice , 'Fioi_meltw') + call addfld_to(compocn , 'Fioi_meltw') else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Fioi_meltw', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_meltw', rc=rc)) then - call addMapFrom(compice, 'Fioi_meltw', compocn, mapfcopy, 'unset', 'unset') - call addmrgTo(compocn, 'Fioi_meltw', & + call addmap_from(compice, 'Fioi_meltw', compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, 'Fioi_meltw', & mrg_from=compice, mrg_fld='Fioi_meltw', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if if (flds_wiso) then if (phase == 'advertise') then - call addfldFrom(compice , 'Fioi_meltw_wiso') - call addFldTo(compocn , 'Fioi_meltw_wiso') + call addfld_from(compice , 'Fioi_meltw_wiso') + call addfld_to(compocn , 'Fioi_meltw_wiso') else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Fioi_meltw_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_meltw_wiso', rc=rc)) then - call addMapFrom(compice, 'Fioi_meltw_wiso', compocn, mapfcopy, 'unset', 'unset') - call addmrgTo(compocn, 'Fioi_meltw_wiso', & + call addmap_from(compice, 'Fioi_meltw_wiso', compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, 'Fioi_meltw_wiso', & mrg_from=compice, mrg_fld='Fioi_meltw_wiso', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if @@ -2043,13 +2043,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: heat flux from melting ice from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(compice, 'Fioi_melth') - call addFldTo(compocn, 'Fioi_melth') + call addfld_from(compice, 'Fioi_melth') + call addfld_to(compocn, 'Fioi_melth') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_melth', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_melth', rc=rc)) then - call addMapFrom(compice, 'Fioi_melth', compocn, mapfcopy, 'unset', 'unset') - call addmrgTo(compocn, 'Fioi_melth', & + call addmap_from(compice, 'Fioi_melth', compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, 'Fioi_melth', & mrg_from=compice, mrg_fld='Fioi_melth', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if @@ -2057,13 +2057,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: salt flux from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(compice, 'Fioi_salt') - call addFldTo(compocn, 'Fioi_salt') + call addfld_from(compice, 'Fioi_salt') + call addfld_to(compocn, 'Fioi_salt') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_salt', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_salt', rc=rc)) then - call addMapFrom(compice, 'Fioi_salt', compocn, mapfcopy, 'unset', 'unset') - call addmrgTo(compocn, 'Fioi_salt', & + call addmap_from(compice, 'Fioi_salt', compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, 'Fioi_salt', & mrg_from=compice, mrg_fld='Fioi_salt', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if @@ -2071,13 +2071,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: hydrophylic black carbon deposition flux from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(compice, 'Fioi_bcphi') - call addFldTo(compocn, 'Fioi_bcphi') + call addfld_from(compice, 'Fioi_bcphi') + call addfld_to(compocn, 'Fioi_bcphi') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_bcphi', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_bcphi', rc=rc)) then - call addMapFrom(compice, 'Fioi_bcphi', compocn, mapfcopy, 'unset', 'unset') - call addmrgTo(compocn, 'Fioi_bcphi', & + call addmap_from(compice, 'Fioi_bcphi', compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, 'Fioi_bcphi', & mrg_from=compice, mrg_fld='Fioi_bcphi', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if @@ -2085,13 +2085,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: hydrophobic black carbon deposition flux from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(compice, 'Fioi_bcpho') - call addFldTo(compocn, 'Fioi_bcpho') + call addfld_from(compice, 'Fioi_bcpho') + call addfld_to(compocn, 'Fioi_bcpho') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_bcpho', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_bcpho', rc=rc)) then - call addMapFrom(compice, 'Fioi_bcpho', compocn, mapfcopy, 'unset', 'unset') - call addmrgTo(compocn, 'Fioi_bcpho', & + call addmap_from(compice, 'Fioi_bcpho', compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, 'Fioi_bcpho', & mrg_from=compice, mrg_fld='Fioi_bcpho', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if @@ -2099,13 +2099,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: dust flux from ice ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(compice, 'Fioi_flxdst') - call addFldTo(compocn, 'Fioi_flxdst') + call addfld_from(compice, 'Fioi_flxdst') + call addfld_to(compocn, 'Fioi_flxdst') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_flxdst', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_flxdst', rc=rc)) then - call addMapFrom(compice, 'Fioi_flxdst', compocn, mapfcopy, 'unset', 'unset') - call addmrgTo(compocn, 'Fioi_flxdst', & + call addmap_from(compice, 'Fioi_flxdst', compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, 'Fioi_flxdst', & mrg_from=compice, mrg_fld='Fioi_flxdst', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if @@ -2121,38 +2121,38 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! fldlistFr(comprof) in order to be mapped correctly but the ocean ! does not receive it so it is advertised but it will! not be connected do ns = 1, is_local%wrap%num_icesheets - call addfldFrom(compglc(ns), 'Fogg_rofl') + call addfld_from(compglc(ns), 'Fogg_rofl') end do - call addfldFrom(comprof, 'Forr_rofl') - call addFldTo(compocn, 'Foxx_rofl') - call addFldTo(compocn, 'Flrr_flood') + call addfld_from(comprof, 'Forr_rofl') + call addfld_to(compocn, 'Foxx_rofl') + call addfld_to(compocn, 'Flrr_flood') do ns = 1, is_local%wrap%num_icesheets - call addfldFrom(compglc(ns), 'Fogg_rofi') + call addfld_from(compglc(ns), 'Fogg_rofi') end do - call addfldFrom(comprof, 'Forr_rofi') - call addFldTo(compocn, 'Foxx_rofi') + call addfld_from(comprof, 'Forr_rofi') + call addfld_to(compocn, 'Foxx_rofi') else if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc)) then ! liquid from river and possibly flood from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl' , rc=rc)) then if (trim(rof2ocn_liq_rmap) == 'unset') then - call addmapFrom(comprof, 'Forr_rofl', compocn, mapconsd, 'none', 'unset') + call addmap_from(comprof, 'Forr_rofl', compocn, mapconsd, 'none', 'unset') else - call addmapFrom(comprof, 'Forr_rofl', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) + call addmap_from(comprof, 'Forr_rofl', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) end if if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood', rc=rc)) then - call addmapFrom(comprof, 'Flrr_flood', compocn, mapconsd, 'one', rof2ocn_fmap) - call addmrgTo(compocn, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl:Flrr_flood', mrg_type='sum') + call addmap_from(comprof, 'Flrr_flood', compocn, mapconsd, 'one', rof2ocn_fmap) + call addmrg_to(compocn, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl:Flrr_flood', mrg_type='sum') else - call addmrgTo(compocn, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl', mrg_type='sum') + call addmrg_to(compocn, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl', mrg_type='sum') end if end if ! liquid from glc to ocean do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofl' , rc=rc)) then ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmapFrom(compglc(ns), 'Fogg_rofl', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) - call addmrgTo(compocn, 'Foxx_rofl', mrg_from=compglc(ns), mrg_fld='Fogg_rofl', mrg_type='sum') + call addmap_from(compglc(ns), 'Fogg_rofl', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) + call addmrg_to(compocn, 'Foxx_rofl', mrg_from=compglc(ns), mrg_fld='Fogg_rofl', mrg_type='sum') end if end do end if @@ -2160,18 +2160,18 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! ice from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi' , rc=rc)) then if (trim(rof2ocn_ice_rmap) == 'unset') then - call addmapFrom(comprof, 'Forr_rofi', compocn, mapconsd, 'none', 'unset') + call addmap_from(comprof, 'Forr_rofi', compocn, mapconsd, 'none', 'unset') else - call addmapFrom(comprof, 'Forr_rofi', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) + call addmap_from(comprof, 'Forr_rofi', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) end if - call addmrgTo(compocn, 'Foxx_rofi', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') + call addmrg_to(compocn, 'Foxx_rofi', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') end if ! ice from glc to ocean do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofi' , rc=rc)) then ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmapFrom(compglc(ns), 'Fogg_rofi', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) - call addmrgTo(compocn, 'Foxx_rofi', mrg_from=compglc(ns), mrg_fld='Fogg_rofi', mrg_type='sum') + call addmap_from(compglc(ns), 'Fogg_rofi', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) + call addmrg_to(compocn, 'Foxx_rofi', mrg_from=compglc(ns), mrg_fld='Fogg_rofi', mrg_type='sum') end if end do end if @@ -2180,31 +2180,31 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_wiso) then if (phase == 'advertise') then do ns = 1, is_local%wrap%num_icesheets - call addfldFrom(compglc(ns), 'Fogg_rofl_wiso') + call addfld_from(compglc(ns), 'Fogg_rofl_wiso') end do - call addfldFrom(comprof, 'Forr_rofl_wiso') - call addFldTo(compocn, 'Foxx_rofl_wiso') - call addFldTo(compocn, 'Flrr_flood_wiso') + call addfld_from(comprof, 'Forr_rofl_wiso') + call addfld_to(compocn, 'Foxx_rofl_wiso') + call addfld_to(compocn, 'Flrr_flood_wiso') do ns = 1, is_local%wrap%num_icesheets - call addfldFrom(compglc(ns), 'Fogg_rofi_wiso') + call addfld_from(compglc(ns), 'Fogg_rofi_wiso') end do - call addfldFrom(comprof, 'Forr_rofi_wiso') - call addFldTo(compocn, 'Foxx_rofi_wiso') + call addfld_from(comprof, 'Forr_rofi_wiso') + call addfld_to(compocn, 'Foxx_rofi_wiso') else if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl_wiso' , rc=rc)) then ! liquid from river and possibly flood from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_wiso' , rc=rc)) then if (trim(rof2ocn_liq_rmap) == 'unset') then - call addmapFrom(comprof, 'Forr_rofl_wiso', compocn, mapconsd, 'none', 'unset') + call addmap_from(comprof, 'Forr_rofl_wiso', compocn, mapconsd, 'none', 'unset') else - call addmapFrom(comprof, 'Forr_rofl_wiso', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) + call addmap_from(comprof, 'Forr_rofl_wiso', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) end if if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood_wiso', rc=rc)) then - call addmapFrom(comprof, 'Flrr_flood_wiso', compocn, mapconsd, 'one', rof2ocn_fmap) - call addmrgTo(compocn, 'Foxx_rofl_wiso', & + call addmap_from(comprof, 'Flrr_flood_wiso', compocn, mapconsd, 'one', rof2ocn_fmap) + call addmrg_to(compocn, 'Foxx_rofl_wiso', & mrg_from=comprof, mrg_fld='Forr_rofl:Flrr_flood', mrg_type='sum') else - call addmrgTo(compocn, 'Foxx_rofl_wiso', & + call addmrg_to(compocn, 'Foxx_rofl_wiso', & mrg_from=comprof, mrg_fld='Forr_rofl', mrg_type='sum') end if end if @@ -2212,8 +2212,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofl_wiso' , rc=rc)) then ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmapFrom(compglc(ns), 'Fogg_rofl_wiso', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) - call addmrgTo(compocn, 'Foxx_rofl_wiso', & + call addmap_from(compglc(ns), 'Fogg_rofl_wiso', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) + call addmrg_to(compocn, 'Foxx_rofl_wiso', & mrg_from=compglc(ns), mrg_fld='Fogg_rofl_wiso', mrg_type='sum') end if end do @@ -2222,18 +2222,18 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! ice from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_wiso' , rc=rc)) then if (trim(rof2ocn_ice_rmap) == 'unset') then - call addmapFrom(comprof, 'Forr_rofi_wiso', compocn, mapconsd, 'none', 'unset') + call addmap_from(comprof, 'Forr_rofi_wiso', compocn, mapconsd, 'none', 'unset') else - call addmapFrom(comprof, 'Forr_rofi_wiso', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) + call addmap_from(comprof, 'Forr_rofi_wiso', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) end if - call addmrgTo(compocn, 'Foxx_rofi_wiso', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') + call addmrg_to(compocn, 'Foxx_rofi_wiso', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') end if ! ice from glc to ocean do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofi_wiso' , rc=rc)) then ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmapFrom(compglc(ns), 'Fogg_rofi_wiso', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) - call addmrgTo(compocn, 'Foxx_rofi_wiso', & + call addmap_from(compglc(ns), 'Fogg_rofi_wiso', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) + call addmrg_to(compocn, 'Foxx_rofi_wiso', & mrg_from=compglc(ns), mrg_fld='Fogg_rofi_wiso', mrg_type='sum') end if end do @@ -2245,78 +2245,78 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: Langmuir multiplier from wave !----------------------------- if (phase == 'advertise') then - call addfldFrom(compwav, 'Sw_lamult') - call addFldTo(compocn, 'Sw_lamult') + call addfld_from(compwav, 'Sw_lamult') + call addfld_to(compocn, 'Sw_lamult') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_lamult', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_lamult', rc=rc)) then - call addmapFrom(compwav, 'Sw_lamult', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) - call addmrgTo(compocn, 'Sw_lamult', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') + call addmap_from(compwav, 'Sw_lamult', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_lamult', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') end if end if !----------------------------- ! to ocn: Stokes drift u component from wave !----------------------------- if (phase == 'advertise') then - call addfldFrom(compwav, 'Sw_ustokes') - call addFldTo(compocn, 'Sw_ustokes') + call addfld_from(compwav, 'Sw_ustokes') + call addfld_to(compocn, 'Sw_ustokes') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes', rc=rc)) then - call addmapFrom(compwav, 'Sw_ustokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) - call addmrgTo(compocn, 'Sw_ustokes', mrg_from=compwav, mrg_fld='Sw_ustokes', mrg_type='copy') + call addmap_from(compwav, 'Sw_ustokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_ustokes', mrg_from=compwav, mrg_fld='Sw_ustokes', mrg_type='copy') end if end if !----------------------------- ! to ocn: Stokes drift v component from wave !----------------------------- if (phase == 'advertise') then - call addfldFrom(compwav, 'Sw_vstokes') - call addFldTo(compocn, 'Sw_vstokes') + call addfld_from(compwav, 'Sw_vstokes') + call addfld_to(compocn, 'Sw_vstokes') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes', rc=rc)) then - call addmapFrom(compwav, 'Sw_vstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) - call addmrgTo(compocn, 'Sw_vstokes', mrg_from=compwav, mrg_fld='Sw_vstokes', mrg_type='copy') + call addmap_from(compwav, 'Sw_vstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_vstokes', mrg_from=compwav, mrg_fld='Sw_vstokes', mrg_type='copy') end if end if !----------------------------- ! to ocn: Stokes drift depth from wave !----------------------------- if (phase == 'advertise') then - call addfldFrom(compwav, 'Sw_hstokes') - call addFldTo(compocn, 'Sw_hstokes') + call addfld_from(compwav, 'Sw_hstokes') + call addfld_to(compocn, 'Sw_hstokes') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_hstokes', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_hstokes', rc=rc)) then - call addmapFrom(compwav, 'Sw_hstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) - call addmrgTo(compocn, 'Sw_hstokes', mrg_from=compwav, mrg_fld='Sw_hstokes', mrg_type='copy') + call addmap_from(compwav, 'Sw_hstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_hstokes', mrg_from=compwav, mrg_fld='Sw_hstokes', mrg_type='copy') end if end if !----------------------------- ! to ocn: Partitioned stokes drift components in x-direction !----------------------------- if (phase == 'advertise') then - call addfldFrom(compwav, 'Sw_pstokes_x') - call addFldTo(compocn, 'Sw_pstokes_x') + call addfld_from(compwav, 'Sw_pstokes_x') + call addfld_to(compocn, 'Sw_pstokes_x') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_pstokes_x', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_pstokes_x', rc=rc)) then - call addmapFrom(compwav, 'Sw_pstokes_x', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) - call addmrgTo(compocn, 'Sw_pstokes_x', mrg_from=compwav, mrg_fld='Sw_pstokes_x', mrg_type='copy') + call addmap_from(compwav, 'Sw_pstokes_x', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_pstokes_x', mrg_from=compwav, mrg_fld='Sw_pstokes_x', mrg_type='copy') end if end if !----------------------------- ! to ocn: Stokes drift depth from wave !----------------------------- if (phase == 'advertise') then - call addfldFrom(compwav, 'Sw_pstokes_y') - call addFldTo(compocn, 'Sw_pstokes_y') + call addfld_from(compwav, 'Sw_pstokes_y') + call addfld_to(compocn, 'Sw_pstokes_y') else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_pstokes_y', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_pstokes_y', rc=rc)) then - call addmapFrom(compwav, 'Sw_pstokes_y', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) - call addmrgTo(compocn, 'Sw_pstokes_y', mrg_from=compwav, mrg_fld='Sw_pstokes_y', mrg_type='copy') + call addmap_from(compwav, 'Sw_pstokes_y', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg_to(compocn, 'Sw_pstokes_y', mrg_from=compwav, mrg_fld='Sw_pstokes_y', mrg_type='copy') end if end if @@ -2328,13 +2328,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: downward longwave heat flux from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_lwdn') - call addfldTo(compice, 'Faxa_lwdn') + call addfld_from(compatm, 'Faxa_lwdn') + call addfld_to(compice, 'Faxa_lwdn') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_lwdn', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn', rc=rc)) then - call addMapFrom(compatm, 'Faxa_lwdn', compice, mapconsf, 'one', atm2ice_map) - call addmrgTo(compice, 'Faxa_lwdn', mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='copy') + call addmap_from(compatm, 'Faxa_lwdn', compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_lwdn', mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2344,43 +2344,43 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: downward Diffuse visible incident solar radiation from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_swndr') - call addfldTo(compice, 'Faxa_swndr') + call addfld_from(compatm, 'Faxa_swndr') + call addfld_to(compice, 'Faxa_swndr') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_swndr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndr', rc=rc)) then - call addMapFrom(compatm, 'Faxa_swndr', compice, mapconsf, 'one', atm2ice_map) - call addmrgTo(compice, 'Faxa_swndr', mrg_from=compatm, mrg_fld='Faxa_swndr', mrg_type='copy') + call addmap_from(compatm, 'Faxa_swndr', compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_swndr', mrg_from=compatm, mrg_fld='Faxa_swndr', mrg_type='copy') end if end if if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_swvdr') - call addfldTo(compice, 'Faxa_swvdr') + call addfld_from(compatm, 'Faxa_swvdr') + call addfld_to(compice, 'Faxa_swvdr') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_swvdr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdr', rc=rc)) then - call addMapFrom(compatm, 'Faxa_swvdr', compice, mapconsf, 'one', atm2ice_map) - call addmrgTo(compice, 'Faxa_swvdr', mrg_from=compatm, mrg_fld='Faxa_swvdr', mrg_type='copy') + call addmap_from(compatm, 'Faxa_swvdr', compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_swvdr', mrg_from=compatm, mrg_fld='Faxa_swvdr', mrg_type='copy') end if end if if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_swndf') - call addfldTo(compice, 'Faxa_swndf') + call addfld_from(compatm, 'Faxa_swndf') + call addfld_to(compice, 'Faxa_swndf') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_swndf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndf', rc=rc)) then - call addMapFrom(compatm, 'Faxa_swndf', compice, mapconsf, 'one', atm2ice_map) - call addmrgTo(compice, 'Faxa_swndf', mrg_from=compatm, mrg_fld='Faxa_swndf', mrg_type='copy') + call addmap_from(compatm, 'Faxa_swndf', compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_swndf', mrg_from=compatm, mrg_fld='Faxa_swndf', mrg_type='copy') end if end if if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_swvdf') - call addfldTo(compice, 'Faxa_swvdf') + call addfld_from(compatm, 'Faxa_swvdf') + call addfld_to(compice, 'Faxa_swvdf') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_swvdf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdf', rc=rc)) then - call addMapFrom(compatm, 'Faxa_swvdf', compice, mapconsf, 'one', atm2ice_map) - call addmrgTo(compice, 'Faxa_swvdf', mrg_from=compatm, mrg_fld='Faxa_swvdf', mrg_type='copy') + call addmap_from(compatm, 'Faxa_swvdf', compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_swvdf', mrg_from=compatm, mrg_fld='Faxa_swvdf', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2389,13 +2389,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: hydrophylic black carbon wet deposition flux from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_bcph') - call addfldTo(compice, 'Faxa_bcph') + call addfld_from(compatm, 'Faxa_bcph') + call addfld_to(compice, 'Faxa_bcph') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_bcph', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_bcph', rc=rc)) then - call addMapFrom(compatm, 'Faxa_bcph', compice, mapconsf, 'one', atm2ice_map) - call addmrgTo(compice, 'Faxa_bcph', mrg_from=compatm, mrg_fld='Faxa_bcph', mrg_type='copy') + call addmap_from(compatm, 'Faxa_bcph', compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_bcph', mrg_from=compatm, mrg_fld='Faxa_bcph', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2404,13 +2404,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: hydrophylic organic carbon wet deposition flux from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_ocph') - call addfldTo(compice, 'Faxa_ocph') + call addfld_from(compatm, 'Faxa_ocph') + call addfld_to(compice, 'Faxa_ocph') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_ocph', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_ocph', rc=rc)) then - call addMapFrom(compatm, 'Faxa_ocph', compice, mapconsf, 'one', atm2ice_map) - call addmrgTo(compice, 'Faxa_ocph', mrg_from=compatm, mrg_fld='Faxa_ocph', mrg_type='copy') + call addmap_from(compatm, 'Faxa_ocph', compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_ocph', mrg_from=compatm, mrg_fld='Faxa_ocph', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2420,13 +2420,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: dust wet deposition flux (size 4) from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_dstwet') - call addfldTo(compice, 'Faxa_dstwet') + call addfld_from(compatm, 'Faxa_dstwet') + call addfld_to(compice, 'Faxa_dstwet') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_dstwet', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_dstwet', rc=rc)) then - call addMapFrom(compatm, 'Faxa_dstwet', compice, mapconsf, 'one', atm2ice_map) - call addmrgTo(compice, 'Faxa_dstwet', mrg_from=compatm, mrg_fld='Faxa_dstwet', mrg_type='copy') + call addmap_from(compatm, 'Faxa_dstwet', compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_dstwet', mrg_from=compatm, mrg_fld='Faxa_dstwet', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2436,13 +2436,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: dust dry deposition flux (size 4) from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_dstdry') - call addfldTo(compice, 'Faxa_dstdry') + call addfld_from(compatm, 'Faxa_dstdry') + call addfld_to(compice, 'Faxa_dstdry') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Faxa_dstdry', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_dstdry', rc=rc)) then - call addMapFrom(compatm, 'Faxa_dstdry', compice, mapconsf, 'one', atm2ice_map) - call addmrgTo(compice, 'Faxa_dstdry', mrg_from=compatm, mrg_fld='Faxa_dstdry', mrg_type='copy') + call addmap_from(compatm, 'Faxa_dstdry', compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_dstdry', mrg_from=compatm, mrg_fld='Faxa_dstdry', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2450,83 +2450,83 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: rain and snow rate from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_rainc') - call addFldFrom(compatm, 'Faxa_rainl') - call addFldFrom(compatm, 'Faxa_rain' ) - call addfldTo(compice, 'Faxa_rain' ) + call addfld_from(compatm, 'Faxa_rainc') + call addfld_from(compatm, 'Faxa_rainl') + call addfld_from(compatm, 'Faxa_rain' ) + call addfld_to(compice, 'Faxa_rain' ) else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc', rc=rc)) then - call addMapFrom(compatm, 'Faxa_rainc', compice, mapconsf, 'one', atm2ice_map) - call addMapFrom(compatm, 'Faxa_rainl', compice, mapconsf, 'one', atm2ice_map) - call addmrgTo(compice, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', mrg_type='sum') + call addmap_from(compatm, 'Faxa_rainc', compice, mapconsf, 'one', atm2ice_map) + call addmap_from(compatm, 'Faxa_rainl', compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', mrg_type='sum') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain', rc=rc)) then - call addMapFrom(compatm, 'Faxa_rain', compice, mapconsf, 'one', atm2ice_map) - call addmrgTo(compice, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rain', mrg_type='copy') + call addmap_from(compatm, 'Faxa_rain', compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rain', mrg_type='copy') end if end if if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_snowc') - call addFldFrom(compatm, 'Faxa_snowl') - call addFldFrom(compatm, 'Faxa_snow' ) - call addfldTo(compice, 'Faxa_snow' ) + call addfld_from(compatm, 'Faxa_snowc') + call addfld_from(compatm, 'Faxa_snowl') + call addfld_from(compatm, 'Faxa_snow' ) + call addfld_to(compice, 'Faxa_snow' ) else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc', rc=rc)) then - call addMapFrom(compatm, 'Faxa_snowc', compice, mapconsf, 'one', atm2ice_map) - call addMapFrom(compatm, 'Faxa_snowl', compice, mapconsf, 'one', atm2ice_map) - call addmrgTo(compice, 'Faxa_snow' , & + call addmap_from(compatm, 'Faxa_snowc', compice, mapconsf, 'one', atm2ice_map) + call addmap_from(compatm, 'Faxa_snowl', compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_snow' , & mrg_from=compatm, mrg_fld='Faxa_snowc:Faxa_snowl', mrg_type='sum') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow', rc=rc)) then - call addMapFrom(compatm, 'Faxa_snow', compice, mapconsf, 'one', atm2ice_map) - call addmrgTo(compice, 'Faxa_snow', & + call addmap_from(compatm, 'Faxa_snow', compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_snow', & mrg_from=compatm, mrg_fld='Faxa_snow', mrg_type='copy') end if end if if (flds_wiso) then if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_rainc_wiso') - call addFldFrom(compatm, 'Faxa_rainl_wiso') - call addFldFrom(compatm, 'Faxa_rain_wiso' ) - call addfldTo(compice, 'Faxa_rain_wiso' ) + call addfld_from(compatm, 'Faxa_rainc_wiso') + call addfld_from(compatm, 'Faxa_rainl_wiso') + call addfld_from(compatm, 'Faxa_rain_wiso' ) + call addfld_to(compice, 'Faxa_rain_wiso' ) else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain_wiso' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', rc=rc)) then - call addMapFrom(compatm, 'Faxa_rainc_wiso', compice, mapconsf, 'one', atm2ice_map) - call addMapFrom(compatm, 'Faxa_rainl_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmrgTo(compice, 'Faxa_rain_wiso' , & + call addmap_from(compatm, 'Faxa_rainc_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmap_from(compatm, 'Faxa_rainl_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_rain_wiso' , & mrg_from=compatm, mrg_fld='Faxa_rainc_wiso:Faxa_rainl_wiso', mrg_type='sum') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain_wiso', rc=rc)) then - call addMapFrom(compatm, 'Faxa_rain_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmrgTo(compice, 'Faxa_rain_wiso', & + call addmap_from(compatm, 'Faxa_rain_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_rain_wiso', & mrg_from=compatm, mrg_fld='Faxa_rain_wiso', mrg_type='copy') end if end if if (phase == 'advertise') then - call addFldFrom(compatm, 'Faxa_snowc_wiso') - call addFldFrom(compatm, 'Faxa_snowl_wiso') - call addFldFrom(compatm, 'Faxa_snow_wiso' ) - call addfldTo(compice, 'Faxa_snow_wiso' ) + call addfld_from(compatm, 'Faxa_snowc_wiso') + call addfld_from(compatm, 'Faxa_snowl_wiso') + call addfld_from(compatm, 'Faxa_snow_wiso' ) + call addfld_to(compice, 'Faxa_snow_wiso' ) else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc_wiso', rc=rc)) then - call addMapFrom(compatm, 'Faxa_snowc_wiso', compice, mapconsf, 'one', atm2ice_map) - call addMapFrom(compatm, 'Faxa_snowl_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmrgTo(compice, 'Faxa_snow_wiso' , & + call addmap_from(compatm, 'Faxa_snowc_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmap_from(compatm, 'Faxa_snowl_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_snow_wiso' , & mrg_from=compatm, mrg_fld='Faxa_snowc_wiso:Faxa_snowl_wiso', mrg_type='sum') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow_wiso', rc=rc)) then - call addMapFrom(compatm, 'Faxa_snow_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmrgTo(compice, 'Faxa_snow_wiso', mrg_from=compatm, mrg_fld='Faxa_snow_wiso', mrg_type='copy') + call addmap_from(compatm, 'Faxa_snow_wiso', compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_snow_wiso', mrg_from=compatm, mrg_fld='Faxa_snow_wiso', mrg_type='copy') end if end if end if @@ -2535,65 +2535,65 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: height at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_z') - call addfldTo(compice, 'Sa_z') + call addfld_from(compatm, 'Sa_z') + call addfld_to(compice, 'Sa_z') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_z', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_z', rc=rc)) then - call addMapFrom(compatm, 'Sa_z', compice, mapbilnr, 'one', atm2ice_map) - call addmrgTo(compice, 'Sa_z', mrg_from=compatm, mrg_fld='Sa_z', mrg_type='copy') + call addmap_from(compatm, 'Sa_z', compice, mapbilnr, 'one', atm2ice_map) + call addmrg_to(compice, 'Sa_z', mrg_from=compatm, mrg_fld='Sa_z', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to ice: pressure at the lowest model level fromatm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_pbot') - call addfldTo(compice, 'Sa_pbot') + call addfld_from(compatm, 'Sa_pbot') + call addfld_to(compice, 'Sa_pbot') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_pbot', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_pbot', rc=rc)) then - call addMapFrom(compatm, 'Sa_pbot', compice, mapbilnr, 'one', atm2ice_map) - call addmrgTo(compice, 'Sa_pbot', mrg_from=compatm, mrg_fld='Sa_pbot', mrg_type='copy') + call addmap_from(compatm, 'Sa_pbot', compice, mapbilnr, 'one', atm2ice_map) + call addmrg_to(compice, 'Sa_pbot', mrg_from=compatm, mrg_fld='Sa_pbot', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to ice: temperature at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_tbot') - call addfldTo(compice, 'Sa_tbot') + call addfld_from(compatm, 'Sa_tbot') + call addfld_to(compice, 'Sa_tbot') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_tbot', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_tbot', rc=rc)) then - call addMapFrom(compatm, 'Sa_tbot', compice, mapbilnr, 'one', atm2ice_map) - call addmrgTo(compice, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') + call addmap_from(compatm, 'Sa_tbot', compice, mapbilnr, 'one', atm2ice_map) + call addmrg_to(compice, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to ice: potential temperature at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_ptem') - call addfldTo(compice, 'Sa_ptem') + call addfld_from(compatm, 'Sa_ptem') + call addfld_to(compice, 'Sa_ptem') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_ptem', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_ptem', rc=rc)) then - call addMapFrom(compatm, 'Sa_ptem', compice, mapbilnr, 'one', atm2ice_map) - call addmrgTo(compice, 'Sa_ptem', mrg_from=compatm, mrg_fld='Sa_ptem', mrg_type='copy') + call addmap_from(compatm, 'Sa_ptem', compice, mapbilnr, 'one', atm2ice_map) + call addmrg_to(compice, 'Sa_ptem', mrg_from=compatm, mrg_fld='Sa_ptem', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to ice: density at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_dens') - call addfldTo(compice, 'Sa_dens') + call addfld_from(compatm, 'Sa_dens') + call addfld_to(compice, 'Sa_dens') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_dens', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_dens', rc=rc)) then - call addMapFrom(compatm, 'Sa_dens', compice, mapbilnr, 'one', atm2ice_map) - call addmrgTo(compice, 'Sa_dens', mrg_from=compatm, mrg_fld='Sa_dens', mrg_type='copy') + call addmap_from(compatm, 'Sa_dens', compice, mapbilnr, 'one', atm2ice_map) + call addmrg_to(compice, 'Sa_dens', mrg_from=compatm, mrg_fld='Sa_dens', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2601,31 +2601,31 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: meridional wind at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_u') - call addfldTo(compice, 'Sa_u') + call addfld_from(compatm, 'Sa_u') + call addfld_to(compice, 'Sa_u') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_u', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_u', rc=rc)) then if (mapuv_with_cart3d) then - call addMapFrom(compatm, 'Sa_u', compice, mappatch_uv3d, 'one', atm2ice_map) + call addmap_from(compatm, 'Sa_u', compice, mappatch_uv3d, 'one', atm2ice_map) else - call addMapFrom(compatm, 'Sa_u', compice, mappatch, 'one', atm2ice_map) + call addmap_from(compatm, 'Sa_u', compice, mappatch, 'one', atm2ice_map) end if - call addmrgTo(compice, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') + call addmrg_to(compice, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') end if end if if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_v') - call addfldTo(compice, 'Sa_v') + call addfld_from(compatm, 'Sa_v') + call addfld_to(compice, 'Sa_v') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_v', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_v', rc=rc)) then if (mapuv_with_cart3d) then - call addMapFrom(compatm, 'Sa_v', compice, mappatch_uv3d, 'one', atm2ice_map) + call addmap_from(compatm, 'Sa_v', compice, mappatch_uv3d, 'one', atm2ice_map) else - call addMapFrom(compatm, 'Sa_v', compice, mappatch, 'one', atm2ice_map) + call addmap_from(compatm, 'Sa_v', compice, mappatch, 'one', atm2ice_map) end if - call addmrgTo(compice, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') + call addmrg_to(compice, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2633,24 +2633,24 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: specific humidity for water isotopes at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_shum') - call addfldTo(compice, 'Sa_shum') + call addfld_from(compatm, 'Sa_shum') + call addfld_to(compice, 'Sa_shum') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_shum', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum', rc=rc)) then - call addMapFrom(compatm, 'Sa_shum', compice, mapbilnr, 'one', atm2ice_map) - call addmrgTo(compice, 'Sa_shum', mrg_from=compatm, mrg_fld='Sa_shum', mrg_type='copy') + call addmap_from(compatm, 'Sa_shum', compice, mapbilnr, 'one', atm2ice_map) + call addmrg_to(compice, 'Sa_shum', mrg_from=compatm, mrg_fld='Sa_shum', mrg_type='copy') end if end if if (flds_wiso) then if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_shum_wiso') - call addfldTo(compice, 'Sa_shum_wiso') + call addfld_from(compatm, 'Sa_shum_wiso') + call addfld_to(compice, 'Sa_shum_wiso') else if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_shum_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum_wiso', rc=rc)) then - call addMapFrom(compatm, 'Sa_shum_wiso', compice, mapbilnr, 'one', atm2ice_map) - call addmrgTo(compice, 'Sa_shum_wiso', mrg_from=compatm, mrg_fld='Sa_shum_wiso', mrg_type='copy') + call addmap_from(compatm, 'Sa_shum_wiso', compice, mapbilnr, 'one', atm2ice_map) + call addmrg_to(compice, 'Sa_shum_wiso', mrg_from=compatm, mrg_fld='Sa_shum_wiso', mrg_type='copy') end if end if end if @@ -2659,26 +2659,26 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: sea surface temperature from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(compocn, 'So_t') - call addfldTo(compice, 'So_t') + call addfld_from(compocn, 'So_t') + call addfld_to(compice, 'So_t') else if ( fldchk(is_local%wrap%FBexp(compice) , 'So_t', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_t', rc=rc)) then - call addmapFrom(compocn, 'So_t', compice, mapfcopy , 'unset', 'unset') - call addmrgTo(compice, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + call addmap_from(compocn, 'So_t', compice, mapfcopy , 'unset', 'unset') + call addmrg_to(compice, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to ice: sea surface salinity from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(compocn, 'So_s') - call addfldTo(compice, 'So_s') + call addfld_from(compocn, 'So_s') + call addfld_to(compice, 'So_s') else if ( fldchk(is_local%wrap%FBexp(compice) , 'So_s', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_s', rc=rc)) then - call addmapFrom(compocn, 'So_s', compice, mapfcopy , 'unset', 'unset') - call addmrgTo(compice, 'So_s', mrg_from=compocn, mrg_fld='So_s', mrg_type='copy') + call addmap_from(compocn, 'So_s', compice, mapfcopy , 'unset', 'unset') + call addmrg_to(compice, 'So_s', mrg_from=compocn, mrg_fld='So_s', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2686,23 +2686,23 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: meridional sea water velocity from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(compocn, 'So_u') - call addfldTo(compice, 'So_u') + call addfld_from(compocn, 'So_u') + call addfld_to(compice, 'So_u') else if ( fldchk(is_local%wrap%FBexp(compice) , 'So_u', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_u', rc=rc)) then - call addmapFrom(compocn, 'So_u', compice, mapfcopy , 'unset', 'unset') - call addmrgTo(compice, 'So_u', mrg_from=compocn, mrg_fld='So_u', mrg_type='copy') + call addmap_from(compocn, 'So_u', compice, mapfcopy , 'unset', 'unset') + call addmrg_to(compice, 'So_u', mrg_from=compocn, mrg_fld='So_u', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfldFrom(compocn, 'So_v') - call addfldTo(compice, 'So_v') + call addfld_from(compocn, 'So_v') + call addfld_to(compice, 'So_v') else if ( fldchk(is_local%wrap%FBexp(compice) , 'So_v', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_v', rc=rc)) then - call addmapFrom(compocn, 'So_v', compice, mapfcopy , 'unset', 'unset') - call addmrgTo(compice, 'So_v', mrg_from=compocn, mrg_fld='So_v', mrg_type='copy') + call addmap_from(compocn, 'So_v', compice, mapfcopy , 'unset', 'unset') + call addmrg_to(compice, 'So_v', mrg_from=compocn, mrg_fld='So_v', mrg_type='copy') end if end if ! --------------------------------------------------------------------- @@ -2710,36 +2710,36 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: meridional sea surface slope from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(compocn, 'So_dhdx') - call addfldTo(compice, 'So_dhdx') + call addfld_from(compocn, 'So_dhdx') + call addfld_to(compice, 'So_dhdx') else if ( fldchk(is_local%wrap%FBexp(compice) , 'So_dhdx', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_dhdx', rc=rc)) then - call addmapFrom(compocn, 'So_dhdx', compice, mapfcopy , 'unset', 'unset') - call addmrgTo(compice, 'So_dhdx', mrg_from=compocn, mrg_fld='So_dhdx', mrg_type='copy') + call addmap_from(compocn, 'So_dhdx', compice, mapfcopy , 'unset', 'unset') + call addmrg_to(compice, 'So_dhdx', mrg_from=compocn, mrg_fld='So_dhdx', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfldFrom(compocn, 'So_dhdy') - call addfldTo(compice, 'So_dhdy') + call addfld_from(compocn, 'So_dhdy') + call addfld_to(compice, 'So_dhdy') else if ( fldchk(is_local%wrap%FBexp(compice) , 'So_dhdy', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_dhdy', rc=rc)) then - call addmapFrom(compocn, 'So_dhdy', compice, mapfcopy , 'unset', 'unset') - call addmrgTo(compice, 'So_dhdy', mrg_from=compocn, mrg_fld='So_dhdy', mrg_type='copy') + call addmap_from(compocn, 'So_dhdy', compice, mapfcopy , 'unset', 'unset') + call addmrg_to(compice, 'So_dhdy', mrg_from=compocn, mrg_fld='So_dhdy', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to ice: ocean melt and freeze potential from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(compocn, 'Fioo_q') - call addfldTo(compice, 'Fioo_q') + call addfld_from(compocn, 'Fioo_q') + call addfld_to(compice, 'Fioo_q') else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'Fioo_q', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compice) , 'Fioo_q', rc=rc)) then - call addmapFrom(compocn, 'Fioo_q', compice, mapfcopy, 'unset', 'unset') - call addmrgTo(compice, 'Fioo_q', mrg_from=compocn, mrg_fld='Fioo_q', mrg_type='copy') + call addmap_from(compocn, 'Fioo_q', compice, mapfcopy, 'unset', 'unset') + call addmrg_to(compice, 'Fioo_q', mrg_from=compocn, mrg_fld='Fioo_q', mrg_type='copy') end if end if !----------------------------- @@ -2747,13 +2747,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------- if (flds_wiso) then if (phase == 'advertise') then - call addfldFrom(compocn, 'So_roce_wiso') - call addfldTo(compice, 'So_roce_wiso') + call addfld_from(compocn, 'So_roce_wiso') + call addfld_to(compice, 'So_roce_wiso') else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_roce_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compice) , 'So_roce_wiso', rc=rc)) then - call addmapFrom(compocn, 'So_roce_wiso', compice, mapfcopy, 'unset', 'unset') - call addmrgTo(compice, 'So_roce_wiso', mrg_from=compocn, mrg_fld='So_roce_wiso', mrg_type='copy') + call addmap_from(compocn, 'So_roce_wiso', compice, mapfcopy, 'unset', 'unset') + call addmrg_to(compice, 'So_roce_wiso', mrg_from=compocn, mrg_fld='So_roce_wiso', mrg_type='copy') end if end if end if @@ -2762,43 +2762,43 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: frozen runoff from rof and glc ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(comprof, 'Firr_rofi') ! water flux into sea ice due to runoff (frozen) + call addfld_from(comprof, 'Firr_rofi') ! water flux into sea ice due to runoff (frozen) do ns = 1, is_local%wrap%num_icesheets - call addfldFrom(compglc(ns), 'Figg_rofi') ! glc frozen runoff_iceberg flux to ice + call addfld_from(compglc(ns), 'Figg_rofi') ! glc frozen runoff_iceberg flux to ice end do - call addfldTo(compice, 'Fixx_rofi') ! total frozen water flux into sea ice + call addfld_to(compice, 'Fixx_rofi') ! total frozen water flux into sea ice else if ( fldchk(is_local%wrap%FBExp(compice), 'Fixx_rofi', rc=rc)) then if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi', rc=rc)) then - call addmapFrom(comprof, 'Forr_rofi', compice, mapconsf, 'none', rof2ocn_ice_rmap) - call addmrgTo(compice, 'Fixx_rofi', mrg_from=comprof, mrg_fld='Firr_rofi', mrg_type='sum') + call addmap_from(comprof, 'Forr_rofi', compice, mapconsf, 'none', rof2ocn_ice_rmap) + call addmrg_to(compice, 'Fixx_rofi', mrg_from=comprof, mrg_fld='Firr_rofi', mrg_type='sum') end if do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Figg_rofi', rc=rc)) then - call addmapFrom(compglc(ns), 'Figg_rofi', compice, mapconsf, 'one' , glc2ice_rmap) - call addmrgTo(compice, 'Fixx_rofi', mrg_from=compglc(ns), mrg_fld='Figg_rofi', mrg_type='sum') + call addmap_from(compglc(ns), 'Figg_rofi', compice, mapconsf, 'one' , glc2ice_rmap) + call addmrg_to(compice, 'Fixx_rofi', mrg_from=compglc(ns), mrg_fld='Figg_rofi', mrg_type='sum') end if end do end if end if if (flds_wiso) then if (phase == 'advertise') then - call addfldFrom(comprof, 'Firr_rofi_wiso') ! water flux into sea ice due to runoff (frozen) + call addfld_from(comprof, 'Firr_rofi_wiso') ! water flux into sea ice due to runoff (frozen) do ns = 1, is_local%wrap%num_icesheets - call addfldFrom(compglc(ns), 'Figg_rofi_wiso') ! glc frozen runoff_iceberg flux to ice + call addfld_from(compglc(ns), 'Figg_rofi_wiso') ! glc frozen runoff_iceberg flux to ice end do - call addfldTo(compice, 'Fixx_rofi_wiso') ! total frozen water flux into sea ice + call addfld_to(compice, 'Fixx_rofi_wiso') ! total frozen water flux into sea ice else if ( fldchk(is_local%wrap%FBExp(compice), 'Fixx_rofi_wiso', rc=rc)) then if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_wiso', rc=rc)) then - call addmapFrom(comprof, 'Forr_rofi_wiso', compice, mapconsf, 'none', rof2ocn_ice_rmap) - call addmrgTo(compice, 'Fixx_rofi_wiso', & + call addmap_from(comprof, 'Forr_rofi_wiso', compice, mapconsf, 'none', rof2ocn_ice_rmap) + call addmrg_to(compice, 'Fixx_rofi_wiso', & mrg_from=comprof, mrg_fld='Firr_rofi_wiso', mrg_type='sum') end if do ns = 1, is_local%wrap%num_icesheets if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Figg_rofi_wiso', rc=rc)) then - call addmapFrom(compglc(ns), 'Figg_rofi_wiso', compice, mapconsf, 'one' , glc2ice_rmap) - call addmrgTo(compice, 'Fixx_rofi_wiso', & + call addmap_from(compglc(ns), 'Figg_rofi_wiso', compice, mapconsf, 'one' , glc2ice_rmap) + call addmrg_to(compice, 'Fixx_rofi_wiso', & mrg_from=compglc(ns), mrg_fld='Figg_rofi_wiso', mrg_type='sum') end if end do @@ -2811,13 +2811,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- if (wavice_coupling) then if (phase == 'advertise') then - call addfldFrom(compwav, 'Sw_elevation_spectrum') - call addfldTo(compice, 'Sw_elevation_spectrum') + call addfld_from(compwav, 'Sw_elevation_spectrum') + call addfld_to(compice, 'Sw_elevation_spectrum') else if ( fldchk(is_local%wrap%FBExp(compice) , 'Sw_elevation_spectrum', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav,compwav), 'Sw_elevation_spectrum', rc=rc)) then - call addmapFrom(compwav, 'Sw_elevation_spectrum', compice, mapbilnr, 'one', 'unset') - call addmrgTo(compice, 'Sw_elevation_spectrum', & + call addmap_from(compwav, 'Sw_elevation_spectrum', compice, mapbilnr, 'one', 'unset') + call addmrg_to(compice, 'Sw_elevation_spectrum', & mrg_from=compwav, mrg_fld='Sw_elevation_spectrum', mrg_type='copy') end if end if @@ -2831,14 +2831,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to wav: fractional ice coverage wrt ocean from ice !---------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(compice, 'Si_ifrac') - call addfldTo(compwav, 'Si_ifrac') + call addfld_from(compice, 'Si_ifrac') + call addfld_to(compwav, 'Si_ifrac') else if ( fldchk(is_local%wrap%FBexp(compwav) , 'Si_ifrac', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_ifrac', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addMapFrom(compice, 'Si_ifrac', compwav, mapbilnr, 'one', ice2wav_smap) - call addmrgTo(compwav, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') + call addmap_from(compice, 'Si_ifrac', compwav, mapbilnr, 'one', ice2wav_smap) + call addmrg_to(compwav, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') end if end if !---------------------------------------------------------- @@ -2846,13 +2846,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !---------------------------------------------------------- if (wavice_coupling) then if (phase == 'advertise') then - call addfldFrom(compice, 'Si_thick') - call addfldTo(compwav, 'Si_thick') + call addfld_from(compice, 'Si_thick') + call addfld_to(compwav, 'Si_thick') else if (fldchk(is_local%wrap%FBexp(compwav) , 'Si_thick', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_thick', rc=rc)) then - call addMapFrom(compice, 'Si_thick', compwav, mapbilnr, 'one', ice2wav_smap) - call addmrgTo(compwav, 'Si_thick', mrg_from=compice, mrg_fld='Si_thick', mrg_type='copy') + call addmap_from(compice, 'Si_thick', compwav, mapbilnr, 'one', ice2wav_smap) + call addmrg_to(compwav, 'Si_thick', mrg_from=compice, mrg_fld='Si_thick', mrg_type='copy') end if end if end if @@ -2861,13 +2861,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !---------------------------------------------------------- if (wavice_coupling) then if (phase == 'advertise') then - call addfldFrom(compice, 'Si_floediam') - call addfldTo(compwav, 'Si_floediam') + call addfld_from(compice, 'Si_floediam') + call addfld_to(compwav, 'Si_floediam') else if (fldchk(is_local%wrap%FBexp(compwav) , 'Si_floediam', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_floediam', rc=rc)) then - call addMapFrom(compice, 'Si_floediam', compwav, mapbilnr, 'one', ice2wav_smap) - call addmrgTo(compwav, 'Si_floediam', mrg_from=compice, mrg_fld='Si_floediam', mrg_type='copy') + call addmap_from(compice, 'Si_floediam', compwav, mapbilnr, 'one', ice2wav_smap) + call addmrg_to(compwav, 'Si_floediam', mrg_from=compice, mrg_fld='Si_floediam', mrg_type='copy') end if end if end if @@ -2875,39 +2875,39 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to wav: ocean surface temperature from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(compocn, 'So_t') - call addfldTo(compwav, 'So_t') + call addfld_from(compocn, 'So_t') + call addfld_to(compwav, 'So_t') else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_t', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compwav) , 'So_t', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmapFrom(compocn, 'So_t', compwav, mapbilnr, 'one', ocn2wav_smap) - call addmrgTo(compwav, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + call addmap_from(compocn, 'So_t', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmrg_to(compwav, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') end if end if ! --------------------------------------------------------------------- ! to wav: ocean currents from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(compocn, 'So_u') - call addfldTo(compwav, 'So_u') + call addfld_from(compocn, 'So_u') + call addfld_to(compwav, 'So_u') else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_u', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compwav) , 'So_u', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmapFrom(compocn, 'So_u', compwav, mapbilnr, 'one', ocn2wav_smap) - call addmrgTo(compwav, 'So_u', mrg_from=compocn, mrg_fld='So_u', mrg_type='copy') + call addmap_from(compocn, 'So_u', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmrg_to(compwav, 'So_u', mrg_from=compocn, mrg_fld='So_u', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfldFrom(compocn, 'So_v') - call addfldTo(compwav, 'So_v') + call addfld_from(compocn, 'So_v') + call addfld_to(compwav, 'So_v') else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_v', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compwav) , 'So_v', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmapFrom(compocn, 'So_v', compwav, mapbilnr, 'one', ocn2wav_smap) - call addmrgTo(compwav, 'So_v', mrg_from=compocn, mrg_fld='So_v', mrg_type='copy') + call addmap_from(compocn, 'So_v', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmrg_to(compwav, 'So_v', mrg_from=compocn, mrg_fld='So_v', mrg_type='copy') end if end if @@ -2915,14 +2915,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to wav: ocean boundary layer depth from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(compocn, 'So_bldepth') - call addfldTo(compwav, 'So_bldepth') + call addfld_from(compocn, 'So_bldepth') + call addfld_to(compwav, 'So_bldepth') else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_bldepth', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compwav) , 'So_bldepth', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmapFrom(compocn, 'So_bldepth', compwav, mapbilnr, 'one', ocn2wav_smap) - call addmrgTo(compwav, 'So_bldepth', mrg_from=compocn, mrg_fld='So_bldepth', mrg_type='copy') + call addmap_from(compocn, 'So_bldepth', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmrg_to(compwav, 'So_bldepth', mrg_from=compocn, mrg_fld='So_bldepth', mrg_type='copy') end if end if @@ -2930,23 +2930,23 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to wav: zonal and meridional winds at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_u') - call addfldTo(compwav, 'Sa_u') + call addfld_from(compatm, 'Sa_u') + call addfld_to(compwav, 'Sa_u') else if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_u', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_u', rc=rc)) then - call addMapFrom(compatm, 'Sa_u', compwav, mapbilnr, 'one', atm2wav_map) - call addmrgTo(compwav, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') + call addmap_from(compatm, 'Sa_u', compwav, mapbilnr, 'one', atm2wav_map) + call addmrg_to(compwav, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') end if end if if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_v') - call addfldTo(compwav, 'Sa_v') + call addfld_from(compatm, 'Sa_v') + call addfld_to(compwav, 'Sa_v') else if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_v', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_v', rc=rc)) then - call addMapFrom(compatm, 'Sa_v', compwav, mapbilnr, 'one', atm2wav_map) - call addmrgTo(compwav, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') + call addmap_from(compatm, 'Sa_v', compwav, mapbilnr, 'one', atm2wav_map) + call addmrg_to(compwav, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') end if end if @@ -2954,13 +2954,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to wav: temperature at lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_tbot') - call addfldTo(compwav, 'Sa_tbot') + call addfld_from(compatm, 'Sa_tbot') + call addfld_to(compwav, 'Sa_tbot') else if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_tbot', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_tbot', rc=rc)) then - call addMapFrom(compatm, 'Sa_tbot', compwav, mapbilnr, 'one', atm2wav_map) - call addmrgTo(compwav, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') + call addmap_from(compatm, 'Sa_tbot', compwav, mapbilnr, 'one', atm2wav_map) + call addmrg_to(compwav, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') end if end if @@ -2972,13 +2972,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to rof: water flux from land (liquid surface) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(complnd, 'Flrl_rofsur') - call addfldTo(comprof, 'Flrl_rofsur') + call addfld_from(complnd, 'Flrl_rofsur') + call addfld_to(comprof, 'Flrl_rofsur') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsur', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsur', rc=rc)) then - call addmapFrom(complnd, 'Flrl_rofsur', comprof, mapconsf, 'lfrac', lnd2rof_map) - call addmrgTo(comprof, 'Flrl_rofsur', & + call addmap_from(complnd, 'Flrl_rofsur', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrg_to(comprof, 'Flrl_rofsur', & mrg_from=complnd, mrg_fld='Flrl_rofsur', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if @@ -2987,13 +2987,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to rof: water flux from land (ice surface) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(complnd, 'Flrl_rofi') - call addfldTo(comprof, 'Flrl_rofi') + call addfld_from(complnd, 'Flrl_rofi') + call addfld_to(comprof, 'Flrl_rofi') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofi', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofi', rc=rc)) then - call addmapFrom(complnd, 'Flrl_rofi', comprof, mapconsf, 'lfrac', lnd2rof_map) - call addmrgTo(comprof, 'Flrl_rofi', & + call addmap_from(complnd, 'Flrl_rofi', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrg_to(comprof, 'Flrl_rofi', & mrg_from=complnd, mrg_fld='Flrl_rofi', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if @@ -3002,13 +3002,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to rof: water flux from land (liquid glacier, wetland, and lake) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(complnd, 'Flrl_rofgwl') - call addfldTo(comprof, 'Flrl_rofgwl') + call addfld_from(complnd, 'Flrl_rofgwl') + call addfld_to(comprof, 'Flrl_rofgwl') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofgwl', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofgwl', rc=rc)) then - call addmapFrom(complnd, 'Flrl_rofgwl', comprof, mapconsf, 'lfrac', lnd2rof_map) - call addmrgTo(comprof, 'Flrl_rofgwl', & + call addmap_from(complnd, 'Flrl_rofgwl', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrg_to(comprof, 'Flrl_rofgwl', & mrg_from=complnd, mrg_fld='Flrl_rofgwl', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if @@ -3017,13 +3017,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to rof: water flux from land (liquid subsurface) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(complnd, 'Flrl_rofsub') - call addfldTo(comprof, 'Flrl_rofsub') + call addfld_from(complnd, 'Flrl_rofsub') + call addfld_to(comprof, 'Flrl_rofsub') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsub', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsub', rc=rc)) then - call addmapFrom(complnd, 'Flrl_rofsub', comprof, mapconsf, 'lfrac', lnd2rof_map) - call addmrgTo(comprof, 'Flrl_rofsub', & + call addmap_from(complnd, 'Flrl_rofsub', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrg_to(comprof, 'Flrl_rofsub', & mrg_from=complnd, mrg_fld='Flrl_rofsub', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if @@ -3032,13 +3032,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to rof: irrigation flux from land (withdrawal from rivers) ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(complnd, 'Flrl_irrig') - call addfldTo(comprof, 'Flrl_irrig') + call addfld_from(complnd, 'Flrl_irrig') + call addfld_to(comprof, 'Flrl_irrig') else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_irrig', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_irrig', rc=rc)) then - call addmapFrom(complnd, 'Flrl_irrig', comprof, mapconsf, 'lfrac', lnd2rof_map) - call addmrgTo(comprof, 'Flrl_irrig', & + call addmap_from(complnd, 'Flrl_irrig', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmrg_to(comprof, 'Flrl_irrig', & mrg_from=complnd, mrg_fld='Flrl_irrig', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if @@ -3058,25 +3058,25 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Note : Sl_topo is sent from lnd -> med, but is NOT sent to glc (only used for the remapping in the mediator) if (phase == 'advertise') then - call addFldFrom(complnd, 'Sl_tsrf_elev') ! surface temperature of glacier (1->glc_nec+1) - call addFldFrom(complnd, 'Sl_topo_elev') ! surface heights of glacier (1->glc_nec+1) - call addFldFrom(complnd, 'Flgl_qice_elev') ! glacier ice flux (1->glc_nec+1) + call addfld_from(complnd, 'Sl_tsrf_elev') ! surface temperature of glacier (1->glc_nec+1) + call addfld_from(complnd, 'Sl_topo_elev') ! surface heights of glacier (1->glc_nec+1) + call addfld_from(complnd, 'Flgl_qice_elev') ! glacier ice flux (1->glc_nec+1) do ns = 1,is_local%wrap%num_icesheets - call addfldTo(compglc(ns), 'Sl_tsrf') - call addfldTo(compglc(ns), 'Flgl_qice') + call addfld_to(compglc(ns), 'Sl_tsrf') + call addfld_to(compglc(ns), 'Flgl_qice') end do else ! custom mapping, accumulation and merging will be done in prep_glc_mod.F90 do ns = 1,is_local%wrap%num_icesheets if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Flgl_qice_elev', rc=rc)) then - call addmapFrom(complnd, 'Flgl_qice_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') + call addmap_from(complnd, 'Flgl_qice_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') end if if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Sl_tsrf_elev' , rc=rc)) then - call addmapFrom(complnd, 'Sl_tsrf_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') + call addmap_from(complnd, 'Sl_tsrf_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') end if if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Sl_topo_elev' , rc=rc)) then ! This is needed just for mappingn to glc - but is not sent as a field - call addmapFrom(complnd, 'Sl_topo_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') + call addmap_from(complnd, 'Sl_topo_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') end if end do end if @@ -3086,21 +3086,21 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------- if (is_local%wrap%ocn2glc_coupling) then if (phase == 'advertise') then - call addfldFrom(compocn, 'So_t_depth') - call addfldFrom(compocn, 'So_s_depth') + call addfld_from(compocn, 'So_t_depth') + call addfld_from(compocn, 'So_s_depth') do ns = 1,is_local%wrap%num_icesheets - call addfldTo(compglc(ns), 'So_t_depth') - call addfldTo(compglc(ns), 'So_s_depth') + call addfld_to(compglc(ns), 'So_t_depth') + call addfld_to(compglc(ns), 'So_s_depth') end do else ! custom mapping, accumulation and merging will be done in prep_glc_mod.F90 ! the following is used to create the route handle do ns = 1,is_local%wrap%num_icesheets if ( fldchk(is_local%wrap%FBImp(compocn,compocn) , 'So_t_depth', rc=rc)) then - call addmapFrom(compocn, 'So_t_depth', compglc(ns), mapbilnr, 'none', 'unset') + call addmap_from(compocn, 'So_t_depth', compglc(ns), mapbilnr, 'none', 'unset') end if if ( fldchk(is_local%wrap%FBImp(compocn,compocn) , 'So_s_depth', rc=rc)) then - call addmapFrom(compocn, 'So_s_depth', compglc(ns), mapbilnr, 'none', 'unset') + call addmap_from(compocn, 'So_s_depth', compglc(ns), mapbilnr, 'none', 'unset') end if end do end if @@ -3130,16 +3130,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd and ocn: prognostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_co2prog') - call addfldTo(complnd, 'Sa_co2prog') - call addFldTo(compocn, 'Sa_co2prog') + call addfld_from(compatm, 'Sa_co2prog') + call addfld_to(complnd, 'Sa_co2prog') + call addfld_to(compocn, 'Sa_co2prog') else - call addMapFrom(compatm, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) - call addMapFrom(compatm, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap_from(compatm, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) + call addmap_from(compatm, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) - call addmrgTo(complnd, 'Sa_co2prog', & + call addmrg_to(complnd, 'Sa_co2prog', & mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - call addmrgTo(compocn, 'Sa_co2prog', & + call addmrg_to(compocn, 'Sa_co2prog', & mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') end if @@ -3147,16 +3147,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd and ocn: diagnostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_co2diag') - call addfldTo(complnd, 'Sa_co2diag') - call addFldTo(compocn, 'Sa_co2diag') + call addfld_from(compatm, 'Sa_co2diag') + call addfld_to(complnd, 'Sa_co2diag') + call addfld_to(compocn, 'Sa_co2diag') else - call addMapFrom(compatm, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) - call addMapFrom(compatm, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap_from(compatm, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) + call addmap_from(compatm, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) - call addmrgTo(complnd, 'Sa_co2diag', & + call addmrg_to(complnd, 'Sa_co2diag', & mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - call addmrgTo(compocn, 'Sa_co2diag', & + call addmrg_to(compocn, 'Sa_co2diag', & mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') end if @@ -3166,11 +3166,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: prognostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_co2prog') - call addfldTo(complnd, 'Sa_co2prog') + call addfld_from(compatm, 'Sa_co2prog') + call addfld_to(complnd, 'Sa_co2prog') else - call addMapFrom(compatm, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Sa_co2prog', & + call addmap_from(compatm, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Sa_co2prog', & mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') end if @@ -3178,11 +3178,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: diagnostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_co2diag') - call addfldTo(complnd, 'Sa_co2diag') + call addfld_from(compatm, 'Sa_co2diag') + call addfld_to(complnd, 'Sa_co2diag') else - call addMapFrom(compatm, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrgTo(complnd, 'Sa_co2diag', & + call addmap_from(compatm, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Sa_co2diag', & mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') end if @@ -3190,11 +3190,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: surface flux of CO2 from land ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(complnd, 'Fall_fco2_lnd') - call addfldTo(compatm, 'Fall_fco2_lnd') + call addfld_from(complnd, 'Fall_fco2_lnd') + call addfld_to(compatm, 'Fall_fco2_lnd') else - call addmapFrom(complnd, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) - call addmrgTo(compatm, 'Fall_fco2_lnd', & + call addmap_from(complnd, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) + call addmrg_to(compatm, 'Fall_fco2_lnd', & mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if @@ -3204,16 +3204,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd and ocn: prognostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_co2prog') - call addfldTo(complnd, 'Sa_co2prog') - call addFldTo(compocn, 'Sa_co2prog') + call addfld_from(compatm, 'Sa_co2prog') + call addfld_to(complnd, 'Sa_co2prog') + call addfld_to(compocn, 'Sa_co2prog') else - call addMapFrom(compatm, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) - call addMapFrom(compatm, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap_from(compatm, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_map) + call addmap_from(compatm, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_map) - call addmrgTo(complnd, 'Sa_co2prog', & + call addmrg_to(complnd, 'Sa_co2prog', & mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') - call addmrgTo(compocn, 'Sa_co2prog', & + call addmrg_to(compocn, 'Sa_co2prog', & mrg_from=compatm, mrg_fld='Sa_co2prog', mrg_type='copy') end if @@ -3221,16 +3221,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd and ocn: diagnostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(compatm, 'Sa_co2diag') - call addfldTo(complnd, 'Sa_co2diag') - call addFldTo(compocn, 'Sa_co2diag') + call addfld_from(compatm, 'Sa_co2diag') + call addfld_to(complnd, 'Sa_co2diag') + call addfld_to(compocn, 'Sa_co2diag') else - call addMapFrom(compatm, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) - call addMapFrom(compatm, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap_from(compatm, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_map) + call addmap_from(compatm, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_map) - call addmrgTo(complnd, 'Sa_co2diag', & + call addmrg_to(complnd, 'Sa_co2diag', & mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') - call addmrgTo(compocn, 'Sa_co2diag', & + call addmrg_to(compocn, 'Sa_co2diag', & mrg_from=compatm, mrg_fld='Sa_co2diag', mrg_type='copy') end if @@ -3238,11 +3238,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: surface flux of CO2 from land ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addFldFrom(complnd, 'Fall_fco2_lnd') - call addfldTo(compatm, 'Fall_fco2_lnd') + call addfld_from(complnd, 'Fall_fco2_lnd') + call addfld_to(compatm, 'Fall_fco2_lnd') else - call addmapFrom(complnd, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) - call addmrgTo(compatm, 'Fall_fco2_lnd', & + call addmap_from(complnd, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) + call addmrg_to(compatm, 'Fall_fco2_lnd', & mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if @@ -3250,10 +3250,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: surface flux of CO2 from ocn ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfldFrom(compocn, 'Faoo_fco2_ocn') - call addfldTo(compatm, 'Faoo_fco2_ocn') + call addfld_from(compocn, 'Faoo_fco2_ocn') + call addfld_to(compatm, 'Faoo_fco2_ocn') else - call addmapFrom(compocn, 'Faoo_fco2_ocn', compatm, mapconsd, 'one', ocn2atm_map) + call addmap_from(compocn, 'Faoo_fco2_ocn', compatm, mapconsd, 'one', ocn2atm_map) ! custom merge in med_phases_prep_atm end if endif diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 26eaf2e03..6aa71596d 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -86,8 +86,8 @@ end subroutine esmFldsExchange_hafs subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) - use esmFlds, only : addfldTo => med_fldList_AddFldTo - use esmFlds, only : addfldFrom => med_fldList_AddFldFrom + use esmFlds, only : addfld_to => med_fldList_addfld_to + use esmFlds, only : addfld_from => med_fldList_addfld_from ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -123,8 +123,8 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ncomps - call addfldFrom(n, trim(cvalue)) - call addfldTo(n, trim(cvalue)) + call addfld_from(n, trim(cvalue)) + call addfld_to(n, trim(cvalue)) end do end if @@ -141,12 +141,12 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) !---------------------------------------------------------- ! to med: masks from components !---------------------------------------------------------- - call addfldFrom(compocn, 'So_omask') + call addfld_from(compocn, 'So_omask') !---------------------------------------------------------- ! to med: frac from components !---------------------------------------------------------- - call addfldTo(compatm, 'So_ofrac') + call addfld_to(compatm, 'So_ofrac') !===================================================================== ! FIELDS TO ATMOSPHERE @@ -160,8 +160,8 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) S_flds = (/'So_t'/) ! sea_surface_temperature do n = 1,size(S_flds) fldname = trim(S_flds(n)) - call addfldFrom(compocn, trim(fldname)) - call addfldTo(compatm, trim(fldname)) + call addfld_from(compocn, trim(fldname)) + call addfld_to(compatm, trim(fldname)) end do deallocate(S_flds) end if @@ -174,8 +174,8 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) S_flds = (/'Sw_z0'/) ! wave_z0_roughness_length do n = 1,size(S_flds) fldname = trim(S_flds(n)) - call addfldFrom(compwav, trim(fldname)) - call addfldTo(compatm, trim(fldname)) + call addfld_from(compwav, trim(fldname)) + call addfld_to(compatm, trim(fldname)) end do deallocate(S_flds) end if @@ -197,8 +197,8 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) 'Sa_tskn' /) ! inst_temp_height_surface do n = 1,size(S_flds) fldname = trim(S_flds(n)) - call addfldFrom(compatm, trim(fldname)) - call addfldTo(compocn, trim(fldname)) + call addfld_from(compatm, trim(fldname)) + call addfld_to(compocn, trim(fldname)) end do deallocate(S_flds) end if @@ -218,8 +218,8 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) fldname2 = trim(F_flds(n,2)) - call addfldFrom(compatm, trim(fldname1)) - call addfldTo(compocn, trim(fldname2)) + call addfld_from(compatm, trim(fldname1)) + call addfld_to(compocn, trim(fldname2)) end do deallocate(F_flds) end if @@ -236,8 +236,8 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) S_flds = (/'Sa_u10m', 'Sa_v10m'/) do n = 1,size(S_flds) fldname = trim(S_flds(n)) - call addfldFrom(compatm, trim(fldname)) - call addfldTo(compwav, trim(fldname)) + call addfld_from(compatm, trim(fldname)) + call addfld_to(compwav, trim(fldname)) end do deallocate(S_flds) end if @@ -297,8 +297,8 @@ subroutine esmFldsExchange_hafs_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 : addmapFrom => med_fldList_AddMapFrom - use esmFlds , only : addmrgTo => med_fldList_AddMrgTo + use esmFlds , only : addmap_from => med_fldList_addmap_from + use esmFlds , only : addmrg_to => med_fldList_addmrg_to ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -369,9 +369,9 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) 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 addmapFrom(compocn, trim(fldname), compatm, & + call addmap_from(compocn, trim(fldname), compatm, & mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%ocn2atm_smap) - call addmrgTo(compatm, trim(fldname), & + call addmrg_to(compatm, trim(fldname), & mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') end if end do @@ -389,9 +389,9 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav,compwav),trim(fldname),rc=rc) & ) then - call addmapFrom(compwav, trim(fldname), compatm, & + call addmap_from(compwav, trim(fldname), compatm, & mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%wav2atm_smap) - call addmrgTo(compatm, trim(fldname), & + call addmrg_to(compatm, trim(fldname), & mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') end if end do @@ -418,9 +418,9 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) 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 addmapFrom(compatm, trim(fldname), compocn, & + call addmap_from(compatm, trim(fldname), compocn, & mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) - call addmrgTo(compocn, trim(fldname), & + call addmrg_to(compocn, trim(fldname), & mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') end if end do @@ -445,9 +445,9 @@ subroutine esmFldsExchange_hafs_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 addmapFrom(compatm, trim(fldname1), compocn, & + call addmap_from(compatm, trim(fldname1), compocn, & mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) - call addmrgTo(compocn, trim(fldname2), & + call addmrg_to(compocn, trim(fldname2), & mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') end if end do @@ -469,9 +469,9 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compwav),trim(fldname),rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname),rc=rc) & ) then - call addmapFrom(compatm, trim(fldname), compwav, & + call addmap_from(compatm, trim(fldname), compwav, & mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2wav_smap) - call addmrgTo(compwav, trim(fldname), & + call addmrg_to(compwav, trim(fldname), & mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') end if end do diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 8e9ecc61d..6f6e5c083 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -33,12 +33,12 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use med_internalstate_mod , only : mapconsf_aofrac, mapbilnr_nstod use med_internalstate_mod , only : coupling_mode, mapnames use esmFlds , only : med_fldList_type - use esmFlds , only : addfldTo => med_fldList_AddFldTo - use esmFlds , only : addmrgTo => med_fldList_AddMrgTo - use esmFlds , only : addfldFrom => med_fldList_AddFldFrom - use esmFlds , only : addmapFrom => med_fldList_AddMapFrom - use esmFlds , only : addaofluxFld => med_fldList_addaofluxFld - use esmFlds , only : addaofluxMap => med_fldList_addaofluxMap + 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 + use esmFlds , only : addfld_aoflux => med_fldList_addfld_aoflux + use esmFlds , only : addmap_aoflux => med_fldList_addmap_aoflux use med_internalstate_mod , only : InternalState, mastertask, logunit @@ -84,8 +84,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ncomps - call addFldTo(n, trim(cvalue)) - call addfldFrom(n, trim(cvalue)) + call addfld_to(n, trim(cvalue)) + call addfld_from(n, trim(cvalue)) end do end if @@ -95,13 +95,13 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! masks from components if (phase == 'advertise') then - if (is_local%wrap%comp_present(compice)) call addfldFrom(compice, 'Si_imask') - if (is_local%wrap%comp_present(compocn)) call addfldFrom(compocn, 'So_omask') - if (is_local%wrap%comp_present(complnd)) call addFldFrom(complnd, 'Sl_lfrin') + if (is_local%wrap%comp_present(compice)) call addfld_from(compice, 'Si_imask') + if (is_local%wrap%comp_present(compocn)) call addfld_from(compocn, 'So_omask') + if (is_local%wrap%comp_present(complnd)) call addfld_from(complnd, 'Sl_lfrin') else 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 addMapFrom(compocn, 'So_omask', compice, mapfcopy, 'unset', 'unset') + call addmap_from(compocn, 'So_omask', compice, mapfcopy, 'unset', 'unset') end if end if @@ -114,11 +114,11 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) )then - call addfldFrom(compatm, trim(fldname)) + call addfld_from(compatm, trim(fldname)) end if else if ( fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmapFrom(compatm, trim(fldname), compocn, maptype, 'one', 'unset') + call addmap_from(compatm, trim(fldname), compocn, maptype, 'one', 'unset') end if end if end do @@ -131,7 +131,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then - call addaofluxfld(trim(fldname)) + call addfld_aoflux(trim(fldname)) end if end do deallocate(flds) @@ -146,11 +146,11 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) )then - call addfldFrom(compatm, trim(fldname)) + call addfld_from(compatm, trim(fldname)) end if else if ( fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmapFrom(compatm, trim(fldname), compocn, maptype, 'one', 'unset') + call addmap_from(compatm, trim(fldname), compocn, maptype, 'one', 'unset') end if end if end do @@ -164,7 +164,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then - call addaofluxfld(trim(fldname)) + call addfld_aoflux(trim(fldname)) end if end do deallocate(flds) @@ -172,7 +172,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! TODO: unused, but required to maintain B4B repro for mediator restarts; should be removed if (phase == 'advertise') then - call addfldFrom(compice, 'mean_sw_pen_to_ocn') + call addfld_from(compice, 'mean_sw_pen_to_ocn') end if !===================================================================== @@ -182,16 +182,16 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to atm: fractions (computed in med_phases_prep_atm) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm)) then - call addfldFrom(compice, 'Si_ifrac') - call addfldTo(compatm, 'Si_ifrac') + call addfld_from(compice, 'Si_ifrac') + call addfld_to(compatm, 'Si_ifrac') end if ! ofrac used by atm if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compatm)) then - call addfldFrom(compatm, 'Sa_ofrac') + call addfld_from(compatm, 'Sa_ofrac') end if ! lfrac used by atm if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%comp_present(compatm)) then - call addfldTo(compatm, 'Sl_lfrac') + call addfld_to(compatm, 'Sl_lfrac') end if end if @@ -211,14 +211,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm)) then - call addfldFrom(compice, trim(fldname)) - call addfldTo(compatm, trim(fldname)) + call addfld_from(compice, trim(fldname)) + call addfld_to(compatm, trim(fldname)) end if else 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 addmapFrom(compice, trim(fldname), compatm, maptype, 'ifrac', 'unset') - call addmrgTo(compatm, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + call addmap_from(compice, trim(fldname), compatm, maptype, 'ifrac', 'unset') + call addmrg_to(compatm, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') end if end if end do @@ -230,14 +230,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm)) then - call addfldFrom(compice, trim(fldname)) - call addfldTo(compatm, trim(fldname)) + call addfld_from(compice, trim(fldname)) + call addfld_to(compatm, trim(fldname)) end if else 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 addmapFrom(compice, trim(fldname), compatm, maptype, 'ifrac', 'unset') - call addmrgTo(compatm, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + call addmap_from(compice, trim(fldname), compatm, maptype, 'ifrac', 'unset') + call addmrg_to(compatm, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') end if end if end do @@ -246,28 +246,28 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to atm: unmerged surface temperatures from ocn if (phase == 'advertise') then if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compatm)) then - call addfldFrom(compocn, 'So_t') - call addfldTo(compatm, 'So_t') + call addfld_from(compocn, 'So_t') + call addfld_to(compatm, 'So_t') end if else if ( fldchk(is_local%wrap%FBexp(compatm) , 'So_t', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_t', rc=rc)) then - call addMapFrom(compocn, 'So_t', compatm, maptype, 'ofrac', 'unset') - call addmrgTo(compatm, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + call addmap_from(compocn, 'So_t', compatm, maptype, 'ofrac', 'unset') + call addmrg_to(compatm, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') end if end if ! to atm: unmerged surface temperatures from lnd if (phase == 'advertise') then if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%comp_present(compatm)) then - call addFldFrom(complnd, 'Sl_t') - call addfldTo(compatm, 'Sl_t') + call addfld_from(complnd, 'Sl_t') + call addfld_to(compatm, 'Sl_t') end if else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_t', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_t', rc=rc)) then - call addmapFrom(complnd, 'Sl_t', compatm, maptype, 'lfrin', 'unset') - call addmrgTo(compatm, 'Sl_t', mrg_from=complnd, mrg_fld='Sl_t', mrg_type='copy') + call addmap_from(complnd, 'Sl_t', compatm, maptype, 'lfrin', 'unset') + call addmrg_to(compatm, 'Sl_t', mrg_from=complnd, mrg_fld='Sl_t', mrg_type='copy') end if end if @@ -283,16 +283,16 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) flds = (/ 'lat ', 'sen ', 'lwup', 'taux', 'tauy' /) if (phase == 'advertise') then do n = 1,size(flds) - call addaofluxfld('Faox_'//trim(flds(n))) - call addfldTo(compatm, 'Faox_'//trim(flds(n))) + call addfld_aoflux('Faox_'//trim(flds(n))) + call addfld_to(compatm, 'Faox_'//trim(flds(n))) end do else do n = 1,size(flds) if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_'//trim(flds(n)), rc=rc)) then if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addaofluxmap('Faox_'//trim(flds(n)), compatm, maptype, 'ofrac', 'unset') + call addmap_aoflux('Faox_'//trim(flds(n)), compatm, maptype, 'ofrac', 'unset') end if - call addmrgTo(compatm, 'Faox_'//trim(flds(n)), mrg_from=compmed, mrg_fld='Faox_'//trim(flds(n)), mrg_type='copy') + call addmrg_to(compatm, 'Faox_'//trim(flds(n)), mrg_from=compmed, mrg_fld='Faox_'//trim(flds(n)), mrg_type='copy') end if end do end if @@ -303,14 +303,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to atm: surface roughness length from wav if (phase == 'advertise') then if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compatm)) then - call addfldFrom(compwav, 'Sw_z0') - call addfldTo(compatm, 'Sw_z0') + call addfld_from(compwav, 'Sw_z0') + call addfld_to(compatm, 'Sw_z0') end if else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sw_z0', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav,compwav), 'Sw_z0', rc=rc)) then - call addmapFrom(compwav, 'Sw_z0', compatm, mapnstod_consf, 'one', 'unset') - call addmrgTo(compatm, 'Sw_z0', mrg_from=compwav, mrg_fld='Sw_z0', mrg_type='copy') + call addmap_from(compwav, 'Sw_z0', compatm, mapnstod_consf, 'one', 'unset') + call addmrg_to(compatm, 'Sw_z0', mrg_from=compwav, mrg_fld='Sw_z0', mrg_type='copy') end if end if @@ -321,14 +321,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ocn: sea level pressure from atm if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfldFrom(compatm, 'Sa_pslv') - call addFldTo(compocn, 'Sa_pslv') + call addfld_from(compatm, 'Sa_pslv') + call addfld_to(compocn, 'Sa_pslv') end if else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Sa_pslv', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_pslv', rc=rc)) then - call addmapFrom(compatm, 'Sa_pslv', compocn, maptype, 'one', 'unset') - call addmrgTo(compocn, 'Sa_pslv', mrg_from=compatm, mrg_fld='Sa_pslv', mrg_type='copy') + call addmap_from(compatm, 'Sa_pslv', compocn, maptype, 'one', 'unset') + call addmrg_to(compocn, 'Sa_pslv', mrg_from=compatm, mrg_fld='Sa_pslv', mrg_type='copy') end if end if @@ -346,13 +346,13 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) do n = 1,size(oflds) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfldFrom(compatm, trim(aflds(n))) - call addFldTo(compocn, trim(oflds(n))) + call addfld_from(compatm, trim(aflds(n))) + call addfld_to(compocn, trim(oflds(n))) end if else if ( fldchk(is_local%wrap%FBexp(compocn) , trim(oflds(n)), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), trim(aflds(n)), rc=rc)) then - call addmapFrom(compatm, trim(aflds(n)), compocn, maptype, 'one', 'unset') + call addmap_from(compatm, trim(aflds(n)), compocn, maptype, 'one', 'unset') end if end if end do @@ -360,13 +360,13 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) do n = 1,size(oflds) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then - call addfldFrom(compice, trim(iflds(n))) - call addFldTo(compocn, trim(oflds(n))) + call addfld_from(compice, trim(iflds(n))) + call addfld_to(compocn, trim(oflds(n))) end if else if ( fldchk(is_local%wrap%FBexp(compocn) , trim(oflds(n)), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), trim(iflds(n)), rc=rc)) then - call addmapFrom(compice, trim(iflds(n)), compocn, mapfcopy, 'unset', 'unset') + call addmap_from(compice, trim(iflds(n)), compocn, mapfcopy, 'unset', 'unset') end if end if end do @@ -381,14 +381,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfldFrom(compatm, trim(fldname)) - call addFldTo(compocn, trim(fldname)) + call addfld_from(compatm, trim(fldname)) + call addfld_to(compocn, trim(fldname)) end if else 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 addmapFrom(compatm, trim(fldname), compocn, maptype, 'one', 'unset') - call addmrgTo(compocn, trim(fldname), & + call addmap_from(compatm, trim(fldname), compocn, maptype, 'one', 'unset') + call addmrg_to(compocn, trim(fldname), & mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if @@ -408,16 +408,16 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm) & .and. is_local%wrap%comp_present(compocn)) then - call addfldFrom(compice, trim(iflds(n))) - call addfldFrom(compatm, trim(aflds(n))) - call addFldTo(compocn, trim(oflds(n))) + call addfld_from(compice, trim(iflds(n))) + call addfld_from(compatm, trim(aflds(n))) + call addfld_to(compocn, trim(oflds(n))) end if else if ( fldchk(is_local%wrap%FBexp(compocn) , trim(oflds(n)), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), trim(iflds(n)), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), trim(aflds(n)), rc=rc)) then - call addmapFrom(compice, trim(iflds(n)), compocn, mapfcopy, 'unset', 'unset') - call addmapFrom(compatm, trim(aflds(n)), compocn, mapconsf_aofrac, 'aofrac', 'unset') + call addmap_from(compice, trim(iflds(n)), compocn, mapfcopy, 'unset', 'unset') + call addmap_from(compatm, trim(aflds(n)), compocn, mapconsf_aofrac, 'aofrac', 'unset') end if end if end do @@ -428,14 +428,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ocn: net long wave via auto merge if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfldFrom(compatm, 'Faxa_lwnet') - call addFldTo(compocn, 'Faxa_lwnet') + call addfld_from(compatm, 'Faxa_lwnet') + call addfld_to(compocn, 'Faxa_lwnet') end if else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_lwnet', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwnet', rc=rc)) then - call addmapFrom(compatm, 'Faxa_lwnet', compocn, mapconsf_aofrac, 'aofrac', 'unset') - call addmrgTo(compocn, 'Faxa_lwnet', & + call addmap_from(compatm, 'Faxa_lwnet', compocn, mapconsf_aofrac, 'aofrac', 'unset') + call addmrg_to(compocn, 'Faxa_lwnet', & mrg_from=compatm, mrg_fld='Faxa_lwnet', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if @@ -443,26 +443,26 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ocn: merged sensible heat flux (custom merge in med_phases_prep_ocn) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfldFrom(compatm, 'Faxa_sen') - call addFldTo(compocn, 'Faxa_sen') + call addfld_from(compatm, 'Faxa_sen') + call addfld_to(compocn, 'Faxa_sen') end if else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_sen', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_sen', rc=rc)) then - call addmapFrom(compatm, 'Faxa_sen', compocn, mapconsf_aofrac, 'aofrac', 'unset') + call addmap_from(compatm, 'Faxa_sen', compocn, mapconsf_aofrac, 'aofrac', 'unset') end if end if ! to ocn: evaporation water flux (custom merge in med_phases_prep_ocn) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfldFrom(compatm, 'Faxa_lat') - call addFldTo(compocn, 'Faxa_evap') + call addfld_from(compatm, 'Faxa_lat') + call addfld_to(compocn, 'Faxa_evap') end if else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_evap', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lat' , rc=rc)) then - call addmapFrom(compatm, 'Faxa_lat', compocn, mapconsf_aofrac, 'aofrac', 'unset') + call addmap_from(compatm, 'Faxa_lat', compocn, mapconsf_aofrac, 'aofrac', 'unset') end if end if else if (trim(coupling_mode) == 'nems_orig_data' .or. trim(coupling_mode) == 'nems_frac_aoflux') then @@ -473,18 +473,18 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) do n = 1,size(flds) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then - call addaofluxfld('Faox_'//trim(flds(n))) - call addfldFrom(compice , 'Fioi_'//trim(flds(n))) - call addFldTo(compocn , 'Foxx_'//trim(flds(n))) + call addfld_aoflux('Faox_'//trim(flds(n))) + call addfld_from(compice , 'Fioi_'//trim(flds(n))) + call addfld_to(compocn , 'Foxx_'//trim(flds(n))) end if else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_'//trim(flds(n)), rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_'//trim(flds(n)), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_'//trim(flds(n)), rc=rc)) then - call addmapFrom(compice, 'Fioi_'//trim(flds(n)), compocn, mapfcopy, 'unset', 'unset') - call addmrgTo(compocn, 'Foxx_'//trim(flds(n)), & + call addmap_from(compice, 'Fioi_'//trim(flds(n)), compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, 'Foxx_'//trim(flds(n)), & mrg_from=compmed, mrg_fld='Faox_'//trim(flds(n)), mrg_type='merge', mrg_fracname='ofrac') - call addmrgTo(compocn, 'Foxx_'//trim(flds(n)), & + call addmrg_to(compocn, 'Foxx_'//trim(flds(n)), & mrg_from=compice, mrg_fld='Fioi_'//trim(flds(n)), mrg_type='merge', mrg_fracname='ifrac') end if end if @@ -494,18 +494,18 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ocn: long wave net via auto merge if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addaofluxfld('Faox_lwup') - call addfldFrom(compatm, 'Faxa_lwdn') - call addFldTo(compocn, 'Foxx_lwnet') + call addfld_aoflux('Faox_lwup') + call addfld_from(compatm, 'Faxa_lwdn') + call addfld_to(compocn, 'Foxx_lwnet') end if else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_lwnet', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_lwup' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn' , rc=rc)) then - call addmapFrom(compatm, 'Faxa_lwdn', compocn, maptype, 'one', 'unset') - call addmrgTo(compocn, 'Foxx_lwnet', & + call addmap_from(compatm, 'Faxa_lwdn', compocn, maptype, 'one', 'unset') + call addmrg_to(compocn, 'Foxx_lwnet', & mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') - call addmrgTo(compocn, 'Foxx_lwnet', & + call addmrg_to(compocn, 'Foxx_lwnet', & mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='merge', mrg_fracname='ofrac') end if end if @@ -513,13 +513,13 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ocn: sensible heat flux from mediator via auto merge if (phase == 'advertise') then if (is_local%wrap%comp_present(compocn)) then - call addaofluxfld('Faox_sen') - call addFldTo(compocn, 'Faox_sen') + call addfld_aoflux('Faox_sen') + call addfld_to(compocn, 'Faox_sen') end if else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faox_sen', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_sen' , rc=rc)) then - call addmrgTo(compocn, 'Faox_sen', & + call addmrg_to(compocn, 'Faox_sen', & mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if @@ -527,13 +527,13 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ocn: evaporation water flux from mediator via auto merge if (phase == 'advertise') then if (is_local%wrap%comp_present(compocn)) then - call addaofluxfld('Faox_evap') - call addFldTo(compocn, 'Faox_evap') + call addfld_aoflux('Faox_evap') + call addfld_to(compocn, 'Faox_evap') end if else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faox_evap', rc=rc) .and. & fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_evap' , rc=rc)) then - call addmrgTo(compocn, 'Faox_evap', & + call addmrg_to(compocn, 'Faox_evap', & mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if @@ -548,14 +548,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then - call addfldFrom(compice, trim(fldname)) - call addFldTo(compocn, trim(fldname)) + call addfld_from(compice, trim(fldname)) + call addfld_to(compocn, trim(fldname)) end if else if ( fldchk(is_local%wrap%FBexp(compocn) , trim(fldname), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), trim(fldname), rc=rc)) then - call addmapFrom(compice, trim(fldname), compocn, mapfcopy, 'unset', 'unset') - call addmrgTo(compocn, trim(fldname), & + call addmap_from(compice, trim(fldname), compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, trim(fldname), & mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if @@ -570,14 +570,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compocn)) then - call addfldFrom(compwav, trim(fldname)) - call addFldTo(compocn, trim(fldname)) + call addfld_from(compwav, trim(fldname)) + call addfld_to(compocn, trim(fldname)) end if else if ( fldchk(is_local%wrap%FBexp(compocn) , trim(fldname), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav,compwav), trim(fldname), rc=rc)) then - call addmapFrom(compwav, trim(fldname), compocn, mapfcopy, 'unset', 'unset') - call addmrgTo(compocn, trim(fldname), mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') + call addmap_from(compwav, trim(fldname), compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, trim(fldname), mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') end if end if end do @@ -603,14 +603,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compice)) then - call addfldFrom(compatm, trim(fldname)) - call addFldTo(compice, trim(fldname)) + call addfld_from(compatm, trim(fldname)) + call addfld_to(compice, trim(fldname)) end if else 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 addmapFrom(compatm, trim(fldname), compice, maptype, 'one', 'unset') - call addmrgTo(compice, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + call addmap_from(compatm, trim(fldname), compice, maptype, 'one', 'unset') + call addmrg_to(compice, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') end if end if end do @@ -630,14 +630,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compice)) then - call addfldFrom(compatm, trim(fldname)) - call addFldTo(compice, trim(fldname)) + call addfld_from(compatm, trim(fldname)) + call addfld_to(compice, trim(fldname)) endif else 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 addmapFrom(compatm, trim(fldname), compice, maptype, 'one', 'unset') - call addmrgTo(compice, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + call addmap_from(compatm, trim(fldname), compice, maptype, 'one', 'unset') + call addmrg_to(compice, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') end if end if end do @@ -658,14 +658,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compice)) then - call addfldFrom(compocn, trim(fldname)) - call addFldTo(compice, trim(fldname)) + call addfld_from(compocn, trim(fldname)) + call addfld_to(compice, trim(fldname)) endif else 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 addMapFrom(compocn, trim(fldname), compice, mapfcopy , 'unset', 'unset') - call addmrgTo(compice, 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 if end do @@ -682,14 +682,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compwav)) then - call addfldFrom(compatm, trim(fldname)) - call addfldTo(compwav, trim(fldname)) + call addfld_from(compatm, trim(fldname)) + call addfld_to(compwav, trim(fldname)) end if else if ( fldchk(is_local%wrap%FBexp(compwav) , trim(fldname), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmapFrom(compatm, trim(fldname), compwav, mapnstod_consf, 'one', 'unset') - call addmrgTo(compwav, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + call addmap_from(compatm, trim(fldname), compwav, mapnstod_consf, 'one', 'unset') + call addmrg_to(compwav, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') end if end if end do @@ -698,14 +698,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to wav: sea ice fraction if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compwav)) then - call addfldFrom(compice, 'Si_ifrac') - call addfldTo(compwav, 'Si_ifrac') + call addfld_from(compice, 'Si_ifrac') + call addfld_to(compwav, 'Si_ifrac') end if else if ( fldchk(is_local%wrap%FBexp(compwav) , 'Si_ifrac', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice), 'Si_ifrac', rc=rc)) then - call addmapFrom(compice, 'Si_ifrac', compwav, mapfcopy , 'unset', 'unset') - call addmrgTo(compwav, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') + call addmap_from(compice, 'Si_ifrac', compwav, mapfcopy , 'unset', 'unset') + call addmrg_to(compwav, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') end if end if @@ -718,14 +718,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compwav)) then - call addfldFrom(compocn, trim(fldname)) - call addfldTo(compwav, trim(fldname)) + call addfld_from(compocn, trim(fldname)) + call addfld_to(compwav, trim(fldname)) end if else if ( fldchk(is_local%wrap%FBexp(compwav) , trim(fldname), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), trim(fldname), rc=rc)) then - call addMapFrom(compocn, trim(fldname), compwav, mapfcopy , 'unset', 'unset') - call addmrgTo(compwav, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + call addmap_from(compocn, trim(fldname), compwav, mapfcopy , 'unset', 'unset') + call addmrg_to(compwav, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') end if end if end do @@ -756,14 +756,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(complnd)) then - call addfldFrom(compatm, trim(fldname)) - call addfldTo(complnd, trim(fldname)) + call addfld_from(compatm, trim(fldname)) + call addfld_to(complnd, trim(fldname)) end if else if ( fldchk(is_local%wrap%FBexp(complnd) , trim(fldname), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmapFrom(compatm, trim(fldname), complnd, maptype, 'one', 'unset') - call addmrgTo(complnd, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + call addmap_from(compatm, trim(fldname), complnd, maptype, 'one', 'unset') + call addmrg_to(complnd, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') end if end if end do diff --git a/mediator/med.F90 b/mediator/med.F90 index 11d5d6747..352cf0c4d 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -810,7 +810,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) ! Initialize memory for fldlistTo and fldlistFr - this is need for the calls below for the ! advertise phase - call med_fldlist_init1() + call med_fldlist_init1(ncomps) if (trim(coupling_mode) == 'cesm') then call esmFldsExchange_cesm(gcomp, phase='advertise', rc=rc) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index caa9f4851..c0c8a8d1d 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -18,7 +18,7 @@ module med_phases_prep_atm_mod use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, mastertask use med_internalstate_mod , only : compatm, compocn, compice, compname, coupling_mode - use esmFlds , only : med_fldlist_GetfldListTo + use esmFlds , only : med_fldlist_GetfldListTo, esm_fldlist_type use perf_mod , only : t_startf, t_stopf use med_phases_aofluxes_mod, only : med_aofluxes_map_xgrid2agrid_output use med_phases_aofluxes_mod, only : med_aofluxes_map_ogrid2agrid_output @@ -53,6 +53,7 @@ subroutine med_phases_prep_atm(gcomp, rc) real(R8), pointer :: ifrac(:) real(R8), pointer :: ofrac(:) integer :: i, j, n, n1, ncnt + type(esm_fldlist_type), pointer :: fldList character(len=*),parameter :: subname='(med_phases_prep_atm)' !------------------------------------------------------------------------------- @@ -131,6 +132,7 @@ subroutine med_phases_prep_atm(gcomp, rc) !--------------------------------------- !--- merge all fields to atm !--------------------------------------- + fldList => med_fldList_GetfldListTo(compatm) if (trim(coupling_mode) == 'cesm' .or. & trim(coupling_mode) == 'nems_frac_aoflux' .or. & trim(coupling_mode) == 'hafs') then @@ -139,7 +141,7 @@ subroutine med_phases_prep_atm(gcomp, rc) is_local%wrap%FBExp(compatm), & is_local%wrap%FBFrac(compatm), & is_local%wrap%FBImp(:,compatm), & - med_fldList_GetfldListTo(compatm), & + fldList, & FBMed1=is_local%wrap%FBMed_ocnalb_a, & FBMed2=is_local%wrap%FBMed_aoflux_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -151,7 +153,8 @@ subroutine med_phases_prep_atm(gcomp, rc) is_local%wrap%FBExp(compatm), & is_local%wrap%FBFrac(compatm), & is_local%wrap%FBImp(:,compatm), & - med_fldList_GetfldListTo(compatm), rc=rc) + fldList, & + rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 0ed527b8f..20f953a64 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -27,7 +27,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND - use esmFlds , only : med_fldList_GetFldListTo + use esmFlds , only : med_fldList_GetFldListTo, med_fldList_type use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag @@ -51,6 +51,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) real(r8), pointer :: dataptr2d(:,:) logical :: first_call = .true. logical :: field_found + type(med_fldlist_type), pointer :: fldList real(r8), pointer :: dataptr_scalar_lnd(:,:) real(r8), pointer :: dataptr_scalar_atm(:,:) character(len=*), parameter :: subname='(med_phases_prep_lnd)' @@ -84,12 +85,14 @@ subroutine med_phases_prep_lnd(gcomp, rc) ! auto merges to create FBExp(complnd) - other than glc->lnd ! The following will merge all fields in fldsSrc call t_startf('MED:'//trim(subname)//' merge') + fldList => med_fldList_GetFldListTo(complnd) call med_merge_auto(& is_local%wrap%med_coupling_active(:,complnd), & is_local%wrap%FBExp(complnd), & is_local%wrap%FBFrac(complnd), & is_local%wrap%FBImp(:,complnd), & - med_fldList_GetFldListTo(complnd), rc=rc) + fldList, & + rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//trim(subname)//' merge') diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index d2e1e4ffe..6923699f3 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -19,7 +19,7 @@ module med_phases_prep_ocn_mod use med_methods_mod , only : FB_average => med_methods_FB_average use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset - use esmFlds , only : med_fldList_GetfldListTo + 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 @@ -99,6 +99,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) real(r8), pointer :: rofi(:), hrofi(:) real(r8), pointer :: areas(:) real(r8), allocatable :: hcorr(:) + type(med_fldlist_type), pointer :: fldList character(len=*), parameter :: subname='(med_phases_prep_ocn_accum)' !--------------------------------------- @@ -113,7 +114,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - + fldList => med_fldList_GetfldListTo(compocn) ! auto merges to ocn if ( trim(coupling_mode) == 'cesm' .or. & trim(coupling_mode) == 'nems_orig_data' .or. & @@ -124,7 +125,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) is_local%wrap%FBExp(compocn), & is_local%wrap%FBFrac(compocn), & is_local%wrap%FBImp(:,compocn), & - med_fldList_GetfldListTo(compocn), & + fldList, & FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'nems_frac' .or. & @@ -135,7 +136,8 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) is_local%wrap%FBExp(compocn), & is_local%wrap%FBFrac(compocn), & is_local%wrap%FBImp(:,compocn), & - med_fldList_GetfldListTo(compocn), rc=rc) + fldList, & + rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if From 15e746be8506c0221e9a8cb84fab68cc34678510 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 29 Nov 2022 14:39:50 -0700 Subject: [PATCH 145/395] fix typos --- mediator/esmFlds.F90 | 5 +++-- mediator/med_phases_prep_atm_mod.F90 | 4 ++-- mediator/med_phases_prep_ocn_mod.F90 | 2 +- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index 46de218f6..c9425ac85 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -54,7 +54,8 @@ module esmflds character(CS), allocatable :: mapnorm(:) character(CX), allocatable :: mapfile(:) - ! Merging fldsTo data - for mediator export field character(CS), allocatable :: merge_fields(:) + ! Merging fldsTo data - for mediator export field + character(CS), allocatable :: merge_fields(:) character(CS), allocatable :: merge_types(:) character(CS), allocatable :: merge_fracnames(:) type(med_fldList_entry_type), pointer :: next => null() @@ -219,7 +220,7 @@ subroutine med_fldList_AddFld(fields, stdname, shortname) call med_fldList_findName(fields, stdname, found, newfld) ! create new entry if fldname is not in original list mapsize = size(fldListTo) - mrgsize = size(fldListFrom) + mrgsize = size(fldListFr) if (.not. found) then ! 1) allocate newfld to be size (one element larger than input flds) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index c0c8a8d1d..9448f6913 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -18,7 +18,7 @@ module med_phases_prep_atm_mod use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, mastertask use med_internalstate_mod , only : compatm, compocn, compice, compname, coupling_mode - use esmFlds , only : med_fldlist_GetfldListTo, esm_fldlist_type + use esmFlds , only : med_fldlist_GetfldListTo, med_fldlist_type use perf_mod , only : t_startf, t_stopf use med_phases_aofluxes_mod, only : med_aofluxes_map_xgrid2agrid_output use med_phases_aofluxes_mod, only : med_aofluxes_map_ogrid2agrid_output @@ -53,7 +53,7 @@ subroutine med_phases_prep_atm(gcomp, rc) real(R8), pointer :: ifrac(:) real(R8), pointer :: ofrac(:) integer :: i, j, n, n1, ncnt - type(esm_fldlist_type), pointer :: fldList + type(med_fldlist_type), pointer :: fldList character(len=*),parameter :: subname='(med_phases_prep_atm)' !------------------------------------------------------------------------------- diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 6923699f3..b8b4f2fa6 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -137,7 +137,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) is_local%wrap%FBFrac(compocn), & is_local%wrap%FBImp(:,compocn), & fldList, & - rc) + rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if From 841258ac0b99c9a5d1553ff7317c6a3ce37b7526 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 29 Nov 2022 15:09:45 -0700 Subject: [PATCH 146/395] more name changes --- mediator/esmFlds.F90 | 28 +++++++++++++++++----------- mediator/med_map_mod.F90 | 1 - 2 files changed, 17 insertions(+), 12 deletions(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index c9425ac85..bf7dc0d2a 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -76,8 +76,8 @@ module esmflds type (med_fldList_type), allocatable, target :: fldListTo(:) ! advertise fields to components type (med_fldList_type), allocatable, target :: fldListFr(:) ! advertise fields from components - type (med_fldList_type), target :: fldListMed_aoflux - type (med_fldList_type), target :: fldListMed_ocnalb + type (med_fldList_type), target :: fldlist_aoflux + type (med_fldList_type), target :: fldlist_ocnalb integer :: rc character(len=CL) :: infostr @@ -95,24 +95,27 @@ subroutine med_fldlist_init1(ncomps) end subroutine med_fldlist_init1 !================================================================================ - + function med_fldList_GetaofluxFldList() result(fldList) + ! Return a pointer to the aoflux fldlist type(med_fldList_type), pointer :: fldList - fldList => fldListMed_aoflux + fldList => fldlist_aoflux end function Med_FldList_GetaofluxFldList !================================================================================ function med_fldList_GetocnalbFldList() result(fldList) + ! Return a pointer to the ocnalb fldlist type(med_fldList_type), pointer :: fldList - fldList => fldListMed_ocnalb + fldList => fldlist_ocnalb end function Med_FldList_GetocnalbFldList !================================================================================ function med_fldList_GetFldListFr(index) result(fldList) + ! Return a pointer to the FldListFr(index) integer, intent(in) :: index type(med_fldList_type), pointer :: fldList @@ -122,6 +125,7 @@ end function Med_FldList_GetFldListFr !================================================================================ function med_fldList_GetFldListTo(index) result(fldList) + ! Return a pointer to the FldListTo(index) integer, intent(in) :: index type(med_fldList_type), pointer :: fldList @@ -131,6 +135,7 @@ end function Med_FldList_GetFldListTo !================================================================================ subroutine med_fldList_addfld_from(index, stdname, shortname) + ! add a fld with name stdname to the FldListFr list integer, intent(in) :: index character(len=*) , intent(in) :: stdname character(len=*) , intent(in) , optional :: shortname @@ -142,10 +147,11 @@ end subroutine med_fldList_addfld_from !================================================================================ subroutine med_fldList_addfld_aoflux(stdname, shortname) + ! add a fld to the aoflux fldList character(len=*) , intent(in) :: stdname character(len=*) , intent(in) , optional :: shortname - call med_fldList_AddFld(fldListMed_aoflux%fields, stdname, shortname) + call med_fldList_AddFld(fldlist_aoflux%fields, stdname, shortname) end subroutine med_fldList_addfld_aoflux @@ -155,7 +161,7 @@ subroutine med_fldList_addfld_ocnalb(stdname, shortname) character(len=*) , intent(in) :: stdname character(len=*) , intent(in) , optional :: shortname - call med_fldList_AddFld(fldListMed_ocnalb%fields, stdname, shortname) + call med_fldList_AddFld(fldlist_ocnalb%fields, stdname, shortname) end subroutine med_fldList_addfld_ocnalb @@ -359,7 +365,7 @@ subroutine med_fldList_addmap_aoflux(fldname, destcomp, maptype, mapnorm, mapfil character(len=*) , intent(in) :: mapnorm character(len=*), optional , intent(in) :: mapfile - call med_fldList_AddMap(fldlistmed_aoflux%fields, fldname, destcomp, maptype, mapnorm, mapfile) + call med_fldList_AddMap(fldlist_aoflux%fields, fldname, destcomp, maptype, mapnorm, mapfile) end subroutine med_fldList_addmap_aoflux @@ -372,7 +378,7 @@ subroutine med_fldList_addmap_ocnalb(fldname, destcomp, maptype, mapnorm, mapfil character(len=*) , intent(in) :: mapnorm character(len=*), optional , intent(in) :: mapfile - call med_fldList_AddMap(fldlistmed_ocnalb%fields, fldname, destcomp, maptype, mapnorm, mapfile) + call med_fldList_AddMap(fldlist_ocnalb%fields, fldname, destcomp, maptype, mapnorm, mapfile) end subroutine med_fldList_addmap_ocnalb @@ -870,8 +876,8 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active) ! ocn-> atm mappings for atm/ocn fluxes computed in mediator on the ocn grid nsrc = compocn ndst = compatm - if (med_coupling_active(nsrc,ndst) .and. allocated(fldListMed_aoflux%fields%mapindex)) then - newfld => fldListMed_aoflux%fields + if (med_coupling_active(nsrc,ndst) .and. allocated(fldlist_aoflux%fields%mapindex)) then + newfld => fldlist_aoflux%fields do while(associated(newfld)) call med_fld_GetFldInfo(newfld, compsrc=ndst, mapindex=mapindex, rc=rc) if ( mapindex /= mapunset) then diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 8cac3e5db..d65914699 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -174,7 +174,6 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun ! Create route handle for target mapindex if route handle is required ! (i.e. mapindex /= mapunset) and route handle has not already been created if (.not. mapexists) then - !~ mapfile = trim(fldListFr%fields(nf)%mapfile(n2)) call med_fld_GetFldInfo(fldptr, compsrc=n2, mapfile=mapfile) call med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, & mapindex, is_local%wrap%rh(n1,n2,:), mapfile=trim(mapfile), rc=rc) From b8c29e67ba21c5a688c34a3ee8923e949907e147 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 30 Nov 2022 07:06:41 -0700 Subject: [PATCH 147/395] add an abort call --- mediator/esmFlds.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index bf7dc0d2a..fa15869df 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -1,7 +1,5 @@ module esmflds use ESMF, only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_ERROR, ESMF_LOGWRITE - use ESMF, only : ESMF_FINALIZE, ESMF_END_ABORT - 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 : compname, compocn, compatm, compice, comprof use med_internalstate_mod, only : mapfcopy, mapnames, mapunset @@ -295,7 +293,7 @@ subroutine med_fldList_AddMrg(flds, fldname, mrg_from, mrg_fld, mrg_type, mrg_fr character(len=*) , intent(in) :: mrg_fld character(len=*) , intent(in) :: mrg_type character(len=*) , intent(in), optional :: mrg_fracname - + ! local variables integer :: rc type(med_fldList_entry_type), pointer :: newfld @@ -315,7 +313,9 @@ end subroutine med_fldList_AddMrg !================================================================================ function med_fldList_GetFld(fields, fldname, rc) result(newfld) - use ESMF, only : ESMF_LogWrite, ESMF_END_ABORT, ESMF_LOGMSG_ERROR, ESMF_Finalize, ESMF_LOGMSG_INFO + use ESMF, only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LOGMSG_INFO + use ESMF, only : ESMF_FINALIZE, ESMF_END_ABORT + type(med_fldList_entry_type) , intent(in), target :: fields character(len=*) , intent(in) :: fldname @@ -337,7 +337,7 @@ function med_fldList_GetFld(fields, fldname, rc) result(newfld) newfld => newfld%next end do call ESMF_LogWrite(subname // 'ERROR: fldname '// trim(fldname) // ' not found in input flds', ESMF_LOGMSG_ERROR) - return + call ESMF_Finalize(endflag=ESMF_END_ABORT) endif end function med_fldList_GetFld From 57b6c0eefa427b651488fd24ec252390b59e49f2 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 1 Dec 2022 08:03:54 -0700 Subject: [PATCH 148/395] fix compile error --- mediator/esmFldsExchange_nems_mod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 563179520..0d4f60369 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -39,7 +39,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use esmFlds , only : addmap_from => med_fldList_addmap_from use esmFlds , only : addfld_aoflux => med_fldList_addfld_aoflux use esmFlds , only : addmap_aoflux => med_fldList_addmap_aoflux - + use med_internalstate_mod , only : InternalState, mastertask, logunit ! input/output parameters: @@ -673,14 +673,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compwav)) then - call addfldFrom(compwav, 'Sw_elevation_spectrum') - call addfldTo(compice, 'Sw_elevation_spectrum') + call addfld_from(compwav, 'Sw_elevation_spectrum') + call addfld_to(compice, 'Sw_elevation_spectrum') end if else if ( fldchk(is_local%wrap%FBExp(compice) , 'Sw_elevation_spectrum', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav,compwav), 'Sw_elevation_spectrum', rc=rc)) then - call addMapFrom(compwav, 'Sw_elevation_spectrum', compice, mapbilnr_nstod, 'one', 'unset') - call addmrgTo(compice, 'Sw_elevation_spectrum', mrg_from=compwav, & + call addmap_from(compwav, 'Sw_elevation_spectrum', compice, mapbilnr_nstod, 'one', 'unset') + call addmrg_to(compice, 'Sw_elevation_spectrum', mrg_from=compwav, & mrg_fld='Sw_elevation_spectrum', mrg_type='copy') end if end if From 4198c592a46f30d821d527058843e7bb3e5bde9b Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 1 Dec 2022 10:34:14 -0700 Subject: [PATCH 149/395] move shr_file_getLogUnit to shr_log_getLogUnit --- cesm/driver/ensemble_driver.F90 | 7 +++---- cesm/driver/esm.F90 | 6 ++---- cesm/nuopc_cap_share/driver_pio_mod.F90 | 1 - cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 4 ++-- cesm/nuopc_cap_share/shr_carma_mod.F90 | 4 +++- cesm/nuopc_cap_share/shr_drydep_mod.F90 | 11 +++++++---- cesm/nuopc_cap_share/shr_megan_mod.F90 | 5 +++-- cesm/nuopc_cap_share/shr_ndep_mod.F90 | 8 ++++---- cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 | 6 +++--- cime_config/namelist_definition_drv.xml | 2 +- 10 files changed, 28 insertions(+), 26 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 1c5d3ca67..f5313f98f 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -8,8 +8,7 @@ module Ensemble_driver !----------------------------------------------------------------------------- use shr_kind_mod , only : cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_log_mod , only : shrlogunit=> shr_log_unit - use shr_file_mod , only : shr_file_setLogUnit + use shr_log_mod , only : shr_log_setLogUnit use esm_utils_mod , only : mastertask, logunit, chkerr implicit none @@ -256,10 +255,10 @@ subroutine SetModelServices(ensemble_driver, rc) open (newunit=logunit,file=trim(diro)//"/"//trim(logfile)) mastertask = .true. else - logUnit = shrlogunit + logUnit = 6 mastertask = .false. endif - call shr_file_setLogUnit (logunit) + call shr_log_setLogUnit (logunit) ! Create a clock for each driver instance call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index b6f39ad52..3d0bb5a2b 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -8,7 +8,7 @@ module ESM use shr_sys_mod , only : shr_sys_abort use shr_mpi_mod , only : shr_mpi_bcast use shr_mem_mod , only : shr_mem_init - use shr_file_mod , only : shr_file_setLogunit + use shr_log_mod , only : shr_log_setLogunit use esm_utils_mod, only : logunit, mastertask, dbug_flag, chkerr use perf_mod , only : t_initf, t_setLogUnit @@ -141,10 +141,8 @@ subroutine SetModelServices(driver, rc) !------------------------------------------- ! Set the io logunit to the value defined in ensemble_driver - ! TODO: - is this statement still correct? - ! it may be corrected below if the med mastertask is not the driver mastertask !------------------------------------------- - call shr_file_setLogunit(logunit) + call shr_log_setLogunit(logunit) !------------------------------------------- ! Get the config and vm objects from the driver diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index 2584ab1dd..42d301221 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -2,7 +2,6 @@ module driver_pio_mod use pio use shr_pio_mod, only : io_compname, pio_comp_settings, iosystems, io_compid, shr_pio_getindex use shr_kind_mod, only : CS=>shr_kind_CS, shr_kind_cl, shr_kind_in - use shr_file_mod, only : shr_file_getunit, shr_file_freeunit use shr_log_mod, only : shr_log_unit use shr_mpi_mod, only : shr_mpi_bcast, shr_mpi_chkerr use shr_sys_mod, only : shr_sys_abort diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index 1a6c43c24..0ed53f22b 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -22,7 +22,7 @@ module nuopc_shr_methods use NUOPC_Model , only : NUOPC_ModelGet use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_sys_mod , only : shr_sys_abort - use shr_file_mod , only : shr_file_setlogunit, shr_file_getLogUnit + use shr_log_mod , only : shr_log_setLogUnit implicit none private @@ -170,7 +170,7 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) endif shrlogunit = logunit - call shr_file_setLogUnit (logunit) + call shr_log_setLogUnit (logunit) end subroutine set_component_logging diff --git a/cesm/nuopc_cap_share/shr_carma_mod.F90 b/cesm/nuopc_cap_share/shr_carma_mod.F90 index 3946b8878..6e596eb5b 100644 --- a/cesm/nuopc_cap_share/shr_carma_mod.F90 +++ b/cesm/nuopc_cap_share/shr_carma_mod.F90 @@ -7,7 +7,7 @@ module shr_carma_mod use shr_kind_mod , only : r8 => shr_kind_r8, CX => SHR_KIND_CX use shr_sys_mod , only : shr_sys_abort - use shr_log_mod , only : logunit => shr_log_Unit + use shr_log_mod , only : shr_log_getLogUnit use shr_nl_mod , only : shr_nl_find_group_name implicit none @@ -38,9 +38,11 @@ subroutine shr_carma_readnl( NLFileName, carma_fields) integer :: ierr ! error code logical :: exists ! if file exists or not integer :: i, tmp(1) + integer :: logunit character(*),parameter :: F00 = "('(shr_carma_readnl) ',2a)" namelist /carma_inparm/ carma_fields + call shr_log_getLogUnit(logunit) carma_fields = ' ' call ESMF_VMGetCurrent(vm, rc=rc) diff --git a/cesm/nuopc_cap_share/shr_drydep_mod.F90 b/cesm/nuopc_cap_share/shr_drydep_mod.F90 index 8b6464da4..7f3af4131 100644 --- a/cesm/nuopc_cap_share/shr_drydep_mod.F90 +++ b/cesm/nuopc_cap_share/shr_drydep_mod.F90 @@ -13,8 +13,7 @@ module shr_drydep_mod use shr_kind_mod , only : r8 => shr_kind_r8, CS => SHR_KIND_CS, CX => SHR_KIND_CX use shr_const_mod , only : SHR_CONST_MWWV use shr_nl_mod , only : shr_nl_find_group_name - use shr_log_mod , only : s_logunit => shr_log_Unit - use shr_file_mod , only : shr_file_getLogUnit + use shr_log_mod , only : shr_log_getLogUnit use shr_infnan_mod , only : shr_infnan_posinf, assignment(=) use nuopc_shr_methods, only : chkerr @@ -254,6 +253,7 @@ subroutine shr_drydep_readnl(NLFilename, drydep_nflds) type(ESMF_VM) :: vm integer :: localPet integer :: mpicom + integer :: s_logunit integer :: rc character(*),parameter :: F00 = "('(shr_drydep_read) ',8a)" character(*),parameter :: FI1 = "('(shr_drydep_init) ',a,I2)" @@ -281,8 +281,8 @@ subroutine shr_drydep_readnl(NLFilename, drydep_nflds) call ESMF_VMGet(vm, localPet=localPet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call shr_log_getLogUnit(s_logunit) if (localPet==0) then - call shr_file_getLogUnit(s_logunit) inquire( file=trim(NLFileName), exist=exists) if ( exists ) then open(newunit=unitn, file=trim(NLFilename), status='old' ) @@ -348,6 +348,7 @@ subroutine shr_drydep_init( ) integer :: mpicom integer :: bint(2) real(kind=r8), pointer :: dptr(:) + integer :: s_logunit integer :: rc logical, save :: drydep_initialized=.false. character(len=256) :: msg @@ -357,6 +358,7 @@ subroutine shr_drydep_init( ) character(*),parameter :: F00 = "('(shr_drydep_init) ',8a)" call ESMF_LogWrite(subname//' start', ESMF_LOGMSG_INFO) + call shr_log_getLogUnit(s_logunit) if (dep_data_file=='NONE' .or. len_trim(dep_data_file)==0) return @@ -615,7 +617,7 @@ subroutine set_hcoeff_vector( ncol, sfc_temp, heff ) real(r8) :: dk1s(ncol) ! DK Work array 1 real(r8) :: dk2s(ncol) ! DK Work array 2 real(r8) :: wrk(ncol) ! Work array - + integer :: s_logunit !----- formats ----- character(*),parameter :: subName = '(shr_drydep_set_hcoeff) ' character(*),parameter :: F00 = "('(shr_drydep_set_hcoeff) ',8a)" @@ -624,6 +626,7 @@ subroutine set_hcoeff_vector( ncol, sfc_temp, heff ) ! notes: !------------------------------------------------------------------------------- + call shr_log_getLogUnit(s_logunit) wrk(:) = (t0 - sfc_temp(:))/(t0*sfc_temp(:)) do m = 1,n_drydep l = mapping(m) diff --git a/cesm/nuopc_cap_share/shr_megan_mod.F90 b/cesm/nuopc_cap_share/shr_megan_mod.F90 index 4273217c0..d49411e84 100644 --- a/cesm/nuopc_cap_share/shr_megan_mod.F90 +++ b/cesm/nuopc_cap_share/shr_megan_mod.F90 @@ -16,7 +16,7 @@ module shr_megan_mod use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cx=>shr_kind_cx, cs=>shr_kind_cs use shr_sys_mod , only : shr_sys_abort - use shr_log_mod , only : logunit => shr_log_Unit + use shr_log_mod , only : shr_log_getLogUnit use shr_mpi_mod , only : shr_mpi_bcast use shr_nl_mod , only : shr_nl_find_group_name use shr_expr_parser_mod , only : shr_exp_parse, shr_exp_item_t, shr_exp_list_destroy @@ -126,6 +126,7 @@ subroutine shr_megan_readnl( NLFileName, megan_nflds) logical :: megan_mapped_emisfctrs = .false. character(len=CL) :: megan_factors_file = ' ' integer :: rc + integer :: logunit integer :: i, tmp(1) character(*), parameter :: F00 = "('(shr_megan_readnl) ',2a)" character(len=*), parameter :: subname='(shr_megan_readnl)' @@ -143,7 +144,7 @@ subroutine shr_megan_readnl( NLFileName, megan_nflds) call ESMF_VMGet(vm, localPet=localPet, mpiCommunicator=mpicom, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + call shr_log_getLogUnit(logunit) ! Note the following still needs to be called on all processors since the mpi_bcast is a collective ! call on all the pes of mpicom if (localPet==0) then diff --git a/cesm/nuopc_cap_share/shr_ndep_mod.F90 b/cesm/nuopc_cap_share/shr_ndep_mod.F90 index 6e0fcb91a..02219d9f3 100644 --- a/cesm/nuopc_cap_share/shr_ndep_mod.F90 +++ b/cesm/nuopc_cap_share/shr_ndep_mod.F90 @@ -9,7 +9,7 @@ module shr_ndep_mod 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 : s_logunit => shr_log_Unit + use shr_log_mod , only : shr_log_getLogUnit use shr_kind_mod , only : r8 => shr_kind_r8 use shr_nl_mod , only : shr_nl_find_group_name use shr_mpi_mod , only : shr_mpi_bcast @@ -49,7 +49,7 @@ subroutine shr_ndep_readnl(NLFilename, ndep_nflds) character(len=32) :: ndep_list(maxspc) = '' ! List of ndep species integer :: localpet integer :: mpicom - + integer :: logunit character(*),parameter :: subName = '(shr_ndep_readnl) ' character(*),parameter :: F00 = "('(shr_ndep_readnl) ',8a)" ! ------------------------------------------------------------------ @@ -67,7 +67,7 @@ subroutine shr_ndep_readnl(NLFilename, ndep_nflds) if ( len_trim(NLFilename) == 0 ) then call shr_sys_abort( subName//'ERROR: nlfilename not set' ) end if - + call shr_log_getLogUnit(logunit) call ESMF_VMGetCurrent(vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -80,7 +80,7 @@ subroutine shr_ndep_readnl(NLFilename, ndep_nflds) inquire( file=trim(NLFileName), exist=exists) if ( exists ) then open(newunit=unitn, file=trim(NLFilename), status='old' ) - write(s_logunit,F00) 'Read in ndep_inparm namelist from: ', trim(NLFilename) + write(logunit,F00) 'Read in ndep_inparm namelist from: ', trim(NLFilename) call shr_nl_find_group_name(unitn, 'ndep_inparm', ierr) if (ierr == 0) then ! Note that ierr /= 0, no namelist is present. diff --git a/cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 b/cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 index fbd601c3c..a0203395e 100644 --- a/cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 +++ b/cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 @@ -7,7 +7,7 @@ module shr_ozone_coupling_mod 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 : s_logunit => shr_log_Unit + use shr_log_mod , only : shr_log_getLogUnit use shr_nl_mod , only : shr_nl_find_group_name use shr_mpi_mod , only : shr_mpi_bcast @@ -52,7 +52,7 @@ subroutine shr_ozone_coupling_readnl(NLFilename, atm_ozone_frequency_val) integer :: rc integer :: localpet integer :: mpicom - + integer :: s_logunit character(len=*), parameter :: atm_ozone_frequency_not_present = 'NOT_PRESENT' character(len=*), parameter :: subname = '(shr_ozone_coupling_readnl) ' ! ------------------------------------------------------------------ @@ -65,7 +65,7 @@ subroutine shr_ozone_coupling_readnl(NLFilename, atm_ozone_frequency_val) if ( len_trim(NLFilename) == 0 ) then call shr_sys_abort( subname//'ERROR: nlfilename not set' ) end if - + call shr_log_getLogUnit(s_logunit) call ESMF_VMGetCurrent(vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index e35ff537d..e253142a3 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -891,7 +891,7 @@ default: ocn - ogrid + xgrid From 28199a1ce9db7d99866518bf66b67f6b6475797b Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 1 Dec 2022 11:24:51 -0700 Subject: [PATCH 150/395] fix mapping for ocn-wav --- mediator/esmFldsExchange_nems_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 0d4f60369..084ab10dc 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -576,7 +576,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compocn) , trim(fldname), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav,compwav), trim(fldname), rc=rc)) then - call addmap_from(compwav, trim(fldname), compocn, mapbilnr_nstod, 'unset', 'unset') + call addmap_from(compwav, trim(fldname), compocn, mapbilnr_nstod, 'one', 'unset') call addmrg_to(compocn, trim(fldname), mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') end if end if From 28f335d296fe45835e7697a0885df08739a3d49c Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 5 Dec 2022 10:57:59 -0700 Subject: [PATCH 151/395] undo change to xgrid --- cime_config/namelist_definition_drv.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index e253142a3..e35ff537d 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -891,7 +891,7 @@ default: ocn - xgrid + ogrid From 243ffdb38ac7d6834ec41e9dfaf8df154ee933b9 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 6 Dec 2022 15:57:00 -0700 Subject: [PATCH 152/395] enable asyncio using pio --- cesm/driver/ensemble_driver.F90 | 164 ++++++++-- cesm/driver/esm.F90 | 9 +- cesm/driver/esm_time_mod.F90 | 269 ++++++++-------- cesm/nuopc_cap_share/driver_pio_mod.F90 | 350 ++++++++++++++++----- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 11 +- cime_config/config_component.xml | 24 ++ cime_config/namelist_definition_drv.xml | 36 +++ mediator/med.F90 | 57 ++-- 8 files changed, 656 insertions(+), 264 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index f5313f98f..d20554cac 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -16,6 +16,11 @@ module Ensemble_driver public :: SetServices private :: SetModelServices + private :: ensemble_finalize + + integer, allocatable :: asyncio_petlist(:) + logical :: asyncio_task=.false. + logical :: asyncIO_available=.false. character(*),parameter :: u_FILE_u = & __FILE__ @@ -26,9 +31,12 @@ module Ensemble_driver subroutine SetServices(ensemble_driver, rc) - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSpecialize + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSpecialize, NUOPC_CompAttributeSet + use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Driver , only : driver_routine_SS => SetServices use NUOPC_Driver , only : ensemble_label_SetModelServices => label_SetModelServices + use NUOPC_Driver , only : ensemble_label_PostChildrenAdvertise => label_PostChildrenAdvertise + use NUOPC_Driver , only : label_Finalize use ESMF , only : ESMF_GridComp, ESMF_GridCompSet use ESMF , only : ESMF_Config, ESMF_ConfigCreate, ESMF_ConfigLoadFile use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO @@ -38,6 +46,7 @@ subroutine SetServices(ensemble_driver, rc) ! local variables type(ESMF_Config) :: config + logical :: isPresent character(len=*), parameter :: subname = "(ensemble_driver.F90:SetServices)" !--------------------------------------- @@ -53,6 +62,14 @@ subroutine SetServices(ensemble_driver, rc) specRoutine=SetModelServices, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! ModifyCplLists is a NUOPC specialization which happens after Advertize but before Realize + ! We have overloaded this specialization location to initilize IO. + ! So after all components have called Advertise but before any component calls Realize + ! IO will be initialized and any async IO tasks will be split off to the PIO async IO driver. + call NUOPC_CompSpecialize(ensemble_driver, specLabel=ensemble_label_PostChildrenAdvertise, & + specRoutine=InitializeIO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Create, open and set the config config = ESMF_ConfigCreate(rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -63,6 +80,26 @@ subroutine SetServices(ensemble_driver, rc) call ESMF_GridCompSet(ensemble_driver, config=config, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! NUOPC component drivers end the initialization process with an internal call to InitializeDataResolution. + ! The ensemble_driver does not need to InitializeDataResolution and doing so will cause a hang + ! if asyncronous IO is used. This attribute is available after ESMF8.4.0b03 to toggle that control. + ! Cannot use asyncIO with older ESMF versions. + call NUOPC_CompAttributeGet(ensemble_driver, name="InitializeDataResolution", & + isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if(isPresent) then + call ESMF_LogWrite(trim(subname)//": setting InitializeDataResolution false", ESMF_LOGMSG_INFO) + call NUOPC_CompAttributeSet(ensemble_driver, name="InitializeDataResolution", value="false", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + asyncIO_available = .true. + call ESMF_LogWrite(trim(subname)//": asyncio is available", ESMF_LOGMSG_INFO) + endif + ! Set a finalize method, it calls pio_finalize + call NUOPC_CompSpecialize(ensemble_driver, specLabel=label_Finalize, & + specRoutine=ensemble_finalize, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine SetServices @@ -105,6 +142,13 @@ subroutine SetModelServices(ensemble_driver, rc) integer :: inst integer :: number_of_members integer :: ntasks_per_member + integer :: currentpet + integer :: iopetcnt + integer :: petcnt + logical :: comp_task + integer :: pio_asyncio_ntasks + integer :: pio_asyncio_stride + integer :: pio_asyncio_rootpe character(CL) :: start_type ! Type of startup character(len=7) :: drvrinst character(len=5) :: inst_suffix @@ -187,13 +231,25 @@ subroutine SetModelServices(ensemble_driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) number_of_members + call NUOPC_CompAttributeGet(ensemble_driver, name="pio_asyncio_ntasks", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) pio_asyncio_ntasks + + call NUOPC_CompAttributeGet(ensemble_driver, name="pio_asyncio_stride", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) pio_asyncio_stride + + call NUOPC_CompAttributeGet(ensemble_driver, name="pio_asyncio_rootpe", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) pio_asyncio_rootpe + call ESMF_VMGet(vm, localPet=localPet, PetCount=PetCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ntasks_per_member = PetCount/number_of_members - if(ntasks_per_member*number_of_members .ne. PetCount) then + ntasks_per_member = PetCount/number_of_members - pio_asyncio_ntasks + if(ntasks_per_member*number_of_members .ne. (PetCount - pio_asyncio_ntasks)) then write (msgstr,'(a,i5,a,i3,a,i3,a)') & - "PetCount (",PetCount,") must be evenly divisable by number of members (",number_of_members,")" + "PetCount - Async IOtasks (",PetCount-pio_asyncio_ntasks,") must be evenly divisable by number of members (",number_of_members,")" call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return endif @@ -203,23 +259,32 @@ subroutine SetModelServices(ensemble_driver, rc) !------------------------------------------- allocate(petList(ntasks_per_member)) - + allocate(asyncio_petlist(pio_asyncio_ntasks)) + currentpet = 0 + iopetcnt = 1 do inst=1,number_of_members - + petcnt=1 + comp_task = .false. ! Determine pet list for driver instance - petList(1) = (inst-1) * ntasks_per_member - do n=2,ntasks_per_member - petList(n) = petList(n-1) + 1 - enddo - + do n=1,ntasks_per_member+pio_asyncio_ntasks + if(pio_asyncio_stride == 0 .or. modulo(n,pio_asyncio_rootpe+1) .ne. 0) then + petList(petcnt) = currentpet + petcnt = petcnt+1 + if (currentpet == localPet) comp_task=.true. + else + asyncio_petlist(iopetcnt) = currentpet + iopetcnt = iopetcnt + 1 + if (currentpet == localPet) asyncio_task=.true. + endif + currentpet = currentpet + 1 + enddo ! Add driver instance to ensemble driver write(drvrinst,'(a,i4.4)') "ESM",inst - call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=gridcomptmp, rc=rc) + call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=driver, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (localpet >= petlist(1) .and. localpet <= petlist(ntasks_per_member)) then - - driver = gridcomptmp + mastertask = .false. + if (comp_task) then if(number_of_members > 1) then call NUOPC_CompAttributeAdd(driver, attrList=(/'inst_suffix'/), rc=rc) @@ -256,15 +321,13 @@ subroutine SetModelServices(ensemble_driver, rc) mastertask = .true. else logUnit = 6 - mastertask = .false. endif call shr_log_setLogUnit (logunit) - - ! Create a clock for each driver instance - call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif + ! Create a clock for each driver instance + call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo deallocate(petList) @@ -273,4 +336,63 @@ subroutine SetModelServices(ensemble_driver, rc) end subroutine SetModelServices + subroutine InitializeIO(ensemble_driver, rc) + use ESMF, only: ESMF_GridComp, ESMF_LOGMSG_INFO, ESMF_LogWrite + use ESMF, only: ESMF_SUCCESS, ESMF_VM, ESMF_GridCompGet, ESMF_VMGet + use ESMF, only: ESMF_CONFIG, ESMF_GridCompIsPetLocal, ESMF_State, ESMF_Clock + use NUOPC, only: NUOPC_CompAttributeGet, NUOPC_CompGet + use NUOPC_DRIVER, only: NUOPC_DriverGetComp + use driver_pio_mod , only: driver_pio_init, driver_pio_component_init + + type(ESMF_GridComp) :: ensemble_driver + type(ESMF_VM) :: ensemble_vm + integer, intent(out) :: rc + character(len=*), parameter :: subname = '('//__FILE__//':InitializeIO)' + type(ESMF_GridComp), pointer :: dcomp(:), ccomp(:) + integer :: iam + integer :: Global_Comm + integer :: drv, comp + character(len=8) :: compname + + rc = ESMF_SUCCESS + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + + call ESMF_GridCompGet(ensemble_driver, vm=ensemble_vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(ensemble_vm, localpet=iam, mpiCommunicator=Global_Comm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + nullify(dcomp) + call NUOPC_DriverGetComp(ensemble_driver, complist=dcomp, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do drv=1,size(dcomp) + if (ESMF_GridCompIsPetLocal(dcomp(drv), rc=rc) .or. asyncio_task) then + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompGet(dcomp(drv), name=compname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": call shr_pio_init "//compname, ESMF_LOGMSG_INFO) + call driver_pio_init(dcomp(drv), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": call shr_pio_component_init "//compname, ESMF_LOGMSG_INFO) + call driver_pio_component_init(dcomp(drv), Global_Comm, asyncio_petlist, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": shr_pio_component_init done "//compname, ESMF_LOGMSG_INFO) + endif + enddo + deallocate(asyncio_petlist) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + end subroutine InitializeIO + + subroutine ensemble_finalize(ensemble_driver, rc) + use ESMF, only : ESMF_GridComp, ESMF_SUCCESS + use driver_pio_mod, only: driver_pio_finalize + type(ESMF_GridComp) :: Ensemble_driver + integer, intent(out) :: rc + rc = ESMF_SUCCESS + call driver_pio_finalize() + + end subroutine ensemble_finalize end module Ensemble_driver diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index 3d0bb5a2b..73fc47637 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -806,7 +806,6 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) use mpi , only : MPI_COMM_NULL, mpi_comm_size #endif use mct_mod , only : mct_world_init - use driver_pio_mod , only : driver_pio_init, driver_pio_component_init #ifdef MED_PRESENT use med_internalstate_mod , only : med_id @@ -932,8 +931,8 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) ! Initialize PIO ! This reads in the pio parameters that are independent of component - call driver_pio_init(driver, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return +! call driver_pio_init(driver, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(comms(componentCount+1), comps(componentCount+1)) comps(1) = 1 @@ -1180,8 +1179,8 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) enddo ! Read in component dependent PIO parameters and initialize ! IO systems - call driver_pio_component_init(driver, size(comps), rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return +! call driver_pio_component_init(driver, size(comps), rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return ! Initialize MCT (this is needed for data models and cice prescribed capability) call mct_world_init(componentCount+1, GLOBAL_COMM, comms, comps) diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index 337b7bc56..dbfbc57be 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -11,7 +11,8 @@ module esm_time_mod use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_LOGMSG_ERROR use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast - use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE + use ESMF , only : ESMF_VMAllReduce, ESMF_REDUCE_MAX + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_GridCompIsPetLocal use ESMF , only : operator(<), operator(/=), operator(+) use ESMF , only : operator(-), operator(*) , operator(>=) use ESMF , only : operator(<=), operator(>), operator(==) @@ -62,7 +63,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert ! local variables type(ESMF_Clock) :: clock - type(ESMF_VM) :: vm + type(ESMF_VM) :: vm, envm type(ESMF_Time) :: StartTime ! Start time type(ESMF_Time) :: RefTime ! Reference time type(ESMF_Time) :: CurrTime ! Current time @@ -101,99 +102,162 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert character(CL) :: tmpstr ! temporary character(CS) :: inst_suffix integer :: tmp(4) ! Array for Broadcast + integer :: myid, bcastID(2) logical :: isPresent - character(len=*), parameter :: subname = '(esm_time_clockInit): ' + logical :: inDriver + logical, save :: firsttime=.true. + character(len=*), parameter :: subname = '('//__FILE__//':esm_time_clockInit) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - - call ESMF_GridCompGet(instance_driver, vm=vm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) !--------------------------------------------------------------------------- ! Determine start time, reference time and current time !--------------------------------------------------------------------------- - call NUOPC_CompAttributeGet(instance_driver, name="start_ymd", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="start_ymd", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) start_ymd - call NUOPC_CompAttributeGet(instance_driver, name="start_tod", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="start_tod", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) start_tod - call NUOPC_CompAttributeGet(instance_driver, name='read_restart', value=cvalue, rc=rc) + !--------------------------------------------------------------------------- + ! Determine driver clock timestep + !--------------------------------------------------------------------------- + + call NUOPC_CompAttributeGet(ensemble_driver, name="atm_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) atm_cpl_dt + + call NUOPC_CompAttributeGet(ensemble_driver, name="lnd_cpl_dt", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) read_restart + read(cvalue,*) lnd_cpl_dt - if (read_restart) then + call NUOPC_CompAttributeGet(ensemble_driver, name="ice_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ice_cpl_dt - call NUOPC_CompAttributeGet(instance_driver, name='drv_restart_pointer', value=restart_file, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(ensemble_driver, name="ocn_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ocn_cpl_dt + + call NUOPC_CompAttributeGet(ensemble_driver, name="glc_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) glc_cpl_dt + + call NUOPC_CompAttributeGet(ensemble_driver, name="rof_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) rof_cpl_dt + + call NUOPC_CompAttributeGet(ensemble_driver, name="wav_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) wav_cpl_dt + + call NUOPC_CompAttributeGet(ensemble_driver, name="glc_avg_period", value=glc_avg_period, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) glc_avg_period - if (trim(restart_file) /= 'none') then + dtime_drv = minval((/atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt/)) + if(mastertask) then + write(tmpstr,'(i10)') dtime_drv + call ESMF_LogWrite(trim(subname)//': driver time interval is : '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + write(logunit,*) trim(subname)//': driver time interval is : '// trim(tmpstr) + endif + call ESMF_GridCompGet(ensemble_driver, vm=envm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(envm, localPet=myid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + indriver = ESMF_GridCompIsPetLocal(instance_driver, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", isPresent=isPresent, rc=rc) + if(indriver) then + call ESMF_GridCompGet(instance_driver, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(instance_driver, name='read_restart', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) read_restart + + if (read_restart) then + + call NUOPC_CompAttributeGet(instance_driver, name='drv_restart_pointer', value=restart_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(isPresent) then - call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", value=inst_suffix, rc=rc) + + if (trim(restart_file) /= 'none') then + + call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - inst_suffix = "" - endif - - restart_pfile = trim(restart_file)//inst_suffix - - if (mastertask) then - call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & - ESMF_LOGMSG_INFO) - open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) - if (ierr < 0) then - rc = ESMF_FAILURE - call ESMF_LogWrite(trim(subname)//' ERROR rpointer file open returns error', & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) - return - end if - read(unitn,'(a)', iostat=ierr) restart_file - if (ierr < 0) then - rc = ESMF_FAILURE - call ESMF_LogWrite(trim(subname)//' ERROR rpointer file read returns error', & - ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) - return - end if - close(unitn) + if(isPresent) then + call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", value=inst_suffix, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + inst_suffix = "" + endif + + restart_pfile = trim(restart_file)//inst_suffix + if (mastertask) then - write(logunit,'(a)') trim(subname)//" reading driver restart from file = "//trim(restart_file) - end if - call esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & + ESMF_LOGMSG_INFO) + open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) + if (ierr < 0) then + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//' ERROR rpointer file open returns error', & + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) + return + end if + read(unitn,'(a)', iostat=ierr) restart_file + if (ierr < 0) then + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//' ERROR rpointer file read returns error', & + ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) + return + end if + close(unitn) + if (mastertask) then + write(logunit,'(a)') trim(subname)//" reading driver restart from file = "//trim(restart_file) + end if + call esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + endif - tmp(1) = start_ymd ; tmp(2) = start_tod - tmp(3) = curr_ymd ; tmp(4) = curr_tod - endif + else - call ESMF_VMBroadcast(vm, tmp, 4, 0, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - start_ymd = tmp(1) ; start_tod = tmp(2) - curr_ymd = tmp(3) ; curr_tod = tmp(4) + if (mastertask) then + write(logunit,*) ' NOTE: the current compset has no mediator - which provides the clock restart information' + write(logunit,*) ' In this case the restarts are handled solely by the component being used and' + write(logunit,*) ' and the driver clock will always be starting from the initial date on restart' + end if + curr_ymd = start_ymd + curr_tod = start_tod + + end if else - if (mastertask) then - write(logunit,*) ' NOTE: the current compset has no mediator - which provides the clock restart information' - write(logunit,*) ' In this case the restarts are handled solely by the component being used and' - write(logunit,*) ' and the driver clock will always be starting from the initial date on restart' - end if curr_ymd = start_ymd curr_tod = start_tod - end if - + end if ! end if read_restart + endif + if(mastertask) then + bcastID(1) = myid + tmp(1) = start_ymd ; tmp(2) = start_tod + tmp(3) = curr_ymd ; tmp(4) = curr_tod else + bcastID(1) = 0 + tmp = 0 + endif + call ESMF_VMAllReduce(envm, bcastID(1:1), bcastID(2:2), 1, ESMF_REDUCE_MAX,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - curr_ymd = start_ymd - curr_tod = start_tod - - end if ! end if read_restart + call ESMF_VMBroadcast(envm, tmp, 4, bcastID(2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + start_ymd = tmp(1) ; start_tod = tmp(2) + curr_ymd = tmp(3) ; curr_tod = tmp(4) ! Determine start time (THE FOLLOWING ASSUMES THAT THE DEFAULT CALENDAR IS SET in the driver) @@ -214,7 +278,6 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert call esm_time_date2ymd(curr_ymd, yr, mon, day) call ESMF_TimeSet( CurrTime, yy=yr, mm=mon, dd=day, s=curr_tod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(mastertask) then write(tmpstr,'(i10)') curr_ymd call ESMF_LogWrite(trim(subname)//': driver curr_ymd: '// trim(tmpstr), ESMF_LOGMSG_INFO) @@ -223,56 +286,12 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert call ESMF_LogWrite(trim(subname)//': driver curr_tod: '// trim(tmpstr), ESMF_LOGMSG_INFO) write(logunit,*) trim(subname)//': driver curr_tod: '// trim(tmpstr) endif - ! Set reference time - HARD-CODED TO START TIME ref_ymd = start_ymd ref_tod = start_tod call esm_time_date2ymd(ref_ymd, yr, mon, day) call ESMF_TimeSet( RefTime, yy=yr, mm=mon, dd=day, s=ref_tod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !--------------------------------------------------------------------------- - ! Determine driver clock timestep - !--------------------------------------------------------------------------- - - call NUOPC_CompAttributeGet(instance_driver, name="atm_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) atm_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="lnd_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) lnd_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="ice_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ice_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="ocn_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ocn_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="glc_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="rof_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) rof_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="wav_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) wav_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="glc_avg_period", value=glc_avg_period, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_avg_period - - dtime_drv = minval((/atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt/)) - if(mastertask) then - write(tmpstr,'(i10)') dtime_drv - call ESMF_LogWrite(trim(subname)//': driver time interval is : '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - write(logunit,*) trim(subname)//': driver time interval is : '// trim(tmpstr) - endif call ESMF_TimeIntervalSet( TimeStep, s=dtime_drv, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -294,20 +313,22 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert if (ChkErr(rc,__LINE__,u_FILE_u)) return end do - ! Set the ensemble driver gridded component clock to the created clock - call ESMF_GridCompSet(instance_driver, clock=clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Set the driver gridded component clock to the created clock + if (indriver) then + call ESMF_GridCompSet(instance_driver, clock=clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif ! Set driver clock stop time - call NUOPC_CompAttributeGet(instance_driver, name="stop_option", value=stop_option, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="stop_option", value=stop_option, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(instance_driver, name="stop_n", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="stop_n", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_n - call NUOPC_CompAttributeGet(instance_driver, name="stop_ymd", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="stop_ymd", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_ymd - call NUOPC_CompAttributeGet(instance_driver, name="stop_tod", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="stop_tod", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_tod if ( stop_ymd < 0) then @@ -342,17 +363,17 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert !--------------------------------------------------------------------------- ! Create the ensemble driver clock - ! TODO: this is done repeatedly - but only needs to be done the first time this is called !--------------------------------------------------------------------------- + if(firsttime) then + TimeStep = StopTime - ClockTime + clock = ESMF_ClockCreate(TimeStep, ClockTime, StopTime=StopTime, & + refTime=RefTime, name='ESMF ensemble Driver Clock', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - TimeStep = StopTime - ClockTime - clock = ESMF_ClockCreate(TimeStep, ClockTime, StopTime=StopTime, & - refTime=RefTime, name='ESMF ensemble Driver Clock', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_GridCompSet(ensemble_driver, clock=clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - + call ESMF_GridCompSet(ensemble_driver, clock=clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + firsttime = .false. + endif end subroutine esm_time_clockInit !=============================================================================== diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index 42d301221..86ea0428c 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -1,5 +1,9 @@ module driver_pio_mod - use pio + use pio , only : pio_offset_kind, pio_rearr_opt_t, PIO_REARR_COMM_UNLIMITED_PEND_REQ + use pio , only : pio_iotype_netcdf, pio_iotype_pnetcdf, pio_iotype_netcdf4c, pio_iotype_netcdf4p + use pio , only : iosystem_desc_t, PIO_64BIT_DATA, PIO_64BIT_OFFSET, PIO_REARR_COMM_COLL + use pio , only : PIO_REARR_COMM_P2P, pio_init, pio_set_log_level + use pio , only : pio_set_blocksize, pio_set_buffer_size_limit, pio_finalize use shr_pio_mod, only : io_compname, pio_comp_settings, iosystems, io_compid, shr_pio_getindex use shr_kind_mod, only : CS=>shr_kind_CS, shr_kind_cl, shr_kind_in use shr_log_mod, only : shr_log_unit @@ -24,7 +28,7 @@ module driver_pio_mod integer(kind=pio_offset_kind) :: pio_buffer_size_limit=-1 type(pio_rearr_opt_t) :: pio_rearr_opts - logical, allocatable :: pio_async_interface(:) + logical :: pio_async_interface integer :: total_comps logical :: mastertask @@ -168,77 +172,140 @@ subroutine driver_pio_init(driver, rc) end subroutine driver_pio_init - subroutine driver_pio_component_init(driver, ncomps, rc) + subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) use ESMF, only : ESMF_GridComp, ESMF_LogSetError, ESMF_RC_NOT_VALID, ESMF_GridCompIsCreated, ESMF_VM, ESMF_VMGet - use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated + use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated, ESMF_Finalize, ESMF_PtrInt1D + use ESMF, only : ESMF_LOGMSG_INFO, ESMF_LOGWRITE use NUOPC, only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use NUOPC_Driver, only : NUOPC_DriverGetComp + use mpi, only : MPI_INTEGER, MPI_MAX, MPI_IN_PLACE, MPI_LOR, MPI_LOGICAL type(ESMF_GridComp) :: driver - type(ESMF_VM) :: vm - integer, intent(in) :: ncomps + integer, intent(in) :: Global_COMM ! The communicator associated with the ensemble_driver + integer, intent(in) :: asyncio_petlist(:) integer, intent(out) :: rc + type(ESMF_VM) :: vm integer :: i, npets, default_stride - integer :: j + integer :: j, myid + integer :: k integer :: comp_comm, comp_rank + integer, allocatable :: procs_per_comp(:), async_procs_per_comp(:) + integer, allocatable :: io_proc_list(:), asyncio_tasks(:), comp_proc_list(:,:) + type(ESMF_GridComp), pointer :: gcomp(:) character(CS) :: cval character(CS) :: msgstr integer :: do_async_init + integer :: totalpes + integer :: asyncio_ntasks + integer :: asyncio_stride + integer :: pecnt + integer :: ierr + integer :: iocomm + integer :: ncomps + integer :: async_rearr + integer :: driverpecount, driver_myid + integer, allocatable :: driverpetlist(:) + integer, allocatable :: asyncio_comp_comm(:) + integer :: logunit + logical :: asyncio_task + logical, allocatable :: petlocal(:) type(iosystem_desc_t), allocatable :: async_iosystems(:) + character(len=*), parameter :: subname = '('//__FILE__//':shr_pio_component_init)' - allocate(pio_comp_settings(ncomps)) - allocate(gcomp(ncomps)) + asyncio_ntasks = size(asyncio_petlist) - allocate(io_compid(ncomps)) - allocate(io_compname(ncomps)) - allocate(iosystems(ncomps)) - - allocate(pio_async_interface(ncomps)) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call MPI_Comm_rank(global_comm, myid, rc) + call MPI_Comm_size(global_comm, totalpes, rc) + asyncio_task=.false. + do i=1,asyncio_ntasks + if(myid == asyncio_petlist(i)) then + asyncio_task = .true. + exit + endif + enddo nullify(gcomp) - do_async_init = 0 - call NUOPC_DriverGetComp(driver, compList=gcomp, rc=rc) + if (asyncio_task) then + driverpecount = 0 + else + call ESMF_GridCompGet(gridcomp=driver, vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_DriverGetComp(driver, compList=gcomp, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=driver_myid, petcount=driverpecount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + + if(associated(gcomp)) then + total_comps = size(gcomp) + else + total_comps = 0 + endif + + call ESMF_LogWrite(trim(subname)//": share total_comps and driverpecount", ESMF_LOGMSG_INFO) if (chkerr(rc,__LINE__,u_FILE_u)) return - total_comps = size(gcomp) - + call MPI_AllReduce(MPI_IN_PLACE, total_comps, 1, MPI_INTEGER, & + MPI_MAX, Global_comm, rc) + call MPI_AllReduce(MPI_IN_PLACE, driverpecount, 1, MPI_INTEGER, & + MPI_MAX, Global_comm, rc) + allocate(pio_comp_settings(total_comps)) + allocate(procs_per_comp(total_comps)) + allocate(io_compid(total_comps)) + allocate(io_compname(total_comps)) + allocate(iosystems(total_comps)) + allocate(petlocal(total_comps)) + do_async_init = 0 + procs_per_comp = 0 + do i=1,total_comps + if(associated(gcomp)) then + petlocal(i) = ESMF_GridCompIsPetLocal(gcomp(i), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + petlocal(i) = .false. + endif + pio_comp_settings(i)%pio_async_interface = .false. io_compid(i) = i+1 - - if (ESMF_GridCompIsPetLocal(gcomp(i), rc=rc)) then + if (petlocal(i)) then call ESMF_GridCompGet(gcomp(i), vm=vm, name=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + call ESMF_LogWrite(trim(subname)//": initialize component: "//trim(cval), ESMF_LOGMSG_INFO) io_compname(i) = trim(cval) - call NUOPC_CompAttributeAdd(gcomp(i), attrList=(/'MCTID'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + write(cval, *) io_compid(i) call NUOPC_CompAttributeSet(gcomp(i), name="MCTID", value=trim(cval), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, mpiCommunicator=comp_comm, rc=rc) + call ESMF_VMGet(vm, mpiCommunicator=comp_comm, localPet=comp_rank, petCount=npets, & + ssiLocalPetCount=default_stride, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - if(comp_comm .ne. MPI_COMM_NULL) then - call ESMF_VMGet(vm, petCount=npets, localPet=comp_rank, ssiLocalPetCount=default_stride, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + procs_per_comp(i) = npets + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + pio_comp_settings(i)%pio_async_interface = (trim(cval) == '.true.') + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_rearranger", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_rearranger + if(.not. pio_comp_settings(i)%pio_async_interface) then call NUOPC_CompAttributeGet(gcomp(i), name="pio_stride", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cval, *) pio_comp_settings(i)%pio_stride if(pio_comp_settings(i)%pio_stride <= 0 .or. pio_comp_settings(i)%pio_stride > npets) then pio_comp_settings(i)%pio_stride = min(npets, default_stride) endif - - call NUOPC_CompAttributeGet(gcomp(i), name="pio_rearranger", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_rearranger - + call NUOPC_CompAttributeGet(gcomp(i), name="pio_numiotasks", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cval, *) pio_comp_settings(i)%pio_numiotasks @@ -247,84 +314,198 @@ subroutine driver_pio_component_init(driver, ncomps, rc) pio_comp_settings(i)%pio_numiotasks = max(1,npets/pio_comp_settings(i)%pio_stride) endif + call NUOPC_CompAttributeGet(gcomp(i), name="pio_root", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cval, *) pio_comp_settings(i)%pio_root - + if(pio_comp_settings(i)%pio_root < 0 .or. pio_comp_settings(i)%pio_root > npets) then pio_comp_settings(i)%pio_root = 0 endif + endif - call NUOPC_CompAttributeGet(gcomp(i), name="pio_typename", value=cval, rc=rc) + call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + pio_comp_settings(i)%pio_async_interface = (trim(cval) == '.true.') + if(.not. pio_comp_settings(i)%pio_async_interface) then + call NUOPC_CompAttributeGet(gcomp(i), name="pio_stride", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - select case (trim(cval)) - case ('pnetcdf') - pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_PNETCDF - case ('netcdf') - pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF - case ('netcdf4p') - pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF4P - case ('netcdf4c') - pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF4C - case DEFAULT - write (msgstr, *) "Invalid PIO_TYPENAME Setting for component ", trim(cval) - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) - return - end select - - call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) + read(cval, *) pio_comp_settings(i)%pio_stride + if(pio_comp_settings(i)%pio_stride <= 0 .or. pio_comp_settings(i)%pio_stride > npets) then + pio_comp_settings(i)%pio_stride = min(npets, default_stride) + endif + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_numiotasks", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_async_interface(i) = (trim(cval) == '.true.') - - call NUOPC_CompAttributeGet(gcomp(i), name="pio_netcdf_format", value=cval, rc=rc) + read(cval, *) pio_comp_settings(i)%pio_numiotasks + + if(pio_comp_settings(i)%pio_numiotasks < 0 .or. pio_comp_settings(i)%pio_numiotasks > npets) then + pio_comp_settings(i)%pio_numiotasks = max(1,npets/pio_comp_settings(i)%pio_stride) + endif + + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_root", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call driver_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) - - if (pio_async_interface(i)) then - do_async_init = do_async_init + 1 - else - if(pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then - pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req = pio_comp_settings(i)%pio_numiotasks - endif - if(pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then - pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req = pio_comp_settings(i)%pio_numiotasks - endif - call pio_init(comp_rank ,comp_comm ,pio_comp_settings(i)%pio_numiotasks, 0, pio_comp_settings(i)%pio_stride, & - pio_comp_settings(i)%pio_rearranger, iosystems(i), pio_comp_settings(i)%pio_root, & - pio_rearr_opts) + read(cval, *) pio_comp_settings(i)%pio_root + + if(pio_comp_settings(i)%pio_root < 0 .or. pio_comp_settings(i)%pio_root > npets) then + pio_comp_settings(i)%pio_root = 0 + endif + endif + call NUOPC_CompAttributeGet(gcomp(i), name="pio_typename", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + select case (trim(cval)) + case ('pnetcdf') + pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_PNETCDF + case ('netcdf') + pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF + case ('netcdf4p') + pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF4P + case ('netcdf4c') + pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF4C + case DEFAULT + write (msgstr, *) "Invalid PIO_TYPENAME Setting for component ", trim(cval) + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return + end select + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_netcdf_format", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call driver_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) + + if (.not. pio_comp_settings(i)%pio_async_interface) then + if(pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req = pio_comp_settings(i)%pio_numiotasks + endif + if(pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req = pio_comp_settings(i)%pio_numiotasks endif + call pio_init(comp_rank ,comp_comm ,pio_comp_settings(i)%pio_numiotasks, 0, pio_comp_settings(i)%pio_stride, & + pio_comp_settings(i)%pio_rearranger, iosystems(i), pio_comp_settings(i)%pio_root, & + pio_rearr_opts) endif + ! Write the PIO settings to the beggining of each component log + if(comp_rank == 0) call driver_pio_log_comp_settings(gcomp(i), logunit, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + endif + enddo + + call ESMF_LogWrite(trim(subname)//": check for async", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do i=1,total_comps + call MPI_AllReduce(MPI_IN_PLACE, pio_comp_settings(i)%pio_async_interface, 1, MPI_LOGICAL, & + MPI_LOR, global_comm, rc) + if(pio_comp_settings(i)%pio_async_interface) then + do_async_init = do_async_init + 1 endif enddo + +! +! Get the PET list for each component using async IO +! + + call MPI_Allreduce(MPI_IN_PLACE, do_async_init, 1, MPI_INTEGER, MPI_MAX, Global_comm, ierr) + call MPI_Allreduce(MPI_IN_PLACE, procs_per_comp, total_comps, MPI_INTEGER, MPI_MAX, Global_comm, ierr) + if (do_async_init > 0) then + allocate(asyncio_comp_comm(do_async_init)) + allocate(comp_proc_list(driverpecount, do_async_init)) + j = 1 + k = 1 + comp_proc_list = -1 + if(.not. asyncio_task) then + do i=1,total_comps + if(pio_comp_settings(i)%pio_async_interface) then + if(petlocal(i)) comp_proc_list(1+driver_myid,j) = myid + do k=1,size(asyncio_petlist) + if(comp_proc_list(1+driver_myid, j) == asyncio_petlist(k)) then + call shr_sys_abort(subname//' ERROR: OVERLAP with asyncio_petlist') + endif + enddo + j = j+1 + endif + enddo + endif + call MPI_AllReduce(MPI_IN_PLACE, comp_proc_list, driverpecount*do_async_init, MPI_INTEGER, MPI_MAX, Global_comm, ierr) + if(asyncio_ntasks == 0) then + call shr_sys_abort(subname//' ERROR: ASYNC IO Requested but no IO PES assigned') + endif + + do i=1,do_async_init + do j=1,driverpecount + if(comp_proc_list(j,i) == -1) then + do k=j+1,driverpecount + if(comp_proc_list(k,i) >= 0) then + comp_proc_list(j,i) = comp_proc_list(k,i) + comp_proc_list(k,i) = -1 + exit + endif + enddo + endif + enddo + enddo + allocate(async_iosystems(do_async_init)) + allocate(async_procs_per_comp(do_async_init)) j=1 + async_rearr = 0 do i=1,total_comps - if(pio_async_interface(i)) then - iosystems(i) = async_iosystems(j) + if(pio_comp_settings(i)%pio_async_interface) then + async_procs_per_comp(j) = procs_per_comp(i) j = j+1 + if(.not.asyncio_task) then + if(async_rearr == 0) then + async_rearr = pio_comp_settings(i)%pio_rearranger + elseif(async_rearr .ne. pio_comp_settings(i)%pio_rearranger) then + + call shr_sys_abort(subname//' ERROR: all async component rearrangers must match') + endif + endif endif enddo + ! IO tasks should not return until the run is completed + !ierr = pio_set_log_level(3) + + call ESMF_LogWrite(trim(subname)//": call async pio_init", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call MPI_AllReduce(MPI_IN_PLACE, async_rearr, 1, MPI_INTEGER, & + MPI_MAX, Global_comm, rc) + + call pio_init(async_iosystems, Global_comm, async_procs_per_comp, & + comp_proc_list, asyncio_petlist, & + async_rearr, asyncio_comp_comm, io_comm) + if(.not. asyncio_task) then + j=1 + do i=1,total_comps + if(pio_comp_settings(i)%pio_async_interface) then + iosystems(i) = async_iosystems(j) + j = j+1 + endif + enddo + endif endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - deallocate(gcomp) + if(associated(gcomp)) deallocate(gcomp) end subroutine driver_pio_component_init - subroutine driver_pio_log_comp_settings(gcomp, logunit) - use ESMF, only : ESMF_GridComp, ESMF_GridCompGet + subroutine driver_pio_log_comp_settings(gcomp, logunit, rc) + use ESMF, only : ESMF_GridComp, ESMF_GridCompGet, ESMF_SUCCESS use NUOPC, only: NUOPC_CompAttributeGet type(ESMF_GridComp) :: gcomp integer, intent(in) :: logunit - + integer, intent(out) :: rc integer :: compid character(len=CS) :: name, cval integer :: i - integer :: rc logical :: isPresent + rc = ESMF_SUCCESS call ESMF_GridCompGet(gcomp, name=name, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -335,13 +516,14 @@ subroutine driver_pio_log_comp_settings(gcomp, logunit) read(cval, *) compid i = shr_pio_getindex(compid) endif - write(logunit,*) trim(name),': PIO numiotasks=', pio_comp_settings(i)%pio_numiotasks - - write(logunit, *) trim(name), ': PIO stride=',pio_comp_settings(i)%pio_stride - - write(logunit, *) trim(name),': PIO rearranger=',pio_comp_settings(i)%pio_rearranger - - write(logunit, *) trim(name),': PIO root=',pio_comp_settings(i)%pio_root + if(pio_comp_settings(i)%pio_async_interface) then + write(logunit,*) trim(name),': using ASYNC IO interface' + else + write(logunit,*) trim(name),': PIO numiotasks=', pio_comp_settings(i)%pio_numiotasks + write(logunit, *) trim(name), ': PIO stride=',pio_comp_settings(i)%pio_stride + write(logunit, *) trim(name),': PIO rearranger=',pio_comp_settings(i)%pio_rearranger + write(logunit, *) trim(name),': PIO root=',pio_comp_settings(i)%pio_root + endif end subroutine driver_pio_log_comp_settings @@ -349,7 +531,7 @@ end subroutine driver_pio_log_comp_settings subroutine driver_pio_finalize( ) integer :: ierr integer :: i - do i=1,total_comps + do i=1,size(iosystems) call pio_finalize(iosystems(i), ierr) end do diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index 0ed53f22b..77b7546bf 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -145,6 +145,8 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) character(len=CL) :: logfile character(len=CL) :: inst_suffix integer :: inst_index ! not used here + character(len=CL) :: name + character(len=*), parameter :: subname = "("//__FILE__//": set_component_logging)" !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -162,15 +164,18 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) endif open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) - ! Write the PIO settings to the beggining of each component log - call driver_pio_log_comp_settings(gcomp, logunit) else logUnit = 6 endif - shrlogunit = logunit + + call ESMF_GridCompGet(gcomp, name=name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": setting logunit for component: "//trim(name), ESMF_LOGMSG_INFO) call shr_log_setLogUnit (logunit) + call ESMF_LogWrite(trim(subname)//": done for component "//trim(name), ESMF_LOGMSG_INFO) end subroutine set_component_logging diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 923e9afa8..49eb08d33 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -2023,6 +2023,30 @@ pio blocksize for box decompositions + + integer + 0 + run_pio + env_mach_pes.xml + Task count for asyncronous IO, only valid if PIO_ASYNC_INTERFACE is True + + + + integer + 0 + run_pio + env_mach_pes.xml + Stride of tasks for asyncronous IO, only valid if PIO_ASYNC_INTERFACE is True + + + + integer + 1 + run_pio + env_mach_pes.xml + RootPE of tasks for asyncronous IO, only valid if PIO_ASYNC_INTERFACE is True + + integer -1 diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index e35ff537d..9f78dd3c3 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -36,6 +36,42 @@ + + integer + pio + PELAYOUT_attributes + + IO tasks FOR ASYNC IO, only valid if ASYNCIO is true. + + + $PIO_ASYNCIO_NTASKS + + + + + integer + pio + PELAYOUT_attributes + + IO task stride FOR ASYNC IO, only valid if ASYNCIO is true. + + + $PIO_ASYNCIO_STRIDE + + + + + integer + pio + PELAYOUT_attributes + + IO rootpe task FOR ASYNC IO, only valid if ASYNCIO is true. + + + $PIO_ASYNCIO_ROOTPE + + + char expdef diff --git a/mediator/med.F90 b/mediator/med.F90 index 352cf0c4d..867c6d056 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -59,10 +59,10 @@ module MED public SetServices public SetVM private InitializeP0 - private InitializeIPDv03p1 ! advertise fields - private InitializeIPDv03p3 ! realize connected Fields with transfer action "provide" - private InitializeIPDv03p4 ! optionally modify the decomp/distr of transferred Grid/Mesh - private InitializeIPDv03p5 ! realize all Fields with transfer action "accept" + private AdvertiseFields ! advertise fields + private RealizeFieldsWithTransferProvided ! realize connected Fields with transfer action "provide" + private ModifyDecompofMesh ! optionally modify the decomp/distr of transferred Grid/Mesh + private RealizeFieldsWithTransferAccept ! realize all Fields with transfer action "accept" private DataInitialize ! finish initialization and resolve data dependencies private SetRunClock private med_meshinfo_create @@ -129,7 +129,7 @@ subroutine SetServices(gcomp, rc) integer, intent(out) :: rc ! local variables - character(len=*),parameter :: subname=' (SetServices) ' + character(len=*), parameter :: subname = '('//__FILE__//':SetServices)' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -161,7 +161,7 @@ subroutine SetServices(gcomp, rc) ! The valid values are: [will provide, can provide, cannot provide] call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeIPDv03p1, rc=rc) + phaseLabelList=(/"IPDv03p1"/), userRoutine=AdvertiseFields, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ @@ -169,7 +169,7 @@ subroutine SetServices(gcomp, rc) !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p3"/), userRoutine=InitializeIPDv03p3, rc=rc) + phaseLabelList=(/"IPDv03p3"/), userRoutine=RealizeFieldsWithTransferProvided, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ @@ -177,7 +177,7 @@ subroutine SetServices(gcomp, rc) !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p4"/), userRoutine=InitializeIPDv03p4, rc=rc) + phaseLabelList=(/"IPDv03p4"/), userRoutine=ModifyDecompofMesh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ @@ -185,7 +185,7 @@ subroutine SetServices(gcomp, rc) !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p5"/), userRoutine=InitializeIPDv03p5, rc=rc) + phaseLabelList=(/"IPDv03p5"/), userRoutine=RealizeFieldsWithTransferAccept, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ @@ -568,10 +568,12 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) character(len=CX) :: logfile character(len=CX) :: diagfile character(len=CX) :: do_budgets - character(len=*),parameter :: subname=' (InitializeP0) ' + character(len=*), parameter :: subname = '('//__FILE__//':InitializeP0)' !----------------------------------------------------------- rc = ESMF_SUCCESS + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + if (profile_memory) call ESMF_VMLogMemInfo("Entering "//trim(subname)) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -647,7 +649,7 @@ end subroutine InitializeP0 !----------------------------------------------------------------------- - subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) + subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) ! Mediator advertises its import and export Fields and sets the ! TransferOfferGeomObject Attribute. @@ -679,7 +681,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) type(med_fldlist_type), pointer :: fldListFr, fldListTo type(med_fldList_entry_type), pointer :: fld integer :: stat - character(len=*),parameter :: subname=' (Advertise Fields) ' + character(len=*), parameter :: subname = '('//__FILE__//':AdvertiseFields)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -919,11 +921,11 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - end subroutine InitializeIPDv03p1 + end subroutine AdvertiseFields !----------------------------------------------------------------------------- - subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) + subroutine RealizeFieldsWithTransferProvided(gcomp, importState, exportState, clock, rc) ! Realize connected Fields with transfer action "provide" @@ -943,7 +945,7 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) type(InternalState) :: is_local type(ESMF_VM) :: vm integer :: n - character(len=*),parameter :: subname=' (Realize Fields with Transfer Provide) ' + character(len=*), parameter :: subname = '('//__FILE__//':RealizeFieldsWithTransferProvided)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -983,11 +985,11 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - end subroutine InitializeIPDv03p3 + end subroutine RealizeFieldsWithTransferProvided !----------------------------------------------------------------------------- - subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) + subroutine ModifyDecompofMesh(gcomp, importState, exportState, clock, rc) ! Optionally modify the decomp/distr of transferred Grid/Mesh @@ -1004,7 +1006,7 @@ subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) ! local variables type(InternalState) :: is_local integer :: n1,n2 - character(len=*),parameter :: subname=' (Modify Decomp of Mesh/Grid) ' + character(len=*), parameter :: subname = '('//__FILE__//':ModifyDecompofMesh)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1303,11 +1305,11 @@ subroutine realizeConnectedGrid(State,string,rc) end subroutine realizeConnectedGrid - end subroutine InitializeIPDv03p4 + end subroutine ModifyDecompofMesh !----------------------------------------------------------------------------- - subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) + subroutine RealizeFieldsWithTransferAccept(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_LogWrite use ESMF , only : ESMF_SUCCESS, ESMF_LOGMSG_INFO, ESMF_StateIsCreated @@ -1332,7 +1334,8 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) ! local variables type(InternalState) :: is_local integer :: n1,n2 - character(len=*),parameter :: subname=' (Realize Fields with Transfer Accept) ' + + character(len=*), parameter :: subname = '('//__FILE__//':RealizeFieldsWithTransferAccept)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1404,7 +1407,7 @@ subroutine completeFieldInitialization(State,rc) integer, allocatable :: ungriddedLBound(:), ungriddedUBound(:) logical :: isPresent logical :: meshcreated - character(len=*),parameter :: subname=' (Complete Field Initialization) ' + character(len=*), parameter :: subname = '('//__FILE__//':completeFieldInitialization)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1514,7 +1517,7 @@ subroutine completeFieldInitialization(State,rc) end subroutine completeFieldInitialization - end subroutine InitializeIPDv03p5 + end subroutine RealizeFieldsWithTransferAccept !----------------------------------------------------------------------------- @@ -1601,7 +1604,7 @@ subroutine DataInitialize(gcomp, rc) logical,save :: first_call = .true. real(r8) :: real_nx, real_ny character(len=CX) :: msgString - character(len=*), parameter :: subname=' (Data Initialization) ' + character(len=*), parameter :: subname = '('//__FILE__//':DataInitialize)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -2209,8 +2212,8 @@ subroutine SetRunClock(gcomp, rc) logical :: first_time = .true. logical, save :: stopalarmcreated=.false. integer :: alarmcount + character(len=*), parameter :: subname = '('//__FILE__//':SetRunClock)' - character(len=*),parameter :: subname=' (Set Run Clock) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -2295,7 +2298,7 @@ subroutine med_meshinfo_create(FB, mesh_info, FBArea, rc) real(r8), allocatable :: ownedElemCoords(:) real(r8), pointer :: dataptr(:) integer :: n, dimcount, fieldcount - character(len=*),parameter :: subname=' (module_MED:med_meshinfo_create) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_meshinfo_create)' !------------------------------------------------------------------------------- rc= ESMF_SUCCESS @@ -2368,7 +2371,7 @@ subroutine med_grid_write(grid, fileName, rc) type(ESMF_ArrayBundle) :: arrayBundle integer :: tileCount logical :: isPresent - character(len=*), parameter :: subname=' (Grid Write) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_grid_write)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS From 3b2c4c5836e7e43dbd8dff463ac871cef6befd6f Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 7 Dec 2022 13:42:57 -0700 Subject: [PATCH 153/395] fix bug in setting log unit --- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index 77b7546bf..7a89e8efa 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -175,8 +175,9 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) call ESMF_LogWrite(trim(subname)//": setting logunit for component: "//trim(name), ESMF_LOGMSG_INFO) call shr_log_setLogUnit (logunit) + ! Still need to set this return value + shrlogunit = logunit call ESMF_LogWrite(trim(subname)//": done for component "//trim(name), ESMF_LOGMSG_INFO) - end subroutine set_component_logging !=============================================================================== From 195a5e4e8e258ee72d504adc6f4fe69aa09979a0 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 8 Dec 2022 07:56:54 -0700 Subject: [PATCH 154/395] review actions --- cesm/driver/ensemble_driver.F90 | 2 +- cesm/driver/esm.F90 | 10 ------ cesm/driver/esm_time_mod.F90 | 5 --- cesm/nuopc_cap_share/driver_pio_mod.F90 | 46 ++++++------------------- 4 files changed, 11 insertions(+), 52 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index d20554cac..339a59218 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -62,7 +62,7 @@ subroutine SetServices(ensemble_driver, rc) specRoutine=SetModelServices, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! ModifyCplLists is a NUOPC specialization which happens after Advertize but before Realize + ! PostChildrenAdvertise is a NUOPC specialization which happens after Advertize but before Realize ! We have overloaded this specialization location to initilize IO. ! So after all components have called Advertise but before any component calls Realize ! IO will be initialized and any async IO tasks will be split off to the PIO async IO driver. diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index 73fc47637..57bc10b13 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -929,11 +929,6 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) inst_suffix = "" endif - ! Initialize PIO - ! This reads in the pio parameters that are independent of component -! call driver_pio_init(driver, rc=rc) -! if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(comms(componentCount+1), comps(componentCount+1)) comps(1) = 1 comms = MPI_COMM_NULL @@ -1177,12 +1172,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return enddo - ! Read in component dependent PIO parameters and initialize - ! IO systems -! call driver_pio_component_init(driver, size(comps), rc) -! if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Initialize MCT (this is needed for data models and cice prescribed capability) call mct_world_init(componentCount+1, GLOBAL_COMM, comms, comps) diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index dbfbc57be..db207f72f 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -89,7 +89,6 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert integer :: rof_cpl_dt ! Runoff coupling interval integer :: wav_cpl_dt ! Wav coupling interval integer :: esp_cpl_dt ! Esp coupling interval - character(CS) :: glc_avg_period ! Glc avering coupling period logical :: read_restart character(len=CL) :: restart_file character(len=CL) :: restart_pfile @@ -155,10 +154,6 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) wav_cpl_dt - call NUOPC_CompAttributeGet(ensemble_driver, name="glc_avg_period", value=glc_avg_period, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_avg_period - dtime_drv = minval((/atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt/)) if(mastertask) then write(tmpstr,'(i10)') dtime_drv diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index 86ea0428c..67a1b2f64 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -203,7 +203,6 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) integer :: pecnt integer :: ierr integer :: iocomm - integer :: ncomps integer :: async_rearr integer :: driverpecount, driver_myid integer, allocatable :: driverpetlist(:) @@ -247,14 +246,16 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) else total_comps = 0 endif - + print *,__FILE__,__LINE__,total_comps call ESMF_LogWrite(trim(subname)//": share total_comps and driverpecount", ESMF_LOGMSG_INFO) if (chkerr(rc,__LINE__,u_FILE_u)) return - - call MPI_AllReduce(MPI_IN_PLACE, total_comps, 1, MPI_INTEGER, & - MPI_MAX, Global_comm, rc) - call MPI_AllReduce(MPI_IN_PLACE, driverpecount, 1, MPI_INTEGER, & - MPI_MAX, Global_comm, rc) + if(driverpecount > 1) then + call MPI_AllReduce(MPI_IN_PLACE, total_comps, 1, MPI_INTEGER, & + MPI_MAX, Global_comm, rc) + call MPI_AllReduce(MPI_IN_PLACE, driverpecount, 1, MPI_INTEGER, & + MPI_MAX, Global_comm, rc) + endif + print *,__FILE__,__LINE__,total_comps allocate(pio_comp_settings(total_comps)) allocate(procs_per_comp(total_comps)) allocate(io_compid(total_comps)) @@ -273,6 +274,7 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) endif pio_comp_settings(i)%pio_async_interface = .false. io_compid(i) = i+1 + print *,__FILE__,__LINE__,total_comps, i, io_compid(i) if (petlocal(i)) then call ESMF_GridCompGet(gcomp(i), vm=vm, name=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -323,35 +325,7 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) pio_comp_settings(i)%pio_root = 0 endif endif - - call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_comp_settings(i)%pio_async_interface = (trim(cval) == '.true.') - if(.not. pio_comp_settings(i)%pio_async_interface) then - call NUOPC_CompAttributeGet(gcomp(i), name="pio_stride", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_stride - if(pio_comp_settings(i)%pio_stride <= 0 .or. pio_comp_settings(i)%pio_stride > npets) then - pio_comp_settings(i)%pio_stride = min(npets, default_stride) - endif - - call NUOPC_CompAttributeGet(gcomp(i), name="pio_numiotasks", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_numiotasks - - if(pio_comp_settings(i)%pio_numiotasks < 0 .or. pio_comp_settings(i)%pio_numiotasks > npets) then - pio_comp_settings(i)%pio_numiotasks = max(1,npets/pio_comp_settings(i)%pio_stride) - endif - - - call NUOPC_CompAttributeGet(gcomp(i), name="pio_root", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_root - - if(pio_comp_settings(i)%pio_root < 0 .or. pio_comp_settings(i)%pio_root > npets) then - pio_comp_settings(i)%pio_root = 0 - endif - endif + call NUOPC_CompAttributeGet(gcomp(i), name="pio_typename", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From b58cd0cc78fde2e294b764fb52c09121ceb9e43f Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 9 Dec 2022 10:08:09 -0700 Subject: [PATCH 155/395] fix some logging issues --- cesm/nuopc_cap_share/driver_pio_mod.F90 | 47 ++++++++++++++----------- 1 file changed, 26 insertions(+), 21 deletions(-) diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index 67a1b2f64..9f7b8c9d1 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -6,7 +6,7 @@ module driver_pio_mod use pio , only : pio_set_blocksize, pio_set_buffer_size_limit, pio_finalize use shr_pio_mod, only : io_compname, pio_comp_settings, iosystems, io_compid, shr_pio_getindex use shr_kind_mod, only : CS=>shr_kind_CS, shr_kind_cl, shr_kind_in - use shr_log_mod, only : shr_log_unit + use shr_log_mod, only : shr_log_getLogUnit use shr_mpi_mod, only : shr_mpi_bcast, shr_mpi_chkerr use shr_sys_mod, only : shr_sys_abort #ifndef NO_MPI2 @@ -66,11 +66,13 @@ subroutine driver_pio_init(driver, rc) character(len=shr_kind_cl) :: nlfilename, cname integer :: ret integer :: localPet + integer :: logunit character(len=CS) :: pio_rearr_comm_type, pio_rearr_comm_fcd character(CS) :: msgstr character(*), parameter :: subName = '(driver_pio_init) ' - + + call shr_log_getLogUnit(logunit) call ESMF_GridCompGet(driver, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -84,7 +86,7 @@ subroutine driver_pio_init(driver, rc) ! 0 is a valid value of pio_buffer_size_limit if(pio_buffer_size_limit>=0) then - if(mastertask) write(shr_log_unit,*) 'Setting pio_buffer_size_limit : ',pio_buffer_size_limit + if(mastertask) write(logunit,*) 'Setting pio_buffer_size_limit : ',pio_buffer_size_limit call pio_set_buffer_size_limit(pio_buffer_size_limit) endif @@ -93,7 +95,7 @@ subroutine driver_pio_init(driver, rc) read(cname, *) pio_blocksize if(pio_blocksize>0) then - if(mastertask) write(shr_log_unit,*) 'Setting pio_blocksize : ',pio_blocksize + if(mastertask) write(logunit,*) 'Setting pio_blocksize : ',pio_blocksize call pio_set_blocksize(pio_blocksize) endif @@ -102,7 +104,7 @@ subroutine driver_pio_init(driver, rc) read(cname, *) pio_debug_level if(pio_debug_level > 0) then - if(mastertask) write(shr_log_unit,*) 'Setting pio_debug_level : ',pio_debug_level + if(mastertask) write(logunit,*) 'Setting pio_debug_level : ',pio_debug_level ret = pio_set_log_level(pio_debug_level) endif @@ -151,23 +153,23 @@ subroutine driver_pio_init(driver, rc) if(mastertask) then ! Log the rearranger options - write(shr_log_unit, *) "PIO rearranger options:" - write(shr_log_unit, *) " comm type = ", pio_rearr_opts%comm_type, " (",trim(pio_rearr_comm_type),")" - write(shr_log_unit, *) " comm fcd = ", pio_rearr_opts%fcd, " (",trim(pio_rearr_comm_fcd),")" + write(logunit, *) "PIO rearranger options:" + write(logunit, *) " comm type = ", pio_rearr_opts%comm_type, " (",trim(pio_rearr_comm_type),")" + write(logunit, *) " comm fcd = ", pio_rearr_opts%fcd, " (",trim(pio_rearr_comm_fcd),")" if(pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then - write(shr_log_unit, *) " max pend req (comp2io) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" + write(logunit, *) " max pend req (comp2io) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" else - write(shr_log_unit, *) " max pend req (comp2io) = ", pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req + write(logunit, *) " max pend req (comp2io) = ", pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req end if - write(shr_log_unit, *) " enable_hs (comp2io) = ", pio_rearr_opts%comm_fc_opts_comp2io%enable_hs - write(shr_log_unit, *) " enable_isend (comp2io) = ", pio_rearr_opts%comm_fc_opts_comp2io%enable_isend + write(logunit, *) " enable_hs (comp2io) = ", pio_rearr_opts%comm_fc_opts_comp2io%enable_hs + write(logunit, *) " enable_isend (comp2io) = ", pio_rearr_opts%comm_fc_opts_comp2io%enable_isend if(pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then - write(shr_log_unit, *) " max pend req (io2comp) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" + write(logunit, *) " max pend req (io2comp) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" else - write(shr_log_unit, *) " max pend req (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req + write(logunit, *) " max pend req (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req end if - write(shr_log_unit, *) " enable_hs (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%enable_hs - write(shr_log_unit, *) " enable_isend (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%enable_isend + write(logunit, *) " enable_hs (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%enable_hs + write(logunit, *) " enable_isend (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%enable_isend end if end subroutine driver_pio_init @@ -214,7 +216,7 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) character(len=*), parameter :: subname = '('//__FILE__//':shr_pio_component_init)' asyncio_ntasks = size(asyncio_petlist) - + call shr_log_getLogUnit(logunit) call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -246,7 +248,7 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) else total_comps = 0 endif - print *,__FILE__,__LINE__,total_comps + call ESMF_LogWrite(trim(subname)//": share total_comps and driverpecount", ESMF_LOGMSG_INFO) if (chkerr(rc,__LINE__,u_FILE_u)) return if(driverpecount > 1) then @@ -255,7 +257,7 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) call MPI_AllReduce(MPI_IN_PLACE, driverpecount, 1, MPI_INTEGER, & MPI_MAX, Global_comm, rc) endif - print *,__FILE__,__LINE__,total_comps + allocate(pio_comp_settings(total_comps)) allocate(procs_per_comp(total_comps)) allocate(io_compid(total_comps)) @@ -274,7 +276,6 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) endif pio_comp_settings(i)%pio_async_interface = .false. io_compid(i) = i+1 - print *,__FILE__,__LINE__,total_comps, i, io_compid(i) if (petlocal(i)) then call ESMF_GridCompGet(gcomp(i), vm=vm, name=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -539,6 +540,10 @@ subroutine driver_pio_getiotypefromname(typename, iotype, defaulttype) integer, intent(out) :: iotype integer, intent(in) :: defaulttype + integer :: logunit + + call shr_log_getLogUnit(logunit) + typename = shr_string_toupper(typename) if ( typename .eq. 'NETCDF' ) then iotype = pio_iotype_netcdf @@ -553,7 +558,7 @@ subroutine driver_pio_getiotypefromname(typename, iotype, defaulttype) else if ( typename .eq. 'DEFAULT') then iotype = defaulttype else - write(shr_log_unit,*) 'driver_pio_mod: WARNING Bad io_type argument - using iotype_netcdf' + write(logunit,*) 'driver_pio_mod: WARNING Bad io_type argument - using iotype_netcdf' iotype=pio_iotype_netcdf end if From 54c6bc34bc2cacb0ddca132b7427b021c640deb8 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 9 Dec 2022 13:55:53 -0700 Subject: [PATCH 156/395] add some logic for asyncio settings --- cesm/driver/ensemble_driver.F90 | 11 ++++++++--- cime_config/buildnml | 20 +++++++++++++++++++- 2 files changed, 27 insertions(+), 4 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 339a59218..d11fe5e41 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -262,6 +262,11 @@ subroutine SetModelServices(ensemble_driver, rc) allocate(asyncio_petlist(pio_asyncio_ntasks)) currentpet = 0 iopetcnt = 1 + ! + ! Logic for asyncio variables is handled in cmeps buildnml. + ! here we assume that pio_asyncio_stride and pio_asyncio_ntasks are only set + ! if asyncio is enabled. + ! do inst=1,number_of_members petcnt=1 comp_task = .false. @@ -372,14 +377,14 @@ subroutine InitializeIO(ensemble_driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompGet(dcomp(drv), name=compname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": call shr_pio_init "//compname, ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": call driver_pio_init "//compname, ESMF_LOGMSG_INFO) call driver_pio_init(dcomp(drv), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": call shr_pio_component_init "//compname, ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": call driver_pio_component_init "//compname, ESMF_LOGMSG_INFO) call driver_pio_component_init(dcomp(drv), Global_Comm, asyncio_petlist, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": shr_pio_component_init done "//compname, ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": driver_pio_component_init done "//compname, ESMF_LOGMSG_INFO) endif enddo deallocate(asyncio_petlist) diff --git a/cime_config/buildnml b/cime_config/buildnml index fd5d73df0..606061e2c 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -249,11 +249,15 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): #-------------------------------- # Write nuopc.runconfig file and add to input dataset list. #-------------------------------- - # Determine valid components valid_comps = [] + asyncio = False + for item in case.get_values("COMP_CLASSES"): comp = case.get_value("COMP_" + item) + if case.get_value(f"PIO_ASYNC_INTERFACE", {"compclass":item}): + asyncio = True + valid = True # stub comps if comp == 's' + item.lower(): @@ -273,6 +277,20 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): valid = False if valid: valid_comps.append(item) + asyncio_ntasks = case.get_value("PIO_ASYNCIO_NTASKS") + asyncio_stride = case.get_value("PIO_ASYNCIO_STRIDE") + # If asyncio is enabled make sure that the aysncio values are set + # if not enabled then do not pass xml settings to namelists. + if asyncio: + expect(asyncio_ntasks > 0 and asyncio_stride > 0, + "ASYNCIO is enabled but PIO_ASYNCIO_NTASKS={} and PIO_ASYNCIO_STRIDE = {}". + format(asyncio_ntasks, asyncio_stride)) + else: + if asyncio_ntasks > 0 or asyncio_stride > 0: + logger.warning("ASYNCIO is disabled, ignoring settings for PIO_ASYNCIO_NTASKS={} and PIO_ASYNCIO_STRIDE = {}". + format(asyncio_ntasks, asyncio_stride)) + nmlgen.set_value("pio_asyncio_ntasks", 0) + nmlgen.set_value("pio_asyncio_stride", 0) # Determine if there are any data components in the compset datamodel_in_compset = False From eaffa8d80e60f5168d954ca33f424807a6f12f18 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 9 Dec 2022 13:58:28 -0700 Subject: [PATCH 157/395] remove whitespace --- cime_config/buildnml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 606061e2c..acaac4d0b 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -280,7 +280,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): asyncio_ntasks = case.get_value("PIO_ASYNCIO_NTASKS") asyncio_stride = case.get_value("PIO_ASYNCIO_STRIDE") # If asyncio is enabled make sure that the aysncio values are set - # if not enabled then do not pass xml settings to namelists. + # if not enabled then do not pass xml settings to namelists. if asyncio: expect(asyncio_ntasks > 0 and asyncio_stride > 0, "ASYNCIO is enabled but PIO_ASYNCIO_NTASKS={} and PIO_ASYNCIO_STRIDE = {}". From 9c034d94666d2c13356886df37279dfb21e64f09 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 9 Dec 2022 14:04:42 -0700 Subject: [PATCH 158/395] add another comment --- cesm/driver/ensemble_driver.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index d11fe5e41..180fc57b1 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -273,10 +273,12 @@ subroutine SetModelServices(ensemble_driver, rc) ! Determine pet list for driver instance do n=1,ntasks_per_member+pio_asyncio_ntasks if(pio_asyncio_stride == 0 .or. modulo(n,pio_asyncio_rootpe+1) .ne. 0) then + ! Here if asyncio is false or this is a compute task petList(petcnt) = currentpet petcnt = petcnt+1 if (currentpet == localPet) comp_task=.true. else + ! Here if asyncio is true and this is an io task asyncio_petlist(iopetcnt) = currentpet iopetcnt = iopetcnt + 1 if (currentpet == localPet) asyncio_task=.true. From 85946ae80c51fa063c6a4505978362424ccfaac0 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 13 Dec 2022 10:27:11 -0700 Subject: [PATCH 159/395] some tests and bug fixes --- cesm/driver/ensemble_driver.F90 | 50 +++++++++++++------ cesm/driver/esm.F90 | 2 +- cesm/nuopc_cap_share/driver_pio_mod.F90 | 9 ++-- .../drv/asyncio1node/shell_commands | 7 +++ .../drv/asyncio1pernode/shell_commands | 14 ++++++ 5 files changed, 61 insertions(+), 21 deletions(-) create mode 100644 cime_config/testdefs/testmods_dirs/drv/asyncio1node/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/drv/asyncio1pernode/shell_commands diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 180fc57b1..8b1bdaa30 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -142,7 +142,6 @@ subroutine SetModelServices(ensemble_driver, rc) integer :: inst integer :: number_of_members integer :: ntasks_per_member - integer :: currentpet integer :: iopetcnt integer :: petcnt logical :: comp_task @@ -260,8 +259,6 @@ subroutine SetModelServices(ensemble_driver, rc) allocate(petList(ntasks_per_member)) allocate(asyncio_petlist(pio_asyncio_ntasks)) - currentpet = 0 - iopetcnt = 1 ! ! Logic for asyncio variables is handled in cmeps buildnml. ! here we assume that pio_asyncio_stride and pio_asyncio_ntasks are only set @@ -269,24 +266,49 @@ subroutine SetModelServices(ensemble_driver, rc) ! do inst=1,number_of_members petcnt=1 + iopetcnt = 1 comp_task = .false. + asyncio_task = .false. ! Determine pet list for driver instance - do n=1,ntasks_per_member+pio_asyncio_ntasks - if(pio_asyncio_stride == 0 .or. modulo(n,pio_asyncio_rootpe+1) .ne. 0) then - ! Here if asyncio is false or this is a compute task - petList(petcnt) = currentpet - petcnt = petcnt+1 - if (currentpet == localPet) comp_task=.true. + if(pio_asyncio_ntasks > 0) then + do n=pio_asyncio_rootpe,pio_asyncio_rootpe+pio_asyncio_stride*(pio_asyncio_ntasks-1),pio_asyncio_stride + asyncio_petlist(iopetcnt) = n + iopetcnt = iopetcnt+1 + if(n == localPet) asyncio_task = .true. + enddo + iopetcnt = 1 + endif + do n=0,ntasks_per_member+pio_asyncio_ntasks-1 + if(iopetcnt<=pio_asyncio_ntasks) then + if( asyncio_petlist(iopetcnt)==n) then + ! Here if asyncio is true and this is an io task + iopetcnt = iopetcnt+1 + else if(petcnt <= ntasks_per_member) then + ! Here if this is a compute task + petList(petcnt) = n + petcnt = petcnt+1 + if (n == localPet) comp_task=.true. + else + msgstr = "ERROR task cannot be nether a compute task nor an asyncio task" + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif else - ! Here if asyncio is true and this is an io task - asyncio_petlist(iopetcnt) = currentpet - iopetcnt = iopetcnt + 1 - if (currentpet == localPet) asyncio_task=.true. + ! Here if asyncio is false + petList(petcnt) = n + petcnt = petcnt+1 + if (n == localPet) comp_task=.true. endif - currentpet = currentpet + 1 enddo + if(comp_task .and. asyncio_task) then + msgstr = "ERROR task cannot be both a compute task and an asyncio task" + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + ! Add driver instance to ensemble driver write(drvrinst,'(a,i4.4)') "ESM",inst + call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=driver, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index 57bc10b13..cabd38498 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -953,7 +953,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) read(cvalue,*) ntasks if (ntasks < 0 .or. ntasks > PetCount) then - write (msgstr, *) "Invalid NTASKS value specified for component: ",namestr, ' ntasks: ',ntasks + write (msgstr, *) "Invalid NTASKS value specified for component: ",namestr, ' ntasks: ',ntasks, petcount call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return endif diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index 9f7b8c9d1..437d46f42 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -7,7 +7,6 @@ module driver_pio_mod use shr_pio_mod, only : io_compname, pio_comp_settings, iosystems, io_compid, shr_pio_getindex use shr_kind_mod, only : CS=>shr_kind_CS, shr_kind_cl, shr_kind_in use shr_log_mod, only : shr_log_getLogUnit - use shr_mpi_mod, only : shr_mpi_bcast, shr_mpi_chkerr use shr_sys_mod, only : shr_sys_abort #ifndef NO_MPI2 use mpi, only : mpi_comm_null, mpi_comm_world, mpi_finalize @@ -251,7 +250,7 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) call ESMF_LogWrite(trim(subname)//": share total_comps and driverpecount", ESMF_LOGMSG_INFO) if (chkerr(rc,__LINE__,u_FILE_u)) return - if(driverpecount > 1) then + if(totalpes > 1) then call MPI_AllReduce(MPI_IN_PLACE, total_comps, 1, MPI_INTEGER, & MPI_MAX, Global_comm, rc) call MPI_AllReduce(MPI_IN_PLACE, driverpecount, 1, MPI_INTEGER, & @@ -356,6 +355,7 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) if(pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req = pio_comp_settings(i)%pio_numiotasks endif + call pio_init(comp_rank ,comp_comm ,pio_comp_settings(i)%pio_numiotasks, 0, pio_comp_settings(i)%pio_stride, & pio_comp_settings(i)%pio_rearranger, iosystems(i), pio_comp_settings(i)%pio_root, & pio_rearr_opts) @@ -369,7 +369,6 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) call ESMF_LogWrite(trim(subname)//": check for async", ESMF_LOGMSG_INFO) if (chkerr(rc,__LINE__,u_FILE_u)) return - do i=1,total_comps call MPI_AllReduce(MPI_IN_PLACE, pio_comp_settings(i)%pio_async_interface, 1, MPI_LOGICAL, & MPI_LOR, global_comm, rc) @@ -384,7 +383,6 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) call MPI_Allreduce(MPI_IN_PLACE, do_async_init, 1, MPI_INTEGER, MPI_MAX, Global_comm, ierr) call MPI_Allreduce(MPI_IN_PLACE, procs_per_comp, total_comps, MPI_INTEGER, MPI_MAX, Global_comm, ierr) - if (do_async_init > 0) then allocate(asyncio_comp_comm(do_async_init)) allocate(comp_proc_list(driverpecount, do_async_init)) @@ -447,9 +445,8 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) call ESMF_LogWrite(trim(subname)//": call async pio_init", ESMF_LOGMSG_INFO) if (chkerr(rc,__LINE__,u_FILE_u)) return - call MPI_AllReduce(MPI_IN_PLACE, async_rearr, 1, MPI_INTEGER, & + call MPI_AllReduce(pio_comp_settings(1)%pio_rearranger, async_rearr, 1, MPI_INTEGER, & MPI_MAX, Global_comm, rc) - call pio_init(async_iosystems, Global_comm, async_procs_per_comp, & comp_proc_list, asyncio_petlist, & async_rearr, asyncio_comp_comm, io_comm) diff --git a/cime_config/testdefs/testmods_dirs/drv/asyncio1node/shell_commands b/cime_config/testdefs/testmods_dirs/drv/asyncio1node/shell_commands new file mode 100644 index 000000000..9a4718359 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/drv/asyncio1node/shell_commands @@ -0,0 +1,7 @@ +# This will add one asyncio node +./xmlchange PIO_ASYNC_INTERFACE=TRUE +ntasks=`./xmlquery --value TOTAL_TASKS` +./xmlchange PIO_ASYNCIO_ROOTPE=$ntasks +./xmlchange PIO_ASYNCIO_STRIDE=1 +./xmlchange PIO_ASYNCIO_NTASKS=4 +./xmlchange PIO_REARRANGER=2 diff --git a/cime_config/testdefs/testmods_dirs/drv/asyncio1pernode/shell_commands b/cime_config/testdefs/testmods_dirs/drv/asyncio1pernode/shell_commands new file mode 100644 index 000000000..b70f3653d --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/drv/asyncio1pernode/shell_commands @@ -0,0 +1,14 @@ +# This will add one async pio task per node to a test +# does not work for all cases +./xmlchange PIO_ASYNC_INTERFACE=TRUE +ntasks=`./xmlquery --value TOTAL_TASKS` +tpn=`./xmlquery --value MAX_MPITASKS_PER_NODE` +echo "ntasks=$ntasks tpn=$tpn" +./xmlchange PIO_ASYNCIO_STRIDE=$tpn +let piontasks=ntasks/tpn +echo "piontasks=$piontasks" +./xmlchange PIO_ASYNCIO_NTASKS=$piontasks +let newntasks=ntasks-piontasks +echo "newntasks=$newntasks" +./xmlchange NTASKS=$newntasks +./xmlchange PIO_REARRANGER=2 \ No newline at end of file From 3fcf6e2a2ea2f9a811e4d88d61c5e3242cfb94d5 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 13 Dec 2022 13:57:55 -0700 Subject: [PATCH 160/395] Fix documentation of DOUT_S_SAVE_INTERIM_RESTART_FILES --- cime_config/config_component_cesm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index cfcdc12ef..e2e6b44e1 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -92,7 +92,7 @@ env_run.xml Logical to archive all interim restart files, not just those at eor If TRUE, perform short term archiving on all interim restart files, - not just those at the end of the run. By default, this value is TRUE. + not just those at the end of the run. By default, this value is FALSE. The restart files are saved under the specific component directory ($DOUT_S_ROOT/$CASE/$COMPONENT/rest rather than the top-level $DOUT_S_ROOT/$CASE/rest directory). Interim restart files are created using the REST_N and REST_OPTION variables. From 825cade314cac9075c6379bdbfafdcdbf8a61e18 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 14 Dec 2022 14:16:59 -0700 Subject: [PATCH 161/395] fix issue with scaling over instances --- cesm/driver/ensemble_driver.F90 | 104 ++++++++++++++++---------------- 1 file changed, 51 insertions(+), 53 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index f5313f98f..ec7628b3b 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -203,69 +203,67 @@ subroutine SetModelServices(ensemble_driver, rc) !------------------------------------------- allocate(petList(ntasks_per_member)) + inst = localPet/ntasks_per_member + 1 - do inst=1,number_of_members - - ! Determine pet list for driver instance - petList(1) = (inst-1) * ntasks_per_member - do n=2,ntasks_per_member - petList(n) = petList(n-1) + 1 - enddo - - ! Add driver instance to ensemble driver - write(drvrinst,'(a,i4.4)') "ESM",inst - call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=gridcomptmp, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (localpet >= petlist(1) .and. localpet <= petlist(ntasks_per_member)) then - - driver = gridcomptmp + ! Determine pet list for driver instance + petList(1) = (inst-1) * ntasks_per_member + do n=2,ntasks_per_member + petList(n) = petList(n-1) + 1 + enddo - if(number_of_members > 1) then - call NUOPC_CompAttributeAdd(driver, attrList=(/'inst_suffix'/), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write(inst_suffix,'(a,i4.4)') '_',inst - call NUOPC_CompAttributeSet(driver, name='inst_suffix', value=inst_suffix, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - inst_suffix = '' - endif + ! Add driver instance to ensemble driver + write(drvrinst,'(a,i4.4)') "ESM",inst + call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=gridcomptmp, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (localpet >= petlist(1) .and. localpet <= petlist(ntasks_per_member)) then + + driver = gridcomptmp - ! Set the driver instance attributes - call NUOPC_CompAttributeAdd(driver, attrList=(/'read_restart'/), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(read_restart_string), rc=rc) + if(number_of_members > 1) then + call NUOPC_CompAttributeAdd(driver, attrList=(/'inst_suffix'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ReadAttributes(driver, config, "CLOCK_attributes::", rc=rc) + write(inst_suffix,'(a,i4.4)') '_',inst + call NUOPC_CompAttributeSet(driver, name='inst_suffix', value=inst_suffix, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + else + inst_suffix = '' + endif - call ReadAttributes(driver, config, "DRIVER_attributes::", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Set the driver instance attributes + call NUOPC_CompAttributeAdd(driver, attrList=(/'read_restart'/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(read_restart_string), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(driver, config, "CLOCK_attributes::", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(driver, config, "DRIVER_attributes::", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(driver, config, "DRV_modelio::", rc=rc) + call ReadAttributes(driver, config, "DRV_modelio::", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Set the driver log to the driver task 0 + if (mod(localPet, ntasks_per_member) == 0) then + call NUOPC_CompAttributeGet(driver, name="diro", value=diro, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Set the driver log to the driver task 0 - if (mod(localPet, ntasks_per_member) == 0) then - call NUOPC_CompAttributeGet(driver, name="diro", value=diro, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(driver, name="logfile", value=logfile, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - open (newunit=logunit,file=trim(diro)//"/"//trim(logfile)) - mastertask = .true. - else - logUnit = 6 - mastertask = .false. - endif - call shr_log_setLogUnit (logunit) - - ! Create a clock for each driver instance - call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) + call NUOPC_CompAttributeGet(driver, name="logfile", value=logfile, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + open (newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + mastertask = .true. + else + logUnit = 6 + mastertask = .false. endif - enddo + call shr_log_setLogUnit (logunit) + + ! Create a clock for each driver instance + call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + endif deallocate(petList) From b345944f228a3250089045234bfd99a3d4aadf9b Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 14 Dec 2022 14:24:07 -0700 Subject: [PATCH 162/395] add a comment --- cesm/driver/ensemble_driver.F90 | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index ec7628b3b..2b8238187 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -133,7 +133,7 @@ subroutine SetModelServices(ensemble_driver, rc) call ReadAttributes(ensemble_driver, config, "CLOCK_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(ensemble_driver, 'calendar', calendar, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, 'calendar', calendar, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (calendar == 'NO_LEAP') then call ESMF_CalendarSetDefault(ESMF_CALKIND_NOLEAP, rc=rc) @@ -203,6 +203,7 @@ subroutine SetModelServices(ensemble_driver, rc) !------------------------------------------- allocate(petList(ntasks_per_member)) + ! which driver instance is this? inst = localPet/ntasks_per_member + 1 ! Determine pet list for driver instance @@ -215,9 +216,9 @@ subroutine SetModelServices(ensemble_driver, rc) write(drvrinst,'(a,i4.4)') "ESM",inst call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=gridcomptmp, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + if (localpet >= petlist(1) .and. localpet <= petlist(ntasks_per_member)) then - + driver = gridcomptmp if(number_of_members > 1) then @@ -235,17 +236,17 @@ subroutine SetModelServices(ensemble_driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(read_restart_string), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + call ReadAttributes(driver, config, "CLOCK_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + call ReadAttributes(driver, config, "DRIVER_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(driver, config, "DRV_modelio::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Set the driver log to the driver task 0 + + ! Set the driver log to the driver task 0 if (mod(localPet, ntasks_per_member) == 0) then call NUOPC_CompAttributeGet(driver, name="diro", value=diro, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -262,7 +263,7 @@ subroutine SetModelServices(ensemble_driver, rc) ! Create a clock for each driver instance call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + endif deallocate(petList) From 861b0fd18445b1f4b82d1c59564e15ded9ad389e Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 15 Dec 2022 13:27:35 -0700 Subject: [PATCH 163/395] more cleanup and refactoring --- cesm/driver/ensemble_driver.F90 | 178 ++++++++++----------- cesm/driver/esm.F90 | 21 +-- cesm/nuopc_cap_share/driver_pio_mod.F90 | 78 ++++----- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 7 +- cime_config/testdefs/testlist_drv.xml | 33 ++++ mediator/med.F90 | 22 +-- 6 files changed, 175 insertions(+), 164 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 8b1bdaa30..197657a27 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -10,7 +10,6 @@ module Ensemble_driver use shr_kind_mod , only : cl=>shr_kind_cl, cs=>shr_kind_cs use shr_log_mod , only : shr_log_setLogUnit use esm_utils_mod , only : mastertask, logunit, chkerr - implicit none private @@ -21,7 +20,6 @@ module Ensemble_driver integer, allocatable :: asyncio_petlist(:) logical :: asyncio_task=.false. logical :: asyncIO_available=.false. - character(*),parameter :: u_FILE_u = & __FILE__ @@ -83,7 +81,7 @@ subroutine SetServices(ensemble_driver, rc) ! NUOPC component drivers end the initialization process with an internal call to InitializeDataResolution. ! The ensemble_driver does not need to InitializeDataResolution and doing so will cause a hang ! if asyncronous IO is used. This attribute is available after ESMF8.4.0b03 to toggle that control. - ! Cannot use asyncIO with older ESMF versions. + ! Cannot use asyncIO with older ESMF versions. call NUOPC_CompAttributeGet(ensemble_driver, name="InitializeDataResolution", & isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -126,17 +124,14 @@ subroutine SetModelServices(ensemble_driver, rc) ! local variables type(ESMF_VM) :: vm - type(ESMF_GridComp) :: driver, gridcomptmp + type(ESMF_GridComp) :: driver type(ESMF_Config) :: config - integer :: n, n1, stat + integer :: n, n1 integer, pointer :: petList(:) - character(len=20) :: model, prefix - integer :: petCount, i + integer :: petCount integer :: localPet - logical :: is_set character(len=512) :: diro character(len=512) :: logfile - integer :: global_comm logical :: read_restart character(len=CS) :: read_restart_string integer :: inst @@ -176,7 +171,7 @@ subroutine SetModelServices(ensemble_driver, rc) call ReadAttributes(ensemble_driver, config, "CLOCK_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(ensemble_driver, 'calendar', calendar, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, 'calendar', calendar, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (calendar == 'NO_LEAP') then call ESMF_CalendarSetDefault(ESMF_CALKIND_NOLEAP, rc=rc) @@ -258,106 +253,105 @@ subroutine SetModelServices(ensemble_driver, rc) !------------------------------------------- allocate(petList(ntasks_per_member)) - allocate(asyncio_petlist(pio_asyncio_ntasks)) + allocate(asyncio_petlist(pio_asyncio_ntasks)) ! - ! Logic for asyncio variables is handled in cmeps buildnml. - ! here we assume that pio_asyncio_stride and pio_asyncio_ntasks are only set + ! Logic for asyncio variables is handled in cmeps buildnml. + ! here we assume that pio_asyncio_stride and pio_asyncio_ntasks are only set ! if asyncio is enabled. ! - do inst=1,number_of_members - petcnt=1 + inst = localPet/(ntasks_per_member+pio_asyncio_ntasks) + 1 + + petcnt=1 + iopetcnt = 1 + comp_task = .false. + asyncio_task = .false. + ! Determine pet list for driver instance + if(pio_asyncio_ntasks > 0) then + do n=pio_asyncio_rootpe,pio_asyncio_rootpe+pio_asyncio_stride*(pio_asyncio_ntasks-1),pio_asyncio_stride + asyncio_petlist(iopetcnt) = (inst-1)*ntasks_per_member + n + iopetcnt = iopetcnt+1 + if((inst-1)*ntasks_per_member + n == localPet) asyncio_task = .true. + enddo iopetcnt = 1 - comp_task = .false. - asyncio_task = .false. - ! Determine pet list for driver instance - if(pio_asyncio_ntasks > 0) then - do n=pio_asyncio_rootpe,pio_asyncio_rootpe+pio_asyncio_stride*(pio_asyncio_ntasks-1),pio_asyncio_stride - asyncio_petlist(iopetcnt) = n + endif + do n=0,ntasks_per_member+pio_asyncio_ntasks-1 + if(iopetcnt<=pio_asyncio_ntasks) then + if( asyncio_petlist(iopetcnt)==n) then + ! Here if asyncio is true and this is an io task iopetcnt = iopetcnt+1 - if(n == localPet) asyncio_task = .true. - enddo - iopetcnt = 1 - endif - do n=0,ntasks_per_member+pio_asyncio_ntasks-1 - if(iopetcnt<=pio_asyncio_ntasks) then - if( asyncio_petlist(iopetcnt)==n) then - ! Here if asyncio is true and this is an io task - iopetcnt = iopetcnt+1 - else if(petcnt <= ntasks_per_member) then - ! Here if this is a compute task - petList(petcnt) = n - petcnt = petcnt+1 - if (n == localPet) comp_task=.true. - else - msgstr = "ERROR task cannot be nether a compute task nor an asyncio task" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - else - ! Here if asyncio is false - petList(petcnt) = n + else if(petcnt <= ntasks_per_member) then + ! Here if this is a compute task + petList(petcnt) = (inst-1)*ntasks_per_member + n petcnt = petcnt+1 - if (n == localPet) comp_task=.true. + if ((inst-1)*ntasks_per_member + n == localPet) comp_task=.true. + else + msgstr = "ERROR task cannot be neither a compute task nor an asyncio task" + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out endif - enddo - if(comp_task .and. asyncio_task) then - msgstr = "ERROR task cannot be both a compute task and an asyncio task" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out + else + ! Here if asyncio is false + petList(petcnt) = (inst-1)*ntasks_per_member + n + petcnt = petcnt+1 + if ((inst-1)*ntasks_per_member + n == localPet) comp_task=.true. endif + enddo + if(comp_task .and. asyncio_task) then + msgstr = "ERROR task cannot be both a compute task and an asyncio task" + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif - ! Add driver instance to ensemble driver - write(drvrinst,'(a,i4.4)') "ESM",inst - - call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=driver, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Add driver instance to ensemble driver + write(drvrinst,'(a,i4.4)') "ESM",inst - mastertask = .false. - if (comp_task) then + call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=driver, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - if(number_of_members > 1) then - call NUOPC_CompAttributeAdd(driver, attrList=(/'inst_suffix'/), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write(inst_suffix,'(a,i4.4)') '_',inst - call NUOPC_CompAttributeSet(driver, name='inst_suffix', value=inst_suffix, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - inst_suffix = '' - endif + mastertask = .false. + if (comp_task) then - ! Set the driver instance attributes - call NUOPC_CompAttributeAdd(driver, attrList=(/'read_restart'/), rc=rc) + if(number_of_members > 1) then + call NUOPC_CompAttributeAdd(driver, attrList=(/'inst_suffix'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(read_restart_string), rc=rc) + write(inst_suffix,'(a,i4.4)') '_',inst + call NUOPC_CompAttributeSet(driver, name='inst_suffix', value=inst_suffix, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + else + inst_suffix = '' + endif - call ReadAttributes(driver, config, "CLOCK_attributes::", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Set the driver instance attributes + call NUOPC_CompAttributeAdd(driver, attrList=(/'read_restart'/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(read_restart_string), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(driver, config, "DRIVER_attributes::", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + call ReadAttributes(driver, config, "CLOCK_attributes::", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(driver, config, "DRV_modelio::", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + call ReadAttributes(driver, config, "DRIVER_attributes::", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Set the driver log to the driver task 0 - if (mod(localPet, ntasks_per_member) == 0) then - call NUOPC_CompAttributeGet(driver, name="diro", value=diro, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(driver, name="logfile", value=logfile, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - open (newunit=logunit,file=trim(diro)//"/"//trim(logfile)) - mastertask = .true. - else - logUnit = 6 - endif - call shr_log_setLogUnit (logunit) - endif - ! Create a clock for each driver instance - call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) + call ReadAttributes(driver, config, "DRV_modelio::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - enddo + ! Set the driver log to the driver task 0 + if (mod(localPet, ntasks_per_member) == 0) then + call NUOPC_CompAttributeGet(driver, name="diro", value=diro, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(driver, name="logfile", value=logfile, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + open (newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + mastertask = .true. + else + logUnit = 6 + endif + call shr_log_setLogUnit (logunit) + endif + ! Create a clock for each driver instance + call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return deallocate(petList) @@ -372,7 +366,7 @@ subroutine InitializeIO(ensemble_driver, rc) use NUOPC, only: NUOPC_CompAttributeGet, NUOPC_CompGet use NUOPC_DRIVER, only: NUOPC_DriverGetComp use driver_pio_mod , only: driver_pio_init, driver_pio_component_init - + type(ESMF_GridComp) :: ensemble_driver type(ESMF_VM) :: ensemble_vm integer, intent(out) :: rc @@ -380,7 +374,7 @@ subroutine InitializeIO(ensemble_driver, rc) type(ESMF_GridComp), pointer :: dcomp(:), ccomp(:) integer :: iam integer :: Global_Comm - integer :: drv, comp + integer :: drv character(len=8) :: compname rc = ESMF_SUCCESS diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index cabd38498..15ac8932d 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -54,7 +54,6 @@ subroutine SetServices(driver, rc) integer, intent(out) :: rc ! local variables - type(ESMF_Config) :: runSeq character(len=*), parameter :: subname = "(esm.F90:SetServices)" !--------------------------------------- @@ -125,9 +124,7 @@ subroutine SetModelServices(driver, rc) ! local variables type(ESMF_VM) :: vm type(ESMF_Config) :: config - integer :: n, i, stat - character(len=20) :: model, prefix - integer :: localPet, medpet + integer :: localPet character(len=CL) :: meminitStr integer :: global_comm integer :: maxthreads @@ -241,7 +238,6 @@ subroutine SetRunSequence(driver, rc) integer, intent(out) :: rc ! local variables - integer :: localrc type(ESMF_Config) :: runSeq type(NUOPC_FreeFormat) :: runSeqFF character(len=*), parameter :: subname = "(esm.F90:SetRunSequence)" @@ -433,11 +429,7 @@ subroutine InitAttributes(driver, rc) type(ShrWVSatTableSpec) :: liquid_spec type(ShrWVSatTableSpec) :: ice_spec type(ShrWVSatTableSpec) :: mixed_spec - logical :: flag - integer :: i, it, n - integer :: unitn ! Namelist unit number to read integer :: localPet, rootpe_med - character(len=CL) :: msgstr integer , parameter :: ens1=1 ! use first instance of ensemble only integer , parameter :: fix1=1 ! temporary hard-coding to first ensemble, needs to be fixed real(R8) , parameter :: epsilo = shr_const_mwwv/shr_const_mwdair @@ -568,8 +560,6 @@ subroutine CheckAttributes( driver, rc ) integer , intent(out) :: rc !----- local ----- - character(len=CL) :: cvalue ! temporary - character(len=CL) :: start_type ! Type of startup character(len=CS) :: logFilePostFix ! postfix for output log files character(len=CL) :: outPathRoot ! root for output log files character(len=CS) :: cime_model @@ -627,12 +617,9 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n integer , intent(inout) :: rc ! local variables - integer :: n - integer :: stat integer :: inst_index character(len=CL) :: cvalue character(len=CS) :: attribute - integer :: componentCount character(len=*), parameter :: subname = "(esm.F90:AddAttributes)" !------------------------------------------- @@ -871,9 +858,8 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) type(ESMF_Info) :: info integer :: componentcount integer :: PetCount - integer :: LocalPet integer :: ntasks, rootpe, nthrds, stride - integer :: ntask, cnt + integer :: ntask integer :: i integer :: stat character(len=32), allocatable :: compLabels(:) @@ -1403,11 +1389,12 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) allocate(lonMesh(lsize), latMesh(lsize)) call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + scol_mesh_n = 0 do n = 1,lsize lonMesh(n) = ownedElemCoords(2*n-1) latMesh(n) = ownedElemCoords(2*n) if (abs(lonMesh(n) - scol_lon) < 1.e-4 .and. abs(latMesh(n) - scol_lat) < 1.e-4) then - scol_mesh_n = n scol_mesh_n = n exit end if diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index 437d46f42..cfca1cce4 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -20,7 +20,7 @@ module driver_pio_mod public :: driver_pio_init public :: driver_pio_component_init public :: driver_pio_finalize - public :: driver_pio_log_comp_settings + private :: driver_pio_log_comp_settings integer :: io_comm integer :: pio_debug_level=0, pio_blocksize=0 @@ -204,13 +204,17 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) integer :: pecnt integer :: ierr integer :: iocomm + integer :: pp integer :: async_rearr - integer :: driverpecount, driver_myid + integer :: maxprocspercomp, driver_myid integer, allocatable :: driverpetlist(:) integer, allocatable :: asyncio_comp_comm(:) integer :: logunit + integer :: ioproc + integer :: n logical :: asyncio_task logical, allocatable :: petlocal(:) + type(ESMF_PtrInt1D), pointer :: petLists(:) type(iosystem_desc_t), allocatable :: async_iosystems(:) character(len=*), parameter :: subname = '('//__FILE__//':shr_pio_component_init)' @@ -229,19 +233,16 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) endif enddo nullify(gcomp) - - if (asyncio_task) then - driverpecount = 0 - else + nullify(petLists) + if (.not. asyncio_task) then call ESMF_GridCompGet(gridcomp=driver, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_DriverGetComp(driver, compList=gcomp, rc=rc) + call NUOPC_DriverGetComp(driver, compList=gcomp, petLists=petLists, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=driver_myid, petcount=driverpecount, rc=rc) + call ESMF_VMGet(vm, localPet=driver_myid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif - if(associated(gcomp)) then total_comps = size(gcomp) else @@ -253,8 +254,6 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) if(totalpes > 1) then call MPI_AllReduce(MPI_IN_PLACE, total_comps, 1, MPI_INTEGER, & MPI_MAX, Global_comm, rc) - call MPI_AllReduce(MPI_IN_PLACE, driverpecount, 1, MPI_INTEGER, & - MPI_MAX, Global_comm, rc) endif allocate(pio_comp_settings(total_comps)) @@ -361,7 +360,7 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) pio_rearr_opts) endif ! Write the PIO settings to the beggining of each component log - if(comp_rank == 0) call driver_pio_log_comp_settings(gcomp(i), logunit, rc) + if(comp_rank == 0) call driver_pio_log_comp_settings(gcomp(i), rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif @@ -384,43 +383,42 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) call MPI_Allreduce(MPI_IN_PLACE, do_async_init, 1, MPI_INTEGER, MPI_MAX, Global_comm, ierr) call MPI_Allreduce(MPI_IN_PLACE, procs_per_comp, total_comps, MPI_INTEGER, MPI_MAX, Global_comm, ierr) if (do_async_init > 0) then + maxprocspercomp = 0 + do i=1,total_comps + if(procs_per_comp(i) > maxprocspercomp) maxprocspercomp = procs_per_comp(i) + enddo + call MPI_AllReduce(MPI_IN_PLACE, maxprocspercomp, 1, MPI_INTEGER, & + MPI_MAX, Global_comm, rc) + allocate(asyncio_comp_comm(do_async_init)) - allocate(comp_proc_list(driverpecount, do_async_init)) + allocate(comp_proc_list(maxprocspercomp, do_async_init)) j = 1 k = 1 comp_proc_list = -1 if(.not. asyncio_task) then do i=1,total_comps if(pio_comp_settings(i)%pio_async_interface) then - if(petlocal(i)) comp_proc_list(1+driver_myid,j) = myid + comp_proc_list(1:procs_per_comp(i), j) = petLists(i)%ptr + ! IO tasks are not in the driver comp so we need to correct the comp_proc_list do k=1,size(asyncio_petlist) - if(comp_proc_list(1+driver_myid, j) == asyncio_petlist(k)) then - call shr_sys_abort(subname//' ERROR: OVERLAP with asyncio_petlist') - endif + ioproc = asyncio_petlist(k) + do n=1,procs_per_comp(i) + if(petLists(i)%ptr(n) >= (ioproc-k+1)) comp_proc_list(n,j) = comp_proc_list(n,j) + 1 + enddo enddo j = j+1 endif +! deallocate(petLists(i)%ptr) enddo endif - call MPI_AllReduce(MPI_IN_PLACE, comp_proc_list, driverpecount*do_async_init, MPI_INTEGER, MPI_MAX, Global_comm, ierr) + ! Copy comp_proc_list to io tasks + do i=1,do_async_init + call MPI_AllReduce(MPI_IN_PLACE, comp_proc_list(:,i), maxprocspercomp, MPI_INTEGER, MPI_MAX, Global_comm, ierr) + enddo if(asyncio_ntasks == 0) then call shr_sys_abort(subname//' ERROR: ASYNC IO Requested but no IO PES assigned') endif - do i=1,do_async_init - do j=1,driverpecount - if(comp_proc_list(j,i) == -1) then - do k=j+1,driverpecount - if(comp_proc_list(k,i) >= 0) then - comp_proc_list(j,i) = comp_proc_list(k,i) - comp_proc_list(k,i) = -1 - exit - endif - enddo - endif - enddo - enddo - allocate(async_iosystems(do_async_init)) allocate(async_procs_per_comp(do_async_init)) j=1 @@ -441,11 +439,10 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) enddo ! IO tasks should not return until the run is completed - !ierr = pio_set_log_level(3) - + !ierr = pio_set_log_level(1) call ESMF_LogWrite(trim(subname)//": call async pio_init", ESMF_LOGMSG_INFO) if (chkerr(rc,__LINE__,u_FILE_u)) return - call MPI_AllReduce(pio_comp_settings(1)%pio_rearranger, async_rearr, 1, MPI_INTEGER, & + call MPI_AllReduce(MPI_IN_PLACE, async_rearr, 1, MPI_INTEGER, & MPI_MAX, Global_comm, rc) call pio_init(async_iosystems, Global_comm, async_procs_per_comp, & comp_proc_list, asyncio_petlist, & @@ -461,20 +458,20 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) endif endif call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - + if(associated(petLists)) deallocate(petLists) if(associated(gcomp)) deallocate(gcomp) end subroutine driver_pio_component_init - subroutine driver_pio_log_comp_settings(gcomp, logunit, rc) + subroutine driver_pio_log_comp_settings(gcomp, rc) use ESMF, only : ESMF_GridComp, ESMF_GridCompGet, ESMF_SUCCESS use NUOPC, only: NUOPC_CompAttributeGet type(ESMF_GridComp) :: gcomp - integer, intent(in) :: logunit integer, intent(out) :: rc integer :: compid character(len=CS) :: name, cval integer :: i + integer :: logunit logical :: isPresent rc = ESMF_SUCCESS @@ -488,6 +485,11 @@ subroutine driver_pio_log_comp_settings(gcomp, logunit, rc) read(cval, *) compid i = shr_pio_getindex(compid) endif + + logunit = 6 + call NUOPC_CompAttributeGet(gcomp, name="logunit", value=logunit, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if(pio_comp_settings(i)%pio_async_interface) then write(logunit,*) trim(name),': using ASYNC IO interface' else diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index 7a89e8efa..a52f154a9 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -132,7 +132,7 @@ end subroutine get_component_instance !=============================================================================== subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) - use driver_pio_mod, only : driver_pio_log_comp_settings + use NUOPC, only: NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd ! input/output variables type(ESMF_GridComp) :: gcomp logical, intent(in) :: mastertask @@ -173,7 +173,10 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//": setting logunit for component: "//trim(name), ESMF_LOGMSG_INFO) - + call NUOPC_CompAttributeAdd(gcomp, (/"logunit"/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, "logunit", logunit, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_log_setLogUnit (logunit) ! Still need to set this return value shrlogunit = logunit diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index 7368a1fd2..6a939b32a 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -260,4 +260,37 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/mediator/med.F90 b/mediator/med.F90 index 867c6d056..4c82eff4e 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -567,7 +567,6 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) character(len=CX) :: diro character(len=CX) :: logfile character(len=CX) :: diagfile - character(len=CX) :: do_budgets character(len=*), parameter :: subname = '('//__FILE__//':InitializeP0)' !----------------------------------------------------------- @@ -672,7 +671,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) ! local variables character(len=CS) :: stdname, shortname - integer :: n, n1, n2, ncomp, nflds, ns + integer :: ncomp, ns logical :: isPresent, isSet character(len=CS) :: transferOffer character(len=CS) :: cvalue @@ -895,7 +894,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//':Fr_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) fld => fld%next end do - + fldListTo => med_fldList_GetFldListTo(ncomp) fld => fldListTo%fields do while(associated(fld)) @@ -1066,7 +1065,7 @@ subroutine realizeConnectedGrid(State,string,rc) integer :: dimCount, tileCount integer :: connectionCount integer :: fieldCount - integer :: i, j, n, n1, i1, i2 + integer :: n, n1, i1, i2 type(ESMF_GeomType_Flag) :: geomtype type(ESMF_FieldStatus_Flag) :: fieldStatus character(len=CX) :: msgString @@ -1333,7 +1332,7 @@ subroutine RealizeFieldsWithTransferAccept(gcomp, importState, exportState, cloc ! local variables type(InternalState) :: is_local - integer :: n1,n2 + integer :: n1 character(len=*), parameter :: subname = '('//__FILE__//':RealizeFieldsWithTransferAccept)' !----------------------------------------------------------- @@ -1582,24 +1581,19 @@ subroutine DataInitialize(gcomp, rc) ! local variables type(InternalState) :: is_local - type(ESMF_VM) :: vm type(ESMF_Clock) :: clock type(ESMF_State) :: importState, exportState type(ESMF_Time) :: time type(ESMF_Field) :: field - type(ESMF_StateItem_Flag) :: itemType type(med_fldList_type), pointer :: fldListMed_ocnalb - logical :: atCorrectTime, connected - integer :: n1,n2,n,ns + logical :: atCorrectTime + integer :: n1,n2,n integer :: nsrc,ndst - integer :: cntn1, cntn2 integer :: fieldCount character(ESMF_MAXSTR),allocatable :: fieldNameList(:) character(CL), pointer :: fldnames(:) character(CL) :: cvalue - character(CL) :: start_type logical :: read_restart - logical :: isPresent, isSet logical :: allDone = .false. logical,save :: first_call = .true. real(r8) :: real_nx, real_ny @@ -2207,11 +2201,9 @@ subroutine SetRunClock(gcomp, rc) type(ESMF_TimeInterval) :: timeStep type(ESMF_Alarm) :: stop_alarm character(len=CL) :: cvalue - character(len=CL) :: name, stop_option + character(len=CL) :: stop_option integer :: stop_n, stop_ymd - logical :: first_time = .true. logical, save :: stopalarmcreated=.false. - integer :: alarmcount character(len=*), parameter :: subname = '('//__FILE__//':SetRunClock)' !----------------------------------------------------------- From de5592ee98f8344ee1749368ab6f4764c4a5a651 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 15 Dec 2022 14:17:41 -0700 Subject: [PATCH 164/395] set wallclock time for tests --- cesm/driver/ensemble_driver.F90 | 6 +++--- cime_config/testdefs/testlist_drv.xml | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 197657a27..59c0ed395 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -240,10 +240,10 @@ subroutine SetModelServices(ensemble_driver, rc) call ESMF_VMGet(vm, localPet=localPet, PetCount=PetCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ntasks_per_member = PetCount/number_of_members - pio_asyncio_ntasks - if(ntasks_per_member*number_of_members .ne. (PetCount - pio_asyncio_ntasks)) then + ntasks_per_member = PetCount/number_of_members - pio_asyncio_ntasks*number_of_members + if(ntasks_per_member*number_of_members .ne. (PetCount - pio_asyncio_ntasks*number_of_members)) then write (msgstr,'(a,i5,a,i3,a,i3,a)') & - "PetCount - Async IOtasks (",PetCount-pio_asyncio_ntasks,") must be evenly divisable by number of members (",number_of_members,")" + "PetCount - Async IOtasks (",PetCount-pio_asyncio_ntasks*number_of_members,") must be evenly divisable by number of members (",number_of_members,")" call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return endif diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index 6a939b32a..b84ea4a7d 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -276,7 +276,7 @@ - + @@ -286,7 +286,7 @@ - + From 3b1c33e98037c271238f2014385d0d3fca2a8150 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 15 Dec 2022 14:19:46 -0700 Subject: [PATCH 165/395] update to xgrid as default --- cime_config/namelist_definition_drv.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index e35ff537d..4a5b34fca 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -887,11 +887,11 @@ MED_attributes ogrid,agrid,xgrid - Grid for atm ocn flux calc (untested) - default: ocn + Grid for atm ocn flux calc + default: xgrid - ogrid + xgrid From 9ca645141e9b79e86731d4c93619600eeaefdae8 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 15 Dec 2022 15:31:02 -0700 Subject: [PATCH 166/395] fix typo --- cime_config/testdefs/testlist_drv.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index b84ea4a7d..01fb96b17 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -263,7 +263,7 @@ - From b1a7c69dddb580a77a41eeb03bc0489f1d9a8246 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Sat, 17 Dec 2022 07:29:49 -0700 Subject: [PATCH 167/395] add asyncio tests to prealpha --- cesm/nuopc_cap_share/driver_pio_mod.F90 | 4 ++-- cime_config/testdefs/testlist_drv.xml | 7 +++---- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index cfca1cce4..dd59b88ac 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -431,8 +431,8 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) if(async_rearr == 0) then async_rearr = pio_comp_settings(i)%pio_rearranger elseif(async_rearr .ne. pio_comp_settings(i)%pio_rearranger) then - - call shr_sys_abort(subname//' ERROR: all async component rearrangers must match') + write(msgstr,*) i,async_rearr,pio_comp_settings(i)%pio_rearranger + call shr_sys_abort(subname//' ERROR: all async component rearrangers must match '//msgstr) endif endif endif diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index 01fb96b17..ec86e5989 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -263,7 +263,7 @@ - + @@ -272,7 +272,7 @@ - + @@ -282,7 +282,7 @@ - + @@ -292,5 +292,4 @@ - From 467f47e92ab3870a6f8d1d0ba34c6183213743c7 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Sun, 18 Dec 2022 07:36:05 -0700 Subject: [PATCH 168/395] remove multi_driver, add precommit config file --- .pre-commit-config.yaml | 24 ++ cime_config/buildnml | 567 +++++++++++++++++++++++----------------- 2 files changed, 351 insertions(+), 240 deletions(-) create mode 100644 .pre-commit-config.yaml diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml new file mode 100644 index 000000000..a382ff1fd --- /dev/null +++ b/.pre-commit-config.yaml @@ -0,0 +1,24 @@ +exclude: ^utils/.*$ + +repos: + - repo: https://github.com/pre-commit/pre-commit-hooks + rev: v4.0.1 + hooks: + - id: check-xml + files: cime_config/ + - id: end-of-file-fixer + exclude: doc/ + - id: trailing-whitespace + exclude: doc/ + - repo: https://github.com/psf/black + rev: 22.3.0 + hooks: + - id: black + files: ./ + - repo: https://github.com/PyCQA/pylint + rev: v2.11.1 + hooks: + - id: pylint + args: + - --disable=I,C,R,logging-not-lazy,wildcard-import,unused-wildcard-import,fixme,broad-except,bare-except,eval-used,exec-used,global-statement,logging-format-interpolation,no-name-in-module,arguments-renamed,unspecified-encoding,protected-access,import-error,no-member + files: cime_config diff --git a/cime_config/buildnml b/cime_config/buildnml index fd5d73df0..32d6df1c0 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -17,259 +17,308 @@ from CIME.utils import expect from CIME.utils import get_model, get_time_in_seconds, get_timestamp from CIME.buildnml import create_namelist_infile, parse_input from CIME.XML.files import Files -#pylint: disable=undefined-variable + +# pylint: disable=undefined-variable logger = logging.getLogger(__name__) ############################################################################### def _create_drv_namelists(case, infile, confdir, nmlgen, files): -############################################################################### + ############################################################################### - #-------------------------------- + # -------------------------------- # Set up config dictionary - #-------------------------------- + # -------------------------------- config = {} cime_model = get_model() - config['cime_model'] = cime_model - config['iyear'] = case.get_value('COMPSET').split('_')[0] - config['BGC_MODE'] = case.get_value("CCSM_BGC") - config['CPL_I2O_PER_CAT'] = case.get_value('CPL_I2O_PER_CAT') - config['DRV_THREADING'] = case.get_value('DRV_THREADING') - config['CPL_ALBAV'] = case.get_value('CPL_ALBAV') - config['CPL_EPBAL'] = case.get_value('CPL_EPBAL') - config['FLDS_WISO'] = case.get_value('FLDS_WISO') - config['BUDGETS'] = case.get_value('BUDGETS') - config['MACH'] = case.get_value('MACH') - config['MPILIB'] = case.get_value('MPILIB') - config['OS'] = case.get_value('OS') - config['glc_nec'] = 0 if case.get_value('GLC_NEC') == 0 else case.get_value('GLC_NEC') - config['timer_level'] = 'pos' if case.get_value('TIMER_LEVEL') >= 1 else 'neg' - config['continue_run'] = '.true.' if case.get_value('CONTINUE_RUN') else '.false.' - config['flux_epbal'] = 'ocn' if case.get_value('CPL_EPBAL') == 'ocn' else 'off' - config['mask_grid'] = case.get_value('MASK_GRID') - config['rest_option'] = case.get_value('REST_OPTION') - config['comp_ocn'] = case.get_value('COMP_OCN') - - atm_grid = case.get_value('ATM_GRID') - lnd_grid = case.get_value('LND_GRID') - ice_grid = case.get_value('ICE_GRID') - ocn_grid = case.get_value('OCN_GRID') - rof_grid = case.get_value('ROF_GRID') - wav_grid = case.get_value('WAV_GRID') - #pylint: disable=unused-variable - glc_grid = case.get_value('GLC_GRID') - - config['atm_grid'] = atm_grid - config['lnd_grid'] = lnd_grid - config['ice_grid'] = ice_grid - config['ocn_grid'] = ocn_grid + config["cime_model"] = cime_model + config["iyear"] = case.get_value("COMPSET").split("_")[0] + config["BGC_MODE"] = case.get_value("CCSM_BGC") + config["CPL_I2O_PER_CAT"] = case.get_value("CPL_I2O_PER_CAT") + config["DRV_THREADING"] = case.get_value("DRV_THREADING") + config["CPL_ALBAV"] = case.get_value("CPL_ALBAV") + config["CPL_EPBAL"] = case.get_value("CPL_EPBAL") + config["FLDS_WISO"] = case.get_value("FLDS_WISO") + config["BUDGETS"] = case.get_value("BUDGETS") + config["MACH"] = case.get_value("MACH") + config["MPILIB"] = case.get_value("MPILIB") + config["OS"] = case.get_value("OS") + config["glc_nec"] = ( + 0 if case.get_value("GLC_NEC") == 0 else case.get_value("GLC_NEC") + ) + config["timer_level"] = "pos" if case.get_value("TIMER_LEVEL") >= 1 else "neg" + config["continue_run"] = ".true." if case.get_value("CONTINUE_RUN") else ".false." + config["flux_epbal"] = "ocn" if case.get_value("CPL_EPBAL") == "ocn" else "off" + config["mask_grid"] = case.get_value("MASK_GRID") + config["rest_option"] = case.get_value("REST_OPTION") + config["comp_ocn"] = case.get_value("COMP_OCN") + + atm_grid = case.get_value("ATM_GRID") + lnd_grid = case.get_value("LND_GRID") + ice_grid = case.get_value("ICE_GRID") + ocn_grid = case.get_value("OCN_GRID") + # pylint: disable=unused-variable + rof_grid = case.get_value("ROF_GRID") + # pylint: disable=unused-variable + wav_grid = case.get_value("WAV_GRID") + # pylint: disable=unused-variable + glc_grid = case.get_value("GLC_GRID") + + config["atm_grid"] = atm_grid + config["lnd_grid"] = lnd_grid + config["ice_grid"] = ice_grid + config["ocn_grid"] = ocn_grid atm_mesh = case.get_value("ATM_DOMAIN_MESH") lnd_mesh = case.get_value("LND_DOMAIN_MESH") rof_mesh = case.get_value("ROF_DOMAIN_MESH") - config['samegrid_atm_lnd'] = 'true' if atm_mesh == case.get_value("LND_DOMAIN_MESH") else 'false' - config['samegrid_atm_ocn'] = 'true' if atm_mesh == case.get_value("OCN_DOMAIN_MESH") else 'false' - config['samegrid_atm_ice'] = 'true' if atm_mesh == case.get_value("ICE_DOMAIN_MESH") else 'false' - config['samegrid_atm_wav'] = 'true' if atm_mesh == case.get_value("WAV_DOMAIN_MESH") else 'false' - config['samegrid_lnd_rof'] = 'true' if lnd_mesh == rof_mesh else 'false' + config["samegrid_atm_lnd"] = ( + "true" if atm_mesh == case.get_value("LND_DOMAIN_MESH") else "false" + ) + config["samegrid_atm_ocn"] = ( + "true" if atm_mesh == case.get_value("OCN_DOMAIN_MESH") else "false" + ) + config["samegrid_atm_ice"] = ( + "true" if atm_mesh == case.get_value("ICE_DOMAIN_MESH") else "false" + ) + config["samegrid_atm_wav"] = ( + "true" if atm_mesh == case.get_value("WAV_DOMAIN_MESH") else "false" + ) + config["samegrid_lnd_rof"] = "true" if lnd_mesh == rof_mesh else "false" # determine if need to set atm_domainfile - scol_lon = float(case.get_value('PTS_LON')) - scol_lat = float(case.get_value('PTS_LAT')) - if scol_lon > -999. and scol_lat > -999. and case.get_value("ATM_DOMAIN_FILE") != "UNSET": - config['single_column'] = 'true' + scol_lon = float(case.get_value("PTS_LON")) + scol_lat = float(case.get_value("PTS_LAT")) + if ( + scol_lon > -999.0 + and scol_lat > -999.0 + and case.get_value("ATM_DOMAIN_FILE") != "UNSET" + ): + config["single_column"] = "true" else: - config['single_column'] = 'false' + config["single_column"] = "false" # needed for determining the run sequence as well as glc_renormalize_smb - config['COMP_ATM'] = case.get_value("COMP_ATM") - config['COMP_ICE'] = case.get_value("COMP_ICE") - config['COMP_GLC'] = case.get_value("COMP_GLC") - config['COMP_LND'] = case.get_value("COMP_LND") - config['COMP_OCN'] = case.get_value("COMP_OCN") - config['COMP_ROF'] = case.get_value("COMP_ROF") - config['COMP_WAV'] = case.get_value("COMP_WAV") - - if ((case.get_value("COMP_ROF") == 'mosart' and case.get_value("MOSART_MODE") == 'NULL') or - (case.get_value("COMP_ROF") == 'rtm' and case.get_value("RTM_MODE") == 'NULL') or - (case.get_value("ROF_GRID") == 'null')): - config['ROF_MODE'] = 'null' - - if case.get_value('RUN_TYPE') == 'startup': - config['run_type'] = 'startup' - elif case.get_value('RUN_TYPE') == 'hybrid': - config['run_type'] = 'startup' - elif case.get_value('RUN_TYPE') == 'branch': - config['run_type'] = 'branch' - - #---------------------------------------------------- + config["COMP_ATM"] = case.get_value("COMP_ATM") + config["COMP_ICE"] = case.get_value("COMP_ICE") + config["COMP_GLC"] = case.get_value("COMP_GLC") + config["COMP_LND"] = case.get_value("COMP_LND") + config["COMP_OCN"] = case.get_value("COMP_OCN") + config["COMP_ROF"] = case.get_value("COMP_ROF") + config["COMP_WAV"] = case.get_value("COMP_WAV") + + if ( + ( + case.get_value("COMP_ROF") == "mosart" + and case.get_value("MOSART_MODE") == "NULL" + ) + or ( + case.get_value("COMP_ROF") == "rtm" and case.get_value("RTM_MODE") == "NULL" + ) + or (case.get_value("ROF_GRID") == "null") + ): + config["ROF_MODE"] = "null" + + if case.get_value("RUN_TYPE") == "startup": + config["run_type"] = "startup" + elif case.get_value("RUN_TYPE") == "hybrid": + config["run_type"] = "startup" + elif case.get_value("RUN_TYPE") == "branch": + config["run_type"] = "branch" + + # ---------------------------------------------------- # Initialize namelist defaults - #---------------------------------------------------- + # ---------------------------------------------------- nmlgen.init_defaults(infile, config, skip_default_for_groups=["modelio"]) - #-------------------------------- + # -------------------------------- # Set default wav-ice coupling (assumes cice6 as the ice component - #-------------------------------- - if (case.get_value("COMP_WAV") == 'ww3dev' and case.get_value("COMP_ICE") == 'cice'): - nmlgen.add_default('wavice_coupling', value='.true.') + # -------------------------------- + if case.get_value("COMP_WAV") == "ww3dev" and case.get_value("COMP_ICE") == "cice": + nmlgen.add_default("wavice_coupling", value=".true.") - #-------------------------------- + # -------------------------------- # Overwrite: set brnch_retain_casename - #-------------------------------- - start_type = nmlgen.get_value('start_type') - if start_type != 'startup': - if case.get_value('CASE') == case.get_value('RUN_REFCASE'): - nmlgen.set_value('brnch_retain_casename' , value='.true.') + # -------------------------------- + start_type = nmlgen.get_value("start_type") + if start_type != "startup": + if case.get_value("CASE") == case.get_value("RUN_REFCASE"): + nmlgen.set_value("brnch_retain_casename", value=".true.") # set aquaplanet if appropriate - if config['COMP_OCN'] == 'docn' and 'aqua' in case.get_value("DOCN_MODE"): - nmlgen.set_value('aqua_planet' , value='.true.') + if config["COMP_OCN"] == "docn" and "aqua" in case.get_value("DOCN_MODE"): + nmlgen.set_value("aqua_planet", value=".true.") - #-------------------------------- + # -------------------------------- # Overwrite: set component coupling frequencies - #-------------------------------- - ncpl_base_period = case.get_value('NCPL_BASE_PERIOD') - if ncpl_base_period == 'hour': + # -------------------------------- + ncpl_base_period = case.get_value("NCPL_BASE_PERIOD") + if ncpl_base_period == "hour": basedt = 3600 - elif ncpl_base_period == 'day': + elif ncpl_base_period == "day": basedt = 3600 * 24 - elif ncpl_base_period == 'year': - if case.get_value('CALENDAR') == 'NO_LEAP': + elif ncpl_base_period == "year": + if case.get_value("CALENDAR") == "NO_LEAP": basedt = 3600 * 24 * 365 else: - expect(False, "Invalid CALENDAR for NCPL_BASE_PERIOD %s " %ncpl_base_period) - elif ncpl_base_period == 'decade': - if case.get_value('CALENDAR') == 'NO_LEAP': + expect( + False, "Invalid CALENDAR for NCPL_BASE_PERIOD %s " % ncpl_base_period + ) + elif ncpl_base_period == "decade": + if case.get_value("CALENDAR") == "NO_LEAP": basedt = 3600 * 24 * 365 * 10 else: - expect(False, "invalid NCPL_BASE_PERIOD NCPL_BASE_PERIOD %s " %ncpl_base_period) + expect( + False, + "invalid NCPL_BASE_PERIOD NCPL_BASE_PERIOD %s " % ncpl_base_period, + ) else: - expect(False, "invalid NCPL_BASE_PERIOD NCPL_BASE_PERIOD %s " %ncpl_base_period) + expect( + False, "invalid NCPL_BASE_PERIOD NCPL_BASE_PERIOD %s " % ncpl_base_period + ) if basedt < 0: - expect(False, "basedt invalid overflow for NCPL_BASE_PERIOD %s " %ncpl_base_period) - + expect( + False, "basedt invalid overflow for NCPL_BASE_PERIOD %s " % ncpl_base_period + ) # determine coupling intervals comps = case.get_values("COMP_CLASSES") mindt = basedt coupling_times = {} for comp in comps: - ncpl = case.get_value(comp.upper() + '_NCPL') + ncpl = case.get_value(comp.upper() + "_NCPL") if ncpl is not None: cpl_dt = basedt // int(ncpl) totaldt = cpl_dt * int(ncpl) if totaldt != basedt: - expect(False, " %s ncpl doesn't divide base dt evenly" %comp) - nmlgen.add_default(comp.lower() + '_cpl_dt', value=cpl_dt) - coupling_times[comp.lower() + '_cpl_dt'] = cpl_dt + expect(False, " %s ncpl doesn't divide base dt evenly" % comp) + nmlgen.add_default(comp.lower() + "_cpl_dt", value=cpl_dt) + coupling_times[comp.lower() + "_cpl_dt"] = cpl_dt mindt = min(mindt, cpl_dt) # sanity check comp_atm = case.get_value("COMP_ATM") - if comp_atm is not None and comp_atm not in('datm', 'xatm', 'satm'): - atmdt = int(basedt / case.get_value('ATM_NCPL')) - expect(atmdt == mindt, 'Active atm should match shortest model timestep atmdt={} mindt={}' - .format(atmdt, mindt)) - - #-------------------------------- + if comp_atm is not None and comp_atm not in ("datm", "xatm", "satm"): + atmdt = int(basedt / case.get_value("ATM_NCPL")) + expect( + atmdt == mindt, + "Active atm should match shortest model timestep atmdt={} mindt={}".format( + atmdt, mindt + ), + ) + + # -------------------------------- # Overwrite: set start_ymd - #-------------------------------- - run_startdate = "".join(str(x) for x in case.get_value('RUN_STARTDATE').split('-')) - nmlgen.set_value('start_ymd', value=run_startdate) + # -------------------------------- + run_startdate = "".join(str(x) for x in case.get_value("RUN_STARTDATE").split("-")) + nmlgen.set_value("start_ymd", value=run_startdate) - #-------------------------------- + # -------------------------------- # Overwrite: set tprof_option and tprof_n - if tprof_total is > 0 - #-------------------------------- + # -------------------------------- # This would be better handled inside the alarm logic in the driver routines. # Here supporting only nday(s), nmonth(s), and nyear(s). - stop_option = case.get_value('STOP_OPTION') - if 'nyear' in stop_option: - tprofoption = 'ndays' + stop_option = case.get_value("STOP_OPTION") + if "nyear" in stop_option: + tprofoption = "ndays" tprofmult = 365 - elif 'nmonth' in stop_option: - tprofoption = 'ndays' + elif "nmonth" in stop_option: + tprofoption = "ndays" tprofmult = 30 - elif 'nday' in stop_option: - tprofoption = 'ndays' + elif "nday" in stop_option: + tprofoption = "ndays" tprofmult = 1 else: tprofmult = 1 - tprofoption = 'never' - - tprof_total = case.get_value('TPROF_TOTAL') - if ((tprof_total > 0) and (case.get_value('STOP_DATE') < 0) and ('ndays' in tprofoption)): - stop_n = case.get_value('STOP_N') + tprofoption = "never" + + tprof_total = case.get_value("TPROF_TOTAL") + if ( + (tprof_total > 0) + and (case.get_value("STOP_DATE") < 0) + and ("ndays" in tprofoption) + ): + stop_n = case.get_value("STOP_N") stopn = tprofmult * stop_n tprofn = int(stopn / tprof_total) if tprofn < 1: tprofn = 1 - nmlgen.set_value('tprof_option', value=tprofoption) - nmlgen.set_value('tprof_n' , value=tprofn) + nmlgen.set_value("tprof_option", value=tprofoption) + nmlgen.set_value("tprof_n", value=tprofn) # Set up the pause_component_list if pause is active - pauseo = case.get_value('PAUSE_OPTION') - if pauseo != 'never' and pauseo != 'none': - pausen = case.get_value('PAUSE_N') - pcl = nmlgen.get_default('pause_component_list') - nmlgen.add_default('pause_component_list', pcl) + pauseo = case.get_value("PAUSE_OPTION") + if pauseo != "never" and pauseo != "none": + pausen = case.get_value("PAUSE_N") + pcl = nmlgen.get_default("pause_component_list") + nmlgen.add_default("pause_component_list", pcl) # Check to make sure pause_component_list is valid - pcl = nmlgen.get_value('pause_component_list') - if pcl != 'none' and pcl != 'all': - pause_comps = pcl.split(':') + pcl = nmlgen.get_value("pause_component_list") + if pcl != "none" and pcl != "all": + pause_comps = pcl.split(":") comp_classes = case.get_values("COMP_CLASSES") for comp in pause_comps: - expect(comp == 'drv' or comp.upper() in comp_classes, - "Invalid PAUSE_COMPONENT_LIST, %s is not a valid component type"%comp) + expect( + comp == "drv" or comp.upper() in comp_classes, + "Invalid PAUSE_COMPONENT_LIST, %s is not a valid component type" + % comp, + ) # End for # End if # Set esp interval - if 'nstep' in pauseo: + if "nstep" in pauseo: esp_time = mindt else: esp_time = get_time_in_seconds(pausen, pauseo) - nmlgen.set_value('esp_cpl_dt', value=esp_time) + nmlgen.set_value("esp_cpl_dt", value=esp_time) # End if pause is active - #-------------------------------- + # -------------------------------- # Specify input data list file - #-------------------------------- - data_list_path = os.path.join(case.get_case_root(), "Buildconf", "cpl.input_data_list") + # -------------------------------- + data_list_path = os.path.join( + case.get_case_root(), "Buildconf", "cpl.input_data_list" + ) if os.path.exists(data_list_path): os.remove(data_list_path) - #-------------------------------- + # -------------------------------- # Write namelist file drv_in and initial input dataset list. - #-------------------------------- + # -------------------------------- namelist_file = os.path.join(confdir, "drv_in") drv_namelist_groups = ["papi_inparm", "prof_inparm", "debug_inparm"] - nmlgen.write_output_file(namelist_file, data_list_path=data_list_path, groups=drv_namelist_groups) + nmlgen.write_output_file( + namelist_file, data_list_path=data_list_path, groups=drv_namelist_groups + ) - #-------------------------------- + # -------------------------------- # Write nuopc.runconfig file and add to input dataset list. - #-------------------------------- - + # -------------------------------- # Determine valid components valid_comps = [] for item in case.get_values("COMP_CLASSES"): comp = case.get_value("COMP_" + item) valid = True - # stub comps - if comp == 's' + item.lower(): + if comp == "s" + item.lower(): + # stub comps valid = False - # xcpl_comps - elif comp == 'x' + item.lower(): - if item != 'ESP': #no esp xcpl component - if case.get_value(item + "_NX") == "0" and case.get_value(item + "_NY") == "0": + elif comp == "x" + item.lower(): + # xcpl_comps + if item != "ESP": # no esp xcpl component + if ( + case.get_value(item + "_NX") == "0" + and case.get_value(item + "_NY") == "0" + ): valid = False - # special case - mosart in NULL mode - elif (comp == 'mosart'): - if (case.get_value("MOSART_MODE") == 'NULL'): + elif comp == "mosart": + # special case - mosart in NULL mode + if case.get_value("MOSART_MODE") == "NULL": valid = False - # special case - rtm in NULL mode - elif (comp == 'rtm'): - if (case.get_value("RTM_MODE") == 'NULL'): + elif comp == "rtm": + # special case - rtm in NULL mode + if case.get_value("RTM_MODE") == "NULL": valid = False if valid: valid_comps.append(item) @@ -278,7 +327,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): datamodel_in_compset = False comp_classes = case.get_values("COMP_CLASSES") for comp in comp_classes: - dcompname = "d"+comp.lower() + dcompname = "d" + comp.lower() if dcompname in case.get_value("COMP_{}".format(comp)): datamodel_in_compset = True @@ -287,12 +336,14 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): if len(valid_comps) == 2 and not datamodel_in_compset: # skip the mediator if there is a prognostic component and all other components are stub valid_comps.remove("CPL") - nmlgen.set_value('mediator_present', value='.false.') + nmlgen.set_value("mediator_present", value=".false.") nmlgen.set_value("component_list", value=" ".join(valid_comps)) else: # do not skip mediator if there is a data component but all other components are stub valid_comps_string = " ".join(valid_comps) - nmlgen.set_value("component_list", value=valid_comps_string.replace("CPL","MED")) + nmlgen.set_value( + "component_list", value=valid_comps_string.replace("CPL", "MED") + ) # the driver restart pointer will look like a mediator is present even if it is not nmlgen.set_value("drv_restart_pointer", value="rpointer.cpl") @@ -304,53 +355,49 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): lid = os.environ["LID"] if "LID" in os.environ else get_timestamp("%y%m%d-%H%M%S") - #if we are in multi-coupler mode the number of instances of mediator will be the max + # if we are in multi-coupler mode the number of instances of mediator will be the max # of any NINST_* value maxinst = 1 - if case.get_value("MULTI_DRIVER"): - maxinst = case.get_value("NINST_MAX") - multi_driver = True - with open(nuopc_config_file, 'a', encoding="utf-8") as conffile: + + with open(nuopc_config_file, "a", encoding="utf-8") as conffile: nmlgen.write_nuopc_config_file(conffile, data_list_path=data_list_path) - for model in case.get_values("COMP_CLASSES") + ['DRV']: + for model in case.get_values("COMP_CLASSES") + ["DRV"]: model = model.lower() config = {} - config['component'] = model + config["component"] = model nmlgen.init_defaults([], config, skip_entry_loop=True) - if model == 'cpl': + if model == "cpl": newgroup = "MED_modelio" else: - newgroup = model.upper()+"_modelio" + newgroup = model.upper() + "_modelio" nmlgen.rename_group("modelio", newgroup) - if maxinst == 1 and model != 'cpl' and not multi_driver: - inst_count = case.get_value("NINST_" + model.upper()) - else: - inst_count = maxinst - if not model == 'drv': - for entry in ["pio_async_interface", - "pio_netcdf_format", - "pio_numiotasks", - "pio_rearranger", - "pio_root", - "pio_stride", - "pio_typename"]: + inst_count = maxinst + if not model == "drv": + for entry in [ + "pio_async_interface", + "pio_netcdf_format", + "pio_numiotasks", + "pio_rearranger", + "pio_root", + "pio_stride", + "pio_typename", + ]: nmlgen.add_default(entry) - inst_string = "" inst_index = 1 while inst_index <= inst_count: - # determine instance string + # determine instance string if inst_count > 1: - inst_string = '_{:04d}'.format(inst_index) + inst_string = "_{:04d}".format(inst_index) # Output the following to nuopc.runconfig - nmlgen.set_value("diro", case.get_value('RUNDIR')) - if model == 'cpl': - logfile = 'med' + inst_string + ".log." + str(lid) - elif model == 'drv': + nmlgen.set_value("diro", case.get_value("RUNDIR")) + if model == "cpl": + logfile = "med" + inst_string + ".log." + str(lid) + elif model == "drv": logfile = model + ".log." + str(lid) else: logfile = model + inst_string + ".log." + str(lid) @@ -358,24 +405,31 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): inst_index = inst_index + 1 nmlgen.write_nuopc_config_file(conffile) - #-------------------------------- + # -------------------------------- # Update nuopc.runconfig file if component needs it - #-------------------------------- + # -------------------------------- # Read nuopc.runconfig - with open(nuopc_config_file, 'r', encoding="utf-8") as f: + with open(nuopc_config_file, "r", encoding="utf-8") as f: lines_cpl = f.readlines() # Look for only active components except CPL lines_comp = [] for comp in comps: - if comp != 'CPL' and case.get_value("COMP_{}".format(comp)) != 'd'+comp.lower(): + if ( + comp != "CPL" + and case.get_value("COMP_{}".format(comp)) != "d" + comp.lower() + ): # Read *.configure file for component - caseroot = case.get_value('CASEROOT') - comp_config_file = os.path.join(caseroot,"Buildconf","{}conf".format(case.get_value("COMP_{}".format(comp))), - "{}.configure".format(case.get_value("COMP_{}".format(comp)))) + caseroot = case.get_value("CASEROOT") + comp_config_file = os.path.join( + caseroot, + "Buildconf", + "{}conf".format(case.get_value("COMP_{}".format(comp))), + "{}.configure".format(case.get_value("COMP_{}".format(comp))), + ) if os.path.isfile(comp_config_file): - with open(comp_config_file, 'r', encoding="utf-8") as f: + with open(comp_config_file, "r", encoding="utf-8") as f: lines_comp = f.readlines() if lines_comp: @@ -393,25 +447,25 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): lines_cpl_new.append(line_comp) # Write to a file - with open(nuopc_config_file, 'w', encoding="utf-8") as f: + with open(nuopc_config_file, "w", encoding="utf-8") as f: for line in lines_cpl_new: f.write(line) - #-------------------------------- + # -------------------------------- # Write nuopc.runseq - #-------------------------------- + # -------------------------------- _create_runseq(case, coupling_times, valid_comps) - #-------------------------------- + # -------------------------------- # Write drv_flds_in - #-------------------------------- + # -------------------------------- # In thte following, all values come simply from the infiles - no default values need to be added # FIXME - do want to add the possibility that will use a user definition file for drv_flds_in - caseroot = case.get_value('CASEROOT') + caseroot = case.get_value("CASEROOT") namelist_file = os.path.join(confdir, "drv_flds_in") - nmlgen.add_default('drv_flds_in_files') - drvflds_files = nmlgen.get_default('drv_flds_in_files') + nmlgen.add_default("drv_flds_in_files") + drvflds_files = nmlgen.get_default("drv_flds_in_files") infiles = [] for drvflds_file in drvflds_files: infile = os.path.join(caseroot, drvflds_file) @@ -427,31 +481,36 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): dict_ = {} with open(infile, "r", encoding="utf-8") as myfile: for line in myfile: - if "=" in line and '!' not in line: + if "=" in line and "!" not in line: name, var = line.partition("=")[::2] name = name.strip() var = var.strip() dict_[name] = var dicts[infile] = dict_ - for first,second in itertools.combinations(dicts.keys(),2): + for first, second in itertools.combinations(dicts.keys(), 2): compare_drv_flds_in(dicts[first], dicts[second], first, second) # Now create drv_flds_in config = {} - definition_dir = os.path.dirname(files.get_value("NAMELIST_DEFINITION_FILE", attribute={"component":"drv"})) - definition_file = [os.path.join(definition_dir, "namelist_definition_drv_flds.xml")] + definition_dir = os.path.dirname( + files.get_value("NAMELIST_DEFINITION_FILE", attribute={"component": "drv"}) + ) + definition_file = [ + os.path.join(definition_dir, "namelist_definition_drv_flds.xml") + ] nmlgen = NamelistGenerator(case, definition_file, files=files) skip_entry_loop = True nmlgen.init_defaults(infiles, config, skip_entry_loop=skip_entry_loop) drv_flds_in = os.path.join(caseroot, "CaseDocs", "drv_flds_in") nmlgen.write_output_file(drv_flds_in) + ############################################################################### def _create_runseq(case, coupling_times, valid_comps): -############################################################################### + ############################################################################### - caseroot = case.get_value("CASEROOT") + caseroot = case.get_value("CASEROOT") user_file = os.path.join(caseroot, "nuopc.runseq") rundir = case.get_value("RUNDIR") @@ -459,7 +518,7 @@ def _create_runseq(case, coupling_times, valid_comps): # Determine if there is a user run sequence file in CASEROOT, use it shutil.copy(user_file, rundir) - shutil.copy(user_file, os.path.join(caseroot,"CaseDocs")) + shutil.copy(user_file, os.path.join(caseroot, "CaseDocs")) logger.info("NUOPC run sequence: copying custom run sequence from case root") else: @@ -467,13 +526,17 @@ def _create_runseq(case, coupling_times, valid_comps): if len(valid_comps) == 1: # Create run sequence with no mediator - outfile = open(os.path.join(caseroot, "CaseDocs", "nuopc.runseq"), "w", encoding="utf-8") - dtime = coupling_times[valid_comps[0].lower() + '_cpl_dt'] - outfile.write ("runSeq:: \n") - outfile.write ("@" + str(dtime) + " \n") - outfile.write (" " + valid_comps[0] + " \n") - outfile.write ("@ \n") - outfile.write (":: \n") + outfile = open( + os.path.join(caseroot, "CaseDocs", "nuopc.runseq"), + "w", + encoding="utf-8", + ) + dtime = coupling_times[valid_comps[0].lower() + "_cpl_dt"] + outfile.write("runSeq:: \n") + outfile.write("@" + str(dtime) + " \n") + outfile.write(" " + valid_comps[0] + " \n") + outfile.write("@ \n") + outfile.write(":: \n") outfile.close() shutil.copy(os.path.join(caseroot, "CaseDocs", "nuopc.runseq"), rundir) @@ -488,9 +551,9 @@ def _create_runseq(case, coupling_times, valid_comps): sys.path.append(os.path.join(os.path.dirname(__file__), "runseq")) - if (comp_ice == "cice" and comp_atm == 'datm' and comp_ocn == "docn"): + if comp_ice == "cice" and comp_atm == "datm" and comp_ocn == "docn": from runseq_D import gen_runseq - elif (comp_lnd == 'dlnd' and comp_glc == "cism"): + elif comp_lnd == "dlnd" and comp_glc == "cism": from runseq_TG import gen_runseq else: from runseq_general import gen_runseq @@ -498,37 +561,52 @@ def _create_runseq(case, coupling_times, valid_comps): # create the run sequence gen_runseq(case, coupling_times) + ############################################################################### def compare_drv_flds_in(first, second, infile1, infile2): -############################################################################### + ############################################################################### sharedKeys = set(first.keys()).intersection(second.keys()) for key in sharedKeys: if first[key] != second[key]: - print('Key: {}, \n Value 1: {}, \n Value 2: {}'.format(key, first[key], second[key])) - expect(False, "incompatible settings in drv_flds_in from \n %s \n and \n %s" - % (infile1, infile2)) + print( + "Key: {}, \n Value 1: {}, \n Value 2: {}".format( + key, first[key], second[key] + ) + ) + expect( + False, + "incompatible settings in drv_flds_in from \n %s \n and \n %s" + % (infile1, infile2), + ) + ############################################################################### def buildnml(case, caseroot, component): -############################################################################### + ############################################################################### if component != "drv": raise AttributeError # Do a check here of ESMF VERSION, requires 8.1.0 or newer (8.2.0 or newer for esmf_aware_threading) esmf_aware_threading = case.get_value("ESMF_AWARE_THREADING") esmfmkfile = os.getenv("ESMFMKFILE") - expect(esmfmkfile and os.path.isfile(esmfmkfile),"ESMFMKFILE not found {}".format(esmfmkfile)) - with open(esmfmkfile, 'r', encoding="utf-8") as f: + expect( + esmfmkfile and os.path.isfile(esmfmkfile), + "ESMFMKFILE not found {}".format(esmfmkfile), + ) + with open(esmfmkfile, "r", encoding="utf-8") as f: major = None minor = None for line in f.readlines(): - if 'ESMF_VERSION' in line: - major = line[-2] if 'MAJOR' in line else major - minor = line[-2] if 'MINOR' in line else minor - logger.debug("ESMF version major {} minor {}".format(major,minor)) - expect(int(major) >=8,"ESMF version should be 8.1 or newer") + if "ESMF_VERSION" in line: + major = line[-2] if "MAJOR" in line else major + minor = line[-2] if "MINOR" in line else minor + logger.debug("ESMF version major {} minor {}".format(major, minor)) + expect(int(major) >= 8, "ESMF version should be 8.1 or newer") if esmf_aware_threading: - expect(int(minor) >= 2, "ESMF version should be 8.2.0 or newer when using ESMF_AWARE_THREADING") + expect( + int(minor) >= 2, + "ESMF version should be 8.2.0 or newer when using ESMF_AWARE_THREADING", + ) else: expect(int(minor) >= 1, "ESMF version should be 8.1.0 or newer") @@ -540,17 +618,22 @@ def buildnml(case, caseroot, component): # TODO: Append instead of replace? user_xml_dir = os.path.join(caseroot, "SourceMods", "src.drv") - expect (os.path.isdir(user_xml_dir), - "user_xml_dir %s does not exist " %user_xml_dir) + expect( + os.path.isdir(user_xml_dir), "user_xml_dir %s does not exist " % user_xml_dir + ) files = Files(comp_interface="nuopc") # TODO: to get the right attributes of COMP_ROOT_DIR_CPL in evaluating definition_file - need # to do the following first - this needs to be changed so that the following two lines are not needed! - comp_root_dir_cpl = files.get_value( "COMP_ROOT_DIR_CPL",{"component":"cpl"}, resolved=False) + comp_root_dir_cpl = files.get_value( + "COMP_ROOT_DIR_CPL", {"component": "cpl"}, resolved=False + ) files.set_value("COMP_ROOT_DIR_CPL", comp_root_dir_cpl) - definition_files = [files.get_value("NAMELIST_DEFINITION_FILE", {"component": "cpl"})] + definition_files = [ + files.get_value("NAMELIST_DEFINITION_FILE", {"component": "cpl"}) + ] user_drv_definition = os.path.join(user_xml_dir, "namelist_definition_drv.xml") if os.path.isfile(user_drv_definition): definition_files.append(user_drv_definition) @@ -574,8 +657,8 @@ def buildnml(case, caseroot, component): rundir = case.get_value("RUNDIR") # copy nuopc.runconfig to rundir - shutil.copy(os.path.join(confdir,"drv_in"), rundir) - shutil.copy(os.path.join(confdir,"nuopc.runconfig"), rundir) + shutil.copy(os.path.join(confdir, "drv_in"), rundir) + shutil.copy(os.path.join(confdir, "nuopc.runconfig"), rundir) # copy drv_flds_in to rundir drv_flds_in = os.path.join(caseroot, "CaseDocs", "drv_flds_in") @@ -591,9 +674,12 @@ def buildnml(case, caseroot, component): if os.path.isfile(user_yaml_file): filename = user_yaml_file else: - filename = os.path.join(os.path.dirname(__file__), os.pardir, "mediator", "fd_cesm.yaml") + filename = os.path.join( + os.path.dirname(__file__), os.pardir, "mediator", "fd_cesm.yaml" + ) shutil.copy(filename, os.path.join(rundir, "fd.yaml")) + ############################################################################### def _main_func(): caseroot = parse_input(sys.argv) @@ -601,5 +687,6 @@ def _main_func(): with Case(caseroot) as case: buildnml(case, caseroot, "drv") + if __name__ == "__main__": _main_func() From 67b42d521f2f2adadac2d940a42788f4af28bc93 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 19 Dec 2022 17:02:41 -0700 Subject: [PATCH 169/395] get the tests working --- cesm/driver/ensemble_driver.F90 | 72 +++++++++++-------- cesm/nuopc_cap_share/driver_pio_mod.F90 | 30 ++++---- cime_config/buildnml | 9 +-- .../drv/asyncio1node/shell_commands | 10 ++- .../drv/asyncio1pernode/shell_commands | 17 ++--- 5 files changed, 77 insertions(+), 61 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 59c0ed395..51f636905 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -20,6 +20,8 @@ module Ensemble_driver integer, allocatable :: asyncio_petlist(:) logical :: asyncio_task=.false. logical :: asyncIO_available=.false. + integer :: number_of_members + integer :: inst ! ensemble instance containing this task character(*),parameter :: u_FILE_u = & __FILE__ @@ -134,8 +136,6 @@ subroutine SetModelServices(ensemble_driver, rc) character(len=512) :: logfile logical :: read_restart character(len=CS) :: read_restart_string - integer :: inst - integer :: number_of_members integer :: ntasks_per_member integer :: iopetcnt integer :: petcnt @@ -240,10 +240,10 @@ subroutine SetModelServices(ensemble_driver, rc) call ESMF_VMGet(vm, localPet=localPet, PetCount=PetCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ntasks_per_member = PetCount/number_of_members - pio_asyncio_ntasks*number_of_members - if(ntasks_per_member*number_of_members .ne. (PetCount - pio_asyncio_ntasks*number_of_members)) then + ntasks_per_member = PetCount/number_of_members - pio_asyncio_ntasks + if(modulo(PetCount-pio_asyncio_ntasks*number_of_members, number_of_members) .ne. 0) then write (msgstr,'(a,i5,a,i3,a,i3,a)') & - "PetCount - Async IOtasks (",PetCount-pio_asyncio_ntasks*number_of_members,") must be evenly divisable by number of members (",number_of_members,")" + "PetCount (",PetCount,") - Async IOtasks (",pio_asyncio_ntasks*number_of_members,") must be evenly divisable by number of members (",number_of_members,")" call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return endif @@ -268,22 +268,24 @@ subroutine SetModelServices(ensemble_driver, rc) ! Determine pet list for driver instance if(pio_asyncio_ntasks > 0) then do n=pio_asyncio_rootpe,pio_asyncio_rootpe+pio_asyncio_stride*(pio_asyncio_ntasks-1),pio_asyncio_stride - asyncio_petlist(iopetcnt) = (inst-1)*ntasks_per_member + n + asyncio_petlist(iopetcnt) = (inst-1)*(ntasks_per_member+pio_asyncio_ntasks) + n + if(asyncio_petlist(iopetcnt) == localPet) asyncio_task = .true. iopetcnt = iopetcnt+1 - if((inst-1)*ntasks_per_member + n == localPet) asyncio_task = .true. enddo iopetcnt = 1 endif do n=0,ntasks_per_member+pio_asyncio_ntasks-1 - if(iopetcnt<=pio_asyncio_ntasks) then - if( asyncio_petlist(iopetcnt)==n) then + if(pio_asyncio_ntasks > 0) then + if( asyncio_petlist(iopetcnt)==(inst-1)*(ntasks_per_member+pio_asyncio_ntasks) + n) then ! Here if asyncio is true and this is an io task iopetcnt = iopetcnt+1 else if(petcnt <= ntasks_per_member) then ! Here if this is a compute task - petList(petcnt) = (inst-1)*ntasks_per_member + n + petList(petcnt) = n + (inst-1)*(ntasks_per_member + pio_asyncio_ntasks) + if (petList(petcnt) == localPet) then + comp_task=.true. + endif petcnt = petcnt+1 - if ((inst-1)*ntasks_per_member + n == localPet) comp_task=.true. else msgstr = "ERROR task cannot be neither a compute task nor an asyncio task" call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) @@ -292,8 +294,8 @@ subroutine SetModelServices(ensemble_driver, rc) else ! Here if asyncio is false petList(petcnt) = (inst-1)*ntasks_per_member + n + if (petList(petcnt) == localPet) comp_task=.true. petcnt = petcnt+1 - if ((inst-1)*ntasks_per_member + n == localPet) comp_task=.true. endif enddo if(comp_task .and. asyncio_task) then @@ -366,15 +368,18 @@ subroutine InitializeIO(ensemble_driver, rc) use NUOPC, only: NUOPC_CompAttributeGet, NUOPC_CompGet use NUOPC_DRIVER, only: NUOPC_DriverGetComp use driver_pio_mod , only: driver_pio_init, driver_pio_component_init + use MPI, only : MPI_Comm_split, MPI_UNDEFINED type(ESMF_GridComp) :: ensemble_driver type(ESMF_VM) :: ensemble_vm integer, intent(out) :: rc character(len=*), parameter :: subname = '('//__FILE__//':InitializeIO)' - type(ESMF_GridComp), pointer :: dcomp(:), ccomp(:) + type(ESMF_GridComp), pointer :: dcomp(:) integer :: iam - integer :: Global_Comm + integer :: Global_Comm, Instance_Comm integer :: drv + integer :: PetCount + integer :: key, color, i character(len=8) :: compname rc = ESMF_SUCCESS @@ -382,29 +387,34 @@ subroutine InitializeIO(ensemble_driver, rc) call ESMF_GridCompGet(ensemble_driver, vm=ensemble_vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(ensemble_vm, localpet=iam, mpiCommunicator=Global_Comm, rc=rc) + call ESMF_VMGet(ensemble_vm, localpet=iam, mpiCommunicator=Global_Comm, PetCount=PetCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + if(number_of_members > 1) then + color = inst + key = modulo(iam, PetCount/number_of_members) + call MPI_Comm_split(Global_Comm, color, key, Instance_Comm, rc) + do i=1,size(asyncio_petlist) + asyncio_petList(i) = modulo(asyncio_petList(i), PetCount/number_of_members) + enddo + else + Instance_Comm = Global_Comm + endif nullify(dcomp) call NUOPC_DriverGetComp(ensemble_driver, complist=dcomp, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompGet(dcomp(1), name=compname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": call driver_pio_init "//compname, ESMF_LOGMSG_INFO) + call driver_pio_init(dcomp(1), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - do drv=1,size(dcomp) - if (ESMF_GridCompIsPetLocal(dcomp(drv), rc=rc) .or. asyncio_task) then - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompGet(dcomp(drv), name=compname, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": call driver_pio_init "//compname, ESMF_LOGMSG_INFO) - call driver_pio_init(dcomp(drv), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": call driver_pio_component_init "//compname, ESMF_LOGMSG_INFO) + call driver_pio_component_init(dcomp(1), Instance_Comm, asyncio_petlist, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": driver_pio_component_init done "//compname, ESMF_LOGMSG_INFO) - call ESMF_LogWrite(trim(subname)//": call driver_pio_component_init "//compname, ESMF_LOGMSG_INFO) - call driver_pio_component_init(dcomp(drv), Global_Comm, asyncio_petlist, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": driver_pio_component_init done "//compname, ESMF_LOGMSG_INFO) - endif - enddo + deallocate(dcomp) deallocate(asyncio_petlist) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine InitializeIO diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index dd59b88ac..9569969ab 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -173,7 +173,7 @@ subroutine driver_pio_init(driver, rc) end subroutine driver_pio_init - subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) + subroutine driver_pio_component_init(driver, Inst_comm, asyncio_petlist, rc) use ESMF, only : ESMF_GridComp, ESMF_LogSetError, ESMF_RC_NOT_VALID, ESMF_GridCompIsCreated, ESMF_VM, ESMF_VMGet use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated, ESMF_Finalize, ESMF_PtrInt1D use ESMF, only : ESMF_LOGMSG_INFO, ESMF_LOGWRITE @@ -182,7 +182,7 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) use mpi, only : MPI_INTEGER, MPI_MAX, MPI_IN_PLACE, MPI_LOR, MPI_LOGICAL type(ESMF_GridComp) :: driver - integer, intent(in) :: Global_COMM ! The communicator associated with the ensemble_driver + integer, intent(in) :: Inst_comm ! The communicator associated with the ensemble_driver integer, intent(in) :: asyncio_petlist(:) integer, intent(out) :: rc @@ -219,15 +219,18 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) character(len=*), parameter :: subname = '('//__FILE__//':shr_pio_component_init)' asyncio_ntasks = size(asyncio_petlist) + call shr_log_getLogUnit(logunit) call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) if (chkerr(rc,__LINE__,u_FILE_u)) return - call MPI_Comm_rank(global_comm, myid, rc) - call MPI_Comm_size(global_comm, totalpes, rc) + call MPI_Comm_rank(Inst_comm, myid, rc) + call MPI_Comm_size(Inst_comm, totalpes, rc) asyncio_task=.false. + do i=1,asyncio_ntasks - if(myid == asyncio_petlist(i)) then + ! asyncio_petlist is in + if(modulo(asyncio_petlist(i), totalpes) == myid) then asyncio_task = .true. exit endif @@ -253,7 +256,7 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if(totalpes > 1) then call MPI_AllReduce(MPI_IN_PLACE, total_comps, 1, MPI_INTEGER, & - MPI_MAX, Global_comm, rc) + MPI_MAX, Inst_comm, rc) endif allocate(pio_comp_settings(total_comps)) @@ -299,6 +302,7 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) call NUOPC_CompAttributeGet(gcomp(i), name="pio_rearranger", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cval, *) pio_comp_settings(i)%pio_rearranger + if(.not. pio_comp_settings(i)%pio_async_interface) then call NUOPC_CompAttributeGet(gcomp(i), name="pio_stride", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -370,7 +374,7 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do i=1,total_comps call MPI_AllReduce(MPI_IN_PLACE, pio_comp_settings(i)%pio_async_interface, 1, MPI_LOGICAL, & - MPI_LOR, global_comm, rc) + MPI_LOR, Inst_comm, rc) if(pio_comp_settings(i)%pio_async_interface) then do_async_init = do_async_init + 1 endif @@ -380,15 +384,15 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) ! Get the PET list for each component using async IO ! - call MPI_Allreduce(MPI_IN_PLACE, do_async_init, 1, MPI_INTEGER, MPI_MAX, Global_comm, ierr) - call MPI_Allreduce(MPI_IN_PLACE, procs_per_comp, total_comps, MPI_INTEGER, MPI_MAX, Global_comm, ierr) + call MPI_Allreduce(MPI_IN_PLACE, do_async_init, 1, MPI_INTEGER, MPI_MAX, Inst_comm, ierr) + call MPI_Allreduce(MPI_IN_PLACE, procs_per_comp, total_comps, MPI_INTEGER, MPI_MAX, Inst_comm, ierr) if (do_async_init > 0) then maxprocspercomp = 0 do i=1,total_comps if(procs_per_comp(i) > maxprocspercomp) maxprocspercomp = procs_per_comp(i) enddo call MPI_AllReduce(MPI_IN_PLACE, maxprocspercomp, 1, MPI_INTEGER, & - MPI_MAX, Global_comm, rc) + MPI_MAX, Inst_comm, rc) allocate(asyncio_comp_comm(do_async_init)) allocate(comp_proc_list(maxprocspercomp, do_async_init)) @@ -413,7 +417,7 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) endif ! Copy comp_proc_list to io tasks do i=1,do_async_init - call MPI_AllReduce(MPI_IN_PLACE, comp_proc_list(:,i), maxprocspercomp, MPI_INTEGER, MPI_MAX, Global_comm, ierr) + call MPI_AllReduce(MPI_IN_PLACE, comp_proc_list(:,i), maxprocspercomp, MPI_INTEGER, MPI_MAX, Inst_comm, ierr) enddo if(asyncio_ntasks == 0) then call shr_sys_abort(subname//' ERROR: ASYNC IO Requested but no IO PES assigned') @@ -443,8 +447,8 @@ subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) call ESMF_LogWrite(trim(subname)//": call async pio_init", ESMF_LOGMSG_INFO) if (chkerr(rc,__LINE__,u_FILE_u)) return call MPI_AllReduce(MPI_IN_PLACE, async_rearr, 1, MPI_INTEGER, & - MPI_MAX, Global_comm, rc) - call pio_init(async_iosystems, Global_comm, async_procs_per_comp, & + MPI_MAX, Inst_comm, rc) + call pio_init(async_iosystems, Inst_comm, async_procs_per_comp, & comp_proc_list, asyncio_petlist, & async_rearr, asyncio_comp_comm, io_comm) if(.not. asyncio_task) then diff --git a/cime_config/buildnml b/cime_config/buildnml index acaac4d0b..80fd28f82 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -325,9 +325,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): #if we are in multi-coupler mode the number of instances of mediator will be the max # of any NINST_* value maxinst = 1 - if case.get_value("MULTI_DRIVER"): - maxinst = case.get_value("NINST_MAX") - multi_driver = True + with open(nuopc_config_file, 'a', encoding="utf-8") as conffile: nmlgen.write_nuopc_config_file(conffile, data_list_path=data_list_path) @@ -342,10 +340,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): newgroup = model.upper()+"_modelio" nmlgen.rename_group("modelio", newgroup) - if maxinst == 1 and model != 'cpl' and not multi_driver: - inst_count = case.get_value("NINST_" + model.upper()) - else: - inst_count = maxinst + inst_count = maxinst if not model == 'drv': for entry in ["pio_async_interface", "pio_netcdf_format", diff --git a/cime_config/testdefs/testmods_dirs/drv/asyncio1node/shell_commands b/cime_config/testdefs/testmods_dirs/drv/asyncio1node/shell_commands index 9a4718359..d247e86b6 100644 --- a/cime_config/testdefs/testmods_dirs/drv/asyncio1node/shell_commands +++ b/cime_config/testdefs/testmods_dirs/drv/asyncio1node/shell_commands @@ -1,7 +1,13 @@ # This will add one asyncio node ./xmlchange PIO_ASYNC_INTERFACE=TRUE -ntasks=`./xmlquery --value TOTAL_TASKS` -./xmlchange PIO_ASYNCIO_ROOTPE=$ntasks +ntasks=`./xmlquery --value TOTALPES` +let rootpe=$ntasks-4 +./xmlchange PIO_ASYNCIO_ROOTPE=$rootpe ./xmlchange PIO_ASYNCIO_STRIDE=1 ./xmlchange PIO_ASYNCIO_NTASKS=4 ./xmlchange PIO_REARRANGER=2 +comp_ocn=`./xmlquery --value COMP_OCN` +# MOM ocn has no pio interface +if [[ "$comp_ocn" == "mom" ]]; then + ./xmlchange PIO_ASYNC_INTERFACE_OCN=FALSE; +fi \ No newline at end of file diff --git a/cime_config/testdefs/testmods_dirs/drv/asyncio1pernode/shell_commands b/cime_config/testdefs/testmods_dirs/drv/asyncio1pernode/shell_commands index b70f3653d..e64f74d42 100644 --- a/cime_config/testdefs/testmods_dirs/drv/asyncio1pernode/shell_commands +++ b/cime_config/testdefs/testmods_dirs/drv/asyncio1pernode/shell_commands @@ -1,14 +1,15 @@ # This will add one async pio task per node to a test # does not work for all cases -./xmlchange PIO_ASYNC_INTERFACE=TRUE -ntasks=`./xmlquery --value TOTAL_TASKS` +./xmlchange --force PIO_ASYNC_INTERFACE=TRUE +ntasks=`./xmlquery --value TOTALPES` +ninst=`./xmlquery --value NINST` tpn=`./xmlquery --value MAX_MPITASKS_PER_NODE` echo "ntasks=$ntasks tpn=$tpn" -./xmlchange PIO_ASYNCIO_STRIDE=$tpn -let piontasks=ntasks/tpn +./xmlchange --force PIO_ASYNCIO_STRIDE=$tpn +let piontasks=(ntasks/ninst)/tpn echo "piontasks=$piontasks" -./xmlchange PIO_ASYNCIO_NTASKS=$piontasks -let newntasks=ntasks-piontasks +./xmlchange --force PIO_ASYNCIO_NTASKS=$piontasks +let newntasks=ntasks/ninst-piontasks echo "newntasks=$newntasks" -./xmlchange NTASKS=$newntasks -./xmlchange PIO_REARRANGER=2 \ No newline at end of file +./xmlchange --force NTASKS=$newntasks +./xmlchange --force PIO_REARRANGER=2 \ No newline at end of file From 884fdf58c19d635c02ca425a5d8f2a3dade114fc Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 20 Dec 2022 11:32:10 -0700 Subject: [PATCH 170/395] more mods for asyncio testing --- cesm/nuopc_cap_share/driver_pio_mod.F90 | 2 +- .../drv/asyncio1node/shell_commands | 16 ++++++----- .../drv/asyncio1pernode/shell_commands | 27 ++++++++++++------- 3 files changed, 28 insertions(+), 17 deletions(-) diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index 9569969ab..b14d99304 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -434,7 +434,7 @@ subroutine driver_pio_component_init(driver, Inst_comm, asyncio_petlist, rc) if(.not.asyncio_task) then if(async_rearr == 0) then async_rearr = pio_comp_settings(i)%pio_rearranger - elseif(async_rearr .ne. pio_comp_settings(i)%pio_rearranger) then + elseif(async_rearr .ne. pio_comp_settings(i)%pio_rearranger .and. pio_comp_settings(i)%pio_rearranger > 0) then write(msgstr,*) i,async_rearr,pio_comp_settings(i)%pio_rearranger call shr_sys_abort(subname//' ERROR: all async component rearrangers must match '//msgstr) endif diff --git a/cime_config/testdefs/testmods_dirs/drv/asyncio1node/shell_commands b/cime_config/testdefs/testmods_dirs/drv/asyncio1node/shell_commands index d247e86b6..70ec80d0e 100644 --- a/cime_config/testdefs/testmods_dirs/drv/asyncio1node/shell_commands +++ b/cime_config/testdefs/testmods_dirs/drv/asyncio1node/shell_commands @@ -1,13 +1,17 @@ -# This will add one asyncio node -./xmlchange PIO_ASYNC_INTERFACE=TRUE -ntasks=`./xmlquery --value TOTALPES` -let rootpe=$ntasks-4 -./xmlchange PIO_ASYNCIO_ROOTPE=$rootpe +# This will add 4 asyncio tasks on the first node +./xmlchange PIO_ASYNCIO_ROOTPE=0 ./xmlchange PIO_ASYNCIO_STRIDE=1 ./xmlchange PIO_ASYNCIO_NTASKS=4 ./xmlchange PIO_REARRANGER=2 +./xmlchange PIO_ASYNC_INTERFACE=TRUE +for comp in ATM OCN LND ICE CPL GLC ROF +do + rootpe=`./xmlquery --value ROOTPE_$comp` + let newrootpe=rootpe+4 + ./xmlchange ROOTPE_$comp=$newrootpe +done comp_ocn=`./xmlquery --value COMP_OCN` # MOM ocn has no pio interface if [[ "$comp_ocn" == "mom" ]]; then ./xmlchange PIO_ASYNC_INTERFACE_OCN=FALSE; -fi \ No newline at end of file +fi diff --git a/cime_config/testdefs/testmods_dirs/drv/asyncio1pernode/shell_commands b/cime_config/testdefs/testmods_dirs/drv/asyncio1pernode/shell_commands index e64f74d42..05077453c 100644 --- a/cime_config/testdefs/testmods_dirs/drv/asyncio1pernode/shell_commands +++ b/cime_config/testdefs/testmods_dirs/drv/asyncio1pernode/shell_commands @@ -1,15 +1,22 @@ # This will add one async pio task per node to a test # does not work for all cases -./xmlchange --force PIO_ASYNC_INTERFACE=TRUE -ntasks=`./xmlquery --value TOTALPES` -ninst=`./xmlquery --value NINST` +max2() { printf '%d' $(( $1 > $2 ? $1 : $2 )); } +let totaltasks=0 +./xmlchange --force --force PIO_ASYNC_INTERFACE=TRUE +for comp in ATM OCN LND ICE CPL GLC ROF +do + ntasks=`./xmlquery --value NTASKS_$comp` + rootpe=`./xmlquery --value ROOTPE_$comp` + let maxpe=ntasks+rootpe + totaltasks=$(( $totaltasks > $maxpe ? $totaltasks : $maxpe )) +done +echo "totaltasks is $totaltasks" tpn=`./xmlquery --value MAX_MPITASKS_PER_NODE` -echo "ntasks=$ntasks tpn=$tpn" -./xmlchange --force PIO_ASYNCIO_STRIDE=$tpn -let piontasks=(ntasks/ninst)/tpn +./xmlchange --force --force PIO_ASYNCIO_STRIDE=$tpn +let piontasks=totaltasks/tpn echo "piontasks=$piontasks" -./xmlchange --force PIO_ASYNCIO_NTASKS=$piontasks -let newntasks=ntasks/ninst-piontasks +./xmlchange --force --force PIO_ASYNCIO_NTASKS=$piontasks +let newntasks=totaltasks-piontasks echo "newntasks=$newntasks" -./xmlchange --force NTASKS=$newntasks -./xmlchange --force PIO_REARRANGER=2 \ No newline at end of file +./xmlchange --force --force NTASKS=$newntasks +./xmlchange --force --force PIO_REARRANGER=2 From 65c5a4e6c7e6b302ebeb16d72b6210dff08eda06 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 20 Dec 2022 15:43:56 -0700 Subject: [PATCH 171/395] working now for B case --- cesm/driver/ensemble_driver.F90 | 5 ++++- cesm/driver/esm.F90 | 16 +++++++++++---- cesm/nuopc_cap_share/driver_pio_mod.F90 | 27 +++++++++++++------------ 3 files changed, 30 insertions(+), 18 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 51f636905..5f7702f4b 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -339,7 +339,8 @@ subroutine SetModelServices(ensemble_driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Set the driver log to the driver task 0 - if (mod(localPet, ntasks_per_member) == 0) then + + if (localPet == petList(1)) then call NUOPC_CompAttributeGet(driver, name="diro", value=diro, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(driver, name="logfile", value=logfile, rc=rc) @@ -384,6 +385,7 @@ subroutine InitializeIO(ensemble_driver, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + call shr_log_setLogUnit (logunit) call ESMF_GridCompGet(ensemble_driver, vm=ensemble_vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -425,6 +427,7 @@ subroutine ensemble_finalize(ensemble_driver, rc) type(ESMF_GridComp) :: Ensemble_driver integer, intent(out) :: rc rc = ESMF_SUCCESS + call shr_log_setLogUnit (logunit) call driver_pio_finalize() end subroutine ensemble_finalize diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index 15ac8932d..43e40cb95 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -245,6 +245,7 @@ subroutine SetRunSequence(driver, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + call shr_log_setLogunit(logunit) !-------- ! Run Sequence and Connectors @@ -343,6 +344,7 @@ recursive subroutine ModifyCplLists(driver, importState, exportState, clock, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + call shr_log_setLogunit(logunit) call ESMF_LogWrite("Driver is in ModifyCplLists()", ESMF_LOGMSG_INFO, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -438,6 +440,7 @@ subroutine InitAttributes(driver, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + call shr_log_setLogunit(logunit) !---------------------------------------------------------- ! Initialize options for reproducible sums @@ -625,6 +628,7 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n rc = ESMF_Success call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + call shr_log_setLogunit(logunit) !------ ! Add compid to gcomp attributes @@ -726,6 +730,7 @@ subroutine ReadAttributes(gcomp, config, label, relaxedflag, formatprint, rc) !------------------------------------------- rc = ESMF_SUCCESS + call shr_log_setLogunit(logunit) if (present(relaxedflag)) then attrFF = NUOPC_FreeFormatCreate(config, label=trim(label), relaxedflag=.true., rc=rc) @@ -877,6 +882,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) integer :: rank, nprocs, ierr character(len=*), parameter :: subname = "(esm_pelayout.F90:esm_init_pelayout)" !--------------------------------------- + call shr_log_setLogunit(logunit) rc = ESMF_SUCCESS call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1229,6 +1235,7 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS + call shr_log_setLogunit(logunit) ! obtain the single column lon and lat call NUOPC_CompAttributeGet(gcomp, name='scol_lon', value=cvalue, rc=rc) @@ -1508,10 +1515,7 @@ subroutine esm_finalize(driver, rc) !--------------------------------------- rc = ESMF_SUCCESS - - if (mastertask) then - write(logunit,*)' SUCCESSFUL TERMINATION OF CESM' - end if + call shr_log_setLogunit(logunit) call ESMF_GridCompGet(driver, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1531,6 +1535,10 @@ subroutine esm_finalize(driver, rc) endif call t_prf(trim(timing_dir)//'/model_timing'//trim(inst_suffix), mpicom=mpicomm) + if (mastertask) then + write(logunit,*)' SUCCESSFUL TERMINATION OF CESM' + end if + call t_finalizef() end subroutine esm_finalize diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index b14d99304..384f6f33f 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -272,22 +272,31 @@ subroutine driver_pio_component_init(driver, Inst_comm, asyncio_petlist, rc) if(associated(gcomp)) then petlocal(i) = ESMF_GridCompIsPetLocal(gcomp(i), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + pio_comp_settings(i)%pio_async_interface = (trim(cval) == '.true.') + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_rearranger", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_rearranger else petlocal(i) = .false. endif pio_comp_settings(i)%pio_async_interface = .false. io_compid(i) = i+1 + if (petlocal(i)) then - call ESMF_GridCompGet(gcomp(i), vm=vm, name=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": initialize component: "//trim(cval), ESMF_LOGMSG_INFO) - io_compname(i) = trim(cval) call NUOPC_CompAttributeAdd(gcomp(i), attrList=(/'MCTID'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - write(cval, *) io_compid(i) call NUOPC_CompAttributeSet(gcomp(i), name="MCTID", value=trim(cval), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_GridCompGet(gcomp(i), vm=vm, name=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": initialize component: "//trim(cval), ESMF_LOGMSG_INFO) + io_compname(i) = trim(cval) call ESMF_VMGet(vm, mpiCommunicator=comp_comm, localPet=comp_rank, petCount=npets, & ssiLocalPetCount=default_stride, rc=rc) @@ -295,14 +304,6 @@ subroutine driver_pio_component_init(driver, Inst_comm, asyncio_petlist, rc) procs_per_comp(i) = npets - call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_comp_settings(i)%pio_async_interface = (trim(cval) == '.true.') - - call NUOPC_CompAttributeGet(gcomp(i), name="pio_rearranger", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_rearranger - if(.not. pio_comp_settings(i)%pio_async_interface) then call NUOPC_CompAttributeGet(gcomp(i), name="pio_stride", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From be2d502c800a8920cfad7564de08e010b4fa78f6 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 21 Dec 2022 09:55:19 -0700 Subject: [PATCH 172/395] more cleanup --- cesm/driver/ensemble_driver.F90 | 14 +++++++++++--- cesm/driver/esm.F90 | 5 ++++- cesm/nuopc_cap_share/driver_pio_mod.F90 | 23 +++++++++++++---------- 3 files changed, 28 insertions(+), 14 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 5f7702f4b..c0308d0da 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -302,13 +302,18 @@ subroutine SetModelServices(ensemble_driver, rc) msgstr = "ERROR task cannot be both a compute task and an asyncio task" call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return ! bail out + elseif (.not. comp_task .and. .not. asyncio_task) then + msgstr = "ERROR task is nether a compute task nor an asyncio task" + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out endif - ! Add driver instance to ensemble driver write(drvrinst,'(a,i4.4)') "ESM",inst - + call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=driver, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + write(msgstr, *) ": driver added on PETS ",petlist(1),' to ',petlist(petcnt-1) + call ESMF_LogWrite(trim(subname)//msgstr) mastertask = .false. if (comp_task) then @@ -369,8 +374,9 @@ subroutine InitializeIO(ensemble_driver, rc) use NUOPC, only: NUOPC_CompAttributeGet, NUOPC_CompGet use NUOPC_DRIVER, only: NUOPC_DriverGetComp use driver_pio_mod , only: driver_pio_init, driver_pio_component_init +#ifndef NO_MPI2 use MPI, only : MPI_Comm_split, MPI_UNDEFINED - +#endif type(ESMF_GridComp) :: ensemble_driver type(ESMF_VM) :: ensemble_vm integer, intent(out) :: rc @@ -394,7 +400,9 @@ subroutine InitializeIO(ensemble_driver, rc) if(number_of_members > 1) then color = inst key = modulo(iam, PetCount/number_of_members) +#ifndef NO_MPI2 call MPI_Comm_split(Global_Comm, color, key, Instance_Comm, rc) +#endif do i=1,size(asyncio_petlist) asyncio_petList(i) = modulo(asyncio_petList(i), PetCount/number_of_members) enddo diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index 43e40cb95..a8605c404 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -1498,7 +1498,7 @@ end subroutine esm_set_single_column_attributes subroutine esm_finalize(driver, rc) use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_VM, ESMF_VMGet - use ESMF , only : ESMF_SUCCESS + use ESMF , only : ESMF_SUCCESS, ESMF_LOGMSG_INFO, ESMF_LOGWRITE use NUOPC , only : NUOPC_CompAttributeGet use perf_mod , only : t_prf, t_finalizef @@ -1512,8 +1512,10 @@ subroutine esm_finalize(driver, rc) logical :: isPresent type(ESMF_VM) :: vm integer :: mpicomm + character(len=*), parameter :: subname = '(esm_finalize) ' !--------------------------------------- + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS call shr_log_setLogunit(logunit) @@ -1538,6 +1540,7 @@ subroutine esm_finalize(driver, rc) if (mastertask) then write(logunit,*)' SUCCESSFUL TERMINATION OF CESM' end if + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) call t_finalizef() end subroutine esm_finalize diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index 384f6f33f..4f7c5d0dd 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -30,7 +30,7 @@ module driver_pio_mod logical :: pio_async_interface integer :: total_comps - logical :: mastertask + logical :: maintask #define DEBUGI 1 #ifdef DEBUGI @@ -77,7 +77,7 @@ subroutine driver_pio_init(driver, rc) call ESMF_VMGet(vm, localPet=localPet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - mastertask = (localPet == 0) + maintask = (localPet == 0) call NUOPC_CompAttributeGet(driver, name="pio_buffer_size_limit", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -85,7 +85,7 @@ subroutine driver_pio_init(driver, rc) ! 0 is a valid value of pio_buffer_size_limit if(pio_buffer_size_limit>=0) then - if(mastertask) write(logunit,*) 'Setting pio_buffer_size_limit : ',pio_buffer_size_limit + if(maintask) write(logunit,*) 'Setting pio_buffer_size_limit : ',pio_buffer_size_limit call pio_set_buffer_size_limit(pio_buffer_size_limit) endif @@ -94,7 +94,7 @@ subroutine driver_pio_init(driver, rc) read(cname, *) pio_blocksize if(pio_blocksize>0) then - if(mastertask) write(logunit,*) 'Setting pio_blocksize : ',pio_blocksize + if(maintask) write(logunit,*) 'Setting pio_blocksize : ',pio_blocksize call pio_set_blocksize(pio_blocksize) endif @@ -103,7 +103,7 @@ subroutine driver_pio_init(driver, rc) read(cname, *) pio_debug_level if(pio_debug_level > 0) then - if(mastertask) write(logunit,*) 'Setting pio_debug_level : ',pio_debug_level + if(maintask) write(logunit,*) 'Setting pio_debug_level : ',pio_debug_level ret = pio_set_log_level(pio_debug_level) endif @@ -150,7 +150,7 @@ subroutine driver_pio_init(driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cname, *) pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req - if(mastertask) then + if(maintask) then ! Log the rearranger options write(logunit, *) "PIO rearranger options:" write(logunit, *) " comm type = ", pio_rearr_opts%comm_type, " (",trim(pio_rearr_comm_type),")" @@ -470,7 +470,8 @@ end subroutine driver_pio_component_init subroutine driver_pio_log_comp_settings(gcomp, rc) use ESMF, only : ESMF_GridComp, ESMF_GridCompGet, ESMF_SUCCESS use NUOPC, only: NUOPC_CompAttributeGet - + use, intrinsic :: iso_fortran_env, only: output_unit + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc integer :: compid @@ -492,9 +493,12 @@ subroutine driver_pio_log_comp_settings(gcomp, rc) endif logunit = 6 - call NUOPC_CompAttributeGet(gcomp, name="logunit", value=logunit, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="logunit", value=logunit, isPresent=ispresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + if(.not. isPresent) then + logunit = output_unit + if(maintask) write(logunit,*) 'Attribute logunit not set for ',trim(name) + endif if(pio_comp_settings(i)%pio_async_interface) then write(logunit,*) trim(name),': using ASYNC IO interface' else @@ -503,7 +507,6 @@ subroutine driver_pio_log_comp_settings(gcomp, rc) write(logunit, *) trim(name),': PIO rearranger=',pio_comp_settings(i)%pio_rearranger write(logunit, *) trim(name),': PIO root=',pio_comp_settings(i)%pio_root endif - end subroutine driver_pio_log_comp_settings !=============================================================================== From 4e32aed17f1c92dbeb251f0897673aed1d1df0f9 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 23 Dec 2022 12:22:45 -0700 Subject: [PATCH 173/395] update workflow to use actions from cdeps --- .github/workflows/extbuild.yml | 108 ++++++++++++--------------------- 1 file changed, 39 insertions(+), 69 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index b0b01f785..97d34f96e 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -19,77 +19,30 @@ jobs: CXX: mpicxx CPPFLAGS: "-I/usr/include -I/usr/local/include" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.3.0b13 - PNETCDF_VERSION: pnetcdf-1.12.3 - NETCDF_FORTRAN_VERSION: v4.5.2 - PIO_VERSION: pio2_5_7 + ESMF_VERSION: v8.4.0 + PNETCDF_VERSION: checkpoint.1.12.3 + NETCDF_FORTRAN_VERSION: v4.6.0 + PIO_VERSION: pio2_5_10 steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 # Build the ESMF library, if the cache contains a previous build # it will be used instead - id: cache-esmf - uses: actions/cache@v2 + uses: actions/cache@v3 with: path: ~/ESMF key: ${{ runner.os }}-${{ env.ESMF_VERSION }}-ESMF - - id: load-env - run: | - sudo apt-get update - sudo apt-get install gfortran wget openmpi-bin netcdf-bin libopenmpi-dev libnetcdf-dev - - id: checkout-ESMF - uses: actions/checkout@v3 - with: - repository: esmf-org/esmf - path: esmf-src - ref: ${{ env.ESMF_VERSION }} - - id: build-ESMF - if: steps.cache-esmf.outputs.cache-hit != 'true' - run: | - #wget https://github.com/esmf-org/esmf/archive/${{ env.ESMF_VERSION }}.tar.gz - #tar -xzvf ${{ env.ESMF_VERSION }}.tar.gz - #pushd esmf-${{ env.ESMF_VERSION }} - pushd esmf-src - export ESMF_DIR=`pwd` - export ESMF_COMM=openmpi - export ESMF_YAMLCPP="internal" - export ESMF_INSTALL_PREFIX=$HOME/ESMF - export ESMF_BOPT=g - make - make install - popd - id: cache-pnetcdf uses: actions/cache@v2 with: path: ~/pnetcdf key: ${{ runner.os }}-${{ env.PNETCDF_VERSION}}-pnetcdf - - name: pnetcdf build - if: steps.cache-pnetcdf.outputs.cache-hit != 'true' - run: | - wget https://parallel-netcdf.github.io/Release/${{ env.PNETCDF_VERSION }}.tar.gz - tar -xzvf ${{ env.PNETCDF_VERSION }}.tar.gz - ls -l - pushd ${{ env.PNETCDF_VERSION }} - ./configure --prefix=$HOME/pnetcdf --enable-shared --disable-cxx - make - make install - popd - name: Cache netcdf-fortran id: cache-netcdf-fortran uses: actions/cache@v2 with: path: ~/netcdf-fortran key: ${{ runner.os }}-${{ env.NETCDF_FORTRAN_VERSION }}-netcdf-fortran - - name: netcdf fortran build - if: steps.cache-netcdf-fortran.outputs.cache-hit != 'true' - run: | - wget https://github.com/Unidata/netcdf-fortran/archive/${{ env.NETCDF_FORTRAN_VERSION }}.tar.gz - tar -xzvf ${{ env.NETCDF_FORTRAN_VERSION }}.tar.gz - ls -l - pushd netcdf-fortran-* - ./configure --prefix=$HOME/netcdf-fortran - make - make install - - name: Cache PIO id: cache-PIO uses: actions/cache@v2 @@ -99,23 +52,40 @@ jobs: restore-keys: | ${{ runner.os }}-${{ env.NETCDF_FORTRAN_VERSION }}-netcdf-fortran ${{ runner.os }}-${{ env.PNETCDF_VERSION }}-pnetcdf - - - id: checkout-PIO - uses: actions/checkout@v3 + - name: Build PNetCDF + if: steps.cache-pnetcdf.outputs.cache-hit != 'true' + uses: ESCOMP/CDEPS/.github/actions/buildpnetcdf@e06246b with: - repository: NCAR/ParallelIO - path: parallelio-src - ref: ${{ env.PIO_VERSION }} - - name: Build PIO - if: steps.cache-PIO.outputs.cache-hit != 'true' - run: | - mkdir build-pio - pushd build-pio - cmake -Wno-dev -DNetCDF_C_LIBRARY=/usr/lib/x86_64-linux-gnu/libnetcdf.so -DNetCDF_C_INCLUDE_DIR=/usr/include -DCMAKE_PREFIX_PATH=/usr -DCMAKE_INSTALL_PREFIX=$HOME/pio -DPIO_HDF5_LOGGING=On -DPIO_USE_MALLOC=On -DPIO_ENABLE_TESTS=Off -DPIO_ENABLE_LOGGING=On -DPIO_ENABLE_EXAMPLES=Off -DPIO_ENABLE_TIMING=Off -DNetCDF_Fortran_PATH=$HOME/netcdf-fortran -DPnetCDF_PATH=$HOME/pnetcdf ../parallelio-src - make VERBOSE=1 - make install - popd - + pnetcdf_version: ${{ env.PNETCDF_VERSION }} + install_prefix: $HOME/pnetcdf + - name: Build NetCDF Fortran + if: steps.cache-netcdf-fortran.outputs.cache-hit != 'true' + uses: ESCOMP/CDEPS/.github/actions/buildnetcdff@e06246b + with: + netcdf_fortran_version: ${{ env.NETCDF_FORTRAN_VERSION }} + install_prefix: $HOME/netcdf-fortran + netcdf_c_path: /usr + - name: Build ParallelIO + if: steps.cache-PARALLELIO.outputs.cache-hit != 'true' + uses: ESCOMP/CDEPS/.github/actions/buildpio@e06246b + with: + parallelio_version: ${{ env.ParallelIO_VERSION }} + netcdf_c_path: /usr + netcdf_fortran_path: $HOME/netcdf-fortran + pnetcdf_path: $HOME/pnetcdf + install_prefix: $HOME/pio + - name: Build ESMF + if: steps.cache-esmf.outputs.cache-hit != 'true' + uses: ESCOMP/CDEPS/.github/actions/buildesmf@e06246b + with: + esmf_version: ${{ env.ESMF_VERSION }} + esmf_bopt: g + esmf_comm: openmpi + install_prefix: $HOME/ESMF + netcdf_c_path: /usr + netcdf_fortran_path: $HOME/netcdf-fortran + pnetcdf_path: $HOME/pnetcdf + parallelio_path: $HOME/pio - name: Build CMEPS run: | export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk From 75903415d52afff402d1fa68dd378ea15836163e Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 23 Dec 2022 12:25:05 -0700 Subject: [PATCH 174/395] needs full SHA --- .github/workflows/extbuild.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 97d34f96e..153bb48bc 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -54,20 +54,20 @@ jobs: ${{ runner.os }}-${{ env.PNETCDF_VERSION }}-pnetcdf - name: Build PNetCDF if: steps.cache-pnetcdf.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildpnetcdf@e06246b + uses: ESCOMP/CDEPS/.github/actions/buildpnetcdf@e06246b560d3132170bb1a5443fa3d65dfbd2040 with: pnetcdf_version: ${{ env.PNETCDF_VERSION }} install_prefix: $HOME/pnetcdf - name: Build NetCDF Fortran if: steps.cache-netcdf-fortran.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildnetcdff@e06246b + uses: ESCOMP/CDEPS/.github/actions/buildnetcdff@e06246b560d3132170bb1a5443fa3d65dfbd2040 with: netcdf_fortran_version: ${{ env.NETCDF_FORTRAN_VERSION }} install_prefix: $HOME/netcdf-fortran netcdf_c_path: /usr - name: Build ParallelIO if: steps.cache-PARALLELIO.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildpio@e06246b + uses: ESCOMP/CDEPS/.github/actions/buildpio@e06246b560d3132170bb1a5443fa3d65dfbd2040 with: parallelio_version: ${{ env.ParallelIO_VERSION }} netcdf_c_path: /usr @@ -76,7 +76,7 @@ jobs: install_prefix: $HOME/pio - name: Build ESMF if: steps.cache-esmf.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildesmf@e06246b + uses: ESCOMP/CDEPS/.github/actions/buildesmf@e06246b560d3132170bb1a5443fa3d65dfbd2040 with: esmf_version: ${{ env.ESMF_VERSION }} esmf_bopt: g From 64f71d766e9e364017651076f393ae6555c6c76c Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 23 Dec 2022 12:29:09 -0700 Subject: [PATCH 175/395] need to setup environment --- .github/workflows/extbuild.yml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 153bb48bc..034527889 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -27,6 +27,10 @@ jobs: - uses: actions/checkout@v3 # Build the ESMF library, if the cache contains a previous build # it will be used instead + - id: load-env + run: | + sudo apt-get update + sudo apt-get install gfortran wget openmpi-bin netcdf-bin libopenmpi-dev libnetcdf-dev autotools-dev autoconf - id: cache-esmf uses: actions/cache@v3 with: From 238b861f6c9c998107068d17cf8c5aa6f5d227dd Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 23 Dec 2022 13:13:16 -0700 Subject: [PATCH 176/395] add scripts_regression_tests to workflow --- .github/workflows/extbuild.yml | 6 +- .github/workflows/srt.yml | 137 ++++++++++++++++----------------- 2 files changed, 68 insertions(+), 75 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 034527889..35b9a1a3d 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -47,8 +47,8 @@ jobs: with: path: ~/netcdf-fortran key: ${{ runner.os }}-${{ env.NETCDF_FORTRAN_VERSION }}-netcdf-fortran - - name: Cache PIO - id: cache-PIO + - name: Cache ParallelIO + id: cache-ParallelIO uses: actions/cache@v2 with: path: ~/pio @@ -70,7 +70,7 @@ jobs: install_prefix: $HOME/netcdf-fortran netcdf_c_path: /usr - name: Build ParallelIO - if: steps.cache-PARALLELIO.outputs.cache-hit != 'true' + if: steps.cache-ParallelIO.outputs.cache-hit != 'true' uses: ESCOMP/CDEPS/.github/actions/buildpio@e06246b560d3132170bb1a5443fa3d65dfbd2040 with: parallelio_version: ${{ env.ParallelIO_VERSION }} diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 74859525d..cf7f29bb1 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -6,9 +6,9 @@ name: scripts regression tests # events but only for the master branch on: push: - branches: main + branches: [ master ] pull_request: - branches: main + branches: [ master ] # A workflow run is made up of one or more jobs that can run sequentially or in parallel jobs: @@ -18,117 +18,111 @@ jobs: runs-on: ubuntu-latest strategy: matrix: - python-version: [3.8, 3.9] + python-version: [3.10] env: CC: mpicc FC: mpifort CXX: mpicxx CPPFLAGS: "-I/usr/include -I/usr/local/include" # Versions of all dependencies can be updated here - PNETCDF_VERSION: pnetcdf-1.12.2 - NETCDF_FORTRAN_VERSION: v4.5.2 - MCT_VERSION: MCT_2.11.0 - PARALLELIO_VERSION: pio2_5_4 + PNETCDF_VERSION: checkpoint.1.12.3 + NETCDF_FORTRAN_VERSION: v4.6.0 + ESMF_VERSION: v8.4.0 + PARALLELIO_VERSION: pio2_5_10 NETCDF_C_PATH: /usr NETCDF_FORTRAN_PATH: ${HOME}/netcdf-fortran PNETCDF_PATH: ${HOME}/pnetcdf CIME_MODEL: cesm - CIME_DRIVER: mct + CIME_DRIVER: nuopc # Steps represent a sequence of tasks that will be executed as part of the job steps: # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it - - name: cime checkout - uses: actions/checkout@v2 - with: - repository: ESMCI/cime - - - name: share checkout - uses: actions/checkout@v2 - with: - repository: ESCOMP/CESM_share - path: share - - - name: cpl7 checkout - uses: actions/checkout@v2 - with: - repository: ESCOMP/CESM_CPL7andDataComps - path: components/cpl7 - - id: load-env run: | sudo apt-get update - sudo apt-get install libxml2-utils pylint wget gfortran openmpi-bin netcdf-bin libopenmpi-dev cmake libnetcdf-dev + sudo apt-get install libxml2-utils pylint wget gfortran openmpi-bin netcdf-bin libopenmpi-dev cmake libnetcdf-dev autotools-dev autoconf - name: Set up Python ${{ matrix.python-version }} - uses: actions/setup-python@v2 + uses: actions/setup-python@v4 with: python-version: ${{ matrix.python-version }} - - name: mct install - run: | - git clone -b ${{ env.MCT_VERSION }} https://github.com/MCSclimate/MCT libraries/mct - ls -l libraries/mct + - name: cesm checkout + uses: actions/checkout@v3 + with: + repository: ESCOMP/CESM + path: cesm - - name: parallelio install + # Checkout cesm and update cmeps to this commit + - name: checkout externals run: | - git clone -b ${{ env.PARALLELIO_VERSION }} https://github.com/NCAR/ParallelIO libraries/parallelio - ls -l libraries/parallelio - + pushd cesm + ./manage_externals/checkout_externals -o + pushd components/cmeps + git checkout $GITHUB_SHA + - name: cache pnetcdf id: cache-pnetcdf uses: actions/cache@v2 with: path: ~/pnetcdf - key: ${{ runner.os }}-${{ env.PNETCDF_VERSION}}-pnetcdf-redo - - - name: pnetcdf build - if: steps.cache-pnetcdf.outputs.cache-hit != 'true' - run: | - wget https://parallel-netcdf.github.io/Release/${{ env.PNETCDF_VERSION }}.tar.gz - tar -xzvf ${{ env.PNETCDF_VERSION }}.tar.gz - ls -l - pushd ${{ env.PNETCDF_VERSION }} - ./configure --prefix=$HOME/pnetcdf --enable-shared --disable-cxx - make - make install - popd + key: ${{ runner.os }}-${{ env.PNETCDF_VERSION}}-pnetcdf - name: Cache netcdf-fortran id: cache-netcdf-fortran uses: actions/cache@v2 with: path: ~/netcdf-fortran - key: ${{ runner.os }}-${{ env.NETCDF_FORTRAN_VERSION }}-netcdf-fortran-redo - - - name: netcdf fortran build - if: steps.cache-netcdf-fortran.outputs.cache-hit != 'true' - run: | - sudo apt-get install libnetcdf-dev - wget https://github.com/Unidata/netcdf-fortran/archive/${{ env.NETCDF_FORTRAN_VERSION }}.tar.gz - tar -xzvf ${{ env.NETCDF_FORTRAN_VERSION }}.tar.gz - ls -l - pushd netcdf-fortran-* - ./configure --prefix=$HOME/netcdf-fortran - make - make install - - - name: link netcdf-c to netcdf-fortran path - # link netcdf c library here to simplify build - run: | - pushd ${{ env.NETCDF_FORTRAN_PATH }}/include - ln -fs /usr/include/*netcdf* . - pushd ${{ env.NETCDF_FORTRAN_PATH }}/lib - clibdir=`nc-config --libdir` - ln -fs $clibdir/lib* . + key: ${{ runner.os }}-${{ env.NETCDF_FORTRAN_VERSION }}-netcdf-fortran + - name: Cache ParallelIO + id: cache-ParallelIO + uses: actions/cache@v2 + with: + path: ~/pio + key: ${{ runner.os }}-${{ env.PARALLELIO_VERSION }}.pio - name: Cache inputdata id: cache-inputdata uses: actions/cache@v2 with: path: $HOME/cesm/inputdata key: inputdata + - name: Build PNetCDF + if: steps.cache-pnetcdf.outputs.cache-hit != 'true' + uses: ESCOMP/CDEPS/.github/actions/buildpnetcdf@e06246b560d3132170bb1a5443fa3d65dfbd2040 + with: + pnetcdf_version: ${{ env.PNETCDF_VERSION }} + install_prefix: $HOME/pnetcdf + - name: Build NetCDF Fortran + if: steps.cache-netcdf-fortran.outputs.cache-hit != 'true' + uses: ESCOMP/CDEPS/.github/actions/buildnetcdff@e06246b560d3132170bb1a5443fa3d65dfbd2040 + with: + netcdf_fortran_version: ${{ env.NETCDF_FORTRAN_VERSION }} + install_prefix: $HOME/netcdf-fortran + netcdf_c_path: /usr + - name: Build ParallelIO + if: steps.cache-PARALLELIO.outputs.cache-hit != 'true' + uses: ESCOMP/CDEPS/.github/actions/buildpio@e06246b560d3132170bb1a5443fa3d65dfbd2040 + with: + parallelio_version: ${{ env.ParallelIO_VERSION }} + netcdf_c_path: /usr + netcdf_fortran_path: $HOME/netcdf-fortran + pnetcdf_path: $HOME/pnetcdf + install_prefix: $HOME/pio + - name: Build ESMF + if: steps.cache-esmf.outputs.cache-hit != 'true' + uses: ESCOMP/CDEPS/.github/actions/buildesmf@e06246b560d3132170bb1a5443fa3d65dfbd2040 + with: + esmf_version: ${{ env.ESMF_VERSION }} + esmf_bopt: g + esmf_comm: openmpi + install_prefix: $HOME/ESMF + netcdf_c_path: /usr + netcdf_fortran_path: $HOME/netcdf-fortran + pnetcdf_path: $HOME/pnetcdf + parallelio_path: $HOME/pio # # The following can be used to ssh to the testnode for debugging # see https://github.com/mxschmitt/action-tmate for details @@ -139,8 +133,7 @@ jobs: run: | mkdir -p $HOME/cesm/scratch mkdir -p $HOME/cesm/inputdata - cd $HOME/work/CESM_share/CESM_share/scripts/tests - ls -l $HOME/work/CESM_share/CESM_share + cd $HOME/cesm/cime/CIME/tests export NETCDF=$HOME/netcdf-fortran export PATH=$NETCDF/bin:$PATH export LD_LIBRARY_PATH=$NETCDF/lib:$HOME/pnetcdf/lib:$LD_LIBRARY_PATH From d53f965ebd5d9da0b79d9fed1f24717d78709e9a Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 23 Dec 2022 13:16:19 -0700 Subject: [PATCH 177/395] add scripts_regression_tests to workflow --- .github/workflows/srt.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index cf7f29bb1..975227db9 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -18,7 +18,7 @@ jobs: runs-on: ubuntu-latest strategy: matrix: - python-version: [3.10] + python-version: [ 3.10.9 ] env: CC: mpicc FC: mpifort From 6f76ccc8de10f3b12c10e0368dbf15a7d222b985 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 23 Dec 2022 13:29:41 -0700 Subject: [PATCH 178/395] ref not sha --- .github/workflows/srt.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 975227db9..4035507a9 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -55,13 +55,13 @@ jobs: repository: ESCOMP/CESM path: cesm - # Checkout cesm and update cmeps to this commit + # Checkout cesm (datamodels only) and update cmeps to this commit - name: checkout externals run: | pushd cesm - ./manage_externals/checkout_externals -o + ./manage_externals/checkout_externals cmeps ccs_config cdeps cime share mct pushd components/cmeps - git checkout $GITHUB_SHA + git checkout $GITHUB_REF - name: cache pnetcdf id: cache-pnetcdf From fa2ccbf6b01505a87a233c783934a1b31d202c0b Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 23 Dec 2022 13:37:26 -0700 Subject: [PATCH 179/395] nether ref nor sha --- .github/workflows/srt.yml | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 4035507a9..438592018 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -34,7 +34,7 @@ jobs: PNETCDF_PATH: ${HOME}/pnetcdf CIME_MODEL: cesm CIME_DRIVER: nuopc - + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} # Steps represent a sequence of tasks that will be executed as part of the job steps: # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it @@ -48,20 +48,23 @@ jobs: uses: actions/setup-python@v4 with: python-version: ${{ matrix.python-version }} - + # use the latest cesm master - name: cesm checkout uses: actions/checkout@v3 with: repository: ESCOMP/CESM path: cesm - - # Checkout cesm (datamodels only) and update cmeps to this commit + # this cmeps commit + - name: cmeps checkout + uses: actions/checkout@v3 + with: + path: components/cmeps + + # Checkout cesm datamodels and support - name: checkout externals run: | pushd cesm - ./manage_externals/checkout_externals cmeps ccs_config cdeps cime share mct - pushd components/cmeps - git checkout $GITHUB_REF + ./manage_externals/checkout_externals ccs_config cdeps cime share mct - name: cache pnetcdf id: cache-pnetcdf From 9bba7a31a3f215f25d53d2f01bd244c69f3f7922 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 23 Dec 2022 14:02:14 -0700 Subject: [PATCH 180/395] fix path --- .github/workflows/srt.yml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 438592018..f41ba3e9c 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -66,6 +66,11 @@ jobs: pushd cesm ./manage_externals/checkout_externals ccs_config cdeps cime share mct + - id: cache-esmf + uses: actions/cache@v3 + with: + path: ~/ESMF + key: ${{ runner.os }}-${{ env.ESMF_VERSION }}-ESMF - name: cache pnetcdf id: cache-pnetcdf uses: actions/cache@v2 @@ -136,7 +141,7 @@ jobs: run: | mkdir -p $HOME/cesm/scratch mkdir -p $HOME/cesm/inputdata - cd $HOME/cesm/cime/CIME/tests + cd $GITHUB_WORKSPACE/cesm/cime/CIME/tests export NETCDF=$HOME/netcdf-fortran export PATH=$NETCDF/bin:$PATH export LD_LIBRARY_PATH=$NETCDF/lib:$HOME/pnetcdf/lib:$LD_LIBRARY_PATH From b23d44337751654539c1314aada9cc18c1aa6457 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 23 Dec 2022 14:21:34 -0700 Subject: [PATCH 181/395] fix cmeps path --- .github/workflows/srt.yml | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index f41ba3e9c..ada3d4f64 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -48,6 +48,8 @@ jobs: uses: actions/setup-python@v4 with: python-version: ${{ matrix.python-version }} + cache: 'pip' + - run: pip install yaml # use the latest cesm master - name: cesm checkout uses: actions/checkout@v3 @@ -58,7 +60,7 @@ jobs: - name: cmeps checkout uses: actions/checkout@v3 with: - path: components/cmeps + path: cesm/components/cmeps # Checkout cesm datamodels and support - name: checkout externals @@ -73,27 +75,27 @@ jobs: key: ${{ runner.os }}-${{ env.ESMF_VERSION }}-ESMF - name: cache pnetcdf id: cache-pnetcdf - uses: actions/cache@v2 + uses: actions/cache@v3 with: path: ~/pnetcdf key: ${{ runner.os }}-${{ env.PNETCDF_VERSION}}-pnetcdf - name: Cache netcdf-fortran id: cache-netcdf-fortran - uses: actions/cache@v2 + uses: actions/cache@v3 with: path: ~/netcdf-fortran key: ${{ runner.os }}-${{ env.NETCDF_FORTRAN_VERSION }}-netcdf-fortran - name: Cache ParallelIO id: cache-ParallelIO - uses: actions/cache@v2 + uses: actions/cache@v3 with: path: ~/pio key: ${{ runner.os }}-${{ env.PARALLELIO_VERSION }}.pio - name: Cache inputdata id: cache-inputdata - uses: actions/cache@v2 + uses: actions/cache@v3 with: path: $HOME/cesm/inputdata key: inputdata From caba810589ccce99837af8a30b33396bbda99bc6 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 23 Dec 2022 14:33:22 -0700 Subject: [PATCH 182/395] fix cmeps path --- .github/workflows/srt.yml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index ada3d4f64..713228de0 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -49,7 +49,9 @@ jobs: with: python-version: ${{ matrix.python-version }} cache: 'pip' - - run: pip install yaml + - run: | + echo 'yaml-1.3 0.1.0' > requirements.txt + pip install -r requirements.txt # use the latest cesm master - name: cesm checkout uses: actions/checkout@v3 From 839d8e9c589969321736707a696791acc66c3550 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 23 Dec 2022 14:35:23 -0700 Subject: [PATCH 183/395] fix cmeps path --- .github/workflows/srt.yml | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 713228de0..aa9c69fa4 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -48,10 +48,7 @@ jobs: uses: actions/setup-python@v4 with: python-version: ${{ matrix.python-version }} - cache: 'pip' - - run: | - echo 'yaml-1.3 0.1.0' > requirements.txt - pip install -r requirements.txt + # use the latest cesm master - name: cesm checkout uses: actions/checkout@v3 From f965da94147d51632622bfdc4ba199de02075b82 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 23 Dec 2022 14:51:20 -0700 Subject: [PATCH 184/395] add cpl7 --- .github/workflows/srt.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index aa9c69fa4..643ff0f93 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -62,10 +62,11 @@ jobs: path: cesm/components/cmeps # Checkout cesm datamodels and support + # cpl7 is needed - i think that's a bug - name: checkout externals run: | pushd cesm - ./manage_externals/checkout_externals ccs_config cdeps cime share mct + ./manage_externals/checkout_externals ccs_config cdeps cime share mct cpl7 - id: cache-esmf uses: actions/cache@v3 From 2fd947b6f8151482759c4e98064f367681e975ae Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 23 Dec 2022 15:18:14 -0700 Subject: [PATCH 185/395] install PyYAML --- .github/workflows/srt.yml | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 643ff0f93..0b5ef23d0 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -48,7 +48,9 @@ jobs: uses: actions/setup-python@v4 with: python-version: ${{ matrix.python-version }} - + - run: echo "PyYAML" > requirements.txt + - name: Install PyYAML + run: pip install -r requirements.txt # use the latest cesm master - name: cesm checkout uses: actions/checkout@v3 @@ -68,7 +70,8 @@ jobs: pushd cesm ./manage_externals/checkout_externals ccs_config cdeps cime share mct cpl7 - - id: cache-esmf + - name: Cache ESMF + id: cache-esmf uses: actions/cache@v3 with: path: ~/ESMF @@ -147,6 +150,7 @@ jobs: export NETCDF=$HOME/netcdf-fortran export PATH=$NETCDF/bin:$PATH export LD_LIBRARY_PATH=$NETCDF/lib:$HOME/pnetcdf/lib:$LD_LIBRARY_PATH + export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest # the following can be used by developers to login to the github server in case of errors From f2f06c21da1c55b01f310249e06b936ac793fd2a Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 27 Dec 2022 07:21:47 -0700 Subject: [PATCH 186/395] turn on debug --- .github/workflows/srt.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 0b5ef23d0..7d8a76bdd 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -155,6 +155,6 @@ jobs: # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details -# - name: Setup tmate session -# if: ${{ failure() }} -# uses: mxschmitt/action-tmate@v3 + - name: Setup tmate session + if: ${{ failure() }} + uses: mxschmitt/action-tmate@v3 From 0dde540c6d7dbca9c675ee3a080f912e15b41624 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 27 Dec 2022 07:33:10 -0700 Subject: [PATCH 187/395] use pio external --- .github/workflows/srt.yml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 7d8a76bdd..6755ec912 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -147,6 +147,10 @@ jobs: mkdir -p $HOME/cesm/scratch mkdir -p $HOME/cesm/inputdata cd $GITHUB_WORKSPACE/cesm/cime/CIME/tests + export PIO_INCDIR=$HOME/pio/include + export PIO_LIBDIR=$HOME/pio/lib + export PIO_VERSION_MAJOR=2 + export PIO_TYPENAME_VALID_VALUES="netcdf,pnetcdf,netcdf4p,netcdf4c" export NETCDF=$HOME/netcdf-fortran export PATH=$NETCDF/bin:$PATH export LD_LIBRARY_PATH=$NETCDF/lib:$HOME/pnetcdf/lib:$LD_LIBRARY_PATH From cd6e6e2a8dc7a120c8b67b1339f95d0ba179d7e8 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 27 Dec 2022 07:53:32 -0700 Subject: [PATCH 188/395] set more env variables --- .github/workflows/srt.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 6755ec912..a2ae9524c 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -147,12 +147,13 @@ jobs: mkdir -p $HOME/cesm/scratch mkdir -p $HOME/cesm/inputdata cd $GITHUB_WORKSPACE/cesm/cime/CIME/tests + export CIME_TEST_PLATFORM=ubuntu-latest export PIO_INCDIR=$HOME/pio/include export PIO_LIBDIR=$HOME/pio/lib export PIO_VERSION_MAJOR=2 export PIO_TYPENAME_VALID_VALUES="netcdf,pnetcdf,netcdf4p,netcdf4c" export NETCDF=$HOME/netcdf-fortran - export PATH=$NETCDF/bin:$PATH + export PATH=$NETCDF/bin:$PATH:$HOME/netcdf-fortran/bin export LD_LIBRARY_PATH=$NETCDF/lib:$HOME/pnetcdf/lib:$LD_LIBRARY_PATH export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest From 281332b915ceb2c66e26eaf6f3ea182f5e21f09e Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 27 Dec 2022 08:16:24 -0700 Subject: [PATCH 189/395] try adding pio --- .github/workflows/srt.yml | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index a2ae9524c..3f156fb25 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -68,7 +68,7 @@ jobs: - name: checkout externals run: | pushd cesm - ./manage_externals/checkout_externals ccs_config cdeps cime share mct cpl7 + ./manage_externals/checkout_externals ccs_config cdeps cime share mct cpl7 parallelio - name: Cache ESMF id: cache-esmf @@ -136,11 +136,6 @@ jobs: netcdf_fortran_path: $HOME/netcdf-fortran pnetcdf_path: $HOME/pnetcdf parallelio_path: $HOME/pio -# -# The following can be used to ssh to the testnode for debugging -# see https://github.com/mxschmitt/action-tmate for details -# - name: Setup tmate session -# uses: mxschmitt/action-tmate@v3 - name: scripts regression tests run: | @@ -160,6 +155,6 @@ jobs: # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details - - name: Setup tmate session - if: ${{ failure() }} - uses: mxschmitt/action-tmate@v3 +# - name: Setup tmate session +# if: ${{ failure() }} +# uses: mxschmitt/action-tmate@v3 From c094c34fec4694afa104d81b6ca52f18d318048e Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 27 Dec 2022 14:33:03 -0700 Subject: [PATCH 190/395] fix naming of logs in multi-instance cases --- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index a52f154a9..f7461f853 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -144,7 +144,8 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) character(len=CL) :: diro character(len=CL) :: logfile character(len=CL) :: inst_suffix - integer :: inst_index ! not used here + integer :: inst_index ! Not used here + integer :: i character(len=CL) :: name character(len=*), parameter :: subname = "("//__FILE__//": set_component_logging)" !----------------------------------------------------------------------- @@ -159,8 +160,9 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) call get_component_instance(gcomp, inst_suffix, inst_index, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Multiinstance logfile name needs a correction - if(logfile(4:4) == '_') then - logfile = logfile(1:3)//trim(inst_suffix)//logfile(9:) + if(len_trim(inst_suffix) > 0) then + i = index(logfile, ".log") + logfile = logfile(1:i-1)//trim(inst_suffix)//logfile(i:) endif open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) From 415898a62f4c5c07ae2f0c9e34f70636bb469ae4 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 08:46:16 -0700 Subject: [PATCH 191/395] add werror to extbuild --- .github/workflows/extbuild.yml | 45 +++++++++------------------------- 1 file changed, 11 insertions(+), 34 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 35b9a1a3d..f4fec7cf6 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -30,53 +30,30 @@ jobs: - id: load-env run: | sudo apt-get update - sudo apt-get install gfortran wget openmpi-bin netcdf-bin libopenmpi-dev libnetcdf-dev autotools-dev autoconf + sudo apt-get update + sudo apt-get install gfortran + sudo apt-get install wget + sudo apt-get install openmpi-bin libopenmpi-dev + sudo apt-get install netcdf-bin libnetcdf-dev libnetcdff-dev + sudo apt-get install pnetcdf-bin libpnetcdf-dev + sudo apt-get install autotools-dev autoconf - id: cache-esmf uses: actions/cache@v3 with: path: ~/ESMF key: ${{ runner.os }}-${{ env.ESMF_VERSION }}-ESMF - - id: cache-pnetcdf - uses: actions/cache@v2 - with: - path: ~/pnetcdf - key: ${{ runner.os }}-${{ env.PNETCDF_VERSION}}-pnetcdf - - name: Cache netcdf-fortran - id: cache-netcdf-fortran - uses: actions/cache@v2 - with: - path: ~/netcdf-fortran - key: ${{ runner.os }}-${{ env.NETCDF_FORTRAN_VERSION }}-netcdf-fortran - name: Cache ParallelIO id: cache-ParallelIO - uses: actions/cache@v2 + uses: actions/cache@v3 with: path: ~/pio key: ${{ runner.os }}-${{ env.PIO_VERSION }}.pio - restore-keys: | - ${{ runner.os }}-${{ env.NETCDF_FORTRAN_VERSION }}-netcdf-fortran - ${{ runner.os }}-${{ env.PNETCDF_VERSION }}-pnetcdf - - name: Build PNetCDF - if: steps.cache-pnetcdf.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildpnetcdf@e06246b560d3132170bb1a5443fa3d65dfbd2040 - with: - pnetcdf_version: ${{ env.PNETCDF_VERSION }} - install_prefix: $HOME/pnetcdf - - name: Build NetCDF Fortran - if: steps.cache-netcdf-fortran.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildnetcdff@e06246b560d3132170bb1a5443fa3d65dfbd2040 - with: - netcdf_fortran_version: ${{ env.NETCDF_FORTRAN_VERSION }} - install_prefix: $HOME/netcdf-fortran - netcdf_c_path: /usr - name: Build ParallelIO if: steps.cache-ParallelIO.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildpio@e06246b560d3132170bb1a5443fa3d65dfbd2040 + uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@9390e30e29d4ebbfbef0fc72162cacd9e8f25e4e with: parallelio_version: ${{ env.ParallelIO_VERSION }} - netcdf_c_path: /usr - netcdf_fortran_path: $HOME/netcdf-fortran - pnetcdf_path: $HOME/pnetcdf + enable_fortran: True install_prefix: $HOME/pio - name: Build ESMF if: steps.cache-esmf.outputs.cache-hit != 'true' @@ -96,6 +73,6 @@ jobs: export PIO=$HOME/pio mkdir build-cmeps pushd build-cmeps - cmake -DCMAKE_BUILD_TYPE=DEBUG -DCMAKE_Fortran_FLAGS="-g -Wall -ffree-form -ffree-line-length-none" ../ + cmake -DCMAKE_BUILD_TYPE=DEBUG -DCMAKE_Fortran_FLAGS="-g -Werror -ffree-form -ffree-line-length-none -Wno-unused-dummy-argument" ../ make VERBOSE=1 popd From 428a0e3df46fb996e39327f48dcb584b02160f9d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 08:54:49 -0700 Subject: [PATCH 192/395] test the test --- mediator/med.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/mediator/med.F90 b/mediator/med.F90 index 352cf0c4d..6f62d14ee 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -568,6 +568,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) character(len=CX) :: logfile character(len=CX) :: diagfile character(len=CX) :: do_budgets + integer :: unused_variable character(len=*),parameter :: subname=' (InitializeP0) ' !----------------------------------------------------------- From c082b2ec3df5bbdbeb04fa994a097dfceb8b8962 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 08:59:50 -0700 Subject: [PATCH 193/395] test the test --- .github/workflows/extbuild.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index f4fec7cf6..1509461b8 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -73,6 +73,6 @@ jobs: export PIO=$HOME/pio mkdir build-cmeps pushd build-cmeps - cmake -DCMAKE_BUILD_TYPE=DEBUG -DCMAKE_Fortran_FLAGS="-g -Werror -ffree-form -ffree-line-length-none -Wno-unused-dummy-argument" ../ + cmake -DCMAKE_BUILD_TYPE=DEBUG -DCMAKE_Fortran_FLAGS="-g -Wall -Werror -ffree-form -ffree-line-length-none -Wno-unused-dummy-argument" ../ make VERBOSE=1 popd From 3ad71eb9e73f868b81eb264118433fd5529ee8fc Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 09:05:38 -0700 Subject: [PATCH 194/395] remove unused variables --- ufs/flux_atmocn_mod.F90 | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/ufs/flux_atmocn_mod.F90 b/ufs/flux_atmocn_mod.F90 index ca0bc200c..3e5b58602 100644 --- a/ufs/flux_atmocn_mod.F90 +++ b/ufs/flux_atmocn_mod.F90 @@ -25,9 +25,9 @@ module flux_atmocn_mod real(R8) :: loc_karman = shr_const_karman real(R8) :: loc_g = shr_const_g real(R8) :: loc_latvap = shr_const_latvap - real(R8) :: loc_latice = shr_const_latice +! real(R8) :: loc_latice = shr_const_latice real(R8) :: loc_stebol = shr_const_stebol - real(R8) :: loc_tkfrz = shr_const_tkfrz +! real(R8) :: loc_tkfrz = shr_const_tkfrz ! These control convergence of the iterative flux calculation ! (For Large and Pond scheme only; not UA or COARE). @@ -144,10 +144,6 @@ subroutine flux_atmOcn(logunit, nMax,zbot ,ubot ,vbot ,thbot , & real(R8) :: cp ! specific heat of moist air real(R8) :: fac ! vertical interpolation factor real(R8) :: spval ! local missing value - !!++ COARE only - real(R8) :: zo,zot,zoq ! roughness lengths - real(R8) :: hsb,hlb ! sens & lat heat flxs at zbot - real(R8) :: trf,qrf,urf,vrf ! reference-height quantities !--- local functions -------------------------------- real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) From 1093e8c122f63735fd0575ad04564a9c59649398 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 09:08:08 -0700 Subject: [PATCH 195/395] remove unused variables --- ufs/glc_elevclass_mod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/ufs/glc_elevclass_mod.F90 b/ufs/glc_elevclass_mod.F90 index 3bcefc23c..6524f064f 100644 --- a/ufs/glc_elevclass_mod.F90 +++ b/ufs/glc_elevclass_mod.F90 @@ -29,7 +29,7 @@ module glc_elevclass_mod !----------------------------------------------------------------------- function glc_get_num_elevation_classes() result(num_elevation_classes) integer :: num_elevation_classes ! function result - integer :: rc + num_elevation_classes = 0 end function glc_get_num_elevation_classes !----------------------------------------------------------------------- @@ -52,6 +52,7 @@ function glc_mean_elevation_virtual(elevation_class, logunit) result(mean_elevat real(r8) :: mean_elevation ! function result integer, intent(in) :: elevation_class integer, optional, intent(in) :: logunit + mean_elevation = 0.0_r8 end function glc_mean_elevation_virtual !----------------------------------------------------------------------- From cd01b7d998f863fb06066c09fba74f1aeb0dc5be Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 09:12:00 -0700 Subject: [PATCH 196/395] remove unused variables --- .github/workflows/extbuild.yml | 4 ++-- mediator/med_utils_mod.F90 | 6 ++++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 1509461b8..8455f2928 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -64,8 +64,8 @@ jobs: esmf_comm: openmpi install_prefix: $HOME/ESMF netcdf_c_path: /usr - netcdf_fortran_path: $HOME/netcdf-fortran - pnetcdf_path: $HOME/pnetcdf + netcdf_fortran_path: /usr + pnetcdf_path: /usr parallelio_path: $HOME/pio - name: Build CMEPS run: | diff --git a/mediator/med_utils_mod.F90 b/mediator/med_utils_mod.F90 index 9e34d1d40..4bfda7761 100644 --- a/mediator/med_utils_mod.F90 +++ b/mediator/med_utils_mod.F90 @@ -21,8 +21,8 @@ subroutine med_memcheck(string, level, mastertask) character(len=*), intent(in) :: string integer, intent(in) :: level logical, intent(in) :: mastertask - integer :: ierr #ifdef CESMCOUPLED + integer :: ierr integer, external :: GPTLprint_memusage if((mastertask .and. memdebug_level > level) .or. memdebug_level > level+1) then ierr = GPTLprint_memusage(string) @@ -48,9 +48,11 @@ logical function med_utils_ChkErr(rc, line, file, mpierr) logical, optional, intent(in) :: mpierr #ifdef NO_MPI2 integer, parameter :: MPI_MAX_ERROR_STRING=80 +#else + integer :: ierr, len #endif character(MPI_MAX_ERROR_STRING) :: lstring - integer :: lrc, len, ierr + integer :: lrc med_utils_ChkErr = .false. lrc = rc From 4a5a96060ce29e8d3106f65c68b5148eb66be747 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 09:15:34 -0700 Subject: [PATCH 197/395] remove unused variables --- mediator/med_utils_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/mediator/med_utils_mod.F90 b/mediator/med_utils_mod.F90 index 4bfda7761..7017180c2 100644 --- a/mediator/med_utils_mod.F90 +++ b/mediator/med_utils_mod.F90 @@ -59,10 +59,10 @@ logical function med_utils_ChkErr(rc, line, file, mpierr) if (present(mpierr)) then if(mpierr) then if (rc == MPI_SUCCESS) return -#ifdef USE_MPI2 - call MPI_ERROR_STRING(rc, lstring, len, ierr) -#else +#ifdef NO_MPI2 write(lstring,*) "ERROR in mct mpi-serial library rc=",rc +#else + call MPI_ERROR_STRING(rc, lstring, len, ierr) #endif call ESMF_LogWrite("ERROR: "//trim(lstring), ESMF_LOGMSG_INFO, line=line, file=file) lrc = ESMF_FAILURE From dc3fc739d38fb724c9bedd5c99a20fd694d686f9 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 09:22:36 -0700 Subject: [PATCH 198/395] remove unused variables --- mediator/med_methods_mod.F90 | 26 +++++++++++--------------- 1 file changed, 11 insertions(+), 15 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 203b1923d..bd5b60793 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -68,8 +68,9 @@ module med_methods_mod private med_methods_Mesh_Print private med_methods_Grid_Print private med_methods_Field_GetFldPtr +#ifdef DIAGNOSE private med_methods_Array_diagnose - +#endif !----------------------------------------------------------------------------- contains !----------------------------------------------------------------------------- @@ -242,13 +243,11 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S integer , intent(out) :: rc ! local variables - integer :: i,j,n,n1 + integer :: n,n1 integer :: fieldCount,fieldCountgeom - logical :: found character(ESMF_MAXSTR) :: lname type(ESMF_Field) :: field,lfield type(ESMF_Mesh) :: lmesh - type(ESMF_StaggerLoc) :: staggerloc type(ESMF_MeshLoc) :: meshloc integer :: ungriddedCount integer :: ungriddedCount_in @@ -658,7 +657,6 @@ subroutine med_methods_State_getNumFields(State, fieldnum, rc) integer , intent(out) :: rc ! local variables - integer :: n,itemCount type(ESMF_Field), pointer :: fieldList(:) character(len=*),parameter :: subname='(med_methods_State_getNumFields)' ! ---------------------------------------------- @@ -699,7 +697,7 @@ subroutine med_methods_FB_reset(FB, value, rc) integer , intent(out) :: rc ! local variables - integer :: i,j,n + integer :: n integer :: fieldCount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) real(R8) :: lvalue @@ -777,7 +775,7 @@ subroutine med_methods_State_reset(State, value, rc) integer , intent(out) :: rc ! local variables - integer :: i,j,n + integer :: n integer :: fieldCount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) real(R8) :: lvalue @@ -923,7 +921,7 @@ subroutine med_methods_FB_diagnose(FB, string, rc) integer , intent(out) :: rc ! local variables - integer :: i,j,n + integer :: n integer :: fieldCount, lrank character(ESMF_MAXSTR), pointer :: lfieldnamelist(:) character(len=CL) :: lstring @@ -993,7 +991,7 @@ subroutine med_methods_FB_diagnose(FB, string, rc) end subroutine med_methods_FB_diagnose !----------------------------------------------------------------------------- - +#ifdef DIAGNOSE subroutine med_methods_Array_diagnose(array, string, rc) ! ---------------------------------------------- @@ -1041,7 +1039,7 @@ subroutine med_methods_Array_diagnose(array, string, rc) endif end subroutine med_methods_Array_diagnose - +#endif !----------------------------------------------------------------------------- subroutine med_methods_State_diagnose(State, string, rc) @@ -1057,7 +1055,7 @@ subroutine med_methods_State_diagnose(State, string, rc) integer , intent(out) :: rc ! local variables - integer :: i,j,n + integer :: n integer :: fieldCount, lrank character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) character(len=CS) :: lstring @@ -1140,7 +1138,6 @@ subroutine med_methods_FB_Field_diagnose(FB, fieldname, string, rc) integer , intent(out) :: rc ! local variables - integer :: lrank character(len=CS) :: lstring real(R8), pointer :: dataPtr1d(:) real(R8), pointer :: dataPtr2d(:,:) @@ -1738,7 +1735,6 @@ subroutine med_methods_State_GeomPrint(state, string, rc) type(ESMF_Field) :: lfield integer :: fieldcount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - character(ESMF_MAXSTR) :: name character(len=*),parameter :: subname='(med_methods_State_GeomPrint)' ! ---------------------------------------------- @@ -2061,7 +2057,7 @@ subroutine med_methods_Grid_Print(grid, string, rc) integer :: localDeCount integer :: DeCount integer :: dimCount, tileCount - integer :: staggerlocCount, arbdimCount, rank + integer :: rank type(ESMF_StaggerLoc) :: staggerloc type(ESMF_TypeKind_Flag) :: coordTypeKind character(len=32) :: staggerstr @@ -2265,7 +2261,7 @@ subroutine med_methods_State_GetScalar(state, scalar_id, scalar_value, flds_scal integer, intent(inout) :: rc ! local variables - integer :: mytask, ierr, len, icount + integer :: mytask, icount type(ESMF_VM) :: vm type(ESMF_Field) :: field real(R8), pointer :: farrayptr(:,:) From 31c80fca308fc6d972bc3a36721396bc1eb8f45b Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 09:26:00 -0700 Subject: [PATCH 199/395] remove unused variables --- mediator/med_internalstate_mod.F90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 99baa2fe1..52866ca4d 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -208,12 +208,9 @@ subroutine med_internalstate_init(gcomp, rc) ! local variables type(InternalState) :: is_local logical :: ispresent, isset - integer :: n, ns, n1, n2 - integer :: stat - logical :: glc_present + integer :: n, ns, n1 character(len=8) :: cnum character(len=CS) :: cvalue - character(len=CL) :: cname character(len=ESMF_MAXSTR) :: mesh_glc character(len=CX) :: msgString character(len=3) :: name From 044d348ff1a4039d89c8b7c471c5f1df6b380cd3 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 09:30:10 -0700 Subject: [PATCH 200/395] remove unused variables --- mediator/esmFlds.F90 | 17 +++-------------- 1 file changed, 3 insertions(+), 14 deletions(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index cb634f464..54e20ea18 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -398,7 +398,7 @@ subroutine med_fldList_AddMap(fields, fldname, destcomp, maptype, mapnorm, mapfi ! local variables type(med_fldList_entry_type), pointer :: newfld - integer :: id, n, rc + integer :: rc character(len=CX) :: lmapfile character(len=*),parameter :: subname='(med_fldList_AddMap)' ! ---------------------------------------------- @@ -458,7 +458,6 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num integer :: n type(ESMF_Field) :: field character(CS) :: shortname - character(CS) :: stdname character(ESMF_MAXSTR) :: transferActionAttr type(ESMF_StateIntent_Flag) :: stateIntent character(ESMF_MAXSTR) :: transferAction @@ -817,20 +816,12 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active) logical, intent(in) :: med_coupling_active(:,:) ! local variables - integer :: nsrc,ndst,nf,nm,n + integer :: nsrc,ndst integer :: mapindex character(len=CS) :: mapnorm character(len=CL) :: mapfile character(len=CS) :: fldname - character(len=CS) :: stdname - character(len=CX) :: merge_fields - character(len=CX) :: merge_field - character(len=CS) :: merge_type - character(len=CS) :: merge_fracname - character(len=CS) :: string - character(len=CL) :: mrgstr character(len=CL) :: cvalue - logical :: init_mrgstr type(med_fldList_entry_type), pointer :: newfld character(len=*),parameter :: subname = '(med_fldList_Document_Mapping)' !----------------------------------------------------------- @@ -919,18 +910,16 @@ subroutine med_fldList_Document_Merging(logunit, med_coupling_active) logical, intent(in) :: med_coupling_active(:,:) ! local variables - integer :: nsrc,ndst,nf,n + integer :: nsrc,ndst character(len=CS) :: dst_comp character(len=CS) :: dst_field character(len=CS) :: src_comp - character(len=CS) :: src_field character(len=CS) :: merge_type character(len=CS) :: merge_field character(len=CS) :: merge_frac character(len=CS) :: prefix character(len=CS) :: string character(len=CL) :: mrgstr - logical :: init_mrgstr type(med_fldList_entry_type), pointer :: newfld character(len=*),parameter :: subname = '(med_fldList_Document_Merging)' !----------------------------------------------------------- From 2ce324b3d256d8529ac3c2307493dbcd97c10ba7 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 09:34:20 -0700 Subject: [PATCH 201/395] remove unused variables --- mediator/esmFldsExchange_cesm_mod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 149c7791d..ac003daa4 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -76,7 +76,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) use med_internalstate_mod , only : compice, comprof, compwav, compglc, ncomps use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_nstod use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf - use med_internalstate_mod , only : coupling_mode use med_internalstate_mod , only : map_glc2ocn_ice, map_glc2ocn_liq, map_rof2ocn_ice, map_rof2ocn_liq use esmFlds , only : addfld_ocnalb => med_fldList_addfld_ocnalb use esmFlds , only : addfld_aoflux => med_fldList_addfld_aoflux @@ -97,7 +96,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) type(InternalState) :: is_local integer :: n, ns character(len=CL) :: cvalue - character(len=CS) :: name logical :: wavice_coupling logical :: ocn2glc_coupling character(len=*) , parameter :: subname=' (esmFldsExchange_cesm) ' From 5dd533da46f1024d5b7f2c7daed8bf4101d660c3 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 09:37:52 -0700 Subject: [PATCH 202/395] remove unused variables --- mediator/esmFldsExchange_hafs_mod.F90 | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 6aa71596d..1f645524e 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -95,16 +95,14 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) integer , intent(inout) :: rc ! local variables: - integer :: num, i, n + integer :: n logical :: isPresent character(len=CL) :: cvalue - character(len=CS) :: name, fldname + character(len=CS) :: fldname character(len=CS) :: fldname1, fldname2 type(gcomp_attr) :: hafs_attr - 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_hafs_advt)' !-------------------------------------- @@ -307,16 +305,12 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, 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 + integer :: n + character(len=CS) :: fldname character(len=CS) :: fldname1, fldname2 type(gcomp_attr) :: hafs_attr - 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_hafs_init)' !-------------------------------------- From 55317e26c7a1ba38e76f06fa46375067ce158eae Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 09:47:47 -0700 Subject: [PATCH 203/395] remove unused variables --- mediator/esmFldsExchange_nems_mod.F90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 084ab10dc..501537939 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -26,7 +26,6 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use med_utils_mod , only : chkerr => med_utils_chkerr use med_methods_mod , only : fldchk => med_methods_FB_FldChk use med_internalstate_mod , only : InternalState - use med_internalstate_mod , only : mastertask, logunit use med_internalstate_mod , only : compmed, compatm, compocn, compice, complnd, compwav, ncomps use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf @@ -40,8 +39,6 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use esmFlds , only : addfld_aoflux => med_fldList_addfld_aoflux use esmFlds , only : addmap_aoflux => med_fldList_addmap_aoflux - use med_internalstate_mod , only : InternalState, mastertask, logunit - ! input/output parameters: type(ESMF_GridComp) :: gcomp character(len=*) , intent(in) :: phase @@ -49,7 +46,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! local variables: type(InternalState) :: is_local - integer :: i, n, maptype + integer :: i, maptype character(len=CX) :: msgString character(len=CL) :: cvalue character(len=CS) :: fldname From 8c6feca8994636714e02d7a471b77b67ef02fc65 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 09:50:05 -0700 Subject: [PATCH 204/395] remove unused variables --- mediator/esmFldsExchange_nems_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 501537939..10b580886 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -46,7 +46,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! local variables: type(InternalState) :: is_local - integer :: i, maptype + integer :: i, n, maptype character(len=CX) :: msgString character(len=CL) :: cvalue character(len=CS) :: fldname From c9de4efa768d1ea651113ec46b83d9952e76366c Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 09:52:22 -0700 Subject: [PATCH 205/395] remove unused variables --- mediator/esmFldsExchange_nems_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 10b580886..f37a9c898 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -46,7 +46,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! local variables: type(InternalState) :: is_local - integer :: i, n, maptype + integer :: n, maptype character(len=CX) :: msgString character(len=CL) :: cvalue character(len=CS) :: fldname From fe1192fb93b6415724f3af70acc86bacb62ad547 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 09:54:39 -0700 Subject: [PATCH 206/395] remove unused variables --- mediator/med_time_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index 5ba7f30a7..93eb53469 100644 --- a/mediator/med_time_mod.F90 +++ b/mediator/med_time_mod.F90 @@ -86,7 +86,6 @@ subroutine med_time_alarmInit( clock, alarm, option, & type(ESMF_Time) :: CurrTime ! Current Time type(ESMF_Time) :: NextAlarm ! Next alarm time type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval - integer :: sec character(len=*), parameter :: subname = '(med_time_alarmInit): ' !------------------------------------------------------------------------------- From 3398d0f56d5d089cf37a64cc6d2ef09070498816 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 10:03:20 -0700 Subject: [PATCH 207/395] remove unused variables --- mediator/med_diag_mod.F90 | 34 +++++----------------------------- 1 file changed, 5 insertions(+), 29 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 2792d0a26..d1a35f689 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -263,7 +263,6 @@ subroutine med_diag_init(gcomp, rc) integer :: c_size ! number of component send/recvs integer :: f_size ! number of fields integer :: p_size ! number of period types - type(ESMF_Clock) :: mediatorClock character(CS) :: cvalue logical :: isPresent, isSet character(*), parameter :: subName = '(med_phases_diag_init) ' @@ -575,7 +574,7 @@ subroutine med_phases_diag_accum(gcomp, rc) integer, intent(out) :: rc ! local variables - integer :: ip, ic + integer :: ip character(*), parameter :: subName = '(med_diag_accum) ' ! ------------------------------------------------------------------ @@ -647,14 +646,13 @@ subroutine med_phases_diag_atm(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: n,nf,ic,ip + integer :: n,nf,ip real(r8), pointer :: afrac(:) real(r8), pointer :: lfrac(:) real(r8), pointer :: ifrac(:) real(r8), pointer :: ofrac(:) real(r8), pointer :: areas(:) real(r8), pointer :: lats(:) - type(ESMF_Field) :: lfield character(*), parameter :: subName = '(med_phases_diag_atm) ' !------------------------------------------------------------------------------- @@ -790,7 +788,6 @@ subroutine diag_atm_recv(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifra integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_field) :: lfield real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -826,7 +823,6 @@ subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifra integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_field) :: lfield real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -865,7 +861,6 @@ subroutine diag_atm_wiso_recv(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_Field) :: lfield real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -922,7 +917,6 @@ subroutine diag_atm_wiso_send(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_Field) :: lfield real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -979,7 +973,6 @@ subroutine med_phases_diag_lnd( gcomp, rc) real(r8), pointer :: lfrac(:) integer :: n,ip, ic real(r8), pointer :: areas(:) - type(ESMF_Field) :: lfield character(*), parameter :: subName = '(med_phases_diag_lnd) ' ! ------------------------------------------------------------------ @@ -1105,7 +1098,6 @@ subroutine diag_lnd(FB, fldname, nf, ic, areas, lfrac, budget, minus, rc) integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_field) :: lfield real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1139,7 +1131,6 @@ subroutine diag_lnd_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, lfrac, integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_field) :: lfield real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1177,7 +1168,7 @@ subroutine med_phases_diag_rof( gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: ic, ip, n + integer :: ic, ip real(r8), pointer :: areas(:) character(*), parameter :: subName = '(med_phases_diag_rof) ' ! ------------------------------------------------------------------ @@ -1266,7 +1257,6 @@ subroutine diag_rof(FB, fldname, nf, ic, areas, budget, minus, rc) ! local variables integer :: n, ip - type(ESMF_field) :: lfield real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1300,7 +1290,6 @@ subroutine diag_rof_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, budget, ! local variables integer :: n, ip - type(ESMF_field) :: lfield real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1386,7 +1375,6 @@ subroutine diag_glc(FB, fldname, nf, ic, areas, budget, minus, rc) integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_field) :: lfield real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1424,7 +1412,6 @@ subroutine med_phases_diag_ocn( gcomp, rc) real(r8), pointer :: ifrac(:) ! ice fraction in ocean grid cell real(r8), pointer :: ofrac(:) ! non-ice fraction nin ocean grid cell real(r8), pointer :: sfrac(:) ! sum of ifrac and ofrac - real(r8), pointer :: sfrac_x_ofrac(:) real(r8), pointer :: areas(:) real(r8), pointer :: data(:) type(ESMF_field) :: lfield @@ -1605,7 +1592,6 @@ subroutine diag_ocn(FB, fldname, nf, ic, areas, frac, budget, scale, rc) integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_field) :: lfield real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1639,7 +1625,6 @@ subroutine diag_ocn_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, frac, b ! local variables integer :: n, ip - type(ESMF_field) :: lfield real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1675,7 +1660,6 @@ subroutine med_phases_diag_ice_ice2med( gcomp, rc) real(r8), pointer :: ifrac(:) real(r8), pointer :: areas(:) real(r8), pointer :: lats(:) - type(ESMF_field) :: lfield character(*), parameter :: subName = '(med_phases_diag_ice_ice2med) ' ! ------------------------------------------------------------------ @@ -1779,7 +1763,6 @@ subroutine diag_ice_recv(FB, fldname, nf, areas, lats, ifrac, budget, minus, sca integer , intent(out) :: rc ! local variables integer :: n, ic, ip - type(ESMF_Field) :: lfield real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1825,7 +1808,6 @@ subroutine diag_ice_recv_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, integer , intent(out) :: rc ! local variables integer :: n, ic, ip - type(ESMF_Field) :: lfield real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1875,7 +1857,6 @@ subroutine med_phases_diag_ice_med2ice( gcomp, rc) real(r8), pointer :: data(:) real(r8), pointer :: areas(:) real(r8), pointer :: lats(:) - type(ESMF_Field) :: lfield character(*), parameter :: subName = '(med_phases_diag_ice_med2ice) ' ! ------------------------------------------------------------------ @@ -1967,7 +1948,6 @@ subroutine diag_ice_send(FB, fldname, nf, areas, lats, ifrac, budget, rc) integer , intent(out) :: rc ! local variables integer :: n, ic, ip - type(ESMF_Field) :: lfield real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -2001,7 +1981,6 @@ subroutine diag_ice_send_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ! local variables integer :: n, ic, ip - type(ESMF_Field) :: lfield real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -2044,13 +2023,11 @@ subroutine med_phases_diag_print(gcomp, rc) integer :: tod integer :: output_level ! print level logical :: sumdone ! has a sum been computed yet - character(CS) :: cvalue integer :: ip integer :: c_size ! number of component send/recvs integer :: f_size ! number of fields integer :: p_size ! number of period types real(r8), allocatable :: datagpr(:,:,:) - character(len=64) :: timestr logical, save :: firstcall = .true. character(*), parameter :: subName = '(med_phases_diag_print) ' ! ------------------------------------------------------------------ @@ -2498,10 +2475,10 @@ subroutine med_diag_print_summary(data, ip, date, tod) integer , intent(in) :: tod ! local variables - integer :: ic,nf,is ! data array indicies + integer :: nf,is ! data array indicies real(r8) :: atm_area, lnd_area, ocn_area real(r8) :: ice_area_nh, ice_area_sh - real(r8) :: sum_area, sum_area_tot + real(r8) :: sum_area real(r8) :: net_water_atm , sum_net_water_atm real(r8) :: net_water_lnd , sum_net_water_lnd real(r8) :: net_water_rof , sum_net_water_rof @@ -2526,7 +2503,6 @@ subroutine med_diag_print_summary(data, ip, date, tod) real(r8) :: net_salt_ice_nh , sum_net_salt_ice_nh real(r8) :: net_salt_ice_sh , sum_net_salt_ice_sh real(r8) :: net_salt_tot , sum_net_salt_tot - character(len=40) :: str character(*), parameter:: subName = '(med_diag_print_summary) ' ! ------------------------------------------------------------------ From 971a71b1261a9a50a1da3f32af22140626fd10b1 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 10:05:04 -0700 Subject: [PATCH 208/395] remove unused variables --- mediator/med_diag_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index d1a35f689..5c33a0e86 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -1414,7 +1414,6 @@ subroutine med_phases_diag_ocn( gcomp, rc) real(r8), pointer :: sfrac(:) ! sum of ifrac and ofrac real(r8), pointer :: areas(:) real(r8), pointer :: data(:) - type(ESMF_field) :: lfield character(*), parameter :: subName = '(med_phases_diag_ocn) ' ! ------------------------------------------------------------------ From 364723c8a7b0e1ded69b9161ebcd1758ed97e977 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 10:11:33 -0700 Subject: [PATCH 209/395] remove unused variables --- mediator/med_map_mod.F90 | 16 ++++------------ 1 file changed, 4 insertions(+), 12 deletions(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 6a05fa4f2..b443bb039 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -99,9 +99,8 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun type(ESMF_Field) :: fldsrc type(ESMF_Field) :: flddst integer :: n1,n2 - integer :: n,m,nf,id,nflds + integer :: nf integer :: fieldCount - character(len=CL) :: fieldname type(ESMF_Field), pointer :: fieldlist(:) type(ESMF_Field) :: field_src character(len=CX) :: mapfile @@ -348,7 +347,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, use med_internalstate_mod , only : mapunset, mapnames, nmappers use med_internalstate_mod , only : mapnstod, mapnstod_consd, mapnstod_consf, mapnstod_consd use med_internalstate_mod , only : mapfillv_bilnr, mapbilnr_nstod, mapconsf_aofrac - use med_internalstate_mod , only : ncomps, compatm, compice, compocn, compwav, complnd, compname + use med_internalstate_mod , only : compocn, compwav, complnd, compname use med_internalstate_mod , only : coupling_mode, dststatus_print use med_internalstate_mod , only : defaultMasks use med_constants_mod , only : ispval_mask => med_constants_ispval_mask @@ -654,7 +653,6 @@ logical function med_map_RH_is_created_RH3d(RHs,n1,n2,mapindex,rc) integer , intent(out) :: rc ! local variables - integer :: rc1, rc2 character(len=*), parameter :: subname=' (module_MED_map:med_map_RH_is_created_RH3d) ' !----------------------------------------------------------- @@ -720,8 +718,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & use ESMF use esmFlds , only : med_fldList_entry_type, med_fldList_getNumFlds, med_fldList_type use esmFlds , only : med_fld_getFldInfo - use med_internalstate_mod , only : nmappers - use med_internalstate_mod , only : ncomps, compatm, compice, compocn, compname, mapnames + use med_internalstate_mod , only : ncomps, compname, mapnames use med_internalstate_mod , only : packed_data_type ! input/output variables @@ -734,10 +731,9 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & integer , intent(out) :: rc ! local variables - integer :: nf, nu, ns + integer :: nf, nu integer, allocatable :: npacked(:) integer :: fieldcount - type(ESMF_Field) :: lfield integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields real(r8), pointer :: ptrsrc_packed(:,:) real(r8), pointer :: ptrdst_packed(:,:) @@ -746,7 +742,6 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & type(ESMF_Mesh) :: lmesh_src type(ESMF_Mesh) :: lmesh_dst integer :: mapindex - integer :: numFlds type(ESMF_Field), pointer :: fieldlist_src(:) type(ESMF_Field), pointer :: fieldlist_dst(:) type(med_fldlist_entry_type), pointer :: fldptr @@ -953,12 +948,9 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d real(r8), pointer :: dataptr1d(:) real(r8), pointer :: dataptr2d(:,:) real(r8), pointer :: dataptr2d_packed(:,:) - type(ESMF_Field) :: lfield type(ESMF_Field) :: field_fracsrc type(ESMF_Field), pointer :: fieldlist_src(:) type(ESMF_Field), pointer :: fieldlist_dst(:) - type(ESMF_Field) :: usrc, vsrc ! only used for 3d mapping of u,v - type(ESMF_Field) :: udst, vdst ! only used for 3d mapping of u,v real(r8), pointer :: data_norm(:) real(r8), pointer :: data_dst(:,:) character(len=*), parameter :: subname=' (module_MED_map:med_map_field_packed) ' From a4ed429000612dc9348b2dd41b44b2cfb61ccffa Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 10:14:12 -0700 Subject: [PATCH 210/395] remove unused variables --- mediator/med_map_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index b443bb039..f2a61483f 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -347,7 +347,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, use med_internalstate_mod , only : mapunset, mapnames, nmappers use med_internalstate_mod , only : mapnstod, mapnstod_consd, mapnstod_consf, mapnstod_consd use med_internalstate_mod , only : mapfillv_bilnr, mapbilnr_nstod, mapconsf_aofrac - use med_internalstate_mod , only : compocn, compwav, complnd, compname + use med_internalstate_mod , only : compocn, compwav, complnd, compname, compatm use med_internalstate_mod , only : coupling_mode, dststatus_print use med_internalstate_mod , only : defaultMasks use med_constants_mod , only : ispval_mask => med_constants_ispval_mask @@ -719,7 +719,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & use esmFlds , only : med_fldList_entry_type, med_fldList_getNumFlds, med_fldList_type use esmFlds , only : med_fld_getFldInfo use med_internalstate_mod , only : ncomps, compname, mapnames - use med_internalstate_mod , only : packed_data_type + use med_internalstate_mod , only : packed_data_type, nmappers ! input/output variables integer , intent(in) :: destcomp From 31ba054f76fa6abdbabb7d17c7bf2244cb7f1450 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 10:17:36 -0700 Subject: [PATCH 211/395] remove unused variables --- mediator/med_map_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index f2a61483f..35a81d85c 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -85,7 +85,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun use med_constants_mod , only : czero => med_constants_czero use esmFlds , only : med_fldList_GetfldListFr, med_fldlist_type use esmFlds , only : med_fld_GetFldInfo, med_fldList_entry_type - use med_internalstate_mod , only : mapunset, compname, compocn, compatm + use med_internalstate_mod , only : mapunset, compname use med_internalstate_mod , only : ncomps, nmappers, compname, mapnames, mapfcopy ! input/output variables @@ -718,7 +718,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & use ESMF use esmFlds , only : med_fldList_entry_type, med_fldList_getNumFlds, med_fldList_type use esmFlds , only : med_fld_getFldInfo - use med_internalstate_mod , only : ncomps, compname, mapnames + use med_internalstate_mod , only : compname, mapnames use med_internalstate_mod , only : packed_data_type, nmappers ! input/output variables From e74da356f9cf73f2318a2429964b7c034e95347a Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 10:20:19 -0700 Subject: [PATCH 212/395] remove unused variables --- mediator/med_fraction_mod.F90 | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 521ba0007..2fd83972a 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -152,7 +152,7 @@ subroutine med_fraction_init(gcomp, rc) use med_internalstate_mod , only : compatm, compocn, compice, complnd use med_internalstate_mod , only : comprof, compglc, compwav, compname use med_internalstate_mod , only : mapfcopy, mapconsd, mapnstod_consd - use med_internalstate_mod , only : InternalState, logunit, mastertask + use med_internalstate_mod , only : InternalState use med_map_mod , only : med_map_routehandles_init, med_map_rh_is_created use med_methods_mod , only : State_getNumFields => med_methods_State_getNumFields use perf_mod , only : t_startf, t_stopf @@ -165,7 +165,6 @@ subroutine med_fraction_init(gcomp, rc) type(InternalState) :: is_local type(ESMF_Field) :: field_src type(ESMF_Field) :: field_dst - type(ESMF_Field) :: lfield real(R8), pointer :: frac(:) real(R8), pointer :: ofrac(:) real(R8), pointer :: aofrac(:) @@ -178,7 +177,7 @@ subroutine med_fraction_init(gcomp, rc) real(R8), pointer :: Si_imask(:) real(R8), pointer :: So_omask(:) real(R8), pointer :: Sa_ofrac(:) - integer :: i,j,n,n1,ns + integer :: n,n1,ns integer :: maptype integer :: fieldCount logical, save :: first_call = .true. @@ -662,14 +661,12 @@ subroutine med_fraction_set(gcomp, rc) ! local variables type(InternalState) :: is_local - real(r8), pointer :: lfrac(:) real(r8), pointer :: ifrac(:) real(r8), pointer :: ofrac(:) real(r8), pointer :: aofrac(:) real(r8), pointer :: Si_ifrac(:) real(r8), pointer :: Si_imask(:) real(r8), pointer :: Sa_ofrac(:) - type(ESMF_Field) :: lfield type(ESMF_Field) :: field_src type(ESMF_Field) :: field_dst integer :: n From bf4a69c80ae9bdf918c7a14f2d183f894a2b9362 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 10:22:41 -0700 Subject: [PATCH 213/395] remove unused variables --- mediator/med_io_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 6d9b8d2f6..b784e74f3 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -2079,7 +2079,7 @@ subroutine med_io_date2ymd_long (date,year,month,day) year =int(tdate/10000) if (date < 0) year = -year month = int( mod(tdate,10000_I8)/ 100) - day = mod(tdate, 100_I8) + day = int(mod(tdate, 100_I8)) end subroutine med_io_date2ymd_long !=============================================================================== From e0e5c70ed2e23ab085be5d3182c7220d3448b646 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 10:30:45 -0700 Subject: [PATCH 214/395] remove unused variables --- mediator/med_io_mod.F90 | 31 +++++++++++++++++-------------- 1 file changed, 17 insertions(+), 14 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index b784e74f3..142d1a6fe 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -783,7 +783,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & type(ESMF_Field) :: field type(ESMF_Mesh) :: mesh type(ESMF_Distgrid) :: distgrid - type(ESMF_VM) :: VM integer :: mpicom integer :: rcode integer :: nf,ns,ng @@ -799,8 +798,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & character(CL) :: itemc ! string converted to char character(CL) :: name1 ! var name character(CL) :: cunit ! var units - character(CL) :: lname ! long name - character(CL) :: sname ! standard name character(CL) :: lpre ! local prefix integer :: lnx,lny logical :: luse_float @@ -819,7 +816,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & integer :: rank integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fields - logical :: isPresent logical :: atmtiles integer :: ntiles = 1 character(CL), allocatable :: fieldNameList(:) @@ -1216,8 +1212,6 @@ subroutine med_io_write_int1d(filename, idata, dname, whead, wdata, file_ind, rc integer :: dimid(1) type(var_desc_t) :: varid character(CL) :: cunit ! var units - character(CL) :: lname ! long name - character(CL) :: sname ! standard name integer :: lnx integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_int1d) ' @@ -1274,6 +1268,11 @@ subroutine med_io_write_r8(filename, rdata, dname, whead, wdata, file_ind, rc) rc = ESMF_SUCCESS + if(present(file_ind)) then + lfile_ind = file_ind + else + lfile_ind = 1 + endif if (whead) then rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,varid) if (rcode==PIO_NOERR) then @@ -1322,6 +1321,11 @@ subroutine med_io_write_r81d(filename, rdata, dname, whead, wdata, file_ind, rc) rc = ESMF_SUCCESS + if(present(file_ind)) then + lfile_ind = file_ind + else + lfile_ind = 1 + endif if (whead) then lnx = size(rdata) rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_nx',lnx,dimid(1)) @@ -1365,8 +1369,6 @@ subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) integer :: dimid(1) type(var_desc_t) :: varid character(CL) :: cunit ! var units - character(CL) :: lname ! long name - character(CL) :: sname ! standard name integer :: lnx integer :: lfile_ind character(CL) :: charvar ! buffer for string read/write @@ -1374,7 +1376,11 @@ subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - + if(present(file_ind)) then + lfile_ind = file_ind + else + lfile_ind = 1 + endif if (whead) then lnx = len(charvar) rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_len',lnx,dimid(1)) @@ -1534,7 +1540,7 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) ! local variables type(ESMF_Field) :: lfield integer :: rcode - integer :: nf,ns,ng + integer :: nf integer :: k,n,l type(file_desc_t) :: pioid type(var_desc_t) :: varid @@ -1543,7 +1549,6 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) character(CL) :: name1 ! var name character(CL) :: lpre ! local prefix real(r8) :: lfillvalue - integer :: tmp(1) integer :: rank, lsize real(r8), pointer :: fldptr1(:), fldptr1_tmp(:) real(r8), pointer :: fldptr2(:,:) @@ -1740,17 +1745,15 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) type(ESMF_Distgrid) :: distgrid integer :: rcode integer :: ns,ng - integer :: n,ndims + integer :: ndims integer, pointer :: dimid(:) type(var_desc_t) :: varid integer :: lnx,lny - integer :: tmp(1) integer, pointer :: minIndexPTile(:,:) integer, pointer :: maxIndexPTile(:,:) integer :: dimCount, tileCount integer, pointer :: Dof(:) character(CL) :: tmpstr - integer :: rank character(*),parameter :: subName = '(med_io_read_init_iodesc) ' !------------------------------------------------------------------------------- From e2a0a3db0a18bc86a70cdc51fc075fecd385d1e5 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 10:32:43 -0700 Subject: [PATCH 215/395] remove unused variables --- mediator/med_io_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 142d1a6fe..6bd9a4663 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -783,7 +783,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & type(ESMF_Field) :: field type(ESMF_Mesh) :: mesh type(ESMF_Distgrid) :: distgrid - integer :: mpicom integer :: rcode integer :: nf,ns,ng integer :: k,n From ad1e91587930fbea0e4226b8b1af1f5845c05ddb Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 10:40:04 -0700 Subject: [PATCH 216/395] remove unused variables --- mediator/med_phases_history_mod.F90 | 26 ++++++-------------------- 1 file changed, 6 insertions(+), 20 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index f98ece233..363118c8d 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -164,14 +164,12 @@ subroutine med_phases_history_write(gcomp, rc) logical :: isSet type(ESMF_VM) :: vm type(ESMF_Calendar) :: calendar ! calendar type - integer :: i,m,n ! indices - integer :: nx,ny ! global grid size + integer :: m,n ! indices character(CL) :: time_units ! units of time variable character(CL) :: hist_file ! history file name real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output logical :: write_now ! true => write to history type - real(r8) :: tbnds(2) ! CF1.0 time bounds type(ESMF_Time) :: starttime type(ESMF_Time) :: currtime type(ESMF_Time) :: nexttime @@ -388,8 +386,7 @@ subroutine med_phases_history_write_med(gcomp, rc) type(InternalState) :: is_local type(ESMF_VM) :: vm type(ESMF_Calendar) :: calendar ! calendar type - integer :: i,m,n ! indices - integer :: nx,ny ! global grid size + integer :: m ! indices character(CL) :: time_units ! units of time variable character(CL) :: hist_file ! history file name real(r8) :: time_val ! time coordinate output @@ -540,10 +537,9 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) character(CL) :: time_units ! units of time variable real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output - character(len=CL) :: hist_str character(len=CL) :: hist_file integer :: m - logical :: isPresent, isSet + logical :: isPresent character(len=*), parameter :: subname='(med_phases_history_write_lnd2glc)' !--------------------------------------- @@ -672,14 +668,13 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) logical :: isSet type(ESMF_VM) :: vm type(ESMF_Calendar) :: calendar ! calendar type - integer :: i,m,n ! indices + integer :: m ! indices integer :: nx,ny ! global grid size character(CL) :: time_units ! units of time variable character(CL) :: hist_file ! history file name real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output logical :: write_now ! true => write to history type - real(r8) :: tbnds(2) ! CF1.0 time bounds character(len=*), parameter :: subname='(med_phases_history_write_inst_comp)' !--------------------------------------- @@ -830,14 +825,13 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) logical :: isSet type(ESMF_VM) :: vm type(ESMF_Calendar) :: calendar ! calendar type - integer :: i,m,n ! indices + integer :: m ! indices integer :: nx,ny ! global grid size character(CL) :: time_units ! units of time variable character(CL) :: hist_file ! history file name real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output logical :: write_now ! true => write to history type - real(r8) :: tbnds(2) ! CF1.0 time bounds character(CS) :: scalar_name character(len=*), parameter :: subname='(med_phases_history_write_comp_avg)' !--------------------------------------- @@ -1052,11 +1046,9 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) integer :: fieldCount logical :: found logical :: enable_auxfile - character(CS) :: timestr ! yr-mon-day-sec string character(CL) :: time_units ! units of time variable integer :: nx,ny ! global grid size logical :: write_now ! if true, write time sample to file - integer :: yr,mon,day,sec ! time units real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output character(CS), allocatable :: fieldNameList(:) @@ -1345,7 +1337,6 @@ subroutine get_auxflds(str, flds, rc) integer :: i,k,n ! generic indecies integer :: nflds ! allocatable size of flds integer :: count ! counts occurances of char - integer :: kFlds ! number of fields in list integer :: i0,i1 ! name = list(i0:i1) integer :: nChar ! temporary logical :: valid ! check if str is valid @@ -1419,15 +1410,12 @@ subroutine med_phases_history_fldbun_accum(fldbun, fldbun_accum, count, rc) type(ESMF_Field) :: lfield_accum integer :: fieldCount_accum character(CL), pointer :: fieldnames_accum(:) - integer :: fieldCount - character(CL), pointer :: fieldnames(:) real(r8), pointer :: dataptr1d(:) real(r8), pointer :: dataptr2d(:,:) real(r8), pointer :: dataptr1d_accum(:) real(r8), pointer :: dataptr2d_accum(:,:) integer :: ungriddedUBound_accum(1) integer :: ungriddedUBound(1) - character(len=64) :: msg !--------------------------------------- rc = ESMF_SUCCESS @@ -1492,7 +1480,7 @@ subroutine med_phases_history_fldbun_average(fldbun_accum, count, rc) integer , intent(out) :: rc ! local variables - integer :: n,i + integer :: n type(ESMF_Field) :: lfield_accum integer :: fieldCount character(CL), pointer :: fieldnames(:) @@ -1557,7 +1545,6 @@ subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hi ! local variables type(ESMF_Clock) :: mclock, dclock type(ESMF_Time) :: StartTime - type(ESMF_TimeInterval) :: htimestep type(ESMF_TimeInterval) :: mtimestep, dtimestep integer :: msec, dsec character(len=*), parameter :: subname='(med_phases_history_init_histclock) ' @@ -1735,7 +1722,6 @@ subroutine med_phases_history_set_timeinfo(gcomp, hclock, alarmname, & integer :: yr,mon,day,sec ! time units integer :: start_ymd ! Starting date YYYYMMDD logical :: isPresent - logical :: isSet character(len=*), parameter :: subname='(med_phases_history_set_timeinfo) ' !--------------------------------------- From c7395eff445ef648ba9a597d59e5584f1eafb35c Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 10:45:31 -0700 Subject: [PATCH 217/395] remove unused variables --- mediator/med_phases_aofluxes_mod.F90 | 20 +++----------------- 1 file changed, 3 insertions(+), 17 deletions(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index b3acbdeb4..bf2061de3 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -94,7 +94,6 @@ module med_phases_aofluxes_mod type(ESMF_RouteHandle) :: rh_agrid2xgrid ! atm->xgrid mapping type(ESMF_RouteHandle) :: rh_xgrid2ogrid ! xgrid->ocn mapping type(ESMF_RouteHandle) :: rh_xgrid2agrid ! xgrid->atm mapping - type(ESMF_RouteHandle) :: rh_ogrid2xgrid_2ndord ! ocn->xgrid mapping 2nd order conservative type(ESMF_RouteHandle) :: rh_agrid2xgrid_2ndord ! atm->xgrid mapping 2nd order conservative type(ESMF_RouteHandle) :: rh_agrid2xgrid_bilinr ! atm->xgrid mapping bilinear type(ESMF_RouteHandle) :: rh_agrid2xgrid_patch ! atm->xgrid mapping patch @@ -152,8 +151,6 @@ module med_phases_aofluxes_mod real(R8) , pointer :: ssq (:) => null() ! saved sq end type aoflux_out_type - character(len=CS) :: aoflux_grid - character(*), parameter :: u_FILE_u = & __FILE__ @@ -359,9 +356,7 @@ subroutine med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc) ! local variables type(InternalState) :: is_local - integer :: n character(CL) :: cvalue - character(len=CX) :: tmpstr real(R8) :: flux_convergence ! convergence criteria for implicit flux computation integer :: flux_max_iteration ! maximum number of iterations for convergence logical :: coldair_outbreak_mod ! cold air outbreak adjustment (Mahrt & Sun 1995,MWR) @@ -504,7 +499,6 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) type(InternalState) :: is_local character(len=CX) :: tmpstr integer :: lsize - integer :: fieldcount type(ESMF_Field) :: lfield type(ESMF_Mesh) :: lmesh real(R8), pointer :: garea(:) => null() @@ -608,7 +602,6 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) ! Local variables type(InternalState) :: is_local integer :: lsize,n - integer :: fieldcount type(ESMF_Field) :: field_src type(ESMF_Field) :: field_dst real(r8), pointer :: dataptr1d(:) @@ -764,7 +757,6 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) integer , intent(out) :: rc ! Local variables - integer :: n integer :: lsize type(InternalState) :: is_local type(ESMF_Field) :: field_a @@ -778,7 +770,6 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) integer :: fieldcount type(ESMF_CoordSys_Flag) :: coordSys real(ESMF_KIND_R8) ,allocatable :: garea(:) - character(ESMF_MAXSTR),allocatable :: fieldNameList(:) character(len=*),parameter :: subname=' (med_aofluxes_init_xgrid) ' !----------------------------------------------------------------------- @@ -974,12 +965,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) ! ! Local variables type(InternalState) :: is_local - type(ESMF_Field) :: field_src - type(ESMF_Field) :: field_dst - integer :: n,i,nf ! indices - real(r8), pointer :: data_normdst(:) - real(r8), pointer :: data_dst(:) - integer :: maptype + integer :: n ! indices real(r8), parameter :: qmin = 1.0e-8_r8 real(r8), parameter :: p0 = 100000.0_r8 ! reference pressure in Pa real(r8), parameter :: rcp = 0.286_r8 ! gas constant of air / specific heat capacity at a constant pressure @@ -1404,7 +1390,7 @@ subroutine med_aofluxes_map_xgrid2agrid_output(gcomp, rc) type(ESMF_Field) :: field_src type(ESMF_Field) :: field_dst type(ESMF_Field) :: lfield - integer :: n,i,nf ! indices + integer :: n,nf ! indices real(r8), pointer :: data_src(:) real(r8), pointer :: data_src_save(:) real(r8), pointer :: data_dst(:) @@ -1484,7 +1470,7 @@ subroutine med_aofluxes_map_xgrid2ogrid_output(gcomp, rc) ! ! Local variables type(InternalState) :: is_local - integer :: n,i,nf ! indices + integer :: nf ! indices type(ESMF_Field) :: field_src type(ESMF_Field) :: field_dst character(*),parameter :: subName = '(med_aofluxes_map_xgrid2ogrid_output) ' From 10ed107a26e258f77345b7d83d1177680636f85d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 10:58:37 -0700 Subject: [PATCH 218/395] remove unused variables --- mediator/med_phases_ocnalb_mod.F90 | 26 +++++++++++--------------- 1 file changed, 11 insertions(+), 15 deletions(-) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 0fd6773c1..2b0d71f21 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -50,12 +50,12 @@ module med_phases_ocnalb_mod character(*),parameter :: u_FILE_u = & __FILE__ - character(len=CL) :: orb_mode ! attribute - orbital mode - integer :: orb_iyear ! attribute - orbital year - integer :: orb_iyear_align ! attribute - associated with model year - real(R8) :: orb_obliq ! attribute - obliquity in degrees - real(R8) :: orb_mvelp ! attribute - moving vernal equinox longitude - real(R8) :: orb_eccen ! attribute and update- orbital eccentricity +! character(len=CL) :: orb_mode ! attribute - orbital mode +! integer :: orb_iyear ! attribute - orbital year +! integer :: orb_iyear_align ! attribute - associated with model year +! real(R8) :: orb_obliq ! attribute - obliquity in degrees +! real(R8) :: orb_mvelp ! attribute - moving vernal equinox longitude +! real(R8) :: orb_eccen ! attribute and update- orbital eccentricity character(len=*) , parameter :: orb_fixed_year = 'fixed_year' character(len=*) , parameter :: orb_variable_year = 'variable_year' @@ -216,7 +216,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - +#ifdef CESMCOUPLED ! local variables type(ocnalb_type), save :: ocnalb type(ESMF_VM) :: vm @@ -255,15 +255,13 @@ subroutine med_phases_ocnalb_run(gcomp, rc) logical :: first_call = .true. character(len=*) , parameter :: subname='(med_phases_ocnalb_run)' !--------------------------------------- - +#else rc = ESMF_SUCCESS - -#ifndef CESMCOUPLED - RETURN ! the following code is not executed unless the model is CESM -#else - +#endif +#ifdef CESMCOUPLED + rc = ESMF_SUCCESS ! Determine master task call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -437,9 +435,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if call t_stopf('MED:'//subname) - #endif - end subroutine med_phases_ocnalb_run !=============================================================================== From 6cbb8d99a3794123d74e7ed1e573a371933a7143 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 13:15:13 -0700 Subject: [PATCH 219/395] remove unused variables --- mediator/med_phases_ocnalb_mod.F90 | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 2b0d71f21..4d6a80380 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -457,14 +457,15 @@ subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, mastertask, rc) logical , intent(in) :: mastertask integer , intent(out) :: rc ! output error +#ifdef CESMCOUPLED + ! local variables character(len=CL) :: msgstr ! temporary character(len=CL) :: cvalue ! temporary character(len=*) , parameter :: subname = "(med_phases_ocnalb_orbital_init)" !------------------------------------------- - +#endif rc = ESMF_SUCCESS - #ifdef CESMCOUPLED ! Determine orbital attributes from input call NUOPC_CompAttributeGet(gcomp, name="orb_mode", value=cvalue, rc=rc) @@ -559,7 +560,7 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, real(R8) , intent(inout) :: lambm0 ! Mean long of perihelion at vernal equinox (radians) real(R8) , intent(inout) :: mvelpp ! moving vernal equinox long of perihelion plus pi (rad) integer , intent(out) :: rc ! output error - +#ifdef CESMCOUPLED ! local variables type(ESMF_Time) :: CurrTime ! current time integer :: year ! model year at current time @@ -569,7 +570,7 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, logical :: first_time = .true. character(len=*) , parameter :: subname = "(med_phases_ocnalb_orbital_update)" !------------------------------------------- - +#endif rc = ESMF_SUCCESS #ifdef CESMCOUPLED From c479c83e79c1d9f88734eb8a4b74ec750eb9fd32 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 13:48:45 -0700 Subject: [PATCH 220/395] remove unused variables --- mediator/med_phases_ocnalb_mod.F90 | 44 ++++++++++++++-------------- mediator/med_phases_post_glc_mod.F90 | 15 ++-------- mediator/med_phases_post_rof_mod.F90 | 4 +-- mediator/med_phases_prep_glc_mod.F90 | 25 ++-------------- mediator/med_phases_prep_ice_mod.F90 | 7 ++--- mediator/med_phases_prep_wav_mod.F90 | 1 - 6 files changed, 32 insertions(+), 64 deletions(-) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 4d6a80380..01dec6473 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -49,14 +49,14 @@ module med_phases_ocnalb_mod ! Conversion from degrees to radians character(*),parameter :: u_FILE_u = & __FILE__ - -! character(len=CL) :: orb_mode ! attribute - orbital mode -! integer :: orb_iyear ! attribute - orbital year -! integer :: orb_iyear_align ! attribute - associated with model year -! real(R8) :: orb_obliq ! attribute - obliquity in degrees -! real(R8) :: orb_mvelp ! attribute - moving vernal equinox longitude -! real(R8) :: orb_eccen ! attribute and update- orbital eccentricity - +#ifdef CESMCOUPLED + character(len=CL) :: orb_mode ! attribute - orbital mode + integer :: orb_iyear ! attribute - orbital year + integer :: orb_iyear_align ! attribute - associated with model year + real(R8) :: orb_obliq ! attribute - obliquity in degrees + real(R8) :: orb_mvelp ! attribute - moving vernal equinox longitude + real(R8) :: orb_eccen ! attribute and update- orbital eccentricity +#endif character(len=*) , parameter :: orb_fixed_year = 'fixed_year' character(len=*) , parameter :: orb_variable_year = 'variable_year' character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' @@ -91,13 +91,11 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) type(ESMF_Mesh) :: lmesh integer :: n integer :: lsize - integer :: dimCount integer :: spatialDim integer :: numOwnedElements type(InternalState) :: is_local real(R8), pointer :: ownedElemCoords(:) character(len=CL) :: tempc1,tempc2 - logical :: mastertask integer :: fieldCount type(ESMF_Field), pointer :: fieldlist(:) character(*), parameter :: subname = '(med_phases_ocnalb_init) ' @@ -216,7 +214,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc -#ifdef CESMCOUPLED + ! local variables type(ocnalb_type), save :: ocnalb type(ESMF_VM) :: vm @@ -226,7 +224,6 @@ subroutine med_phases_ocnalb_run(gcomp, rc) type(InternalState) :: is_local type(ESMF_Clock) :: clock type(ESMF_Time) :: currTime - type(ESMF_Time) :: nextTime type(ESMF_TimeInterval) :: timeStep character(CL) :: cvalue character(CS) :: starttype ! config start type @@ -238,7 +235,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) real(R8), pointer :: ifrac(:) real(R8), pointer :: ifrad(:) integer :: lsize ! local size - integer :: n,i ! indices + integer :: n ! indices real(R8) :: rlat ! gridcell latitude in radians real(R8) :: rlon ! gridcell longitude in radians real(R8) :: cosz ! Cosine of solar zenith angle @@ -255,13 +252,15 @@ subroutine med_phases_ocnalb_run(gcomp, rc) logical :: first_call = .true. character(len=*) , parameter :: subname='(med_phases_ocnalb_run)' !--------------------------------------- -#else + rc = ESMF_SUCCESS + +#ifndef CESMCOUPLED + RETURN ! the following code is not executed unless the model is CESM -#endif -#ifdef CESMCOUPLED - rc = ESMF_SUCCESS +#else + ! Determine master task call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -435,7 +434,9 @@ subroutine med_phases_ocnalb_run(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if call t_stopf('MED:'//subname) + #endif + end subroutine med_phases_ocnalb_run !=============================================================================== @@ -457,15 +458,14 @@ subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, mastertask, rc) logical , intent(in) :: mastertask integer , intent(out) :: rc ! output error -#ifdef CESMCOUPLED - ! local variables character(len=CL) :: msgstr ! temporary character(len=CL) :: cvalue ! temporary character(len=*) , parameter :: subname = "(med_phases_ocnalb_orbital_init)" !------------------------------------------- -#endif + rc = ESMF_SUCCESS + #ifdef CESMCOUPLED ! Determine orbital attributes from input call NUOPC_CompAttributeGet(gcomp, name="orb_mode", value=cvalue, rc=rc) @@ -560,7 +560,7 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, real(R8) , intent(inout) :: lambm0 ! Mean long of perihelion at vernal equinox (radians) real(R8) , intent(inout) :: mvelpp ! moving vernal equinox long of perihelion plus pi (rad) integer , intent(out) :: rc ! output error -#ifdef CESMCOUPLED + ! local variables type(ESMF_Time) :: CurrTime ! current time integer :: year ! model year at current time @@ -570,7 +570,7 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, logical :: first_time = .true. character(len=*) , parameter :: subname = "(med_phases_ocnalb_orbital_update)" !------------------------------------------- -#endif + rc = ESMF_SUCCESS #ifdef CESMCOUPLED diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index 891ee5ddb..c61097f9f 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -90,10 +90,8 @@ subroutine med_phases_post_glc(gcomp, rc) ! local variables type(ESMF_Clock) :: dClock - type(ESMF_StateItem_Flag) :: itemType type(InternalState) :: is_local - integer :: n1,ncnt,ns - real(r8) :: nextsw_cday + integer :: ns logical :: first_call = .true. logical :: isPresent character(CL) :: cvalue @@ -242,9 +240,7 @@ subroutine map_glc2lnd_init(gcomp, rc) type(ESMF_Field) :: lfield_l type(ESMF_Mesh) :: mesh_l integer :: ungriddedUBound_output(1) - integer :: fieldCount - integer :: ns,n - type(ESMF_Field), pointer :: fieldlist(:) + integer :: ns character(len=*) , parameter :: subname='(map_glc2lnd_init)' !--------------------------------------- @@ -360,10 +356,7 @@ subroutine map_glc2lnd( gcomp, rc) ! local variables type(InternalState) :: is_local - type(ESMF_Field) :: lfield - type(ESMF_Field) :: lfield_src - type(ESMF_Field) :: lfield_dst - integer :: ec, l, g, ns, n + integer :: ec, l, ns real(r8) :: topo_virtual real(r8), pointer :: icemask_g(:) ! glc ice mask field on glc grid real(r8), pointer :: frac_g(:) ! total ice fraction in each glc cell @@ -374,9 +367,7 @@ subroutine map_glc2lnd( gcomp, rc) real(r8), pointer :: frac_x_icemask_g_ec(:,:) ! (glc fraction) x (icemask), on the glc grid real(r8), pointer :: frac_x_icemask_l_ec(:,:) real(r8), pointer :: topo_x_icemask_g_ec(:,:) - real(r8), pointer :: topo_x_icemask_l_ec(:,:) real(r8), pointer :: dataptr1d(:) - real(r8), pointer :: dataptr2d(:,:) real(r8), pointer :: frac_l_ec_sum(:,:) real(r8), pointer :: topo_l_ec_sum(:,:) real(r8), pointer :: dataptr1d_src(:) diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index ea478b0cc..aafeec011 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -21,10 +21,10 @@ subroutine med_phases_post_rof(gcomp, rc) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_GridComp, ESMF_GridCompGet 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 : complnd, compocn, compice, compatm, comprof, compname + use med_internalstate_mod , only : complnd, compocn, compice, comprof use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : InternalState use med_phases_history_mod, only : med_phases_history_write_comp use med_map_mod , only : med_map_field_packed use perf_mod , only : t_startf, t_stopf diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index d47bbf46c..a15eacc82 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -90,8 +90,6 @@ module med_phases_prep_glc_mod type(ESMF_Field) :: field_icemask_l type(ESMF_Field) :: field_frac_l type(ESMF_Field) :: field_frac_l_ec - type(ESMF_Field) :: field_lnd_icemask_l - real(r8) , pointer :: aream_l(:) ! cell areas on land grid, for mapping character(len=*), parameter :: qice_fieldname = 'Flgl_qice' ! Name of flux field giving surface mass balance character(len=*), parameter :: Sg_frac_fieldname = 'Sg_ice_covered' @@ -108,7 +106,6 @@ module med_phases_prep_glc_mod character(len=14) :: fldnames_fr_ocn(2) = (/'So_t_depth','So_s_depth'/) ! TODO: what else needs to be added here type(ESMF_DynamicMask) :: dynamicOcnMask integer, parameter :: num_ocndepths = 7 - logical :: ocn_sends_depths = .false. type(ESMF_Clock) :: prepglc_clock character(*), parameter :: u_FILE_u = & @@ -131,18 +128,10 @@ subroutine med_phases_prep_glc_init(gcomp, rc) ! local variables type(InternalState) :: is_local - type(ESMF_Clock) :: med_clock - type(ESMF_ALARM) :: glc_avg_alarm - character(len=CS) :: glc_avg_period - type(ESMF_Time) :: starttime - integer :: glc_cpl_dt - integer :: i,n,ns,nf + integer :: n,ns,nf type(ESMF_Mesh) :: mesh_l type(ESMF_Mesh) :: mesh_o type(ESMF_Field) :: lfield - character(len=CS) :: cvalue - real(r8), pointer :: data2d_in(:,:) - real(r8), pointer :: data2d_out(:,:) character(len=CS) :: glc_renormalize_smb logical :: glc_coupled_fluxes integer :: ungriddedUBound_output(1) ! currently the size must equal 1 for rank 2 fieldds @@ -396,7 +385,6 @@ subroutine med_phases_prep_glc_accum_lnd(gcomp, rc) ! local variables type(InternalState) :: is_local - type(ESMF_Field) :: lfield integer :: i,n real(r8), pointer :: data2d_in(:,:) real(r8), pointer :: data2d_out(:,:) @@ -454,7 +442,6 @@ subroutine med_phases_prep_glc_accum_ocn(gcomp, rc) ! local variables type(InternalState) :: is_local - type(ESMF_Field) :: lfield integer :: i,n real(r8), pointer :: data2d_in(:,:) real(r8), pointer :: data2d_out(:,:) @@ -524,7 +511,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) integer :: yr_med, mon_med, day_med, sec_med integer :: yr_prepglc, mon_prepglc, day_prepglc, sec_prepglc type(ESMF_Alarm) :: alarm - integer :: i, n, ns + integer :: n, ns real(r8), pointer :: data2d(:,:) real(r8), pointer :: data2d_import(:,:) character(len=CS) :: cvalue @@ -752,20 +739,16 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) ! local variables type(InternalState) :: is_local real(r8), pointer :: topolnd_g_ec(:,:) ! topo in elevation classes - real(r8), pointer :: dataptr_g(:) ! temporary data pointer for one elevation class real(r8), pointer :: topoglc_g(:) ! ice topographic height on the glc grid extracted from glc import real(r8), pointer :: data_ice_covered_g(:) ! data for ice-covered regions on the GLC grid real(r8), pointer :: ice_covered_g(:) ! if points on the glc grid is ice-covered (1) or ice-free (0) integer , pointer :: elevclass_g(:) ! elevation classes glc grid real(r8), pointer :: dataexp_g(:) ! pointer into real(r8), pointer :: dataptr2d(:,:) - real(r8), pointer :: dataptr1d(:) real(r8) :: elev_l, elev_u ! lower and upper elevations in interpolation range real(r8) :: d_elev ! elev_u - elev_l integer :: nfld, ec - integer :: i,j,n,g,lsize_g,ns - integer :: ungriddedUBound_output(1) - type(ESMF_Field) :: lfield + integer :: n,lsize_g,ns type(ESMF_Field) :: field_lfrac_l integer :: fieldCount character(len=3) :: cnum @@ -1037,7 +1020,6 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) ! local variables type(InternalState) :: is_local type(ESMF_VM) :: vm - type(ESMF_Field) :: lfield real(r8) , pointer :: qice_g(:) ! SMB (Flgl_qice) on glc grid without elev classes real(r8) , pointer :: qice_l_ec(:,:) ! SMB (Flgl_qice) on land grid with elev classes real(r8) , pointer :: topo_g(:) ! ice topographic height on the glc grid cell @@ -1048,7 +1030,6 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) real(r8) , pointer :: icemask_l(:) ! icemask on land grid real(r8) , pointer :: lfrac(:) ! land fraction on land grid real(r8) , pointer :: dataptr1d(:) ! temporary 1d pointer - real(r8) , pointer :: dataptr2d(:,:) ! temporary 2d pointer integer :: ec ! loop index over elevation classes integer :: n diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 6b8f9c8a1..0b1b40756 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -37,7 +37,7 @@ subroutine med_phases_prep_ice(gcomp, rc) use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_merge_mod , only : med_merge_auto use med_internalstate_mod , only : InternalState, logunit, mastertask - use med_internalstate_mod , only : compatm, compice, compocn, comprof + use med_internalstate_mod , only : compatm, compice, compocn use med_internalstate_mod , only : coupling_mode use esmFlds , only : med_fldList_GetFldListTo use perf_mod , only : t_startf, t_stopf @@ -49,16 +49,13 @@ subroutine med_phases_prep_ice(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Field) :: lfield - integer :: i,n + integer :: n real(R8), pointer :: dataptr(:) real(R8), pointer :: dataptr_scalar_ocn(:,:) real(R8) :: precip_fact(1) character(len=CS) :: cvalue character(len=64), allocatable :: fldnames(:) - real(r8) :: nextsw_cday integer :: scalar_id - real(r8) :: tmp(1) - logical :: first_precip_fact_call = .true. character(len=*),parameter :: subname='(med_phases_prep_ice)' !--------------------------------------- diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 4fdd630ea..8f0e9dcf2 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -81,7 +81,6 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: n, ncnt character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' !--------------------------------------- From 4d9073d825f6a780b146e4e634883aaedf3d33e4 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 15:05:20 -0700 Subject: [PATCH 221/395] no warnings now for cesm build --- cesm/driver/ensemble_driver.F90 | 7 ++--- cesm/driver/esm.F90 | 42 ++++++++++------------------ cesm/driver/esm_time_mod.F90 | 12 ++++---- cesm/driver/t_driver_timers_mod.F90 | 1 - cesm/flux_atmocn/shr_flux_mod.F90 | 3 +- mediator/CMakeLists.txt | 6 ++-- mediator/med.F90 | 24 +++++----------- mediator/med_diag_mod.F90 | 13 ++++++++- mediator/med_map_mod.F90 | 4 +-- mediator/med_merge_mod.F90 | 11 ++------ mediator/med_phases_ocnalb_mod.F90 | 8 ++++-- mediator/med_phases_post_atm_mod.F90 | 2 +- mediator/med_phases_post_ice_mod.F90 | 4 +-- mediator/med_phases_post_lnd_mod.F90 | 2 +- mediator/med_phases_post_ocn_mod.F90 | 2 +- mediator/med_phases_post_wav_mod.F90 | 2 +- mediator/med_phases_prep_atm_mod.F90 | 3 +- mediator/med_phases_prep_lnd_mod.F90 | 7 ++--- mediator/med_phases_prep_ocn_mod.F90 | 6 +--- mediator/med_phases_prep_rof_mod.F90 | 17 ++--------- mediator/med_phases_profile_mod.F90 | 1 - mediator/med_phases_restart_mod.F90 | 11 ++------ 22 files changed, 73 insertions(+), 115 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 2b8238187..7e64c1cc6 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -91,15 +91,12 @@ subroutine SetModelServices(ensemble_driver, rc) type(ESMF_VM) :: vm type(ESMF_GridComp) :: driver, gridcomptmp type(ESMF_Config) :: config - integer :: n, n1, stat + integer :: n integer, pointer :: petList(:) - character(len=20) :: model, prefix - integer :: petCount, i + integer :: petCount integer :: localPet - logical :: is_set character(len=512) :: diro character(len=512) :: logfile - integer :: global_comm logical :: read_restart character(len=CS) :: read_restart_string integer :: inst diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index 3d0bb5a2b..7aef5a8e0 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -54,7 +54,6 @@ subroutine SetServices(driver, rc) integer, intent(out) :: rc ! local variables - type(ESMF_Config) :: runSeq character(len=*), parameter :: subname = "(esm.F90:SetServices)" !--------------------------------------- @@ -125,9 +124,7 @@ subroutine SetModelServices(driver, rc) ! local variables type(ESMF_VM) :: vm type(ESMF_Config) :: config - integer :: n, i, stat - character(len=20) :: model, prefix - integer :: localPet, medpet + integer :: localPet character(len=CL) :: meminitStr integer :: global_comm integer :: maxthreads @@ -241,7 +238,6 @@ subroutine SetRunSequence(driver, rc) integer, intent(out) :: rc ! local variables - integer :: localrc type(ESMF_Config) :: runSeq type(NUOPC_FreeFormat) :: runSeqFF character(len=*), parameter :: subname = "(esm.F90:SetRunSequence)" @@ -267,7 +263,7 @@ subroutine SetRunSequence(driver, rc) call NUOPC_DriverIngestRunSequence(driver, runSeqFF, autoAddConnectors=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - +#ifdef DEBUG ! Uncomment these to add debugging information for driver ! call NUOPC_DriverPrint(driver, orderflag=.true.) ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -275,9 +271,9 @@ subroutine SetRunSequence(driver, rc) ! file=__FILE__)) & ! return ! bail out - ! call pretty_print_nuopc_freeformat(runSeqFF, 'run sequence', rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - + call pretty_print_nuopc_freeformat(runSeqFF, 'run sequence', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return +#endif call NUOPC_FreeFormatDestroy(runSeqFF, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -433,11 +429,7 @@ subroutine InitAttributes(driver, rc) type(ShrWVSatTableSpec) :: liquid_spec type(ShrWVSatTableSpec) :: ice_spec type(ShrWVSatTableSpec) :: mixed_spec - logical :: flag - integer :: i, it, n - integer :: unitn ! Namelist unit number to read integer :: localPet, rootpe_med - character(len=CL) :: msgstr integer , parameter :: ens1=1 ! use first instance of ensemble only integer , parameter :: fix1=1 ! temporary hard-coding to first ensemble, needs to be fixed real(R8) , parameter :: epsilo = shr_const_mwwv/shr_const_mwdair @@ -568,8 +560,6 @@ subroutine CheckAttributes( driver, rc ) integer , intent(out) :: rc !----- local ----- - character(len=CL) :: cvalue ! temporary - character(len=CL) :: start_type ! Type of startup character(len=CS) :: logFilePostFix ! postfix for output log files character(len=CL) :: outPathRoot ! root for output log files character(len=CS) :: cime_model @@ -627,12 +617,9 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n integer , intent(inout) :: rc ! local variables - integer :: n - integer :: stat integer :: inst_index character(len=CL) :: cvalue character(len=CS) :: attribute - integer :: componentCount character(len=*), parameter :: subname = "(esm.F90:AddAttributes)" !------------------------------------------- @@ -750,12 +737,12 @@ subroutine ReadAttributes(gcomp, config, label, relaxedflag, formatprint, rc) call NUOPC_CompAttributeIngest(gcomp, attrFF, addFlag=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! if (present (formatprint)) then - ! call pretty_print_nuopc_freeformat(attrFF, trim(label)//' attributes', rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - ! end if - +#if DEBUG + if (present (formatprint)) then + call pretty_print_nuopc_freeformat(attrFF, trim(label)//' attributes', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if +#endif call NUOPC_FreeFormatDestroy(attrFF, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -870,11 +857,10 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) type(ESMF_VM) :: vm type(ESMF_Config) :: config type(ESMF_Info) :: info - integer :: componentcount integer :: PetCount - integer :: LocalPet + integer :: ComponentCount integer :: ntasks, rootpe, nthrds, stride - integer :: ntask, cnt + integer :: ntask integer :: i integer :: stat character(len=32), allocatable :: compLabels(:) @@ -1254,7 +1240,7 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - + scol_mesh_n = 0 ! obtain the single column lon and lat call NUOPC_CompAttributeGet(gcomp, name='scol_lon', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index 337b7bc56..ada8f2da2 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -23,7 +23,7 @@ module esm_time_mod public :: esm_time_clockInit ! initialize driver clock (assumes default calendar) - private :: esm_time_timeInit +! private :: esm_time_timeInit private :: esm_time_alarmInit private :: esm_time_date2ymd @@ -87,15 +87,14 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert integer :: glc_cpl_dt ! Glc coupling interval integer :: rof_cpl_dt ! Runoff coupling interval integer :: wav_cpl_dt ! Wav coupling interval - integer :: esp_cpl_dt ! Esp coupling interval +! integer :: esp_cpl_dt ! Esp coupling interval character(CS) :: glc_avg_period ! Glc avering coupling period logical :: read_restart character(len=CL) :: restart_file character(len=CL) :: restart_pfile character(len=CL) :: cvalue integer :: dtime_drv ! time-step to use - integer :: yr, mon, day, sec ! Year, month, day, secs as integers - integer :: localPet ! local pet in esm domain + integer :: yr, mon, day ! Year, month, day as integers integer :: unitn ! unit number integer :: ierr ! Return code character(CL) :: tmpstr ! temporary @@ -392,7 +391,6 @@ subroutine esm_time_alarmInit( clock, alarm, option, & type(ESMF_Time) :: CurrTime ! Current Time type(ESMF_Time) :: NextAlarm ! Next restart alarm time type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval - integer :: sec character(len=*), parameter :: subname = '(med_time_alarmInit): ' !------------------------------------------------------------------------------- @@ -563,7 +561,7 @@ subroutine esm_time_alarmInit( clock, alarm, option, & end subroutine esm_time_alarmInit !=============================================================================== - +#ifdef UNUSEDFUNCTION subroutine esm_time_timeInit( Time, ymd, cal, tod, desc, logunit ) ! Create the ESMF_Time object corresponding to the given input time, given in @@ -607,7 +605,7 @@ subroutine esm_time_timeInit( Time, ymd, cal, tod, desc, logunit ) if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine esm_time_timeInit - +#endif !=============================================================================== subroutine esm_time_date2ymd (date, year, month, day) diff --git a/cesm/driver/t_driver_timers_mod.F90 b/cesm/driver/t_driver_timers_mod.F90 index fd316e6de..c38946582 100644 --- a/cesm/driver/t_driver_timers_mod.F90 +++ b/cesm/driver/t_driver_timers_mod.F90 @@ -76,7 +76,6 @@ subroutine t_drvstopf(string,cplrun,cplcom,budget,hashint) logical,intent(in),optional :: cplcom logical,intent(in),optional :: budget integer, intent(in), optional :: hashint - character(len=128) :: strbar logical :: lcplrun,lcplcom,lbudget !------------------------------------------------------------------------------- diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index 9e74abf28..9ec558737 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -1445,7 +1445,8 @@ SUBROUTINE flux_atmOcn_diurnal & tSkin_night(:) = ts(:) cSkin_night(:) = 0.0_R8 endif - + u10n = 0.0_r8 + stable = 0.0_r8 DO n=1,nMax if (mask(n) /= 0) then diff --git a/mediator/CMakeLists.txt b/mediator/CMakeLists.txt index a851018ba..b6cd7cb14 100644 --- a/mediator/CMakeLists.txt +++ b/mediator/CMakeLists.txt @@ -8,7 +8,7 @@ set(SRCFILES esmFldsExchange_cesm_mod.F90 med_fraction_mod.F90 esmFldsExchange_nems_mod.F90 med_io_mod.F90 med_phases_history_mod.F90 med_phases_prep_ocn_mod.F90 med_utils_mod.F90 esmFlds.F90 med_kind_mod.F90 - med_phases_ocnalb_mod.F90 med_phases_prep_rof_mod.F90 + med_phases_prep_rof_mod.F90 med_constants_mod.F90 med_map_mod.F90 med_phases_prep_atm_mod.F90 med_phases_prep_wav_mod.F90 med.F90 med_merge_mod.F90 med_phases_prep_glc_mod.F90 @@ -17,7 +17,9 @@ set(SRCFILES esmFldsExchange_cesm_mod.F90 med_fraction_mod.F90 med_phases_post_atm_mod.F90 med_phases_post_ice_mod.F90 med_phases_post_lnd_mod.F90 med_phases_post_glc_mod.F90 med_phases_post_rof_mod.F90 med_phases_post_wav_mod.F90) - +if(NOT BLD_STANDALONE) + list(APPEND SRCFILES med_phases_ocnalb_mod.F90) +endif() foreach(FILE ${SRCFILES}) if(EXISTS "${CASEROOT}/SourceMods/src.cmeps/${FILE}") list(REMOVE_ITEM SRCFILES ${FILE}) diff --git a/mediator/med.F90 b/mediator/med.F90 index 6f62d14ee..e9b76721b 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -567,8 +567,6 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) character(len=CX) :: diro character(len=CX) :: logfile character(len=CX) :: diagfile - character(len=CX) :: do_budgets - integer :: unused_variable character(len=*),parameter :: subname=' (InitializeP0) ' !----------------------------------------------------------- @@ -661,7 +659,6 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use esmFlds, only : med_fldlist_init1, med_fld_GetFldInfo, med_fldList_entry_type use med_phases_history_mod, only : med_phases_history_init - use med_internalstate_mod , only : atm_name ! input/output variables type(ESMF_GridComp) :: gcomp @@ -671,7 +668,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) ! local variables character(len=CS) :: stdname, shortname - integer :: n, n1, n2, ncomp, nflds, ns + integer :: ncomp, ns logical :: isPresent, isSet character(len=CS) :: transferOffer character(len=CS) :: cvalue @@ -1004,7 +1001,7 @@ subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) ! local variables type(InternalState) :: is_local - integer :: n1,n2 + integer :: n1 character(len=*),parameter :: subname=' (Modify Decomp of Mesh/Grid) ' !----------------------------------------------------------- @@ -1065,7 +1062,7 @@ subroutine realizeConnectedGrid(State,string,rc) integer :: dimCount, tileCount integer :: connectionCount integer :: fieldCount - integer :: i, j, n, n1, i1, i2 + integer :: n, n1, i1, i2 type(ESMF_GeomType_Flag) :: geomtype type(ESMF_FieldStatus_Flag) :: fieldStatus character(len=CX) :: msgString @@ -1332,7 +1329,7 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) ! local variables type(InternalState) :: is_local - integer :: n1,n2 + integer :: n1 character(len=*),parameter :: subname=' (Realize Fields with Transfer Accept) ' !----------------------------------------------------------- @@ -1580,24 +1577,19 @@ subroutine DataInitialize(gcomp, rc) ! local variables type(InternalState) :: is_local - type(ESMF_VM) :: vm type(ESMF_Clock) :: clock type(ESMF_State) :: importState, exportState type(ESMF_Time) :: time type(ESMF_Field) :: field - type(ESMF_StateItem_Flag) :: itemType type(med_fldList_type), pointer :: fldListMed_ocnalb - logical :: atCorrectTime, connected - integer :: n1,n2,n,ns + logical :: atCorrectTime + integer :: n1,n2,n integer :: nsrc,ndst - integer :: cntn1, cntn2 integer :: fieldCount character(ESMF_MAXSTR),allocatable :: fieldNameList(:) character(CL), pointer :: fldnames(:) character(CL) :: cvalue - character(CL) :: start_type logical :: read_restart - logical :: isPresent, isSet logical :: allDone = .false. logical,save :: first_call = .true. real(r8) :: real_nx, real_ny @@ -2205,11 +2197,9 @@ subroutine SetRunClock(gcomp, rc) type(ESMF_TimeInterval) :: timeStep type(ESMF_Alarm) :: stop_alarm character(len=CL) :: cvalue - character(len=CL) :: name, stop_option + character(len=CL) :: stop_option integer :: stop_n, stop_ymd - logical :: first_time = .true. logical, save :: stopalarmcreated=.false. - integer :: alarmcount character(len=*),parameter :: subname=' (Set Run Clock) ' !----------------------------------------------------------- diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 5c33a0e86..204d45684 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -2028,6 +2028,7 @@ subroutine med_phases_diag_print(gcomp, rc) integer :: p_size ! number of period types real(r8), allocatable :: datagpr(:,:,:) logical, save :: firstcall = .true. + character(len=CL) :: timestr character(*), parameter :: subName = '(med_phases_diag_print) ' ! ------------------------------------------------------------------ @@ -2171,6 +2172,12 @@ subroutine med_diag_print_atm(data, ip, date, tod) character(*), parameter:: subName = '(med_phases_diag_print_atm) ' ! ------------------------------------------------------------------ + ica = 0 + icl = 0 + icn = 0 + ics = 0 + ico = 0 + str = "" do ic = 1,2 if (ic == 1) then ! from atm to mediator ica = c_atm_recv ! total from atm @@ -2318,7 +2325,11 @@ subroutine med_diag_print_lnd_ice_ocn(data, ip, date, tod) character(len=40) :: str ! string character(*), parameter :: subName = '(med_diag_print_lnd_ice_ocn) ' ! ------------------------------------------------------------------ - + icar = 0 + icxs = 0 + icxr = 0 + icas = 0 + str = "" do ic = 1,4 if (ic == 1) then diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 35a81d85c..2dcb39069 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -664,7 +664,7 @@ end function med_map_RH_is_created_RH3d !================================================================================ - logical function med_map_RH_is_created_RH1d(RHs,mapindex,rc) + logical function med_map_RH_is_created_RH1d(RHs,mapindex,rc) use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated use med_internalstate_mod , only : mapconsd, mapconsf, mapnstod @@ -684,7 +684,7 @@ logical function med_map_RH_is_created_RH1d(RHs,mapindex,rc) rc = ESMF_SUCCESS rc1 = ESMF_SUCCESS rc2 = ESMF_SUCCESS - + med_map_RH_is_created_RH1d = .false. mapexists = .false. if (mapindex == mapnstod_consd .and. & ESMF_RouteHandleIsCreated(RHs(mapnstod), rc=rc1) .and. & diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index 7139fffd9..fc2d5c965 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -64,15 +64,13 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f ! local variables type(med_fldList_entry_type), pointer :: fldptr - integer :: nfld_out,nfld_in,nm + integer :: nfld_out,nm integer :: compsrc - integer :: num_merge_fields integer :: num_merge_colon_fields character(CL) :: merge_fields character(CL) :: merge_field character(CS) :: merge_type character(CS) :: merge_fracname - character(CS), pointer :: merge_field_names(:) logical :: error_check = .false. ! TODO: make this an input argument integer :: ungriddedUBound_out(1) ! size of ungridded dimension integer :: fieldcount @@ -218,14 +216,12 @@ subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo, ! local variables type(med_fldList_entry_type), pointer :: fldptr - integer :: nfld_out,nfld_in,nm - integer :: num_merge_fields + integer :: nfld_out,nm integer :: num_merge_colon_fields character(CL) :: merge_fields character(CL) :: merge_field character(CS) :: merge_type character(CS) :: merge_fracname - character(CS) :: merge_field_name integer :: ungriddedUBound_out(1) ! size of ungridded dimension integer :: fieldcount character(CL) , pointer :: fieldnamelist(:) @@ -337,7 +333,6 @@ subroutine med_merge_auto_field(merge_type, field_out, ungriddedUBound_out, & real(R8), pointer :: dpf1(:) real(R8), pointer :: dpf2(:,:) ! intput pointers to 1d and 2d fields real(R8), pointer :: dpw1(:) ! weight pointer - character(CL) :: name character(len=*),parameter :: subname=' (med_merge_mod: med_merge_auto_field)' !--------------------------------------- @@ -544,7 +539,7 @@ subroutine med_merge_field_1D(FBout, fnameout, & real(R8), pointer :: dataOut(:) real(R8), pointer :: dataPtr(:) real(R8), pointer :: wgt(:) - integer :: lb1,ub1,i,j,n + integer :: lb1,ub1,i,n logical :: wgtfound, FBinfound integer :: dbrc character(len=*),parameter :: subname='(med_merge_field_1D)' diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 01dec6473..f30c78ea9 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -214,7 +214,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - +#ifdef CESMCOUPLED ! local variables type(ocnalb_type), save :: ocnalb type(ESMF_VM) :: vm @@ -252,7 +252,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) logical :: first_call = .true. character(len=*) , parameter :: subname='(med_phases_ocnalb_run)' !--------------------------------------- - +#endif rc = ESMF_SUCCESS #ifndef CESMCOUPLED @@ -459,9 +459,11 @@ subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, mastertask, rc) integer , intent(out) :: rc ! output error ! local variables +#ifdef CESMCOUPLED character(len=CL) :: msgstr ! temporary character(len=CL) :: cvalue ! temporary character(len=*) , parameter :: subname = "(med_phases_ocnalb_orbital_init)" +#endif !------------------------------------------- rc = ESMF_SUCCESS @@ -562,6 +564,7 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, integer , intent(out) :: rc ! output error ! local variables +#ifdef CESMCOUPLED type(ESMF_Time) :: CurrTime ! current time integer :: year ! model year at current time integer :: orb_year ! orbital year for current orbital computation @@ -569,6 +572,7 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, logical :: lprint logical :: first_time = .true. character(len=*) , parameter :: subname = "(med_phases_ocnalb_orbital_update)" +#endif !------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index 3cf2b64dd..9ed1b78d4 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -28,7 +28,7 @@ subroutine med_phases_post_atm(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_FieldBundleGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : InternalState use med_phases_history_mod, only : med_phases_history_write_comp use med_map_mod , only : med_map_field_packed use med_constants_mod , only : dbug_flag => med_constants_dbug_flag diff --git a/mediator/med_phases_post_ice_mod.F90 b/mediator/med_phases_post_ice_mod.F90 index d081448e4..739369525 100644 --- a/mediator/med_phases_post_ice_mod.F90 +++ b/mediator/med_phases_post_ice_mod.F90 @@ -28,9 +28,9 @@ subroutine med_phases_post_ice(gcomp, rc) use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_map_mod , only : med_map_field_packed use med_fraction_mod , only : med_fraction_set - use med_internalstate_mod , only : InternalState, mastertask + use med_internalstate_mod , only : InternalState use med_phases_history_mod, only : med_phases_history_write_comp - use med_internalstate_mod , only : compice, compatm, compocn, compwav + use med_internalstate_mod , only : compice, compocn, compwav use perf_mod , only : t_startf, t_stopf ! input/output variables diff --git a/mediator/med_phases_post_lnd_mod.F90 b/mediator/med_phases_post_lnd_mod.F90 index d057506af..589698fad 100644 --- a/mediator/med_phases_post_lnd_mod.F90 +++ b/mediator/med_phases_post_lnd_mod.F90 @@ -23,7 +23,7 @@ subroutine med_phases_post_lnd(gcomp, rc) use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_map_mod , only : med_map_field_packed - use med_internalstate_mod , only : InternalState, mastertask + use med_internalstate_mod , only : InternalState use med_phases_prep_rof_mod , only : med_phases_prep_rof_accum use med_phases_prep_glc_mod , only : med_phases_prep_glc_accum_lnd, med_phases_prep_glc_avg use med_phases_history_mod , only : med_phases_history_write_comp diff --git a/mediator/med_phases_post_ocn_mod.F90 b/mediator/med_phases_post_ocn_mod.F90 index abf766211..bfc234507 100644 --- a/mediator/med_phases_post_ocn_mod.F90 +++ b/mediator/med_phases_post_ocn_mod.F90 @@ -26,7 +26,7 @@ subroutine med_phases_post_ocn(gcomp, rc) use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_map_mod , only : med_map_field_packed - use med_internalstate_mod , only : InternalState, logunit, mastertask + use med_internalstate_mod , only : InternalState use med_internalstate_mod , only : compice, compocn, compwav use med_phases_history_mod , only : med_phases_history_write_comp use med_phases_prep_glc_mod , only : med_phases_prep_glc_accum_ocn diff --git a/mediator/med_phases_post_wav_mod.F90 b/mediator/med_phases_post_wav_mod.F90 index 31abf004c..50592012c 100644 --- a/mediator/med_phases_post_wav_mod.F90 +++ b/mediator/med_phases_post_wav_mod.F90 @@ -23,7 +23,7 @@ subroutine med_phases_post_wav(gcomp, rc) use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_map_mod , only : med_map_field_packed - use med_internalstate_mod , only : InternalState, mastertask + use med_internalstate_mod , only : InternalState use med_internalstate_mod , only : compwav, compatm, compocn, compice use med_phases_history_mod, only : med_phases_history_write_comp use perf_mod , only : t_startf, t_stopf diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 9448f6913..47ef5928b 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -46,13 +46,12 @@ subroutine med_phases_prep_atm(gcomp, rc) ! local variables type(ESMF_Field) :: lfield - character(len=64) :: timestr type(InternalState) :: is_local real(R8), pointer :: dataPtr1(:) real(R8), pointer :: dataPtr2(:) real(R8), pointer :: ifrac(:) real(R8), pointer :: ofrac(:) - integer :: i, j, n, n1, ncnt + integer :: n type(med_fldlist_type), pointer :: fldList character(len=*),parameter :: subname='(med_phases_prep_atm)' !------------------------------------------------------------------------------- diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 20f953a64..64bced198 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -32,7 +32,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : complnd, compatm - use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : InternalState, mastertask use med_merge_mod , only : med_merge_auto use perf_mod , only : t_startf, t_stopf @@ -44,11 +44,8 @@ subroutine med_phases_prep_lnd(gcomp, rc) type(ESMF_StateItem_Flag) :: itemType type(InternalState) :: is_local type(ESMF_Field) :: lfield - integer :: ncnt,ns - real(r8) :: nextsw_cday + integer :: ncnt integer :: scalar_id - real(r8) :: tmp(1) - real(r8), pointer :: dataptr2d(:,:) logical :: first_call = .true. logical :: field_found type(med_fldlist_type), pointer :: fldList diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index b8b4f2fa6..981bc1742 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -88,7 +88,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: n, ncnt + integer :: n real(r8) :: glob_area_inv real(r8), pointer :: tocn(:) real(r8), pointer :: rain(:), hrain(:) @@ -624,10 +624,6 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) ! local variables type(InternalState) :: is_local - real(R8), pointer :: ocnwgt1(:) - real(R8), pointer :: icewgt1(:) - real(R8), pointer :: wgtp01(:) - real(R8), pointer :: wgtm01(:) real(R8), pointer :: customwgt(:) real(R8), pointer :: ifrac(:) real(R8), pointer :: ofrac(:) diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 0a8999231..ef977524b 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -90,7 +90,7 @@ subroutine med_phases_prep_rof_init(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: n, n1, nflds + integer :: n, nflds type(ESMF_Mesh) :: mesh_l type(ESMF_Mesh) :: mesh_r type(ESMF_Field) :: lfield @@ -197,9 +197,7 @@ subroutine med_phases_prep_rof_accum(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: i,j,n,ncnt - integer :: fieldCount - integer :: ungriddedUBound(1) + integer :: n logical :: exists real(r8), pointer :: dataptr1d(:) real(r8), pointer :: dataptr1d_accum(:) @@ -277,18 +275,13 @@ subroutine med_phases_prep_rof(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: i,j,n,n1,ncnt + integer :: n integer :: count logical :: exists real(r8), pointer :: dataptr(:) real(r8), pointer :: dataptr1d(:) - type(ESMF_Field) :: field_irrig_flux type(ESMF_Field) :: lfield - type(ESMF_Field) :: lfield_src - type(ESMF_Field) :: lfield_dst - type(ESMF_Field) :: field_lfrac_lnd type(med_fldList_type), pointer :: fldList - character(CL), pointer :: lfieldnamelist(:) character(len=*),parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof)' !--------------------------------------- @@ -455,10 +448,6 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) ! local variables integer :: r,l type(InternalState) :: is_local - integer :: fieldcount - type(ESMF_Field) :: field_import_rof - type(ESMF_Field) :: field_import_lnd - type(ESMF_Field) :: field_irrig_flux type(ESMF_Field) :: field_lfrac_lnd type(ESMF_Mesh) :: lmesh_lnd type(ESMF_Mesh) :: lmesh_rof diff --git a/mediator/med_phases_profile_mod.F90 b/mediator/med_phases_profile_mod.F90 index 46d8f2a73..b3dcc05fa 100644 --- a/mediator/med_phases_profile_mod.F90 +++ b/mediator/med_phases_profile_mod.F90 @@ -58,7 +58,6 @@ subroutine med_phases_profile(gcomp, rc) type(ESMF_Time), save :: prevTime type(ESMF_TimeInterval) :: ringInterval, timestep type(ESMF_Alarm) :: alarm - integer :: yr, mon, day, hr, min, sec logical :: ispresent logical :: alarmison=.false., stopalarmison=.false. real(R8) :: current_time, wallclockelapsed, ypd diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 5affb149a..0331e1cb7 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -58,8 +58,6 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) type(ESMF_Clock) :: mclock type(ESMF_TimeInterval) :: mtimestep type(ESMF_Time) :: mCurrTime - type(ESMF_Time) :: mStartTime - type(ESMF_TimeInterval) :: timestep integer :: timestep_length character(CL) :: cvalue ! attribute string character(CL) :: restart_option ! freq_option setting (ndays, nsteps, etc) @@ -175,11 +173,8 @@ subroutine med_phases_restart_write(gcomp, rc) character(ESMF_MAXSTR) :: cpl_inst_tag ! instance tag character(ESMF_MAXSTR) :: restart_dir ! Optional restart directory name character(ESMF_MAXSTR) :: cvalue ! attribute string - character(ESMF_MAXSTR) :: freq_option ! freq_option setting (ndays, nsteps, etc) - integer :: freq_n ! freq_n setting relative to freq_option logical :: alarmIsOn ! generic alarm flag real(R8) :: tbnds(2) ! CF1.0 time bounds - character(ESMF_MAXSTR) :: tmpstr logical :: isPresent logical :: first_time = .true. character(len=*), parameter :: subname='(med_phases_restart_write)' @@ -304,7 +299,7 @@ subroutine med_phases_restart_write(gcomp, rc) trim(nexttimestr),'.nc' if (mastertask) then - restart_pfile = "rpointer.cpl"//cpl_inst_tag + restart_pfile = "rpointer.cpl"//trim(cpl_inst_tag) call ESMF_LogWrite(trim(subname)//" write rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED') write(unitn,'(a)') trim(restart_file) @@ -495,7 +490,7 @@ subroutine med_phases_restart_read(gcomp, rc) type(ESMF_Time) :: currtime character(len=CS) :: currtimestr type(InternalState) :: is_local - integer :: i,j,m,n + integer :: n integer :: ierr, unitn integer :: yr,mon,day,sec ! time units character(ESMF_MAXSTR) :: case_name ! case name @@ -543,7 +538,7 @@ subroutine med_phases_restart_read(gcomp, rc) endif ! Get the restart file name from the pointer file - restart_pfile = "rpointer.cpl"//cpl_inst_tag + restart_pfile = "rpointer.cpl"//trim(cpl_inst_tag) if (mastertask) then call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old', iostat=ierr) From 717e6d4e3a4c74d6fc0bcd2266153dcf05fdb959 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 15:09:21 -0700 Subject: [PATCH 222/395] no warnings now for cesm build --- mediator/med_diag_mod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 204d45684..6cf30a8df 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -2028,7 +2028,9 @@ subroutine med_phases_diag_print(gcomp, rc) integer :: p_size ! number of period types real(r8), allocatable :: datagpr(:,:,:) logical, save :: firstcall = .true. +#ifdef DEBUG character(len=CL) :: timestr +#endif character(*), parameter :: subName = '(med_phases_diag_print) ' ! ------------------------------------------------------------------ From 90f918e86111ffcd8734686f8c6003e445a11468 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 15:16:01 -0700 Subject: [PATCH 223/395] no warnings now for cesm build --- mediator/med_phases_profile_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_phases_profile_mod.F90 b/mediator/med_phases_profile_mod.F90 index b3dcc05fa..0b5a992ad 100644 --- a/mediator/med_phases_profile_mod.F90 +++ b/mediator/med_phases_profile_mod.F90 @@ -184,6 +184,7 @@ subroutine med_phases_profile(gcomp, rc) call shr_mem_getusage(msize,mrss,.true.) write(logunit,105) ' memory_write: model date = ',trim(nexttimestr), & ' memory = ',msize,' MB (highwater) ',mrss,' MB (usage)' +105 format( 3A, f10.2, A, f10.2, A) #endif previous_time = current_time @@ -192,7 +193,6 @@ subroutine med_phases_profile(gcomp, rc) iterations = iterations + 1 101 format( 5A, F8.2, A, F8.2, A, F8.2, A) -105 format( 3A, f10.2, A, f10.2, A) !--------------------------------------- !--- clean up !--------------------------------------- From b7b69606e5bd332b0e8a6d48fe3ad985708ffd51 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 15:19:51 -0700 Subject: [PATCH 224/395] no warnings now for cesm build --- mediator/med_phases_profile_mod.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/mediator/med_phases_profile_mod.F90 b/mediator/med_phases_profile_mod.F90 index 0b5a992ad..7e9fb3c47 100644 --- a/mediator/med_phases_profile_mod.F90 +++ b/mediator/med_phases_profile_mod.F90 @@ -61,7 +61,10 @@ subroutine med_phases_profile(gcomp, rc) logical :: ispresent logical :: alarmison=.false., stopalarmison=.false. real(R8) :: current_time, wallclockelapsed, ypd - real(r8) :: msize, mrss, ringdays + real(r8) :: ringdays +#ifdef CESMCOUPLED + real(r8) :: msize, mrss +#endif real(r8), save :: avgdt character(len=CL) :: walltimestr, nexttimestr character(len=*), parameter :: subname='(med_phases_profile)' From 8f3b6585e022fd850cf102d8b03c0d0d04ce8300 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 15:25:05 -0700 Subject: [PATCH 225/395] put ocnalb back --- mediator/CMakeLists.txt | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/mediator/CMakeLists.txt b/mediator/CMakeLists.txt index b6cd7cb14..84f62675e 100644 --- a/mediator/CMakeLists.txt +++ b/mediator/CMakeLists.txt @@ -13,13 +13,11 @@ set(SRCFILES esmFldsExchange_cesm_mod.F90 med_fraction_mod.F90 med_phases_prep_atm_mod.F90 med_phases_prep_wav_mod.F90 med.F90 med_merge_mod.F90 med_phases_prep_glc_mod.F90 med_phases_profile_mod.F90 med_diag_mod.F90 - med_phases_post_ocn_mod.F90 + med_phases_post_ocn_mod.F90 med_phases_ocnalb_mod.F90 med_phases_post_atm_mod.F90 med_phases_post_ice_mod.F90 med_phases_post_lnd_mod.F90 med_phases_post_glc_mod.F90 med_phases_post_rof_mod.F90 med_phases_post_wav_mod.F90) -if(NOT BLD_STANDALONE) - list(APPEND SRCFILES med_phases_ocnalb_mod.F90) -endif() + foreach(FILE ${SRCFILES}) if(EXISTS "${CASEROOT}/SourceMods/src.cmeps/${FILE}") list(REMOVE_ITEM SRCFILES ${FILE}) From 707ae2fb3e68e6bd15d35e6eef252379c304acdc Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 15:54:10 -0700 Subject: [PATCH 226/395] no warnings now for cesm build --- mediator/med_phases_ocnalb_mod.F90 | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index f30c78ea9..efb0cf1f9 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -26,10 +26,11 @@ module med_phases_ocnalb_mod !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- - +#ifdef CESMCOUPLED private med_phases_ocnalb_init - private med_phases_ocnalb_orbital_init private med_phases_ocnalb_orbital_update +#endif + private med_phases_ocnalb_orbital_init !-------------------------------------------------------------------------- ! Private data @@ -64,7 +65,7 @@ module med_phases_ocnalb_mod !=============================================================================== contains !=============================================================================== - +#ifdef CESMCOUPLED subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) !----------------------------------------------------------------------- @@ -191,7 +192,7 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) call t_stopf('MED:'//subname) end subroutine med_phases_ocnalb_init - +#endif !=============================================================================== subroutine med_phases_ocnalb_run(gcomp, rc) @@ -543,7 +544,7 @@ subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, mastertask, rc) end subroutine med_phases_ocnalb_orbital_init !=============================================================================== - +#ifdef CESMCOUPLED subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, obliqr, lambm0, mvelpp, rc) !---------------------------------------------------------- @@ -564,7 +565,6 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, integer , intent(out) :: rc ! output error ! local variables -#ifdef CESMCOUPLED type(ESMF_Time) :: CurrTime ! current time integer :: year ! model year at current time integer :: orb_year ! orbital year for current orbital computation @@ -572,12 +572,10 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, logical :: lprint logical :: first_time = .true. character(len=*) , parameter :: subname = "(med_phases_ocnalb_orbital_update)" -#endif !------------------------------------------- rc = ESMF_SUCCESS -#ifdef CESMCOUPLED if (trim(orb_mode) == trim(orb_variable_year)) then call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -605,9 +603,9 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return ! bail out endif -#endif end subroutine med_phases_ocnalb_orbital_update +#endif !=============================================================================== From 7b36b52018d3d6643a0e5a61bb5e70b5554df082 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Jan 2023 15:57:53 -0700 Subject: [PATCH 227/395] no warnings now for cesm build --- mediator/med_phases_ocnalb_mod.F90 | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index efb0cf1f9..ccec8ec2e 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -29,8 +29,8 @@ module med_phases_ocnalb_mod #ifdef CESMCOUPLED private med_phases_ocnalb_init private med_phases_ocnalb_orbital_update -#endif private med_phases_ocnalb_orbital_init +#endif !-------------------------------------------------------------------------- ! Private data @@ -441,7 +441,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) end subroutine med_phases_ocnalb_run !=============================================================================== - +#ifdef CESMCOUPLED subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, mastertask, rc) !---------------------------------------------------------- @@ -460,16 +460,14 @@ subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, mastertask, rc) integer , intent(out) :: rc ! output error ! local variables -#ifdef CESMCOUPLED + character(len=CL) :: msgstr ! temporary character(len=CL) :: cvalue ! temporary character(len=*) , parameter :: subname = "(med_phases_ocnalb_orbital_init)" -#endif !------------------------------------------- rc = ESMF_SUCCESS -#ifdef CESMCOUPLED ! Determine orbital attributes from input call NUOPC_CompAttributeGet(gcomp, name="orb_mode", value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -539,12 +537,10 @@ subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, mastertask, rc) rc = ESMF_FAILURE return ! bail out endif -#endif - end subroutine med_phases_ocnalb_orbital_init !=============================================================================== -#ifdef CESMCOUPLED + subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, obliqr, lambm0, mvelpp, rc) !---------------------------------------------------------- From 2ded3b51bc9b2f545f9e157e56f108dff67b5bd4 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 5 Jan 2023 14:45:19 -0700 Subject: [PATCH 228/395] pretty print is broken, leave it out --- cesm/driver/esm.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index 7aef5a8e0..1c73ea17d 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -271,8 +271,8 @@ subroutine SetRunSequence(driver, rc) ! file=__FILE__)) & ! return ! bail out - call pretty_print_nuopc_freeformat(runSeqFF, 'run sequence', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return +! call pretty_print_nuopc_freeformat(runSeqFF, 'run sequence', rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return #endif call NUOPC_FreeFormatDestroy(runSeqFF, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -737,11 +737,11 @@ subroutine ReadAttributes(gcomp, config, label, relaxedflag, formatprint, rc) call NUOPC_CompAttributeIngest(gcomp, attrFF, addFlag=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return -#if DEBUG - if (present (formatprint)) then - call pretty_print_nuopc_freeformat(attrFF, trim(label)//' attributes', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if +#ifdef DEBUG +! if (present (formatprint)) then +! call pretty_print_nuopc_freeformat(attrFF, trim(label)//' attributes', rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return +! end if #endif call NUOPC_FreeFormatDestroy(attrFF, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From d81f8d0ad69cb5502119da58fceefcfe82f70b5c Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 6 Jan 2023 13:03:47 -0700 Subject: [PATCH 229/395] initialize lprint --- cime_config/namelist_definition_drv.xml | 2 +- mediator/med_phases_ocnalb_mod.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 4a5b34fca..ce1ae92ff 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -891,7 +891,7 @@ default: xgrid - xgrid + ogrid diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index ccec8ec2e..ecaf9956f 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -571,7 +571,7 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, !------------------------------------------- rc = ESMF_SUCCESS - + lprint = .false. if (trim(orb_mode) == trim(orb_variable_year)) then call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From 000c0dc71cb3d4c204f5ba4cd414714bfdbde945 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 9 Jan 2023 10:54:06 -0700 Subject: [PATCH 230/395] replace use of master with main --- .github/workflows/bumpversion.yml | 2 +- .github/workflows/extbuild.yml | 6 +-- .github/workflows/srt.yml | 8 +-- cesm/driver/ensemble_driver.F90 | 8 +-- cesm/driver/esm.F90 | 16 +++--- cesm/driver/esm_time_mod.F90 | 18 +++---- cesm/nuopc_cap_share/driver_pio_mod.F90 | 12 ++--- cesm/nuopc_cap_share/esm_utils_mod.F90 | 2 +- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 12 ++--- cime_config/config_component.xml | 4 +- doc/source/addendum/req_attributes.rst | 2 +- doc/source/conf.py | 16 +++--- doc/source/index.rst | 2 +- mediator/esmFldsExchange_cesm_mod.F90 | 42 +++++++-------- mediator/med.F90 | 60 +++++++++++----------- mediator/med_diag_mod.F90 | 30 +++++------ mediator/med_internalstate_mod.F90 | 12 ++--- mediator/med_map_mod.F90 | 38 +++++++------- mediator/med_phases_aofluxes_mod.F90 | 22 ++++---- mediator/med_phases_history_mod.F90 | 24 ++++----- mediator/med_phases_ocnalb_mod.F90 | 14 ++--- mediator/med_phases_post_glc_mod.F90 | 6 +-- mediator/med_phases_prep_atm_mod.F90 | 4 +- mediator/med_phases_prep_glc_mod.F90 | 20 ++++---- mediator/med_phases_prep_ice_mod.F90 | 6 +-- mediator/med_phases_prep_lnd_mod.F90 | 4 +- mediator/med_phases_prep_ocn_mod.F90 | 12 ++--- mediator/med_phases_prep_rof_mod.F90 | 4 +- mediator/med_phases_prep_wav_mod.F90 | 6 +-- mediator/med_phases_profile_mod.F90 | 4 +- mediator/med_phases_restart_mod.F90 | 12 ++--- mediator/med_time_mod.F90 | 4 +- mediator/med_utils_mod.F90 | 6 +-- ufs/flux_atmocn_ccpp_mod.F90 | 10 ++-- ufs/ufs_io_mod.F90 | 10 ++-- 35 files changed, 229 insertions(+), 229 deletions(-) diff --git a/.github/workflows/bumpversion.yml b/.github/workflows/bumpversion.yml index 7364cb8d8..b17d491f0 100644 --- a/.github/workflows/bumpversion.yml +++ b/.github/workflows/bumpversion.yml @@ -2,7 +2,7 @@ name: Bump version on: push: branches: - - master + - main jobs: build: runs-on: ubuntu-latest diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 8455f2928..fafc46f46 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -2,12 +2,12 @@ name: extbuild # Controls when the action will run. Triggers the workflow on push or pull request -# events but only for the master branch +# events but only for the main branch on: push: - branches: [ master ] + branches: [ main ] pull_request: - branches: [ master ] + branches: [ main ] # A workflow run is made up of one or more jobs that can run sequentially or in parallel jobs: diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 3f156fb25..45cb76058 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -3,12 +3,12 @@ name: scripts regression tests # Controls when the action will run. Triggers the workflow on push or pull request -# events but only for the master branch +# events but only for the main branch on: push: - branches: [ master ] + branches: [ main ] pull_request: - branches: [ master ] + branches: [ main ] # A workflow run is made up of one or more jobs that can run sequentially or in parallel jobs: @@ -51,7 +51,7 @@ jobs: - run: echo "PyYAML" > requirements.txt - name: Install PyYAML run: pip install -r requirements.txt - # use the latest cesm master + # use the latest cesm main - name: cesm checkout uses: actions/checkout@v3 with: diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 7e64c1cc6..2c7e66fbc 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -9,7 +9,7 @@ module Ensemble_driver use shr_kind_mod , only : cl=>shr_kind_cl, cs=>shr_kind_cs use shr_log_mod , only : shr_log_setLogUnit - use esm_utils_mod , only : mastertask, logunit, chkerr + use esm_utils_mod , only : maintask, logunit, chkerr implicit none private @@ -250,15 +250,15 @@ subroutine SetModelServices(ensemble_driver, rc) call NUOPC_CompAttributeGet(driver, name="logfile", value=logfile, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return open (newunit=logunit,file=trim(diro)//"/"//trim(logfile)) - mastertask = .true. + maintask = .true. else logUnit = 6 - mastertask = .false. + maintask = .false. endif call shr_log_setLogUnit (logunit) ! Create a clock for each driver instance - call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) + call esm_time_clockInit(ensemble_driver, driver, logunit, maintask, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index 1c73ea17d..6b094992e 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -9,7 +9,7 @@ module ESM use shr_mpi_mod , only : shr_mpi_bcast use shr_mem_mod , only : shr_mem_init use shr_log_mod , only : shr_log_setLogunit - use esm_utils_mod, only : logunit, mastertask, dbug_flag, chkerr + use esm_utils_mod, only : logunit, maintask, dbug_flag, chkerr use perf_mod , only : t_initf, t_setLogUnit implicit none @@ -154,9 +154,9 @@ subroutine SetModelServices(driver, rc) call ESMF_VMGet(vm, localPet=localPet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (localPet == 0) then - mastertask=.true. + maintask=.true. else - mastertask = .false. + maintask = .false. end if !------------------------------------------- @@ -206,7 +206,7 @@ subroutine SetModelServices(driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Memory test - if (mastertask) then + if (maintask) then call shr_mem_init(strbuf=meminitstr) write(logunit,*) trim(meminitstr) end if @@ -214,7 +214,7 @@ subroutine SetModelServices(driver, rc) !------------------------------------------- ! Timer initialization (has to be after pelayouts are determined) !------------------------------------------- - call t_initf('drv_in', LogPrint=.true., LogUnit=logunit, mpicom=global_comm, mastertask=mastertask, MaxThreads=maxthreads) + call t_initf('drv_in', LogPrint=.true., LogUnit=logunit, mpicom=global_comm, maintask=maintask, MaxThreads=maxthreads) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -301,7 +301,7 @@ subroutine pretty_print_nuopc_freeformat(ffstuff, label, rc) rc = ESMF_SUCCESS - if (mastertask .or. dbug_flag > 3) then + if (maintask .or. dbug_flag > 3) then write(logunit, *) 'BEGIN: ', trim(label) call NUOPC_FreeFormatGet(ffstuff, linecount=linecnt, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -467,7 +467,7 @@ subroutine InitAttributes(driver, rc) call NUOPC_CompAttributeGet(driver, name="tfreeze_option", value=tfreeze_option, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_frz_freezetemp_init(tfreeze_option, mastertask) + call shr_frz_freezetemp_init(tfreeze_option, maintask) call NUOPC_CompAttributeGet(driver, name='cpl_rootpe', value=cvalue, rc=rc) read(cvalue, *) rootpe_med @@ -1519,7 +1519,7 @@ subroutine esm_finalize(driver, rc) rc = ESMF_SUCCESS - if (mastertask) then + if (maintask) then write(logunit,*)' SUCCESSFUL TERMINATION OF CESM' end if diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index ada8f2da2..0c8a6e86c 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -52,12 +52,12 @@ module esm_time_mod contains !=============================================================================== - subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastertask, rc) + subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintask, rc) ! input/output variables type(ESMF_GridComp) :: ensemble_driver, instance_driver integer, intent(in) :: logunit - logical, intent(in) :: mastertask + logical, intent(in) :: maintask integer, intent(out) :: rc ! local variables @@ -142,7 +142,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert restart_pfile = trim(restart_file)//inst_suffix - if (mastertask) then + if (maintask) then call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) @@ -160,7 +160,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert return end if close(unitn) - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//" reading driver restart from file = "//trim(restart_file) end if call esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) @@ -177,7 +177,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert else - if (mastertask) then + if (maintask) then write(logunit,*) ' NOTE: the current compset has no mediator - which provides the clock restart information' write(logunit,*) ' In this case the restarts are handled solely by the component being used and' write(logunit,*) ' and the driver clock will always be starting from the initial date on restart' @@ -200,7 +200,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert call ESMF_TimeSet( StartTime, yy=yr, mm=mon, dd=day, s=start_tod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(mastertask) then + if(maintask) then write(tmpstr,'(i10)') start_ymd call ESMF_LogWrite(trim(subname)//': driver start_ymd: '// trim(tmpstr), ESMF_LOGMSG_INFO) write(logunit,*) trim(subname)//': driver start_ymd: '// trim(tmpstr) @@ -214,7 +214,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert call ESMF_TimeSet( CurrTime, yy=yr, mm=mon, dd=day, s=curr_tod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(mastertask) then + if(maintask) then write(tmpstr,'(i10)') curr_ymd call ESMF_LogWrite(trim(subname)//': driver curr_ymd: '// trim(tmpstr), ESMF_LOGMSG_INFO) write(logunit,*) trim(subname)//': driver curr_ymd: '// trim(tmpstr) @@ -267,7 +267,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert read(cvalue,*) glc_avg_period dtime_drv = minval((/atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt/)) - if(mastertask) then + if(maintask) then write(tmpstr,'(i10)') dtime_drv call ESMF_LogWrite(trim(subname)//': driver time interval is : '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(logunit,*) trim(subname)//': driver time interval is : '// trim(tmpstr) @@ -314,7 +314,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert stop_tod = 0 endif - if (mastertask) then + if (maintask) then write(tmpstr,'(i10)') stop_ymd call ESMF_LogWrite(trim(subname)//': driver stop_ymd: '// trim(tmpstr), ESMF_LOGMSG_INFO) write(logunit,*) trim(subname)//': driver stop_ymd: '// trim(tmpstr) diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index 42d301221..43d913c6d 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -27,7 +27,7 @@ module driver_pio_mod logical, allocatable :: pio_async_interface(:) integer :: total_comps - logical :: mastertask + logical :: maintask #define DEBUGI 1 #ifdef DEBUGI @@ -72,7 +72,7 @@ subroutine driver_pio_init(driver, rc) call ESMF_VMGet(vm, localPet=localPet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - mastertask = (localPet == 0) + maintask = (localPet == 0) call NUOPC_CompAttributeGet(driver, name="pio_buffer_size_limit", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -80,7 +80,7 @@ subroutine driver_pio_init(driver, rc) ! 0 is a valid value of pio_buffer_size_limit if(pio_buffer_size_limit>=0) then - if(mastertask) write(shr_log_unit,*) 'Setting pio_buffer_size_limit : ',pio_buffer_size_limit + if(maintask) write(shr_log_unit,*) 'Setting pio_buffer_size_limit : ',pio_buffer_size_limit call pio_set_buffer_size_limit(pio_buffer_size_limit) endif @@ -89,7 +89,7 @@ subroutine driver_pio_init(driver, rc) read(cname, *) pio_blocksize if(pio_blocksize>0) then - if(mastertask) write(shr_log_unit,*) 'Setting pio_blocksize : ',pio_blocksize + if(maintask) write(shr_log_unit,*) 'Setting pio_blocksize : ',pio_blocksize call pio_set_blocksize(pio_blocksize) endif @@ -98,7 +98,7 @@ subroutine driver_pio_init(driver, rc) read(cname, *) pio_debug_level if(pio_debug_level > 0) then - if(mastertask) write(shr_log_unit,*) 'Setting pio_debug_level : ',pio_debug_level + if(maintask) write(shr_log_unit,*) 'Setting pio_debug_level : ',pio_debug_level ret = pio_set_log_level(pio_debug_level) endif @@ -145,7 +145,7 @@ subroutine driver_pio_init(driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cname, *) pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req - if(mastertask) then + if(maintask) then ! Log the rearranger options write(shr_log_unit, *) "PIO rearranger options:" write(shr_log_unit, *) " comm type = ", pio_rearr_opts%comm_type, " (",trim(pio_rearr_comm_type),")" diff --git a/cesm/nuopc_cap_share/esm_utils_mod.F90 b/cesm/nuopc_cap_share/esm_utils_mod.F90 index f6a4aeb40..7832e79d3 100644 --- a/cesm/nuopc_cap_share/esm_utils_mod.F90 +++ b/cesm/nuopc_cap_share/esm_utils_mod.F90 @@ -3,7 +3,7 @@ module esm_utils_mod implicit none public - logical :: mastertask + logical :: maintask integer :: logunit integer :: dbug_flag = 0 diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index 0ed53f22b..cfa2b00e1 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -75,12 +75,12 @@ module nuopc_shr_methods contains !=============================================================================== - subroutine memcheck(string, level, mastertask) + subroutine memcheck(string, level, maintask) ! input/output variables character(len=*) , intent(in) :: string integer , intent(in) :: level - logical , intent(in) :: mastertask + logical , intent(in) :: maintask ! local variables integer :: ierr @@ -90,7 +90,7 @@ subroutine memcheck(string, level, mastertask) !----------------------------------------------------------------------- #ifdef CESMCOUPLED - if ((mastertask .and. memdebug_level > level) .or. memdebug_level > level+1) then + if ((maintask .and. memdebug_level > level) .or. memdebug_level > level+1) then ierr = GPTLprint_memusage(string) endif #endif @@ -131,11 +131,11 @@ end subroutine get_component_instance !=============================================================================== - subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) + subroutine set_component_logging(gcomp, maintask, logunit, shrlogunit, rc) use driver_pio_mod, only : driver_pio_log_comp_settings ! input/output variables type(ESMF_GridComp) :: gcomp - logical, intent(in) :: mastertask + logical, intent(in) :: maintask integer, intent(out) :: logunit integer, intent(out) :: shrlogunit integer, intent(out) :: rc @@ -149,7 +149,7 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) rc = ESMF_SUCCESS - if (mastertask) then + if (maintask) then call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 923e9afa8..c06f7a7f3 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -45,7 +45,7 @@ - + @@ -54,7 +54,7 @@ $CIMEROOT/config_files.xml case_def env_case.xml - master configuration file that specifies all relevant filenames + main configuration file that specifies all relevant filenames and directories to configure a case diff --git a/doc/source/addendum/req_attributes.rst b/doc/source/addendum/req_attributes.rst index d6b844282..410303632 100644 --- a/doc/source/addendum/req_attributes.rst +++ b/doc/source/addendum/req_attributes.rst @@ -34,7 +34,7 @@ Scalar attributes between the mediator and a component. Currently scalar values are put into a field bundle that only contains an undistributed dimension equal to the size of ``ScalarFieldCount`` and communicated - between the component and the mediator on the `master task` of each + between the component and the mediator on the `main task` of each component. **ScalarFieldName** (required) diff --git a/doc/source/conf.py b/doc/source/conf.py index 80334e199..8c53bb751 100644 --- a/doc/source/conf.py +++ b/doc/source/conf.py @@ -51,8 +51,8 @@ # source_suffix = ['.rst', '.md'] source_suffix = '.rst' -# The master toctree document. -master_doc = 'index' +# The main toctree document. +main_doc = 'index' # General information about the project. project = u'CMEPS' @@ -64,9 +64,9 @@ # built documents. # # The short X.Y version. -version = u'master' +version = u'main' # The full version, including alpha/beta/rc tags. -release = u'master' +release = u'main' # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. @@ -143,7 +143,7 @@ # (source start file, target name, title, # author, documentclass [howto, manual, or own class]). latex_documents = [ - (master_doc, 'on.tex', u'on Documentation', + (main_doc, 'on.tex', u'on Documentation', u'Staff of the NCAR and NOAA/EMC', 'manual'), ] @@ -153,7 +153,7 @@ # One entry per manual page. List of tuples # (source start file, name, description, authors, manual section). man_pages = [ - (master_doc, 'on', u'on Documentation', + (main_doc, 'on', u'on Documentation', [author], 1) ] @@ -164,7 +164,7 @@ # (source start file, target name, title, author, # dir menu entry, description, category) texinfo_documents = [ - (master_doc, 'on', u'on Documentation', + (main_doc, 'on', u'on Documentation', author, 'on', 'One line description of project.', 'Miscellaneous'), ] @@ -172,7 +172,7 @@ # -- Options for pdf output ------------------------------------------------- pdf_documents = [ - (master_doc, + (main_doc, u'CMEPS_Users_Guide', u'CMEPS Users Guide (PDF)',) ] diff --git a/doc/source/index.rst b/doc/source/index.rst index c03f6276e..179198910 100644 --- a/doc/source/index.rst +++ b/doc/source/index.rst @@ -1,4 +1,4 @@ -.. on documentation master file, created by +.. on documentation main file, created by sphinx-quickstart on Mon May 18 11:50:23 2020. You can adapt this file completely to your liking, but it should at least contain the root `toctree` directive. diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index ac003daa4..ae3627491 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -20,7 +20,7 @@ module esmFldsExchange_cesm_mod !-------------------------------------- use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use med_internalstate_mod , only : logunit, mastertask + use med_internalstate_mod , only : logunit, maintask implicit none public @@ -71,7 +71,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_utils_mod , only : chkerr => med_utils_chkerr use med_methods_mod , only : fldchk => med_methods_FB_FldChk - use med_internalstate_mod , only : InternalState, logunit, mastertask + use med_internalstate_mod , only : InternalState, logunit, maintask use med_internalstate_mod , only : compmed, compatm, complnd, compocn use med_internalstate_mod , only : compice, comprof, compwav, compglc, ncomps use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_nstod @@ -124,71 +124,71 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! mapping to atm call NUOPC_CompAttributeGet(gcomp, name='ice2atm_map', value=ice2atm_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'ice2atm_map = '// trim(ice2atm_map) + if (maintask) write(logunit, '(a)') trim(subname)//'ice2atm_map = '// trim(ice2atm_map) call NUOPC_CompAttributeGet(gcomp, name='lnd2atm_map', value=lnd2atm_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'lnd2atm_map = '// trim(lnd2atm_map) + if (maintask) write(logunit, '(a)') trim(subname)//'lnd2atm_map = '// trim(lnd2atm_map) call NUOPC_CompAttributeGet(gcomp, name='ocn2atm_map', value=ocn2atm_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'ocn2atm_map = '// trim(ocn2atm_map) + if (maintask) write(logunit, '(a)') trim(subname)//'ocn2atm_map = '// trim(ocn2atm_map) ! mapping to lnd call NUOPC_CompAttributeGet(gcomp, name='atm2lnd_map', value=atm2lnd_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'atm2lnd_map = '// trim(atm2lnd_map) + if (maintask) write(logunit, '(a)') trim(subname)//'atm2lnd_map = '// trim(atm2lnd_map) call NUOPC_CompAttributeGet(gcomp, name='rof2lnd_map', value=rof2lnd_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'rof2lnd_map = '// trim(rof2lnd_map) + if (maintask) write(logunit, '(a)') trim(subname)//'rof2lnd_map = '// trim(rof2lnd_map) ! mapping to ice call NUOPC_CompAttributeGet(gcomp, name='atm2ice_map', value=atm2ice_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'atm2ice_map = '// trim(atm2ice_map) + if (maintask) write(logunit, '(a)') trim(subname)//'atm2ice_map = '// trim(atm2ice_map) call NUOPC_CompAttributeGet(gcomp, name='glc2ice_rmapname', value=glc2ice_rmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'glc2ice_rmapname = '// trim(glc2ice_rmap) + if (maintask) write(logunit, '(a)') trim(subname)//'glc2ice_rmapname = '// trim(glc2ice_rmap) ! mapping to ocn call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_map', value=atm2ocn_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'atm2ocn_map = '// trim(atm2ocn_map) + if (maintask) write(logunit, '(a)') trim(subname)//'atm2ocn_map = '// trim(atm2ocn_map) call NUOPC_CompAttributeGet(gcomp, name='glc2ocn_liq_rmapname', value=glc2ocn_liq_rmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'glc2ocn_liq_rmapname = '// trim(glc2ocn_liq_rmap) + if (maintask) write(logunit, '(a)') trim(subname)//'glc2ocn_liq_rmapname = '// trim(glc2ocn_liq_rmap) call NUOPC_CompAttributeGet(gcomp, name='glc2ocn_ice_rmapname', value=glc2ocn_ice_rmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'glc2ocn_ice_rmapname = '// trim(glc2ocn_ice_rmap) + if (maintask) write(logunit, '(a)') trim(subname)//'glc2ocn_ice_rmapname = '// trim(glc2ocn_ice_rmap) call NUOPC_CompAttributeGet(gcomp, name='wav2ocn_smapname', value=wav2ocn_smap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'wav2ocn_smapname = '// trim(wav2ocn_smap) + if (maintask) write(logunit, '(a)') trim(subname)//'wav2ocn_smapname = '// trim(wav2ocn_smap) call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_fmapname', value=rof2ocn_fmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'rof2ocn_fmapname = '// trim(rof2ocn_fmap) + if (maintask) write(logunit, '(a)') trim(subname)//'rof2ocn_fmapname = '// trim(rof2ocn_fmap) call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_liq_rmapname', value=rof2ocn_liq_rmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'rof2ocn_liq_rmapname = '// trim(rof2ocn_liq_rmap) + if (maintask) write(logunit, '(a)') trim(subname)//'rof2ocn_liq_rmapname = '// trim(rof2ocn_liq_rmap) call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_ice_rmapname', value=rof2ocn_ice_rmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'rof2ocn_ice_rmapname = '// trim(rof2ocn_ice_rmap) + if (maintask) write(logunit, '(a)') trim(subname)//'rof2ocn_ice_rmapname = '// trim(rof2ocn_ice_rmap) ! mapping to rof call NUOPC_CompAttributeGet(gcomp, name='lnd2rof_map', value=lnd2rof_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'lnd2rof_map = '// trim(lnd2rof_map) + if (maintask) write(logunit, '(a)') trim(subname)//'lnd2rof_map = '// trim(lnd2rof_map) ! mapping to wav call NUOPC_CompAttributeGet(gcomp, name='atm2wav_map', value=atm2wav_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit,'(a)') trim(subname)//'atm2wav_map = '// trim(atm2wav_map) + if (maintask) write(logunit,'(a)') trim(subname)//'atm2wav_map = '// trim(atm2wav_map) call NUOPC_CompAttributeGet(gcomp, name='ice2wav_smapname', value=ice2wav_smap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit,'(a)') trim(subname)//'ice2wav_smapname = '// trim(ice2wav_smap) + if (maintask) write(logunit,'(a)') trim(subname)//'ice2wav_smapname = '// trim(ice2wav_smap) call NUOPC_CompAttributeGet(gcomp, name='ocn2wav_smapname', value=ocn2wav_smap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit,'(a)') trim(subname)//'ocn2wav_smapname = '// trim(ocn2wav_smap) + if (maintask) write(logunit,'(a)') trim(subname)//'ocn2wav_smapname = '// trim(ocn2wav_smap) ! uv cart3d mapping call NUOPC_CompAttributeGet(gcomp, name='mapuv_with_cart3d', value=cvalue, rc=rc) @@ -221,7 +221,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) read(cvalue,*) flds_r2l_stream_channel_depths ! write diagnostic output - if (mastertask) then + if (maintask) then write(logunit,'(a,l7)') trim(subname)//' flds_co2a = ',flds_co2a write(logunit,'(a,l7)') trim(subname)//' flds_co2b = ',flds_co2b write(logunit,'(a,l7)') trim(subname)//' flds_co2c = ',flds_co2c diff --git a/mediator/med.F90 b/mediator/med.F90 index e9b76721b..acbd28948 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -40,7 +40,7 @@ module MED use med_utils_mod , only : memcheck => med_memcheck use med_time_mod , only : med_time_alarmInit use med_internalstate_mod , only : InternalState, med_internalstate_init, med_internalstate_coupling - use med_internalstate_mod , only : med_internalstate_defaultmasks, logunit, mastertask + use med_internalstate_mod , only : med_internalstate_defaultmasks, logunit, maintask use med_internalstate_mod , only : ncomps, compname use med_internalstate_mod , only : compmed, compatm, compocn, compice, complnd, comprof, compwav, compglc use med_internalstate_mod , only : coupling_mode, aoflux_code, aoflux_ccpp_suite @@ -547,7 +547,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_AttributeGet, ESMF_AttributeSet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_METHOD_INITIALIZE use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_CompAttributeGet - use med_internalstate_mod, only : mastertask, logunit, diagunit + use med_internalstate_mod, only : maintask, logunit, diagunit #ifdef CESMCOUPLED use nuopc_shr_methods, only : set_component_logging use shr_log_mod, only : shr_log_unit @@ -576,11 +576,11 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=localPet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - mastertask = .false. - if (localPet == 0) mastertask=.true. + maintask = .false. + if (localPet == 0) maintask=.true. ! Determine mediator logunit - if (mastertask) then + if (maintask) then call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (.not. isPresent .and. .not. isSet) then @@ -592,7 +592,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) logfile = 'mediator.log' end if #ifdef CESMCOUPLED - call set_component_logging(gcomp, mastertask, logunit, shr_log_unit, rc) + call set_component_logging(gcomp, maintask, logunit, shr_log_unit, rc) #else open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) #endif @@ -613,7 +613,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) call ESMF_AttributeGet(gcomp, name="Verbosity", value=cvalue, defaultValue="max", & convention="NUOPC", purpose="Instance", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a)')trim(subname)//": Mediator verbosity is set to "//trim(cvalue) end if @@ -621,7 +621,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name="Profiling", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//": Mediator profiling is set to "//trim(cvalue) end if end if @@ -770,7 +770,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) cvalue = 'cesm' end if aoflux_code = trim(cvalue) - if (mastertask) then + if (maintask) then write(logunit,*) '========================================================' write(logunit,'(a)')trim(subname)//' Mediator aoflux scheme is '//trim(aoflux_code) write(logunit,*) '========================================================' @@ -785,7 +785,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) call ESMF_Finalize(endflag=ESMF_END_ABORT) end if aoflux_ccpp_suite = trim(cvalue) - if (mastertask) then + if (maintask) then write(logunit,*) '========================================================' write(logunit,'(a)')trim(subname)//' Mediator aoflux CCPP suite is '//trim(aoflux_ccpp_suite) write(logunit,*) '========================================================' @@ -799,7 +799,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name='coupling_mode', value=coupling_mode, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite('coupling_mode = '// trim(coupling_mode), ESMF_LOGMSG_INFO) - if (mastertask) then + if (maintask) then write(logunit,*) '========================================================' write(logunit,'(a)')trim(subname)//' Mediator Coupling Mode is '//trim(coupling_mode) write(logunit,*) '========================================================' @@ -871,12 +871,12 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) do ncomp = 1,ncomps if (ncomp /= compmed) then - if (mastertask) write(logunit,*) + if (maintask) write(logunit,*) fldListFr => med_fldList_GetFldListFr(ncomp) fld => fldListFr%fields do while(associated(fld)) call med_fld_GetFldInfo(fld, stdname=stdname, shortname=shortname) - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//':Fr_'//trim(compname(ncomp))//': '//trim(shortname) end if if (trim(shortname) == is_local%wrap%flds_scalar_name) then @@ -896,7 +896,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) fld => fldListTo%fields do while(associated(fld)) call med_fld_GetFldInfo(fld, stdname=stdname, shortname=shortname, rc=rc) - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//':To_'//trim(compname(ncomp))//': '//trim(shortname) end if if (trim(shortname) == is_local%wrap%flds_scalar_name) then @@ -1634,7 +1634,7 @@ subroutine DataInitialize(gcomp, rc) ! Create field bundles FBImp, FBExp !---------------------------------------------------------- - if (mastertask) then + if (maintask) then write(logunit,'(a)') 'Creating mediator field bundles ' end if @@ -1643,7 +1643,7 @@ subroutine DataInitialize(gcomp, rc) ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc) .and. & ESMF_StateIsCreated(is_local%wrap%NStateExp(n1),rc=rc)) then - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' initializing FBs for '//trim(compname(n1)) end if @@ -1662,7 +1662,7 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldCount == 0) then - if (mastertask) then + if (maintask) then write(logunit,*) trim(subname)//' '//trim(compname(n1))//' import FB field count is = ', fieldCount write(logunit,*) trim(subname)//' '//trim(compname(n1))//' trying to use export FB' call ESMF_FieldBundleGet(is_local%wrap%FBExp(n1), fieldCount=fieldCount, rc=rc) @@ -1685,7 +1685,7 @@ subroutine DataInitialize(gcomp, rc) ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc) .and. & ESMF_StateIsCreated(is_local%wrap%NStateImp(n2),rc=rc)) then - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' initializing FBs for '//& trim(compname(n1))//'_'//trim(compname(n2)) end if @@ -1733,13 +1733,13 @@ subroutine DataInitialize(gcomp, rc) 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) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + 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) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' initializing FB FBMed_ocnalb_o' end if deallocate(fldnames) @@ -1787,7 +1787,7 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (mastertask) then + if (maintask) then call med_fldList_Document_Mapping(logunit, is_local%wrap%med_coupling_active) call med_fldList_Document_Merging(logunit, is_local%wrap%med_coupling_active) end if @@ -1973,7 +1973,7 @@ subroutine DataInitialize(gcomp, rc) ! then dependency is not satisified - must return to atm call ESMF_LogWrite("MED - Initialize-Data-Dependency from ATM NOT YET SATISFIED!!!", & ESMF_LOGMSG_INFO) - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//"MED - Initialize-Data-Dependency from ATM NOT YET SATISFIED!!!" end if compDone(compatm) = .false. @@ -2032,7 +2032,7 @@ subroutine DataInitialize(gcomp, rc) if (.not. atCorrectTime) then allDone=.false. if (dbug_flag > 0) then - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//" MED - Initialize-Data-Dependency check not yet satisfied for "//& trim(compname(n1)) end if @@ -2055,12 +2055,12 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- if (allDone) then - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a)') trim(subname)//"Initialize-Data-Dependency allDone check Passed" end if do n1 = 1,ncomps - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a)') trim(subname)//" "//trim(compname(n1)) end if @@ -2080,13 +2080,13 @@ subroutine DataInitialize(gcomp, rc) is_local%wrap%nx(n1) = nint(real_nx) is_local%wrap%ny(n1) = nint(real_ny) write(msgString,'(2i8,2l4)') is_local%wrap%nx(n1), is_local%wrap%ny(n1) - if (mastertask) then + if (maintask) then write(logunit,'(a)') 'global nx,ny sizes for '//trim(compname(n1))//":"//trim(msgString) end if call ESMF_LogWrite(trim(subname)//":"//trim(compname(n1))//":"//trim(msgString), ESMF_LOGMSG_INFO) end if end do - if (mastertask) write(logunit,*) + if (maintask) write(logunit,*) !--------------------------------------- ! Initialize mediator IO @@ -2107,7 +2107,7 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- call NUOPC_CompAttributeGet(gcomp, name="read_restart", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a)') trim(subname)//' read_restart = '//trim(cvalue) end if @@ -2497,8 +2497,8 @@ subroutine med_finalize(gcomp, rc) integer, intent(out) :: rc rc = ESMF_SUCCESS - call memcheck("med_finalize", 0, mastertask) - if (mastertask) then + call memcheck("med_finalize", 0, maintask) + if (maintask) then write(logunit,*)' SUCCESSFUL TERMINATION OF CMEPS' call med_phases_profile_finalize() end if diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 6cf30a8df..802334f6f 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -27,7 +27,7 @@ module med_diag_mod use med_constants_mod , only : shr_const_rearth, shr_const_pi, shr_const_latice, shr_const_latvap use med_constants_mod , only : shr_const_ice_ref_sal, shr_const_ocn_ref_sal, shr_const_isspval use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use med_internalstate_mod , only : InternalState, logunit, mastertask, diagunit + use med_internalstate_mod , only : InternalState, logunit, maintask, diagunit use med_methods_mod , only : fldbun_getdata2d => med_methods_FB_getdata2d use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d use med_methods_mod , only : fldbun_fldChk => med_methods_FB_FldChk @@ -50,7 +50,7 @@ module med_diag_mod public :: med_phases_diag_ice_ice2med public :: med_phases_diag_ice_med2ice - private :: med_diag_sum_master + private :: med_diag_sum_main private :: med_diag_print_atm private :: med_diag_print_lnd_ice_ocn private :: med_diag_print_summary @@ -231,7 +231,7 @@ module med_diag_mod ! public data members ! --------------------------------- - ! note: call med_diag_sum_master then save budget_global and budget_counter on restart from/to root pe --- + ! note: call med_diag_sum_main then save budget_global and budget_counter on restart from/to root pe --- real(r8), allocatable :: budget_local (:,:,:) ! local sum, valid on all pes real(r8), allocatable :: budget_global (:,:,:) ! global sum, valid only on root pe @@ -270,7 +270,7 @@ subroutine med_diag_init(gcomp, rc) rc = ESMF_SUCCESS - if(mastertask) then + if(maintask) then write(logunit,'(a)') ' Creating budget_diags%comps ' end if @@ -281,7 +281,7 @@ subroutine med_diag_init(gcomp, rc) else budget_table_version = 'v1' end if - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname) //' budget table version is '//trim(budget_table_version) end if @@ -589,7 +589,7 @@ subroutine med_phases_diag_accum(gcomp, rc) end subroutine med_phases_diag_accum !=============================================================================== - subroutine med_diag_sum_master(gcomp, rc) + subroutine med_diag_sum_main(gcomp, rc) ! ------------------------------------------------------------------ ! Sum local values to global on root @@ -605,7 +605,7 @@ subroutine med_diag_sum_master(gcomp, rc) integer :: c_size ! number of component send/recvs integer :: f_size ! number of fields integer :: p_size ! number of period types - character(*), parameter :: subName = '(med_diag_sum_master) ' + character(*), parameter :: subName = '(med_diag_sum_main) ' ! ------------------------------------------------------------------ call t_startf('MED:'//subname) @@ -629,7 +629,7 @@ subroutine med_diag_sum_master(gcomp, rc) call t_stopf('MED:'//subname) - end subroutine med_diag_sum_master + end subroutine med_diag_sum_main !=============================================================================== subroutine med_phases_diag_atm(gcomp, rc) @@ -2055,7 +2055,7 @@ subroutine med_phases_diag_print(gcomp, rc) date = year*10000 + mon*100 + day #ifdef DEBUG - if(mastertask) then + if(maintask) then write(timestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') year,'-',mon,'-',day,'-',tod write(logunit,' (a)') trim(subname)//": time = "//trim(timestr) endif @@ -2103,13 +2103,13 @@ subroutine med_phases_diag_print(gcomp, rc) if (.not. sumdone) then ! Some budgets will be printed for this period type ! Determine sums if not already done - call med_diag_sum_master(gcomp, rc) + call med_diag_sum_main(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return sumdone = .true. end if - if (mastertask) then + if (maintask) then c_size = size(budget_diags%comps) f_size = size(budget_diags%fields) p_size = size(budget_diags%periods) @@ -2124,7 +2124,7 @@ subroutine med_phases_diag_print(gcomp, rc) end if datagpr(:,:,:) = datagpr(:,:,:)/budget_counter(:,:,:) - ! Write diagnostic tables to logunit (mastertask only) + ! Write diagnostic tables to logunit (maintask only) if (output_level >= 3) then ! detail atm budgets and breakdown into components --- call med_diag_print_atm(datagpr, ip, date, tod) @@ -2141,8 +2141,8 @@ subroutine med_phases_diag_print(gcomp, rc) deallocate(datagpr) - endif ! output_level > 0 and mastertask - end if ! if mastertask + endif ! output_level > 0 and maintask + end if ! if maintask enddo ! ip = 1, period_types !------------------------------------------------------------------------------- @@ -2760,7 +2760,7 @@ subroutine add_to_budget_diag(entries, index, name) ! create new entry if fldname is not in original list if (.not. found) then - if(mastertask) write(logunit,*) ' Add ',trim(name),' to budgets with index ',index + if(maintask) write(logunit,*) ' Add ',trim(name),' to budgets with index ',index ! 1) allocate newfld to be size (one element larger than input flds) allocate(new_entries(index)) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 52866ca4d..c5497293f 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -18,8 +18,8 @@ module med_internalstate_mod public :: med_internalstate_defaultmasks integer, public :: logunit ! logunit for mediator log output - integer, public :: diagunit ! diagunit for budget output (med master only) - logical, public :: mastertask=.false. ! is this the mastertask + integer, public :: diagunit ! diagunit for budget output (med main only) + logical, public :: maintask=.false. ! is this the maintask integer, public :: med_id ! needed currently in med_io_mod and set in esm.F90 ! Components @@ -239,7 +239,7 @@ subroutine med_internalstate_init(gcomp, rc) end do num_icesheets = num_icesheets + 1 endif - if (mastertask) then + if (maintask) then write(logunit,'(a,i8)') trim(subname)//' number of ice sheets is ',num_icesheets end if end if @@ -333,7 +333,7 @@ subroutine med_internalstate_init(gcomp, rc) compname(compglc(ns)) = 'glc' // trim(cnum) end do - if (mastertask) then + if (maintask) then ! Write out present flags write(logunit,*) do n1 = 1,ncomps @@ -404,7 +404,7 @@ subroutine med_internalstate_coupling(gcomp, rc) ! starts, but any coupling set to false will never be allowed. ! are allowed, just update the table below. - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname) // "Initializing active coupling flags" end if @@ -491,7 +491,7 @@ subroutine med_internalstate_coupling(gcomp, rc) ! - the columns are the source of coupling ! - So, the second column indicates which models the atm is coupled to. ! - And the second row indicates which models are coupled to the atm. - if (mastertask) then + if (maintask) then write(logunit,*) ' ' write(logunit,'(A)') trim(subname)//' Allowed coupling flags' write(logunit,'(2x,A10,20(A5))') '|from to -> ',(compname(n2),n2=1,ncomps) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 2dcb39069..1e1808357 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -5,7 +5,7 @@ module med_map_mod use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_LOGMSG_INFO, ESMF_LogWrite use ESMF , only : ESMF_Field - use med_internalstate_mod , only : InternalState, logunit, mastertask + use med_internalstate_mod , only : InternalState, logunit, maintask 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 @@ -131,7 +131,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun ! -------------------------------------------------------------- ! First loop over source and destination components components - if (mastertask) write(logunit,*) ' ' + if (maintask) write(logunit,*) ' ' do n1 = 1, ncomps do n2 = 1, ncomps if (n1 /= n2) then @@ -194,7 +194,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun ! unity normalization up front ! -------------------------------------------------------------- - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a)') trim(subname)//"Initializing unity map normalizations" endif @@ -212,7 +212,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun call ESMF_FieldBundleGet(is_local%wrap%FBImp(n1,n1), fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldCount == 0) then - if (mastertask) then + if (maintask) then write(logunit,*) trim(subname)//' '//trim(compname(n1))//' import FB field count is = ', fieldCount write(logunit,*) trim(subname)//' '//trim(compname(n1))//' trying to use export FB' end if @@ -257,7 +257,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun call med_map_field(field_src=field_src, field_dst=is_local%wrap%field_NormOne(n1,n2,mapindex), & routehandles=is_local%wrap%RH(n1,n2,:), maptype=mapindex, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' created field_NormOne for '& //compname(n1)//'->'//compname(n2)//' with mapping '//trim(mapnames(mapindex)) end if @@ -431,14 +431,14 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, ! Create route handle if (mapindex == mapfcopy) then - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH redist for '//trim(string) end if call ESMF_FieldRedistStore(fldsrc, flddst, routehandle=routehandles(mapfcopy), & ignoreUnmatchedIndices = .true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else if (lmapfile /= 'unset') then - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//& ' via input file '//trim(mapfile)//' for '//trim(string) end if @@ -448,7 +448,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, if (chkerr(rc,__LINE__,u_FILE_u)) return else if (mapindex == mapbilnr .or. mapindex == mapbilnr_uv3d) then if (.not. ESMF_RouteHandleIsCreated(routehandles(mapbilnr))) then - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapbilnr), & @@ -464,7 +464,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, ldstprint = .true. end if else if (mapindex == mapfillv_bilnr) then - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapfillv_bilnr), & @@ -479,7 +479,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, if (chkerr(rc,__LINE__,u_FILE_u)) return ldstprint = .true. else if (mapindex == mapbilnr_nstod) then - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapbilnr_nstod), & @@ -495,7 +495,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, if (chkerr(rc,__LINE__,u_FILE_u)) return ldstprint = .true. else if (mapindex == mapconsf .or. mapindex == mapnstod_consf) then - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsf), & @@ -512,7 +512,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, ldstprint = .true. else if (mapindex == mapconsf_aofrac) then if (.not. ESMF_RouteHandleIsCreated(routehandles(mapconsf))) then - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsf_aofrac), & @@ -529,14 +529,14 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, ldstprint = .true. else ! Copy existing consf RH - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' copying RH(mapconsf) to '//trim(mapname)//' for '//trim(string) end if routehandles(mapconsf_aofrac) = ESMF_RouteHandleCreate(routehandles(mapconsf), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if else if (mapindex == mapconsd .or. mapindex == mapnstod_consd) then - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsd), & @@ -553,7 +553,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, ldstprint = .true. else if (mapindex == mappatch .or. mapindex == mappatch_uv3d) then if (.not. ESMF_RouteHandleIsCreated(routehandles(mappatch))) then - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mappatch), & @@ -569,7 +569,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, ldstprint = .true. end if else - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' mapindex '//trim(mapname)//' not supported for '//trim(string) end if call ESMF_LogWrite(trim(subname)//' mapindex '//trim(mapname)//' not supported ', & @@ -629,7 +629,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, ! Output route handle to file if requested if (rhprint) then - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//trim(string)//": printing RH for "//trim(mapname) end if call ESMF_RouteHandlePrint(routehandles(mapindex), rc=rc) @@ -791,7 +791,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & ! ungridded dimensions and need to unwrap them into separate fields for the ! purposes of packing - if (mastertask) write(logunit,*) + if (maintask) write(logunit,*) ! Determine the normalization type for each packed_data mapping element ! Loop over mapping types @@ -873,7 +873,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & packed_data(mapindex)%fldindex(nf) = npacked(mapindex) end if - if (mastertask) then + if (maintask) then write(logunit,'(5(a,2x),2x,i4)') trim(subname)//& 'Packed field: destcomp,mapping,mapnorm,fldname,index: ', & trim(compname(destcomp)), & diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index bf2061de3..0b3d10901 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -26,7 +26,7 @@ module med_phases_aofluxes_mod use ESMF , only : ESMF_Finalize, ESMF_LogFoundError use ESMF , only : ESMF_XGridGet, ESMF_MeshCreate, ESMF_MeshWrite, ESMF_KIND_R8 use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit use med_internalstate_mod , only : compatm, compocn, coupling_mode, aoflux_code, mapconsd, mapconsf, mapfcopy use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : memcheck => med_memcheck @@ -198,7 +198,7 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) 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) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a)') trim(subname)//' initialized FB FBMed_aoflux_a' end if @@ -207,7 +207,7 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) 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) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' initialized FB FBMed_aoflux_o' write(logunit,'(a)') trim(subname)//' following are the fields in FBMed_aoflux_o and FBMed_aoflux_a' do n = 1,fieldcount @@ -220,7 +220,7 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) ! Create the field bundle is_local%wrap%FBImp(compatm,compocn) if needed if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compatm,compocn), rc=rc)) then - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' creating field bundle FBImp(compatm,compocn)' end if call FB_init(is_local%wrap%FBImp(compatm,compocn), is_local%wrap%flds_scalar_name, & @@ -228,14 +228,14 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) name='FBImp'//trim(compname(compatm))//'_'//trim(compname(compocn)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' initializing FB for '// & trim(compname(compatm))//'_'//trim(compname(compocn)) end if ! Create the field bundle is_local%wrap%FBImp(compocn,compatm) if needed if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compatm), rc=rc)) then - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' creating field bundle FBImp(compocn,compatm)' end if call FB_init(is_local%wrap%FBImp(compocn,compatm), is_local%wrap%flds_scalar_name, & @@ -243,7 +243,7 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compatm)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' initializing FB for '// & trim(compname(compocn))//'_'//trim(compname(compatm)) end if @@ -309,7 +309,7 @@ subroutine med_phases_aofluxes_run(gcomp, rc) if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif - call memcheck(subname, 5, mastertask) + call memcheck(subname, 5, maintask) ! Calculate atm/ocn fluxes on the destination grid call med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) @@ -368,7 +368,7 @@ subroutine med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc) call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS - call memcheck(subname, 5, mastertask) + call memcheck(subname, 5, maintask) call t_startf('MED:'//subname) @@ -396,7 +396,7 @@ subroutine med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc) ocn_surface_flux_scheme = 0 end if #ifdef CESMCOUPLED - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a)') trim(subname)//' ocn_surface_flux_scheme is '//trim(cvalue) end if @@ -1059,7 +1059,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) #else #ifdef UFS_AOFLUX if (trim(aoflux_code) == 'ccpp') then - call flux_atmocn_ccpp(gcomp=gcomp, mastertask=mastertask, logunit=logunit, & + call flux_atmocn_ccpp(gcomp=gcomp, maintask=maintask, logunit=logunit, & nMax=aoflux_in%lsize, psfc=aoflux_in%psfc, & pbot=aoflux_in%pbot, tbot=aoflux_in%tbot, qbot=aoflux_in%shum, lwdn=aoflux_in%lwdn, & zbot=aoflux_in%zbot, garea=aoflux_in%garea, ubot=aoflux_in%ubot, usfc=aoflux_in%usfc, vbot=aoflux_in%vbot, & diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 363118c8d..2f7c9f062 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -20,7 +20,7 @@ module med_phases_history_mod use NUOPC_Model , only : NUOPC_ModelGet use med_utils_mod , only : chkerr => med_utils_ChkErr use med_internalstate_mod , only : ncomps, compname - use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit use med_time_mod , only : med_time_alarmInit use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf @@ -230,7 +230,7 @@ subroutine med_phases_history_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write diagnostic info - if (mastertask) then + if (maintask) then write(logunit,'(a,2x,i8)') trim(subname) // " initialized history alarm "//& trim(alarmname)//" with option "//trim(hist_option_all_inst)//" and frequency ",hist_n_all_inst end if @@ -253,7 +253,7 @@ subroutine med_phases_history_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write diagnostic info if appropriate - if (mastertask .and. debug_alarms) then + if (maintask .and. debug_alarms) then call ESMF_AlarmGet(alarm, ringInterval=ringInterval, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeIntervalGet(ringInterval, s=ringinterval_length, rc=rc) @@ -271,7 +271,7 @@ subroutine med_phases_history_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a,i8)') trim(subname)//" : history alarmname "//trim(alarmname)//& ' is ringing, interval length is ', ringInterval_length @@ -1142,7 +1142,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) end if ! end of if auxflds is set to 'all' - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a,i4,a)') trim(subname) // ' Writing the following fields to auxfile ',nfcnt,& ' for component '//trim(compname(compid)) @@ -1356,7 +1356,7 @@ subroutine get_auxflds(str, flds, rc) valid = .false. end if if (.not. valid) then - if (mastertask) write(logunit,*) "ERROR: invalid list = ",trim(str) + if (maintask) write(logunit,*) "ERROR: invalid list = ",trim(str) call ESMF_LogWrite("ERROR: invalid list = "//trim(str), ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return @@ -1565,7 +1565,7 @@ subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hi call ESMF_TimeIntervalGet(dtimestep, s=dsec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a,2x,i8,2x,i8)') trim(subname) // " mediator, driver timesteps for " & //trim(alarmname),msec,dsec end if @@ -1580,7 +1580,7 @@ subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hi reftime=StartTime, alarmname=trim(alarmname), advance_clock=.true., rc=rc) ! Write diagnostic info - if (mastertask) then + if (maintask) then write(logunit,'(a,2x,i8)') trim(subname) // " initialized history alarm "//& trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n end if @@ -1634,7 +1634,7 @@ subroutine med_phases_history_query_ifwrite(gcomp, hclock, alarmname, write_now, ! Write diagnostic output if (write_now) then - if (mastertask .and. debug_alarms) then + if (maintask .and. debug_alarms) then ! output alarm info call ESMF_AlarmGet(alarm, ringInterval=ringInterval, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1652,7 +1652,7 @@ subroutine med_phases_history_query_ifwrite(gcomp, hclock, alarmname, write_now, if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a,i8)') trim(subname)//" : history alarmname "//trim(alarmname)//& ' is ringing, interval length is ', ringInterval_length @@ -1674,7 +1674,7 @@ subroutine med_phases_history_query_ifwrite(gcomp, hclock, alarmname, write_now, if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//" : mclock currtime = "//trim(currtimestr)//& " mclock nexttime = "//trim(nexttimestr) end if @@ -1800,7 +1800,7 @@ subroutine med_phases_history_set_timeinfo(gcomp, hclock, alarmname, & write(histfile, "(6a)") trim(case_name),'.cpl',trim(inst_tag),trim(hist_str),trim(nexttime_str),'.nc' end if - if (mastertask) then + if (maintask) then call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(currtime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index ecaf9956f..a5ef002c7 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -262,7 +262,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) #else - ! Determine master task + ! Determine main task call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=iam, rc=rc) @@ -442,7 +442,7 @@ end subroutine med_phases_ocnalb_run !=============================================================================== #ifdef CESMCOUPLED - subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, mastertask, rc) + subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, maintask, rc) !---------------------------------------------------------- ! Obtain orbital related values @@ -456,7 +456,7 @@ subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, mastertask, rc) ! input/output variables type(ESMF_GridComp) :: gcomp integer , intent(in) :: logunit ! output logunit - logical , intent(in) :: mastertask + logical , intent(in) :: maintask integer , intent(out) :: rc ! output error ! local variables @@ -541,7 +541,7 @@ end subroutine med_phases_ocnalb_orbital_init !=============================================================================== - subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, obliqr, lambm0, mvelpp, rc) + subroutine med_phases_ocnalb_orbital_update(clock, logunit, maintask, eccen, obliqr, lambm0, mvelpp, rc) !---------------------------------------------------------- ! Update orbital settings @@ -553,7 +553,7 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, ! input/output variables type(ESMF_Clock) , intent(in) :: clock integer , intent(in) :: logunit - logical , intent(in) :: mastertask + logical , intent(in) :: maintask real(R8) , intent(inout) :: eccen ! orbital eccentricity real(R8) , intent(inout) :: obliqr ! Earths obliquity in rad real(R8) , intent(inout) :: lambm0 ! Mean long of perihelion at vernal equinox (radians) @@ -578,11 +578,11 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, call ESMF_TimeGet(CurrTime, yy=year, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return orb_year = orb_iyear + (year - orb_iyear_align) - lprint = mastertask + lprint = maintask else orb_year = orb_iyear if (first_time) then - lprint = mastertask + lprint = maintask first_time = .false. else lprint = .false. diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index c61097f9f..ac32ae8b8 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -16,7 +16,7 @@ module med_phases_post_glc_mod use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated use med_internalstate_mod , only : compatm, compice, complnd, comprof, compocn, compname, compglc use med_internalstate_mod , only : mapbilnr, mapconsd, compname - use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_methods_mod , only : fldbun_fldchk => med_methods_FB_fldchk use med_methods_mod , only : fldbun_getmesh => med_methods_FB_getmesh @@ -132,7 +132,7 @@ subroutine med_phases_post_glc(gcomp, rc) exit end if end do - if (mastertask) then + if (maintask) then write(logunit,'(a,L1)') trim(subname) // 'glc2lnd_coupling is ',glc2lnd_coupling write(logunit,'(a,L1)') trim(subname) // 'glc2ocn_coupling is ',glc2ocn_coupling write(logunit,'(a,L1)') trim(subname) // 'glc2ice_coupling is ',glc2ice_coupling @@ -145,7 +145,7 @@ subroutine med_phases_post_glc(gcomp, rc) call NUOPC_CompAttributeGet(gcomp, name="cism_evolve", value=cvalue, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read (cvalue,*) cism_evolve - if (mastertask) then + if (maintask) then write(logunit,'(a,l7)') trim(subname)//' cism_evolve = ',cism_evolve end if end if diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 47ef5928b..9bb2b059f 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -16,7 +16,7 @@ module med_phases_prep_atm_mod use med_methods_mod , only : FB_getfldptr=> med_methods_FB_GetFldPtr use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed - use med_internalstate_mod , only : InternalState, mastertask + use med_internalstate_mod , only : InternalState, maintask use med_internalstate_mod , only : compatm, compocn, compice, compname, coupling_mode use esmFlds , only : med_fldlist_GetfldListTo, med_fldlist_type use perf_mod , only : t_startf, t_stopf @@ -62,7 +62,7 @@ subroutine med_phases_prep_atm(gcomp, rc) if (dbug_flag > 5) then call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) end if - call memcheck(subname, 3, mastertask) + call memcheck(subname, 3, maintask) !--------------------------------------- ! --- Get the internal state diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index a15eacc82..311d91c8a 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -22,7 +22,7 @@ module med_phases_prep_glc_mod use ESMF , only : ESMF_DYNAMICMASK, ESMF_DynamicMaskSetR8R8R8, ESMF_DYNAMICMASKELEMENTR8R8R8 use ESMF , only : ESMF_FieldRegrid use med_internalstate_mod , only : complnd, compocn, mapbilnr, mapconsd, compname, compglc - use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit use med_map_mod , only : med_map_routehandles_init, med_map_rh_is_created use med_map_mod , only : med_map_field_normalized, med_map_field use med_constants_mod , only : dbug_flag => med_constants_dbug_flag @@ -258,7 +258,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) rc = ESMF_FAILURE return end select - if (mastertask) then + if (maintask) then write(logunit,'(a,l4)') trim(subname)//' smb_renormalize is ',smb_renormalize end if @@ -546,7 +546,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) if (trim(glc_avg_period) == 'yearly') then call med_time_alarmInit(prepglc_clock, glc_avg_alarm, 'yearly', alarmname='alarm_glc_avg', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a,i10)') trim(subname)//& ' created alarm with averaging period for export to glc is yearly' end if @@ -556,7 +556,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) read(cvalue,*) glc_cpl_dt call med_time_alarmInit(prepglc_clock, glc_avg_alarm, 'nseconds', opt_n=glc_cpl_dt, alarmname='alarm_glc_avg', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a,i10)') trim(subname)//& ' created alarm with averaging period for export to glc (in seconds) ',glc_cpl_dt end if @@ -576,7 +576,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) ! Check time if (dbug_flag > 5) then - if (mastertask) then + if (maintask) then call NUOPC_ModelGet(gcomp, modelClock=med_clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet(med_clock, currtime=med_currtime, rc=rc) @@ -586,7 +586,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) call ESMF_ClockGet(prepglc_clock, currtime=prepglc_currtime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(prepglc_currtime,yy=yr_prepglc, mm=mon_prepglc, dd=day_prepglc, s=sec_prepglc, rc=rc) - if (mastertask) then + if (maintask) then write(logunit,'(a,4(i8,2x))') trim(subname)//'med clock yr, mon, day, sec = ',& yr_med,mon_med,day_med,sec_med write(logunit,'(a,4(i8,2x))') trim(subname)//'prep glc clock yr, mon, day, sec = ',& @@ -602,7 +602,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) do_avg = .true. call ESMF_LogWrite(trim(subname)//": glc_avg alarm is ringing - average input from lnd and ocn to glc", & ESMF_LOGMSG_INFO) - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//"glc_avg alarm is ringing - averaging input from lnd and ocn to glc" end if ! Turn off the alarm @@ -1154,7 +1154,7 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) call ESMF_VMAllreduce(vm, senddata=local_ablat_lnd, recvdata=global_ablat_lnd, count=1, & reduceflag=ESMF_REDUCE_SUM, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a,d21.10)') trim(subname)//'global_accum_lnd = ', global_accum_lnd write(logunit,'(a,d21.10)') trim(subname)//'global_ablat_lnd = ', global_ablat_lnd endif @@ -1184,7 +1184,7 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) reduceflag=ESMF_REDUCE_SUM, rc=rc) call ESMF_VMAllreduce(vm, senddata=local_ablat_glc, recvdata=global_ablat_glc, count=1, & reduceflag=ESMF_REDUCE_SUM, rc=rc) - if (mastertask) then + if (maintask) then write(logunit,'(a,d21.10)') trim(subname)//'global_accum_glc = ', global_accum_glc write(logunit,'(a,d21.10)') trim(subname)//'global_ablat_glc = ', global_ablat_glc endif @@ -1200,7 +1200,7 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) else ablat_renorm_factor = 0.0_r8 endif - if (mastertask) then + if (maintask) then write(logunit,'(a,d21.10)') trim(subname)//'accum_renorm_factor = ', accum_renorm_factor write(logunit,'(a,d21.10)') trim(subname)//'ablat_renorm_factor = ', ablat_renorm_factor endif diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 0b1b40756..428f3afef 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -36,7 +36,7 @@ subroutine med_phases_prep_ice(gcomp, rc) use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_merge_mod , only : med_merge_auto - use med_internalstate_mod , only : InternalState, logunit, mastertask + use med_internalstate_mod , only : InternalState, logunit, maintask use med_internalstate_mod , only : compatm, compice, compocn use med_internalstate_mod , only : coupling_mode use esmFlds , only : med_fldList_GetFldListTo @@ -93,7 +93,7 @@ subroutine med_phases_prep_ice(gcomp, rc) ! is initialized to 0. ! In addition, in med.F90, if this attribute is not present as a mediator component attribute, ! it is set to 0. - if (mastertask) then + if (maintask) then call ESMF_StateGet(is_local%wrap%NstateImp(compocn), & itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -130,7 +130,7 @@ subroutine med_phases_prep_ice(gcomp, rc) ! obtain nextsw_cday from atm if it is in the import state and send it to ice scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday - if (scalar_id > 0 .and. mastertask) then + if (scalar_id > 0 .and. maintask) then call ESMF_StateGet(is_local%wrap%NstateImp(compatm), & itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 64bced198..0c0bad212 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -32,7 +32,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : complnd, compatm - use med_internalstate_mod , only : InternalState, mastertask + use med_internalstate_mod , only : InternalState, maintask use med_merge_mod , only : med_merge_auto use perf_mod , only : t_startf, t_stopf @@ -101,7 +101,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) ! obtain nextsw_cday from atm if it is in the import state and send it to lnd scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday - if (scalar_id > 0 .and. field_found .and. mastertask) then + if (scalar_id > 0 .and. field_found .and. maintask) then call ESMF_StateGet(is_local%wrap%NstateImp(compatm), & itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 981bc1742..58c9ebc8b 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -7,7 +7,7 @@ module med_phases_prep_ocn_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_constants_mod , only : czero =>med_constants_czero use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit use med_merge_mod , only : med_merge_auto, med_merge_field use med_map_mod , only : med_map_field_packed use med_utils_mod , only : memcheck => med_memcheck @@ -61,7 +61,7 @@ subroutine med_phases_prep_ocn_init(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' initializing ocean export accumulation FB for ' end if call FB_init(is_local%wrap%FBExpAccumOcn, is_local%wrap%flds_scalar_name, & @@ -108,7 +108,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) end if rc = ESMF_SUCCESS - call memcheck(subname, 5, mastertask) + call memcheck(subname, 5, maintask) ! Get the internal state nullify(is_local%wrap) @@ -376,7 +376,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) if (dbug_flag > 20) then call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) end if - call memcheck(subname, 5, mastertask) + call memcheck(subname, 5, maintask) ! Get the internal state nullify(is_local%wrap) @@ -565,7 +565,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) ! is initialized to 0. ! In addition, in med.F90, if this attribute is not present as a mediator component attribute, ! it is set to 0. - if (mastertask) then + if (maintask) then call ESMF_StateGet(is_local%wrap%NstateImp(compocn), & itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -638,7 +638,7 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) if (dbug_flag > 20) then call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) end if - call memcheck(subname, 5, mastertask) + call memcheck(subname, 5, maintask) ! Get the internal state nullify(is_local%wrap) diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index ef977524b..5d603a141 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -13,7 +13,7 @@ module med_phases_prep_rof_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use ESMF , only : ESMF_FieldBundle, ESMF_Field use med_internalstate_mod , only : complnd, comprof, mapconsf, mapconsd, mapfcopy - use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_constants_mod , only : czero => med_constants_czero use med_utils_mod , only : chkerr => med_utils_chkerr @@ -306,7 +306,7 @@ subroutine med_phases_prep_rof(gcomp, rc) count = lndAccum2rof_cnt if (count == 0) then - if (mastertask) then + if (maintask) then write(logunit,'(a)')trim(subname)//'accumulation count for land input averging to river is 0 '// & ' accumulation field is set to zero' end if diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 8f0e9dcf2..5fcb9ba7e 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -7,7 +7,7 @@ module med_phases_prep_wav_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_constants_mod , only : czero =>med_constants_czero use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit use med_merge_mod , only : med_merge_auto, med_merge_field use med_map_mod , only : med_map_field_packed use med_utils_mod , only : memcheck => med_memcheck @@ -56,7 +56,7 @@ subroutine med_phases_prep_wav_init(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' initializing wave export accumulation FB for ' end if call FB_Init(is_local%wrap%FBExpAccumWav, is_local%wrap%flds_scalar_name, & @@ -89,7 +89,7 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) end if rc = ESMF_SUCCESS - call memcheck(subname, 5, mastertask) + call memcheck(subname, 5, maintask) ! Get the internal state nullify(is_local%wrap) diff --git a/mediator/med_phases_profile_mod.F90 b/mediator/med_phases_profile_mod.F90 index 7e9fb3c47..dadfb989c 100644 --- a/mediator/med_phases_profile_mod.F90 +++ b/mediator/med_phases_profile_mod.F90 @@ -7,7 +7,7 @@ module med_phases_profile_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag use med_utils_mod , only : med_utils_chkerr, med_memcheck - use med_internalstate_mod , only : mastertask, logunit + use med_internalstate_mod , only : maintask, logunit use med_utils_mod , only : chkerr => med_utils_ChkErr use med_time_mod , only : alarmInit => med_time_alarmInit use perf_mod , only : t_startf, t_stopf @@ -144,7 +144,7 @@ subroutine med_phases_profile(gcomp, rc) endif endif - if ((stopalarmison .or. alarmIsOn .or. iterations==1) .and. mastertask) then + if ((stopalarmison .or. alarmIsOn .or. iterations==1) .and. maintask) then ! We need to get the next time for display call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) if (med_utils_ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 0331e1cb7..6bf5f3466 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -7,7 +7,7 @@ module med_phases_restart_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 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 : mastertask, logunit, InternalState + use med_internalstate_mod , only : maintask, logunit, InternalState use med_internalstate_mod , only : ncomps, compname, compocn, complnd, compwav use perf_mod , only : t_startf, t_stopf use med_phases_prep_glc_mod , only : FBlndAccum2glc_l, lndAccum2glc_cnt @@ -106,7 +106,7 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) end if ! Write mediator diagnostic output - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a,2x,i8)') trim(subname)//" restart clock timestep = ",timestep_length write(logunit,'(a,2x,i8)') trim(subname)//" set restart alarm with option "//& @@ -262,7 +262,7 @@ subroutine med_phases_restart_write(gcomp, rc) if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": nexttime = "//trim(nexttimestr), ESMF_LOGMSG_INFO) endif - if (mastertask) then + if (maintask) then call ESMF_ClockPrint(clock, options="currTime", & preString="-------->"//trim(subname)//" mediating for: ", unit=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -298,7 +298,7 @@ subroutine med_phases_restart_write(gcomp, rc) write(restart_file,"(6a)") trim(restart_dir)//trim(case_name),'.cpl', trim(cpl_inst_tag),'.r.',& trim(nexttimestr),'.nc' - if (mastertask) then + if (maintask) then restart_pfile = "rpointer.cpl"//trim(cpl_inst_tag) call ESMF_LogWrite(trim(subname)//" write rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED') @@ -532,14 +532,14 @@ subroutine med_phases_restart_read(gcomp, rc) if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO) endif - if (mastertask) then + if (maintask) then call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//" mediating for: ", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Get the restart file name from the pointer file restart_pfile = "rpointer.cpl"//trim(cpl_inst_tag) - if (mastertask) then + if (maintask) then call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old', iostat=ierr) if (ierr < 0) then diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index 93eb53469..8a05c3671 100644 --- a/mediator/med_time_mod.F90 +++ b/mediator/med_time_mod.F90 @@ -17,7 +17,7 @@ module med_time_mod use ESMF , only : operator(<=), operator(>), operator(==) 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 : mastertask, logunit + use med_internalstate_mod, only : maintask, logunit implicit none private ! default private @@ -254,7 +254,7 @@ subroutine med_time_alarmInit( clock, alarm, option, & enddo endif - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a)') trim(subname) //' creating alarm '// trim(lalarmname) end if diff --git a/mediator/med_utils_mod.F90 b/mediator/med_utils_mod.F90 index 7017180c2..91286d651 100644 --- a/mediator/med_utils_mod.F90 +++ b/mediator/med_utils_mod.F90 @@ -17,14 +17,14 @@ module med_utils_mod contains !=============================================================================== - subroutine med_memcheck(string, level, mastertask) + subroutine med_memcheck(string, level, maintask) character(len=*), intent(in) :: string integer, intent(in) :: level - logical, intent(in) :: mastertask + logical, intent(in) :: maintask #ifdef CESMCOUPLED integer :: ierr integer, external :: GPTLprint_memusage - if((mastertask .and. memdebug_level > level) .or. memdebug_level > level+1) then + if((maintask .and. memdebug_level > level) .or. memdebug_level > level+1) then ierr = GPTLprint_memusage(string) endif #endif diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index 9dafda8eb..84f1652bf 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -25,7 +25,7 @@ module flux_atmocn_ccpp_mod use med_kind_mod, only : CL=>SHR_KIND_CL use med_utils_mod, only : chkerr => med_utils_chkerr use med_internalstate_mod, only : aoflux_ccpp_suite, logunit - use med_internalstate_mod, only : InternalState, mastertask + use med_internalstate_mod, only : InternalState, maintask use med_constants_mod, only : dbug_flag => med_constants_dbug_flag implicit none @@ -52,7 +52,7 @@ module flux_atmocn_ccpp_mod contains !=============================================================================== - subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, & + subroutine flux_atmOcn_ccpp(gcomp, maintask, logunit, nMax, mask, psfc, pbot, & tbot, qbot, zbot, garea, ubot, usfc, vbot, vsfc, rbot, ts, lwdn, sen, lat, & lwup, evp, taux, tauy, tref, qref, duu10n, ustar_sv, re_sv, ssq_sv, missval) @@ -60,7 +60,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, !--- input arguments -------------------------------- type(ESMF_GridComp), intent(in) :: gcomp ! gridded component - logical , intent(in) :: mastertask ! master task + logical , intent(in) :: maintask ! main task integer , intent(in) :: logunit ! log file unit number integer , intent(in) :: nMax ! data vector length integer , intent(in) :: mask (nMax) ! ocn domain mask @@ -301,7 +301,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, if (trim(cvalue) .eq. '.true.' .or. trim(cvalue) .eq. 'true') ini_read = .true. end if - if (mastertask) then + if (maintask) then write(logunit,*) '========================================================' write(logunit,'(a,f5.2)') trim(subname)//' ccpp_phy_semis_water = ', semis_water write(logunit,'(a,l)') trim(subname)//' ccpp_phy_lseaspray = ', physics%model%lseaspray @@ -361,7 +361,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, ! set counter physics%model%kdt = ((currTime-StartTime)/timeStep)+1 - if (mastertask .and. dbug_flag > 5) then + if (maintask .and. dbug_flag > 5) then write(logunit,'(a,i5)') 'kdt = ', physics%model%kdt end if diff --git a/ufs/ufs_io_mod.F90 b/ufs/ufs_io_mod.F90 index ee85fa183..8564be8e5 100644 --- a/ufs/ufs_io_mod.F90 +++ b/ufs/ufs_io_mod.F90 @@ -39,7 +39,7 @@ module ufs_io_mod use med_kind_mod, only : r8=>SHR_KIND_R8, cs=>SHR_KIND_CS, cl=>SHR_KIND_CL use med_utils_mod, only : chkerr => med_utils_chkerr use med_constants_mod, only : dbug_flag => med_constants_dbug_flag - use med_internalstate_mod, only : InternalState, mastertask, logunit + use med_internalstate_mod, only : InternalState, maintask, logunit use med_internalstate_mod, only : compatm, compocn, mapconsf use med_io_mod, only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date use ufs_const_mod, only : shr_const_cday @@ -173,7 +173,7 @@ subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rc) ! return pointer and fill variable call ESMF_FieldGet(field_dst, localDe=0, farrayPtr=ptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit,'(a)') 'Reading: '//trim(flds(n)) + if (maintask) write(logunit,'(a)') 'Reading: '//trim(flds(n)) if (trim(flds(n)) == 'zorl' ) physics%sfcprop%zorl(:) = ptr(:) if (trim(flds(n)) == 'uustar') physics%sfcprop%uustar(:)= ptr(:) nullify(ptr) @@ -246,7 +246,7 @@ subroutine read_restart(gcomp, rst_file, rc) ! Now read in the restart file !---------------------- - if (mastertask) then + if (maintask) then write(logunit,'(a)') 'Reading CCPP restart file: '//trim(rst_file) end if @@ -289,7 +289,7 @@ subroutine read_restart(gcomp, rst_file, rc) call FB_getfldptr(FBin, trim(flds(n)), ptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit,'(a)') 'Reading: '//trim(flds(n)) + if (maintask) write(logunit,'(a)') 'Reading: '//trim(flds(n)) if (trim(flds(n)) == 'zorl' ) physics%sfcprop%zorl(:) = ptr(:) if (trim(flds(n)) == 'uustar') physics%sfcprop%uustar(:)= ptr(:) if (trim(flds(n)) == 'qss' ) physics%sfcprop%qss(:) = ptr(:) @@ -873,7 +873,7 @@ subroutine write_restart(gcomp, restart_freq, rc) call ESMF_FieldBundleWrite(FBout, trim(rst_file), overwrite=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a)') 'CCPP restart file is closed: '//trim(rst_file) end if From 89227998632e131ab30dc0e4725e4b96e42beb7e Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 9 Jan 2023 12:27:59 -0700 Subject: [PATCH 231/395] gptl argument is still mastertask --- cesm/driver/esm.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index 6b094992e..d9e53397c 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -214,7 +214,7 @@ subroutine SetModelServices(driver, rc) !------------------------------------------- ! Timer initialization (has to be after pelayouts are determined) !------------------------------------------- - call t_initf('drv_in', LogPrint=.true., LogUnit=logunit, mpicom=global_comm, maintask=maintask, MaxThreads=maxthreads) + call t_initf('drv_in', LogPrint=.true., LogUnit=logunit, mpicom=global_comm, mastertask=maintask, MaxThreads=maxthreads) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) From 357617f3eea0a0e416bef7a7ada9394cab00df42 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 9 Jan 2023 13:18:38 -0700 Subject: [PATCH 232/395] smooth workflow --- .github/workflows/srt.yml | 87 ++++++++++++++++++++++----------------- 1 file changed, 49 insertions(+), 38 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 45cb76058..0619b0215 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -23,15 +23,11 @@ jobs: CC: mpicc FC: mpifort CXX: mpicxx - CPPFLAGS: "-I/usr/include -I/usr/local/include" + CPPFLAGS: "-I/usr/include -I/usr/local/include -I/usr/lib/x86_64-linux-gnu/netcdf/mpi/include/" + LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf_mpi -lpnetcdf" # Versions of all dependencies can be updated here - PNETCDF_VERSION: checkpoint.1.12.3 - NETCDF_FORTRAN_VERSION: v4.6.0 ESMF_VERSION: v8.4.0 PARALLELIO_VERSION: pio2_5_10 - NETCDF_C_PATH: /usr - NETCDF_FORTRAN_PATH: ${HOME}/netcdf-fortran - PNETCDF_PATH: ${HOME}/pnetcdf CIME_MODEL: cesm CIME_DRIVER: nuopc GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} @@ -39,10 +35,26 @@ jobs: steps: # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it - - id: load-env + - name: Setup Ubuntu Environment + id: load-env run: | - sudo apt-get update - sudo apt-get install libxml2-utils pylint wget gfortran openmpi-bin netcdf-bin libopenmpi-dev cmake libnetcdf-dev autotools-dev autoconf + set -x + sudo apt-get update + sudo apt-get install netcdf-bin + sudo apt-get install libnetcdf-mpi-19 + sudo apt-get install libnetcdf-mpi-dev + sudo apt-get install pnetcdf-bin + sudo apt-get install libpnetcdf-dev + sudo apt-get install doxygen + sudo apt-get install graphviz + sudo apt-get install wget + sudo apt-get install gfortran + sudo apt-get install libjpeg-dev + sudo apt-get install libz-dev + sudo apt-get install openmpi-bin + sudo apt-get install libopenmpi-dev + cd /usr/lib/x86_64-linux-gnu + sudo ln -fs libnetcdf_mpi.so libnetcdf.so - name: Set up Python ${{ matrix.python-version }} uses: actions/setup-python@v4 @@ -76,19 +88,19 @@ jobs: with: path: ~/ESMF key: ${{ runner.os }}-${{ env.ESMF_VERSION }}-ESMF - - name: cache pnetcdf - id: cache-pnetcdf - uses: actions/cache@v3 - with: - path: ~/pnetcdf - key: ${{ runner.os }}-${{ env.PNETCDF_VERSION}}-pnetcdf + # - name: cache pnetcdf + # id: cache-pnetcdf + # uses: actions/cache@v3 + # with: + # path: ~/pnetcdf + # key: ${{ runner.os }}-${{ env.PNETCDF_VERSION}}-pnetcdf - - name: Cache netcdf-fortran - id: cache-netcdf-fortran - uses: actions/cache@v3 - with: - path: ~/netcdf-fortran - key: ${{ runner.os }}-${{ env.NETCDF_FORTRAN_VERSION }}-netcdf-fortran + # - name: Cache netcdf-fortran + # id: cache-netcdf-fortran + # uses: actions/cache@v3 + # with: + # path: ~/netcdf-fortran + # key: ${{ runner.os }}-${{ env.NETCDF_FORTRAN_VERSION }}-netcdf-fortran - name: Cache ParallelIO id: cache-ParallelIO @@ -102,27 +114,26 @@ jobs: with: path: $HOME/cesm/inputdata key: inputdata - - name: Build PNetCDF - if: steps.cache-pnetcdf.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildpnetcdf@e06246b560d3132170bb1a5443fa3d65dfbd2040 - with: - pnetcdf_version: ${{ env.PNETCDF_VERSION }} - install_prefix: $HOME/pnetcdf - - name: Build NetCDF Fortran - if: steps.cache-netcdf-fortran.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildnetcdff@e06246b560d3132170bb1a5443fa3d65dfbd2040 - with: - netcdf_fortran_version: ${{ env.NETCDF_FORTRAN_VERSION }} - install_prefix: $HOME/netcdf-fortran - netcdf_c_path: /usr + # - name: Build PNetCDF + # if: steps.cache-pnetcdf.outputs.cache-hit != 'true' + # uses: ESCOMP/CDEPS/.github/actions/buildpnetcdf@e06246b560d3132170bb1a5443fa3d65dfbd2040 + # with: + # pnetcdf_version: ${{ env.PNETCDF_VERSION }} + # install_prefix: $HOME/pnetcdf + # - name: Build NetCDF Fortran + # if: steps.cache-netcdf-fortran.outputs.cache-hit != 'true' + # uses: ESCOMP/CDEPS/.github/actions/buildnetcdff@e06246b560d3132170bb1a5443fa3d65dfbd2040 + # with: + # netcdf_fortran_version: ${{ env.NETCDF_FORTRAN_VERSION }} + # install_prefix: $HOME/netcdf-fortran + # netcdf_c_path: /usr - name: Build ParallelIO if: steps.cache-PARALLELIO.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildpio@e06246b560d3132170bb1a5443fa3d65dfbd2040 + uses: NCAR/ParallelIO/.github/actions/parallelio_autotools@05173a6556ea8d80eb34e3881a5014ea8f4b7543 with: parallelio_version: ${{ env.ParallelIO_VERSION }} - netcdf_c_path: /usr - netcdf_fortran_path: $HOME/netcdf-fortran - pnetcdf_path: $HOME/pnetcdf + enable_fortran: True + with_pnetcdf: /usr install_prefix: $HOME/pio - name: Build ESMF if: steps.cache-esmf.outputs.cache-hit != 'true' From 280d399ed8352fa7e51f4d2be3ce47e61c91c0d7 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 9 Jan 2023 13:20:08 -0700 Subject: [PATCH 233/395] fix indentation --- .github/workflows/srt.yml | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 0619b0215..7f965c6c1 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -38,23 +38,23 @@ jobs: - name: Setup Ubuntu Environment id: load-env run: | - set -x - sudo apt-get update - sudo apt-get install netcdf-bin - sudo apt-get install libnetcdf-mpi-19 - sudo apt-get install libnetcdf-mpi-dev - sudo apt-get install pnetcdf-bin - sudo apt-get install libpnetcdf-dev - sudo apt-get install doxygen - sudo apt-get install graphviz - sudo apt-get install wget - sudo apt-get install gfortran - sudo apt-get install libjpeg-dev - sudo apt-get install libz-dev - sudo apt-get install openmpi-bin - sudo apt-get install libopenmpi-dev - cd /usr/lib/x86_64-linux-gnu - sudo ln -fs libnetcdf_mpi.so libnetcdf.so + set -x + sudo apt-get update + sudo apt-get install netcdf-bin + sudo apt-get install libnetcdf-mpi-19 + sudo apt-get install libnetcdf-mpi-dev + sudo apt-get install pnetcdf-bin + sudo apt-get install libpnetcdf-dev + sudo apt-get install doxygen + sudo apt-get install graphviz + sudo apt-get install wget + sudo apt-get install gfortran + sudo apt-get install libjpeg-dev + sudo apt-get install libz-dev + sudo apt-get install openmpi-bin + sudo apt-get install libopenmpi-dev + cd /usr/lib/x86_64-linux-gnu + sudo ln -fs libnetcdf_mpi.so libnetcdf.so - name: Set up Python ${{ matrix.python-version }} uses: actions/setup-python@v4 From 47cee68036be20b50fa1c8b02f3ef573a1caf584 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 9 Jan 2023 13:49:50 -0700 Subject: [PATCH 234/395] fix indentation --- .github/workflows/srt.yml | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 7f965c6c1..6ee6d1d01 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -158,9 +158,8 @@ jobs: export PIO_LIBDIR=$HOME/pio/lib export PIO_VERSION_MAJOR=2 export PIO_TYPENAME_VALID_VALUES="netcdf,pnetcdf,netcdf4p,netcdf4c" - export NETCDF=$HOME/netcdf-fortran - export PATH=$NETCDF/bin:$PATH:$HOME/netcdf-fortran/bin - export LD_LIBRARY_PATH=$NETCDF/lib:$HOME/pnetcdf/lib:$LD_LIBRARY_PATH + export NETCDF=/usr + export LD_LIBRARY_PATH=$NETCDF/libx86_64-linux-gnu/:$LD_LIBRARY_PATH export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest From 29c69da9b62f2f89982ddf7f96271f2e6556c4c9 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 9 Jan 2023 13:59:37 -0700 Subject: [PATCH 235/395] debug github action --- .github/workflows/srt.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 6ee6d1d01..ecbf5bdfa 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -159,12 +159,12 @@ jobs: export PIO_VERSION_MAJOR=2 export PIO_TYPENAME_VALID_VALUES="netcdf,pnetcdf,netcdf4p,netcdf4c" export NETCDF=/usr - export LD_LIBRARY_PATH=$NETCDF/libx86_64-linux-gnu/:$LD_LIBRARY_PATH + export LD_LIBRARY_PATH=$NETCDF/lib/libx86_64-linux-gnu/:$LD_LIBRARY_PATH export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details -# - name: Setup tmate session -# if: ${{ failure() }} -# uses: mxschmitt/action-tmate@v3 + - name: Setup tmate session + if: ${{ failure() }} + uses: mxschmitt/action-tmate@v3 From 55bcfe7ca2321e76e287ed56ab4b200bdb1a42a7 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 9 Jan 2023 14:11:11 -0700 Subject: [PATCH 236/395] need xmllint --- .github/workflows/srt.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index ecbf5bdfa..baef0ba2c 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -40,6 +40,7 @@ jobs: run: | set -x sudo apt-get update + sudo apt-get install libxml2-utils sudo apt-get install netcdf-bin sudo apt-get install libnetcdf-mpi-19 sudo apt-get install libnetcdf-mpi-dev From d158969f74352dabb76ceecf182968bdd157db3f Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 9 Jan 2023 14:23:35 -0700 Subject: [PATCH 237/395] force build --- .github/workflows/srt.yml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index baef0ba2c..3959c86ae 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -88,7 +88,7 @@ jobs: uses: actions/cache@v3 with: path: ~/ESMF - key: ${{ runner.os }}-${{ env.ESMF_VERSION }}-ESMF + key: ${{ runner.os }}-${{ env.ESMF_VERSION }}-ESMF1 # - name: cache pnetcdf # id: cache-pnetcdf # uses: actions/cache@v3 @@ -108,7 +108,7 @@ jobs: uses: actions/cache@v3 with: path: ~/pio - key: ${{ runner.os }}-${{ env.PARALLELIO_VERSION }}.pio + key: ${{ runner.os }}-${{ env.PARALLELIO_VERSION }}.parallelio - name: Cache inputdata id: cache-inputdata uses: actions/cache@v3 @@ -159,7 +159,8 @@ jobs: export PIO_LIBDIR=$HOME/pio/lib export PIO_VERSION_MAJOR=2 export PIO_TYPENAME_VALID_VALUES="netcdf,pnetcdf,netcdf4p,netcdf4c" - export NETCDF=/usr + export NETCDF_PATH=/usr + export PNETCDF_PATH=/usr export LD_LIBRARY_PATH=$NETCDF/lib/libx86_64-linux-gnu/:$LD_LIBRARY_PATH export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest From 098ea11c40a836353a1a058995e6c89f7fbe57cf Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 9 Jan 2023 14:31:27 -0700 Subject: [PATCH 238/395] force buildd --- .github/workflows/srt.yml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 3959c86ae..ea8144cd7 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -135,7 +135,7 @@ jobs: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True with_pnetcdf: /usr - install_prefix: $HOME/pio + install_prefix: ~/pio - name: Build ESMF if: steps.cache-esmf.outputs.cache-hit != 'true' uses: ESCOMP/CDEPS/.github/actions/buildesmf@e06246b560d3132170bb1a5443fa3d65dfbd2040 @@ -143,11 +143,11 @@ jobs: esmf_version: ${{ env.ESMF_VERSION }} esmf_bopt: g esmf_comm: openmpi - install_prefix: $HOME/ESMF + install_prefix: ~/ESMF netcdf_c_path: /usr - netcdf_fortran_path: $HOME/netcdf-fortran - pnetcdf_path: $HOME/pnetcdf - parallelio_path: $HOME/pio + netcdf_fortran_path: /usr + pnetcdf_path: /usr + parallelio_path: ~/pio - name: scripts regression tests run: | From 1781ce8fcc7a75fe532ffd0d1fdcc94e0c10544d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 9 Jan 2023 14:40:15 -0700 Subject: [PATCH 239/395] force buildd --- .github/workflows/srt.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index ea8144cd7..2bdad3e53 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -135,7 +135,7 @@ jobs: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True with_pnetcdf: /usr - install_prefix: ~/pio + install_prefix: /home/runner/pio - name: Build ESMF if: steps.cache-esmf.outputs.cache-hit != 'true' uses: ESCOMP/CDEPS/.github/actions/buildesmf@e06246b560d3132170bb1a5443fa3d65dfbd2040 @@ -167,6 +167,6 @@ jobs: # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details - - name: Setup tmate session - if: ${{ failure() }} - uses: mxschmitt/action-tmate@v3 +# - name: Setup tmate session +# if: ${{ failure() }} +# uses: mxschmitt/action-tmate@v3 From f806ac28a38aac9730cc4f9b81d77a388b9bea9e Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 9 Jan 2023 15:00:06 -0700 Subject: [PATCH 240/395] force buildd --- .github/workflows/srt.yml | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 2bdad3e53..9a87dac80 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -23,8 +23,8 @@ jobs: CC: mpicc FC: mpifort CXX: mpicxx - CPPFLAGS: "-I/usr/include -I/usr/local/include -I/usr/lib/x86_64-linux-gnu/netcdf/mpi/include/" - LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf_mpi -lpnetcdf" + CPPFLAGS: "-I/usr/include -I/usr/local/include " + LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" # Versions of all dependencies can be updated here ESMF_VERSION: v8.4.0 PARALLELIO_VERSION: pio2_5_10 @@ -42,8 +42,8 @@ jobs: sudo apt-get update sudo apt-get install libxml2-utils sudo apt-get install netcdf-bin - sudo apt-get install libnetcdf-mpi-19 - sudo apt-get install libnetcdf-mpi-dev + sudo apt-get install libnetcdf-dev + sudo apt-get install libnetcdff-dev sudo apt-get install pnetcdf-bin sudo apt-get install libpnetcdf-dev sudo apt-get install doxygen @@ -54,8 +54,6 @@ jobs: sudo apt-get install libz-dev sudo apt-get install openmpi-bin sudo apt-get install libopenmpi-dev - cd /usr/lib/x86_64-linux-gnu - sudo ln -fs libnetcdf_mpi.so libnetcdf.so - name: Set up Python ${{ matrix.python-version }} uses: actions/setup-python@v4 @@ -158,7 +156,7 @@ jobs: export PIO_INCDIR=$HOME/pio/include export PIO_LIBDIR=$HOME/pio/lib export PIO_VERSION_MAJOR=2 - export PIO_TYPENAME_VALID_VALUES="netcdf,pnetcdf,netcdf4p,netcdf4c" + export PIO_TYPENAME_VALID_VALUES="netcdf,pnetcdf" export NETCDF_PATH=/usr export PNETCDF_PATH=/usr export LD_LIBRARY_PATH=$NETCDF/lib/libx86_64-linux-gnu/:$LD_LIBRARY_PATH From 6ad71d9e0aa05e24d9356dfcc40c8686d0a8b05c Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 9 Jan 2023 16:21:31 -0700 Subject: [PATCH 241/395] redo multiinstance support --- cesm/driver/ensemble_driver.F90 | 37 ++++++++++++++-------- cesm/driver/esm.F90 | 2 +- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 6 ++-- 3 files changed, 29 insertions(+), 16 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 7e64c1cc6..02a0a517e 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -79,7 +79,7 @@ subroutine SetModelServices(ensemble_driver, rc) use ESMF , only : ESMF_CalendarSetDefault use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd - use NUOPC_Driver , only : NUOPC_DriverAddComp + use NUOPC_Driver , only : NUOPC_DriverAddComp, NUOPC_DriverGetComp use esm , only : ESMSetServices => SetServices, ReadAttributes use esm_time_mod , only : esm_time_clockInit @@ -89,7 +89,7 @@ subroutine SetModelServices(ensemble_driver, rc) ! local variables type(ESMF_VM) :: vm - type(ESMF_GridComp) :: driver, gridcomptmp + type(ESMF_GridComp) :: driver type(ESMF_Config) :: config integer :: n integer, pointer :: petList(:) @@ -169,6 +169,10 @@ subroutine SetModelServices(ensemble_driver, rc) call NUOPC_CompAttributeSet(ensemble_driver, name='read_restart', value=trim(read_restart_string), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeSet(ensemble_driver, name='Profiling', value='max', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + !------------------------------------------- ! Extract the config object from the ensemble_driver !------------------------------------------- @@ -200,23 +204,30 @@ subroutine SetModelServices(ensemble_driver, rc) !------------------------------------------- allocate(petList(ntasks_per_member)) - ! which driver instance is this? - inst = localPet/ntasks_per_member + 1 + ! We need to loop over instances + do inst = 1, number_of_members + + ! Determine pet list for driver instance + petList(1) = (inst-1) * ntasks_per_member + do n=2,ntasks_per_member + petList(n) = petList(n-1) + 1 + enddo + + ! Add driver instance to ensemble driver + write(drvrinst,'(a,i4.4)') "ESM",inst + call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo - ! Determine pet list for driver instance + inst = localPet/ntasks_per_member + 1 petList(1) = (inst-1) * ntasks_per_member do n=2,ntasks_per_member petList(n) = petList(n-1) + 1 enddo - - ! Add driver instance to ensemble driver - write(drvrinst,'(a,i4.4)') "ESM",inst - call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=gridcomptmp, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (localpet >= petlist(1) .and. localpet <= petlist(ntasks_per_member)) then - - driver = gridcomptmp + write(drvrinst,'(a,i4.4)') "ESM",inst + call NUOPC_DriverGetComp(ensemble_driver, drvrinst, comp=driver, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return if(number_of_members > 1) then call NUOPC_CompAttributeAdd(driver, attrList=(/'inst_suffix'/), rc=rc) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index 1c73ea17d..cc2e6f4f1 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -636,7 +636,7 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n if (chkerr(rc,__LINE__,u_FILE_u)) return !------ - ! Add driver restart flag a to gcomp attributes + ! Add driver restart flag to gcomp attributes !------ attribute = 'read_restart' call NUOPC_CompAttributeGet(driver, name=trim(attribute), value=cvalue, rc=rc) diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index 0ed53f22b..b6b0245ac 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -145,6 +145,7 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) character(len=CL) :: logfile character(len=CL) :: inst_suffix integer :: inst_index ! not used here + integer :: n !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -157,8 +158,9 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) call get_component_instance(gcomp, inst_suffix, inst_index, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Multiinstance logfile name needs a correction - if(logfile(4:4) == '_') then - logfile = logfile(1:3)//trim(inst_suffix)//logfile(9:) + if(len_trim(inst_suffix) > 0) then + n = index(logfile, '.') + logfile = logfile(1:n-1)//trim(inst_suffix)//logfile(n:) endif open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) From 00814cbde0e7d2c50bacd24e510c838bdde774b9 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 9 Jan 2023 16:44:10 -0700 Subject: [PATCH 242/395] still debugging workflow --- .github/workflows/srt.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 9a87dac80..2b4035918 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -165,6 +165,6 @@ jobs: # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details -# - name: Setup tmate session -# if: ${{ failure() }} -# uses: mxschmitt/action-tmate@v3 + - name: Setup tmate session + if: ${{ failure() }} + uses: mxschmitt/action-tmate@v3 From 0ba7709e29904af13d8bc3c1e8affe99241716f0 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 9 Jan 2023 17:21:02 -0700 Subject: [PATCH 243/395] fix pio build --- .github/workflows/srt.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 2b4035918..47d43c389 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -128,12 +128,13 @@ jobs: # netcdf_c_path: /usr - name: Build ParallelIO if: steps.cache-PARALLELIO.outputs.cache-hit != 'true' - uses: NCAR/ParallelIO/.github/actions/parallelio_autotools@05173a6556ea8d80eb34e3881a5014ea8f4b7543 + uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@05173a6556ea8d80eb34e3881a5014ea8f4b7543 with: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True with_pnetcdf: /usr install_prefix: /home/runner/pio + - name: Build ESMF if: steps.cache-esmf.outputs.cache-hit != 'true' uses: ESCOMP/CDEPS/.github/actions/buildesmf@e06246b560d3132170bb1a5443fa3d65dfbd2040 From 9635f7c1c450cd4dce25cb15d9f7a93a99115e32 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 10 Jan 2023 06:15:15 -0700 Subject: [PATCH 244/395] fix pio build --- .github/workflows/srt.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 47d43c389..6443f4338 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -132,7 +132,6 @@ jobs: with: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True - with_pnetcdf: /usr install_prefix: /home/runner/pio - name: Build ESMF From bb868998de940e0d11f0fdbedfc8f460ae2373e8 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 10 Jan 2023 08:51:44 -0500 Subject: [PATCH 245/395] remove unused variables, add fix for coord units --- mediator/med_io_mod.F90 | 64 ++++++++++++++++++++++---------------- mediator/med_map_mod.F90 | 1 - mediator/med_merge_mod.F90 | 1 - 3 files changed, 37 insertions(+), 29 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 6bd9a4663..69d1891fb 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -435,7 +435,7 @@ subroutine med_io_init(gcomp, rc) else pio_rearr_comm_enable_isend_comp2io = .false. end if - + ! pio_rearr_comm_max_pend_req_comp2io call NUOPC_CompAttributeGet(gcomp, name='pio_rearr_comm_max_pend_req_comp2io', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -576,7 +576,7 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) if(pio_iotype == PIO_IOTYPE_NETCDF .or. pio_iotype == PIO_IOTYPE_PNETCDF) then nmode = ior(nmode,pio_ioformat) endif - + rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) if (iam==0) write(logunit,'(a)') trim(subname) //' creating file '// trim(filename) rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) @@ -753,10 +753,12 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & ! Write FB to netcdf file !--------------- + use ESMF, only : operator(==) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE, ESMF_END_ABORT use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundle, ESMF_Mesh, ESMF_DistGrid use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_MeshGet, ESMF_DistGridGet use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_AttributeGet + use ESMF , only : ESMF_CoordSys_Flag, ESMF_COORDSYS_SPH_DEG, ESMF_COORDSYS_SPH_RAD, ESMF_COORDSYS_CART use pio , only : var_desc_t, io_desc_t, pio_offset_kind use pio , only : pio_def_dim, pio_inq_dimid, pio_real, pio_def_var, pio_put_att, pio_double use pio , only : pio_inq_varid, pio_setframe, pio_write_darray, pio_initdecomp, pio_freedecomp @@ -783,6 +785,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & type(ESMF_Field) :: field type(ESMF_Mesh) :: mesh type(ESMF_Distgrid) :: distgrid + type(ESMF_CoordSys_Flag) :: coordsys integer :: rcode integer :: nf,ns,ng integer :: k,n @@ -798,6 +801,9 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & character(CL) :: name1 ! var name character(CL) :: cunit ! var units character(CL) :: lpre ! local prefix + character(CS) :: coordvarnames(2) ! coordinate variable names + character(CS) :: coordnames(2) ! coordinate long names + character(CS) :: coordunits(2) ! coordinate units integer :: lnx,lny logical :: luse_float real(r8) :: lfillvalue @@ -873,12 +879,25 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & if (chkerr(rc,__LINE__,u_FILE_u)) return ! Get mesh distgrid and number of elements - call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) + call ESMF_MeshGet(mesh, elementDistgrid=distgrid, coordSys=coordsys, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MeshGet(mesh, spatialDim=ndims, numOwnedElements=nelements, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return write(tmpstr,*) subname, 'ndims, nelements = ', ndims, nelements call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + ! Define coordinate attributes according to CoordSys + if (coordsys == ESMF_COORDSYS_CART) then + coordvarnames(1) = trim(lpre)//'_x' + coordvarnames(2) = trim(lpre)//'_y' + coordnames = (/'x-coordinate', 'y-coordinate'/) + coordunits = (/'unitless','unitless'/) + else + coordvarnames(1) = trim(lpre)//'_lon' + coordvarnames(2) = trim(lpre)//'_lat' + coordnames = (/'longitude', 'latitude '/) + if (coordsys == ESMF_COORDSYS_SPH_DEG) coordunits = (/'degrees_E', 'degrees_N'/) + if (coordsys == ESMF_COORDSYS_SPH_RAD) coordunits = (/'radians ', 'radians '/) + end if ! Set element coordinates if (.not. allocated(ownedElemCoords) .and. ndims > 0 .and. nelements > 0) then @@ -1034,25 +1053,16 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & end do ! Add coordinate information to file - name1 = trim(lpre)//'_lon' - if (luse_float) then - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) - else - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) - end if - rcode = pio_put_att(io_file(lfile_ind), varid, "long_name", "longitude") - rcode = pio_put_att(io_file(lfile_ind), varid, "units", "degrees_east") - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", "longitude") - - name1 = trim(lpre)//'_lat' - if (luse_float) then - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) - else - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) - end if - rcode = pio_put_att(io_file(lfile_ind), varid, "long_name", "latitude") - rcode = pio_put_att(io_file(lfile_ind), varid, "units", "degrees_north") - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", "latitude") + do n = 1,ndims + if (luse_float) then + rcode = pio_def_var(io_file(lfile_ind), trim(coordvarnames(n)), PIO_REAL, dimid, varid) + else + rcode = pio_def_var(io_file(lfile_ind), trim(coordvarnames(n)), PIO_DOUBLE, dimid, varid) + end if + rcode = pio_put_att(io_file(lfile_ind), varid, "long_name", trim(coordnames(n))) + rcode = pio_put_att(io_file(lfile_ind), varid, "units", trim(coordunits(n))) + rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(coordnames(n))) + end do end if if (wdata) then @@ -1078,7 +1088,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & else itemc = trim(fieldNameList(k)) end if - + call FB_getFldPtr(FB, itemc, & fldptr1=fldptr1, fldptr2=fldptr2, rank=rank, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1119,19 +1129,19 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & end do ! end loop over fields in FB ! Fill coordinate variables - why is this being done each time? - name1 = trim(lpre)//'_lon' - rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) + rcode = pio_inq_varid(io_file(lfile_ind), trim(coordvarnames(1)), varid) call pio_setframe(io_file(lfile_ind),varid,frame) call pio_write_darray(io_file(lfile_ind), varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue) - name1 = trim(lpre)//'_lat' - rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) + rcode = pio_inq_varid(io_file(lfile_ind), trim(coordvarnames(2)), varid) call pio_setframe(io_file(lfile_ind),varid,frame) call pio_write_darray(io_file(lfile_ind), varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue) call pio_syncfile(io_file(lfile_ind)) call pio_freedecomp(io_file(lfile_ind), iodesc) endif + deallocate(fieldNameList) + deallocate(ownedElemCoords, ownedElemCoords_x, ownedElemCoords_y) if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 711f27ee4..007e882cd 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -742,7 +742,6 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & type(ESMF_Mesh) :: lmesh_src type(ESMF_Mesh) :: lmesh_dst integer :: mapindex - integer :: numFlds type(ESMF_Field), pointer :: fieldlist_src(:) type(ESMF_Field), pointer :: fieldlist_dst(:) type(med_fldlist_entry_type), pointer :: fldptr diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index c59d37dda..f09c9311d 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -333,7 +333,6 @@ subroutine med_merge_auto_field(merge_type, field_out, ungriddedUBound_out, & real(R8), pointer :: dpf1(:) real(R8), pointer :: dpf2(:,:) ! intput pointers to 1d and 2d fields real(R8), pointer :: dpw1(:) ! weight pointer - character(CL) :: name character(len=*),parameter :: subname=' (med_merge_mod: med_merge_auto_field)' !--------------------------------------- From 764dbe4d2beab9e114fda04616979e06b007c624 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 10 Jan 2023 07:01:03 -0700 Subject: [PATCH 246/395] fix pio build --- .github/workflows/srt.yml | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 6443f4338..9b655cee0 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -147,7 +147,8 @@ jobs: pnetcdf_path: /usr parallelio_path: ~/pio - - name: scripts regression tests + + - name: PREP for scripts regression test run: | mkdir -p $HOME/cesm/scratch mkdir -p $HOME/cesm/inputdata @@ -161,10 +162,13 @@ jobs: export PNETCDF_PATH=/usr export LD_LIBRARY_PATH=$NETCDF/lib/libx86_64-linux-gnu/:$LD_LIBRARY_PATH export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk - ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest + printenv >> $GITHUB_ENV + # - name: scripts regression tests + # run: | + # ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details - - name: Setup tmate session - if: ${{ failure() }} - uses: mxschmitt/action-tmate@v3 +# - name: Setup tmate session +# if: ${{ failure() }} +# uses: mxschmitt/action-tmate@v3 From a96e036afa49c22a64b618e2e684827fe5192e08 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 10 Jan 2023 07:23:33 -0700 Subject: [PATCH 247/395] srt with cache --- .github/workflows/srt.yml | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 9b655cee0..5ae8f1d9b 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -152,7 +152,7 @@ jobs: run: | mkdir -p $HOME/cesm/scratch mkdir -p $HOME/cesm/inputdata - cd $GITHUB_WORKSPACE/cesm/cime/CIME/tests + pushd $GITHUB_WORKSPACE/cesm/cime/CIME/tests export CIME_TEST_PLATFORM=ubuntu-latest export PIO_INCDIR=$HOME/pio/include export PIO_LIBDIR=$HOME/pio/lib @@ -163,12 +163,14 @@ jobs: export LD_LIBRARY_PATH=$NETCDF/lib/libx86_64-linux-gnu/:$LD_LIBRARY_PATH export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk printenv >> $GITHUB_ENV - # - name: scripts regression tests - # run: | - # ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest - + popd + - name: scripts regression tests + run: | + pushd $GITHUB_WORKSPACE/cesm/cime/CIME/tests + ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest + popd # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details -# - name: Setup tmate session -# if: ${{ failure() }} -# uses: mxschmitt/action-tmate@v3 + - name: Setup tmate session + if: ${{ failure() }} + uses: mxschmitt/action-tmate@v3 From f50bd031934acd9144e25c68149d7f8fa54bdd86 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 10 Jan 2023 08:13:33 -0700 Subject: [PATCH 248/395] bld cprnc --- .github/workflows/srt.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 5ae8f1d9b..0688da08a 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -160,14 +160,14 @@ jobs: export PIO_TYPENAME_VALID_VALUES="netcdf,pnetcdf" export NETCDF_PATH=/usr export PNETCDF_PATH=/usr - export LD_LIBRARY_PATH=$NETCDF/lib/libx86_64-linux-gnu/:$LD_LIBRARY_PATH + export LD_LIBRARY_PATH=/usr/lib/libx86_64-linux-gnu/:$LD_LIBRARY_PATH export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk printenv >> $GITHUB_ENV popd - name: scripts regression tests run: | pushd $GITHUB_WORKSPACE/cesm/cime/CIME/tests - ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest + ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest test_sys_build_system.py popd # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details From 419c78861d27ed5f33b43f8a391dd325c9a92f93 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 10 Jan 2023 08:29:37 -0700 Subject: [PATCH 249/395] add ubuntu-latest.cmake --- .github/workflows/srt.yml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 0688da08a..3a66c9240 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -162,6 +162,10 @@ jobs: export PNETCDF_PATH=/usr export LD_LIBRARY_PATH=/usr/lib/libx86_64-linux-gnu/:$LD_LIBRARY_PATH export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk + cat <> $GITHUB_WORKSPACE/cesm/ccs_config/machines/cmake_macros/ubuntu-latest.cmake + set(NetCDF_Fortran_INCLUDE_DIR /usr/include) + set(NetCDF_Fortran_LIBRARY /usr/lib/x86_64-gnu-Linux/libnetcdff.so) + EOF printenv >> $GITHUB_ENV popd - name: scripts regression tests From 5998250087b6ce7ccddeddee9f2245e5859ce418 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 10 Jan 2023 08:36:38 -0700 Subject: [PATCH 250/395] finally working --- .github/workflows/srt.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 3a66c9240..39526be99 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -171,10 +171,10 @@ jobs: - name: scripts regression tests run: | pushd $GITHUB_WORKSPACE/cesm/cime/CIME/tests - ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest test_sys_build_system.py + ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest popd # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details - - name: Setup tmate session - if: ${{ failure() }} - uses: mxschmitt/action-tmate@v3 +# - name: Setup tmate session +# if: ${{ failure() }} +# uses: mxschmitt/action-tmate@v3 From d17cd8956bb36736a4f1a44febb5ca58896a0db3 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 11 Jan 2023 12:52:31 -0700 Subject: [PATCH 251/395] move timer init function --- cesm/driver/ensemble_driver.F90 | 23 +++++++++++++++++------ cesm/driver/esm.F90 | 8 -------- 2 files changed, 17 insertions(+), 14 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 02a0a517e..42d34c438 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -82,7 +82,7 @@ subroutine SetModelServices(ensemble_driver, rc) use NUOPC_Driver , only : NUOPC_DriverAddComp, NUOPC_DriverGetComp use esm , only : ESMSetServices => SetServices, ReadAttributes use esm_time_mod , only : esm_time_clockInit - + use perf_mod , only : t_startf, t_stopf, t_initf ! input/output variables type(ESMF_GridComp) :: ensemble_driver integer, intent(out) :: rc @@ -102,6 +102,7 @@ subroutine SetModelServices(ensemble_driver, rc) integer :: inst integer :: number_of_members integer :: ntasks_per_member + integer :: Global_Comm character(CL) :: start_type ! Type of startup character(len=7) :: drvrinst character(len=5) :: inst_suffix @@ -116,10 +117,21 @@ subroutine SetModelServices(ensemble_driver, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - call ESMF_GridCompGet(ensemble_driver, config=config, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=localPet, mpiCommunicator=global_comm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (localPet == 0) then + mastertask=.true. + else + mastertask = .false. + end if + + call t_initf('drv_in', LogPrint=.true., LogUnit=logunit, mpicom=global_comm, mastertask=mastertask) + call t_startf(subname) + !------------------------------------------- ! Initialize clocks !------------------------------------------- @@ -169,10 +181,6 @@ subroutine SetModelServices(ensemble_driver, rc) call NUOPC_CompAttributeSet(ensemble_driver, name='read_restart', value=trim(read_restart_string), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompAttributeSet(ensemble_driver, name='Profiling', value='max', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - !------------------------------------------- ! Extract the config object from the ensemble_driver !------------------------------------------- @@ -205,6 +213,7 @@ subroutine SetModelServices(ensemble_driver, rc) allocate(petList(ntasks_per_member)) ! We need to loop over instances + call t_startf('compute_drivers') do inst = 1, number_of_members ! Determine pet list for driver instance @@ -218,6 +227,7 @@ subroutine SetModelServices(ensemble_driver, rc) call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return enddo + call t_stopf('compute_drivers') inst = localPet/ntasks_per_member + 1 petList(1) = (inst-1) * ntasks_per_member @@ -275,6 +285,7 @@ subroutine SetModelServices(ensemble_driver, rc) endif deallocate(petList) + call t_stopf(subname) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index cc2e6f4f1..ce768b6d2 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -10,7 +10,6 @@ module ESM use shr_mem_mod , only : shr_mem_init use shr_log_mod , only : shr_log_setLogunit use esm_utils_mod, only : logunit, mastertask, dbug_flag, chkerr - use perf_mod , only : t_initf, t_setLogUnit implicit none private @@ -151,8 +150,6 @@ subroutine SetModelServices(driver, rc) call ESMF_VMGet(vm, localPet=localPet, mpiCommunicator=global_comm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=localPet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return if (localPet == 0) then mastertask=.true. else @@ -211,11 +208,6 @@ subroutine SetModelServices(driver, rc) write(logunit,*) trim(meminitstr) end if - !------------------------------------------- - ! Timer initialization (has to be after pelayouts are determined) - !------------------------------------------- - call t_initf('drv_in', LogPrint=.true., LogUnit=logunit, mpicom=global_comm, mastertask=mastertask, MaxThreads=maxthreads) - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine SetModelServices From c7fec3b21710b76366ac8c0120b5c8be6910743d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 11 Jan 2023 13:10:42 -0700 Subject: [PATCH 252/395] fix merge issues --- cesm/driver/ensemble_driver.F90 | 6 +++--- cesm/driver/esm.F90 | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 8bb3b1154..58b9d58a1 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -124,12 +124,12 @@ subroutine SetModelServices(ensemble_driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (localPet == 0) then - mastertask=.true. + maintask=.true. else - mastertask = .false. + maintask = .false. end if - call t_initf('drv_in', LogPrint=.true., LogUnit=logunit, mpicom=global_comm, mastertask=mastertask) + call t_initf('drv_in', LogPrint=.true., LogUnit=logunit, mpicom=global_comm, mastertask=maintask) call t_startf(subname) !------------------------------------------- diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index 2e951bfa5..da2f6f6d3 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -9,7 +9,7 @@ module ESM use shr_mpi_mod , only : shr_mpi_bcast use shr_mem_mod , only : shr_mem_init use shr_log_mod , only : shr_log_setLogunit - use esm_utils_mod, only : logunit, mastertask, dbug_flag, chkerr + use esm_utils_mod, only : logunit, maintask, dbug_flag, chkerr implicit none private From 9197fd20a6be104c24fd058cae23d2fc1a67670a Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 18 Jan 2023 09:41:41 -0700 Subject: [PATCH 253/395] updates to MEGAN namelist parser modified: cesm/nuopc_cap_share/shr_expr_parser_mod.F90 modified: cesm/nuopc_cap_share/shr_megan_mod.F90 --- cesm/nuopc_cap_share/shr_expr_parser_mod.F90 | 166 ++++++++++--------- cesm/nuopc_cap_share/shr_megan_mod.F90 | 23 +-- 2 files changed, 104 insertions(+), 85 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_expr_parser_mod.F90 b/cesm/nuopc_cap_share/shr_expr_parser_mod.F90 index f37a4ac3c..4cf748a35 100644 --- a/cesm/nuopc_cap_share/shr_expr_parser_mod.F90 +++ b/cesm/nuopc_cap_share/shr_expr_parser_mod.F90 @@ -1,12 +1,12 @@ !============================================================================= ! expression parser utility -- ! for parsing simple linear mathematical expressions of the form -! X = a*Y + b*Z + ... +! X = a*R + b*S + c*(X + Y + Z) ... ! !============================================================================= module shr_expr_parser_mod use shr_kind_mod,only : r8 => shr_kind_r8 - use shr_kind_mod,only : cx => shr_kind_cx + use shr_kind_mod,only : CXX => shr_kind_cxx implicit none private @@ -35,82 +35,122 @@ function shr_exp_parse( exp_array, nitems ) result(exp_items_list) integer, optional, intent(out) :: nitems ! number of expressions parsed type(shr_exp_item_t), pointer :: exp_items_list ! linked list of items returned - integer :: i,j, jj, nmax, nterms, n_exp_items - character(len=cx) :: tmp_str + integer :: i,j, n_exp_items type(shr_exp_item_t), pointer :: exp_item, list_item + integer :: ndxs(512) + integer :: nelem, j1,j2,k + character(len=CXX) :: tmp_str, tmp_name + character(len=8) :: xchr ! multipler + real(r8) :: xdbl + real(r8) :: coeff0 + logical :: more_to_come + character(len=CXX), allocatable :: sums_grps(:) + character(len=CXX) :: sum_string + + allocate(sums_grps(size(exp_array))) nullify( exp_items_list ) nullify( exp_item ) nullify( list_item ) - n_exp_items = 0 - nmax = size( exp_array ) + sums_grps(:) = ' ' - do i = 1,nmax - if (len_trim(exp_array(i))>0) then + ! combine lines that have a trailing "+" with the next line + i=1 + j=1 + loop1: do while( len_trim(exp_array(i)) > 0 ) - j = scan( exp_array(i), '=' ) + k = scan(exp_array(i), '+', back=.true. ) + more_to_come = k == len_trim(exp_array(i)) ! line ends with "+" - if ( j>0 ) then + if ( more_to_come ) then + sums_grps(j) = trim(sums_grps(j)) // trim(adjustl(exp_array(i))) + else + sums_grps(j) = trim(sums_grps(j)) // trim(adjustl(exp_array(i))) + j = j+1 + endif + + i = i+1 + if ( i > size(exp_array) ) exit loop1 - n_exp_items = n_exp_items + 1 + end do loop1 - allocate( exp_item ) - exp_item%n_terms = 0 - exp_item%name = trim(adjustl(exp_array(i)(:j-1))) + n_exp_items = j-1 - tmp_str = trim(adjustl(exp_array(i)(j+1:))) + ! a group is a summation of terms - nterms = 1 - jj = scan( tmp_str, '+' ) - do while(jj>0) - nterms = nterms + 1 - tmp_str = tmp_str(jj+1:) - jj = scan( tmp_str, '+' ) - enddo + ! parse the individual sum strings... and form the groupings + has_grps: if (n_exp_items>0) then - allocate( exp_item%vars(nterms) ) - allocate( exp_item%coeffs(nterms) ) + ! from shr_megan_mod ... should be generalized and shared... + grploop: do i = 1,n_exp_items - tmp_str = trim(adjustl(exp_array(i)(j+1:))) + ! parse out the term names + ! from first parsing out the terms in the summation equation ("+" separates the terms) + sum_string = sums_grps(i) + j = scan( sum_string, '=' ) + nelem = 1 + ndxs(nelem) = j ! ndxs stores the index of each term of the equation + + ! find indices of all the terms in the equation + tmp_str = trim( sum_string(j+1:) ) + j = scan( tmp_str, '+' ) + do while(j>0) + nelem = nelem+1 + ndxs(nelem) = ndxs(nelem-1) + j + tmp_str = tmp_str(j+1:) j = scan( tmp_str, '+' ) + enddo + ndxs(nelem+1) = len(sum_string)+1 - if (j>0) then - call set_coefvar( tmp_str(:j-1), exp_item ) - tmp_str = tmp_str(j-1:) - else - call set_coefvar( tmp_str, exp_item ) - endif + allocate( exp_item ) - else + exp_item%n_terms = nelem ! number of terms - tmp_str = trim(adjustl(exp_array(i))) ! assumed to begin with '+' + exp_item%name = trim(adjustl( sum_string(:ndxs(1)-1))) ! thing to the left of the "=" is used as the name of the group - endif + ! now that we have the number of terms in the summation allocate memory for the terms + allocate( exp_item%vars(nelem) ) + allocate( exp_item%coeffs(nelem) ) - ! at this point tmp_str begins with '+' - j = scan( tmp_str, '+' ) + coeff0 = 1._r8 ! default multiplier - if (j>0) then + ! now parse out the multiplier from the terms + elmloop: do k = 1,nelem - ! remove the leading + ... - tmp_str = tmp_str(j+1:) - j = scan( tmp_str, '+' ) + exp_item%coeffs(k) = coeff0 - do while(j>0) + ! get the term name which follows the '*' operator if the is one + tmp_name = adjustl(sum_string(ndxs(k)+1:ndxs(k+1)-1)) - call set_coefvar( tmp_str(:j-1), exp_item ) + j = scan( tmp_name, '*' ) + if (j>0) then - tmp_str = tmp_str(j+1:) - j = scan( tmp_str, '+' ) + xchr = tmp_name(1:j-1) ! get the multipler (left of the '*') + read( xchr, * ) xdbl ! convert the string to a real + exp_item%coeffs(k) = xdbl ! store the multiplier - enddo + j1 = scan( tmp_name, '(' ) + if (j1>0) then + coeff0 = xdbl + tmp_name = trim(adjustl(tmp_name(j1+1:))) ! get the term name (right of the '*') + else + coeff0 = 1._r8 + tmp_name = trim(adjustl(tmp_name(j+1:))) ! get the term name (right of the '*') + endif - call set_coefvar( tmp_str, exp_item ) + endif - endif + j2 = scan( tmp_name, ')' ) + if (j2>0) then + coeff0 = 1._r8 + tmp_name = tmp_name(1:j2-1) + endif + exp_item%vars(k) = trim(tmp_name) + + enddo elmloop if (associated(exp_item)) then if (associated(exp_items_list)) then @@ -124,13 +164,16 @@ function shr_exp_parse( exp_array, nitems ) result(exp_items_list) endif endif - endif - enddo + + enddo grploop + endif has_grps if ( present(nitems) ) then nitems = n_exp_items endif + deallocate(sums_grps) + end function shr_exp_parse ! ----------------------------------------------------------------- @@ -157,29 +200,4 @@ subroutine shr_exp_list_destroy( list ) end subroutine shr_exp_list_destroy - !========================== - ! Private Methods - - ! ----------------------------------------------------------------- - ! ----------------------------------------------------------------- - subroutine set_coefvar( term, item ) - character(len=*), intent(in) :: term - type(shr_exp_item_t) , intent(inout) :: item - - integer :: k, n - - item%n_terms = item%n_terms + 1 - n = item%n_terms - - k = scan( term, '*' ) - if (k>0) then - item%vars(n) = trim(adjustl(term(k+1:))) - read( term(:k-1), *) item%coeffs(n) - else - item%vars(n) = trim(adjustl(term)) - item%coeffs(n) = 1.0_r8 - endif - - end subroutine set_coefvar - end module shr_expr_parser_mod diff --git a/cesm/nuopc_cap_share/shr_megan_mod.F90 b/cesm/nuopc_cap_share/shr_megan_mod.F90 index d49411e84..eeb5b87f6 100644 --- a/cesm/nuopc_cap_share/shr_megan_mod.F90 +++ b/cesm/nuopc_cap_share/shr_megan_mod.F90 @@ -5,9 +5,9 @@ module shr_megan_mod ! MEGAN = Model of Emissions of Gases and Aerosols from Nature ! ! This reads the megan_emis_nl namelist in drv_flds_in and makes the relavent - ! information available to CAM, CLM, and driver. - ! - The driver sets up CLM to CAM communication for the VOC flux fields. - ! - CLM needs to know what specific VOC fluxes need to be passed to the coupler + ! information available to CAM, CLM, and driver. + ! - The driver sets up CLM to CAM communication for the VOC flux fields. + ! - CLM needs to know what specific VOC fluxes need to be passed to the coupler ! and how to assemble the fluxes. ! - CAM needs to know what specific VOC fluxes to expect from CLM. !================================================================================ @@ -20,7 +20,7 @@ module shr_megan_mod use shr_mpi_mod , only : shr_mpi_bcast use shr_nl_mod , only : shr_nl_find_group_name use shr_expr_parser_mod , only : shr_exp_parse, shr_exp_item_t, shr_exp_list_destroy - + implicit none private @@ -100,7 +100,8 @@ subroutine shr_megan_readnl( NLFileName, megan_nflds) ! Example: ! &megan_emis_nl ! megan_specifier = 'ISOP = isoprene', - ! 'C10H16 = myrcene + sabinene + limonene + carene_3 + ocimene_t_b + pinene_b + ...', + ! 'C10H16 = myrcene + sabinene + limonene + carene_3 + ocimene_t_b + pinene_b + ', + ! ' thujene_a + bornene + 0.5*(terpineol_4 + terpineol_a + terpinyl_ACT_a + myrtenal) + ...', ! 'CH3OH = methanol', ! 'C2H5OH = ethanol', ! 'CH2O = formaldehyde', @@ -109,7 +110,7 @@ subroutine shr_megan_readnl( NLFileName, megan_nflds) ! megan_factors_file = '$datapath/megan_emis_factors.nc' ! / !------------------------------------------------------------------------- - + ! input/output variables character(len=*), intent(in) :: NLFileName integer, intent(out) :: megan_nflds @@ -121,8 +122,8 @@ subroutine shr_megan_readnl( NLFileName, megan_nflds) integer :: unitn ! namelist unit number integer :: ierr ! error code logical :: exists ! if file exists or not - integer, parameter :: maxspc = 100 - character(len=2*CX) :: megan_specifier(maxspc) = ' ' + integer, parameter :: maxspc = 200 + character(len=CX) :: megan_specifier(maxspc) = ' ' logical :: megan_mapped_emisfctrs = .false. character(len=CL) :: megan_factors_file = ' ' integer :: rc @@ -140,12 +141,12 @@ subroutine shr_megan_readnl( NLFileName, megan_nflds) end if call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + 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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call shr_log_getLogUnit(logunit) - ! Note the following still needs to be called on all processors since the mpi_bcast is a collective + ! Note the following still needs to be called on all processors since the mpi_bcast is a collective ! call on all the pes of mpicom if (localPet==0) then inquire( file=trim(NLFileName), exist=exists) From 9514b398c8780414657aae798d0cebe2b06fe48c Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 18 Jan 2023 19:25:48 -0700 Subject: [PATCH 254/395] log MEGAN settings modified: cesm/nuopc_cap_share/shr_megan_mod.F90 --- cesm/nuopc_cap_share/shr_megan_mod.F90 | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_megan_mod.F90 b/cesm/nuopc_cap_share/shr_megan_mod.F90 index eeb5b87f6..0352b64c1 100644 --- a/cesm/nuopc_cap_share/shr_megan_mod.F90 +++ b/cesm/nuopc_cap_share/shr_megan_mod.F90 @@ -68,6 +68,9 @@ module shr_megan_mod ! switch to use mapped emission factors logical :: shr_megan_mapped_emisfctrs = .false. + integer :: localPet = -huge(1) + integer :: logunit = -huge(1) + !-------------------------------------------------------- contains !-------------------------------------------------------- @@ -117,7 +120,6 @@ subroutine shr_megan_readnl( NLFileName, megan_nflds) ! local variables type(ESMF_VM) :: vm - integer :: localPet integer :: mpicom integer :: unitn ! namelist unit number integer :: ierr ! error code @@ -127,7 +129,6 @@ subroutine shr_megan_readnl( NLFileName, megan_nflds) logical :: megan_mapped_emisfctrs = .false. character(len=CL) :: megan_factors_file = ' ' integer :: rc - integer :: logunit integer :: i, tmp(1) character(*), parameter :: F00 = "('(shr_megan_readnl) ',2a)" character(len=*), parameter :: subname='(shr_megan_readnl)' @@ -205,6 +206,8 @@ subroutine shr_megan_init( specifier) allocate(shr_megan_mechcomps(n_entries)) shr_megan_mechcomps(:)%n_megan_comps = 0 + if (localPet==0) write(logunit,*) 'MEGAN entries:' + item => items_list i = 1 do while(associated(item)) @@ -222,7 +225,9 @@ subroutine shr_megan_init( specifier) shr_megan_mechcomps(i)%n_megan_comps = item%n_terms allocate(shr_megan_mechcomps(i)%megan_comps(item%n_terms)) + if (localPet==0) write(logunit,*) ' species : ', item%name do j = 1,item%n_terms + if (localPet==0) write(logunit,'(f12.4,a,a)') item%coeffs(j),' * ', item%vars(j) shr_megan_mechcomps(i)%megan_comps(j)%ptr => add_megan_comp( item%vars(j), item%coeffs(j) ) enddo shr_megan_mechcomps_n = shr_megan_mechcomps_n+1 From 690cf281bbbd3a057ff7cc6ff701c9e429e8b65c Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 19 Jan 2023 11:00:59 -0700 Subject: [PATCH 255/395] code clean up modified: cesm/nuopc_cap_share/shr_megan_mod.F90 --- cesm/nuopc_cap_share/shr_megan_mod.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_megan_mod.F90 b/cesm/nuopc_cap_share/shr_megan_mod.F90 index 0352b64c1..57a218dd7 100644 --- a/cesm/nuopc_cap_share/shr_megan_mod.F90 +++ b/cesm/nuopc_cap_share/shr_megan_mod.F90 @@ -13,8 +13,8 @@ module shr_megan_mod !================================================================================ use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet - use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS - use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cx=>shr_kind_cx, cs=>shr_kind_cs + use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU + use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cx=>shr_kind_cx use shr_sys_mod , only : shr_sys_abort use shr_log_mod , only : shr_log_getLogUnit use shr_mpi_mod , only : shr_mpi_bcast @@ -129,7 +129,6 @@ subroutine shr_megan_readnl( NLFileName, megan_nflds) logical :: megan_mapped_emisfctrs = .false. character(len=CL) :: megan_factors_file = ' ' integer :: rc - integer :: i, tmp(1) character(*), parameter :: F00 = "('(shr_megan_readnl) ',2a)" character(len=*), parameter :: subname='(shr_megan_readnl)' !-------------------------------------------------------------- From c2f8792fc9fa4198a5d3efc7fd935c25742044bd Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 25 Jan 2023 10:57:05 -0700 Subject: [PATCH 256/395] fix issues in merge --- cesm/driver/ensemble_driver.F90 | 4 +- cesm/driver/esm.F90 | 2 +- cesm/driver/esm_time_mod.F90 | 69 +++++----------------- cesm/nuopc_cap_share/driver_pio_mod.F90 | 14 ++--- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 5 +- 5 files changed, 26 insertions(+), 68 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index f7e8c3181..1e91236ca 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -328,7 +328,7 @@ subroutine SetModelServices(ensemble_driver, rc) write(msgstr, *) ": driver added on PETS ",petlist(1),' to ',petlist(petcnt-1) call ESMF_LogWrite(trim(subname)//msgstr) - mastertask = .false. + maintask = .false. if (comp_task) then if(number_of_members > 1) then call NUOPC_CompAttributeAdd(driver, attrList=(/'inst_suffix'/), rc=rc) @@ -370,7 +370,7 @@ subroutine SetModelServices(ensemble_driver, rc) call shr_log_setLogUnit (logunit) endif ! Create a clock for each driver instance - call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) + call esm_time_clockInit(ensemble_driver, driver, logunit, maintask, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return deallocate(petList) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index f3f11925f..02970d31e 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -1529,7 +1529,7 @@ subroutine esm_finalize(driver, rc) endif call t_prf(trim(timing_dir)//'/model_timing'//trim(inst_suffix), mpicom=mpicomm) - if (mastertask) then + if (maintask) then write(logunit,*)' SUCCESSFUL TERMINATION OF CESM' end if call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index 4c38f1654..fc57eaf11 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -155,7 +155,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas read(cvalue,*) wav_cpl_dt dtime_drv = minval((/atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt/)) - if(mastertask) then + if(maintask) then write(tmpstr,'(i10)') dtime_drv call ESMF_LogWrite(trim(subname)//': driver time interval is : '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(logunit,*) trim(subname)//': driver time interval is : '// trim(tmpstr) @@ -193,7 +193,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas restart_pfile = trim(restart_file)//inst_suffix - if (mastertask) then + if (maintask) then call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) @@ -211,27 +211,27 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas return end if close(unitn) - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//" reading driver restart from file = "//trim(restart_file) end if call esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif else - - - if (maintask) then - write(logunit,*) ' NOTE: the current compset has no mediator - which provides the clock restart information' - write(logunit,*) ' In this case the restarts are handled solely by the component being used and' - write(logunit,*) ' and the driver clock will always be starting from the initial date on restart' - end if + if(maintask) then + write(logunit,*) ' NOTE: the current compset has no mediator - which provides the clock restart information' + write(logunit,*) ' In this case the restarts are handled solely by the component being used and' + write(logunit,*) ' and the driver clock will always be starting from the initial date on restart' + end if + curr_ymd = start_ymd + curr_tod = start_tod + endif + else curr_ymd = start_ymd - curr_tod = start_tod - + curr_tod = start_tod end if ! end if read_restart endif - if(mastertask) then + if(maintask) then bcastID(1) = myid tmp(1) = start_ymd ; tmp(2) = start_tod tmp(3) = curr_ymd ; tmp(4) = curr_tod @@ -282,48 +282,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas call ESMF_TimeSet( RefTime, yy=yr, mm=mon, dd=day, s=ref_tod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !--------------------------------------------------------------------------- - ! Determine driver clock timestep - !--------------------------------------------------------------------------- - - call NUOPC_CompAttributeGet(instance_driver, name="atm_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) atm_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="lnd_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) lnd_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="ice_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ice_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="ocn_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ocn_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="glc_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="rof_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) rof_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="wav_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) wav_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="glc_avg_period", value=glc_avg_period, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_avg_period - dtime_drv = minval((/atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt/)) - if(maintask) then - write(tmpstr,'(i10)') dtime_drv - call ESMF_LogWrite(trim(subname)//': driver time interval is : '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - write(logunit,*) trim(subname)//': driver time interval is : '// trim(tmpstr) - endif call ESMF_TimeIntervalSet( TimeStep, s=dtime_drv, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index 91e9c5ec5..ef92bb47a 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -85,7 +85,7 @@ subroutine driver_pio_init(driver, rc) ! 0 is a valid value of pio_buffer_size_limit if(pio_buffer_size_limit>=0) then - if(maintask) write(shr_log_unit,*) 'Setting pio_buffer_size_limit : ',pio_buffer_size_limit + if(maintask) write(logunit,*) 'Setting pio_buffer_size_limit : ',pio_buffer_size_limit call pio_set_buffer_size_limit(pio_buffer_size_limit) endif @@ -94,7 +94,7 @@ subroutine driver_pio_init(driver, rc) read(cname, *) pio_blocksize if(pio_blocksize>0) then - if(maintask) write(shr_log_unit,*) 'Setting pio_blocksize : ',pio_blocksize + if(maintask) write(logunit,*) 'Setting pio_blocksize : ',pio_blocksize call pio_set_blocksize(pio_blocksize) endif @@ -103,7 +103,7 @@ subroutine driver_pio_init(driver, rc) read(cname, *) pio_debug_level if(pio_debug_level > 0) then - if(maintask) write(shr_log_unit,*) 'Setting pio_debug_level : ',pio_debug_level + if(maintask) write(logunit,*) 'Setting pio_debug_level : ',pio_debug_level ret = pio_set_log_level(pio_debug_level) endif @@ -125,22 +125,22 @@ subroutine driver_pio_init(driver, rc) call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_hs_comp2io", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_rearr_opts%comm_fc_opts_comp2io%enable_hs = (trim(cname) .eq. '.true.') + pio_rearr_opts%comm_fc_opts_comp2io%enable_hs = logical((trim(cname) .eq. '.true.'), kind=1) call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_hs_io2comp", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_rearr_opts%comm_fc_opts_io2comp%enable_hs = (trim(cname) .eq. '.true.') + pio_rearr_opts%comm_fc_opts_io2comp%enable_hs = logical((trim(cname) .eq. '.true.'), kind=1) call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_isend_comp2io", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_rearr_opts%comm_fc_opts_comp2io%enable_isend = (trim(cname) .eq. '.true.') + pio_rearr_opts%comm_fc_opts_comp2io%enable_isend = logical((trim(cname) .eq. '.true.'), kind=1) call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_isend_io2comp", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_rearr_opts%comm_fc_opts_io2comp%enable_isend = (trim(cname) .eq. '.true.') + pio_rearr_opts%comm_fc_opts_io2comp%enable_isend = logical((trim(cname) .eq. '.true.'), kind=1) call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_max_pend_req_comp2io", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index aa602f625..9062b27f1 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -130,9 +130,8 @@ subroutine get_component_instance(gcomp, inst_suffix, inst_index, rc) end subroutine get_component_instance !=============================================================================== - + subroutine set_component_logging(gcomp, maintask, logunit, shrlogunit, rc) use NUOPC, only: NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd - use driver_pio_mod, only : driver_pio_log_comp_settings ! input/output variables type(ESMF_GridComp) :: gcomp logical, intent(in) :: maintask @@ -145,7 +144,7 @@ end subroutine get_component_instance character(len=CL) :: logfile character(len=CL) :: inst_suffix integer :: inst_index ! Not used here - integer :: i + integer :: n character(len=CL) :: name character(len=*), parameter :: subname = "("//__FILE__//": set_component_logging)" !----------------------------------------------------------------------- From 89e4ba61ec0985b989ac8521d4ad3c83eb4674a5 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 30 Jan 2023 09:09:52 -0700 Subject: [PATCH 257/395] changes needed for CDEP PR #213 --- cime_config/config_component_cesm.xml | 31 --------------------------- cime_config/runseq/driver_config.py | 3 ++- cime_config/runseq/runseq_general.py | 12 ++++++++--- mediator/med_phases_prep_ocn_mod.F90 | 8 ++++++- 4 files changed, 18 insertions(+), 36 deletions(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index cfcdc12ef..048a90598 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -466,37 +466,6 @@ - - char - none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,date,end - never - - nmonths - - med_history - env_run.xml - Sets mediator average history file frequency (like REST_OPTION) - - - char - - -999 - - 1 - - med_history - env_run.xml - Sets mediator average history file frequency (like REST_N) - - - integer - - -999 - med_history - env_run.xml - yyyymmdd format, sets mediator average history date (like REST_DATE) - - logical TRUE,FALSE diff --git a/cime_config/runseq/driver_config.py b/cime_config/runseq/driver_config.py index e5fe2715d..9694c7503 100644 --- a/cime_config/runseq/driver_config.py +++ b/cime_config/runseq/driver_config.py @@ -132,7 +132,8 @@ def __compute_ocn(self, case, coupling_times): # TODO: check of data model prognostic flag is on - this is a new xml variable # If the prognostic flag is on, then should set med_to_wav to True docn_mode = case.get_value("DOCN_MODE") - med_to_ocn = ('som' in docn_mode or 'interannual' in docn_mode) + docn_import_fields = case.get_value("DOCN_IMPORT_FIELDS") + med_to_ocn = ('som' in docn_mode or 'interannual' in docn_mode or docn_import_fields != 'none') return (run_ocn, med_to_ocn, coupling_times["ocn_cpl_dt"]) diff --git a/cime_config/runseq/runseq_general.py b/cime_config/runseq/runseq_general.py index 2b7f0cc0a..ddbfca598 100644 --- a/cime_config/runseq/runseq_general.py +++ b/cime_config/runseq/runseq_general.py @@ -94,7 +94,7 @@ def gen_runseq(case, coupling_times): runseq.add_action("MED med_phases_aofluxes_run" , run_ocn and run_atm and (med_to_ocn or med_to_atm)) runseq.add_action("MED med_phases_prep_ocn_accum" , med_to_ocn) runseq.add_action("MED med_phases_ocnalb_run" , (run_ocn and run_atm and (med_to_ocn or med_to_atm)) and not xcompset) - runseq.add_action("MED med_phases_diag_ocn" , run_ocn and diag_mode) + runseq.add_action("MED med_phases_diag_ocn" , run_ocn and diag_mode) if (cpl_seq_option == 'OPTION1'): if ocn_cpl_time != atm_cpl_time: @@ -104,11 +104,17 @@ def gen_runseq(case, coupling_times): if ocn_cpl_time != atm_cpl_time: runseq.leave_time_loop(inner_loop, addextra_atsign=True) + if (cpl_seq_option == 'TIGHT'): + runseq.add_action("MED med_phases_aofluxes_run" , med_to_ocn) + runseq.add_action("MED med_phases_prep_ocn_accum" , med_to_ocn) + runseq.add_action("MED med_phases_prep_ocn_avg" , med_to_ocn and ocn_outer_loop) + runseq.add_action("MED -> OCN :remapMethod=redist", med_to_ocn and ocn_outer_loop) + runseq.add_action("MED med_phases_prep_lnd" , med_to_lnd) runseq.add_action("MED -> LND :remapMethod=redist" , med_to_lnd) - runseq.add_action("MED med_phases_prep_ice" , med_to_ice) - runseq.add_action("MED -> ICE :remapMethod=redist" , med_to_ice) + runseq.add_action("MED med_phases_prep_ice" , med_to_ice) + runseq.add_action("MED -> ICE :remapMethod=redist" , med_to_ice) runseq.add_action("MED med_phases_prep_wav_accum" , med_to_wav) runseq.add_action("MED med_phases_prep_wav_avg" , med_to_wav) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index b8b4f2fa6..9bae344c9 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -372,7 +372,6 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) rc = ESMF_SUCCESS - call t_startf('MED:'//subname) if (dbug_flag > 20) then call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) end if @@ -383,6 +382,13 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check that the necessary export field is present + if ( .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then + return + end if + + call t_startf('MED:'//subname) + !--------------------------------------- ! Compute netsw for ocean !--------------------------------------- From 70d6913d13016eac07f1055ffe7c00509d474ca6 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 31 Jan 2023 06:03:39 -0700 Subject: [PATCH 258/395] added new auxiliary stream for ocn2med --- cime_config/namelist_definition_drv.xml | 65 +++++++++++++++++++++++++ 1 file changed, 65 insertions(+) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index e35ff537d..0117f99a0 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1765,6 +1765,71 @@ + + + logical + aux_hist + MED_attributes + Auxiliary mediator ocn2med average history output every day. + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary mediator ocn2med average history output every day. + + So_bldepth:So_t:So_u:So_v + + + + char + aux_hist + MED_attributes + history option type + + ndays + + + + char + aux_hist + MED_attributes + history option type + + 1 + + + + logical + aux_hist + MED_attributes + If true, use time average for aux file output. + + .true. + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + ocn.24h.avg + + + + integer + aux_hist + MED_attributes + Number of time sames per file. + + 30 + + + char time From a0178b2b7dc12994b90cd3cf639e5b2e9cec337b Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 1 Feb 2023 13:29:51 -0700 Subject: [PATCH 259/395] fix the multi instance initialization --- cesm/driver/ensemble_driver.F90 | 197 ++++++++++++------------ cesm/driver/esm.F90 | 11 +- cesm/nuopc_cap_share/driver_pio_mod.F90 | 17 +- 3 files changed, 121 insertions(+), 104 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 1e91236ca..20f87c151 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -7,7 +7,7 @@ module Ensemble_driver ! esm driver and its components layed out concurently across mpi tasks. !----------------------------------------------------------------------------- - use shr_kind_mod , only : cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_kind_mod , only : cl=>shr_kind_cl, cs=>shr_kind_cs, cx=>shr_kind_cx use shr_log_mod , only : shr_log_setLogUnit use esm_utils_mod , only : maintask, logunit, chkerr @@ -145,10 +145,10 @@ subroutine SetModelServices(ensemble_driver, rc) integer :: pio_asyncio_stride integer :: pio_asyncio_rootpe integer :: Global_Comm - character(CL) :: start_type ! Type of startup + character(len=CL) :: start_type ! Type of startup character(len=7) :: drvrinst character(len=5) :: inst_suffix - character(len=CL) :: msgstr + character(len=CX) :: msgstr character(len=CL) :: cvalue character(len=CL) :: calendar character(len=*) , parameter :: start_type_start = "startup" @@ -272,106 +272,114 @@ subroutine SetModelServices(ensemble_driver, rc) ! here we assume that pio_asyncio_stride and pio_asyncio_ntasks are only set ! if asyncio is enabled. ! - inst = localPet/(ntasks_per_member+pio_asyncio_ntasks) + 1 - - petcnt=1 - iopetcnt = 1 - comp_task = .false. - asyncio_task = .false. - ! Determine pet list for driver instance - if(pio_asyncio_ntasks > 0) then - do n=pio_asyncio_rootpe,pio_asyncio_rootpe+pio_asyncio_stride*(pio_asyncio_ntasks-1),pio_asyncio_stride - asyncio_petlist(iopetcnt) = (inst-1)*(ntasks_per_member+pio_asyncio_ntasks) + n - if(asyncio_petlist(iopetcnt) == localPet) asyncio_task = .true. - iopetcnt = iopetcnt+1 - enddo + logunit = 6 + do inst=1,number_of_members + petcnt=1 iopetcnt = 1 - endif - do n=0,ntasks_per_member+pio_asyncio_ntasks-1 + comp_task = .false. + asyncio_task = .false. + ! Determine pet list for driver instance if(pio_asyncio_ntasks > 0) then - if( asyncio_petlist(iopetcnt)==(inst-1)*(ntasks_per_member+pio_asyncio_ntasks) + n) then - ! Here if asyncio is true and this is an io task + do n=pio_asyncio_rootpe,pio_asyncio_rootpe+pio_asyncio_stride*(pio_asyncio_ntasks-1),pio_asyncio_stride + asyncio_petlist(iopetcnt) = (inst-1)*(ntasks_per_member+pio_asyncio_ntasks) + n + if(asyncio_petlist(iopetcnt) == localPet) asyncio_task = .true. iopetcnt = iopetcnt+1 - else if(petcnt <= ntasks_per_member) then - ! Here if this is a compute task - petList(petcnt) = n + (inst-1)*(ntasks_per_member + pio_asyncio_ntasks) - if (petList(petcnt) == localPet) then - comp_task=.true. + enddo + iopetcnt = 1 + endif + do n=0,ntasks_per_member+pio_asyncio_ntasks-1 + if(pio_asyncio_ntasks > 0) then + if( asyncio_petlist(iopetcnt)==(inst-1)*(ntasks_per_member+pio_asyncio_ntasks) + n) then + ! Here if asyncio is true and this is an io task + iopetcnt = iopetcnt+1 + else if(petcnt <= ntasks_per_member) then + ! Here if this is a compute task + petList(petcnt) = n + (inst-1)*(ntasks_per_member + pio_asyncio_ntasks) + if (petList(petcnt) == localPet) then + comp_task=.true. + endif + petcnt = petcnt+1 + else + msgstr = "ERROR task cannot be neither a compute task nor an asyncio task" + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out endif - petcnt = petcnt+1 else - msgstr = "ERROR task cannot be neither a compute task nor an asyncio task" + ! Here if asyncio is false + petList(petcnt) = (inst-1)*ntasks_per_member + n + if (petList(petcnt) == localPet) comp_task=.true. + petcnt = petcnt+1 + endif + enddo + if(inst == localPet/(ntasks_per_member+pio_asyncio_ntasks) + 1) then + if(comp_task .and. asyncio_task) then + write(msgstr,*) "ERROR task cannot be both a compute task and an asyncio task", inst, petlist + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + elseif (.not. comp_task .and. .not. asyncio_task) then + write(msgstr,*) "ERROR task is nether a compute task nor an asyncio task", inst, petlist call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return ! bail out endif - else - ! Here if asyncio is false - petList(petcnt) = (inst-1)*ntasks_per_member + n - if (petList(petcnt) == localPet) comp_task=.true. - petcnt = petcnt+1 endif - enddo - if(comp_task .and. asyncio_task) then - msgstr = "ERROR task cannot be both a compute task and an asyncio task" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - elseif (.not. comp_task .and. .not. asyncio_task) then - msgstr = "ERROR task is nether a compute task nor an asyncio task" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - ! Add driver instance to ensemble driver - write(drvrinst,'(a,i4.4)') "ESM",inst + ! Add driver instance to ensemble driver + write(drvrinst,'(a,i4.4)') "ESM",inst - call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=driver, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write(msgstr, *) ": driver added on PETS ",petlist(1),' to ',petlist(petcnt-1) - call ESMF_LogWrite(trim(subname)//msgstr) - - maintask = .false. - if (comp_task) then - if(number_of_members > 1) then - call NUOPC_CompAttributeAdd(driver, attrList=(/'inst_suffix'/), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write(inst_suffix,'(a,i4.4)') '_',inst - call NUOPC_CompAttributeSet(driver, name='inst_suffix', value=inst_suffix, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - inst_suffix = '' - endif - - ! Set the driver instance attributes - call NUOPC_CompAttributeAdd(driver, attrList=(/'read_restart'/), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(read_restart_string), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ReadAttributes(driver, config, "CLOCK_attributes::", rc=rc) + call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=driver, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ReadAttributes(driver, config, "DRIVER_attributes::", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ReadAttributes(driver, config, "DRV_modelio::", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - + write(msgstr, *) ": driver added on PETS ",petlist(1),' to ',petlist(petcnt-1), comp_task, asyncio_task + call ESMF_LogWrite(trim(subname)//msgstr) ! Set the driver log to the driver task 0 - - if (localPet == petList(1)) then - call NUOPC_CompAttributeGet(driver, name="diro", value=diro, rc=rc) + if (comp_task) then + if(number_of_members > 1) then + call NUOPC_CompAttributeAdd(driver, attrList=(/'inst_suffix'/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(inst_suffix,'(a,i4.4)') '_',inst + call NUOPC_CompAttributeSet(driver, name='inst_suffix', value=inst_suffix, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + inst_suffix = '' + endif + + ! Set the driver instance attributes + call NUOPC_CompAttributeAdd(driver, attrList=(/'read_restart'/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(read_restart_string), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(driver, config, "CLOCK_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(driver, name="logfile", value=logfile, rc=rc) + + call ReadAttributes(driver, config, "DRIVER_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - open (newunit=logunit,file=trim(diro)//"/"//trim(logfile)) - maintask = .true. - else - logUnit = 6 + + call ReadAttributes(driver, config, "DRV_modelio::", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(msgStr, *) trim(subname), ' instance = ',inst, 'attributes read' + call ESMF_LogWrite(msgStr) + if (localPet == petList(1)) then + call NUOPC_CompAttributeGet(driver, name="diro", value=diro, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(driver, name="logfile", value=logfile, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Multiinstance logfile name needs a correction + if(len_trim(inst_suffix) > 0) then + n = index(logfile, '.') + logfile = logfile(1:n-1)//trim(inst_suffix)//logfile(n:) + endif + open (newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + maintask = .true. + endif + endif call shr_log_setLogUnit (logunit) - endif - ! Create a clock for each driver instance - call esm_time_clockInit(ensemble_driver, driver, logunit, maintask, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Create a clock for each driver instance + + call esm_time_clockInit(ensemble_driver, driver, logunit, maintask, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + enddo + inst = localPet/(ntasks_per_member+pio_asyncio_ntasks) + 1 deallocate(petList) call t_stopf(subname) @@ -400,6 +408,8 @@ subroutine InitializeIO(ensemble_driver, rc) integer :: drv integer :: PetCount integer :: key, color, i + type(ESMF_GridComp) :: driver + character(len=7) :: drvrinst character(len=8) :: compname rc = ESMF_SUCCESS @@ -422,22 +432,19 @@ subroutine InitializeIO(ensemble_driver, rc) else Instance_Comm = Global_Comm endif - nullify(dcomp) - call NUOPC_DriverGetComp(ensemble_driver, complist=dcomp, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompGet(dcomp(1), name=compname, rc=rc) + write(drvrinst,'(a,i4.4)') "ESM",inst + call NUOPC_DriverGetComp(ensemble_driver, drvrinst, comp=driver, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": call driver_pio_init "//compname, ESMF_LOGMSG_INFO) - call driver_pio_init(dcomp(1), rc=rc) + call driver_pio_init(driver, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//": call driver_pio_component_init "//compname, ESMF_LOGMSG_INFO) - call driver_pio_component_init(dcomp(1), Instance_Comm, asyncio_petlist, rc) + call driver_pio_component_init(driver, Instance_Comm, asyncio_petlist, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//": driver_pio_component_init done "//compname, ESMF_LOGMSG_INFO) - deallocate(dcomp) deallocate(asyncio_petlist) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine InitializeIO diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index 02970d31e..a98976f21 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -610,14 +610,14 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n character(len=*) , intent(in) :: inst_suffix integer , intent(in) :: nthrds integer , intent(inout) :: rc - ! local variables integer :: inst_index + logical :: computetask character(len=CL) :: cvalue character(len=CS) :: attribute character(len=*), parameter :: subname = "(esm.F90:AddAttributes)" !------------------------------------------- - + computetask = .false. rc = ESMF_Success call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) call shr_log_setLogunit(logunit) @@ -635,6 +635,10 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n ! Add driver restart flag to gcomp attributes !------ attribute = 'read_restart' + call NUOPC_CompAttributeGet(driver, name=trim(attribute), isPresent=computetask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if(.not. computetask) return + call NUOPC_CompAttributeGet(driver, name=trim(attribute), value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeAdd(gcomp, (/trim(attribute)/), rc=rc) @@ -649,6 +653,9 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n if (chkerr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(gcomp, config, "ALLCOMP_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": call Readattributes for"//trim(compname), ESMF_LOGMSG_INFO) + call ReadAttributes(gcomp, config, trim(compname)//"_modelio::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) then print *,__FILE__,__LINE__,"ERROR reading ",trim(compname)," modelio from runconfig" diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index ef92bb47a..710373ed9 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -173,7 +173,7 @@ subroutine driver_pio_init(driver, rc) end subroutine driver_pio_init - subroutine driver_pio_component_init(driver, Inst_comm, asyncio_petlist, rc) + subroutine driver_pio_component_init(driver, inst_comm, asyncio_petlist, rc) use ESMF, only : ESMF_GridComp, ESMF_LogSetError, ESMF_RC_NOT_VALID, ESMF_GridCompIsCreated, ESMF_VM, ESMF_VMGet use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated, ESMF_Finalize, ESMF_PtrInt1D use ESMF, only : ESMF_LOGMSG_INFO, ESMF_LOGWRITE @@ -182,8 +182,8 @@ subroutine driver_pio_component_init(driver, Inst_comm, asyncio_petlist, rc) use mpi, only : MPI_INTEGER, MPI_MAX, MPI_IN_PLACE, MPI_LOR, MPI_LOGICAL type(ESMF_GridComp) :: driver - integer, intent(in) :: Inst_comm ! The communicator associated with the ensemble_driver integer, intent(in) :: asyncio_petlist(:) + integer, intent(in) :: Inst_comm ! The communicator associated with the driver integer, intent(out) :: rc type(ESMF_VM) :: vm @@ -195,6 +195,7 @@ subroutine driver_pio_component_init(driver, Inst_comm, asyncio_petlist, rc) integer, allocatable :: io_proc_list(:), asyncio_tasks(:), comp_proc_list(:,:) type(ESMF_GridComp), pointer :: gcomp(:) + character(CS) :: cval character(CS) :: msgstr integer :: do_async_init @@ -221,30 +222,32 @@ subroutine driver_pio_component_init(driver, Inst_comm, asyncio_petlist, rc) asyncio_ntasks = size(asyncio_petlist) call shr_log_getLogUnit(logunit) - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call MPI_Comm_rank(Inst_comm, myid, rc) call MPI_Comm_size(Inst_comm, totalpes, rc) + asyncio_task=.false. do i=1,asyncio_ntasks ! asyncio_petlist is in - if(modulo(asyncio_petlist(i), totalpes) == myid) then + if(asyncio_petlist(i) == myid) then asyncio_task = .true. exit endif enddo + write(msgstr,*) 'asyncio_task = ', asyncio_task, myid, asyncio_petlist + call ESMF_LogWrite(trim(subname)//msgstr, ESMF_LOGMSG_INFO, rc=rc) nullify(gcomp) nullify(petLists) if (.not. asyncio_task) then call ESMF_GridCompGet(gridcomp=driver, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_DriverGetComp(driver, compList=gcomp, petLists=petLists, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=driver_myid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_DriverGetComp(driver, compList=gcomp, petLists=petLists, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return endif if(associated(gcomp)) then total_comps = size(gcomp) From 3a218b88e59fade15a87f709e36192b9f080c9bd Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 2 Feb 2023 17:06:56 -0700 Subject: [PATCH 260/395] make xgrid default, handle main task for multidriver cases in esm_time_clockinit --- cesm/driver/ensemble_driver.F90 | 2 +- cime_config/namelist_definition_drv.xml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 20f87c151..c79fade40 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -375,7 +375,7 @@ subroutine SetModelServices(ensemble_driver, rc) call shr_log_setLogUnit (logunit) ! Create a clock for each driver instance - call esm_time_clockInit(ensemble_driver, driver, logunit, maintask, rc) + call esm_time_clockInit(ensemble_driver, driver, logunit, localpet==petList(1), rc) if (chkerr(rc,__LINE__,u_FILE_u)) return enddo diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 8bc022f22..9b1e997ce 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -927,7 +927,7 @@ default: xgrid - ogrid + xgrid From 24522e3870f50f10fdfd880c0dcf3eebe5ffb2e5 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 24 Jun 2022 16:38:57 -0600 Subject: [PATCH 261/395] changes for lightning coupling new file: cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 modified: cime_config/namelist_definition_drv_flds.xml modified: mediator/esmFldsExchange_cesm_mod.F90 modified: mediator/fd_cesm.yaml --- .../shr_lightning_coupling_mod.F90 | 104 ++++++++++++++++++ cime_config/namelist_definition_drv_flds.xml | 15 ++- mediator/esmFldsExchange_cesm_mod.F90 | 13 +++ mediator/fd_cesm.yaml | 6 +- 4 files changed, 136 insertions(+), 2 deletions(-) create mode 100644 cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 diff --git a/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 b/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 new file mode 100644 index 000000000..dc8be2e5e --- /dev/null +++ b/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 @@ -0,0 +1,104 @@ +module shr_lightning_coupling_mod + + !======================================================================== + ! Module for handling namelist variables related to lightning coupling + !======================================================================== + + 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 : s_logunit => shr_log_Unit + 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_lightning_coupling_readnl ! Read namelist + + character(len=*), parameter :: & + u_FILE_u=__FILE__ + + !==================================================================================== +CONTAINS + !==================================================================================== + + subroutine shr_lightning_coupling_readnl(NLFilename, atm_lightning_flash_out) + + !======================================================================== + ! reads lightning_coupling_nl namelist and returns a variable specifying + ! if atmosphere model provides lightning flash frequency field to mediator + !======================================================================== + + ! input/output variables + character(len=*), intent(in) :: NLFilename ! Namelist filename + logical, intent(out) :: atm_lightning_flash_out ! if TRUE atm will provide lightning flash frequency + + !----- local ----- + logical :: atm_lightning_flash_freq + type(ESMF_VM) :: vm + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not + integer :: rc + integer :: localpet + integer :: mpicom + + character(len=*), parameter :: atm_ozone_frequency_not_present = 'NOT_PRESENT' + character(len=*), parameter :: subname = '(shr_lightning_coupling_readnl) ' + ! ------------------------------------------------------------------ + + namelist /lightning_coupling_nl/ atm_lightning_flash_freq + + 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 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 + ! ------------------------------------------------------------------------ + ! Set default values in case namelist file doesn't exist, lightning_coupling_nl group + ! doesn't exist within the file, or a given variable isn't present in the namelist + ! group in the file. + ! ------------------------------------------------------------------------ + atm_lightning_flash_freq = .false. + + ! ------------------------------------------------------------------------ + ! Read namelist file + ! ------------------------------------------------------------------------ + inquire( file=trim(NLFileName), exist=exists) + if ( exists ) then + open(newunit=unitn, file=trim(NLFilename), status='old' ) + write(s_logunit,'(a)') subname,'Read in lightning_coupling_nl namelist from: ', trim(NLFilename) + call shr_nl_find_group_name(unitn, 'lightning_coupling_nl', ierr) + if (ierr == 0) then + ! Note that ierr /= 0 means no namelist is present. + read(unitn, lightning_coupling_nl, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort(subname//'problem reading lightning_coupling_nl') + end if + end if + close( unitn ) + end if + + atm_lightning_flash_out = atm_lightning_flash_freq + + end if + + ! ------------------------------------------------------------------------ + ! Broadcast values to all processors + ! ------------------------------------------------------------------------ + call shr_mpi_bcast(atm_lightning_flash_out, mpicom) + + end subroutine shr_lightning_coupling_readnl + +end module shr_lightning_coupling_mod diff --git a/cime_config/namelist_definition_drv_flds.xml b/cime_config/namelist_definition_drv_flds.xml index b8d96bcd6..119921118 100644 --- a/cime_config/namelist_definition_drv_flds.xml +++ b/cime_config/namelist_definition_drv_flds.xml @@ -142,7 +142,7 @@ - + @@ -157,4 +157,17 @@ + + + + + + logical + lightning_coupling + lightning_coupling_nl + + If TRUE atmosphere model will provide prognosed lightning flash frequency. + + + diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index ae3627491..4b9d46dfc 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -399,6 +399,19 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if ! --------------------------------------------------------------------- + ! to lnd: lightning flash frequency from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_lght') + call addfld(fldListTo(complnd)%flds, 'Sa_lght') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_lght', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_lght', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_lght', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Sa_lght', mrg_from=compatm, mrg_fld='Sa_lght', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to lnd: temperature at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 648a4fed2..b29e01b8d 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -325,6 +325,10 @@ canonical_units: mol/mol description: atmosphere export - O3 in the lowest model layer (prognosed or prescribed) # + - standard_name: Sa_lght + canonical_units: /min + description: atmosphere export - lightning flash freqency + # - standard_name: Sa_topo alias: inst_surface_height canonical_units: m @@ -745,7 +749,7 @@ description: sea-ice export - ice thickness # - standard_name: Si_floediam - canonical_units: m + canonical_units: m description: sea-ice export - ice floe diameter # #----------------------------------- From 62c15cd757e9312b68442a4c4aa0e21d7878cece Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 13 Jul 2022 15:46:50 -0600 Subject: [PATCH 262/395] Changed "atm_lightning_flash_freq" to "atm_provides_lightning" modified: cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 modified: cime_config/namelist_definition_drv_flds.xml --- .../nuopc_cap_share/shr_lightning_coupling_mod.F90 | 14 +++++++------- cime_config/namelist_definition_drv_flds.xml | 4 ++-- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 b/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 index dc8be2e5e..06effa52a 100644 --- a/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 +++ b/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 @@ -24,7 +24,7 @@ module shr_lightning_coupling_mod CONTAINS !==================================================================================== - subroutine shr_lightning_coupling_readnl(NLFilename, atm_lightning_flash_out) + subroutine shr_lightning_coupling_readnl(NLFilename, atm_provides_lightning_out) !======================================================================== ! reads lightning_coupling_nl namelist and returns a variable specifying @@ -33,10 +33,10 @@ subroutine shr_lightning_coupling_readnl(NLFilename, atm_lightning_flash_out) ! input/output variables character(len=*), intent(in) :: NLFilename ! Namelist filename - logical, intent(out) :: atm_lightning_flash_out ! if TRUE atm will provide lightning flash frequency + logical, intent(out) :: atm_provides_lightning_out ! if TRUE atm will provide lightning flash frequency !----- local ----- - logical :: atm_lightning_flash_freq + logical :: atm_provides_lightning type(ESMF_VM) :: vm integer :: unitn ! namelist unit number integer :: ierr ! error code @@ -49,7 +49,7 @@ subroutine shr_lightning_coupling_readnl(NLFilename, atm_lightning_flash_out) character(len=*), parameter :: subname = '(shr_lightning_coupling_readnl) ' ! ------------------------------------------------------------------ - namelist /lightning_coupling_nl/ atm_lightning_flash_freq + namelist /lightning_coupling_nl/ atm_provides_lightning rc = ESMF_SUCCESS @@ -70,7 +70,7 @@ subroutine shr_lightning_coupling_readnl(NLFilename, atm_lightning_flash_out) ! doesn't exist within the file, or a given variable isn't present in the namelist ! group in the file. ! ------------------------------------------------------------------------ - atm_lightning_flash_freq = .false. + atm_provides_lightning = .false. ! ------------------------------------------------------------------------ ! Read namelist file @@ -90,14 +90,14 @@ subroutine shr_lightning_coupling_readnl(NLFilename, atm_lightning_flash_out) close( unitn ) end if - atm_lightning_flash_out = atm_lightning_flash_freq + atm_provides_lightning_out = atm_provides_lightning end if ! ------------------------------------------------------------------------ ! Broadcast values to all processors ! ------------------------------------------------------------------------ - call shr_mpi_bcast(atm_lightning_flash_out, mpicom) + call shr_mpi_bcast(atm_provides_lightning_out, mpicom) end subroutine shr_lightning_coupling_readnl diff --git a/cime_config/namelist_definition_drv_flds.xml b/cime_config/namelist_definition_drv_flds.xml index 119921118..7b33564da 100644 --- a/cime_config/namelist_definition_drv_flds.xml +++ b/cime_config/namelist_definition_drv_flds.xml @@ -161,12 +161,12 @@ - + logical lightning_coupling lightning_coupling_nl - If TRUE atmosphere model will provide prognosed lightning flash frequency. + If TRUE atmosphere model will provide prognosed lightning flash frequency (flashes per minute). From 6712c8c6eb94b212800b3f8c7f41ad123f297ae2 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 22 Jul 2022 15:20:17 -0600 Subject: [PATCH 263/395] rename Sa_lght as Sa_lightning modified: cime_config/namelist_definition_drv_flds.xml modified: mediator/esmFldsExchange_cesm_mod.F90 modified: mediator/fd_cesm.yaml --- cime_config/namelist_definition_drv_flds.xml | 2 +- mediator/esmFldsExchange_cesm_mod.F90 | 12 ++++++------ mediator/fd_cesm.yaml | 2 +- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/cime_config/namelist_definition_drv_flds.xml b/cime_config/namelist_definition_drv_flds.xml index 7b33564da..03b6b7c6d 100644 --- a/cime_config/namelist_definition_drv_flds.xml +++ b/cime_config/namelist_definition_drv_flds.xml @@ -158,7 +158,7 @@ - + diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 4b9d46dfc..2c2a3e4bd 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -402,13 +402,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: lightning flash frequency from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_lght') - call addfld(fldListTo(complnd)%flds, 'Sa_lght') + call addfld(fldListFr(compatm)%flds, 'Sa_lightning') + call addfld(fldListTo(complnd)%flds, 'Sa_lightning') else - if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_lght', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_lght', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_lght', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Sa_lght', mrg_from=compatm, mrg_fld='Sa_lght', mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_lightning', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_lightning', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_lightning', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Sa_lightning', mrg_from=compatm, mrg_fld='Sa_lightning', mrg_type='copy') end if end if ! --------------------------------------------------------------------- diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index b29e01b8d..fcaeab358 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -325,7 +325,7 @@ canonical_units: mol/mol description: atmosphere export - O3 in the lowest model layer (prognosed or prescribed) # - - standard_name: Sa_lght + - standard_name: Sa_lightning canonical_units: /min description: atmosphere export - lightning flash freqency # From c8ed0186457a7249a484e8b6945d3ad145f2317d Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 2 Feb 2023 22:18:12 -0700 Subject: [PATCH 264/395] update to cmeps0.14.10 --- cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 | 6 +++--- mediator/esmFldsExchange_cesm_mod.F90 | 10 +++++----- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 b/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 index 06effa52a..e84ccc661 100644 --- a/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 +++ b/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 @@ -7,7 +7,7 @@ module shr_lightning_coupling_mod 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 : s_logunit => shr_log_Unit + use shr_log_mod , only : shr_log_getLogUnit use shr_nl_mod , only : shr_nl_find_group_name use shr_mpi_mod , only : shr_mpi_bcast @@ -44,7 +44,7 @@ subroutine shr_lightning_coupling_readnl(NLFilename, atm_provides_lightning_out) integer :: rc integer :: localpet integer :: mpicom - + integer :: s_logunit character(len=*), parameter :: atm_ozone_frequency_not_present = 'NOT_PRESENT' character(len=*), parameter :: subname = '(shr_lightning_coupling_readnl) ' ! ------------------------------------------------------------------ @@ -57,7 +57,7 @@ subroutine shr_lightning_coupling_readnl(NLFilename, atm_provides_lightning_out) if ( len_trim(NLFilename) == 0 ) then call shr_sys_abort( subname//'ERROR: nlfilename not set' ) end if - + call shr_log_getLogUnit(s_logunit) call ESMF_VMGetCurrent(vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 2c2a3e4bd..ac9eef39a 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -399,16 +399,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if ! --------------------------------------------------------------------- - ! to lnd: lightning flash frequency from atm + ! to lnd: cld to grnd lightning flash freq ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_lightning') - call addfld(fldListTo(complnd)%flds, 'Sa_lightning') + call addfld_from(compatm, 'Sa_lightning') + call addfld_to(complnd, 'Sa_lightning') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_lightning', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_lightning', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_lightning', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Sa_lightning', mrg_from=compatm, mrg_fld='Sa_lightning', mrg_type='copy') + call addmap_from(compatm, 'Sa_lightning', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Sa_lightning', mrg_from=compatm, mrg_fld='Sa_lightning', mrg_type='copy') end if end if ! --------------------------------------------------------------------- From 895e623e3c0b12f838c4d64b3882676dae62cb38 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 16 Mar 2023 07:02:14 -0600 Subject: [PATCH 265/395] Revert default aoflux_grid to ogrid xgrid was causing restart problems; revert this until we can solve those problems --- cime_config/namelist_definition_drv.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 57baa9229..b699ea98a 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -924,10 +924,10 @@ ogrid,agrid,xgrid Grid for atm ocn flux calc - default: xgrid + default: ogrid - xgrid + ogrid From 7ff0d3b063ba1e825ba0f22fe111fb716a093fe8 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 22 Mar 2023 13:44:26 -0600 Subject: [PATCH 266/395] Remove unnecessary deallocate fieldNameList is not always allocated. We could wrap the deallocate in a conditional, but since allocatable arrays are automatically deallocated upon leaving a subroutine, this deallocate statement is unnecessary. --- mediator/med_io_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 69d1891fb..97db9bcc0 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -1140,7 +1140,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & call pio_syncfile(io_file(lfile_ind)) call pio_freedecomp(io_file(lfile_ind), iodesc) endif - deallocate(fieldNameList) deallocate(ownedElemCoords, ownedElemCoords_x, ownedElemCoords_y) if (dbug_flag > 5) then From 18e5075201d10229c87234e48fa9875c1ddc9354 Mon Sep 17 00:00:00 2001 From: Jian Sun Date: Wed, 22 Mar 2023 21:56:04 -0600 Subject: [PATCH 267/395] Add Jim's changes for new GPU options based on his branch: https://github.com/jedwards4b/CMEPS/compare/ff8726f..79d6fa7 modified: cime_config/config_component.xml --- cime_config/config_component.xml | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 7f9bac96e..cadc8a433 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -784,6 +784,24 @@ If TRUE, the component libraries are always built with OpenMP capability. + + char + none, v100, a100, mi250 + none + build_def + env_build.xml + If set will compile and submit with this gpu type enabled + + + + char + none, openacc, openmp, combined + none + build_def + env_build.xml + If set will compile and submit with this gpu offload method enabled + + logical TRUE,FALSE From ebb0818566e23a99e14c3d59aff19cbaaf2e1f90 Mon Sep 17 00:00:00 2001 From: Jian Sun Date: Wed, 22 Mar 2023 22:03:18 -0600 Subject: [PATCH 268/395] Add MAX_CPUTASKS_PER_GPU_NODE XML variable Update nvhpc compiler for GPU settings Remove PGI compiler modified: cime_config/config_component.xml --- cime_config/config_component.xml | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index cadc8a433..abff72296 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -1897,12 +1897,22 @@ pes or cores per node for accounting purposes + + integer + 0 + + 1 + + mach_pes_last + env_mach_pes.xml + Number of CPU cores per GPU node used for simulation + + integer 0 - 1 - 1 + 1 mach_pes env_mach_pes.xml From 72c123099cc4a8f255af4c07eb0dc26984a02340 Mon Sep 17 00:00:00 2001 From: Jian Sun Date: Fri, 24 Mar 2023 14:44:22 -0600 Subject: [PATCH 269/395] Remove default_values and valid_values for GPU_TYPE and GPU_OFFLOAD so that they could assign multiple values to the config_machines.xml file modified: cime_config/config_component.xml --- cime_config/config_component.xml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index abff72296..48e86f88c 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -786,8 +786,8 @@ char - none, v100, a100, mi250 - none + + build_def env_build.xml If set will compile and submit with this gpu type enabled @@ -795,8 +795,8 @@ char - none, openacc, openmp, combined - none + + build_def env_build.xml If set will compile and submit with this gpu offload method enabled From 5bb31fea49e4939613e483dba94d156b2bcfaf31 Mon Sep 17 00:00:00 2001 From: Michael Levy Date: Tue, 28 Mar 2023 09:59:47 -0600 Subject: [PATCH 270/395] Send nitrogen deposition from atm to ocn --- mediator/esmFldsExchange_cesm_mod.F90 | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 149c7791d..9b8f7b1e1 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1963,6 +1963,21 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if + ! --------------------------------------------------------------------- + ! to ocn: nitrogen deposition fields from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_to(compocn, 'Faxa_ndep') + call addfld_from(compatm, 'Faxa_ndep') + else + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_ndep', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_ndep', rc=rc)) then + call addmap_from(compatm, 'Faxa_ndep', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Faxa_ndep', & + mrg_from=compatm, mrg_fld='Faxa_ndep', mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + end if + ! --------------------------------------------------------------------- ! to ocn: enthalpy from atm rain, snow, evaporation ! to ocn: enthalpy from liquid and ice river runoff From 6cfd189087cfa10aaf5d2bb581eeb5b6ef3e5bb7 Mon Sep 17 00:00:00 2001 From: Michael Levy Date: Tue, 28 Mar 2023 10:08:15 -0600 Subject: [PATCH 271/395] Clean up comments There was already a comment claiming nitrogen deposition was being passed, so all I needed to add were the actual addfld_to(), addfld_from(), addmap_from(), and addmrg_to() calls. --- mediator/esmFldsExchange_cesm_mod.F90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 9b8f7b1e1..97729b63c 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1962,10 +1962,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=compatm, mrg_fld='Faxa_dstdry', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if - - ! --------------------------------------------------------------------- - ! to ocn: nitrogen deposition fields from atm - ! --------------------------------------------------------------------- if (phase == 'advertise') then call addfld_to(compocn, 'Faxa_ndep') call addfld_from(compatm, 'Faxa_ndep') From 5476eaa402327b3d42e17a0e420d3be19f92fc4e Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 29 Mar 2023 10:47:46 -0600 Subject: [PATCH 272/395] A fix for #346 so that LND2ROF_FMAPNAME will be used --- cime_config/namelist_definition_drv.xml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index e35ff537d..6a5de628d 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2055,25 +2055,25 @@ idmap - + char mapping abs MED_attributes - lnd to rof mapping, 'unset' or 'idmap' are normal possible values + lnd to rof mapping, 'unset' or 'idmap' are normal possible values (mapping file given for mizuRoute grids) - unset + $LND2ROF_FMAPNAME idmap - + char mapping abs MED_attributes - rof to lnd mapping, 'unset' or 'idmap' are normal possible values + rof to lnd mapping, 'unset' or 'idmap' are normal possible values (mapping file given for mizuRoute grids) - unset + $ROF2LND_FMAPNAME idmap From c3e8e2335e658f3227ed103366ff20ec9763ff18 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 5 Apr 2023 09:53:22 -0600 Subject: [PATCH 273/395] replace aux_cam with aux_cmeps in testlist --- cime_config/testdefs/testlist_drv.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index ec86e5989..985bd6ce9 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -189,7 +189,7 @@ - + From 805d252f6f6c9590739ad2f10d7ad809e1076347 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 5 Apr 2023 15:59:46 -0600 Subject: [PATCH 274/395] using copy_with_weights causes weights to be applied twice --- mediator/esmFldsExchange_cesm_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 97729b63c..ad98ae684 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1970,7 +1970,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_ndep', rc=rc)) then call addmap_from(compatm, 'Faxa_ndep', compocn, mapconsf, 'one', atm2ocn_map) call addmrg_to(compocn, 'Faxa_ndep', & - mrg_from=compatm, mrg_fld='Faxa_ndep', mrg_type='copy_with_weights', mrg_fracname='ofrac') + mrg_from=compatm, mrg_fld='Faxa_ndep', mrg_type='copy') end if end if From ac4d591489f2a0039521faa138002d942a2c7e15 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 7 Apr 2023 11:40:17 -0600 Subject: [PATCH 275/395] use updated error check and broadcast methods modified: cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 --- .../shr_lightning_coupling_mod.F90 | 22 +++++++++++++------ 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 b/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 index e84ccc661..3b4e260d8 100644 --- a/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 +++ b/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 @@ -5,11 +5,12 @@ module shr_lightning_coupling_mod !======================================================================== use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet - use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS + use ESMF , only : ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS + use ESMF , only : ESMF_VMBroadCast, ESMF_Logical, assignment(=) use shr_sys_mod , only : shr_sys_abort use shr_log_mod , only : shr_log_getLogUnit use shr_nl_mod , only : shr_nl_find_group_name - use shr_mpi_mod , only : shr_mpi_bcast + use nuopc_shr_methods, only : chkerr implicit none private @@ -41,6 +42,7 @@ subroutine shr_lightning_coupling_readnl(NLFilename, atm_provides_lightning_out) integer :: unitn ! namelist unit number integer :: ierr ! error code logical :: exists ! if file exists or not + type(ESMF_Logical):: ltmp(1) integer :: rc integer :: localpet integer :: mpicom @@ -53,16 +55,19 @@ subroutine shr_lightning_coupling_readnl(NLFilename, atm_provides_lightning_out) rc = ESMF_SUCCESS + atm_provides_lightning_out = .false. + ltmp(1) = .false. + !--- 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(s_logunit) call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) 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 (chkerr(rc,__LINE__,u_FILE_u)) return if (localpet==0) then ! ------------------------------------------------------------------------ @@ -90,14 +95,17 @@ subroutine shr_lightning_coupling_readnl(NLFilename, atm_provides_lightning_out) close( unitn ) end if - atm_provides_lightning_out = atm_provides_lightning + ltmp(1) = atm_provides_lightning end if ! ------------------------------------------------------------------------ - ! Broadcast values to all processors + ! Broadcast values to all tasks ! ------------------------------------------------------------------------ - call shr_mpi_bcast(atm_provides_lightning_out, mpicom) + call ESMF_VMBroadcast(vm, ltmp, count=1, rootPet=0, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + atm_provides_lightning_out = ltmp(1) end subroutine shr_lightning_coupling_readnl From 4cf3e05eb4505c6944b137948f9a93f17e96bc7a Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 12 Apr 2023 14:31:14 -0400 Subject: [PATCH 276/395] Added Fwxx_taux and Fwxx_tauy, based on Foxx_taux and Foxx_tauy --- mediator/esmFldsExchange_cesm_mod.F90 | 35 +++++++++++++++++++++++++++ mediator/fd_cesm.yaml | 19 +++++++++++++++ 2 files changed, 54 insertions(+) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 149c7791d..f53d9e38b 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2963,6 +2963,41 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compwav, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') end if end if +!PSH begin + ! --------------------------------------------------------------------- + ! to wav: zonal and meridional wind stress + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_to(compwav , 'Fwxx_taux') + call addfld_from(compice , 'Fioi_taux') + call addfld_aoflux('Faox_taux') + else + if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then + if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then + call addmap_from(compice, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compwav, 'Fwxx_taux', & + mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + end if + call addmrg_to(compwav, 'Fwxx_taux', & + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + if (phase == 'advertise') then + call addfld_to(compwav , 'Fwxx_tauy') + call addfld_from(compice , 'Fioi_tauy') + call addfld_aoflux('Faox_tauy') + else + if ( fldchk(is_local%wrap%FBexp(compwav), 'Foxx_tauy', rc=rc)) then + if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_tauy', rc=rc)) then + call addmap_from(compice, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compwav, 'Fwxx_tauy', & + mrg_from=compice, mrg_fld='Fioi_tauy', mrg_type='merge', mrg_fracname='ifrac') + end if + call addmrg_to(compwav, 'Fwxx_tauy', & + mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') + end if + end if +!PSH end !===================================================================== ! FIELDS TO RIVER (comprof) diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 648a4fed2..d6a281249 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1172,6 +1172,25 @@ canonical_units: m2/s description: wave elevation spectrum +#PSH begin + # + #----------------------------------- + # section: wave import + #----------------------------------- + # + + # + - standard_name: Fwxx_taux + alias: mean_zonal_moment_flx + canonical_units: N m-2 + description: wave import - zonal surface stress + # + - standard_name: Fwxx_tauy + alias: mean_merid_moment_flx + canonical_units: N m-2 + description: wave import - meridional surface stress +#PSH end + #----------------------------------- # mediator fields #----------------------------------- From e68d9bc49bf080e36272944db49ac196ba0bf4f2 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 14 Apr 2023 13:14:41 -0400 Subject: [PATCH 277/395] Trying simpler form of sharing Foxx to compwav --- mediator/esmFldsExchange_cesm_mod.F90 | 56 +++++++++++++-------------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index f53d9e38b..a9e556de6 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2968,34 +2968,34 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld_to(compwav , 'Fwxx_taux') - call addfld_from(compice , 'Fioi_taux') - call addfld_aoflux('Faox_taux') - else - if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then - if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then - call addmap_from(compice, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') - end if - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - if (phase == 'advertise') then - call addfld_to(compwav , 'Fwxx_tauy') - call addfld_from(compice , 'Fioi_tauy') - call addfld_aoflux('Faox_tauy') - else - if ( fldchk(is_local%wrap%FBexp(compwav), 'Foxx_tauy', rc=rc)) then - if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_tauy', rc=rc)) then - call addmap_from(compice, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') - call addmrg_to(compwav, 'Fwxx_tauy', & - mrg_from=compice, mrg_fld='Fioi_tauy', mrg_type='merge', mrg_fracname='ifrac') - end if - call addmrg_to(compwav, 'Fwxx_tauy', & - mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') - end if + call addfld_to(compwav , 'Foxx_taux') +! call addfld_from(compice , 'Fioi_taux') +! call addfld_aoflux('Faox_taux') +! else +! if ( fldchk(is_local%wrap%FBexp(compwav), 'Foxx_taux', rc=rc)) then +! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then +! call addmap_from(compice, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') +! call addmrg_to(compwav, 'Foxx_taux', & +! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') +! end if +! call addmrg_to(compwav, 'Foxx_taux', & +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') +! end if + end if + if (phase == 'advertise') then + call addfld_to(compwav , 'Foxx_tauy') +! call addfld_from(compice , 'Fioi_tauy') +! call addfld_aoflux('Faox_tauy') +! else +! if ( fldchk(is_local%wrap%FBexp(compwav), 'Foxx_tauy', rc=rc)) then +! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_tauy', rc=rc)) then +! call addmap_from(compice, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') +! call addmrg_to(compwav, 'Fwxx_tauy', & +! mrg_from=compice, mrg_fld='Fioi_tauy', mrg_type='merge', mrg_fracname='ifrac') +! end if +! call addmrg_to(compwav, 'Fwxx_tauy', & +! mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') +! end if end if !PSH end From eb186945b14c3dba06c5056dd9f605dcb3aca7b6 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 14 Apr 2023 18:06:53 -0400 Subject: [PATCH 278/395] Turning off Foxx export to waves for testing --- mediator/esmFldsExchange_cesm_mod.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index a9e556de6..881235573 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2967,8 +2967,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_to(compwav , 'Foxx_taux') +! if (phase == 'advertise') then +! call addfld_to(compwav , 'Foxx_taux') ! call addfld_from(compice , 'Fioi_taux') ! call addfld_aoflux('Faox_taux') ! else @@ -2981,9 +2981,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! call addmrg_to(compwav, 'Foxx_taux', & ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') ! end if - end if - if (phase == 'advertise') then - call addfld_to(compwav , 'Foxx_tauy') +! end if +! if (phase == 'advertise') then +! call addfld_to(compwav , 'Foxx_tauy') ! call addfld_from(compice , 'Fioi_tauy') ! call addfld_aoflux('Faox_tauy') ! else @@ -2996,7 +2996,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! call addmrg_to(compwav, 'Fwxx_tauy', & ! mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') ! end if - end if +! end if !PSH end !===================================================================== From c791efc7d85c130d1001af6f2f0db4ee5de12cf8 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Mon, 17 Apr 2023 12:25:07 -0400 Subject: [PATCH 279/395] Adding Fwxx_taux to get wind stress to pass to wave model --- mediator/esmFldsExchange_cesm_mod.F90 | 15 +++++++++++++++ mediator/fd_cesm.yaml | 10 +++++----- 2 files changed, 20 insertions(+), 5 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 881235573..4ee196f5a 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2967,6 +2967,21 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_to(compwav , 'Fwxx_taux') + call addfld_from(compice , 'Fioi_taux') + call addfld_aoflux('Faox_taux') + else + if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then + if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then + call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') + call addmrg_to(compwav, 'Fwxx_taux', & + mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + end if + call addmrg_to(compwav, 'Fwxx_taux', & + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + end if + end if ! if (phase == 'advertise') then ! call addfld_to(compwav , 'Foxx_taux') ! call addfld_from(compice , 'Fioi_taux') diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index d6a281249..9d2d873bc 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1179,16 +1179,16 @@ #----------------------------------- # - # + # - standard_name: Fwxx_taux alias: mean_zonal_moment_flx canonical_units: N m-2 description: wave import - zonal surface stress # - - standard_name: Fwxx_tauy - alias: mean_merid_moment_flx - canonical_units: N m-2 - description: wave import - meridional surface stress +# - standard_name: Fwxx_tauy +# alias: mean_merid_moment_flx +# canonical_units: N m-2 +# description: wave import - meridional surface stress #PSH end #----------------------------------- From 8db24496210078ea9584aa970e731d5d2cd3eab8 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Mon, 17 Apr 2023 14:00:36 -0400 Subject: [PATCH 280/395] Adding Fwxx_taux, using Foxx_taux as a model --- mediator/med_phases_prep_wav_mod.F90 | 44 ++++++++++++++++++++++------ 1 file changed, 35 insertions(+), 9 deletions(-) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 4fdd630ea..578b2837f 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -13,12 +13,20 @@ module med_phases_prep_wav_mod use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose +!PSH begin + use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk + use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr +!PSH end use med_methods_mod , only : FB_accum => med_methods_FB_accum use med_methods_mod , only : FB_average => med_methods_FB_average use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset - use esmFlds , only : med_fldList_GetfldListTo - use med_internalstate_mod , only : compwav +!PSH begin +! use esmFlds , only : med_fldList_GetfldListTo +! use med_internalstate_mod , only : compwav + use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type + use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode +!PSH end use perf_mod , only : t_startf, t_stopf implicit none @@ -28,6 +36,10 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_accum ! called from run sequence public :: med_phases_prep_wav_avg ! called from run sequence +!PSH begin + private :: med_phases_prep_ocn_custom_cesm +!PSH end + character(*), parameter :: u_FILE_u = & __FILE__ @@ -82,6 +94,9 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n, ncnt +!PSH begin + type(med_fldlist_type), pointer :: fldList +!PSH end character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' !--------------------------------------- @@ -96,14 +111,25 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - +!PSH begin + fldList => med_fldList_GetfldListTo(compwav) +!PSH end ! auto merges to wav - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compwav), & - is_local%wrap%FBExp(compwav), & - is_local%wrap%FBFrac(compwav), & - is_local%wrap%FBImp(:,compwav), & - med_fldList_GetfldListTo(compwav), rc=rc) +!PSH begin +! call med_merge_auto(& +! is_local%wrap%med_coupling_active(:,compwav), & +! is_local%wrap%FBExp(compwav), & +! is_local%wrap%FBFrac(compwav), & +! is_local%wrap%FBImp(:,compwav), & +! med_fldList_GetfldListTo(compwav), rc=rc) + call med_merge_auto(& + is_local%wrap%med_coupling_active(:,compwav), & + is_local%wrap%FBExp(compwav), & + is_local%wrap%FBFrac(compwav), & + is_local%wrap%FBImp(:,compwav), & + fldList, & + FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) +!PSH end if (ChkErr(rc,__LINE__,u_FILE_u)) return ! wave accumulator From a599c2f9844d1d6adf4a54e8a701756d08b0e0d9 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Mon, 17 Apr 2023 14:27:20 -0400 Subject: [PATCH 281/395] Comment out unnecessary line --- mediator/med_phases_prep_wav_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 578b2837f..3a99f295f 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -37,7 +37,7 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_avg ! called from run sequence !PSH begin - private :: med_phases_prep_ocn_custom_cesm +! private :: med_phases_prep_wav_custom_cesm !PSH end character(*), parameter :: u_FILE_u = & From 61cf3780a49850529e2882715cf147f1f24707bd Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 19 Apr 2023 09:50:24 -0600 Subject: [PATCH 282/395] fix issue with xgrid reproducibility --- mediator/med_phases_aofluxes_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 0b3d10901..9fbc472be 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -768,6 +768,7 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Mesh) :: xch_mesh real(r8), pointer :: dataptr(:) integer :: fieldcount + integer :: stp ! srcTermProcessing is declared inout and must have variable not constant type(ESMF_CoordSys_Flag) :: coordSys real(ESMF_KIND_R8) ,allocatable :: garea(:) character(len=*),parameter :: subname=' (med_aofluxes_init_xgrid) ' @@ -870,11 +871,12 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (trim(coupling_mode) == 'cesm') then + stp = 1 call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_bilinr, & - regridmethod=ESMF_REGRIDMETHOD_BILINEAR, dstMaskValues=(/0/), rc=rc) + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, dstMaskValues=(/0/), srcTermProcessing=stp, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_patch, & - regridmethod=ESMF_REGRIDMETHOD_PATCH, dstMaskValues=(/0/), rc=rc) + regridmethod=ESMF_REGRIDMETHOD_PATCH, dstMaskValues=(/0/), srcTermProcessing=stp, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if From f126b9f1c33dc8421a5520289ab3e515a4cd153c Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 19 Apr 2023 16:32:24 -0600 Subject: [PATCH 283/395] update the minimum esmf version requirement --- cime_config/buildnml | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 6b76da004..9d06b0cae 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -620,14 +620,7 @@ def buildnml(case, caseroot, component): major = line[-2] if "MAJOR" in line else major minor = line[-2] if "MINOR" in line else minor logger.debug("ESMF version major {} minor {}".format(major, minor)) - expect(int(major) >= 8, "ESMF version should be 8.1 or newer") - if esmf_aware_threading: - expect( - int(minor) >= 2, - "ESMF version should be 8.2.0 or newer when using ESMF_AWARE_THREADING", - ) - else: - expect(int(minor) >= 1, "ESMF version should be 8.1.0 or newer") + expect(int(major) >= 8 and int(minor) >=4, "ESMF version should be 8.4.1 or newer") confdir = os.path.join(case.get_value("CASEBUILD"), "cplconf") if not os.path.isdir(confdir): From 263bebed62622f7bf9e115f5f51524471be7eadd Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 25 Apr 2023 11:31:35 +0200 Subject: [PATCH 284/395] added wav/ice coupling --- cime_config/buildnml | 8 ++------ cime_config/config_component_cesm.xml | 8 ++++++++ cime_config/namelist_definition_drv.xml | 5 ++++- mediator/esmFldsExchange_cesm_mod.F90 | 12 ++++++------ 4 files changed, 20 insertions(+), 13 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index fd5d73df0..e29d3eee6 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -101,17 +101,13 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): elif case.get_value('RUN_TYPE') == 'branch': config['run_type'] = 'branch' + config['wav_ice_coupling'] = config['COMP_WAV'] == 'ww3dev' and config['COMP_ICE'] == 'cice' + #---------------------------------------------------- # Initialize namelist defaults #---------------------------------------------------- nmlgen.init_defaults(infile, config, skip_default_for_groups=["modelio"]) - #-------------------------------- - # Set default wav-ice coupling (assumes cice6 as the ice component - #-------------------------------- - if (case.get_value("COMP_WAV") == 'ww3dev' and case.get_value("COMP_ICE") == 'cice'): - nmlgen.add_default('wavice_coupling', value='.true.') - #-------------------------------- # Overwrite: set brnch_retain_casename #-------------------------------- diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index cfcdc12ef..c1894ec4e 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -108,12 +108,15 @@ CO2A none CO2A + CO2A CO2A CO2A CO2A CO2A CO2C CO2C + CO2A + CO2A run_coupling env_run.xml @@ -232,6 +235,11 @@ 1 + + + + 24 + 48 run_coupling env_run.xml diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index e35ff537d..6f01cbe62 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2270,6 +2270,7 @@ 4 + 4 0 @@ -3798,7 +3799,7 @@ - + logical expdef ALLCOMP_attributes @@ -3807,6 +3808,8 @@ .false. + + diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 149c7791d..20509ed47 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -98,16 +98,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) integer :: n, ns character(len=CL) :: cvalue character(len=CS) :: name - logical :: wavice_coupling + logical :: wav_coupling_to_cice logical :: ocn2glc_coupling character(len=*) , parameter :: subname=' (esmFldsExchange_cesm) ' !-------------------------------------- rc = ESMF_SUCCESS - call NUOPC_CompAttributeGet(gcomp, name='wavice_coupling', value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='wav_coupling_to_cice', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) wavice_coupling + read(cvalue,*) wav_coupling_to_cice call NUOPC_CompAttributeGet(gcomp, name='ocn2glc_coupling', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2809,7 +2809,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to ice: wave elevation spectrum (field with ungridded dimensions) ! --------------------------------------------------------------------- - if (wavice_coupling) then + if (wav_coupling_to_cice) then if (phase == 'advertise') then call addfld_from(compwav, 'Sw_elevation_spectrum') call addfld_to(compice, 'Sw_elevation_spectrum') @@ -2844,7 +2844,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !---------------------------------------------------------- ! to wav: ice thickness from ice !---------------------------------------------------------- - if (wavice_coupling) then + if (wav_coupling_to_cice) then if (phase == 'advertise') then call addfld_from(compice, 'Si_thick') call addfld_to(compwav, 'Si_thick') @@ -2859,7 +2859,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !---------------------------------------------------------- ! to wav: ice floe diameter from ice !---------------------------------------------------------- - if (wavice_coupling) then + if (wav_coupling_to_cice) then if (phase == 'advertise') then call addfld_from(compice, 'Si_floediam') call addfld_to(compwav, 'Si_floediam') From 17fa9d5a97395d323b21675b7829b237f3f4a51c Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 10:37:02 -0400 Subject: [PATCH 285/395] Adding custom field subroutine for waves with cesm, based on equivalent routine for ocn component --- mediator/med_phases_prep_wav_mod.F90 | 307 ++++++++++++++++++++++++++- 1 file changed, 306 insertions(+), 1 deletion(-) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 3a99f295f..fa6e6617e 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -37,7 +37,7 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_avg ! called from run sequence !PSH begin -! private :: med_phases_prep_wav_custom_cesm + private :: med_phases_prep_wav_custom_cesm !PSH end character(*), parameter :: u_FILE_u = & @@ -131,6 +131,13 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) !PSH end if (ChkErr(rc,__LINE__,u_FILE_u)) return +!PSH begin + ! custom merges to ocean + if (trim(coupling_mode) == 'cesm') then + call med_phases_prep_wav_custom_cesm(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if +!PSH end ! wave accumulator call FB_accum(is_local%wrap%FBExpAccumWav, is_local%wrap%FBExp(compwav), rc=rc) @@ -216,4 +223,302 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_prep_wav_avg + !----------------------------------------------------------------------------- + subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) + + !--------------------------------------- + ! custom calculations for cesm + !--------------------------------------- + + use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet + use ESMF , only : ESMF_VMBroadCast + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + type(ESMF_Field) :: lfield + real(R8), pointer :: ifrac(:) + real(R8), pointer :: ofrac(:) + real(R8), pointer :: ifracr(:) + real(R8), pointer :: ofracr(:) + real(R8), pointer :: avsdr(:) + real(R8), pointer :: avsdf(:) + real(R8), pointer :: anidr(:) + real(R8), pointer :: anidf(:) + real(R8), pointer :: Faxa_swvdf(:) + real(R8), pointer :: Faxa_swndf(:) + real(R8), pointer :: Faxa_swvdr(:) + real(R8), pointer :: Faxa_swndr(:) + real(R8), pointer :: Foxx_swnet(:) + real(R8), pointer :: Foxx_swnet_afracr(:) + real(R8), pointer :: Foxx_swnet_vdr(:) + real(R8), pointer :: Foxx_swnet_vdf(:) + real(R8), pointer :: Foxx_swnet_idr(:) + real(R8), pointer :: Foxx_swnet_idf(:) + real(R8), pointer :: Fioi_swpen_vdr(:) + real(R8), pointer :: Fioi_swpen_vdf(:) + real(R8), pointer :: Fioi_swpen_idr(:) + real(R8), pointer :: Fioi_swpen_idf(:) + real(R8), pointer :: Fioi_swpen(:) + real(R8), pointer :: dataptr(:) + real(R8), pointer :: dataptr_scalar_ocn(:,:) + real(R8) :: frac_sum + real(R8) :: ifrac_scaled, ofrac_scaled + real(R8) :: ifracr_scaled, ofracr_scaled + logical :: export_swnet_by_bands + logical :: import_swpen_by_bands + logical :: export_swnet_afracr + real(R8) :: precip_fact(1) + character(CS) :: cvalue + real(R8) :: fswabsv, fswabsi + integer :: scalar_id + integer :: n + integer :: lsize + real(R8) :: c1,c2,c3,c4 + character(len=64), allocatable :: fldnames(:) + character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > 20) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + end if + call memcheck(subname, 5, mastertask) + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + +! !--------------------------------------- +! ! Compute netsw for ocean +! !--------------------------------------- +! ! netsw_for_ocn = downsw_from_atm * (1-ocn_albedo) * (1-ice_fraction) + pensw_from_ice * (ice_fraction) +! +! ! Input from atm +! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swvdr', Faxa_swvdr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swndr', Faxa_swndr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swvdf', Faxa_swvdf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swndf', Faxa_swndf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! lsize = size(Faxa_swvdr) +! +! ! Input from mediator, ocean albedos +! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_avsdr' , avsdr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_anidr' , anidr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_avsdf' , avsdf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_anidf' , anidf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! +! ! Output to ocean swnet total +! if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet', Foxx_swnet, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! else +! lsize = size(Faxa_swvdr) +! allocate(Foxx_swnet(lsize)) +! end if +! +! ! Output to ocean swnet by radiation bands +! if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc)) then +! export_swnet_by_bands = .true. +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', Foxx_swnet_vdr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', Foxx_swnet_vdf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', Foxx_swnet_idr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', Foxx_swnet_idf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! else +! export_swnet_by_bands = .false. +! end if +! +! ! ----------------------- +! ! If cice IS NOT PRESENT +! ! ----------------------- +! if (.not. is_local%wrap%comp_present(compice)) then +! ! Compute total swnet to ocean independent of swpen from sea-ice +! do n = 1,lsize +! fswabsv = Faxa_swvdr(n) * (1.0_R8 - avsdr(n)) + Faxa_swvdf(n) * (1.0_R8 - avsdf(n)) +! fswabsi = Faxa_swndr(n) * (1.0_R8 - anidr(n)) + Faxa_swndf(n) * (1.0_R8 - anidf(n)) +! Foxx_swnet(n) = fswabsv + fswabsi +! end do +! ! Compute sw export to ocean bands if required +! if (export_swnet_by_bands) then +! c1 = 0.285; c2 = 0.285; c3 = 0.215; c4 = 0.215 +! Foxx_swnet_vdr(:) = c1 * Foxx_swnet(:) +! Foxx_swnet_vdf(:) = c2 * Foxx_swnet(:) +! Foxx_swnet_idr(:) = c3 * Foxx_swnet(:) +! Foxx_swnet_idf(:) = c4 * Foxx_swnet(:) +! end if +! end if +! +! ! ----------------------- +! ! If cice IS PRESENT +! ! ----------------------- +! if (is_local%wrap%comp_present(compice)) then +! +! ! Input from mediator, ice-covered ocean and open ocean fractions +! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrac' , ifrac, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac' , ofrac, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrad' , ifracr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrad' , ofracr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! +! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen', Fioi_swpen, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! if (FB_fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdr', rc=rc)) then +! import_swpen_by_bands = .true. +! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_vdr', Fioi_swpen_vdr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_vdf', Fioi_swpen_vdf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_idr', Fioi_swpen_idr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_idf', Fioi_swpen_idf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! else +! import_swpen_by_bands = .false. +! end if +! +! if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr',rc=rc)) then +! ! Swnet without swpen from sea-ice +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr', Foxx_swnet_afracr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! export_swnet_afracr = .true. +! else +! export_swnet_afracr = .false. +! end if +! +! do n = 1,lsize +! ! Compute total swnet to ocean independent of swpen from sea-ice +! fswabsv = Faxa_swvdr(n) * (1.0_R8 - avsdr(n)) + Faxa_swvdf(n) * (1.0_R8 - avsdf(n)) +! fswabsi = Faxa_swndr(n) * (1.0_R8 - anidr(n)) + Faxa_swndf(n) * (1.0_R8 - anidf(n)) +! Foxx_swnet(n) = fswabsv + fswabsi +! +! ! Add swpen from sea ice +! ifrac_scaled = ifrac(n) +! ofrac_scaled = ofrac(n) +! frac_sum = ifrac(n) + ofrac(n) +! if (frac_sum /= 0._R8) then +! ifrac_scaled = ifrac(n) / (frac_sum) +! ofrac_scaled = ofrac(n) / (frac_sum) +! endif +! ifracr_scaled = ifracr(n) +! ofracr_scaled = ofracr(n) +! frac_sum = ifracr(n) + ofracr(n) +! if (frac_sum /= 0._R8) then +! ifracr_scaled = ifracr(n) / (frac_sum) +! ofracr_scaled = ofracr(n) / (frac_sum) +! endif +! Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) +! +! if (export_swnet_afracr) then +! Foxx_swnet_afracr(n) = ofracr_scaled*(fswabsv + fswabsi) +! end if +! +! ! Compute sw export to ocean bands if required +! if (export_swnet_by_bands) then +! if (import_swpen_by_bands) then +! ! use each individual band for swpen coming from the sea-ice +! Foxx_swnet_vdr(n) = Faxa_swvdr(n)*(1.0_R8-avsdr(n))*ofracr_scaled + Fioi_swpen_vdr(n)*ifrac_scaled +! Foxx_swnet_vdf(n) = Faxa_swvdf(n)*(1.0_R8-avsdf(n))*ofracr_scaled + Fioi_swpen_vdf(n)*ifrac_scaled +! Foxx_swnet_idr(n) = Faxa_swndr(n)*(1.0_R8-anidr(n))*ofracr_scaled + Fioi_swpen_idr(n)*ifrac_scaled +! Foxx_swnet_idf(n) = Faxa_swndf(n)*(1.0_R8-anidf(n))*ofracr_scaled + Fioi_swpen_idf(n)*ifrac_scaled +! else +! ! scale total Foxx_swnet to get contributions from each band +! c1 = 0.285; c2 = 0.285; c3 = 0.215; c4 = 0.215 +! Foxx_swnet_vdr(n) = c1 * Foxx_swnet(n) +! Foxx_swnet_vdf(n) = c2 * Foxx_swnet(n) +! Foxx_swnet_idr(n) = c3 * Foxx_swnet(n) +! Foxx_swnet_idf(n) = c4 * Foxx_swnet(n) +! end if +! end if +! end do +! +! ! Output to ocean per ice thickness fraction and sw penetrating into ocean +! if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Sf_afrac', rc=rc)) then +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afrac', fldptr1=dataptr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! dataptr(:) = ofrac(:) +! end if +! if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Sf_afracr', rc=rc)) then +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afracr', fldptr1=dataptr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! dataptr(:) = ofracr(:) +! end if +! +! end if ! if sea-ice is present +! +! ! Deallocate Foxx_swnet if it was allocated in this subroutine +! if (.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then +! deallocate(Foxx_swnet) +! end if +! +! ! Apply precipitation factor from ocean (that scales atm rain and snow back to ocn ) if appropriate +! if (trim(coupling_mode) == 'cesm' .and. is_local%wrap%flds_scalar_index_precip_factor /= 0) then +! +! ! Note that in med_internal_mod.F90 all is_local%wrap%flds_scalar_index_precip_factor +! ! is initialized to 0. +! ! In addition, in med.F90, if this attribute is not present as a mediator component attribute, +! ! it is set to 0. +! if (mastertask) then +! call ESMF_StateGet(is_local%wrap%NstateImp(compocn), & +! itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return +! call ESMF_FieldGet(lfield, farrayPtr=dataptr_scalar_ocn, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return +! scalar_id=is_local%wrap%flds_scalar_index_precip_factor +! precip_fact(1) = dataptr_scalar_ocn(scalar_id,1) +! if (precip_fact(1) /= 1._r8) then +! write(logunit,'(a,f21.13)')& +! '(merge_to_ocn): Scaling rain, snow, liquid and ice runoff by non-unity precip_fact ',& +! precip_fact(1) +! end if +! end if +! call ESMF_VMBroadCast(is_local%wrap%vm, precip_fact, 1, 0, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return +! is_local%wrap%flds_scalar_precip_factor = precip_fact(1) +! if (dbug_flag > 5) then +! write(cvalue,*) precip_fact(1) +! call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO) +! end if +! +! ! Scale rain and snow to ocn from atm by the precipitation factor received from the ocean +! allocate(fldnames(4)) +! fldnames = (/'Faxa_rain', 'Faxa_snow', 'Foxx_rofl', 'Foxx_rofi'/) +! do n = 1,size(fldnames) +! if (FB_fldchk(is_local%wrap%FBExp(compocn), trim(fldnames(n)), rc=rc)) then +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), trim(fldnames(n)) , dataptr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! dataptr(:) = dataptr(:) * is_local%wrap%flds_scalar_precip_factor +! end if +! end do +! deallocate(fldnames) +! end if +! +! if (dbug_flag > 20) then +! call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) +! end if +! call t_stopf('MED:'//subname) +! + end subroutine med_phases_prep_wav_custom_cesm + end module med_phases_prep_wav_mod From 5712122b396bde5d742d0402fd2823e369b7ee24 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 13:04:35 -0400 Subject: [PATCH 286/395] Passing So_ofrac to wav component --- mediator/esmFldsExchange_cesm_mod.F90 | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 4ee196f5a..566040563 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2964,6 +2964,22 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !PSH begin + if (phase == 'advertise') then + call addfld_from(compocn, 'So_ofrac') + call addfld_to(compwav, 'So_ofrac') + end if +! if (phase == 'advertise') then +! call addfld_from(compocn, 'So_ofrac') +! call addfld_to(compwav, 'So_ofrac') +! else +! if ( fldchk(is_local%wrap%FBexp(compwav) , 'So_ofrac', rc=rc) .and. & +! fldchk(is_local%wrap%FBImp(compice,compice ), 'So_ofrac', rc=rc)) then +! ! By default will be using a custom map - but if one is not available, use a generated bilinear instead +! call addmap_from(compice, 'Si_ifrac', compwav, mapbilnr, 'one', ice2wav_smap) +! call addmrg_to(compwav, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') +! end if +! end if + ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- From e6451a48903d5a1588a4b6e1e5288138e805992d Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 14:19:14 -0400 Subject: [PATCH 287/395] Changing merge to Fwxx_taux to copy --- mediator/esmFldsExchange_cesm_mod.F90 | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 566040563..897e942a3 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2985,17 +2985,18 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') - call addfld_from(compice , 'Fioi_taux') +! call addfld_from(compice , 'Fioi_taux') call addfld_aoflux('Faox_taux') else if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then - if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then - call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') - end if +! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then +! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') +! call addmrg_to(compwav, 'Fwxx_taux', & +! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') +! end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='copy') +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if ! if (phase == 'advertise') then From bdd726adc35eefc4cc26bf6185857fdaca004a1b Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 15:24:45 -0400 Subject: [PATCH 288/395] Fixed syntax of addmrg_to call for Fwxx_taux --- mediator/esmFldsExchange_cesm_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 897e942a3..42bb327ee 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2995,7 +2995,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') ! end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='copy') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if From dec4bfb7c43dfb43f46e6a41592b04aa25640b10 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 16:47:24 -0400 Subject: [PATCH 289/395] Reverted earlier modifications --- mediator/med_phases_prep_wav_mod.F90 | 202 +++++++++++++-------------- 1 file changed, 101 insertions(+), 101 deletions(-) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index fa6e6617e..eb89bde22 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -14,18 +14,18 @@ module med_phases_prep_wav_mod use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose !PSH begin - use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk - use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr +! use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk +! use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr !PSH end use med_methods_mod , only : FB_accum => med_methods_FB_accum use med_methods_mod , only : FB_average => med_methods_FB_average use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset !PSH begin -! use esmFlds , only : med_fldList_GetfldListTo -! use med_internalstate_mod , only : compwav - use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type - use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode + use esmFlds , only : med_fldList_GetfldListTo + use med_internalstate_mod , only : compwav +! use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type +! use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode !PSH end use perf_mod , only : t_startf, t_stopf @@ -37,7 +37,7 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_avg ! called from run sequence !PSH begin - private :: med_phases_prep_wav_custom_cesm +! private :: med_phases_prep_wav_custom_cesm !PSH end character(*), parameter :: u_FILE_u = & @@ -95,7 +95,7 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) type(InternalState) :: is_local integer :: n, ncnt !PSH begin - type(med_fldlist_type), pointer :: fldList +! type(med_fldlist_type), pointer :: fldList !PSH end character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' !--------------------------------------- @@ -112,31 +112,31 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !PSH begin - fldList => med_fldList_GetfldListTo(compwav) +! fldList => med_fldList_GetfldListTo(compwav) !PSH end ! auto merges to wav !PSH begin -! call med_merge_auto(& -! is_local%wrap%med_coupling_active(:,compwav), & -! is_local%wrap%FBExp(compwav), & -! is_local%wrap%FBFrac(compwav), & -! is_local%wrap%FBImp(:,compwav), & -! med_fldList_GetfldListTo(compwav), rc=rc) - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compwav), & - is_local%wrap%FBExp(compwav), & - is_local%wrap%FBFrac(compwav), & - is_local%wrap%FBImp(:,compwav), & - fldList, & - FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) + call med_merge_auto(& + is_local%wrap%med_coupling_active(:,compwav), & + is_local%wrap%FBExp(compwav), & + is_local%wrap%FBFrac(compwav), & + is_local%wrap%FBImp(:,compwav), & + med_fldList_GetfldListTo(compwav), rc=rc) +! call med_merge_auto(& +! is_local%wrap%med_coupling_active(:,compwav), & +! is_local%wrap%FBExp(compwav), & +! is_local%wrap%FBFrac(compwav), & +! is_local%wrap%FBImp(:,compwav), & +! fldList, & +! FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) !PSH end if (ChkErr(rc,__LINE__,u_FILE_u)) return !PSH begin - ! custom merges to ocean - if (trim(coupling_mode) == 'cesm') then - call med_phases_prep_wav_custom_cesm(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if +! ! custom merges to ocean +! if (trim(coupling_mode) == 'cesm') then +! call med_phases_prep_wav_custom_cesm(gcomp, rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if !PSH end ! wave accumulator @@ -224,79 +224,79 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) end subroutine med_phases_prep_wav_avg !----------------------------------------------------------------------------- - subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) - - !--------------------------------------- - ! custom calculations for cesm - !--------------------------------------- - - use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet - use ESMF , only : ESMF_VMBroadCast - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR - - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(InternalState) :: is_local - type(ESMF_Field) :: lfield - real(R8), pointer :: ifrac(:) - real(R8), pointer :: ofrac(:) - real(R8), pointer :: ifracr(:) - real(R8), pointer :: ofracr(:) - real(R8), pointer :: avsdr(:) - real(R8), pointer :: avsdf(:) - real(R8), pointer :: anidr(:) - real(R8), pointer :: anidf(:) - real(R8), pointer :: Faxa_swvdf(:) - real(R8), pointer :: Faxa_swndf(:) - real(R8), pointer :: Faxa_swvdr(:) - real(R8), pointer :: Faxa_swndr(:) - real(R8), pointer :: Foxx_swnet(:) - real(R8), pointer :: Foxx_swnet_afracr(:) - real(R8), pointer :: Foxx_swnet_vdr(:) - real(R8), pointer :: Foxx_swnet_vdf(:) - real(R8), pointer :: Foxx_swnet_idr(:) - real(R8), pointer :: Foxx_swnet_idf(:) - real(R8), pointer :: Fioi_swpen_vdr(:) - real(R8), pointer :: Fioi_swpen_vdf(:) - real(R8), pointer :: Fioi_swpen_idr(:) - real(R8), pointer :: Fioi_swpen_idf(:) - real(R8), pointer :: Fioi_swpen(:) - real(R8), pointer :: dataptr(:) - real(R8), pointer :: dataptr_scalar_ocn(:,:) - real(R8) :: frac_sum - real(R8) :: ifrac_scaled, ofrac_scaled - real(R8) :: ifracr_scaled, ofracr_scaled - logical :: export_swnet_by_bands - logical :: import_swpen_by_bands - logical :: export_swnet_afracr - real(R8) :: precip_fact(1) - character(CS) :: cvalue - real(R8) :: fswabsv, fswabsi - integer :: scalar_id - integer :: n - integer :: lsize - real(R8) :: c1,c2,c3,c4 - character(len=64), allocatable :: fldnames(:) - character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' - !--------------------------------------- - - rc = ESMF_SUCCESS - - call t_startf('MED:'//subname) - if (dbug_flag > 20) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - end if - call memcheck(subname, 5, mastertask) - - ! Get the internal state - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - +! subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) +! +! !--------------------------------------- +! ! custom calculations for cesm +! !--------------------------------------- +! +! use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet +! use ESMF , only : ESMF_VMBroadCast +! use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS +! use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR +! +! ! input/output variables +! type(ESMF_GridComp) :: gcomp +! integer, intent(out) :: rc +! +! ! local variables +! type(InternalState) :: is_local +! type(ESMF_Field) :: lfield +! real(R8), pointer :: ifrac(:) +! real(R8), pointer :: ofrac(:) +! real(R8), pointer :: ifracr(:) +! real(R8), pointer :: ofracr(:) +! real(R8), pointer :: avsdr(:) +! real(R8), pointer :: avsdf(:) +! real(R8), pointer :: anidr(:) +! real(R8), pointer :: anidf(:) +! real(R8), pointer :: Faxa_swvdf(:) +! real(R8), pointer :: Faxa_swndf(:) +! real(R8), pointer :: Faxa_swvdr(:) +! real(R8), pointer :: Faxa_swndr(:) +! real(R8), pointer :: Foxx_swnet(:) +! real(R8), pointer :: Foxx_swnet_afracr(:) +! real(R8), pointer :: Foxx_swnet_vdr(:) +! real(R8), pointer :: Foxx_swnet_vdf(:) +! real(R8), pointer :: Foxx_swnet_idr(:) +! real(R8), pointer :: Foxx_swnet_idf(:) +! real(R8), pointer :: Fioi_swpen_vdr(:) +! real(R8), pointer :: Fioi_swpen_vdf(:) +! real(R8), pointer :: Fioi_swpen_idr(:) +! real(R8), pointer :: Fioi_swpen_idf(:) +! real(R8), pointer :: Fioi_swpen(:) +! real(R8), pointer :: dataptr(:) +! real(R8), pointer :: dataptr_scalar_ocn(:,:) +! real(R8) :: frac_sum +! real(R8) :: ifrac_scaled, ofrac_scaled +! real(R8) :: ifracr_scaled, ofracr_scaled +! logical :: export_swnet_by_bands +! logical :: import_swpen_by_bands +! logical :: export_swnet_afracr +! real(R8) :: precip_fact(1) +! character(CS) :: cvalue +! real(R8) :: fswabsv, fswabsi +! integer :: scalar_id +! integer :: n +! integer :: lsize +! real(R8) :: c1,c2,c3,c4 +! character(len=64), allocatable :: fldnames(:) +! character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' +! !--------------------------------------- +! +! rc = ESMF_SUCCESS +! +! call t_startf('MED:'//subname) +! if (dbug_flag > 20) then +! call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) +! end if +! call memcheck(subname, 5, mastertask) +! +! ! Get the internal state +! nullify(is_local%wrap) +! call ESMF_GridCompGetInternalState(gcomp, is_local, rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! ! !--------------------------------------- ! ! Compute netsw for ocean ! !--------------------------------------- @@ -519,6 +519,6 @@ subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) ! end if ! call t_stopf('MED:'//subname) ! - end subroutine med_phases_prep_wav_custom_cesm +! end subroutine med_phases_prep_wav_custom_cesm end module med_phases_prep_wav_mod From d4b84412a4589038fa65b0aca9c555823676ab06 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 17:53:47 -0400 Subject: [PATCH 290/395] Substituting Foxx_taux for Faox_taux --- mediator/esmFldsExchange_cesm_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 42bb327ee..bf8fe952e 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2986,7 +2986,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') ! call addfld_from(compice , 'Fioi_taux') - call addfld_aoflux('Faox_taux') + call addfld_from(compocn, 'Foxx_taux') +! call addfld_aoflux('Faox_taux') else if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then ! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then @@ -2995,7 +2996,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') ! end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') + mrg_from=compocn, mrg_fld='Foxx_taux', mrg_type='copy') +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if From d666f8340d473f956c41c641bd4b7cbfbb1ace53 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 23:31:25 -0400 Subject: [PATCH 291/395] Revert "Substituting Foxx_taux for Faox_taux" This reverts commit d4b84412a4589038fa65b0aca9c555823676ab06. --- mediator/esmFldsExchange_cesm_mod.F90 | 6 +- mediator/med_phases_prep_wav_mod.F90 | 202 +++++++++++++------------- 2 files changed, 103 insertions(+), 105 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index bf8fe952e..42bb327ee 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2986,8 +2986,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') ! call addfld_from(compice , 'Fioi_taux') - call addfld_from(compocn, 'Foxx_taux') -! call addfld_aoflux('Faox_taux') + call addfld_aoflux('Faox_taux') else if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then ! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then @@ -2996,8 +2995,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') ! end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compocn, mrg_fld='Foxx_taux', mrg_type='copy') -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index eb89bde22..fa6e6617e 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -14,18 +14,18 @@ module med_phases_prep_wav_mod use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose !PSH begin -! use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk -! use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr + use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk + use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr !PSH end use med_methods_mod , only : FB_accum => med_methods_FB_accum use med_methods_mod , only : FB_average => med_methods_FB_average use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset !PSH begin - use esmFlds , only : med_fldList_GetfldListTo - use med_internalstate_mod , only : compwav -! use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type -! use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode +! use esmFlds , only : med_fldList_GetfldListTo +! use med_internalstate_mod , only : compwav + use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type + use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode !PSH end use perf_mod , only : t_startf, t_stopf @@ -37,7 +37,7 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_avg ! called from run sequence !PSH begin -! private :: med_phases_prep_wav_custom_cesm + private :: med_phases_prep_wav_custom_cesm !PSH end character(*), parameter :: u_FILE_u = & @@ -95,7 +95,7 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) type(InternalState) :: is_local integer :: n, ncnt !PSH begin -! type(med_fldlist_type), pointer :: fldList + type(med_fldlist_type), pointer :: fldList !PSH end character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' !--------------------------------------- @@ -112,31 +112,31 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !PSH begin -! fldList => med_fldList_GetfldListTo(compwav) + fldList => med_fldList_GetfldListTo(compwav) !PSH end ! auto merges to wav !PSH begin - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compwav), & - is_local%wrap%FBExp(compwav), & - is_local%wrap%FBFrac(compwav), & - is_local%wrap%FBImp(:,compwav), & - med_fldList_GetfldListTo(compwav), rc=rc) -! call med_merge_auto(& -! is_local%wrap%med_coupling_active(:,compwav), & -! is_local%wrap%FBExp(compwav), & -! is_local%wrap%FBFrac(compwav), & -! is_local%wrap%FBImp(:,compwav), & -! fldList, & -! FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) +! call med_merge_auto(& +! is_local%wrap%med_coupling_active(:,compwav), & +! is_local%wrap%FBExp(compwav), & +! is_local%wrap%FBFrac(compwav), & +! is_local%wrap%FBImp(:,compwav), & +! med_fldList_GetfldListTo(compwav), rc=rc) + call med_merge_auto(& + is_local%wrap%med_coupling_active(:,compwav), & + is_local%wrap%FBExp(compwav), & + is_local%wrap%FBFrac(compwav), & + is_local%wrap%FBImp(:,compwav), & + fldList, & + FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) !PSH end if (ChkErr(rc,__LINE__,u_FILE_u)) return !PSH begin -! ! custom merges to ocean -! if (trim(coupling_mode) == 'cesm') then -! call med_phases_prep_wav_custom_cesm(gcomp, rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if + ! custom merges to ocean + if (trim(coupling_mode) == 'cesm') then + call med_phases_prep_wav_custom_cesm(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if !PSH end ! wave accumulator @@ -224,79 +224,79 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) end subroutine med_phases_prep_wav_avg !----------------------------------------------------------------------------- -! subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) -! -! !--------------------------------------- -! ! custom calculations for cesm -! !--------------------------------------- -! -! use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet -! use ESMF , only : ESMF_VMBroadCast -! use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS -! use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR -! -! ! input/output variables -! type(ESMF_GridComp) :: gcomp -! integer, intent(out) :: rc -! -! ! local variables -! type(InternalState) :: is_local -! type(ESMF_Field) :: lfield -! real(R8), pointer :: ifrac(:) -! real(R8), pointer :: ofrac(:) -! real(R8), pointer :: ifracr(:) -! real(R8), pointer :: ofracr(:) -! real(R8), pointer :: avsdr(:) -! real(R8), pointer :: avsdf(:) -! real(R8), pointer :: anidr(:) -! real(R8), pointer :: anidf(:) -! real(R8), pointer :: Faxa_swvdf(:) -! real(R8), pointer :: Faxa_swndf(:) -! real(R8), pointer :: Faxa_swvdr(:) -! real(R8), pointer :: Faxa_swndr(:) -! real(R8), pointer :: Foxx_swnet(:) -! real(R8), pointer :: Foxx_swnet_afracr(:) -! real(R8), pointer :: Foxx_swnet_vdr(:) -! real(R8), pointer :: Foxx_swnet_vdf(:) -! real(R8), pointer :: Foxx_swnet_idr(:) -! real(R8), pointer :: Foxx_swnet_idf(:) -! real(R8), pointer :: Fioi_swpen_vdr(:) -! real(R8), pointer :: Fioi_swpen_vdf(:) -! real(R8), pointer :: Fioi_swpen_idr(:) -! real(R8), pointer :: Fioi_swpen_idf(:) -! real(R8), pointer :: Fioi_swpen(:) -! real(R8), pointer :: dataptr(:) -! real(R8), pointer :: dataptr_scalar_ocn(:,:) -! real(R8) :: frac_sum -! real(R8) :: ifrac_scaled, ofrac_scaled -! real(R8) :: ifracr_scaled, ofracr_scaled -! logical :: export_swnet_by_bands -! logical :: import_swpen_by_bands -! logical :: export_swnet_afracr -! real(R8) :: precip_fact(1) -! character(CS) :: cvalue -! real(R8) :: fswabsv, fswabsi -! integer :: scalar_id -! integer :: n -! integer :: lsize -! real(R8) :: c1,c2,c3,c4 -! character(len=64), allocatable :: fldnames(:) -! character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' -! !--------------------------------------- -! -! rc = ESMF_SUCCESS -! -! call t_startf('MED:'//subname) -! if (dbug_flag > 20) then -! call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) -! end if -! call memcheck(subname, 5, mastertask) -! -! ! Get the internal state -! nullify(is_local%wrap) -! call ESMF_GridCompGetInternalState(gcomp, is_local, rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! + subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) + + !--------------------------------------- + ! custom calculations for cesm + !--------------------------------------- + + use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet + use ESMF , only : ESMF_VMBroadCast + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + type(ESMF_Field) :: lfield + real(R8), pointer :: ifrac(:) + real(R8), pointer :: ofrac(:) + real(R8), pointer :: ifracr(:) + real(R8), pointer :: ofracr(:) + real(R8), pointer :: avsdr(:) + real(R8), pointer :: avsdf(:) + real(R8), pointer :: anidr(:) + real(R8), pointer :: anidf(:) + real(R8), pointer :: Faxa_swvdf(:) + real(R8), pointer :: Faxa_swndf(:) + real(R8), pointer :: Faxa_swvdr(:) + real(R8), pointer :: Faxa_swndr(:) + real(R8), pointer :: Foxx_swnet(:) + real(R8), pointer :: Foxx_swnet_afracr(:) + real(R8), pointer :: Foxx_swnet_vdr(:) + real(R8), pointer :: Foxx_swnet_vdf(:) + real(R8), pointer :: Foxx_swnet_idr(:) + real(R8), pointer :: Foxx_swnet_idf(:) + real(R8), pointer :: Fioi_swpen_vdr(:) + real(R8), pointer :: Fioi_swpen_vdf(:) + real(R8), pointer :: Fioi_swpen_idr(:) + real(R8), pointer :: Fioi_swpen_idf(:) + real(R8), pointer :: Fioi_swpen(:) + real(R8), pointer :: dataptr(:) + real(R8), pointer :: dataptr_scalar_ocn(:,:) + real(R8) :: frac_sum + real(R8) :: ifrac_scaled, ofrac_scaled + real(R8) :: ifracr_scaled, ofracr_scaled + logical :: export_swnet_by_bands + logical :: import_swpen_by_bands + logical :: export_swnet_afracr + real(R8) :: precip_fact(1) + character(CS) :: cvalue + real(R8) :: fswabsv, fswabsi + integer :: scalar_id + integer :: n + integer :: lsize + real(R8) :: c1,c2,c3,c4 + character(len=64), allocatable :: fldnames(:) + character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > 20) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + end if + call memcheck(subname, 5, mastertask) + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! !--------------------------------------- ! ! Compute netsw for ocean ! !--------------------------------------- @@ -519,6 +519,6 @@ end subroutine med_phases_prep_wav_avg ! end if ! call t_stopf('MED:'//subname) ! -! end subroutine med_phases_prep_wav_custom_cesm + end subroutine med_phases_prep_wav_custom_cesm end module med_phases_prep_wav_mod From 39257106ef55335081c88e14afea0525e7050cfb Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 23:45:36 -0400 Subject: [PATCH 292/395] Removed export of So_ofrac to wav component (unnecessary), and other miscellaneous cleanup --- mediator/esmFldsExchange_cesm_mod.F90 | 38 +++------------------------ 1 file changed, 4 insertions(+), 34 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 42bb327ee..94028de1d 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2964,10 +2964,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !PSH begin - if (phase == 'advertise') then - call addfld_from(compocn, 'So_ofrac') - call addfld_to(compwav, 'So_ofrac') - end if +! if (phase == 'advertise') then +! call addfld_from(compocn, 'So_ofrac') +! call addfld_to(compwav, 'So_ofrac') +! end if ! if (phase == 'advertise') then ! call addfld_from(compocn, 'So_ofrac') ! call addfld_to(compwav, 'So_ofrac') @@ -2999,36 +2999,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if -! if (phase == 'advertise') then -! call addfld_to(compwav , 'Foxx_taux') -! call addfld_from(compice , 'Fioi_taux') -! call addfld_aoflux('Faox_taux') -! else -! if ( fldchk(is_local%wrap%FBexp(compwav), 'Foxx_taux', rc=rc)) then -! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then -! call addmap_from(compice, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') -! call addmrg_to(compwav, 'Foxx_taux', & -! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') -! end if -! call addmrg_to(compwav, 'Foxx_taux', & -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') -! end if -! end if -! if (phase == 'advertise') then -! call addfld_to(compwav , 'Foxx_tauy') -! call addfld_from(compice , 'Fioi_tauy') -! call addfld_aoflux('Faox_tauy') -! else -! if ( fldchk(is_local%wrap%FBexp(compwav), 'Foxx_tauy', rc=rc)) then -! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_tauy', rc=rc)) then -! call addmap_from(compice, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') -! call addmrg_to(compwav, 'Fwxx_tauy', & -! mrg_from=compice, mrg_fld='Fioi_tauy', mrg_type='merge', mrg_fracname='ifrac') -! end if -! call addmrg_to(compwav, 'Fwxx_tauy', & -! mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') -! end if -! end if !PSH end !===================================================================== From e142b2d44b0444b435f0442b2bd047c21d1fcf6e Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 00:35:57 -0400 Subject: [PATCH 293/395] Cleaning up earlier, temporary code --- mediator/med_phases_prep_wav_mod.F90 | 194 +++++++++++++-------------- 1 file changed, 97 insertions(+), 97 deletions(-) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index fa6e6617e..196ca724a 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -22,10 +22,10 @@ module med_phases_prep_wav_mod use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset !PSH begin -! use esmFlds , only : med_fldList_GetfldListTo -! use med_internalstate_mod , only : compwav - use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type - use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode + use esmFlds , only : med_fldList_GetfldListTo + use med_internalstate_mod , only : compwav +! use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type +! use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode !PSH end use perf_mod , only : t_startf, t_stopf @@ -37,7 +37,7 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_avg ! called from run sequence !PSH begin - private :: med_phases_prep_wav_custom_cesm +! private :: med_phases_prep_wav_custom_cesm !PSH end character(*), parameter :: u_FILE_u = & @@ -116,27 +116,27 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) !PSH end ! auto merges to wav !PSH begin -! call med_merge_auto(& -! is_local%wrap%med_coupling_active(:,compwav), & -! is_local%wrap%FBExp(compwav), & -! is_local%wrap%FBFrac(compwav), & -! is_local%wrap%FBImp(:,compwav), & -! med_fldList_GetfldListTo(compwav), rc=rc) - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compwav), & - is_local%wrap%FBExp(compwav), & - is_local%wrap%FBFrac(compwav), & - is_local%wrap%FBImp(:,compwav), & - fldList, & - FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) + call med_merge_auto(& + is_local%wrap%med_coupling_active(:,compwav), & + is_local%wrap%FBExp(compwav), & + is_local%wrap%FBFrac(compwav), & + is_local%wrap%FBImp(:,compwav), & + med_fldList_GetfldListTo(compwav), rc=rc) +! call med_merge_auto(& +! is_local%wrap%med_coupling_active(:,compwav), & +! is_local%wrap%FBExp(compwav), & +! is_local%wrap%FBFrac(compwav), & +! is_local%wrap%FBImp(:,compwav), & +! fldList, & +! FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) !PSH end if (ChkErr(rc,__LINE__,u_FILE_u)) return !PSH begin - ! custom merges to ocean - if (trim(coupling_mode) == 'cesm') then - call med_phases_prep_wav_custom_cesm(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if +! ! custom merges to ocean +! if (trim(coupling_mode) == 'cesm') then +! call med_phases_prep_wav_custom_cesm(gcomp, rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if !PSH end ! wave accumulator @@ -224,79 +224,79 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) end subroutine med_phases_prep_wav_avg !----------------------------------------------------------------------------- - subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) - - !--------------------------------------- - ! custom calculations for cesm - !--------------------------------------- - - use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet - use ESMF , only : ESMF_VMBroadCast - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR - - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(InternalState) :: is_local - type(ESMF_Field) :: lfield - real(R8), pointer :: ifrac(:) - real(R8), pointer :: ofrac(:) - real(R8), pointer :: ifracr(:) - real(R8), pointer :: ofracr(:) - real(R8), pointer :: avsdr(:) - real(R8), pointer :: avsdf(:) - real(R8), pointer :: anidr(:) - real(R8), pointer :: anidf(:) - real(R8), pointer :: Faxa_swvdf(:) - real(R8), pointer :: Faxa_swndf(:) - real(R8), pointer :: Faxa_swvdr(:) - real(R8), pointer :: Faxa_swndr(:) - real(R8), pointer :: Foxx_swnet(:) - real(R8), pointer :: Foxx_swnet_afracr(:) - real(R8), pointer :: Foxx_swnet_vdr(:) - real(R8), pointer :: Foxx_swnet_vdf(:) - real(R8), pointer :: Foxx_swnet_idr(:) - real(R8), pointer :: Foxx_swnet_idf(:) - real(R8), pointer :: Fioi_swpen_vdr(:) - real(R8), pointer :: Fioi_swpen_vdf(:) - real(R8), pointer :: Fioi_swpen_idr(:) - real(R8), pointer :: Fioi_swpen_idf(:) - real(R8), pointer :: Fioi_swpen(:) - real(R8), pointer :: dataptr(:) - real(R8), pointer :: dataptr_scalar_ocn(:,:) - real(R8) :: frac_sum - real(R8) :: ifrac_scaled, ofrac_scaled - real(R8) :: ifracr_scaled, ofracr_scaled - logical :: export_swnet_by_bands - logical :: import_swpen_by_bands - logical :: export_swnet_afracr - real(R8) :: precip_fact(1) - character(CS) :: cvalue - real(R8) :: fswabsv, fswabsi - integer :: scalar_id - integer :: n - integer :: lsize - real(R8) :: c1,c2,c3,c4 - character(len=64), allocatable :: fldnames(:) - character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' - !--------------------------------------- - - rc = ESMF_SUCCESS - - call t_startf('MED:'//subname) - if (dbug_flag > 20) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - end if - call memcheck(subname, 5, mastertask) - - ! Get the internal state - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - +! subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) +! +! !--------------------------------------- +! ! custom calculations for cesm +! !--------------------------------------- +! +! use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet +! use ESMF , only : ESMF_VMBroadCast +! use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS +! use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR +! +! ! input/output variables +! type(ESMF_GridComp) :: gcomp +! integer, intent(out) :: rc +! +! ! local variables +! type(InternalState) :: is_local +! type(ESMF_Field) :: lfield +! real(R8), pointer :: ifrac(:) +! real(R8), pointer :: ofrac(:) +! real(R8), pointer :: ifracr(:) +! real(R8), pointer :: ofracr(:) +! real(R8), pointer :: avsdr(:) +! real(R8), pointer :: avsdf(:) +! real(R8), pointer :: anidr(:) +! real(R8), pointer :: anidf(:) +! real(R8), pointer :: Faxa_swvdf(:) +! real(R8), pointer :: Faxa_swndf(:) +! real(R8), pointer :: Faxa_swvdr(:) +! real(R8), pointer :: Faxa_swndr(:) +! real(R8), pointer :: Foxx_swnet(:) +! real(R8), pointer :: Foxx_swnet_afracr(:) +! real(R8), pointer :: Foxx_swnet_vdr(:) +! real(R8), pointer :: Foxx_swnet_vdf(:) +! real(R8), pointer :: Foxx_swnet_idr(:) +! real(R8), pointer :: Foxx_swnet_idf(:) +! real(R8), pointer :: Fioi_swpen_vdr(:) +! real(R8), pointer :: Fioi_swpen_vdf(:) +! real(R8), pointer :: Fioi_swpen_idr(:) +! real(R8), pointer :: Fioi_swpen_idf(:) +! real(R8), pointer :: Fioi_swpen(:) +! real(R8), pointer :: dataptr(:) +! real(R8), pointer :: dataptr_scalar_ocn(:,:) +! real(R8) :: frac_sum +! real(R8) :: ifrac_scaled, ofrac_scaled +! real(R8) :: ifracr_scaled, ofracr_scaled +! logical :: export_swnet_by_bands +! logical :: import_swpen_by_bands +! logical :: export_swnet_afracr +! real(R8) :: precip_fact(1) +! character(CS) :: cvalue +! real(R8) :: fswabsv, fswabsi +! integer :: scalar_id +! integer :: n +! integer :: lsize +! real(R8) :: c1,c2,c3,c4 +! character(len=64), allocatable :: fldnames(:) +! character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' +! !--------------------------------------- +! +! rc = ESMF_SUCCESS +! +! call t_startf('MED:'//subname) +! if (dbug_flag > 20) then +! call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) +! end if +! call memcheck(subname, 5, mastertask) +! +! ! Get the internal state +! nullify(is_local%wrap) +! call ESMF_GridCompGetInternalState(gcomp, is_local, rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! ! !--------------------------------------- ! ! Compute netsw for ocean ! !--------------------------------------- @@ -519,6 +519,6 @@ subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) ! end if ! call t_stopf('MED:'//subname) ! - end subroutine med_phases_prep_wav_custom_cesm +! end subroutine med_phases_prep_wav_custom_cesm end module med_phases_prep_wav_mod From 14bd205d9234aac9504fb18e214a555363da6047 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 01:02:18 -0400 Subject: [PATCH 294/395] Removed unnecessary fldList variable --- mediator/med_phases_prep_wav_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 196ca724a..3ed57c00d 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -95,7 +95,7 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) type(InternalState) :: is_local integer :: n, ncnt !PSH begin - type(med_fldlist_type), pointer :: fldList +! type(med_fldlist_type), pointer :: fldList !PSH end character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' !--------------------------------------- @@ -112,7 +112,7 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !PSH begin - fldList => med_fldList_GetfldListTo(compwav) +! fldList => med_fldList_GetfldListTo(compwav) !PSH end ! auto merges to wav !PSH begin From abc56586b0e478d2a1d8a6442115a2d6665a6605 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 07:00:36 -0400 Subject: [PATCH 295/395] Adding stress from ice to Fwxx_taux --- mediator/esmFldsExchange_cesm_mod.F90 | 32 ++++++++++++++++++++------- 1 file changed, 24 insertions(+), 8 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 94028de1d..ddf0570ce 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2983,20 +2983,36 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- +! if (phase == 'advertise') then +! call addfld_to(compwav , 'Fwxx_taux') +!! call addfld_from(compice , 'Fioi_taux') +! call addfld_aoflux('Faox_taux') +! else +! if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then +!! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then +!! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') +!! call addmrg_to(compwav, 'Fwxx_taux', & +!! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') +!! end if +! call addmrg_to(compwav, 'Fwxx_taux', & +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') +!! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') +! end if +! end if +!! if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') -! call addfld_from(compice , 'Fioi_taux') + call addfld_from(compice , 'Fioi_taux') call addfld_aoflux('Faox_taux') else if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then -! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then -! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') -! call addmrg_to(compwav, 'Fwxx_taux', & -! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') -! end if + if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then + call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') + call addmrg_to(compwav, 'Fwxx_taux', & + mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if !PSH end From cb585c5852d3701d1eedfe9fe14b42fcf980e7a3 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 09:48:17 -0400 Subject: [PATCH 296/395] Removed mrg_fracname from Fwxx merges --- mediator/esmFldsExchange_cesm_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index ddf0570ce..b3b0f56c5 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -3009,10 +3009,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge') +! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge') +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if !PSH end From 95c518851d7153e6311dfdc40a8bcf247b701681 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 11:28:03 -0400 Subject: [PATCH 297/395] Added ifrac and ofrac to FBFrac for wave component --- mediator/med_fraction_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 521ba0007..7cc5c0203 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -126,8 +126,10 @@ module med_fraction_mod character(len=6),parameter,dimension(1) :: fraclist_l = (/'lfrac '/) character(len=6),parameter,dimension(2) :: fraclist_g = (/'gfrac ','lfrac '/) character(len=6),parameter,dimension(2) :: fraclist_r = (/'rfrac ','lfrac '/) - character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) - +!PSH begin +! character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) + character(len=6),parameter,dimension(3) :: fraclist_w = (/'ifrac ','ofrac ','wfrac '/) +!PSH end !--- standard --- real(R8) , parameter :: eps_fraclim = 1.0e-03 ! truncation limit in fractions_a(lfrac) character(*), parameter :: u_FILE_u = & From 5633ff2e4a3f3ce1c3781eec53eab2df520d4ed3 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 11:29:37 -0400 Subject: [PATCH 298/395] Using ifrac and ofrac weights for Fbww merge --- mediator/esmFldsExchange_cesm_mod.F90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index b3b0f56c5..ddf0570ce 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -3009,12 +3009,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge') -! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge') -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if !PSH end From a3c13d2fe9a06f1c4db513ac60078a3c52950bb2 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 14:33:20 -0400 Subject: [PATCH 299/395] Updated comments to include wave component --- mediator/med_fraction_mod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 7cc5c0203..c97fb8994 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -23,6 +23,7 @@ module med_fraction_mod ! character(*),parameter :: fraclist_l = 'lfrac' ! character(*),parameter :: fraclist_g = 'gfrac:lfrac' ! character(*),parameter :: fraclist_r = 'lfrac:rfrac' + ! character(*),parameter :: fraclist_w = 'ifrac:ofrac:wfrac' ! ! we assume ocean and ice are on the same grids, same masks ! we assume ocn2atm and ice2atm are masked maps From 51f760183678dd96e34de5733de202167bf7ee1f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 28 Apr 2023 10:37:25 +0200 Subject: [PATCH 300/395] updates to remove mct_mod and all other mct related files from share/ --- cesm/driver/esm.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index a98976f21..b5207955a 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -796,7 +796,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #ifndef NO_MPI2 use mpi , only : MPI_COMM_NULL, mpi_comm_size #endif - use mct_mod , only : mct_world_init + use m_MCTWorld , only : mct_world_init => init #ifdef MED_PRESENT use med_internalstate_mod , only : med_id From 962646ae8d45d94cb83cd27c7f08a4c190a260b8 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 28 Apr 2023 13:07:30 -0600 Subject: [PATCH 301/395] improves the readability of salt budget --- cesm/driver/esm.F90 | 2 +- mediator/med_diag_mod.F90 | 8 +++++--- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index a98976f21..b5207955a 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -796,7 +796,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #ifndef NO_MPI2 use mpi , only : MPI_COMM_NULL, mpi_comm_size #endif - use mct_mod , only : mct_world_init + use m_MCTWorld , only : mct_world_init => init #ifdef MED_PRESENT use med_internalstate_mod , only : med_id diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 802334f6f..8ea6651ea 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -95,6 +95,8 @@ module med_diag_mod character(*), parameter :: FA1 = "(' ',a12,6f15.8)" character(*), parameter :: FA0r = "(' ',12x,8(6x,a8,1x))" character(*), parameter :: FA1r = "(' ',a12,8f15.8)" + character(*), parameter :: FA0s = "(' ',12x,8(7x,a8,2x))" + character(*), parameter :: FA1s = "(' ',a12,8g18.8)" ! --------------------------------- ! C for component @@ -2683,7 +2685,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) write(diagunit,*) ' ' write(diagunit,FAH) subname,'NET SALT BUDGET (kg/m2s): period = ',& trim(budget_diags%periods(ip)%name), ': date = ',date,tod - write(diagunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' + write(diagunit,FA0s) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' do nf = f_salt_beg, f_salt_end net_salt_atm = data(nf, c_atm_recv, ip) + data(nf, c_atm_send, ip) net_salt_lnd = data(nf, c_lnd_recv, ip) + data(nf, c_lnd_send, ip) @@ -2695,7 +2697,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) net_salt_tot = net_salt_atm + net_salt_lnd + net_salt_rof + net_salt_ocn + & net_salt_ice_nh + net_salt_ice_sh + net_salt_glc - write(diagunit,FA1r) budget_diags%fields(nf)%name,& + write(diagunit,FA1s) budget_diags%fields(nf)%name,& net_salt_atm, net_salt_lnd, net_salt_rof, net_salt_ocn, & net_salt_ice_nh, net_salt_ice_sh, net_salt_glc, net_salt_tot enddo @@ -2718,7 +2720,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) sum_net_salt_tot = sum_net_salt_atm + sum_net_salt_lnd + sum_net_salt_rof + sum_net_salt_ocn + & sum_net_salt_ice_nh + sum_net_salt_ice_sh + sum_net_salt_glc - write(diagunit,FA1r)' *SUM*',& + write(diagunit,FA1s)' *SUM*',& sum_net_salt_atm, sum_net_salt_lnd, sum_net_salt_rof, sum_net_salt_ocn, & sum_net_salt_ice_nh, sum_net_salt_ice_sh, sum_net_salt_glc, sum_net_salt_tot end if From f80e7d74337e52a7fb8d4164c78e34cdcdbae6f3 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 28 Apr 2023 13:08:34 -0600 Subject: [PATCH 302/395] undo accidental commit --- cesm/driver/esm.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index b5207955a..a98976f21 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -796,7 +796,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #ifndef NO_MPI2 use mpi , only : MPI_COMM_NULL, mpi_comm_size #endif - use m_MCTWorld , only : mct_world_init => init + use mct_mod , only : mct_world_init #ifdef MED_PRESENT use med_internalstate_mod , only : med_id From 68baf9f3999e48fc8afdcb8ca1f713aa908e9c0b Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 28 Apr 2023 15:33:46 -0400 Subject: [PATCH 303/395] Added new fractions (ifrac, ofrac) for wave component --- mediator/med_fraction_mod.F90 | 188 +++++++++++++++++++++++++++++++++- 1 file changed, 186 insertions(+), 2 deletions(-) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index c97fb8994..ed11d33f1 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -24,8 +24,10 @@ module med_fraction_mod ! character(*),parameter :: fraclist_g = 'gfrac:lfrac' ! character(*),parameter :: fraclist_r = 'lfrac:rfrac' ! character(*),parameter :: fraclist_w = 'ifrac:ofrac:wfrac' - ! - ! we assume ocean and ice are on the same grids, same masks +!PSH begin ! +! ! we assume ocean and ice are on the same grids, same masks + ! we assume ocean, ice, and waves are on the same grids, same masks +!PSH end ! we assume ocn2atm and ice2atm are masked maps ! we assume lnd2atm is a global map ! we assume that the ice fraction evolves in time but that @@ -587,6 +589,86 @@ subroutine med_fraction_init(gcomp, rc) endif endif +!PSH Begin - In progress... +! Note: started this section, based on setting ifrac and ofrac for compatm, but it is not +! clear to me that this approach is correct, since we can assume ocn, ice, wav are all on +! the same grid. Commenting out for now, can delete once I'm confident other approach +! works +! !--------------------------------------- +! ! Set 'ofrac' in FBFrac(compwav) +! !--------------------------------------- +! +! if ( is_local%wrap%comp_present(compocn) .and. & +! is_local%wrap%comp_present(compwav) .and. & +! is_local%wrap%med_coupling_active(compocn,compwav)) then +! +! ! Set 'ofrac' in FBFrac(compwav) - at this point this is the +! ! ocean mask mapped to the atm grid This is mapping the ocean mask to +! ! the wav grid +! +! if (med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),mapfcopy, rc=rc)) then +! ! If ocn and atm are on the same mesh - a redist route handle has already been created +! maptype = mapfcopy +! else +! if (trim(coupling_mode) == 'nems_orig' ) then +! maptype = mapnstod_consd +! else +! maptype = mapconsd +! end if +! if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),maptype, rc=rc)) then +! call med_map_routehandles_init( compocn, compwav, & +! FBSrc=is_local%wrap%FBImp(compocn,compocn), & +! FBDst=is_local%wrap%FBImp(compocn,compwav), & +! mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! end if +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compocn), fieldname='ofrac', field=field_src, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), fieldname='ofrac', field=field_dst, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call med_map_field(field_src, field_dst, is_local%wrap%RH(compocn,compwav,:), maptype, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return +! +! end if +! +! !--------------------------------------- +! ! Set 'ifrac' in FBFrac(compwav) +! !--------------------------------------- +! +! if ( is_local%wrap%comp_present(compice) .and. & +! is_local%wrap%comp_present(compwav) .and. & +! is_local%wrap%med_coupling_active(compice,compwav)) then +! +! ! Set 'ifrac' in FBFrac(compwav) - at this point this is the ice mask mapped to the wav mesh +! ! This maps the ice mask (which is the same as the ocean mask) to the wav mesh +! if (med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),mapfcopy, rc=rc)) then +! ! If ice and wav are on the same mesh - a redist route handle has already been created +! maptype = mapfcopy +! else +! if (trim(coupling_mode) == 'nems_orig' ) then +! maptype = mapnstod_consd +! else +! maptype = mapconsd +! end if +! if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),maptype, rc=rc)) then +! call med_map_routehandles_init( compice, compwav, & +! FBSrc=is_local%wrap%FBImp(compice,compice), & +! FBDst=is_local%wrap%FBImp(compice,compwav), & +! mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! end if +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ifrac', field=field_src, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ifrac', field=field_dst, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compwav,:), maptype, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! +!PSH end + !--------------------------------------- ! Create route handles ocn<->ice if not created !--------------------------------------- @@ -622,6 +704,80 @@ subroutine med_fraction_init(gcomp, rc) end if end if +!PSH begin + !--------------------------------------- + ! Create route handles ocn<->wav if not created + !--------------------------------------- + + if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compocn)) then + if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compocn,:),mapfcopy, rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compocn))) then + call fldbun_init(is_local%wrap%FBImp(compwav,compocn), is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compocn), & + STflds=is_local%wrap%NStateImp(compwav), & + name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compocn)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call med_map_routehandles_init(compwav, compocn, & + FBSrc=is_local%wrap%FBImp(compwav,compice), & + FBDst=is_local%wrap%FBImp(compwav,compice), & + mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),mapfcopy, rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compwav))) then + call fldbun_init(is_local%wrap%FBImp(compocn,compwav), is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compwav), & + STflds=is_local%wrap%NStateImp(compocn), & + name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compwav)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call med_map_routehandles_init( compocn, compwav, & + FBSrc=is_local%wrap%FBImp(compocn,compocn), & + FBDst=is_local%wrap%FBImp(compocn,compwav), & + mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + + !--------------------------------------- + ! Create route handles ice<->wav if not created + !--------------------------------------- + + if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compice)) then + if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compice,:),mapfcopy, rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compice))) then + call fldbun_init(is_local%wrap%FBImp(compwav,compice), is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compice), & + STflds=is_local%wrap%NStateImp(compwav), & + name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compice)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call med_map_routehandles_init(compwav, compice, & + FBSrc=is_local%wrap%FBImp(compwav,compice), & + FBDst=is_local%wrap%FBImp(compwav,compice), & + mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),mapfcopy, rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compice,compwav))) then + call fldbun_init(is_local%wrap%FBImp(compice,compwav), is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compwav), & + STflds=is_local%wrap%NStateImp(compice), & + name='FBImp'//trim(compname(compice))//'_'//trim(compname(compwav)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call med_map_routehandles_init( compice, compwav, & + FBSrc=is_local%wrap%FBImp(compice,compice), & + FBDst=is_local%wrap%FBImp(compice,compwav), & + mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + +!PSH end + + !--------------------------------------- ! Diagnostic output !--------------------------------------- @@ -757,6 +913,34 @@ subroutine med_fraction_set(gcomp, rc) endif call t_stopf('MED:'//trim(subname)//' fbfrac(compocn)') +!PSH begin + ! ------------------------------------------- + ! Set FBfrac(compwav) + ! ------------------------------------------- + + ! The following is just a redistribution from FBFrac(compice) + + call t_startf('MED:'//trim(subname)//' fbfrac(compwav)') + if (is_local%wrap%comp_present(compwav)) then + ! Map 'ifrac' from FBfrac(compice) to FBfrac(compwav) + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ifrac', field=field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ifrac', field=field_dst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compwav,:), mapfcopy, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Map 'ofrac' from FBfrac(compice) to FBfrac(compwav) + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ofrac', field=field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ofrac', field=field_dst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compwav,:), mapfcopy, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + call t_stopf('MED:'//trim(subname)//' fbfrac(compwav)') +!PSH end + ! ------------------------------------------- ! Set FBfrac(compatm) ! ------------------------------------------- From 04296bd52ca7af8e3fb57842b749075b4e1f980f Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 28 Apr 2023 15:53:56 -0400 Subject: [PATCH 304/395] Added compwav declaration to med_fraction_set subroutine --- mediator/med_fraction_mod.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index ed11d33f1..da379de13 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -808,6 +808,10 @@ subroutine med_fraction_set(gcomp, rc) use ESMF , only : ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldBundleIsCreated use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS +!PSH Begin +! use med_internalstate_mod , only : compatm, compocn, compice, compname + use med_internalstate_mod , only : compatm, compocn, compice, compname, compwav +!PSH End use med_internalstate_mod , only : compatm, compocn, compice, compname use med_internalstate_mod , only : mapfcopy, mapconsd, mapnstod_consd use med_internalstate_mod , only : coupling_mode From 5bc4403e393ee9018cf6b2179516a23169d77ed9 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 28 Apr 2023 19:59:35 -0400 Subject: [PATCH 305/395] Corrected two typos where compice was being passed instead of compwav --- mediator/med_fraction_mod.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index da379de13..3a5ac5a26 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -719,8 +719,8 @@ subroutine med_fraction_init(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if call med_map_routehandles_init(compwav, compocn, & - FBSrc=is_local%wrap%FBImp(compwav,compice), & - FBDst=is_local%wrap%FBImp(compwav,compice), & + FBSrc=is_local%wrap%FBImp(compwav,compocn), & + FBDst=is_local%wrap%FBImp(compwav,compocn), & mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -812,7 +812,6 @@ subroutine med_fraction_set(gcomp, rc) ! use med_internalstate_mod , only : compatm, compocn, compice, compname use med_internalstate_mod , only : compatm, compocn, compice, compname, compwav !PSH End - use med_internalstate_mod , only : compatm, compocn, compice, compname use med_internalstate_mod , only : mapfcopy, mapconsd, mapnstod_consd use med_internalstate_mod , only : coupling_mode use med_internalstate_mod , only : InternalState From 69317cbe2fb6f0392997f3fa33f2b7867a5f6108 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 28 Apr 2023 21:13:15 -0400 Subject: [PATCH 306/395] Removing previous additions for wavcomp --- mediator/med_fraction_mod.F90 | 194 +++++++++++++++++----------------- 1 file changed, 97 insertions(+), 97 deletions(-) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 3a5ac5a26..2a410aace 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -130,8 +130,8 @@ module med_fraction_mod character(len=6),parameter,dimension(2) :: fraclist_g = (/'gfrac ','lfrac '/) character(len=6),parameter,dimension(2) :: fraclist_r = (/'rfrac ','lfrac '/) !PSH begin -! character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) - character(len=6),parameter,dimension(3) :: fraclist_w = (/'ifrac ','ofrac ','wfrac '/) + character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) +! character(len=6),parameter,dimension(3) :: fraclist_w = (/'ifrac ','ofrac ','wfrac '/) !PSH end !--- standard --- real(R8) , parameter :: eps_fraclim = 1.0e-03 ! truncation limit in fractions_a(lfrac) @@ -705,76 +705,76 @@ subroutine med_fraction_init(gcomp, rc) end if !PSH begin - !--------------------------------------- - ! Create route handles ocn<->wav if not created - !--------------------------------------- - - if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compocn)) then - if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compocn,:),mapfcopy, rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compocn))) then - call fldbun_init(is_local%wrap%FBImp(compwav,compocn), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compocn), & - STflds=is_local%wrap%NStateImp(compwav), & - name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compocn)), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call med_map_routehandles_init(compwav, compocn, & - FBSrc=is_local%wrap%FBImp(compwav,compocn), & - FBDst=is_local%wrap%FBImp(compwav,compocn), & - mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),mapfcopy, rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compwav))) then - call fldbun_init(is_local%wrap%FBImp(compocn,compwav), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compwav), & - STflds=is_local%wrap%NStateImp(compocn), & - name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compwav)), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call med_map_routehandles_init( compocn, compwav, & - FBSrc=is_local%wrap%FBImp(compocn,compocn), & - FBDst=is_local%wrap%FBImp(compocn,compwav), & - mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end if - - !--------------------------------------- - ! Create route handles ice<->wav if not created - !--------------------------------------- - - if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compice)) then - if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compice,:),mapfcopy, rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compice))) then - call fldbun_init(is_local%wrap%FBImp(compwav,compice), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compice), & - STflds=is_local%wrap%NStateImp(compwav), & - name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compice)), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call med_map_routehandles_init(compwav, compice, & - FBSrc=is_local%wrap%FBImp(compwav,compice), & - FBDst=is_local%wrap%FBImp(compwav,compice), & - mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),mapfcopy, rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compice,compwav))) then - call fldbun_init(is_local%wrap%FBImp(compice,compwav), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compwav), & - STflds=is_local%wrap%NStateImp(compice), & - name='FBImp'//trim(compname(compice))//'_'//trim(compname(compwav)), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call med_map_routehandles_init( compice, compwav, & - FBSrc=is_local%wrap%FBImp(compice,compice), & - FBDst=is_local%wrap%FBImp(compice,compwav), & - mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end if - +! !--------------------------------------- +! ! Create route handles ocn<->wav if not created +! !--------------------------------------- +! +! if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compocn)) then +! if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compocn,:),mapfcopy, rc=rc)) then +! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compocn))) then +! call fldbun_init(is_local%wrap%FBImp(compwav,compocn), is_local%wrap%flds_scalar_name, & +! STgeom=is_local%wrap%NStateImp(compocn), & +! STflds=is_local%wrap%NStateImp(compwav), & +! name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compocn)), rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! call med_map_routehandles_init(compwav, compocn, & +! FBSrc=is_local%wrap%FBImp(compwav,compocn), & +! FBDst=is_local%wrap%FBImp(compwav,compocn), & +! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),mapfcopy, rc=rc)) then +! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compwav))) then +! call fldbun_init(is_local%wrap%FBImp(compocn,compwav), is_local%wrap%flds_scalar_name, & +! STgeom=is_local%wrap%NStateImp(compwav), & +! STflds=is_local%wrap%NStateImp(compocn), & +! name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compwav)), rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! call med_map_routehandles_init( compocn, compwav, & +! FBSrc=is_local%wrap%FBImp(compocn,compocn), & +! FBDst=is_local%wrap%FBImp(compocn,compwav), & +! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! end if +! +! !--------------------------------------- +! ! Create route handles ice<->wav if not created +! !--------------------------------------- +! +! if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compice)) then +! if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compice,:),mapfcopy, rc=rc)) then +! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compice))) then +! call fldbun_init(is_local%wrap%FBImp(compwav,compice), is_local%wrap%flds_scalar_name, & +! STgeom=is_local%wrap%NStateImp(compice), & +! STflds=is_local%wrap%NStateImp(compwav), & +! name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compice)), rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! call med_map_routehandles_init(compwav, compice, & +! FBSrc=is_local%wrap%FBImp(compwav,compice), & +! FBDst=is_local%wrap%FBImp(compwav,compice), & +! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),mapfcopy, rc=rc)) then +! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compice,compwav))) then +! call fldbun_init(is_local%wrap%FBImp(compice,compwav), is_local%wrap%flds_scalar_name, & +! STgeom=is_local%wrap%NStateImp(compwav), & +! STflds=is_local%wrap%NStateImp(compice), & +! name='FBImp'//trim(compname(compice))//'_'//trim(compname(compwav)), rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! call med_map_routehandles_init( compice, compwav, & +! FBSrc=is_local%wrap%FBImp(compice,compice), & +! FBDst=is_local%wrap%FBImp(compice,compwav), & +! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! end if +! !PSH end @@ -917,31 +917,31 @@ subroutine med_fraction_set(gcomp, rc) call t_stopf('MED:'//trim(subname)//' fbfrac(compocn)') !PSH begin - ! ------------------------------------------- - ! Set FBfrac(compwav) - ! ------------------------------------------- - - ! The following is just a redistribution from FBFrac(compice) - - call t_startf('MED:'//trim(subname)//' fbfrac(compwav)') - if (is_local%wrap%comp_present(compwav)) then - ! Map 'ifrac' from FBfrac(compice) to FBfrac(compwav) - call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ifrac', field=field_src, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ifrac', field=field_dst, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compwav,:), mapfcopy, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Map 'ofrac' from FBfrac(compice) to FBfrac(compwav) - call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ofrac', field=field_src, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ofrac', field=field_dst, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compwav,:), mapfcopy, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif - call t_stopf('MED:'//trim(subname)//' fbfrac(compwav)') +! ! ------------------------------------------- +! ! Set FBfrac(compwav) +! ! ------------------------------------------- +! +! ! The following is just a redistribution from FBFrac(compice) +! +! call t_startf('MED:'//trim(subname)//' fbfrac(compwav)') +! if (is_local%wrap%comp_present(compwav)) then +! ! Map 'ifrac' from FBfrac(compice) to FBfrac(compwav) +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ifrac', field=field_src, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ifrac', field=field_dst, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compwav,:), mapfcopy, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! +! ! Map 'ofrac' from FBfrac(compice) to FBfrac(compwav) +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ofrac', field=field_src, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ofrac', field=field_dst, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compwav,:), mapfcopy, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! endif +! call t_stopf('MED:'//trim(subname)//' fbfrac(compwav)') !PSH end ! ------------------------------------------- From baaf12cfc7f6921358eded55f669dede8c2829fc Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 28 Apr 2023 21:30:48 -0400 Subject: [PATCH 307/395] Removing stress from compice from Fwxx_taux --- mediator/esmFldsExchange_cesm_mod.F90 | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index ddf0570ce..9146ee728 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -3002,17 +3002,18 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !! if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') - call addfld_from(compice , 'Fioi_taux') +! call addfld_from(compice , 'Fioi_taux') call addfld_aoflux('Faox_taux') else if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then - if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then - call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') - end if +! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then +! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') +! call addmrg_to(compwav, 'Fwxx_taux', & +! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') +! end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if !PSH end From 24f419cd2d54ad57adeefc976d643a89e13a018b Mon Sep 17 00:00:00 2001 From: James Edwards Date: Sat, 29 Apr 2023 12:55:30 -0500 Subject: [PATCH 308/395] turn off HierarchyProtocol, not used in cesm this is a memory and initialization time saver --- cesm/driver/ensemble_driver.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index c79fade40..15bf0e1a7 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -340,6 +340,9 @@ subroutine SetModelServices(ensemble_driver, rc) else inst_suffix = '' endif + # CESM does not use this ESMF feature and at large processor counts it can be expensive to have it on. + call NUOPC_CompAttributeSet(driver, name="HierarchyProtocol", value="off", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Set the driver instance attributes call NUOPC_CompAttributeAdd(driver, attrList=(/'read_restart'/), rc=rc) From 9c43424704c8e9dc4d9cb683370190ca05e89f00 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 1 May 2023 10:31:15 -0600 Subject: [PATCH 309/395] correct comment delimiter --- cesm/driver/ensemble_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 15bf0e1a7..2656f10fc 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -340,7 +340,7 @@ subroutine SetModelServices(ensemble_driver, rc) else inst_suffix = '' endif - # CESM does not use this ESMF feature and at large processor counts it can be expensive to have it on. + ! CESM does not use this ESMF feature and at large processor counts it can be expensive to have it on. call NUOPC_CompAttributeSet(driver, name="HierarchyProtocol", value="off", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From 16d7223015c663482118e8da6a11a036ab141979 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 5 May 2023 14:40:35 +0200 Subject: [PATCH 310/395] removed unused variable --- mediator/esmFldsExchange_cesm_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index e7da536f6..69cd4391a 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -96,7 +96,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) type(InternalState) :: is_local integer :: n, ns character(len=CL) :: cvalue - character(len=CS) :: name logical :: wav_coupling_to_cice logical :: ocn2glc_coupling character(len=*) , parameter :: subname=' (esmFldsExchange_cesm) ' From dbfb31a8c74df94e4e1f8883a083af16308200cc Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 5 May 2023 14:53:13 +0200 Subject: [PATCH 311/395] removed unneeded xml variables --- .github/pull_request_template.md | 37 +-------------- cime_config/config_component.xml | 81 -------------------------------- 2 files changed, 2 insertions(+), 116 deletions(-) diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index 438a2f450..f3d2d933a 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -11,39 +11,6 @@ Are changes expected to change answers? (specify if bfb, different at roundoff, Any User Interface Changes (namelist or namelist defaults changes)? ### Testing performed +Please describe the tests along with the target model and machine(s) +If possible, please also added hashes that were used in the testing -Testing performed if application target is CESM: -- [ ] (recommended) CIME_DRIVER=nuopc scripts_regression_tests.py - - machines: - - details (e.g. failed tests): -- [ ] (recommended) CESM testlist_drv.xml - - machines and compilers: - - details (e.g. failed tests): -- [ ] (optional) CESM prealpha test - - machines and compilers - - details (e.g. failed tests): -- [ ] (other) please described in detail - - machines and compilers - - details (e.g. failed tests): - -Testing performed if application target is UFS-coupled: -- [ ] (recommended) UFS-coupled testing - - description: - - details (e.g. failed tests): - -Testing performed if application target is UFS-HAFS: -- [ ] (recommended) UFS-HAFS testing - - description: - - details (e.g. failed tests): - -### Hashes used for testing: - -- [ ] CESM: - - repository to check out: https://github.com/ESCOMP/CESM.git - - branch/hash: -- [ ] UFS-coupled, then umbrella repostiory to check out and associated hash: - - repository to check out: - - branch/hash: -- [ ] UFS-HAFS, then umbrella repostiory to check out and associated hash: - - repository to check out: - - branch/hash: diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 7f9bac96e..f986cfad2 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -1361,87 +1361,6 @@ - - - - char - idmap - run_domain - env_run.xml - atm2ocn flux mapping file - - - - char - idmap - run_domain - env_run.xml - atm2ocn state mapping file - - - - char - idmap - run_domain - env_run.xml - atm2ocn vector mapping file - - - - char - idmap - run_domain - env_run.xml - atm2lnd flux mapping file - - - - char - idmap - run_domain - env_run.xml - atm2lnd state mapping file - - - - char - idmap - run_domain - env_run.xml - atm2wav state mapping file - - - - char - idmap - run_domain - env_run.xml - ocn2atm flux mapping file - - - - char - idmap - run_domain - env_run.xml - ocn2atm state mapping file - - - - char - idmap - run_domain - env_run.xml - lnd2atm flux mapping file - - - - char - idmap - run_domain - env_run.xml - lnd2atm state mapping file - char From 7bb5053618aca5c4bf146b2e370d9af2a77c70bc Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 5 May 2023 15:03:27 +0200 Subject: [PATCH 312/395] check for nans --- mediator/med_methods_mod.F90 | 108 +++++++++++++++++++++++++++ mediator/med_phases_prep_atm_mod.F90 | 5 ++ mediator/med_phases_prep_glc_mod.F90 | 7 ++ mediator/med_phases_prep_ice_mod.F90 | 5 ++ mediator/med_phases_prep_lnd_mod.F90 | 5 ++ mediator/med_phases_prep_ocn_mod.F90 | 5 ++ mediator/med_phases_prep_rof_mod.F90 | 5 ++ mediator/med_phases_prep_wav_mod.F90 | 5 ++ 8 files changed, 145 insertions(+) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index bd5b60793..710ba51c7 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -24,6 +24,11 @@ module med_methods_mod med_methods_FieldPtr_compare2 end interface + interface med_methods_check_for_nans + module procedure med_methods_check_for_nans_1d + module procedure med_methods_check_for_nans_2d + end interface med_methods_check_for_nans + ! used/reused in module logical :: isPresent @@ -49,6 +54,7 @@ module med_methods_mod public med_methods_FB_getdata2d public med_methods_FB_getdata1d public med_methods_FB_getmesh + public med_methods_FB_check_for_nans public med_methods_State_reset public med_methods_State_diagnose @@ -71,6 +77,8 @@ module med_methods_mod #ifdef DIAGNOSE private med_methods_Array_diagnose #endif + private med_methods_check_for_nans + !----------------------------------------------------------------------------- contains !----------------------------------------------------------------------------- @@ -2497,4 +2505,104 @@ subroutine med_methods_FB_getmesh(FB, mesh, rc) end subroutine med_methods_FB_getmesh + !----------------------------------------------------------------------------- + subroutine med_methods_FB_check_for_nans(FB, rc) + + use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet, ESMF_FieldGet + + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + integer , intent(inout) :: rc + + ! local variables + type(ESMF_Field) :: field + integer :: index + integer :: fieldcount + integer :: fieldrank + character(len=CL) :: fieldname + real(r8) , pointer :: dataptr1d(:) + real(r8) , pointer :: dataptr2d(:,:) + ! ---------------------------------------------- + rc = ESMF_SUCCESS + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + do index=1,fieldCount + call med_methods_FB_getNameN(FB, index, fieldname, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(FB, fieldName=fieldname, field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, rank=fieldrank, name=fieldname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (fieldrank == 1) then + call ESMF_FieldGet(field, farrayPtr=dataptr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_FieldGet(field, farrayPtr=dataptr2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end do + + end subroutine med_methods_FB_check_for_nans + + !----------------------------------------------------------------------------- + subroutine med_methods_check_for_nans_1d(dataptr, name, rc) + ! input/output variables + real(r8) , intent(in) :: dataptr(:) + character(len=*) , intent(in) :: name + integer , intent(out) :: rc + + ! local variables + integer :: n + integer :: nancount + character(len=CS) :: nancount_char + character(len=*), parameter :: subname='(med_methods_check_for_nans_1d)' + ! ---------------------------------------------- + rc = ESMF_SUCCESS + + nancount = 0 + do n = 1,size(dataptr) + if (isnan(dataptr(n))) then + nancount = nancount + 1 + end if + end do + if (nancount > 0) then + write(nancount_char, '(i0)') nancount + call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(name), & + ESMF_LOGMSG_ERROR) + return + endif + end subroutine med_methods_check_for_nans_1d + + subroutine med_methods_check_for_nans_2d(dataptr, name, rc) + ! input/output variables + real(r8) , intent(in) :: dataptr(:,:) + character(len=*) , intent(in) :: name + integer , intent(out) :: rc + + ! local variables + integer :: n,k + integer :: nancount + character(len=CS) :: nancount_char + character(len=*), parameter :: subname='(med_methods_check_for_nans_2d)' + ! ---------------------------------------------- + rc = ESMF_SUCCESS + + nancount = 0 + do k = 1,size(dataptr, dim=1) + do n = 1,size(dataptr, dim=2) + if (isnan(dataptr(k,n))) then + nancount = nancount + 1 + end if + end do + end do + if (nancount > 0) then + write(nancount_char, '(i0)') nancount + call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(name), & + ESMF_LOGMSG_ERROR) + return + end if + end subroutine med_methods_check_for_nans_2d + end module med_methods_mod diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 9bb2b059f..bccf8e07c 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -14,6 +14,7 @@ module med_phases_prep_atm_mod use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk use med_methods_mod , only : FB_getfldptr=> med_methods_FB_GetFldPtr + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, maintask @@ -243,6 +244,10 @@ subroutine med_phases_prep_atm(gcomp, rc) end do end if + ! Check for nans in fields export to atm + call FB_check_for_nans(is_local%wrap%FBExp(compatm), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 311d91c8a..2861f3324 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -34,6 +34,7 @@ module med_phases_prep_glc_mod use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_init => med_methods_FB_init + use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans use med_methods_mod , only : field_getdata2d => med_methods_Field_getdata2d use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d use med_utils_mod , only : chkerr => med_utils_ChkErr @@ -706,6 +707,12 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) endif end if + ! Check for nans in fields export to atm + do ns = 1,is_local%wrap%num_icesheets + call fldbun_check_for_nans(is_local%wrap%FBExp(compglc(ns)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 428f3afef..1e0496b3d 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -34,6 +34,7 @@ subroutine med_phases_prep_ice(gcomp, rc) use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_merge_mod , only : med_merge_auto use med_internalstate_mod , only : InternalState, logunit, maintask @@ -149,6 +150,10 @@ subroutine med_phases_prep_ice(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if + ! Check for nans in fields export to atm + call FB_check_for_nans(is_local%wrap%FBExp(compice), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 0c0bad212..93780c254 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -29,6 +29,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) use ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND use esmFlds , only : med_fldList_GetFldListTo, med_fldList_type use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose + use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : complnd, compatm @@ -127,6 +128,10 @@ subroutine med_phases_prep_lnd(gcomp, rc) ! Set first call logical to false first_call = .false. + ! Check for nans in fields export to atm + call fldbun_check_for_nans(is_local%wrap%FBExp(complnd), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 60e37a95e..de989ac49 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -19,6 +19,7 @@ module med_phases_prep_ocn_mod use med_methods_mod , only : FB_average => med_methods_FB_average use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type use med_internalstate_mod , only : compocn, compatm, compice, coupling_mode use perf_mod , only : t_startf, t_stopf @@ -295,6 +296,10 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) call FB_copy(is_local%wrap%FBExp(compocn), is_local%wrap%FBExpAccumOcn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check for nans in fields export to atm + call FB_check_for_nans(is_local%wrap%FBExp(compocn), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! zero accumulator is_local%wrap%ExpAccumOcnCnt = 0 call FB_reset(is_local%wrap%FBExpAccumOcn, value=czero, rc=rc) diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 5d603a141..8d690124a 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -23,6 +23,7 @@ module med_phases_prep_rof_mod use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_average => med_methods_FB_average use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d + use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans use perf_mod , only : t_startf, t_stopf implicit none @@ -376,6 +377,10 @@ subroutine med_phases_prep_rof(gcomp, rc) FBfrac=is_local%wrap%FBFrac(comprof), FBin=FBlndAccum2rof_r, fldListTo=fldList, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Check for nans in fields export to atm + call fldbun_check_for_nans(is_local%wrap%FBExp(comprof), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then call fldbun_diagnose(is_local%wrap%FBExp(comprof), & string=trim(subname)//' FBexp(comprof) ', rc=rc) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 5fcb9ba7e..3028303bc 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -17,6 +17,7 @@ module med_phases_prep_wav_mod use med_methods_mod , only : FB_average => med_methods_FB_average use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use esmFlds , only : med_fldList_GetfldListTo use med_internalstate_mod , only : compwav use perf_mod , only : t_startf, t_stopf @@ -176,6 +177,10 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) call FB_copy(is_local%wrap%FBExp(compwav), is_local%wrap%FBExpAccumWav, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check for nans in fields export to atm + call FB_check_for_nans(is_local%wrap%FBExp(compwav), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! zero accumulator is_local%wrap%ExpAccumWavCnt = 0 call FB_reset(is_local%wrap%FBExpAccumWav, value=czero, rc=rc) From 9ee4d83648b2939273ee1091cb7d9a12524879ee Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 5 May 2023 15:53:47 +0200 Subject: [PATCH 313/395] refactored logic --- mediator/med_methods_mod.F90 | 53 ++++++++++++++++-------------------- 1 file changed, 23 insertions(+), 30 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 710ba51c7..e9d545a99 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2522,12 +2522,17 @@ subroutine med_methods_FB_check_for_nans(FB, rc) character(len=CL) :: fieldname real(r8) , pointer :: dataptr1d(:) real(r8) , pointer :: dataptr2d(:,:) + integer :: nancount + character(len=CS) :: nancount_char + logical :: nanfound + character(len=*), parameter :: subname='(med_methods_FB_check_for_nans)' ! ---------------------------------------------- rc = ESMF_SUCCESS call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + nanfound = .false. do index=1,fieldCount call med_methods_FB_getNameN(FB, index, fieldname, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -2538,57 +2543,51 @@ subroutine med_methods_FB_check_for_nans(FB, rc) if (fieldrank == 1) then call ESMF_FieldGet(field, farrayPtr=dataptr1d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_check_for_nans(dataptr1d, nancount) else call ESMF_FieldGet(field, farrayPtr=dataptr2d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_check_for_nans(dataptr2d, nancount) + end if + if (nancount > 0) then + write(nancount_char, '(i0)') nancount + call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(fieldname), & + ESMF_LOGMSG_WARNING) + nanfound = .true. end if end do + if (nanfound) then + call ESMF_LogWrite(trim(subname)//": ERROR nans found in export field bundle ",ESMF_LOGMSG_ERROR) + return + end if end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- - subroutine med_methods_check_for_nans_1d(dataptr, name, rc) + subroutine med_methods_check_for_nans_1d(dataptr, nancount) ! input/output variables - real(r8) , intent(in) :: dataptr(:) - character(len=*) , intent(in) :: name - integer , intent(out) :: rc + real(r8) , intent(in) :: dataptr(:) + integer , intent(out) :: nancount ! local variables integer :: n - integer :: nancount - character(len=CS) :: nancount_char - character(len=*), parameter :: subname='(med_methods_check_for_nans_1d)' ! ---------------------------------------------- - rc = ESMF_SUCCESS - nancount = 0 do n = 1,size(dataptr) if (isnan(dataptr(n))) then nancount = nancount + 1 end if end do - if (nancount > 0) then - write(nancount_char, '(i0)') nancount - call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(name), & - ESMF_LOGMSG_ERROR) - return - endif end subroutine med_methods_check_for_nans_1d - subroutine med_methods_check_for_nans_2d(dataptr, name, rc) + subroutine med_methods_check_for_nans_2d(dataptr, nancount) ! input/output variables - real(r8) , intent(in) :: dataptr(:,:) - character(len=*) , intent(in) :: name - integer , intent(out) :: rc + real(r8) , intent(in) :: dataptr(:,:) + integer , intent(out) :: nancount ! local variables integer :: n,k - integer :: nancount - character(len=CS) :: nancount_char - character(len=*), parameter :: subname='(med_methods_check_for_nans_2d)' ! ---------------------------------------------- - rc = ESMF_SUCCESS - nancount = 0 do k = 1,size(dataptr, dim=1) do n = 1,size(dataptr, dim=2) @@ -2597,12 +2596,6 @@ subroutine med_methods_check_for_nans_2d(dataptr, name, rc) end if end do end do - if (nancount > 0) then - write(nancount_char, '(i0)') nancount - call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(name), & - ESMF_LOGMSG_ERROR) - return - end if end subroutine med_methods_check_for_nans_2d end module med_methods_mod From 3ad7f1f7e9df8a236a3b2d6ab89b37711bab701f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 5 May 2023 16:00:53 +0200 Subject: [PATCH 314/395] updated med_diag_mod with recent changes from escomp --- mediator/med_diag_mod.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 802334f6f..8ea6651ea 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -95,6 +95,8 @@ module med_diag_mod character(*), parameter :: FA1 = "(' ',a12,6f15.8)" character(*), parameter :: FA0r = "(' ',12x,8(6x,a8,1x))" character(*), parameter :: FA1r = "(' ',a12,8f15.8)" + character(*), parameter :: FA0s = "(' ',12x,8(7x,a8,2x))" + character(*), parameter :: FA1s = "(' ',a12,8g18.8)" ! --------------------------------- ! C for component @@ -2683,7 +2685,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) write(diagunit,*) ' ' write(diagunit,FAH) subname,'NET SALT BUDGET (kg/m2s): period = ',& trim(budget_diags%periods(ip)%name), ': date = ',date,tod - write(diagunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' + write(diagunit,FA0s) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' do nf = f_salt_beg, f_salt_end net_salt_atm = data(nf, c_atm_recv, ip) + data(nf, c_atm_send, ip) net_salt_lnd = data(nf, c_lnd_recv, ip) + data(nf, c_lnd_send, ip) @@ -2695,7 +2697,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) net_salt_tot = net_salt_atm + net_salt_lnd + net_salt_rof + net_salt_ocn + & net_salt_ice_nh + net_salt_ice_sh + net_salt_glc - write(diagunit,FA1r) budget_diags%fields(nf)%name,& + write(diagunit,FA1s) budget_diags%fields(nf)%name,& net_salt_atm, net_salt_lnd, net_salt_rof, net_salt_ocn, & net_salt_ice_nh, net_salt_ice_sh, net_salt_glc, net_salt_tot enddo @@ -2718,7 +2720,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) sum_net_salt_tot = sum_net_salt_atm + sum_net_salt_lnd + sum_net_salt_rof + sum_net_salt_ocn + & sum_net_salt_ice_nh + sum_net_salt_ice_sh + sum_net_salt_glc - write(diagunit,FA1r)' *SUM*',& + write(diagunit,FA1s)' *SUM*',& sum_net_salt_atm, sum_net_salt_lnd, sum_net_salt_rof, sum_net_salt_ocn, & sum_net_salt_ice_nh, sum_net_salt_ice_sh, sum_net_salt_glc, sum_net_salt_tot end if From 311582ca09f91feca75c7d411e620e3c28648019 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Sat, 6 May 2023 13:29:39 -0600 Subject: [PATCH 315/395] This fails to enable writing of 'daily' files from forecasts shorter than 24 hours --- cime_config/namelist_definition_drv.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index d403caad1..d62eacc57 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1526,7 +1526,7 @@ MED_attributes history option type - ndays + nhours @@ -1989,7 +1989,7 @@ MED_attributes history option type - ndays + nhours @@ -1998,7 +1998,7 @@ MED_attributes history option type - 1 + 6 From 83bba42b9671e2c76c73db654d884fcf2f2082b6 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 May 2023 13:51:06 +0200 Subject: [PATCH 316/395] updated counters for nans --- mediator/med_methods_mod.F90 | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index e9d545a99..5188ed9f2 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2515,16 +2515,17 @@ subroutine med_methods_FB_check_for_nans(FB, rc) integer , intent(inout) :: rc ! local variables - type(ESMF_Field) :: field - integer :: index - integer :: fieldcount - integer :: fieldrank - character(len=CL) :: fieldname - real(r8) , pointer :: dataptr1d(:) - real(r8) , pointer :: dataptr2d(:,:) - integer :: nancount - character(len=CS) :: nancount_char - logical :: nanfound + type(ESMF_Field) :: field + integer :: index + integer :: fieldcount + integer :: fieldrank + character(len=CL) :: fieldname + real(r8) , pointer :: dataptr1d(:) + real(r8) , pointer :: dataptr2d(:,:) + integer :: nancount + character(len=CS) :: nancount_char + character(len=CL) :: msg_error + logical :: nanfound character(len=*), parameter :: subname='(med_methods_FB_check_for_nans)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -2543,21 +2544,22 @@ subroutine med_methods_FB_check_for_nans(FB, rc) if (fieldrank == 1) then call ESMF_FieldGet(field, farrayPtr=dataptr1d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_check_for_nans(dataptr1d, nancount) + call med_methods_check_for_nans(dataptr1d, nancount) else call ESMF_FieldGet(field, farrayPtr=dataptr2d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_check_for_nans(dataptr2d, nancount) + call med_methods_check_for_nans(dataptr2d, nancount) end if if (nancount > 0) then write(nancount_char, '(i0)') nancount - call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(fieldname), & - ESMF_LOGMSG_WARNING) + msg_error = "ERROR: " // trim(nancount_char) //" nans found in "//trim(fieldname) + call ESMF_LogWrite(trim(msg_error), ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) nanfound = .true. end if end do if (nanfound) then - call ESMF_LogWrite(trim(subname)//": ERROR nans found in export field bundle ",ESMF_LOGMSG_ERROR) + call ESMF_LogWrite('ABORTING JOB', ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE return end if @@ -2565,6 +2567,7 @@ end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- subroutine med_methods_check_for_nans_1d(dataptr, nancount) + use shr_infnan_mod, only: nan => shr_infnan_nan, inf => shr_infnan_inf, assignment(=) ! input/output variables real(r8) , intent(in) :: dataptr(:) integer , intent(out) :: nancount @@ -2581,6 +2584,7 @@ subroutine med_methods_check_for_nans_1d(dataptr, nancount) end subroutine med_methods_check_for_nans_1d subroutine med_methods_check_for_nans_2d(dataptr, nancount) + use shr_infnan_mod, only: nan => shr_infnan_nan, inf => shr_infnan_inf, assignment(=) ! input/output variables real(r8) , intent(in) :: dataptr(:,:) integer , intent(out) :: nancount From 0b59db6514a76cf8369cdbeb5c829e58e44b9df5 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 May 2023 13:55:09 +0200 Subject: [PATCH 317/395] consistent alias of use statements for check_for_nans --- mediator/med_phases_prep_glc_mod.F90 | 4 ++-- mediator/med_phases_prep_lnd_mod.F90 | 4 ++-- mediator/med_phases_prep_rof_mod.F90 | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 2861f3324..97049d5b9 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -34,7 +34,7 @@ module med_phases_prep_glc_mod use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_init => med_methods_FB_init - use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_methods_mod , only : field_getdata2d => med_methods_Field_getdata2d use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d use med_utils_mod , only : chkerr => med_utils_ChkErr @@ -709,7 +709,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) ! Check for nans in fields export to atm do ns = 1,is_local%wrap%num_icesheets - call fldbun_check_for_nans(is_local%wrap%FBExp(compglc(ns)), rc=rc) + call FB_check_for_nans(is_local%wrap%FBExp(compglc(ns)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 93780c254..b73412937 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -29,7 +29,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) use ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND use esmFlds , only : med_fldList_GetFldListTo, med_fldList_type use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose - use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : complnd, compatm @@ -129,7 +129,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) first_call = .false. ! Check for nans in fields export to atm - call fldbun_check_for_nans(is_local%wrap%FBExp(complnd), rc=rc) + call FB_check_for_nans(is_local%wrap%FBExp(complnd), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 8d690124a..cf0ad0f4e 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -23,7 +23,7 @@ module med_phases_prep_rof_mod use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_average => med_methods_FB_average use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d - use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use perf_mod , only : t_startf, t_stopf implicit none @@ -378,7 +378,7 @@ subroutine med_phases_prep_rof(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Check for nans in fields export to atm - call fldbun_check_for_nans(is_local%wrap%FBExp(comprof), rc=rc) + call FB_check_for_nans(is_local%wrap%FBExp(comprof), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then From 64439f74578d01ece0f4a87b41f6c25897751321 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 May 2023 14:03:16 +0200 Subject: [PATCH 318/395] fixed compilation bug --- mediator/med_methods_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 5188ed9f2..8c781e7c3 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2567,7 +2567,8 @@ end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- subroutine med_methods_check_for_nans_1d(dataptr, nancount) - use shr_infnan_mod, only: nan => shr_infnan_nan, inf => shr_infnan_inf, assignment(=) + use shr_infnan_mod, only: nan => isnan + ! input/output variables real(r8) , intent(in) :: dataptr(:) integer , intent(out) :: nancount @@ -2584,7 +2585,8 @@ subroutine med_methods_check_for_nans_1d(dataptr, nancount) end subroutine med_methods_check_for_nans_1d subroutine med_methods_check_for_nans_2d(dataptr, nancount) - use shr_infnan_mod, only: nan => shr_infnan_nan, inf => shr_infnan_inf, assignment(=) + use shr_infnan_mod, only: isnan + ! input/output variables real(r8) , intent(in) :: dataptr(:,:) integer , intent(out) :: nancount From 5e02def6328fc0352cae83e2f366604c712caf8b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 May 2023 14:26:13 +0200 Subject: [PATCH 319/395] add ability to compile without needed shr_infnan - as is the case for UFS --- mediator/med_methods_mod.F90 | 45 ++++++++++++++++++++++++++++-------- 1 file changed, 35 insertions(+), 10 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 8c781e7c3..3d29fde6f 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2530,6 +2530,11 @@ subroutine med_methods_FB_check_for_nans(FB, rc) ! ---------------------------------------------- rc = ESMF_SUCCESS +#ifndef CESM_COUPLED + ! For now only CESM uses shr_infnan_isnan - so until other models provide this + RETURN +#endif + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2566,42 +2571,62 @@ subroutine med_methods_FB_check_for_nans(FB, rc) end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- - subroutine med_methods_check_for_nans_1d(dataptr, nancount) - use shr_infnan_mod, only: nan => isnan +#ifdef CESM_COUPLED + subroutine med_methods_check_for_nans_1d(dataptr, nancount) + use shr_infnan_mod, only: shr_infnan_isnan ! input/output variables real(r8) , intent(in) :: dataptr(:) integer , intent(out) :: nancount - ! local variables integer :: n - ! ---------------------------------------------- + nancount = 0 do n = 1,size(dataptr) - if (isnan(dataptr(n))) then + if (shr_infnan_isnan(dataptr(n))) then nancount = nancount + 1 end if end do end subroutine med_methods_check_for_nans_1d subroutine med_methods_check_for_nans_2d(dataptr, nancount) - use shr_infnan_mod, only: isnan - + use shr_infnan_mod, only: shr_infan_isnan ! input/output variables real(r8) , intent(in) :: dataptr(:,:) integer , intent(out) :: nancount - ! local variables integer :: n,k - ! ---------------------------------------------- + nancount = 0 do k = 1,size(dataptr, dim=1) do n = 1,size(dataptr, dim=2) - if (isnan(dataptr(k,n))) then + if (shr_infan_isnan(dataptr(k,n))) then nancount = nancount + 1 end if end do end do end subroutine med_methods_check_for_nans_2d +#else + + ! For now only CESM uses shr_infnan_isnan - so until other models provide this + ! nancount will just be set to zero + + subroutine med_methods_check_for_nans_1d(dataptr, nancount) + ! input/output variables + real(r8) , intent(in) :: dataptr(:) + integer , intent(out) :: nancount + + nancount = 0 + end subroutine med_methods_check_for_nans_1d + + subroutine med_methods_check_for_nans_2d(dataptr, nancount) + ! input/output variables + real(r8) , intent(in) :: dataptr(:,:) + integer , intent(out) :: nancount + + nancount = 0 + end subroutine med_methods_check_for_nans_2d +#endif + end module med_methods_mod From f1dedf5899b446b2fede15932eede85d5599b42d Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 9 May 2023 15:08:05 -0400 Subject: [PATCH 320/395] Changed Fwxx_taux merge to use 'wfrac' --- mediator/esmFldsExchange_cesm_mod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 9146ee728..068acb503 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -3012,7 +3012,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') ! end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='wfrac') +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if From 2685626c2c47d6801b72744c0ac90b98ace261a2 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 10 May 2023 12:58:00 -0400 Subject: [PATCH 321/395] Adding merge to wave component Fwxx_taux based on Foxx_taux --- mediator/esmFldsExchange_cesm_mod.F90 | 33 ++++++++++++--------------- 1 file changed, 15 insertions(+), 18 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 068acb503..87fdee38f 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2983,6 +2983,21 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_to(compwav , 'Fwxx_taux') + call addfld_from(compice , 'Fioi_taux') + call addfld_aoflux('Faox_taux') + else + if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then + if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then + call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') + call addmrg_to(compwav, 'Fwxx_taux', & + mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + end if + call addmrg_to(compocn, 'Fwxx_taux', & + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + end if + end if ! if (phase == 'advertise') then ! call addfld_to(compwav , 'Fwxx_taux') !! call addfld_from(compice , 'Fioi_taux') @@ -2999,24 +3014,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') ! end if ! end if -!! - if (phase == 'advertise') then - call addfld_to(compwav , 'Fwxx_taux') -! call addfld_from(compice , 'Fioi_taux') - call addfld_aoflux('Faox_taux') - else - if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then -! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then -! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') -! call addmrg_to(compwav, 'Fwxx_taux', & -! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') -! end if - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='wfrac') -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') - end if - end if !PSH end !===================================================================== From 9d4e81c5169b0a8ca750a063e3340882ab6225d3 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 10 May 2023 14:19:12 -0400 Subject: [PATCH 322/395] Fixed a compocn that should have been compwav --- mediator/esmFldsExchange_cesm_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 87fdee38f..397a92ba1 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2994,7 +2994,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compwav, 'Fwxx_taux', & mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') end if - call addmrg_to(compocn, 'Fwxx_taux', & + call addmrg_to(compwav, 'Fwxx_taux', & mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if From 3ca2795f9febd5422497a2c63f423e57e2cb4aaa Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 10 May 2023 15:21:48 -0400 Subject: [PATCH 323/395] Adding ifrac and ofrac to fraclist_w --- mediator/med_fraction_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 2a410aace..ded0e4e7d 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -130,8 +130,8 @@ module med_fraction_mod character(len=6),parameter,dimension(2) :: fraclist_g = (/'gfrac ','lfrac '/) character(len=6),parameter,dimension(2) :: fraclist_r = (/'rfrac ','lfrac '/) !PSH begin - character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) -! character(len=6),parameter,dimension(3) :: fraclist_w = (/'ifrac ','ofrac ','wfrac '/) +! character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) + character(len=6),parameter,dimension(3) :: fraclist_w = (/'ifrac ','ofrac ','wfrac '/) !PSH end !--- standard --- real(R8) , parameter :: eps_fraclim = 1.0e-03 ! truncation limit in fractions_a(lfrac) From 7ac3ca9a8d331ee6e09e43458478ed29626293f2 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 10 May 2023 13:40:40 -0600 Subject: [PATCH 324/395] make history_n integer variables --- cime_config/namelist_definition_drv.xml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 0ade5db43..501d6896e 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1264,7 +1264,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1329,7 +1329,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1396,7 +1396,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1465,7 +1465,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1530,7 +1530,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1748,7 +1748,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1830,7 +1830,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1993,7 +1993,7 @@ - char + integer aux_hist MED_attributes history option type From b22ae222b571f7e5196052d581c74ce6d2611be0 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 10 May 2023 13:44:49 -0600 Subject: [PATCH 325/395] sames should be samples --- cime_config/namelist_definition_drv.xml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 501d6896e..5cbf78319 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1294,7 +1294,7 @@ integer aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 24 @@ -1350,7 +1350,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 24 @@ -1417,7 +1417,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 8 @@ -1486,7 +1486,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 8 @@ -1551,7 +1551,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 1 @@ -1769,7 +1769,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 1 @@ -1860,7 +1860,7 @@ integer aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 30 @@ -2014,7 +2014,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 1 From cca94e4b7bf6e39fa19ddfc865749da08f8dccaa Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 10 May 2023 16:09:27 -0600 Subject: [PATCH 326/395] wopen should return rc --- mediator/med_io_mod.F90 | 33 ++++++++++++++--------------- mediator/med_phases_history_mod.F90 | 18 ++++++++++------ mediator/med_phases_restart_mod.F90 | 3 ++- 3 files changed, 30 insertions(+), 24 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 97db9bcc0..38ae201f2 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -7,7 +7,7 @@ module med_io_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, I8=>SHR_KIND_I8, R8=>SHR_KIND_R8 use med_kind_mod , only : R4=>SHR_KIND_R4 use med_constants_mod , only : fillvalue => SHR_CONST_SPVAL - use ESMF , only : ESMF_VM, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError + use ESMF , only : ESMF_VM, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError, ESMF_LOGMSG_ERROR use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_END_ABORT, ESMF_LOGERR_PASSTHRU use ESMF , only : ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadCast, ESMF_Finalize use NUOPC , only : NUOPC_FieldDictionaryGetEntry @@ -198,7 +198,7 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. '64BIT_DATA') then pio_ioformat = PIO_64BIT_DATA else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_ioformat (CLASSIC|64BIT_OFFSET|64BIT_DATA)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_ioformat (CLASSIC|64BIT_OFFSET|64BIT_DATA)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -223,7 +223,7 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. 'NETCDF4P') then pio_iotype = PIO_IOTYPE_NETCDF4P else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_typename (NETCDF|PNETCDF|NETCDF4C|NETCDF4P)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_typename (NETCDF|PNETCDF|NETCDF4C|NETCDF4P)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -334,13 +334,13 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. 'SUBSET') then pio_rearranger = PIO_REARR_SUBSET else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearranger (BOX|SUBSET)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearranger (BOX|SUBSET)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if else - cvalue = 'BOX' - pio_rearranger = PIO_REARR_BOX + cvalue = 'SUBSET' + pio_rearranger = PIO_REARR_SUBSET end if if (localPet == 0) write(logunit,*) trim(subname), ' : pio_rearranger = ', trim(cvalue), pio_rearranger @@ -357,7 +357,7 @@ subroutine med_io_init(gcomp, rc) if (isPresent .and. isSet) then read(cvalue,*) pio_debug_level if (pio_debug_level < 0 .or. pio_debug_level > 6) then - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_debug_level (0-6)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_debug_level (0-6)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -381,7 +381,7 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. 'COLL') then pio_rearr_comm_type = PIO_REARR_COMM_COLL else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_type (P2P|COLL)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_type (P2P|COLL)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -406,7 +406,7 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. '2DDISABLE') then pio_rearr_comm_fcd = PIO_REARR_COMM_FC_2D_DISABLE else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_fcd (2DENABLE|IO2COMP|COMP2IO|2DDISABLE)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_fcd (2DENABLE|IO2COMP|COMP2IO|2DDISABLE)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -498,7 +498,7 @@ subroutine med_io_init(gcomp, rc) end subroutine med_io_init !=============================================================================== - subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) + subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) !--------------- ! open netcdf file @@ -512,16 +512,15 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) ! input/output arguments character(*), intent(in) :: filename type(ESMF_VM) :: vm + integer, intent(out) :: rc logical, optional, intent(in) :: clobber integer, optional, intent(in) :: file_ind character(CL), optional, intent(in) :: model_doi_url - ! local variables logical :: lclobber integer :: rcode integer :: nmode integer :: lfile_ind - integer :: rc integer :: iam character(CL) :: lversion character(CL) :: lmodel_doi_url @@ -539,10 +538,11 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind - if (.not. pio_file_is_open(io_file(lfile_ind))) then + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (.not. pio_file_is_open(io_file(lfile_ind))) then ! filename not open wfilename(lfile_ind) = trim(filename) @@ -589,7 +589,7 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) write(logunit,'(a)') trim(subname)//' different filename currently open '//trim(filename) write(logunit,'(a)') trim(subname)//' different wfilename currently open '//trim(wfilename(lfile_ind)) end if - call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return @@ -848,7 +848,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif - rc = ESMF_Success return endif diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 2f7c9f062..00444b292 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -292,7 +292,8 @@ subroutine med_phases_history_write(gcomp, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Loop over whead/wdata phases do m = 1,2 @@ -463,7 +464,8 @@ subroutine med_phases_history_write_med(gcomp, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then @@ -596,7 +598,8 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write data to history file do m = 1,2 @@ -749,7 +752,8 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then @@ -953,7 +957,8 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then @@ -1276,7 +1281,8 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! open file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(auxcomp%files(nf)%histfile, vm, file_ind=nf, clobber=.true.) + call med_io_wopen(auxcomp%files(nf)%histfile, vm, rc, file_ind=nf, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! define time variables call ESMF_ClockGet(auxcomp%files(nf)%clock, calendar=calendar, rc=rc) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 6bf5f3466..3b276b08e 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -309,7 +309,8 @@ subroutine med_phases_restart_write(gcomp, rc) call ESMF_LogWrite(trim(subname)//": write "//trim(restart_file), ESMF_LOGMSG_INFO) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(restart_file, vm, clobber=.true.) + call med_io_wopen(restart_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 if (m == 2) then From a31664644ec8e90d3a53bcc11602fc5e3eb6774f Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 11 May 2023 10:23:32 -0600 Subject: [PATCH 327/395] major refactor of med_io_mod to handle multiple files --- mediator/med_io_mod.F90 | 345 +++++++++++----------------- mediator/med_phases_history_mod.F90 | 116 +++++----- mediator/med_phases_restart_mod.F90 | 53 ++--- 3 files changed, 227 insertions(+), 287 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 38ae201f2..9215777c0 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -77,8 +77,9 @@ module med_io_mod character(*),parameter :: version = "cmeps0" integer , parameter :: number_strlen = 8 integer , parameter :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now - character(CL) :: wfilename(0:file_desc_t_cnt) = '' - type(file_desc_t) :: io_file(0:file_desc_t_cnt) + +! character(CL) :: wfilename(0:file_desc_t_cnt) = '' + integer :: pio_iotype integer :: pio_ioformat type(iosystem_desc_t), pointer :: io_subsystem @@ -498,7 +499,7 @@ subroutine med_io_init(gcomp, rc) end subroutine med_io_init !=============================================================================== - subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) + subroutine med_io_wopen(filename, io_file, vm, rc, clobber, file_ind, model_doi_url) !--------------- ! open netcdf file @@ -511,6 +512,7 @@ subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) ! input/output arguments character(*), intent(in) :: filename + type(file_desc_t), intent(inout) :: io_file type(ESMF_VM) :: vm integer, intent(out) :: rc logical, optional, intent(in) :: clobber @@ -542,10 +544,10 @@ subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (.not. pio_file_is_open(io_file(lfile_ind))) then + if (.not. pio_file_is_open(io_file)) then ! filename not open - wfilename(lfile_ind) = trim(filename) +! wfilename(lfile_ind) = trim(filename) if (med_io_file_exists(vm, filename)) then if (lclobber) then @@ -554,20 +556,20 @@ subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) if(pio_iotype == PIO_IOTYPE_NETCDF .or. pio_iotype == PIO_IOTYPE_PNETCDF) then nmode = ior(nmode,pio_ioformat) endif - rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) + rcode = pio_createfile(io_subsystem, io_file, pio_iotype, trim(filename), nmode) if(iam==0) write(logunit,'(a)') trim(subname)//' creating file '//trim(filename) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) + rcode = pio_put_att(io_file,pio_global,"file_version",version) + rcode = pio_put_att(io_file,pio_global,"model_doi_url",lmodel_doi_url) else - rcode = pio_openfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), pio_write) + rcode = pio_openfile(io_subsystem, io_file, pio_iotype, trim(filename), pio_write) if (iam==0) write(logunit,'(a)') trim(subname)//' opening file '//trim(filename) - call pio_seterrorhandling(io_file(lfile_ind),PIO_BCAST_ERROR) - rcode = pio_get_att(io_file(lfile_ind),pio_global,"file_version",lversion) - call pio_seterrorhandling(io_file(lfile_ind),PIO_INTERNAL_ERROR) + call pio_seterrorhandling(io_file,PIO_BCAST_ERROR) + rcode = pio_get_att(io_file,pio_global,"file_version",lversion) + call pio_seterrorhandling(io_file,PIO_INTERNAL_ERROR) if (trim(lversion) /= trim(version)) then - rcode = pio_redef(io_file(lfile_ind)) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) - rcode = pio_enddef(io_file(lfile_ind)) + rcode = pio_redef(io_file) + rcode = pio_put_att(io_file,pio_global,"file_version",version) + rcode = pio_enddef(io_file) endif endif else @@ -577,21 +579,21 @@ subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) nmode = ior(nmode,pio_ioformat) endif - rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) + rcode = pio_createfile(io_subsystem, io_file, pio_iotype, trim(filename), nmode) if (iam==0) write(logunit,'(a)') trim(subname) //' creating file '// trim(filename) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) + rcode = pio_put_att(io_file,pio_global,"file_version",version) + rcode = pio_put_att(io_file,pio_global,"model_doi_url",lmodel_doi_url) endif - elseif (trim(wfilename(lfile_ind)) /= trim(filename)) then +! elseif (trim(wfilename(lfile_ind)) /= trim(filename)) then ! filename is open, better match open filename - if (iam==0) then - write(logunit,'(a)') trim(subname)//' different filename currently open '//trim(filename) - write(logunit,'(a)') trim(subname)//' different wfilename currently open '//trim(wfilename(lfile_ind)) - end if - call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return +! if (iam==0) then +! write(logunit,'(a)') trim(subname)//' different filename currently open '//trim(filename) +! write(logunit,'(a)') trim(subname)//' different wfilename currently open '//trim(wfilename(lfile_ind)) +! end if +! call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_ERROR) +! rc = ESMF_FAILURE +! return else ! filename is already open, just return @@ -600,7 +602,7 @@ subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) end subroutine med_io_wopen !=============================================================================== - subroutine med_io_close(filename, vm, file_ind, rc) + subroutine med_io_close(io_file, rc) !--------------- ! close netcdf file @@ -609,85 +611,52 @@ subroutine med_io_close(filename, vm, file_ind, rc) use pio, only: pio_file_is_open, pio_closefile ! input/output variables - character(*) , intent(in) :: filename - type(ESMF_VM) , intent(in) :: vm - integer,optional , intent(in) :: file_ind + type(file_desc_t) :: io_file integer , intent(out) :: rc ! local variables - integer :: lfile_ind + integer :: iam character(*),parameter :: subName = '(med_io_close) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - - if (.not. pio_file_is_open(io_file(lfile_ind))) then - ! filename not open, just return - elseif (trim(wfilename(lfile_ind)) == trim(filename)) then - ! filename matches, close it - call pio_closefile(io_file(lfile_ind)) - !wfilename(lfile_ind) = '' - else - call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! different filename is open, abort - if (iam==0) then - write(logunit,*) subname,' different wfilename and filename currently open, aborting ' - write(logunit,'(a)') 'filename = ',trim(filename) - write(logunit,'(a)') 'wfilename = ',trim(wfilename(lfile_ind)) - write(logunit,'(i6)')'lfile_ind = ',lfile_ind - end if - call ESMF_LogWrite(subname//'different file currently open, aborting '//trim(filename), ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if + if (pio_file_is_open(io_file)) then + call pio_closefile(io_file) endif end subroutine med_io_close !=============================================================================== - subroutine med_io_redef(filename,file_ind) + subroutine med_io_redef(io_file) use pio, only : pio_redef ! input/output variables - character(len=*), intent(in) :: filename - integer,optional,intent(in):: file_ind - + type(file_desc_t) :: io_file ! local variables - integer :: lfile_ind integer :: rcode !------------------------------------------------------------------------------- - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - rcode = pio_redef(io_file(lfile_ind)) + rcode = pio_redef(io_file) end subroutine med_io_redef !=============================================================================== - subroutine med_io_enddef(filename,file_ind) + subroutine med_io_enddef(io_file) use pio, only : pio_enddef ! input/output variables - character(len=*) , intent(in) :: filename - integer,optional , intent(in) :: file_ind + type(file_desc_t) :: io_file ! local variables - integer :: lfile_ind + integer :: rcode !------------------------------------------------------------------------------- - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - rcode = pio_enddef(io_file(lfile_ind)) + rcode = pio_enddef(io_file) end subroutine med_io_enddef @@ -746,8 +715,8 @@ character(len=8) function med_io_sec2hms (seconds, rc) end function med_io_sec2hms !=============================================================================== - subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & - fillval, pre, flds, tavg, use_float, file_ind, tilesize, rc) + subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & + fillval, pre, flds, tavg, use_float, tilesize, rc) !--------------- ! Write FB to netcdf file @@ -765,7 +734,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & use pio , only : pio_syncfile ! input/output variables - character(len=*) , intent(in) :: filename ! file + type(file_desc_t) :: io_file type(ESMF_FieldBundle) , intent(in) :: FB ! data to be written logical , intent(in) :: whead ! write header logical , intent(in) :: wdata ! write data @@ -777,7 +746,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & character(len=*), optional , intent(in) :: flds(:) ! specific fields to write out logical, optional , intent(in) :: tavg ! is this a tavg logical, optional , intent(in) :: use_float ! write output as float rather than double - integer, optional , intent(in) :: file_ind integer, optional , intent(in) :: tilesize ! if non-zero, write atm component on tiles integer , intent(out):: rc @@ -811,7 +779,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & integer, pointer :: maxIndexPTile(:,:) integer :: dimCount, tileCount integer, pointer :: Dof(:) - integer :: lfile_ind real(r8), pointer :: fldptr1(:) real(r8), pointer :: fldptr2(:,:) real(r8), allocatable :: ownedElemCoords(:), ownedElemCoords_x(:), ownedElemCoords_y(:) @@ -835,8 +802,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & if (present(pre)) lpre = trim(pre) luse_float = .false. if (present(use_float)) luse_float = use_float - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind + atmtiles = .false. if (present(tilesize)) then if (tilesize > 0) atmtiles = .true. @@ -953,22 +919,22 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & ! Write header if (whead) then if (atmtiles) then - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_nx', lnx, dimid3(1)) - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_ny', lny, dimid3(2)) - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_ntiles', ntiles, dimid3(3)) + rcode = pio_def_dim(io_file, trim(lpre)//'_nx', lnx, dimid3(1)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ny', lny, dimid3(2)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ntiles', ntiles, dimid3(3)) if (present(nt)) then dimid4(1:3) = dimid3 - rcode = pio_inq_dimid(io_file(lfile_ind), 'time', dimid4(4)) + rcode = pio_inq_dimid(io_file, 'time', dimid4(4)) dimid => dimid4 else dimid => dimid3 endif else - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_nx', lnx, dimid2(1)) - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_ny', lny, dimid2(2)) + rcode = pio_def_dim(io_file, trim(lpre)//'_nx', lnx, dimid2(1)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ny', lny, dimid2(2)) if (present(nt)) then dimid3(1:2) = dimid2 - rcode = pio_inq_dimid(io_file(lfile_ind), 'time', dimid3(3)) + rcode = pio_inq_dimid(io_file, 'time', dimid3(3)) dimid => dimid3 else dimid => dimid2 @@ -1007,21 +973,21 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) call ESMF_LogWrite(trim(subname)//': defining '//trim(name1), ESMF_LOGMSG_INFO) if (luse_float) then - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind), varid,"_FillValue",real(lfillvalue,r4)) + rcode = pio_def_var(io_file, trim(name1), PIO_REAL, dimid, varid) + rcode = pio_put_att(io_file, varid,"_FillValue",real(lfillvalue,r4)) else - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind),varid,"_FillValue",lfillvalue) + rcode = pio_def_var(io_file, trim(name1), PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file,varid,"_FillValue",lfillvalue) end if if (NUOPC_FieldDictionaryHasEntry(trim(itemc))) then call NUOPC_FieldDictionaryGetEntry(itemc, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind), varid, "units" , trim(cunit)) + rcode = pio_put_att(io_file, varid, "units" , trim(cunit)) end if - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(name1)) + rcode = pio_put_att(io_file, varid, "standard_name", trim(name1)) if (present(tavg)) then if (tavg) then - rcode = pio_put_att(io_file(lfile_ind), varid, "cell_methods", "time: mean") + rcode = pio_put_att(io_file, varid, "cell_methods", "time: mean") endif endif end if @@ -1030,21 +996,21 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & name1 = trim(lpre)//'_'//trim(itemc) call ESMF_LogWrite(trim(subname)//':'//trim(itemc)//':'//trim(name1),ESMF_LOGMSG_INFO) if (luse_float) then - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind), varid, "_FillValue", real(lfillvalue, r4)) + rcode = pio_def_var(io_file, trim(name1), PIO_REAL, dimid, varid) + rcode = pio_put_att(io_file, varid, "_FillValue", real(lfillvalue, r4)) else - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind), varid, "_FillValue", lfillvalue) + rcode = pio_def_var(io_file, trim(name1), PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file, varid, "_FillValue", lfillvalue) end if if (NUOPC_FieldDictionaryHasEntry(trim(itemc))) then call NUOPC_FieldDictionaryGetEntry(itemc, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind), varid, "units", trim(cunit)) + rcode = pio_put_att(io_file, varid, "units", trim(cunit)) end if - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(name1)) + rcode = pio_put_att(io_file, varid, "standard_name", trim(name1)) if (present(tavg)) then if (tavg) then - rcode = pio_put_att(io_file(lfile_ind), varid, "cell_methods", "time: mean") + rcode = pio_put_att(io_file, varid, "cell_methods", "time: mean") endif end if end if @@ -1054,13 +1020,13 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & ! Add coordinate information to file do n = 1,ndims if (luse_float) then - rcode = pio_def_var(io_file(lfile_ind), trim(coordvarnames(n)), PIO_REAL, dimid, varid) + rcode = pio_def_var(io_file, trim(coordvarnames(n)), PIO_REAL, dimid, varid) else - rcode = pio_def_var(io_file(lfile_ind), trim(coordvarnames(n)), PIO_DOUBLE, dimid, varid) + rcode = pio_def_var(io_file, trim(coordvarnames(n)), PIO_DOUBLE, dimid, varid) end if - rcode = pio_put_att(io_file(lfile_ind), varid, "long_name", trim(coordnames(n))) - rcode = pio_put_att(io_file(lfile_ind), varid, "units", trim(coordunits(n))) - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(coordnames(n))) + rcode = pio_put_att(io_file, varid, "long_name", trim(coordnames(n))) + rcode = pio_put_att(io_file, varid, "units", trim(coordunits(n))) + rcode = pio_put_att(io_file, varid, "standard_name", trim(coordnames(n))) end do end if @@ -1106,38 +1072,38 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & do n = 1,ungriddedUBound(1) write(cnumber,'(i0)') n name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) - rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) - call pio_setframe(io_file(lfile_ind),varid,frame) + rcode = pio_inq_varid(io_file, trim(name1), varid) + call pio_setframe(io_file,varid,frame) if (gridToFieldMap(1) == 1) then - call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr2(:,n), rcode, fillval=lfillvalue) + call pio_write_darray(io_file, varid, iodesc, fldptr2(:,n), rcode, fillval=lfillvalue) else if (gridToFieldMap(1) == 2) then - call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue) + call pio_write_darray(io_file, varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue) end if end do else if (rank == 1 .or. rank == 0) then name1 = trim(lpre)//'_'//trim(itemc) - rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) - call pio_setframe(io_file(lfile_ind),varid,frame) + rcode = pio_inq_varid(io_file, trim(name1), varid) + call pio_setframe(io_file,varid,frame) ! fix for writing data on exchange grid, which has no data in some PETs if (rank == 0) nullify(fldptr1) - call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr1, rcode, fillval=lfillvalue) + call pio_write_darray(io_file, varid, iodesc, fldptr1, rcode, fillval=lfillvalue) end if ! end if rank is 2 or 1 or 0 end if ! end if not "hgt" end do ! end loop over fields in FB ! Fill coordinate variables - why is this being done each time? - rcode = pio_inq_varid(io_file(lfile_ind), trim(coordvarnames(1)), varid) - call pio_setframe(io_file(lfile_ind),varid,frame) - call pio_write_darray(io_file(lfile_ind), varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue) + rcode = pio_inq_varid(io_file, trim(coordvarnames(1)), varid) + call pio_setframe(io_file,varid,frame) + call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue) - rcode = pio_inq_varid(io_file(lfile_ind), trim(coordvarnames(2)), varid) - call pio_setframe(io_file(lfile_ind),varid,frame) - call pio_write_darray(io_file(lfile_ind), varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue) + rcode = pio_inq_varid(io_file, trim(coordvarnames(2)), varid) + call pio_setframe(io_file,varid,frame) + call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue) - call pio_syncfile(io_file(lfile_ind)) - call pio_freedecomp(io_file(lfile_ind), iodesc) + call pio_syncfile(io_file) + call pio_freedecomp(io_file, iodesc) endif deallocate(ownedElemCoords, ownedElemCoords_x, ownedElemCoords_y) @@ -1148,7 +1114,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & end subroutine med_io_write_FB !=============================================================================== - subroutine med_io_write_int(filename, idata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_int(io_file, idata, dname, whead, wdata, rc) use pio, only : var_desc_t, pio_def_var, pio_put_att, pio_int, pio_inq_varid, pio_put_var @@ -1157,45 +1123,40 @@ subroutine med_io_write_int(filename, idata, dname, whead, wdata, file_ind, rc) !--------------- ! intput/output variables - character(len=*) ,intent(in) :: filename ! file + type(file_desc_t) :: io_file integer ,intent(in) :: idata ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header logical ,intent(in) :: wdata ! write data - integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc ! local variables integer :: rcode type(var_desc_t) :: varid character(CL) :: cunit ! var units - integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_int) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - if (whead) then if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file,varid,"units",trim(cunit)) end if - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_INT,varid) - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_def_var(io_file,trim(dname),PIO_INT,varid) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) endif if (wdata) then - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,idata) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,idata) endif end subroutine med_io_write_int !=============================================================================== - subroutine med_io_write_int1d(filename, idata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_int1d(io_file, idata, dname, whead, wdata, file_ind, rc) !--------------- ! Write 1d integer array to netcdf file @@ -1206,7 +1167,7 @@ subroutine med_io_write_int1d(filename, idata, dname, whead, wdata, file_ind, rc use pio , only : pio_int, pio_def_var ! input/output arguments - character(len=*) ,intent(in) :: filename ! file + type(file_desc_t) :: io_file integer ,intent(in) :: idata(:) ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header @@ -1233,21 +1194,21 @@ subroutine med_io_write_int1d(filename, idata, dname, whead, wdata, file_ind, rc if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file,varid,"units",trim(cunit)) end if lnx = size(idata) - rcode = pio_def_dim(io_file(lfile_ind),trim(dname),lnx,dimid(1)) - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_INT,dimid,varid) - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_def_dim(io_file,trim(dname),lnx,dimid(1)) + rcode = pio_def_var(io_file,trim(dname),PIO_INT,dimid,varid) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) else if (wdata) then - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,idata) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,idata) endif end subroutine med_io_write_int1d !=============================================================================== - subroutine med_io_write_r8(filename, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_r8(io_file, rdata, dname, whead, wdata, rc) !--------------- ! Write scalar double to netcdf file @@ -1257,48 +1218,41 @@ subroutine med_io_write_r8(filename, rdata, dname, whead, wdata, file_ind, rc) use pio , only : pio_double, pio_noerr, pio_inq_varid, pio_put_var ! input/output arguments - character(len=*) ,intent(in) :: filename ! file + type(file_desc_T) :: io_file real(r8) ,intent(in) :: rdata ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header logical ,intent(in) :: wdata ! write data - integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc ! local variables integer :: rcode type(var_desc_t) :: varid character(CL) :: cunit ! var units - integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_r8) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if(present(file_ind)) then - lfile_ind = file_ind - else - lfile_ind = 1 - endif if (whead) then - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,varid) + rcode = pio_def_var(io_file,trim(dname),PIO_DOUBLE,varid) if (rcode==PIO_NOERR) then if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file,varid,"units",trim(cunit)) end if - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) end if else if (wdata) then - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,rdata) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,rdata) endif end subroutine med_io_write_r8 !=============================================================================== - subroutine med_io_write_r81d(filename, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_r81d(io_file, rdata, dname, whead, wdata, rc) !--------------- ! Write 1d double array to netcdf file @@ -1308,12 +1262,11 @@ subroutine med_io_write_r81d(filename, rdata, dname, whead, wdata, file_ind, rc) use pio , only : pio_inq_varid, pio_put_var, pio_double, pio_put_att ! !INPUT/OUTPUT PARAMETERS: - character(len=*) ,intent(in) :: filename ! file + type(file_desc_t) :: io_file real(r8) ,intent(in) :: rdata(:) ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header logical ,intent(in) :: wdata ! write data - integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc ! local variables @@ -1322,38 +1275,32 @@ subroutine med_io_write_r81d(filename, rdata, dname, whead, wdata, file_ind, rc) type(var_desc_t) :: varid character(CL) :: cunit ! var units integer :: lnx - integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_r81d) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if(present(file_ind)) then - lfile_ind = file_ind - else - lfile_ind = 1 - endif if (whead) then lnx = size(rdata) - rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_nx',lnx,dimid(1)) - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,dimid,varid) + rcode = pio_def_dim(io_file,trim(dname)//'_nx',lnx,dimid(1)) + rcode = pio_def_var(io_file,trim(dname),PIO_DOUBLE,dimid,varid) if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file,varid,"units",trim(cunit)) end if - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) endif if (wdata) then - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,rdata) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,rdata) endif end subroutine med_io_write_r81d !=============================================================================== - subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_char(io_file, rdata, dname, whead, wdata, rc) !--------------- ! Write char string to netcdf file @@ -1363,12 +1310,11 @@ subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) use pio , only : pio_char, pio_put_var ! input/output arguments - character(len=*) ,intent(in) :: filename ! file + type(file_desc_t) :: io_file character(len=*) ,intent(in) :: rdata ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header logical ,intent(in) :: wdata ! write data - integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc ! local variables @@ -1377,37 +1323,32 @@ subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) type(var_desc_t) :: varid character(CL) :: cunit ! var units integer :: lnx - integer :: lfile_ind character(CL) :: charvar ! buffer for string read/write character(*),parameter :: subName = '(med_io_write_char) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if(present(file_ind)) then - lfile_ind = file_ind - else - lfile_ind = 1 - endif + if (whead) then lnx = len(charvar) - rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_len',lnx,dimid(1)) - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_CHAR,dimid,varid) + rcode = pio_def_dim(io_file,trim(dname)//'_len',lnx,dimid(1)) + rcode = pio_def_var(io_file,trim(dname),PIO_CHAR,dimid,varid) if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) else if (wdata) then charvar = '' charvar = trim(rdata) - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,charvar) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,charvar) endif end subroutine med_io_write_char !=============================================================================== - subroutine med_io_define_time(time_units, calendar, file_ind, rc) + subroutine med_io_define_time(io_file, time_units, calendar, rc) use ESMF, only : operator(==), operator(/=) use ESMF, only : ESMF_Calendar, ESMF_CalendarIsCreated @@ -1420,9 +1361,9 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) use pio , only : pio_inq_varid, pio_put_var ! input/output variables + type(file_desc_t) :: io_file character(len=*) , intent(in) :: time_units ! units of time type(ESMF_Calendar) , intent(in) :: calendar ! calendar - integer, optional , intent(in) :: file_ind integer , intent(out):: rc ! local variables @@ -1430,16 +1371,12 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) integer :: dimid(1) integer :: dimid2(2) type(var_desc_t) :: varid - integer :: lfile_ind character(CL) :: calname ! calendar name character(*),parameter :: subName = '(med_io_define_time) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - if (.not. ESMF_CalendarIsCreated(calendar)) then call ESMF_LogWrite(trim(subname)//' ERROR: calendar is not created ', & ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) @@ -1448,9 +1385,9 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) end if ! define time and add calendar attribute - rcode = pio_def_dim(io_file(lfile_ind), 'time', PIO_UNLIMITED, dimid(1)) - rcode = pio_def_var(io_file(lfile_ind), 'time', PIO_DOUBLE, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind), varid, 'units', trim(time_units)) + rcode = pio_def_dim(io_file, 'time', PIO_UNLIMITED, dimid(1)) + rcode = pio_def_var(io_file, 'time', PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file, varid, 'units', trim(time_units)) if (calendar == ESMF_CALKIND_360DAY) then calname = '360_day' else if (calendar == ESMF_CALKIND_GREGORIAN) then @@ -1466,18 +1403,18 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) else if (calendar == ESMF_CALKIND_NOLEAP) then calname = 'noleap' end if - rcode = pio_put_att(io_file(lfile_ind), varid, 'calendar', trim(calname)) + rcode = pio_put_att(io_file, varid, 'calendar', trim(calname)) ! define time bounds dimid2(2) = dimid(1) - rcode = pio_def_dim(io_file(lfile_ind), 'ntb', 2, dimid2(1)) - rcode = pio_def_var(io_file(lfile_ind), 'time_bnds', PIO_DOUBLE, dimid2, varid) - rcode = pio_put_att(io_file(lfile_ind), varid, 'bounds', 'time_bnds') + rcode = pio_def_dim(io_file, 'ntb', 2, dimid2(1)) + rcode = pio_def_var(io_file, 'time_bnds', PIO_DOUBLE, dimid2, varid) + rcode = pio_put_att(io_file, varid, 'bounds', 'time_bnds') end subroutine med_io_define_time !=============================================================================== - subroutine med_io_write_time(time_val, tbnds, nt, file_ind, rc) + subroutine med_io_write_time(io_file, time_val, tbnds, nt, rc) !--------------- ! Write time variable to netcdf file @@ -1486,15 +1423,14 @@ subroutine med_io_write_time(time_val, tbnds, nt, file_ind, rc) use pio, only : pio_put_att, pio_inq_varid, pio_put_var ! input/output variables + type(file_desc_t) :: io_file real(r8) , intent(in) :: time_val ! data to be written real(r8) , intent(in) :: tbnds(2) ! time bounds integer , intent(in) :: nt - integer , optional, intent(in) :: file_ind integer , intent(out):: rc ! local variables integer :: rcode - integer :: lfile_ind integer :: varid integer :: start(2),count(2) character(*),parameter :: subName = '(med_io_write_time) ' @@ -1502,19 +1438,16 @@ subroutine med_io_write_time(time_val, tbnds, nt, file_ind, rc) rc = ESMF_SUCCESS - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - ! write time count = 1; start = nt - rcode = pio_inq_varid(io_file(lfile_ind), 'time', varid) - rcode = pio_put_var(io_file(lfile_ind), varid, start(1:1), count(1:1), (/time_val/)) + rcode = pio_inq_varid(io_file, 'time', varid) + rcode = pio_put_var(io_file, varid, start(1:1), count(1:1), (/time_val/)) ! write time bounds - rcode = pio_inq_varid(io_file(lfile_ind), 'time_bnds', varid) + rcode = pio_inq_varid(io_file, 'time_bnds', varid) start(1) = 1; start(2) = nt count(1) = 2; count(2) = 1 - rcode = pio_put_var(io_file(lfile_ind), varid, start(1:2), count(1:2), tbnds) + rcode = pio_put_var(io_file, varid, start(1:2), count(1:2), tbnds) end subroutine med_io_write_time @@ -1537,7 +1470,7 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) use pio , only : pio_read_darray, pio_offset_kind, pio_setframe ! input/output arguments - character(len=*) ,intent(in) :: filename ! file + character(len=*) ,intent(in) :: filename type(ESMF_VM) ,intent(in) :: vm type(ESMF_FieldBundle) ,intent(in) :: FB ! data to be read character(len=*) ,optional ,intent(in) :: pre ! prefix to variable name diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 00444b292..e647dc647 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -24,7 +24,8 @@ module med_phases_history_mod use med_time_mod , only : med_time_alarmInit use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf - + use pio , only : file_desc_t + implicit none private @@ -59,6 +60,7 @@ module med_phases_history_mod ! Instantaneous history files datatypes/variables per component ! ---------------------------- type, public :: instfile_type + type(file_desc_t) :: io_file logical :: write_inst character(CS) :: hist_option integer :: hist_n @@ -74,6 +76,7 @@ module med_phases_history_mod ! Time averaging history files ! ---------------------------- type, public :: avgfile_type + type(file_desc_t) :: io_file logical :: write_avg type(ESMF_FieldBundle) :: FBaccum_import ! field bundle for time averaging integer :: accumcnt_import ! field bundle accumulation counter @@ -93,6 +96,7 @@ module med_phases_history_mod ! Auxiliary history files ! ---------------------------- type, public :: auxfile_type + type(file_desc_t) :: io_file character(CS), allocatable :: flds(:) ! array of aux field names character(CS) :: auxname ! name for history file creation character(CL) :: histfile = '' ! current history file name @@ -155,6 +159,7 @@ subroutine med_phases_history_write(gcomp, rc) integer, intent(out) :: rc ! local variables + type(file_desc_t) :: io_file type(InternalState) :: is_local type(ESMF_Clock) :: mclock type(ESMF_Alarm) :: alarm @@ -292,23 +297,23 @@ subroutine med_phases_history_write(gcomp, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, rc, clobber=.true.) + call med_io_wopen(hist_file, io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Loop over whead/wdata phases do m = 1,2 if (m == 2) then - call med_io_enddef(hist_file) + call med_io_enddef(io_file) end if ! Write time values if (whead(m)) then call ESMF_ClockGet(mclock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_write_time(io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -316,49 +321,49 @@ subroutine med_phases_history_write(gcomp, rc) ! Write import and export field bundles if (is_local%wrap%comp_present(n)) then if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), & is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBexp(n), whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBexp(n), whead(m), wdata(m), & is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif end if ! Write mediator fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBFrac(n), whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBFrac(n), whead(m), wdata(m), & is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='Med_frac_'//trim(compname(n)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write component mediator area field bundles - call med_io_write(hist_file, is_local%wrap%FBArea(n), whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBArea(n), whead(m), wdata(m), & is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='MED_'//trim(compname(n)), rc=rc) end do ! Write atm/ocn fluxes and ocean albedoes if field bundles are created if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_alb_ocn', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_aoflux_ocn', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) end if end do ! end of loop over whead/wdata m index phases ! Close file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! end of write_now if-block @@ -464,44 +469,44 @@ subroutine med_phases_history_write_med(gcomp, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, rc, clobber=.true.) + call med_io_wopen(hist_file, instfiles(compmed)%io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then call ESMF_ClockGet(instfiles(compmed)%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(instfiles(compmed)%io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_enddef(hist_file) - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_enddef(instfiles(compmed)%io_file) + call med_io_write_time(instfiles(compmed)%io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write aoflux fields computed in mediator if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & + call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_aoflux_ocn', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & + call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) end if ! If appropriate - write ocn albedos computed in mediator if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & + call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_alb_ocn', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & + call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', rc=rc) end if end do ! end of loop over m ! Close file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(instfiles(compmed)%io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! end of if-write_now block @@ -525,6 +530,7 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) integer , intent(out) :: rc ! local variables + type(file_desc_t) :: io_file type(InternalState) :: is_local type(ESMF_VM) :: vm type(ESMF_Clock) :: clock @@ -598,7 +604,7 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, rc, clobber=.true.) + call med_io_wopen(hist_file, io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write data to history file @@ -606,20 +612,20 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) if (whead(m)) then call ESMF_ClockGet(clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_enddef(hist_file) - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_enddef(io_file) + call med_io_write_time(io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call med_io_write(hist_file, fldbun, whead(m), wdata(m), is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & + call med_io_write(io_file, fldbun, whead(m), wdata(m), is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & nt=1, pre=trim(compname(complnd))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do ! end of loop over m ! Close history file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine med_phases_history_write_lnd2glc @@ -752,18 +758,18 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, rc, clobber=.true.) + call med_io_wopen(hist_file, instfile%io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then call ESMF_ClockGet(instfile%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(instfile%io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_enddef(hist_file) - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_enddef(instfile%io_file) + call med_io_write_time(instfile%io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -771,19 +777,19 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) ny = is_local%wrap%ny(compid) ! Define/write import field bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBimp(compid,compid), whead(m), wdata(m), nx, ny, & + call med_io_write(instfile%io_file, is_local%wrap%FBimp(compid,compid), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(compid))//'Imp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Define/write import export bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBexp(compid), whead(m), wdata(m), nx, ny, & + call med_io_write(instfile%io_file, is_local%wrap%FBexp(compid), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(compid))//'Exp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Define/Write mediator fractions if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(compid),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBFrac(compid), whead(m), wdata(m), nx, ny, & + call med_io_write(instfile%io_file, is_local%wrap%FBFrac(compid), whead(m), wdata(m), nx, ny, & nt=1, pre='Med_frac_'//trim(compname(compid)), tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -791,7 +797,7 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) end do ! end of loop over m ! Close file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(instfile%io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -957,18 +963,18 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, rc, clobber=.true.) + call med_io_wopen(hist_file, avgfile%io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then call ESMF_ClockGet(avgfile%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(avgfile%io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_enddef(hist_file) - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_enddef(avgfile%io_file) + call med_io_write_time(avgfile%io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -977,7 +983,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) nx = is_local%wrap%nx(compid) ny = is_local%wrap%ny(compid) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then - call med_io_write(hist_file, avgfile%FBaccum_import, whead(m), wdata(m), nx, ny, & + call med_io_write(avgfile%io_file, avgfile%FBaccum_import, whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(compid))//'Imp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (wdata(m)) then @@ -986,7 +992,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) end if endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then - call med_io_write(hist_file, avgfile%FBaccum_export, whead(m), wdata(m), nx, ny, & + call med_io_write(avgfile%io_file, avgfile%FBaccum_export, whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(compid))//'Exp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (wdata(m)) then @@ -998,7 +1004,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) end do ! end of loop over m ! Close file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(avgfile%io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! end of write_now if-block @@ -1281,40 +1287,40 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! open file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(auxcomp%files(nf)%histfile, vm, rc, file_ind=nf, clobber=.true.) + call med_io_wopen(auxcomp%files(nf)%histfile, auxcomp%files(nf)%io_file, vm, rc, file_ind=nf, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! define time variables call ESMF_ClockGet(auxcomp%files(nf)%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, file_ind=nf, rc=rc) + call med_io_define_time(auxcomp%files(nf)%io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! define data variables with a time dimension (include the nt argument below) - call med_io_write(auxcomp%files(nf)%histfile, is_local%wrap%FBimp(compid,compid), & + call med_io_write(auxcomp%files(nf)%io_file, is_local%wrap%FBimp(compid,compid), & whead(1), wdata(1), nx, ny, nt=auxcomp%files(nf)%nt, & pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, & - file_ind=nf, use_float=.true., rc=rc) + use_float=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! end definition phase - call med_io_enddef(auxcomp%files(nf)%histfile, file_ind=nf) + call med_io_enddef(auxcomp%files(nf)%io_file) end if ! Write time variables for time nt - call med_io_write_time(time_val, time_bnds, nt=auxcomp%files(nf)%nt, file_ind=nf, rc=rc) + call med_io_write_time(auxcomp%files(nf)%io_file, time_val, time_bnds, nt=auxcomp%files(nf)%nt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write data variables for time nt if (auxcomp%files(nf)%doavg) then - call med_io_write(auxcomp%files(nf)%histfile, auxcomp%files(nf)%FBaccum, whead(2), wdata(2), nx, ny, & - nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, file_ind=nf, rc=rc) + call med_io_write(auxcomp%files(nf)%io_file, auxcomp%files(nf)%FBaccum, whead(2), wdata(2), nx, ny, & + nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(auxcomp%files(nf)%FBaccum, value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_write(auxcomp%files(nf)%histfile, is_local%wrap%FBimp(compid,compid), whead(2), wdata(2), nx, ny, & - nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, file_ind=nf, rc=rc) + call med_io_write(auxcomp%files(nf)%io_file, is_local%wrap%FBimp(compid,compid), whead(2), wdata(2), nx, ny, & + nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -1322,7 +1328,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) if (auxcomp%files(nf)%nt == auxcomp%files(nf)%ntperfile) then call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_close(auxcomp%files(nf)%histfile, vm, file_ind=nf, rc=rc) + call med_io_close(auxcomp%files(nf)%io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return auxcomp%files(nf)%nt = 0 end if diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 3b276b08e..a225ff97c 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -13,7 +13,7 @@ module med_phases_restart_mod use med_phases_prep_glc_mod , only : FBlndAccum2glc_l, lndAccum2glc_cnt use med_phases_prep_glc_mod , only : FBocnAccum2glc_o, ocnAccum2glc_cnt use med_phases_prep_rof_mod , only : FBlndAccum2rof_l, lndAccum2rof_cnt - + use pio , only : file_desc_t implicit none private @@ -143,6 +143,7 @@ subroutine med_phases_restart_write(gcomp, rc) integer, intent(out) :: rc ! local variables + type(file_desc_t) :: io_file type(ESMF_VM) :: vm type(ESMF_Clock) :: clock type(ESMF_Time) :: starttime @@ -309,12 +310,12 @@ subroutine med_phases_restart_write(gcomp, rc) call ESMF_LogWrite(trim(subname)//": write "//trim(restart_file), ESMF_LOGMSG_INFO) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(restart_file, vm, rc, clobber=.true.) + call med_io_wopen(restart_file, io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 if (m == 2) then - call med_io_enddef(restart_file) + call med_io_enddef(io_file) end if tbnds = days_since @@ -322,23 +323,23 @@ subroutine med_phases_restart_write(gcomp, rc) if (whead(m)) then call ESMF_ClockGet(clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_write_time(days_since, tbnds=(/days_since,days_since/), nt=1, rc=rc) + call med_io_write_time(io_file, days_since, tbnds=(/days_since,days_since/), nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write out next ymd/tod in place of curr ymd/tod because the ! restart represents the time at end of the current timestep ! and that is where we want to start the next run. - call med_io_write(restart_file, start_ymd, 'start_ymd', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, start_ymd, 'start_ymd', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, start_tod, 'start_tod', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, start_tod, 'start_tod', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, next_ymd , 'curr_ymd' , whead(m), wdata(m), rc=rc) + call med_io_write(io_file, next_ymd , 'curr_ymd' , whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, next_tod , 'curr_tod' , whead(m), wdata(m), rc=rc) + call med_io_write(io_file, next_tod , 'curr_tod' , whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ncomps @@ -347,19 +348,19 @@ subroutine med_phases_restart_write(gcomp, rc) ny = is_local%wrap%ny(n) ! Write import field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - call med_io_write(restart_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(n))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Write export field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then - call med_io_write(restart_file, is_local%wrap%FBexp(n), whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBexp(n), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(n))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Write fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then - call med_io_write(restart_file, is_local%wrap%FBfrac(n), whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBfrac(n), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(n))//'Frac', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -370,10 +371,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccumOcn)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) - call med_io_write(restart_file, is_local%wrap%FBExpAccumOcn, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBExpAccumOcn, whead(m), wdata(m), nx, ny, & nt=1, pre='ocnExpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, is_local%wrap%ExpAccumOcnCnt, 'ocnExpAccum_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, is_local%wrap%ExpAccumOcnCnt, 'ocnExpAccum_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -381,10 +382,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccumWav)) then nx = is_local%wrap%nx(compwav) ny = is_local%wrap%ny(compwav) - call med_io_write(restart_file, is_local%wrap%FBExpAccumWav, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBExpAccumWav, whead(m), wdata(m), nx, ny, & nt=1, pre='wavExpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, is_local%wrap%ExpAccumWavCnt, 'wavExpAccum_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, is_local%wrap%ExpAccumWavCnt, 'wavExpAccum_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -392,10 +393,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(FBlndAccum2rof_l)) then nx = is_local%wrap%nx(complnd) ny = is_local%wrap%ny(complnd) - call med_io_write(restart_file, FBlndAccum2rof_l, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, FBlndAccum2rof_l, whead(m), wdata(m), nx, ny, & nt=1, pre='lndImpAccum2rof', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, lndAccum2rof_cnt, 'lndImpAccum2rof_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, lndAccum2rof_cnt, 'lndImpAccum2rof_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -403,10 +404,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(FBlndAccum2glc_l)) then nx = is_local%wrap%nx(complnd) ny = is_local%wrap%ny(complnd) - call med_io_write(restart_file, FBlndAccum2glc_l, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, FBlndAccum2glc_l, whead(m), wdata(m), nx, ny, & nt=1, pre='lndImpAccum2glc', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, lndAccum2glc_cnt, 'lndImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, lndAccum2glc_cnt, 'lndImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -414,10 +415,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(FBocnAccum2glc_o)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) - call med_io_write(restart_file, FBocnAccum2glc_o, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, FBocnAccum2glc_o, whead(m), wdata(m), nx, ny, & nt=1, pre='ocnImpAccum2glc_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, ocnAccum2glc_cnt, 'ocnImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, ocnAccum2glc_cnt, 'ocnImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -425,7 +426,7 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) - call med_io_write(restart_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), nx, ny, & nt=1, pre='MedOcnAlb_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -438,11 +439,11 @@ subroutine med_phases_restart_write(gcomp, rc) if (auxcomp(nc)%files(nf)%doavg .and. auxcomp(nc)%files(nf)%accumcnt > 0) then nx = is_local%wrap%nx(nc) ny = is_local%wrap%ny(nc) - call med_io_write(restart_file, auxcomp(nc)%files(nf)%FBaccum, & + call med_io_write(io_file, auxcomp(nc)%files(nf)%FBaccum, & whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(nc))//trim(auxcomp(nc)%files(nf)%auxname), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, auxcomp(nc)%files(nf)%accumcnt, & + call med_io_write(io_file, auxcomp(nc)%files(nf)%accumcnt, & trim(compname(nc))//trim(auxcomp(nc)%files(nf)%auxname)//'_accumcnt', & whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -453,7 +454,7 @@ subroutine med_phases_restart_write(gcomp, rc) enddo ! end of whead/wdata loop ! Close file - call med_io_close(restart_file, vm, rc=rc) + call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif From 4490cffdc06f2664022c621034cbd24222ef535d Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 11 May 2023 10:25:37 -0600 Subject: [PATCH 328/395] ntperfile should be type integer --- cime_config/namelist_definition_drv.xml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 5cbf78319..f6e1d4442 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1347,7 +1347,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. @@ -1414,7 +1414,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. @@ -1483,7 +1483,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. @@ -1548,7 +1548,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. @@ -1766,7 +1766,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. @@ -2011,7 +2011,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. From 57e1970552fb68d88d7cdf4e3a84d511bd03f006 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 11 May 2023 11:27:08 -0600 Subject: [PATCH 329/395] remove unused variable --- mediator/med_io_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 9215777c0..3a8fb2d6f 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -616,7 +616,6 @@ subroutine med_io_close(io_file, rc) ! local variables - integer :: iam character(*),parameter :: subName = '(med_io_close) ' !------------------------------------------------------------------------------- From 5d7470d052b391d8fc7bbd57e5e5641a439abad2 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 11 May 2023 13:44:12 -0600 Subject: [PATCH 330/395] CESM_COUPLED should be CESMCOUPLED --- mediator/med_methods_mod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 3d29fde6f..faecf47a6 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2530,7 +2530,7 @@ subroutine med_methods_FB_check_for_nans(FB, rc) ! ---------------------------------------------- rc = ESMF_SUCCESS -#ifndef CESM_COUPLED +#ifndef CESMCOUPLED ! For now only CESM uses shr_infnan_isnan - so until other models provide this RETURN #endif @@ -2571,7 +2571,7 @@ subroutine med_methods_FB_check_for_nans(FB, rc) end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- -#ifdef CESM_COUPLED +#ifdef CESMCOUPLED subroutine med_methods_check_for_nans_1d(dataptr, nancount) use shr_infnan_mod, only: shr_infnan_isnan @@ -2590,7 +2590,7 @@ subroutine med_methods_check_for_nans_1d(dataptr, nancount) end subroutine med_methods_check_for_nans_1d subroutine med_methods_check_for_nans_2d(dataptr, nancount) - use shr_infnan_mod, only: shr_infan_isnan + use shr_infnan_mod, only: shr_infnan_isnan ! input/output variables real(r8) , intent(in) :: dataptr(:,:) integer , intent(out) :: nancount @@ -2600,7 +2600,7 @@ subroutine med_methods_check_for_nans_2d(dataptr, nancount) nancount = 0 do k = 1,size(dataptr, dim=1) do n = 1,size(dataptr, dim=2) - if (shr_infan_isnan(dataptr(k,n))) then + if (shr_infnan_isnan(dataptr(k,n))) then nancount = nancount + 1 end if end do From b60c9d7f6089de5ecb2e6784a21c84f6906a6d75 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Thu, 11 May 2023 13:58:56 -0600 Subject: [PATCH 331/395] Candidate fixes of descriptions and comments --- cime_config/namelist_definition_drv.xml | 44 ++++++++++++------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index f6e1d4442..bfe991383 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1235,7 +1235,7 @@ - + logical aux_hist @@ -1267,7 +1267,7 @@ integer aux_hist MED_attributes - history option type + history option span 1 @@ -1300,7 +1300,7 @@ - + logical aux_hist @@ -1332,7 +1332,7 @@ integer aux_hist MED_attributes - history option type + history option span 1 @@ -1365,7 +1365,7 @@ - + logical aux_hist @@ -1381,7 +1381,7 @@ char aux_hist MED_attributes - Auxiliary mediator atm2med precipitation history output every 3 hours + Auxiliary mediator atm2med precipitation fields history output every 3 hours Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl @@ -1399,7 +1399,7 @@ integer aux_hist MED_attributes - history option type + history option span 3 @@ -1432,13 +1432,13 @@ - + logical aux_hist MED_attributes - Auxiliary mediator a2x precipitation history output every 3 hours + Auxiliary mediator a2x dynamic, radiation, and precipitation history output every 3 hours .false. @@ -1449,7 +1449,7 @@ aux_hist MED_attributes - Auxiliary mediator a2x precipitation history output every 3 hours + Auxiliary mediator a2x dynamic, radiation, and precipitation fields history output every 3 hours Sa_z:Sa_topo:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_dens:Sa_pbot:Sa_pslv:Faxa_lwdn:Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:Sa_co2diag:Sa_co2prog @@ -1468,7 +1468,7 @@ integer aux_hist MED_attributes - history option type + history option span 3 @@ -1501,12 +1501,12 @@ - + logical aux_hist MED_attributes - Auxiliary mediator a2x precipitation history output every 3 hours + Auxiliary mediator a2x aerosol and ghg history output daily or endofrun .false. @@ -1515,7 +1515,7 @@ char aux_hist MED_attributes - Auxiliary mediator a2x precipitation history output every 3 hours + Auxiliary mediator a2x aerosol and ghg history output daily or endofrun Faxa_bcph:Faxa_ocph:Faxa_dstwet:Faxa_dstdry:Sa_co2prog:Sa_co2diag @@ -1533,9 +1533,9 @@ integer aux_hist MED_attributes - history option type + history option span - 1 + 3 @@ -1553,7 +1553,7 @@ MED_attributes Number of time samples per file. - 1 + 2 @@ -1801,7 +1801,7 @@ - + logical aux_hist @@ -1978,7 +1978,7 @@ char aux_hist MED_attributes - Auxiliary mediator rof2med precipitation history output. + Auxiliary mediator rof2med precipitation fields history output. all @@ -1996,9 +1996,9 @@ integer aux_hist MED_attributes - history option type + history option span - 6 + 3 @@ -2016,7 +2016,7 @@ MED_attributes Number of time samples per file. - 1 + 2 From 42a5fd537fd166eea08a8a132cc159c25a471ec6 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 11 May 2023 15:39:03 -0600 Subject: [PATCH 332/395] remove dead code --- mediator/med_io_mod.F90 | 17 ----------------- 1 file changed, 17 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 3a8fb2d6f..d55ebc724 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -75,10 +75,6 @@ module med_io_mod character(*),parameter :: prefix = "med_io_" character(*),parameter :: modName = "(med_io_mod) " character(*),parameter :: version = "cmeps0" - integer , parameter :: number_strlen = 8 - integer , parameter :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now - -! character(CL) :: wfilename(0:file_desc_t_cnt) = '' integer :: pio_iotype integer :: pio_ioformat @@ -546,9 +542,6 @@ subroutine med_io_wopen(filename, io_file, vm, rc, clobber, file_ind, model_doi_ if (.not. pio_file_is_open(io_file)) then - ! filename not open -! wfilename(lfile_ind) = trim(filename) - if (med_io_file_exists(vm, filename)) then if (lclobber) then nmode = pio_clobber @@ -585,16 +578,6 @@ subroutine med_io_wopen(filename, io_file, vm, rc, clobber, file_ind, model_doi_ rcode = pio_put_att(io_file,pio_global,"model_doi_url",lmodel_doi_url) endif -! elseif (trim(wfilename(lfile_ind)) /= trim(filename)) then - ! filename is open, better match open filename -! if (iam==0) then -! write(logunit,'(a)') trim(subname)//' different filename currently open '//trim(filename) -! write(logunit,'(a)') trim(subname)//' different wfilename currently open '//trim(wfilename(lfile_ind)) -! end if -! call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_ERROR) -! rc = ESMF_FAILURE -! return - else ! filename is already open, just return endif From ebc63bb70eaaf26273b60970a9bdbf3eb40ac7a5 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Fri, 12 May 2023 08:28:48 -0600 Subject: [PATCH 333/395] allow ufs to use check nan feature --- mediator/med_methods_mod.F90 | 28 ---------------------------- 1 file changed, 28 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index faecf47a6..1da8d6ac1 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2530,11 +2530,6 @@ subroutine med_methods_FB_check_for_nans(FB, rc) ! ---------------------------------------------- rc = ESMF_SUCCESS -#ifndef CESMCOUPLED - ! For now only CESM uses shr_infnan_isnan - so until other models provide this - RETURN -#endif - call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2571,7 +2566,6 @@ subroutine med_methods_FB_check_for_nans(FB, rc) end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- -#ifdef CESMCOUPLED subroutine med_methods_check_for_nans_1d(dataptr, nancount) use shr_infnan_mod, only: shr_infnan_isnan @@ -2607,26 +2601,4 @@ subroutine med_methods_check_for_nans_2d(dataptr, nancount) end do end subroutine med_methods_check_for_nans_2d -#else - - ! For now only CESM uses shr_infnan_isnan - so until other models provide this - ! nancount will just be set to zero - - subroutine med_methods_check_for_nans_1d(dataptr, nancount) - ! input/output variables - real(r8) , intent(in) :: dataptr(:) - integer , intent(out) :: nancount - - nancount = 0 - end subroutine med_methods_check_for_nans_1d - - subroutine med_methods_check_for_nans_2d(dataptr, nancount) - ! input/output variables - real(r8) , intent(in) :: dataptr(:,:) - integer , intent(out) :: nancount - - nancount = 0 - end subroutine med_methods_check_for_nans_2d -#endif - end module med_methods_mod From a25075d606421d5a33927771c5f5840d4581aea3 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Fri, 12 May 2023 08:37:19 -0600 Subject: [PATCH 334/395] fix comments --- mediator/med_phases_prep_glc_mod.F90 | 2 +- mediator/med_phases_prep_ice_mod.F90 | 2 +- mediator/med_phases_prep_ocn_mod.F90 | 2 +- mediator/med_phases_prep_rof_mod.F90 | 2 +- mediator/med_phases_prep_wav_mod.F90 | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 97049d5b9..e82dc9a4b 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -707,7 +707,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) endif end if - ! Check for nans in fields export to atm + ! Check for nans in fields export to glc do ns = 1,is_local%wrap%num_icesheets call FB_check_for_nans(is_local%wrap%FBExp(compglc(ns)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 1e0496b3d..e0c0ff3a7 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -150,7 +150,7 @@ subroutine med_phases_prep_ice(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if - ! Check for nans in fields export to atm + ! Check for nans in fields export to ice call FB_check_for_nans(is_local%wrap%FBExp(compice), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index de989ac49..604d0ccea 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -296,7 +296,7 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) call FB_copy(is_local%wrap%FBExp(compocn), is_local%wrap%FBExpAccumOcn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Check for nans in fields export to atm + ! Check for nans in fields export to ocn call FB_check_for_nans(is_local%wrap%FBExp(compocn), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index cf0ad0f4e..36c3ddbae 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -377,7 +377,7 @@ subroutine med_phases_prep_rof(gcomp, rc) FBfrac=is_local%wrap%FBFrac(comprof), FBin=FBlndAccum2rof_r, fldListTo=fldList, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Check for nans in fields export to atm + ! Check for nans in fields export to rof call FB_check_for_nans(is_local%wrap%FBExp(comprof), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 3028303bc..9aad25417 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -177,7 +177,7 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) call FB_copy(is_local%wrap%FBExp(compwav), is_local%wrap%FBExpAccumWav, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Check for nans in fields export to atm + ! Check for nans in fields export to wav call FB_check_for_nans(is_local%wrap%FBExp(compwav), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 96206b6366dca33da7fe20021c71a5f0db8ace7a Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 12 May 2023 08:54:52 -0600 Subject: [PATCH 335/395] adjust indentation --- mediator/med_phases_history_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index e647dc647..5f150a4b7 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -60,7 +60,7 @@ module med_phases_history_mod ! Instantaneous history files datatypes/variables per component ! ---------------------------- type, public :: instfile_type - type(file_desc_t) :: io_file + type(file_desc_t):: io_file logical :: write_inst character(CS) :: hist_option integer :: hist_n @@ -76,7 +76,7 @@ module med_phases_history_mod ! Time averaging history files ! ---------------------------- type, public :: avgfile_type - type(file_desc_t) :: io_file + type(file_desc_t) :: io_file logical :: write_avg type(ESMF_FieldBundle) :: FBaccum_import ! field bundle for time averaging integer :: accumcnt_import ! field bundle accumulation counter @@ -96,7 +96,7 @@ module med_phases_history_mod ! Auxiliary history files ! ---------------------------- type, public :: auxfile_type - type(file_desc_t) :: io_file + type(file_desc_t) :: io_file character(CS), allocatable :: flds(:) ! array of aux field names character(CS) :: auxname ! name for history file creation character(CL) :: histfile = '' ! current history file name From a587023727e73bbdffec5b8daff5bcb93385e670 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 May 2023 14:20:46 -0600 Subject: [PATCH 336/395] updates for new stresses sent to wave --- mediator/esmFldsExchange_cesm_mod.F90 | 34 +-- mediator/med_phases_aofluxes_mod.F90 | 29 ++- mediator/med_phases_prep_wav_mod.F90 | 333 +------------------------- 3 files changed, 44 insertions(+), 352 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 397a92ba1..8ff5f95f4 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2983,28 +2983,28 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- - if (phase == 'advertise') then + if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') - call addfld_from(compice , 'Fioi_taux') - call addfld_aoflux('Faox_taux') - else - if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then - if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then - call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') - end if - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') - end if + ! call addfld_from(compice , 'Fioi_taux') + ! call addfld_aoflux('Faox_taux') + else + ! if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then + ! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then + ! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') + ! call addmrg_to(compwav, 'Fwxx_taux', & + ! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + ! end if + ! call addmrg_to(compwav, 'Fwxx_taux', & + ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + ! end if end if -! if (phase == 'advertise') then +! if (phase == 'advertise') then ! call addfld_to(compwav , 'Fwxx_taux') !! call addfld_from(compice , 'Fioi_taux') ! call addfld_aoflux('Faox_taux') -! else -! if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then -!! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then +! else +! if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then +!! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then !! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') !! call addmrg_to(compwav, 'Fwxx_taux', & !! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index b3acbdeb4..608ad18b0 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -27,7 +27,7 @@ module med_phases_aofluxes_mod use ESMF , only : ESMF_XGridGet, ESMF_MeshCreate, ESMF_MeshWrite, ESMF_KIND_R8 use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_internalstate_mod , only : InternalState, mastertask, logunit - use med_internalstate_mod , only : compatm, compocn, coupling_mode, aoflux_code, mapconsd, mapconsf, mapfcopy + use med_internalstate_mod , only : compatm, compocn, compwav, coupling_mode, aoflux_code, mapconsd, mapconsf, mapfcopy use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_chkerr @@ -492,6 +492,7 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) use esmFlds , only : med_fldlist_GetaofluxfldList use esmFlds , only : med_fldList_type use med_map_mod , only : med_map_packed_field_create + use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk ! Arguments type(ESMF_GridComp) , intent(inout) :: gcomp @@ -509,6 +510,7 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Mesh) :: lmesh real(R8), pointer :: garea(:) => null() type(ESMF_CoordSys_Flag) :: coordSys + integer :: maptype character(len=*),parameter :: subname=' (med_aofluxes_init_ocngrid) ' !----------------------------------------------------------------------- @@ -571,7 +573,6 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) if (is_local%wrap%aoflux_grid == 'ogrid') then if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o) .and. & ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a)) then - call med_map_packed_field_create(destcomp=compatm, & flds_scalar_name=is_local%wrap%flds_scalar_name, & fieldsSrc=fldListMed_aoflux, & @@ -579,7 +580,6 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) FBDst=is_local%wrap%FBMed_aoflux_a, & packed_data=is_local%wrap%packed_data_aoflux_o2a(:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if end if @@ -957,6 +957,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) use ESMF , only : ESMF_GridComp use ESMF , only : ESMF_LogWrite, ESMF_LogMsg_Info, ESMF_SUCCESS use med_map_mod , only : med_map_field_packed, med_map_rh_is_created + use med_map_mod , only : med_map_routehandles_init + use med_methods_mod, only : FB_fldchk => med_methods_FB_fldchk + use med_methods_mod, only : FB_diagnose => med_methods_FB_diagnose #ifdef CESMCOUPLED use shr_flux_mod , only : flux_atmocn #else @@ -1129,6 +1132,26 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) end if + ! map aoflux fields to wav grid if stresses are needed on the wave grid + if ( FB_fldchk(is_local%wrap%FBExp(compwav), 'Fwxx_taux', rc=rc)) then + maptype = mapconsf + if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:), maptype, rc=rc)) then + call med_map_routehandles_init( compocn, compwav, & + FBSrc=is_local%wrap%FBImp(compocn,compocn), & + FBDst=is_local%wrap%FBImp(compwav,compwav), & + mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_FieldBundleGet(is_local%wrap%FBMed_aoflux_o, 'Faox_taux', field=field_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBExp(compwav), 'Fwxx_taux', field=field_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegrid(field_src, field_dst, & + routehandle=is_local%wrap%RH(compocn, compwav, maptype), & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + call t_stopf('MED:'//subname) end subroutine med_aofluxes_update diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 3ed57c00d..4fdd630ea 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -13,20 +13,12 @@ module med_phases_prep_wav_mod use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose -!PSH begin - use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk - use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr -!PSH end use med_methods_mod , only : FB_accum => med_methods_FB_accum use med_methods_mod , only : FB_average => med_methods_FB_average use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset -!PSH begin use esmFlds , only : med_fldList_GetfldListTo use med_internalstate_mod , only : compwav -! use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type -! use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode -!PSH end use perf_mod , only : t_startf, t_stopf implicit none @@ -36,10 +28,6 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_accum ! called from run sequence public :: med_phases_prep_wav_avg ! called from run sequence -!PSH begin -! private :: med_phases_prep_wav_custom_cesm -!PSH end - character(*), parameter :: u_FILE_u = & __FILE__ @@ -94,9 +82,6 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n, ncnt -!PSH begin -! type(med_fldlist_type), pointer :: fldList -!PSH end character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' !--------------------------------------- @@ -111,33 +96,15 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -!PSH begin -! fldList => med_fldList_GetfldListTo(compwav) -!PSH end + ! auto merges to wav -!PSH begin call med_merge_auto(& is_local%wrap%med_coupling_active(:,compwav), & is_local%wrap%FBExp(compwav), & is_local%wrap%FBFrac(compwav), & is_local%wrap%FBImp(:,compwav), & med_fldList_GetfldListTo(compwav), rc=rc) -! call med_merge_auto(& -! is_local%wrap%med_coupling_active(:,compwav), & -! is_local%wrap%FBExp(compwav), & -! is_local%wrap%FBFrac(compwav), & -! is_local%wrap%FBImp(:,compwav), & -! fldList, & -! FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) -!PSH end if (ChkErr(rc,__LINE__,u_FILE_u)) return -!PSH begin -! ! custom merges to ocean -! if (trim(coupling_mode) == 'cesm') then -! call med_phases_prep_wav_custom_cesm(gcomp, rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -!PSH end ! wave accumulator call FB_accum(is_local%wrap%FBExpAccumWav, is_local%wrap%FBExp(compwav), rc=rc) @@ -223,302 +190,4 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_prep_wav_avg - !----------------------------------------------------------------------------- -! subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) -! -! !--------------------------------------- -! ! custom calculations for cesm -! !--------------------------------------- -! -! use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet -! use ESMF , only : ESMF_VMBroadCast -! use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS -! use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR -! -! ! input/output variables -! type(ESMF_GridComp) :: gcomp -! integer, intent(out) :: rc -! -! ! local variables -! type(InternalState) :: is_local -! type(ESMF_Field) :: lfield -! real(R8), pointer :: ifrac(:) -! real(R8), pointer :: ofrac(:) -! real(R8), pointer :: ifracr(:) -! real(R8), pointer :: ofracr(:) -! real(R8), pointer :: avsdr(:) -! real(R8), pointer :: avsdf(:) -! real(R8), pointer :: anidr(:) -! real(R8), pointer :: anidf(:) -! real(R8), pointer :: Faxa_swvdf(:) -! real(R8), pointer :: Faxa_swndf(:) -! real(R8), pointer :: Faxa_swvdr(:) -! real(R8), pointer :: Faxa_swndr(:) -! real(R8), pointer :: Foxx_swnet(:) -! real(R8), pointer :: Foxx_swnet_afracr(:) -! real(R8), pointer :: Foxx_swnet_vdr(:) -! real(R8), pointer :: Foxx_swnet_vdf(:) -! real(R8), pointer :: Foxx_swnet_idr(:) -! real(R8), pointer :: Foxx_swnet_idf(:) -! real(R8), pointer :: Fioi_swpen_vdr(:) -! real(R8), pointer :: Fioi_swpen_vdf(:) -! real(R8), pointer :: Fioi_swpen_idr(:) -! real(R8), pointer :: Fioi_swpen_idf(:) -! real(R8), pointer :: Fioi_swpen(:) -! real(R8), pointer :: dataptr(:) -! real(R8), pointer :: dataptr_scalar_ocn(:,:) -! real(R8) :: frac_sum -! real(R8) :: ifrac_scaled, ofrac_scaled -! real(R8) :: ifracr_scaled, ofracr_scaled -! logical :: export_swnet_by_bands -! logical :: import_swpen_by_bands -! logical :: export_swnet_afracr -! real(R8) :: precip_fact(1) -! character(CS) :: cvalue -! real(R8) :: fswabsv, fswabsi -! integer :: scalar_id -! integer :: n -! integer :: lsize -! real(R8) :: c1,c2,c3,c4 -! character(len=64), allocatable :: fldnames(:) -! character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' -! !--------------------------------------- -! -! rc = ESMF_SUCCESS -! -! call t_startf('MED:'//subname) -! if (dbug_flag > 20) then -! call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) -! end if -! call memcheck(subname, 5, mastertask) -! -! ! Get the internal state -! nullify(is_local%wrap) -! call ESMF_GridCompGetInternalState(gcomp, is_local, rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! -! !--------------------------------------- -! ! Compute netsw for ocean -! !--------------------------------------- -! ! netsw_for_ocn = downsw_from_atm * (1-ocn_albedo) * (1-ice_fraction) + pensw_from_ice * (ice_fraction) -! -! ! Input from atm -! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swvdr', Faxa_swvdr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swndr', Faxa_swndr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swvdf', Faxa_swvdf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swndf', Faxa_swndf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! lsize = size(Faxa_swvdr) -! -! ! Input from mediator, ocean albedos -! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_avsdr' , avsdr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_anidr' , anidr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_avsdf' , avsdf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_anidf' , anidf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! -! ! Output to ocean swnet total -! if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet', Foxx_swnet, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! else -! lsize = size(Faxa_swvdr) -! allocate(Foxx_swnet(lsize)) -! end if -! -! ! Output to ocean swnet by radiation bands -! if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc)) then -! export_swnet_by_bands = .true. -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', Foxx_swnet_vdr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', Foxx_swnet_vdf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', Foxx_swnet_idr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', Foxx_swnet_idf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! else -! export_swnet_by_bands = .false. -! end if -! -! ! ----------------------- -! ! If cice IS NOT PRESENT -! ! ----------------------- -! if (.not. is_local%wrap%comp_present(compice)) then -! ! Compute total swnet to ocean independent of swpen from sea-ice -! do n = 1,lsize -! fswabsv = Faxa_swvdr(n) * (1.0_R8 - avsdr(n)) + Faxa_swvdf(n) * (1.0_R8 - avsdf(n)) -! fswabsi = Faxa_swndr(n) * (1.0_R8 - anidr(n)) + Faxa_swndf(n) * (1.0_R8 - anidf(n)) -! Foxx_swnet(n) = fswabsv + fswabsi -! end do -! ! Compute sw export to ocean bands if required -! if (export_swnet_by_bands) then -! c1 = 0.285; c2 = 0.285; c3 = 0.215; c4 = 0.215 -! Foxx_swnet_vdr(:) = c1 * Foxx_swnet(:) -! Foxx_swnet_vdf(:) = c2 * Foxx_swnet(:) -! Foxx_swnet_idr(:) = c3 * Foxx_swnet(:) -! Foxx_swnet_idf(:) = c4 * Foxx_swnet(:) -! end if -! end if -! -! ! ----------------------- -! ! If cice IS PRESENT -! ! ----------------------- -! if (is_local%wrap%comp_present(compice)) then -! -! ! Input from mediator, ice-covered ocean and open ocean fractions -! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrac' , ifrac, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac' , ofrac, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrad' , ifracr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrad' , ofracr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! -! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen', Fioi_swpen, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! if (FB_fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdr', rc=rc)) then -! import_swpen_by_bands = .true. -! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_vdr', Fioi_swpen_vdr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_vdf', Fioi_swpen_vdf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_idr', Fioi_swpen_idr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_idf', Fioi_swpen_idf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! else -! import_swpen_by_bands = .false. -! end if -! -! if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr',rc=rc)) then -! ! Swnet without swpen from sea-ice -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr', Foxx_swnet_afracr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! export_swnet_afracr = .true. -! else -! export_swnet_afracr = .false. -! end if -! -! do n = 1,lsize -! ! Compute total swnet to ocean independent of swpen from sea-ice -! fswabsv = Faxa_swvdr(n) * (1.0_R8 - avsdr(n)) + Faxa_swvdf(n) * (1.0_R8 - avsdf(n)) -! fswabsi = Faxa_swndr(n) * (1.0_R8 - anidr(n)) + Faxa_swndf(n) * (1.0_R8 - anidf(n)) -! Foxx_swnet(n) = fswabsv + fswabsi -! -! ! Add swpen from sea ice -! ifrac_scaled = ifrac(n) -! ofrac_scaled = ofrac(n) -! frac_sum = ifrac(n) + ofrac(n) -! if (frac_sum /= 0._R8) then -! ifrac_scaled = ifrac(n) / (frac_sum) -! ofrac_scaled = ofrac(n) / (frac_sum) -! endif -! ifracr_scaled = ifracr(n) -! ofracr_scaled = ofracr(n) -! frac_sum = ifracr(n) + ofracr(n) -! if (frac_sum /= 0._R8) then -! ifracr_scaled = ifracr(n) / (frac_sum) -! ofracr_scaled = ofracr(n) / (frac_sum) -! endif -! Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) -! -! if (export_swnet_afracr) then -! Foxx_swnet_afracr(n) = ofracr_scaled*(fswabsv + fswabsi) -! end if -! -! ! Compute sw export to ocean bands if required -! if (export_swnet_by_bands) then -! if (import_swpen_by_bands) then -! ! use each individual band for swpen coming from the sea-ice -! Foxx_swnet_vdr(n) = Faxa_swvdr(n)*(1.0_R8-avsdr(n))*ofracr_scaled + Fioi_swpen_vdr(n)*ifrac_scaled -! Foxx_swnet_vdf(n) = Faxa_swvdf(n)*(1.0_R8-avsdf(n))*ofracr_scaled + Fioi_swpen_vdf(n)*ifrac_scaled -! Foxx_swnet_idr(n) = Faxa_swndr(n)*(1.0_R8-anidr(n))*ofracr_scaled + Fioi_swpen_idr(n)*ifrac_scaled -! Foxx_swnet_idf(n) = Faxa_swndf(n)*(1.0_R8-anidf(n))*ofracr_scaled + Fioi_swpen_idf(n)*ifrac_scaled -! else -! ! scale total Foxx_swnet to get contributions from each band -! c1 = 0.285; c2 = 0.285; c3 = 0.215; c4 = 0.215 -! Foxx_swnet_vdr(n) = c1 * Foxx_swnet(n) -! Foxx_swnet_vdf(n) = c2 * Foxx_swnet(n) -! Foxx_swnet_idr(n) = c3 * Foxx_swnet(n) -! Foxx_swnet_idf(n) = c4 * Foxx_swnet(n) -! end if -! end if -! end do -! -! ! Output to ocean per ice thickness fraction and sw penetrating into ocean -! if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Sf_afrac', rc=rc)) then -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afrac', fldptr1=dataptr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! dataptr(:) = ofrac(:) -! end if -! if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Sf_afracr', rc=rc)) then -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afracr', fldptr1=dataptr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! dataptr(:) = ofracr(:) -! end if -! -! end if ! if sea-ice is present -! -! ! Deallocate Foxx_swnet if it was allocated in this subroutine -! if (.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then -! deallocate(Foxx_swnet) -! end if -! -! ! Apply precipitation factor from ocean (that scales atm rain and snow back to ocn ) if appropriate -! if (trim(coupling_mode) == 'cesm' .and. is_local%wrap%flds_scalar_index_precip_factor /= 0) then -! -! ! Note that in med_internal_mod.F90 all is_local%wrap%flds_scalar_index_precip_factor -! ! is initialized to 0. -! ! In addition, in med.F90, if this attribute is not present as a mediator component attribute, -! ! it is set to 0. -! if (mastertask) then -! call ESMF_StateGet(is_local%wrap%NstateImp(compocn), & -! itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc) -! if (chkerr(rc,__LINE__,u_FILE_u)) return -! call ESMF_FieldGet(lfield, farrayPtr=dataptr_scalar_ocn, rc=rc) -! if (chkerr(rc,__LINE__,u_FILE_u)) return -! scalar_id=is_local%wrap%flds_scalar_index_precip_factor -! precip_fact(1) = dataptr_scalar_ocn(scalar_id,1) -! if (precip_fact(1) /= 1._r8) then -! write(logunit,'(a,f21.13)')& -! '(merge_to_ocn): Scaling rain, snow, liquid and ice runoff by non-unity precip_fact ',& -! precip_fact(1) -! end if -! end if -! call ESMF_VMBroadCast(is_local%wrap%vm, precip_fact, 1, 0, rc=rc) -! if (chkerr(rc,__LINE__,u_FILE_u)) return -! is_local%wrap%flds_scalar_precip_factor = precip_fact(1) -! if (dbug_flag > 5) then -! write(cvalue,*) precip_fact(1) -! call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO) -! end if -! -! ! Scale rain and snow to ocn from atm by the precipitation factor received from the ocean -! allocate(fldnames(4)) -! fldnames = (/'Faxa_rain', 'Faxa_snow', 'Foxx_rofl', 'Foxx_rofi'/) -! do n = 1,size(fldnames) -! if (FB_fldchk(is_local%wrap%FBExp(compocn), trim(fldnames(n)), rc=rc)) then -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), trim(fldnames(n)) , dataptr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! dataptr(:) = dataptr(:) * is_local%wrap%flds_scalar_precip_factor -! end if -! end do -! deallocate(fldnames) -! end if -! -! if (dbug_flag > 20) then -! call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) -! end if -! call t_stopf('MED:'//subname) -! -! end subroutine med_phases_prep_wav_custom_cesm - end module med_phases_prep_wav_mod From ca8ca8bbf7517b130b8fddefd3849eec7f00a856 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 May 2023 14:40:36 -0600 Subject: [PATCH 337/395] udpates needed to pass taux and tauxy to wave --- mediator/esmFldsExchange_cesm_mod.F90 | 48 +------ mediator/fd_cesm.yaml | 18 +-- mediator/med_fraction_mod.F90 | 200 +------------------------- mediator/med_phases_aofluxes_mod.F90 | 15 +- 4 files changed, 26 insertions(+), 255 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 99f362f37..13811aec9 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2985,58 +2985,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compwav, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') end if end if -!PSH begin -! if (phase == 'advertise') then -! call addfld_from(compocn, 'So_ofrac') -! call addfld_to(compwav, 'So_ofrac') -! end if -! if (phase == 'advertise') then -! call addfld_from(compocn, 'So_ofrac') -! call addfld_to(compwav, 'So_ofrac') -! else -! if ( fldchk(is_local%wrap%FBexp(compwav) , 'So_ofrac', rc=rc) .and. & -! fldchk(is_local%wrap%FBImp(compice,compice ), 'So_ofrac', rc=rc)) then -! ! By default will be using a custom map - but if one is not available, use a generated bilinear instead -! call addmap_from(compice, 'Si_ifrac', compwav, mapbilnr, 'one', ice2wav_smap) -! call addmrg_to(compwav, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') -! end if -! end if ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') - ! call addfld_from(compice , 'Fioi_taux') - ! call addfld_aoflux('Faox_taux') - else - ! if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then - ! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then - ! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') - ! call addmrg_to(compwav, 'Fwxx_taux', & - ! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') - ! end if - ! call addmrg_to(compwav, 'Fwxx_taux', & - ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') - ! end if - end if -! if (phase == 'advertise') then -! call addfld_to(compwav , 'Fwxx_taux') -!! call addfld_from(compice , 'Fioi_taux') -! call addfld_aoflux('Faox_taux') -! else -! if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then -!! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then -!! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') -!! call addmrg_to(compwav, 'Fwxx_taux', & -!! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') -!! end if -! call addmrg_to(compwav, 'Fwxx_taux', & -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') -!! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') -! end if -! end if -!PSH end + call addfld_to(compwav , 'Fwxx_tauy') + end if !===================================================================== ! FIELDS TO RIVER (comprof) diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 060015656..c09a63c58 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1176,24 +1176,20 @@ canonical_units: m2/s description: wave elevation spectrum -#PSH begin - # + # #----------------------------------- # section: wave import #----------------------------------- - # - - # + # - standard_name: Fwxx_taux alias: mean_zonal_moment_flx canonical_units: N m-2 description: wave import - zonal surface stress - # -# - standard_name: Fwxx_tauy -# alias: mean_merid_moment_flx -# canonical_units: N m-2 -# description: wave import - meridional surface stress -#PSH end + # + - standard_name: Fwxx_tauy + alias: mean_merid_moment_flx + canonical_units: N m-2 + description: wave import - meridional surface stress #----------------------------------- # mediator fields diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 5331a5452..2fd83972a 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -23,11 +23,8 @@ module med_fraction_mod ! character(*),parameter :: fraclist_l = 'lfrac' ! character(*),parameter :: fraclist_g = 'gfrac:lfrac' ! character(*),parameter :: fraclist_r = 'lfrac:rfrac' - ! character(*),parameter :: fraclist_w = 'ifrac:ofrac:wfrac' -!PSH begin ! -! ! we assume ocean and ice are on the same grids, same masks - ! we assume ocean, ice, and waves are on the same grids, same masks -!PSH end + ! + ! we assume ocean and ice are on the same grids, same masks ! we assume ocn2atm and ice2atm are masked maps ! we assume lnd2atm is a global map ! we assume that the ice fraction evolves in time but that @@ -129,10 +126,8 @@ module med_fraction_mod character(len=6),parameter,dimension(1) :: fraclist_l = (/'lfrac '/) character(len=6),parameter,dimension(2) :: fraclist_g = (/'gfrac ','lfrac '/) character(len=6),parameter,dimension(2) :: fraclist_r = (/'rfrac ','lfrac '/) -!PSH begin -! character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) - character(len=6),parameter,dimension(3) :: fraclist_w = (/'ifrac ','ofrac ','wfrac '/) -!PSH end + character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) + !--- standard --- real(R8) , parameter :: eps_fraclim = 1.0e-03 ! truncation limit in fractions_a(lfrac) character(*), parameter :: u_FILE_u = & @@ -588,86 +583,6 @@ subroutine med_fraction_init(gcomp, rc) endif endif -!PSH Begin - In progress... -! Note: started this section, based on setting ifrac and ofrac for compatm, but it is not -! clear to me that this approach is correct, since we can assume ocn, ice, wav are all on -! the same grid. Commenting out for now, can delete once I'm confident other approach -! works -! !--------------------------------------- -! ! Set 'ofrac' in FBFrac(compwav) -! !--------------------------------------- -! -! if ( is_local%wrap%comp_present(compocn) .and. & -! is_local%wrap%comp_present(compwav) .and. & -! is_local%wrap%med_coupling_active(compocn,compwav)) then -! -! ! Set 'ofrac' in FBFrac(compwav) - at this point this is the -! ! ocean mask mapped to the atm grid This is mapping the ocean mask to -! ! the wav grid -! -! if (med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),mapfcopy, rc=rc)) then -! ! If ocn and atm are on the same mesh - a redist route handle has already been created -! maptype = mapfcopy -! else -! if (trim(coupling_mode) == 'nems_orig' ) then -! maptype = mapnstod_consd -! else -! maptype = mapconsd -! end if -! if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),maptype, rc=rc)) then -! call med_map_routehandles_init( compocn, compwav, & -! FBSrc=is_local%wrap%FBImp(compocn,compocn), & -! FBDst=is_local%wrap%FBImp(compocn,compwav), & -! mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! end if -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compocn), fieldname='ofrac', field=field_src, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), fieldname='ofrac', field=field_dst, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call med_map_field(field_src, field_dst, is_local%wrap%RH(compocn,compwav,:), maptype, rc=rc) -! if (chkerr(rc,__LINE__,u_FILE_u)) return -! -! end if -! -! !--------------------------------------- -! ! Set 'ifrac' in FBFrac(compwav) -! !--------------------------------------- -! -! if ( is_local%wrap%comp_present(compice) .and. & -! is_local%wrap%comp_present(compwav) .and. & -! is_local%wrap%med_coupling_active(compice,compwav)) then -! -! ! Set 'ifrac' in FBFrac(compwav) - at this point this is the ice mask mapped to the wav mesh -! ! This maps the ice mask (which is the same as the ocean mask) to the wav mesh -! if (med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),mapfcopy, rc=rc)) then -! ! If ice and wav are on the same mesh - a redist route handle has already been created -! maptype = mapfcopy -! else -! if (trim(coupling_mode) == 'nems_orig' ) then -! maptype = mapnstod_consd -! else -! maptype = mapconsd -! end if -! if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),maptype, rc=rc)) then -! call med_map_routehandles_init( compice, compwav, & -! FBSrc=is_local%wrap%FBImp(compice,compice), & -! FBDst=is_local%wrap%FBImp(compice,compwav), & -! mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! end if -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ifrac', field=field_src, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ifrac', field=field_dst, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compwav,:), maptype, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! -!PSH end - !--------------------------------------- ! Create route handles ocn<->ice if not created !--------------------------------------- @@ -703,80 +618,6 @@ subroutine med_fraction_init(gcomp, rc) end if end if -!PSH begin -! !--------------------------------------- -! ! Create route handles ocn<->wav if not created -! !--------------------------------------- -! -! if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compocn)) then -! if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compocn,:),mapfcopy, rc=rc)) then -! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compocn))) then -! call fldbun_init(is_local%wrap%FBImp(compwav,compocn), is_local%wrap%flds_scalar_name, & -! STgeom=is_local%wrap%NStateImp(compocn), & -! STflds=is_local%wrap%NStateImp(compwav), & -! name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compocn)), rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! call med_map_routehandles_init(compwav, compocn, & -! FBSrc=is_local%wrap%FBImp(compwav,compocn), & -! FBDst=is_local%wrap%FBImp(compwav,compocn), & -! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),mapfcopy, rc=rc)) then -! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compwav))) then -! call fldbun_init(is_local%wrap%FBImp(compocn,compwav), is_local%wrap%flds_scalar_name, & -! STgeom=is_local%wrap%NStateImp(compwav), & -! STflds=is_local%wrap%NStateImp(compocn), & -! name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compwav)), rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! call med_map_routehandles_init( compocn, compwav, & -! FBSrc=is_local%wrap%FBImp(compocn,compocn), & -! FBDst=is_local%wrap%FBImp(compocn,compwav), & -! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! end if -! -! !--------------------------------------- -! ! Create route handles ice<->wav if not created -! !--------------------------------------- -! -! if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compice)) then -! if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compice,:),mapfcopy, rc=rc)) then -! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compice))) then -! call fldbun_init(is_local%wrap%FBImp(compwav,compice), is_local%wrap%flds_scalar_name, & -! STgeom=is_local%wrap%NStateImp(compice), & -! STflds=is_local%wrap%NStateImp(compwav), & -! name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compice)), rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! call med_map_routehandles_init(compwav, compice, & -! FBSrc=is_local%wrap%FBImp(compwav,compice), & -! FBDst=is_local%wrap%FBImp(compwav,compice), & -! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),mapfcopy, rc=rc)) then -! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compice,compwav))) then -! call fldbun_init(is_local%wrap%FBImp(compice,compwav), is_local%wrap%flds_scalar_name, & -! STgeom=is_local%wrap%NStateImp(compwav), & -! STflds=is_local%wrap%NStateImp(compice), & -! name='FBImp'//trim(compname(compice))//'_'//trim(compname(compwav)), rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! call med_map_routehandles_init( compice, compwav, & -! FBSrc=is_local%wrap%FBImp(compice,compice), & -! FBDst=is_local%wrap%FBImp(compice,compwav), & -! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! end if -! -!PSH end - - !--------------------------------------- ! Diagnostic output !--------------------------------------- @@ -807,10 +648,7 @@ subroutine med_fraction_set(gcomp, rc) use ESMF , only : ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldBundleIsCreated use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS -!PSH Begin -! use med_internalstate_mod , only : compatm, compocn, compice, compname - use med_internalstate_mod , only : compatm, compocn, compice, compname, compwav -!PSH End + use med_internalstate_mod , only : compatm, compocn, compice, compname use med_internalstate_mod , only : mapfcopy, mapconsd, mapnstod_consd use med_internalstate_mod , only : coupling_mode use med_internalstate_mod , only : InternalState @@ -913,34 +751,6 @@ subroutine med_fraction_set(gcomp, rc) endif call t_stopf('MED:'//trim(subname)//' fbfrac(compocn)') -!PSH begin -! ! ------------------------------------------- -! ! Set FBfrac(compwav) -! ! ------------------------------------------- -! -! ! The following is just a redistribution from FBFrac(compice) -! -! call t_startf('MED:'//trim(subname)//' fbfrac(compwav)') -! if (is_local%wrap%comp_present(compwav)) then -! ! Map 'ifrac' from FBfrac(compice) to FBfrac(compwav) -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ifrac', field=field_src, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ifrac', field=field_dst, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compwav,:), mapfcopy, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! -! ! Map 'ofrac' from FBfrac(compice) to FBfrac(compwav) -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ofrac', field=field_src, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ofrac', field=field_dst, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compwav,:), mapfcopy, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! endif -! call t_stopf('MED:'//trim(subname)//' fbfrac(compwav)') -!PSH end - ! ------------------------------------------- ! Set FBfrac(compatm) ! ------------------------------------------- diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index ae38f995c..de3fd21a5 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -503,8 +503,8 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Field) :: lfield type(ESMF_Mesh) :: lmesh real(R8), pointer :: garea(:) => null() - type(ESMF_CoordSys_Flag) :: coordSys integer :: maptype + type(ESMF_CoordSys_Flag) :: coordSys character(len=*),parameter :: subname=' (med_aofluxes_init_ocngrid) ' !----------------------------------------------------------------------- @@ -1120,8 +1120,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) end if - ! map aoflux fields to wav grid if stresses are needed on the wave grid - if ( FB_fldchk(is_local%wrap%FBExp(compwav), 'Fwxx_taux', rc=rc)) then + ! map taux and tauy from ocean to wave grid if stresses are needed on the wave grid + if ( FB_fldchk(is_local%wrap%FBExp(compwav), 'Fwxx_taux', rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compwav), 'Fwxx_tauy', rc=rc)) then maptype = mapconsf if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:), maptype, rc=rc)) then call med_map_routehandles_init( compocn, compwav, & @@ -1138,6 +1139,14 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) routehandle=is_local%wrap%RH(compocn, compwav, maptype), & termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBMed_aoflux_o, 'Faox_tauy', field=field_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBExp(compwav), 'Fwxx_tauy', field=field_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegrid(field_src, field_dst, & + routehandle=is_local%wrap%RH(compocn, compwav, maptype), & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if call t_stopf('MED:'//subname) From d64ffe9bdf1be421a8bdb7b730355386b81e7cc7 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 May 2023 15:06:49 -0600 Subject: [PATCH 338/395] fixed compile bugs --- mediator/med_phases_aofluxes_mod.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index de3fd21a5..46c7c93f7 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -975,6 +975,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) real(r8), parameter :: p0 = 100000.0_r8 ! reference pressure in Pa real(r8), parameter :: rcp = 0.286_r8 ! gas constant of air / specific heat capacity at a constant pressure real(r8), parameter :: rdair = 287.058_r8 ! dry air gas constant in J/K/kg + integer :: maptype + type(ESMF_Field) :: field_src + type(ESMF_Field) :: field_dst character(*),parameter :: subName = '(med_aofluxes_update) ' !----------------------------------------------------------------------- From 488b8d9f1cd7f25a1c7344bd8b3268ccc2c5dffd Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 May 2023 15:28:07 -0600 Subject: [PATCH 339/395] fixed compile bugs --- mediator/med_phases_aofluxes_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 46c7c93f7..48055e92e 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -503,7 +503,6 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Field) :: lfield type(ESMF_Mesh) :: lmesh real(R8), pointer :: garea(:) => null() - integer :: maptype type(ESMF_CoordSys_Flag) :: coordSys character(len=*),parameter :: subname=' (med_aofluxes_init_ocngrid) ' !----------------------------------------------------------------------- From c3e57f4c027e622a53aacd39ebd449eeb551ae62 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 18 May 2023 16:01:59 -0600 Subject: [PATCH 340/395] make this an input that can be toggled in user_nl_cpl --- cime_config/namelist_definition_drv.xml | 11 +++++++++++ mediator/med_methods_mod.F90 | 21 +++++++++++++++++---- mediator/med_phases_prep_atm_mod.F90 | 2 +- mediator/med_phases_prep_glc_mod.F90 | 2 +- mediator/med_phases_prep_ice_mod.F90 | 2 +- mediator/med_phases_prep_lnd_mod.F90 | 2 +- mediator/med_phases_prep_ocn_mod.F90 | 2 +- mediator/med_phases_prep_rof_mod.F90 | 2 +- mediator/med_phases_prep_wav_mod.F90 | 2 +- 9 files changed, 35 insertions(+), 11 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index bfe991383..43623b195 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -716,6 +716,17 @@ $ESMF_VERBOSITY_LEVEL + + logical + performance + MED_attributes + + Check for NaN values in fields returned from mediator to components + + + .false. + + integer control diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index faecf47a6..739db9b54 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2506,11 +2506,12 @@ subroutine med_methods_FB_getmesh(FB, mesh, rc) end subroutine med_methods_FB_getmesh !----------------------------------------------------------------------------- - subroutine med_methods_FB_check_for_nans(FB, rc) - - use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet, ESMF_FieldGet + subroutine med_methods_FB_check_for_nans(gcomp, FB, rc) + use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_GridComp + use NUOPC, only : NUOPC_CompAttributeGet ! input/output variables + type(ESMF_GridComp) , intent(in) :: gcomp type(ESMF_FieldBundle) , intent(in) :: FB integer , intent(inout) :: rc @@ -2526,11 +2527,23 @@ subroutine med_methods_FB_check_for_nans(FB, rc) character(len=CS) :: nancount_char character(len=CL) :: msg_error logical :: nanfound + logical, save :: checkfornans + logical, save :: firstcall=.true. + character(len=CL) :: cvalue character(len=*), parameter :: subname='(med_methods_FB_check_for_nans)' ! ---------------------------------------------- rc = ESMF_SUCCESS -#ifndef CESMCOUPLED +#ifdef CESMCOUPLED + if (firstcall) then + call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue, *) checkfornans + firstcall = .false. + endif + if(.not. checkfornans) return + +#else ! For now only CESM uses shr_infnan_isnan - so until other models provide this RETURN #endif diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index bccf8e07c..8de571d0d 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -245,7 +245,7 @@ subroutine med_phases_prep_atm(gcomp, rc) end if ! Check for nans in fields export to atm - call FB_check_for_nans(is_local%wrap%FBExp(compatm), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compatm), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 97049d5b9..cd09abc3d 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -709,7 +709,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) ! Check for nans in fields export to atm do ns = 1,is_local%wrap%num_icesheets - call FB_check_for_nans(is_local%wrap%FBExp(compglc(ns)), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compglc(ns)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 1e0496b3d..e234eb987 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -151,7 +151,7 @@ subroutine med_phases_prep_ice(gcomp, rc) end if ! Check for nans in fields export to atm - call FB_check_for_nans(is_local%wrap%FBExp(compice), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compice), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index b73412937..26722b4f8 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -129,7 +129,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) first_call = .false. ! Check for nans in fields export to atm - call FB_check_for_nans(is_local%wrap%FBExp(complnd), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(complnd), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index de989ac49..7628bd61a 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -297,7 +297,7 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Check for nans in fields export to atm - call FB_check_for_nans(is_local%wrap%FBExp(compocn), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compocn), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! zero accumulator diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index cf0ad0f4e..b866cc00b 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -378,7 +378,7 @@ subroutine med_phases_prep_rof(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Check for nans in fields export to atm - call FB_check_for_nans(is_local%wrap%FBExp(comprof), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(comprof), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 3028303bc..526ecb204 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -178,7 +178,7 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Check for nans in fields export to atm - call FB_check_for_nans(is_local%wrap%FBExp(compwav), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compwav), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! zero accumulator From d84c9b3151c25fe8c34059d84e29918bf5abc0ca Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 18 May 2023 16:05:48 -0600 Subject: [PATCH 341/395] expand description --- cime_config/namelist_definition_drv.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 43623b195..a676c49ba 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -721,7 +721,7 @@ performance MED_attributes - Check for NaN values in fields returned from mediator to components + Check for NaN values in fields returned from mediator to components. This has a small performance impact. .false. From a753571a110dcb59f3b16d28d4868599bc7ef3ad Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 19 May 2023 08:39:08 -0600 Subject: [PATCH 342/395] make default .true. add log message --- cime_config/namelist_definition_drv.xml | 2 +- mediator/med_methods_mod.F90 | 15 +++++++++++---- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index a676c49ba..dec6868f1 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -724,7 +724,7 @@ Check for NaN values in fields returned from mediator to components. This has a small performance impact. - .false. + .true. diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 739db9b54..b4e9c2050 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2507,7 +2507,7 @@ end subroutine med_methods_FB_getmesh !----------------------------------------------------------------------------- subroutine med_methods_FB_check_for_nans(gcomp, FB, rc) - + use med_internalstate_mod, only : maintask, logunit use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_GridComp use NUOPC, only : NUOPC_CompAttributeGet ! input/output variables @@ -2538,16 +2538,23 @@ subroutine med_methods_FB_check_for_nans(gcomp, FB, rc) if (firstcall) then call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue, *) checkfornans + read(cvalue, *) checkfornans firstcall = .false. + if(maintask) then + write(logunit,*) ' check_for_nans is ',checkfornans + if(checkfornans) then + write(logunit,*) ' Fields will be checked for NaN values when passed from mediator to component' + else + write(logunit,*) ' Fields will NOT be checked for NaN values when passed from mediator to component' + endif + endif endif if(.not. checkfornans) return - #else ! For now only CESM uses shr_infnan_isnan - so until other models provide this RETURN #endif - + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 0ff2afeedb44c40c2e1b2d6ec2b3ff3f3c5b11ae Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 19 May 2023 09:16:22 -0600 Subject: [PATCH 343/395] resolve circular dependancy --- mediator/med_methods_mod.F90 | 5 +++-- mediator/med_phases_prep_atm_mod.F90 | 4 ++-- mediator/med_phases_prep_glc_mod.F90 | 2 +- mediator/med_phases_prep_ice_mod.F90 | 2 +- mediator/med_phases_prep_lnd_mod.F90 | 4 ++-- mediator/med_phases_prep_ocn_mod.F90 | 2 +- mediator/med_phases_prep_rof_mod.F90 | 2 +- mediator/med_phases_prep_wav_mod.F90 | 2 +- 8 files changed, 12 insertions(+), 11 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index b4e9c2050..95c87d7b3 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2506,13 +2506,14 @@ subroutine med_methods_FB_getmesh(FB, mesh, rc) end subroutine med_methods_FB_getmesh !----------------------------------------------------------------------------- - subroutine med_methods_FB_check_for_nans(gcomp, FB, rc) - use med_internalstate_mod, only : maintask, logunit + subroutine med_methods_FB_check_for_nans(gcomp, FB, maintask, logunit, rc) use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_GridComp use NUOPC, only : NUOPC_CompAttributeGet ! input/output variables type(ESMF_GridComp) , intent(in) :: gcomp type(ESMF_FieldBundle) , intent(in) :: FB + logical , intent(in) :: maintask + integer , intent(in) :: logunit integer , intent(inout) :: rc ! local variables diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 8de571d0d..a58becf9a 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -17,7 +17,7 @@ module med_phases_prep_atm_mod use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed - use med_internalstate_mod , only : InternalState, maintask + use med_internalstate_mod , only : InternalState, maintask, logunit use med_internalstate_mod , only : compatm, compocn, compice, compname, coupling_mode use esmFlds , only : med_fldlist_GetfldListTo, med_fldlist_type use perf_mod , only : t_startf, t_stopf @@ -245,7 +245,7 @@ subroutine med_phases_prep_atm(gcomp, rc) end if ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compatm), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compatm), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index cd09abc3d..4ee84448e 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -709,7 +709,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) ! Check for nans in fields export to atm do ns = 1,is_local%wrap%num_icesheets - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compglc(ns)), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compglc(ns)), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index e234eb987..da56458c7 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -151,7 +151,7 @@ subroutine med_phases_prep_ice(gcomp, rc) end if ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compice), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compice), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 26722b4f8..1bab6c794 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -33,7 +33,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : complnd, compatm - use med_internalstate_mod , only : InternalState, maintask + use med_internalstate_mod , only : InternalState, maintask, logunit use med_merge_mod , only : med_merge_auto use perf_mod , only : t_startf, t_stopf @@ -129,7 +129,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) first_call = .false. ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(complnd), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(complnd), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 7628bd61a..b9a3a485e 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -297,7 +297,7 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compocn), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compocn), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! zero accumulator diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index b866cc00b..e2853c51c 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -378,7 +378,7 @@ subroutine med_phases_prep_rof(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(comprof), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(comprof), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 526ecb204..200e4bc62 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -178,7 +178,7 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compwav), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compwav), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! zero accumulator From 689d674c2bb083a580bd2ffbe66d6b1200d00f86 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 19 May 2023 09:20:26 -0600 Subject: [PATCH 344/395] remove CESMCOUPLED cppdef --- mediator/med_methods_mod.F90 | 30 +----------------------------- 1 file changed, 1 insertion(+), 29 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 95c87d7b3..452017932 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2535,7 +2535,6 @@ subroutine med_methods_FB_check_for_nans(gcomp, FB, maintask, logunit, rc) ! ---------------------------------------------- rc = ESMF_SUCCESS -#ifdef CESMCOUPLED if (firstcall) then call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2551,11 +2550,7 @@ subroutine med_methods_FB_check_for_nans(gcomp, FB, maintask, logunit, rc) endif endif if(.not. checkfornans) return -#else - ! For now only CESM uses shr_infnan_isnan - so until other models provide this - RETURN -#endif - + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2592,7 +2587,6 @@ subroutine med_methods_FB_check_for_nans(gcomp, FB, maintask, logunit, rc) end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- -#ifdef CESMCOUPLED subroutine med_methods_check_for_nans_1d(dataptr, nancount) use shr_infnan_mod, only: shr_infnan_isnan @@ -2628,26 +2622,4 @@ subroutine med_methods_check_for_nans_2d(dataptr, nancount) end do end subroutine med_methods_check_for_nans_2d -#else - - ! For now only CESM uses shr_infnan_isnan - so until other models provide this - ! nancount will just be set to zero - - subroutine med_methods_check_for_nans_1d(dataptr, nancount) - ! input/output variables - real(r8) , intent(in) :: dataptr(:) - integer , intent(out) :: nancount - - nancount = 0 - end subroutine med_methods_check_for_nans_1d - - subroutine med_methods_check_for_nans_2d(dataptr, nancount) - ! input/output variables - real(r8) , intent(in) :: dataptr(:,:) - integer , intent(out) :: nancount - - nancount = 0 - end subroutine med_methods_check_for_nans_2d -#endif - end module med_methods_mod From b6ba816c71ad2e1b8992c7cab3c93185a56b1bad Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 19 May 2023 10:53:56 -0600 Subject: [PATCH 345/395] pass the strict ext build test --- .github/workflows/extbuild.yml | 4 ++-- mediator/med_methods_mod.F90 | 33 ++++++++++++++++++++++++++++++++- 2 files changed, 34 insertions(+), 3 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index fafc46f46..a659e4eb6 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -19,10 +19,10 @@ jobs: CXX: mpicxx CPPFLAGS: "-I/usr/include -I/usr/local/include" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.4.0 + ESMF_VERSION: v8.4.2 PNETCDF_VERSION: checkpoint.1.12.3 NETCDF_FORTRAN_VERSION: v4.6.0 - PIO_VERSION: pio2_5_10 + PIO_VERSION: pio2_6_0 steps: - uses: actions/checkout@v3 # Build the ESMF library, if the cache contains a previous build diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 452017932..5b5ec6bde 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2535,6 +2535,7 @@ subroutine med_methods_FB_check_for_nans(gcomp, FB, maintask, logunit, rc) ! ---------------------------------------------- rc = ESMF_SUCCESS +#ifdef CESMCOUPLED if (firstcall) then call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2549,8 +2550,15 @@ subroutine med_methods_FB_check_for_nans(gcomp, FB, maintask, logunit, rc) endif endif endif +#else + ! For now only CESM uses shr_infnan_isnan - so until other models provide this + cvalue = ".false." + checkfornans = .false. + if(firstcall) write(logunit,*) ' Fields will NOT be checked for NaN values when passed from mediator to component' + firstcall = .false. +#endif if(.not. checkfornans) return - + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2587,6 +2595,7 @@ subroutine med_methods_FB_check_for_nans(gcomp, FB, maintask, logunit, rc) end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- +#ifdef CESMCOUPLED subroutine med_methods_check_for_nans_1d(dataptr, nancount) use shr_infnan_mod, only: shr_infnan_isnan @@ -2622,4 +2631,26 @@ subroutine med_methods_check_for_nans_2d(dataptr, nancount) end do end subroutine med_methods_check_for_nans_2d +#else + + ! For now only CESM uses shr_infnan_isnan - so until other models provide this + ! nancount will just be set to zero + + subroutine med_methods_check_for_nans_1d(dataptr, nancount) + ! input/output variables + real(r8) , intent(in) :: dataptr(:) + integer , intent(out) :: nancount + + nancount = 0 + end subroutine med_methods_check_for_nans_1d + + subroutine med_methods_check_for_nans_2d(dataptr, nancount) + ! input/output variables + real(r8) , intent(in) :: dataptr(:,:) + integer , intent(out) :: nancount + + nancount = 0 + end subroutine med_methods_check_for_nans_2d +#endif + end module med_methods_mod From 79cf2082355dfd70dc92013cbd04dcdd2c810d59 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 19 May 2023 16:49:26 -0600 Subject: [PATCH 346/395] rework based on pr review --- .github/workflows/extbuild.yml | 33 ++++++++++++++++++++++++-- mediator/med.F90 | 15 ++++++++++++ mediator/med_methods_mod.F90 | 35 +++++----------------------- mediator/med_phases_prep_atm_mod.F90 | 2 +- mediator/med_phases_prep_glc_mod.F90 | 4 ++-- mediator/med_phases_prep_ice_mod.F90 | 4 ++-- mediator/med_phases_prep_lnd_mod.F90 | 4 ++-- mediator/med_phases_prep_ocn_mod.F90 | 4 ++-- mediator/med_phases_prep_rof_mod.F90 | 4 ++-- mediator/med_phases_prep_wav_mod.F90 | 4 ++-- 10 files changed, 65 insertions(+), 44 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index a659e4eb6..d5f742588 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -18,11 +18,13 @@ jobs: FC: mpifort CXX: mpicxx CPPFLAGS: "-I/usr/include -I/usr/local/include" + # Versions of all dependencies can be updated here ESMF_VERSION: v8.4.2 PNETCDF_VERSION: checkpoint.1.12.3 NETCDF_FORTRAN_VERSION: v4.6.0 PIO_VERSION: pio2_6_0 + CDEPS_VERSION: cdeps1.0.15 steps: - uses: actions/checkout@v3 # Build the ESMF library, if the cache contains a previous build @@ -50,14 +52,14 @@ jobs: key: ${{ runner.os }}-${{ env.PIO_VERSION }}.pio - name: Build ParallelIO if: steps.cache-ParallelIO.outputs.cache-hit != 'true' - uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@9390e30e29d4ebbfbef0fc72162cacd9e8f25e4e + uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@2_6_0 with: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True install_prefix: $HOME/pio - name: Build ESMF if: steps.cache-esmf.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildesmf@e06246b560d3132170bb1a5443fa3d65dfbd2040 + uses: ESCOMP/CDEPS/.github/actions/buildesmf@cdeps1.0.15 with: esmf_version: ${{ env.ESMF_VERSION }} esmf_bopt: g @@ -67,6 +69,29 @@ jobs: netcdf_fortran_path: /usr pnetcdf_path: /usr parallelio_path: $HOME/pio + - name: Cache CDEPS + id: cache-cdeps + uses: actions/cache@v3 + with: + path: $HOME/cdeps + key: ${{ runner.os }}-${{ env.CDEPS_VERSION }}.cdeps + + - name: checkout CDEPS + uses: actions/checkout@v3 + with: + repository: ESCOMP/CDEPS + path: cdeps-src + ref: ${{ env.CDEPS_VERSION }} + - name: Build CDEPS + if steps.cache-cdeps.outputs.cache-hit != 'true' + uses: ESCOMP/CDEPS/.github/actions/buildcdeps@cdeps1.0.15 + with: + esmfmkfile: $HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk + pio_path: $HOME/pio + src_root: $HOME/cdeps-src + cmake_flags: " -Wno-dev -DCMAKE_BUILD_TYPE=DEBUG -DWERROR=ON -DCMAKE_Fortran_FLAGS=\"-DCPRGNU -g -Wall \ + -ffree-form -ffree-line-length-none -fallow-argument-mismatch \"" + - name: Build CMEPS run: | export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk @@ -76,3 +101,7 @@ jobs: cmake -DCMAKE_BUILD_TYPE=DEBUG -DCMAKE_Fortran_FLAGS="-g -Wall -Werror -ffree-form -ffree-line-length-none -Wno-unused-dummy-argument" ../ make VERBOSE=1 popd + + - name: Setup tmate session + if: ${{ failure() }} + uses: mxschmitt/action-tmate@v3 diff --git a/mediator/med.F90 b/mediator/med.F90 index e7c6da9d3..df0b13eca 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -661,6 +661,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use esmFlds, only : med_fldlist_init1, med_fld_GetFldInfo, med_fldList_entry_type use med_phases_history_mod, only : med_phases_history_init + use med_methods_mod , only : mediator_checkfornans ! input/output variables type(ESMF_GridComp) :: gcomp @@ -916,6 +917,20 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) end if end do ! end of ncomps loop + ! Should mediator check for NaNs? + call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue, *) mediator_checkfornans + if(maintask) then + write(logunit,*) ' check_for_nans is ',mediator_checkfornans + if(mediator_checkfornans) then + write(logunit,*) ' Fields will be checked for NaN values when passed from mediator to component' + else + write(logunit,*) ' Fields will NOT be checked for NaN values when passed from mediator to component' + endif + endif + + if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 5b5ec6bde..40e10bc72 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -30,7 +30,7 @@ module med_methods_mod end interface med_methods_check_for_nans ! used/reused in module - + logical, public :: mediator_checkfornans ! set in med.F90 AdvertiseFields logical :: isPresent character(len=1024) :: msgString type(ESMF_FieldStatus_Flag) :: status @@ -2506,11 +2506,9 @@ subroutine med_methods_FB_getmesh(FB, mesh, rc) end subroutine med_methods_FB_getmesh !----------------------------------------------------------------------------- - subroutine med_methods_FB_check_for_nans(gcomp, FB, maintask, logunit, rc) - use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_GridComp - use NUOPC, only : NUOPC_CompAttributeGet + subroutine med_methods_FB_check_for_nans(FB, maintask, logunit, rc) + use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet, ESMF_FieldGet ! input/output variables - type(ESMF_GridComp) , intent(in) :: gcomp type(ESMF_FieldBundle) , intent(in) :: FB logical , intent(in) :: maintask integer , intent(in) :: logunit @@ -2528,36 +2526,15 @@ subroutine med_methods_FB_check_for_nans(gcomp, FB, maintask, logunit, rc) character(len=CS) :: nancount_char character(len=CL) :: msg_error logical :: nanfound - logical, save :: checkfornans - logical, save :: firstcall=.true. - character(len=CL) :: cvalue character(len=*), parameter :: subname='(med_methods_FB_check_for_nans)' ! ---------------------------------------------- rc = ESMF_SUCCESS -#ifdef CESMCOUPLED - if (firstcall) then - call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue, *) checkfornans - firstcall = .false. - if(maintask) then - write(logunit,*) ' check_for_nans is ',checkfornans - if(checkfornans) then - write(logunit,*) ' Fields will be checked for NaN values when passed from mediator to component' - else - write(logunit,*) ' Fields will NOT be checked for NaN values when passed from mediator to component' - endif - endif - endif -#else +#ifndef CESMCOUPLED ! For now only CESM uses shr_infnan_isnan - so until other models provide this - cvalue = ".false." - checkfornans = .false. - if(firstcall) write(logunit,*) ' Fields will NOT be checked for NaN values when passed from mediator to component' - firstcall = .false. + mediator_checkfornans = .false. #endif - if(.not. checkfornans) return + if(.not. mediator_checkfornans) return call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index a58becf9a..98728a8a6 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -245,7 +245,7 @@ subroutine med_phases_prep_atm(gcomp, rc) end if ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compatm), maintask, logunit, rc=rc) + call FB_check_for_nans(is_local%wrap%FBExp(compatm), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 4ee84448e..920fb415e 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -707,9 +707,9 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) endif end if - ! Check for nans in fields export to atm + ! Check for nans in fields export to glc do ns = 1,is_local%wrap%num_icesheets - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compglc(ns)), maintask, logunit, rc=rc) + call FB_check_for_nans(is_local%wrap%FBExp(compglc(ns)), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index da56458c7..524313622 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -150,8 +150,8 @@ subroutine med_phases_prep_ice(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if - ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compice), maintask, logunit, rc=rc) + ! Check for nans in fields export to ice + call FB_check_for_nans(is_local%wrap%FBExp(compice), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 1bab6c794..4be8bb402 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -128,8 +128,8 @@ subroutine med_phases_prep_lnd(gcomp, rc) ! Set first call logical to false first_call = .false. - ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(complnd), maintask, logunit, rc=rc) + ! Check for nans in fields export to lnd + call FB_check_for_nans(is_local%wrap%FBExp(complnd), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index b9a3a485e..59a87726c 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -296,8 +296,8 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) call FB_copy(is_local%wrap%FBExp(compocn), is_local%wrap%FBExpAccumOcn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compocn), maintask, logunit, rc=rc) + ! Check for nans in fields export to ocn + call FB_check_for_nans(is_local%wrap%FBExp(compocn), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! zero accumulator diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index e2853c51c..55b2dae82 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -377,8 +377,8 @@ subroutine med_phases_prep_rof(gcomp, rc) FBfrac=is_local%wrap%FBFrac(comprof), FBin=FBlndAccum2rof_r, fldListTo=fldList, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(comprof), maintask, logunit, rc=rc) + ! Check for nans in fields export to rof + call FB_check_for_nans(is_local%wrap%FBExp(comprof), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 200e4bc62..c690aa522 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -177,8 +177,8 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) call FB_copy(is_local%wrap%FBExp(compwav), is_local%wrap%FBExpAccumWav, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compwav), maintask, logunit, rc=rc) + ! Check for nans in fields export to wav + call FB_check_for_nans(is_local%wrap%FBExp(compwav), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! zero accumulator From 92ace685b61e48bd62ea41eeb5ea7768610d50ed Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 19 May 2023 16:51:41 -0600 Subject: [PATCH 347/395] fix yaml syntax --- .github/workflows/extbuild.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index d5f742588..4b00101c7 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -83,7 +83,7 @@ jobs: path: cdeps-src ref: ${{ env.CDEPS_VERSION }} - name: Build CDEPS - if steps.cache-cdeps.outputs.cache-hit != 'true' + if: steps.cache-cdeps.outputs.cache-hit != 'true' uses: ESCOMP/CDEPS/.github/actions/buildcdeps@cdeps1.0.15 with: esmfmkfile: $HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk From 60b9f1999890e6217b598f2011f0d55cf26f240d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 19 May 2023 16:54:05 -0600 Subject: [PATCH 348/395] fix ext versions --- .github/workflows/extbuild.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 4b00101c7..15237f0db 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -52,14 +52,14 @@ jobs: key: ${{ runner.os }}-${{ env.PIO_VERSION }}.pio - name: Build ParallelIO if: steps.cache-ParallelIO.outputs.cache-hit != 'true' - uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@2_6_0 + uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@${{ env.PIO_VERSION }} with: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True install_prefix: $HOME/pio - name: Build ESMF if: steps.cache-esmf.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildesmf@cdeps1.0.15 + uses: ESCOMP/CDEPS/.github/actions/buildesmf@${{ env.CDEPS_VERSION }} with: esmf_version: ${{ env.ESMF_VERSION }} esmf_bopt: g From 0b862b929ace490f06c56b87f200b4d890146505 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 19 May 2023 16:55:21 -0600 Subject: [PATCH 349/395] fix ext versions --- .github/workflows/extbuild.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 15237f0db..f968d0371 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -52,14 +52,14 @@ jobs: key: ${{ runner.os }}-${{ env.PIO_VERSION }}.pio - name: Build ParallelIO if: steps.cache-ParallelIO.outputs.cache-hit != 'true' - uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@${{ env.PIO_VERSION }} + uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@pio2_6_0 with: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True install_prefix: $HOME/pio - name: Build ESMF if: steps.cache-esmf.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildesmf@${{ env.CDEPS_VERSION }} + uses: ESCOMP/CDEPS/.github/actions/buildesmf@cdeps1.0.15 with: esmf_version: ${{ env.ESMF_VERSION }} esmf_bopt: g From 5b26040ea42182724c5d24ec113f0221e78b51de Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 23 May 2023 10:53:19 -0600 Subject: [PATCH 350/395] add ispresent and isset --- mediator/med.F90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index df0b13eca..56fcb7621 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -918,9 +918,13 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) end do ! end of ncomps loop ! Should mediator check for NaNs? - call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue, *) mediator_checkfornans + if(isPresent .and. isSet) then + read(cvalue, *) mediator_checkfornans + else + mediator_checkfornans = .false. + endif if(maintask) then write(logunit,*) ' check_for_nans is ',mediator_checkfornans if(mediator_checkfornans) then From dabe6d3ae5592adc2520a1203b9d34c0d37df08d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 23 May 2023 14:56:23 -0600 Subject: [PATCH 351/395] make xgrid default (should have been in alpha12c) and fix sw flux to mom ocn --- cime_config/namelist_definition_drv.xml | 2 +- mediator/med_phases_prep_ocn_mod.F90 | 6 +++++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index fdc53d43b..57baa9229 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -927,7 +927,7 @@ default: xgrid - ogrid + xgrid diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 60e37a95e..7d8950582 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -383,7 +383,11 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Check that the necessary export field is present - if ( .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then + if ( .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc) .and. & + .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc) .and. & + .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & + .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & + .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc)) then return end if From e94015a90bcee1cea45a6f30f78eab5e292dd6f6 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 23 May 2023 17:56:49 -0600 Subject: [PATCH 352/395] slight change in logic --- mediator/med_phases_prep_ocn_mod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 7d8950582..c19a4cf47 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -384,10 +384,10 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) ! Check that the necessary export field is present if ( .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc) .and. & - .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc) .and. & - .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & - .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & - .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc)) then + .not. (FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc))) then return end if From 6a642a6f92450d80c36ab92aeadb8733d60875ae Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Wed, 24 May 2023 07:35:58 -0400 Subject: [PATCH 353/395] get ufs to work w/ ocnalb * remove swnet to ocean from custom_nems * set optional use of nextswday * get med history working w/o aofluxes --- mediator/esmFldsExchange_nems_mod.F90 | 10 +++ mediator/med.F90 | 10 +-- mediator/med_map_mod.F90 | 3 +- mediator/med_phases_history_mod.F90 | 2 +- mediator/med_phases_ocnalb_mod.F90 | 107 +++++++++++++++++--------- mediator/med_phases_prep_ocn_mod.F90 | 65 ++++++++-------- 6 files changed, 122 insertions(+), 75 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index e62863a5d..d55f3d1b8 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -38,6 +38,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use esmFlds , only : addmap_from => med_fldList_addmap_from use esmFlds , only : addfld_aoflux => med_fldList_addfld_aoflux use esmFlds , only : addmap_aoflux => med_fldList_addmap_aoflux + use esmFlds , only : addfld_ocnalb => med_fldList_addfld_ocnalb + use esmFlds , only : addmap_ocnalb => med_fldList_addmap_ocnalb ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -172,6 +174,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call addfld_from(compice, 'mean_sw_pen_to_ocn') end if + ! Advertise the ocean albedos. These are not sent to the ATM in UFS. + if (phase == 'advertise') then + call addfld_ocnalb('So_avsdr') + call addfld_ocnalb('So_avsdf') + call addfld_ocnalb('So_anidr') + call addfld_ocnalb('So_anidf') + end if + !===================================================================== ! FIELDS TO ATMOSPHERE (compatm) !===================================================================== diff --git a/mediator/med.F90 b/mediator/med.F90 index e7c6da9d3..564c8b1dd 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1920,14 +1920,12 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------- - ! Initialize ocean albedos (this is needed for cesm and hafs) + ! Initialize ocean albedos !---------------------------------------------------------- - if (trim(coupling_mode(1:5)) /= 'nems_') then - if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compatm)) then - call med_phases_ocnalb_run(gcomp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compatm)) then + call med_phases_ocnalb_run(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if !--------------------------------------- diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 18752dc2f..6a0661643 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -259,7 +259,8 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun if (chkerr(rc,__LINE__,u_FILE_u)) return if (maintask) then write(logunit,'(a)') trim(subname)//' created field_NormOne for '& - //compname(n1)//'->'//compname(n2)//' with mapping '//trim(mapnames(mapindex)) + //trim(compname(n1))//'->'//trim(compname(n2))//' with mapping '& + //trim(mapnames(mapindex)) end if end if end do ! end of loop over map_indiex mappers diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 5f150a4b7..7d59a7fea 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -25,7 +25,7 @@ module med_phases_history_mod use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf use pio , only : file_desc_t - + implicit none private diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index a5ef002c7..2d2da421c 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -8,11 +8,9 @@ module med_phases_ocnalb_mod use med_methods_mod , only : State_GetScalar => med_methods_State_GetScalar use med_internalstate_mod , only : mapconsf, mapnames, compatm, compocn use perf_mod , only : t_startf, t_stopf -#ifdef CESMCOUPLED use shr_orb_mod , only : shr_orb_cosz, shr_orb_decl use shr_orb_mod , only : shr_orb_params, SHR_ORB_UNDEF_INT, SHR_ORB_UNDEF_REAL use shr_log_mod , only : shr_log_unit -#endif implicit none private @@ -26,11 +24,10 @@ module med_phases_ocnalb_mod !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- -#ifdef CESMCOUPLED + private med_phases_ocnalb_init private med_phases_ocnalb_orbital_update private med_phases_ocnalb_orbital_init -#endif !-------------------------------------------------------------------------- ! Private data @@ -47,17 +44,15 @@ module med_phases_ocnalb_mod logical :: created ! has memory been allocated here end type ocnalb_type - ! Conversion from degrees to radians character(*),parameter :: u_FILE_u = & __FILE__ -#ifdef CESMCOUPLED character(len=CL) :: orb_mode ! attribute - orbital mode integer :: orb_iyear ! attribute - orbital year integer :: orb_iyear_align ! attribute - associated with model year real(R8) :: orb_obliq ! attribute - obliquity in degrees real(R8) :: orb_mvelp ! attribute - moving vernal equinox longitude real(R8) :: orb_eccen ! attribute and update- orbital eccentricity -#endif + character(len=*) , parameter :: orb_fixed_year = 'fixed_year' character(len=*) , parameter :: orb_variable_year = 'variable_year' character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' @@ -65,7 +60,7 @@ module med_phases_ocnalb_mod !=============================================================================== contains !=============================================================================== -#ifdef CESMCOUPLED + subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) !----------------------------------------------------------------------- @@ -192,7 +187,7 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) call t_stopf('MED:'//subname) end subroutine med_phases_ocnalb_init -#endif + !=============================================================================== subroutine med_phases_ocnalb_run(gcomp, rc) @@ -201,8 +196,10 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ! Compute ocean albedos (on the ocean grid) !----------------------------------------------------------------------- + use NUOPC_Mediator, only : NUOPC_MediatorGet use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_TimeInterval use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_Time, ESMF_TimeGet + use ESMF , only : ESMF_ClockIsCreated, ESMF_ClockGetNextTime use ESMF , only : ESMF_VM, ESMF_VMGet use ESMF , only : ESMF_LogWrite, ESMF_LogFoundError use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_INFO @@ -211,11 +208,11 @@ subroutine med_phases_ocnalb_run(gcomp, rc) use ESMF , only : operator(+) use NUOPC , only : NUOPC_CompAttributeGet use med_constants_mod , only : shr_const_pi + use med_phases_history_mod, only : med_phases_history_write_med ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc -#ifdef CESMCOUPLED ! local variables type(ocnalb_type), save :: ocnalb type(ESMF_VM) :: vm @@ -224,7 +221,9 @@ subroutine med_phases_ocnalb_run(gcomp, rc) logical :: update_alb type(InternalState) :: is_local type(ESMF_Clock) :: clock + type(ESMF_Clock) :: dclock type(ESMF_Time) :: currTime + type(ESMF_Time) :: nextTime type(ESMF_TimeInterval) :: timeStep character(CL) :: cvalue character(CS) :: starttype ! config start type @@ -251,16 +250,11 @@ subroutine med_phases_ocnalb_run(gcomp, rc) real(R8), parameter :: const_deg2rad = shr_const_pi/180.0_R8 ! deg to rads character(CL) :: msg logical :: first_call = .true. + logical :: isPresent, isSet character(len=*) , parameter :: subname='(med_phases_ocnalb_run)' !--------------------------------------- -#endif - rc = ESMF_SUCCESS - -#ifndef CESMCOUPLED - RETURN ! the following code is not executed unless the model is CESM - -#else + rc = ESMF_SUCCESS ! Determine main task call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) @@ -273,10 +267,17 @@ subroutine med_phases_ocnalb_run(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! TODO: ? maybe somewhere else. Also need place to set ufs limit on albedo calc + !call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (isPresent .and. isSet) use_nextswcday = .true. + ! Determine if ocnalb data type will be initialized - and if not return if (first_call) then - if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. & - ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then + !TODO: works? + if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .or. & + ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc) .or. & + ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then ocnalb%created = .true. else ocnalb%created = .false. @@ -331,6 +332,30 @@ subroutine med_phases_ocnalb_run(gcomp, rc) call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) if (chkerr(rc,__LINE__,u_FILE_u)) return else + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + call State_GetScalar(& + state=is_local%wrap%NstateImp(compatm), & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + flds_scalar_num=is_local%wrap%flds_scalar_num, & + scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday, & + scalar_value=nextsw_cday, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + + first_call = .false. + + else + !TODO: ?set logical if nextsw is being done cesm way instead of attr get each time + ! Note that med_methods_State_GetScalar includes a broadcast to all other pets + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then call State_GetScalar(& state=is_local%wrap%NstateImp(compatm), & flds_scalar_name=is_local%wrap%flds_scalar_name, & @@ -338,21 +363,17 @@ subroutine med_phases_ocnalb_run(gcomp, rc) scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday, & scalar_value=nextsw_cday, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + else + ! TODO: Clock is advanced at end of run phase; use nextTime + call ESMF_ClockGetNextTime(clock, nextTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !call ESMF_ClockGet( clock, currTime=currTime, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !call ESMF_TimeGet(currTime, dayOfYear_r8=nextsw_cday, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - - first_call = .false. - - else - - ! Note that med_methods_State_GetScalar includes a broadcast to all other pets - call State_GetScalar(& - state=is_local%wrap%NstateImp(compatm), & - flds_scalar_name=is_local%wrap%flds_scalar_name, & - flds_scalar_num=is_local%wrap%flds_scalar_num, & - scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday, & - scalar_value=nextsw_cday, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if call NUOPC_CompAttributeGet(gcomp, name='flux_albav', value=cvalue, rc=rc) @@ -393,6 +414,8 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ocnalb%anidr(n) = (.026_r8/(cosz**1.7_r8 + 0.065_r8)) + & (.150_r8*(cosz - 0.100_r8 ) * & (cosz - 0.500_r8 ) * (cosz - 1.000_r8 ) ) + !TODO: make config---why does fv3atm use albdif here and not albdir ? + ocnalb%anidr(n) = max (ocnalb%anidr(n), albdif) ocnalb%avsdr(n) = ocnalb%anidr(n) ocnalb%anidf(n) = albdif ocnalb%avsdf(n) = albdif @@ -430,18 +453,29 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ofrad(:) = ofrac(:) endif + ! Write mediator ocnalb history if aofluxes are not active + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then + if ( .not. ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. & + .not. ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_ClockIsCreated(dclock)) then + call med_phases_history_write_med(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + end if + if (dbug_flag > 1) then call FB_diagnose(is_local%wrap%FBMed_ocnalb_o, string=trim(subname)//' FBMed_ocnalb_o', rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if call t_stopf('MED:'//subname) -#endif - end subroutine med_phases_ocnalb_run !=============================================================================== -#ifdef CESMCOUPLED + subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, maintask, rc) !---------------------------------------------------------- @@ -601,7 +635,6 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, maintask, eccen, ob endif end subroutine med_phases_ocnalb_orbital_update -#endif !=============================================================================== diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 604d0ccea..fcfae20fe 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -217,10 +217,12 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) end if ! custom merges to ocean - if (trim(coupling_mode) == 'cesm') then - call med_phases_prep_ocn_custom_cesm(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode(1:5)) == 'nems_') then + ! TODO: fix this + !if (trim(coupling_mode) == 'cesm') then + call med_phases_prep_ocn_custom_cesm(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !else if (trim(coupling_mode(1:5)) == 'nems_') then + if (trim(coupling_mode(1:5)) == 'nems_') then call med_phases_prep_ocn_custom_nems(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -388,9 +390,10 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Check that the necessary export field is present - if ( .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then - return - end if + ! TODO: fix this + !if ( .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then + ! return + !end if call t_startf('MED:'//subname) @@ -479,8 +482,6 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrad' , ofracr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen', Fioi_swpen, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return if (FB_fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdr', rc=rc)) then import_swpen_by_bands = .true. call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_vdr', Fioi_swpen_vdr, rc=rc) @@ -493,6 +494,8 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else import_swpen_by_bands = .false. + call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen', Fioi_swpen, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr',rc=rc)) then @@ -525,8 +528,10 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) ifracr_scaled = ifracr(n) / (frac_sum) ofracr_scaled = ofracr(n) / (frac_sum) endif - Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) - + !TODO: fix this + if (.not.import_swpen_by_bands) then + Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) + end if if (export_swnet_afracr) then Foxx_swnet_afracr(n) = ofracr_scaled*(fswabsv + fswabsi) end if @@ -688,25 +693,25 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_tauy', wgtB=customwgt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - - ! netsw_for_ocn = [downsw_from_atm*(1-ice_fraction)*(1-ocn_albedo)] + [pensw_from_ice*(ice_fraction)] - customwgt(:) = ofrac(:) * (1.0_R8 - 0.06_R8) - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdr' , wgtA=customwgt, & - FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdr', wgtB=ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdf' , wgtA=customwgt, & - FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdf', wgtB=ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndr' , wgtA=customwgt, & - FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idr', wgtB=ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndf' , wgtA=customwgt, & - FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idf', wgtB=ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! TODO: fix this + ! ! netsw_for_ocn = [downsw_from_atm*(1-ice_fraction)*(1-ocn_albedo)] + [pensw_from_ice*(ice_fraction)] + ! customwgt(:) = ofrac(:) * (1.0_R8 - 0.06_R8) + ! call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', & + ! FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdr' , wgtA=customwgt, & + ! FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdr', wgtB=ifrac, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', & + ! FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdf' , wgtA=customwgt, & + ! FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdf', wgtB=ifrac, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', & + ! FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndr' , wgtA=customwgt, & + ! FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idr', wgtB=ifrac, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', & + ! FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndf' , wgtA=customwgt, & + ! FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idf', wgtB=ifrac, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(customwgt) From f174edd579a62ec8278e0f70577d35faa155df91 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 24 May 2023 08:28:30 -0600 Subject: [PATCH 354/395] fix src path for cdeps --- .github/workflows/extbuild.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index f968d0371..581c27324 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -80,7 +80,7 @@ jobs: uses: actions/checkout@v3 with: repository: ESCOMP/CDEPS - path: cdeps-src + path: ${GITHUB_WORKSPACE}/cdeps-src ref: ${{ env.CDEPS_VERSION }} - name: Build CDEPS if: steps.cache-cdeps.outputs.cache-hit != 'true' @@ -88,7 +88,7 @@ jobs: with: esmfmkfile: $HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk pio_path: $HOME/pio - src_root: $HOME/cdeps-src + src_root: ${GITHUB_WORKSPACE}/cdeps-src cmake_flags: " -Wno-dev -DCMAKE_BUILD_TYPE=DEBUG -DWERROR=ON -DCMAKE_Fortran_FLAGS=\"-DCPRGNU -g -Wall \ -ffree-form -ffree-line-length-none -fallow-argument-mismatch \"" From 9817b91c5ccf3c91891aefad891ab910a5c45ba3 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 24 May 2023 09:44:00 -0600 Subject: [PATCH 355/395] cdeps path again --- .github/workflows/extbuild.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 581c27324..2581a546d 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -80,7 +80,7 @@ jobs: uses: actions/checkout@v3 with: repository: ESCOMP/CDEPS - path: ${GITHUB_WORKSPACE}/cdeps-src + path: $HOME/cdeps-src ref: ${{ env.CDEPS_VERSION }} - name: Build CDEPS if: steps.cache-cdeps.outputs.cache-hit != 'true' @@ -88,7 +88,7 @@ jobs: with: esmfmkfile: $HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk pio_path: $HOME/pio - src_root: ${GITHUB_WORKSPACE}/cdeps-src + src_root: $HOME/cdeps-src cmake_flags: " -Wno-dev -DCMAKE_BUILD_TYPE=DEBUG -DWERROR=ON -DCMAKE_Fortran_FLAGS=\"-DCPRGNU -g -Wall \ -ffree-form -ffree-line-length-none -fallow-argument-mismatch \"" From 371d7522c8f3eabad6027d85084808d978ad7acf Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 24 May 2023 09:49:50 -0600 Subject: [PATCH 356/395] cdeps path again --- .github/workflows/extbuild.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 2581a546d..a3b119392 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -80,7 +80,7 @@ jobs: uses: actions/checkout@v3 with: repository: ESCOMP/CDEPS - path: $HOME/cdeps-src + path: cdeps-src ref: ${{ env.CDEPS_VERSION }} - name: Build CDEPS if: steps.cache-cdeps.outputs.cache-hit != 'true' @@ -88,7 +88,7 @@ jobs: with: esmfmkfile: $HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk pio_path: $HOME/pio - src_root: $HOME/cdeps-src + src_root: ${GITHUB_WORKSPACE}/cdeps-src cmake_flags: " -Wno-dev -DCMAKE_BUILD_TYPE=DEBUG -DWERROR=ON -DCMAKE_Fortran_FLAGS=\"-DCPRGNU -g -Wall \ -ffree-form -ffree-line-length-none -fallow-argument-mismatch \"" From 8f59dbaa6bb113141d26c81d23538d8f4779bfae Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 24 May 2023 10:04:39 -0600 Subject: [PATCH 357/395] try building ext with cdeps share --- .github/workflows/extbuild.yml | 2 +- mediator/med_methods_mod.F90 | 28 ---------------------------- 2 files changed, 1 insertion(+), 29 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index a3b119392..6e26b40a5 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -98,7 +98,7 @@ jobs: export PIO=$HOME/pio mkdir build-cmeps pushd build-cmeps - cmake -DCMAKE_BUILD_TYPE=DEBUG -DCMAKE_Fortran_FLAGS="-g -Wall -Werror -ffree-form -ffree-line-length-none -Wno-unused-dummy-argument" ../ + cmake -DCMAKE_BUILD_TYPE=DEBUG -DCMAKE_Fortran_FLAGS="-g -Wall -Werror -ffree-form -ffree-line-length-none -Wno-unused-dummy-argument -I /home/runner/work/CMEPS/CMEPS/build-cdeps/share" ../ make VERBOSE=1 popd diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 40e10bc72..54fe20ec1 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2530,10 +2530,6 @@ subroutine med_methods_FB_check_for_nans(FB, maintask, logunit, rc) ! ---------------------------------------------- rc = ESMF_SUCCESS -#ifndef CESMCOUPLED - ! For now only CESM uses shr_infnan_isnan - so until other models provide this - mediator_checkfornans = .false. -#endif if(.not. mediator_checkfornans) return call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) @@ -2572,8 +2568,6 @@ subroutine med_methods_FB_check_for_nans(FB, maintask, logunit, rc) end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- -#ifdef CESMCOUPLED - subroutine med_methods_check_for_nans_1d(dataptr, nancount) use shr_infnan_mod, only: shr_infnan_isnan ! input/output variables @@ -2608,26 +2602,4 @@ subroutine med_methods_check_for_nans_2d(dataptr, nancount) end do end subroutine med_methods_check_for_nans_2d -#else - - ! For now only CESM uses shr_infnan_isnan - so until other models provide this - ! nancount will just be set to zero - - subroutine med_methods_check_for_nans_1d(dataptr, nancount) - ! input/output variables - real(r8) , intent(in) :: dataptr(:) - integer , intent(out) :: nancount - - nancount = 0 - end subroutine med_methods_check_for_nans_1d - - subroutine med_methods_check_for_nans_2d(dataptr, nancount) - ! input/output variables - real(r8) , intent(in) :: dataptr(:,:) - integer , intent(out) :: nancount - - nancount = 0 - end subroutine med_methods_check_for_nans_2d -#endif - end module med_methods_mod From a7a6dcbf0ee1c500d197c7b9377e09e306cfedcf Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 26 May 2023 09:57:11 -0600 Subject: [PATCH 358/395] testing indicates we are not yet ready for xgrid --- cime_config/namelist_definition_drv.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index d9001cfb7..dec6868f1 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -938,7 +938,7 @@ default: ogrid - xgrid + ogrid From d75d75ea4d0b52296d9b6ee527e3bf687158c761 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Fri, 26 May 2023 13:39:48 -0400 Subject: [PATCH 359/395] remove file accidentally committed --- mediator/runseq.cesm | 53 -------------------------------------------- 1 file changed, 53 deletions(-) delete mode 100644 mediator/runseq.cesm diff --git a/mediator/runseq.cesm b/mediator/runseq.cesm deleted file mode 100644 index 3d1e09b6b..000000000 --- a/mediator/runseq.cesm +++ /dev/null @@ -1,53 +0,0 @@ -runSeq:: -@86400 -@10800 -@3600 -@1800 - MED med_phases_aofluxes_run - MED med_phases_prep_ocn_accum - MED med_phases_ocnalb_run - MED med_phases_diag_ocn -@@3600 - MED med_phases_prep_ocn_avg - MED -> OCN :remapMethod=redist -@@ - MED med_phases_prep_lnd - MED -> LND :remapMethod=redist - MED med_phases_prep_ice - MED -> ICE :remapMethod=redist - ICE - LND - LND -> MED :remapMethod=redist - MED med_phases_post_lnd - MED med_phases_diag_lnd - MED med_phases_diag_rof - MED med_phases_diag_ice_ice2med - MED med_phases_diag_glc - ICE -> MED :remapMethod=redist - MED med_phases_post_ice - MED med_phases_prep_atm - MED -> ATM :remapMethod=redist - ATM - ATM -> MED :remapMethod=redist - MED med_phases_post_atm - MED med_phases_diag_atm - MED med_phases_diag_ice_med2ice - MED med_phases_diag_accum - MED med_phases_diag_print -@ - OCN - OCN -> MED :remapMethod=redist - MED med_phases_post_ocn -@ - MED med_phases_prep_rof - MED -> ROF :remapMethod=redist - ROF - ROF -> MED :remapMethod=redist - MED med_phases_post_rof - MED med_phases_history_write - MED med_phases_restart_write - MED med_phases_profile -@ - GLC -> MED :remapMethod=redist -@ -:: From a4d615e8b563656da11d3afd196a37be05a8710c Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 30 May 2023 22:01:06 +0000 Subject: [PATCH 360/395] add config variables for ufs use case --- mediator/med_phases_ocnalb_mod.F90 | 92 ++++++++++++++++++------------ 1 file changed, 56 insertions(+), 36 deletions(-) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 2d2da421c..47bbef6d5 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -57,6 +57,10 @@ module med_phases_ocnalb_mod character(len=*) , parameter :: orb_variable_year = 'variable_year' character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' + ! used, reused in module + logical :: use_min_albedo ! apply minimum value of albedo for direct vis, nir + logical :: use_nextswcday ! use the scalar field for next time (otherwise, will be set using clock) + !=============================================================================== contains !=============================================================================== @@ -69,11 +73,12 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) ! All input field bundles are ASSUMED to be on the ocean grid !----------------------------------------------------------------------- - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_Mesh, ESMF_MeshGet - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet - use ESMF , only : ESMF_FieldBundleGet, ESMF_Field, ESMF_FieldGet - use ESMF , only : operator(==) + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_Mesh, ESMF_MeshGet + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : ESMF_FieldBundleGet, ESMF_Field, ESMF_FieldGet + use NUOPC , only : NUOPC_CompAttributeGet + use ESMF , only : operator(==) ! Arguments type(ESMF_GridComp) :: gcomp @@ -92,6 +97,8 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) type(InternalState) :: is_local real(R8), pointer :: ownedElemCoords(:) character(len=CL) :: tempc1,tempc2 + character(len=CS) :: cvalue + logical :: isPresent, isSet integer :: fieldCount type(ESMF_Field), pointer :: fieldlist(:) character(*), parameter :: subname = '(med_phases_ocnalb_init) ' @@ -181,6 +188,21 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) call med_phases_ocnalb_orbital_init(gcomp, logunit, iam==0, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Determine if direct albedos should have a minimum value + use_min_albedo = .false. + call NUOPC_CompAttributeGet(gcomp, name="limit_ocean_albedo", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + use_min_albedo=(trim(cvalue)=="true") + endif + ! Allow setting of albedo timestep using the clock instead of the atm's next timestep + use_nextswcday = .true. + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", isPresent=isPresent, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (.not. isPresent ) then + use_nextswcday = .false. + endif + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif @@ -251,11 +273,17 @@ subroutine med_phases_ocnalb_run(gcomp, rc) character(CL) :: msg logical :: first_call = .true. logical :: isPresent, isSet + character(len=CL) :: logmsg character(len=*) , parameter :: subname='(med_phases_ocnalb_run)' !--------------------------------------- rc = ESMF_SUCCESS + write(logmsg,'(A,l)') trim(subname)//': use_min_albedo setting is ',use_min_albedo + call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) + write(logmsg,'(A,l)') trim(subname)//': use_nextswcday setting is ',use_nextswcday + call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) + ! Determine main task call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -267,16 +295,10 @@ subroutine med_phases_ocnalb_run(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! TODO: ? maybe somewhere else. Also need place to set ufs limit on albedo calc - !call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !if (isPresent .and. isSet) use_nextswcday = .true. - ! Determine if ocnalb data type will be initialized - and if not return if (first_call) then - !TODO: works? - if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .or. & - ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc) .or. & + if ((ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. & + ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) .or. & ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then ocnalb%created = .true. else @@ -332,9 +354,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) if (chkerr(rc,__LINE__,u_FILE_u)) return else - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then + if (use_nextswcday) then call State_GetScalar(& state=is_local%wrap%NstateImp(compatm), & flds_scalar_name=is_local%wrap%flds_scalar_name, & @@ -351,11 +371,8 @@ subroutine med_phases_ocnalb_run(gcomp, rc) first_call = .false. else - !TODO: ?set logical if nextsw is being done cesm way instead of attr get each time ! Note that med_methods_State_GetScalar includes a broadcast to all other pets - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then + if (use_nextswcday) then call State_GetScalar(& state=is_local%wrap%NstateImp(compatm), & flds_scalar_name=is_local%wrap%flds_scalar_name, & @@ -365,17 +382,19 @@ subroutine med_phases_ocnalb_run(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else ! TODO: Clock is advanced at end of run phase; use nextTime - call ESMF_ClockGetNextTime(clock, nextTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - !call ESMF_ClockGet( clock, currTime=currTime, rc=rc) + !call ESMF_ClockGetNextTime(clock, nextTime, rc=rc) !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !call ESMF_TimeGet(currTime, dayOfYear_r8=nextsw_cday, rc=rc) + !call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday, rc=rc) !if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! TODO: albedos are used only for ocean sw net calculation at this Advance, use currTime + call ESMF_ClockGet( clock, currTime=currTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(currTime, dayOfYear_r8=nextsw_cday, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end if + !TODO: is there a reason to get this each time instead of at init? call NUOPC_CompAttributeGet(gcomp, name='flux_albav', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flux_albav @@ -414,8 +433,10 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ocnalb%anidr(n) = (.026_r8/(cosz**1.7_r8 + 0.065_r8)) + & (.150_r8*(cosz - 0.100_r8 ) * & (cosz - 0.500_r8 ) * (cosz - 1.000_r8 ) ) - !TODO: make config---why does fv3atm use albdif here and not albdir ? - ocnalb%anidr(n) = max (ocnalb%anidr(n), albdif) + if (use_min_albedo) then + !TODO: why does fv3atm use albdif here and not albdir ? + ocnalb%anidr(n) = max (ocnalb%anidr(n), albdif) + end if ocnalb%avsdr(n) = ocnalb%anidr(n) ocnalb%anidf(n) = albdif ocnalb%avsdf(n) = albdif @@ -454,15 +475,14 @@ subroutine med_phases_ocnalb_run(gcomp, rc) endif ! Write mediator ocnalb history if aofluxes are not active - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then - if ( .not. ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. & - .not. ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then - call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc) .and. & + .not. ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. & + .not. ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_ClockIsCreated(dclock)) then + call med_phases_history_write_med(gcomp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (ESMF_ClockIsCreated(dclock)) then - call med_phases_history_write_med(gcomp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if end if end if From b6fd22cf2abc9240708f9a7be26fc88b35c65925 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 12 Jun 2023 15:47:02 -0400 Subject: [PATCH 361/395] add configuration options for albedo calcs * flux_albav moved to _init * use_nextswcday for using clock instead of scalar field * min_albedo for setting min albedo used max(min_albedo,....) * giving a min_albedo value sets logical use_min_albedo, otherwise false and min_albedo=0 * set mean albdif and albdir via config. If not present, defaults to current values --- mediator/med_phases_ocnalb_mod.F90 | 86 ++++++++++++++++++---------- mediator/med_phases_prep_ocn_mod.F90 | 34 ++--------- 2 files changed, 63 insertions(+), 57 deletions(-) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 47bbef6d5..cd242bb7e 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -6,7 +6,7 @@ module med_phases_ocnalb_mod use med_utils_mod , only : chkerr => med_utils_chkerr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : State_GetScalar => med_methods_State_GetScalar - use med_internalstate_mod , only : mapconsf, mapnames, compatm, compocn + use med_internalstate_mod , only : mapconsf, mapnames, compatm, compocn, maintask use perf_mod , only : t_startf, t_stopf use shr_orb_mod , only : shr_orb_cosz, shr_orb_decl use shr_orb_mod , only : shr_orb_params, SHR_ORB_UNDEF_INT, SHR_ORB_UNDEF_REAL @@ -58,9 +58,12 @@ module med_phases_ocnalb_mod character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' ! used, reused in module - logical :: use_min_albedo ! apply minimum value of albedo for direct vis, nir - logical :: use_nextswcday ! use the scalar field for next time (otherwise, will be set using clock) - + logical :: flux_albav ! use average dif and dir albedos + logical :: use_nextswcday ! use the scalar field for next time (otherwise, will be set using clock) + logical :: use_min_albedo ! apply minimum value of albedo for direct vis, nir + real(R8) :: min_albedo ! minimum value of albedo for direct vis, nir + real(R8) :: albdif ! 60 deg reference albedo, diffuse + real(R8) :: albdir ! 60 deg reference albedo, direct !=============================================================================== contains !=============================================================================== @@ -98,8 +101,10 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) real(R8), pointer :: ownedElemCoords(:) character(len=CL) :: tempc1,tempc2 character(len=CS) :: cvalue + logical :: use_min_ocnalb logical :: isPresent, isSet integer :: fieldCount + character(CL) :: msg type(ESMF_Field), pointer :: fieldlist(:) character(*), parameter :: subname = '(med_phases_ocnalb_init) ' !----------------------------------------------------------------------- @@ -188,12 +193,37 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) call med_phases_ocnalb_orbital_init(gcomp, logunit, iam==0, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Determine if direct albedos should have a minimum value - use_min_albedo = .false. - call NUOPC_CompAttributeGet(gcomp, name="limit_ocean_albedo", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + ! Determine if reference albedos are used + flux_albav = .false. + call NUOPC_CompAttributeGet(gcomp, name='flux_albav', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flux_albav + end if + ! Set reference albedo values + call NUOPC_CompAttributeGet(gcomp, name="albdif", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then - use_min_albedo=(trim(cvalue)=="true") + read(cvalue,*) albdif + else + albdif = 0.06_r8 + end if + call NUOPC_CompAttributeGet(gcomp, name="albdir", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) albdir + else + albdir = 0.07_r8 + end if + ! Determine if direct albedo should have a minimum value + call NUOPC_CompAttributeGet(gcomp, name="ocean_albedo_limit", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) min_albedo + use_min_albedo = .true. + else + min_albedo = 0.0_R8 + use_min_ocnalb = .false. endif ! Allow setting of albedo timestep using the clock instead of the atm's next timestep use_nextswcday = .true. @@ -203,6 +233,18 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) use_nextswcday = .false. endif + if (flux_albav) then + write(msg,'(2(A,f8.2))') trim(subname)//': mean albedos set: albdif = ',albdif,', albdir = ',albdir + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + else + if (use_min_albedo) then + write(msg,'(A,f8.2)') trim(subname)//': min_albedo setting = ',min_albedo + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + end if + end if + write(msg,'(A,l)') trim(subname)//': use_nextswcday setting is ',use_nextswcday + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif @@ -250,7 +292,6 @@ subroutine med_phases_ocnalb_run(gcomp, rc) character(CL) :: cvalue character(CS) :: starttype ! config start type character(CL) :: runtype ! initial, continue, hybrid, branch - logical :: flux_albav ! flux avg option real(R8) :: nextsw_cday ! calendar day of next atm shortwave real(R8), pointer :: ofrac(:) real(R8), pointer :: ofrad(:) @@ -267,23 +308,14 @@ subroutine med_phases_ocnalb_run(gcomp, rc) real(R8) :: obliqr ! Earth orbit real(R8) :: delta ! Solar declination angle in radians real(R8) :: eccf ! Earth orbit eccentricity factor - real(R8), parameter :: albdif = 0.06_r8 ! 60 deg reference albedo, diffuse - real(R8), parameter :: albdir = 0.07_r8 ! 60 deg reference albedo, direct real(R8), parameter :: const_deg2rad = shr_const_pi/180.0_R8 ! deg to rads character(CL) :: msg logical :: first_call = .true. - logical :: isPresent, isSet - character(len=CL) :: logmsg character(len=*) , parameter :: subname='(med_phases_ocnalb_run)' !--------------------------------------- rc = ESMF_SUCCESS - write(logmsg,'(A,l)') trim(subname)//': use_min_albedo setting is ',use_min_albedo - call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) - write(logmsg,'(A,l)') trim(subname)//': use_nextswcday setting is ',use_nextswcday - call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) - ! Determine main task call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -354,6 +386,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) if (chkerr(rc,__LINE__,u_FILE_u)) return else + ! obtain nextsw_cday from atm if it is in the import state if (use_nextswcday) then call State_GetScalar(& state=is_local%wrap%NstateImp(compatm), & @@ -382,22 +415,17 @@ subroutine med_phases_ocnalb_run(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else ! TODO: Clock is advanced at end of run phase; use nextTime - !call ESMF_ClockGetNextTime(clock, nextTime, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! TODO: albedos are used only for ocean sw net calculation at this Advance, use currTime - call ESMF_ClockGet( clock, currTime=currTime, rc=rc) + call ESMF_ClockGetNextTime(clock, nextTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(currTime, dayOfYear_r8=nextsw_cday, rc=rc) + call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end if !TODO: is there a reason to get this each time instead of at init? - call NUOPC_CompAttributeGet(gcomp, name='flux_albav', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flux_albav + !call NUOPC_CompAttributeGet(gcomp, name='flux_albav', value=cvalue, rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return + !read(cvalue,*) flux_albav ! Get orbital values call med_phases_ocnalb_orbital_update(clock, logunit, iam==0, eccen, obliqr, lambm0, mvelpp, rc) @@ -435,7 +463,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) (cosz - 0.500_r8 ) * (cosz - 1.000_r8 ) ) if (use_min_albedo) then !TODO: why does fv3atm use albdif here and not albdir ? - ocnalb%anidr(n) = max (ocnalb%anidr(n), albdif) + ocnalb%anidr(n) = max (ocnalb%anidr(n), min_albedo) end if ocnalb%avsdr(n) = ocnalb%anidr(n) ocnalb%anidf(n) = albdif diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 2c63751ae..bc87fdeb8 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -31,7 +31,7 @@ module med_phases_prep_ocn_mod public :: med_phases_prep_ocn_accum ! called from run sequence public :: med_phases_prep_ocn_avg ! called from run sequence - private :: med_phases_prep_ocn_custom_cesm + private :: med_phases_prep_ocn_custom private :: med_phases_prep_ocn_custom_nems character(*), parameter :: u_FILE_u = & @@ -217,11 +217,8 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) end if ! custom merges to ocean - ! TODO: fix this - !if (trim(coupling_mode) == 'cesm') then - call med_phases_prep_ocn_custom_cesm(gcomp, rc) + call med_phases_prep_ocn_custom(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !else if (trim(coupling_mode(1:5)) == 'nems_') then if (trim(coupling_mode(1:5)) == 'nems_') then call med_phases_prep_ocn_custom_nems(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -317,7 +314,7 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) end subroutine med_phases_prep_ocn_avg !----------------------------------------------------------------------------- - subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) + subroutine med_phases_prep_ocn_custom(gcomp, rc) !--------------------------------------- ! custom calculations for cesm @@ -374,7 +371,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) integer :: lsize real(R8) :: c1,c2,c3,c4 character(len=64), allocatable :: fldnames(:) - character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_cesm)' + character(len=*), parameter :: subname='(med_phases_prep_ocn_custom)' !--------------------------------------- rc = ESMF_SUCCESS @@ -531,7 +528,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) ifracr_scaled = ifracr(n) / (frac_sum) ofracr_scaled = ofracr(n) / (frac_sum) endif - !TODO: fix this + !TODO: ? fix this if (.not.import_swpen_by_bands) then Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) end if @@ -624,7 +621,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) end if call t_stopf('MED:'//subname) - end subroutine med_phases_prep_ocn_custom_cesm + end subroutine med_phases_prep_ocn_custom !----------------------------------------------------------------------------- subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) @@ -696,25 +693,6 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_tauy', wgtB=customwgt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! TODO: fix this - ! ! netsw_for_ocn = [downsw_from_atm*(1-ice_fraction)*(1-ocn_albedo)] + [pensw_from_ice*(ice_fraction)] - ! customwgt(:) = ofrac(:) * (1.0_R8 - 0.06_R8) - ! call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', & - ! FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdr' , wgtA=customwgt, & - ! FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdr', wgtB=ifrac, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', & - ! FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdf' , wgtA=customwgt, & - ! FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdf', wgtB=ifrac, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', & - ! FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndr' , wgtA=customwgt, & - ! FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idr', wgtB=ifrac, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', & - ! FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndf' , wgtA=customwgt, & - ! FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idf', wgtB=ifrac, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(customwgt) From 5f27114bdd2808c281c7b884fa084977a098d81b Mon Sep 17 00:00:00 2001 From: James Edwards Date: Fri, 23 Jun 2023 15:27:58 -0600 Subject: [PATCH 362/395] both =0 is not an error --- mediator/med_methods_mod.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 54fe20ec1..649c9c511 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -1354,7 +1354,10 @@ subroutine med_methods_FB_accum(FBout, FBin, copy, rc) call med_methods_Field_GetFldPtr(lfield, fldptr1=dataptro1, fldptr2=dataptro2, rank=lranko, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (lranki == 1 .and. lranko == 1) then + if (lranki == 0 .and. lranko == 0) then + ! do nothing + call ESMF_LogWrite(trim(subname)//": Both ranki and ranko are 0", ESMF_LOGMSG_INFO) + elseif (lranki == 1 .and. lranko == 1) then if (.not.med_methods_FieldPtr_Compare(dataPtro1, dataPtri1, subname, rc)) then call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr1 size ", ESMF_LOGMSG_ERROR) @@ -1397,7 +1400,7 @@ subroutine med_methods_FB_accum(FBout, FBin, copy, rc) else write(msgString,'(a,2i8)') trim(subname)//": ranki, ranko = ",lranki,lranko - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_ERROR) call ESMF_LogWrite(trim(subname)//": ERROR ranki ranko not supported "//trim(lfieldnamelist(n)), & ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE From 6ef50f318bf0cbb559ebecc6f26731f02a58057e Mon Sep 17 00:00:00 2001 From: James Edwards Date: Mon, 24 Jul 2023 14:27:13 -0600 Subject: [PATCH 363/395] add surface flux rollover --- cesm/flux_atmocn/shr_flux_mod.F90 | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index 9ec558737..741447d93 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -259,7 +259,17 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) - cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps + + ! Large and Yeager 2009 + cdn(Umps) = 0.0027_R8 / min(33.0000_R8,Umps) + 0.000142_R8 + & + 0.0000764_R8 * min(33.0000_R8,Umps) - 3.14807e-13_r8 * min(33.0000_R8,Umps)**6 + ! Capped Large and Pond by wind + ! cdn(Umps) = 0.0027_R8 / min(30.0_R8,Umps) + 0.000142_R8 + 0.0000764_R8 * min(30.0_R8,Umps) + ! Capped Large and Pond by Cd + ! cdn(Umps) = min(0.0025_R8, (0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps )) + ! Large and Pond + ! cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps + psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) From 7b7d232bb7cd28a0cef8ed57c252c5d02e0b7f44 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 27 Jul 2023 10:21:28 -0400 Subject: [PATCH 364/395] remove TODOs --- mediator/med_phases_ocnalb_mod.F90 | 7 ------- 1 file changed, 7 deletions(-) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index cd242bb7e..636ce16e6 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -414,7 +414,6 @@ subroutine med_phases_ocnalb_run(gcomp, rc) scalar_value=nextsw_cday, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else - ! TODO: Clock is advanced at end of run phase; use nextTime call ESMF_ClockGetNextTime(clock, nextTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday, rc=rc) @@ -422,11 +421,6 @@ subroutine med_phases_ocnalb_run(gcomp, rc) end if end if - !TODO: is there a reason to get this each time instead of at init? - !call NUOPC_CompAttributeGet(gcomp, name='flux_albav', value=cvalue, rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return - !read(cvalue,*) flux_albav - ! Get orbital values call med_phases_ocnalb_orbital_update(clock, logunit, iam==0, eccen, obliqr, lambm0, mvelpp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -462,7 +456,6 @@ subroutine med_phases_ocnalb_run(gcomp, rc) (.150_r8*(cosz - 0.100_r8 ) * & (cosz - 0.500_r8 ) * (cosz - 1.000_r8 ) ) if (use_min_albedo) then - !TODO: why does fv3atm use albdif here and not albdir ? ocnalb%anidr(n) = max (ocnalb%anidr(n), min_albedo) end if ocnalb%avsdr(n) = ocnalb%anidr(n) From 4e09c3a8af0bf6af4fd69997b4f2ad16ed61a253 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 27 Jul 2023 11:39:06 -0400 Subject: [PATCH 365/395] use log_error, not log_info --- mediator/med_io_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 82e0b04d0..49c1f3d37 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -75,7 +75,7 @@ module med_io_mod character(*),parameter :: prefix = "med_io_" character(*),parameter :: modName = "(med_io_mod) " character(*),parameter :: version = "cmeps0" - + integer :: pio_iotype integer :: pio_ioformat type(iosystem_desc_t), pointer :: io_subsystem @@ -1739,7 +1739,7 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) deallocate(minIndexPTile, maxIndexPTile) else if(maintask) write(logunit,*) trim(subname),' ERROR: '//trim(name1)//' is not present, aborting ' - call ESMF_LogWrite(trim(subname)//' ERROR: '//trim(name1)//' is not present, aborting ', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//' ERROR: '//trim(name1)//' is not present, aborting ', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE end if ! end if rcode check From 9bcf425b42a369f31257e50335caec3640db3338 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 27 Jul 2023 13:06:12 -0600 Subject: [PATCH 366/395] remove TODO --- mediator/med_phases_prep_ocn_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index e46763499..8cae24f3e 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -528,7 +528,6 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) ifracr_scaled = ifracr(n) / (frac_sum) ofracr_scaled = ofracr(n) / (frac_sum) endif - !TODO: ? fix this if (.not.import_swpen_by_bands) then Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) end if From 0dbe67ed6f32066d1929f751c1e92dcbc7c2aed5 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Fri, 28 Jul 2023 09:43:13 -0600 Subject: [PATCH 367/395] fix the x case --- mediator/med_internalstate_mod.F90 | 1 - mediator/med_map_mod.F90 | 22 +++++++++++----------- 2 files changed, 11 insertions(+), 12 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index c5497293f..66e2eb1db 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -262,7 +262,6 @@ subroutine med_internalstate_init(gcomp, rc) end do end if is_local%wrap%num_icesheets = num_icesheets - call NUOPC_CompAttributeGet(gcomp, name='mediator_present', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 18752dc2f..9f514a4cb 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -111,7 +111,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun type(ESMF_Mesh) :: mesh_dst type(med_fldlist_type), pointer :: FldListFr type(med_fldlist_entry_type), pointer :: fldptr - character(len=*), parameter :: subname=' (module_med_map: RouteHandles_init) ' + character(len=*), parameter :: subname=' (med_map_mod: RouteHandles_init) ' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -304,7 +304,7 @@ subroutine med_map_routehandles_initfrom_fieldbundle(n1, n2, FBsrc, FBdst, mapin ! local variables type(ESMF_Field) :: fldsrc type(ESMF_Field) :: flddst - character(len=*), parameter :: subname=' (module_MED_map:med_map_routehandles_initfrom_fieldbundle) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_routehandles_initfrom_fieldbundle) ' !--------------------------------------------- rc = ESMF_SUCCESS @@ -653,7 +653,7 @@ logical function med_map_RH_is_created_RH3d(RHs,n1,n2,mapindex,rc) integer , intent(out) :: rc ! local variables - character(len=*), parameter :: subname=' (module_MED_map:med_map_RH_is_created_RH3d) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_RH_is_created_RH3d) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -678,7 +678,7 @@ logical function med_map_RH_is_created_RH1d(RHs,mapindex,rc) ! local variables integer :: rc1, rc2 logical :: mapexists - character(len=*), parameter :: subname=' (module_MED_map:med_map_RH_is_created_RH1d) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_RH_is_created_RH1d) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -718,7 +718,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & use ESMF use esmFlds , only : med_fldList_entry_type, med_fldList_getNumFlds, med_fldList_type use esmFlds , only : med_fld_getFldInfo - use med_internalstate_mod , only : compname, mapnames + use med_internalstate_mod , only : compname, mapnames, rof_name use med_internalstate_mod , only : packed_data_type, nmappers ! input/output variables @@ -750,7 +750,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & character(CL), allocatable :: fieldNameList(:) character(CS) :: mapnorm_mapindex character(len=CX) :: tmpstr - character(len=*), parameter :: subname=' (module_MED_map:med_packed_field_create) ' + character(len=*), parameter :: subname=' (med_map_mod:med_packed_field_create) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -817,7 +817,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & //', mapnorm '//trim(mapnorm_mapindex) & //' '//trim(fieldnamelist(nf)) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - else + else if(rof_name .ne. 'xrof' .and. compname(destcomp) .ne. 'ocn') then if (mapnorm_mapindex /= packed_data(mapindex)%mapnorm) then write(tmpstr,*)'Map type '//trim(mapnames(mapindex)) & //', destcomp '//trim(compname(destcomp)) & @@ -953,7 +953,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d type(ESMF_Field), pointer :: fieldlist_dst(:) real(r8), pointer :: data_norm(:) real(r8), pointer :: data_dst(:,:) - character(len=*), parameter :: subname=' (module_MED_map:med_map_field_packed) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_field_packed) ' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -1165,7 +1165,7 @@ subroutine med_map_field_normalized(field_src, field_dst, routehandles, maptype, integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields integer :: lsize_src integer :: lsize_dst - character(len=*), parameter :: subname=' (module_MED_map:med_map_field_normalized) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_field_normalized) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -1278,7 +1278,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r logical :: checkflag = .false. character(len=CS) :: lfldname real(ESMF_KIND_R8), parameter :: fillValue = 9.99e20_ESMF_KIND_R8 - character(len=*), parameter :: subname='(module_MED_map:med_map_field) ' + character(len=*), parameter :: subname='(med_map_mod:med_map_field) ' !--------------------------------------------------- rc = ESMF_SUCCESS @@ -1381,7 +1381,7 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, rc) integer :: spatialDim real(r8), parameter :: deg2rad = shr_const_pi/180.0_R8 ! deg to rads logical :: first_time = .true. - character(len=*), parameter :: subname=' (module_MED_map:med_map_uv_cart3d) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_uv_cart3d) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS From 427ebebbf93e711abe6a24b7540acbb25f52a3a3 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sat, 29 Jul 2023 09:57:44 -0400 Subject: [PATCH 368/395] add missing return error check for FldsExchange --- mediator/med.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 346a98da9..3efc94a6e 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -661,7 +661,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use esmFlds, only : med_fldlist_init1, med_fld_GetFldInfo, med_fldList_entry_type use med_phases_history_mod, only : med_phases_history_init - use med_methods_mod , only : mediator_checkfornans + use med_methods_mod , only : mediator_checkfornans ! input/output variables type(ESMF_GridComp) :: gcomp @@ -921,7 +921,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if(isPresent .and. isSet) then - read(cvalue, *) mediator_checkfornans + read(cvalue, *) mediator_checkfornans else mediator_checkfornans = .false. endif @@ -1804,7 +1804,8 @@ subroutine DataInitialize(gcomp, rc) call esmFldsExchange_cesm(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode(1:4)) == 'nems') then - call esmFldsExchange_nems(gcomp, phase='initialize', rc=rc) + call esmFldsExchange_nems(gcomp, phase='initialize', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 957a0fb588367f0abc9d6a2c34a1ba4182cfaefe Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 31 Jul 2023 16:35:27 +0000 Subject: [PATCH 369/395] address comments --- mediator/med_io_mod.F90 | 2 +- mediator/med_phases_ocnalb_mod.F90 | 9 ++------- 2 files changed, 3 insertions(+), 8 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 49c1f3d37..265a5ddda 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -1738,7 +1738,7 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) deallocate(minIndexPTile, maxIndexPTile) else - if(maintask) write(logunit,*) trim(subname),' ERROR: '//trim(name1)//' is not present, aborting ' + if(maintask) write(logunit,'(a)') trim(subname)//' ERROR: '//trim(name1)//' is not present, aborting ' call ESMF_LogWrite(trim(subname)//' ERROR: '//trim(name1)//' is not present, aborting ', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE end if ! end if rcode check diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 636ce16e6..31bd211f0 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -329,9 +329,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ! Determine if ocnalb data type will be initialized - and if not return if (first_call) then - if ((ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. & - ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) .or. & - ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then ocnalb%created = .true. else ocnalb%created = .false. @@ -495,10 +493,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ofrad(:) = ofrac(:) endif - ! Write mediator ocnalb history if aofluxes are not active - if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc) .and. & - .not. ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. & - .not. ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ESMF_ClockIsCreated(dclock)) then From 9b2942ac728aad88054f6718d09024c69241fd70 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Mon, 31 Jul 2023 11:47:16 -0600 Subject: [PATCH 370/395] alternate solution for X case --- mediator/esmFldsExchange_cesm_mod.F90 | 4 ++-- mediator/med_map_mod.F90 | 3 ++- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 13811aec9..a2c4fe435 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2158,7 +2158,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! liquid from river and possibly flood from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl' , rc=rc)) then if (trim(rof2ocn_liq_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofl', compocn, mapconsd, 'none', 'unset') + call addmap_from(comprof, 'Forr_rofl', compocn, mapconsd, 'one', 'unset') else call addmap_from(comprof, 'Forr_rofl', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) end if @@ -2182,7 +2182,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! ice from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi' , rc=rc)) then if (trim(rof2ocn_ice_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofi', compocn, mapconsd, 'none', 'unset') + call addmap_from(comprof, 'Forr_rofi', compocn, mapconsd, 'one', 'unset') else call addmap_from(comprof, 'Forr_rofi', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) end if diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 9f514a4cb..82544370d 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -817,7 +817,8 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & //', mapnorm '//trim(mapnorm_mapindex) & //' '//trim(fieldnamelist(nf)) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - else if(rof_name .ne. 'xrof' .and. compname(destcomp) .ne. 'ocn') then + else + !if(rof_name .ne. 'xrof' .and. compname(destcomp) .ne. 'ocn') then if (mapnorm_mapindex /= packed_data(mapindex)%mapnorm) then write(tmpstr,*)'Map type '//trim(mapnames(mapindex)) & //', destcomp '//trim(compname(destcomp)) & From 3d8e23331f18c90b8945013ac45711ac63f741c7 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 1 Aug 2023 09:16:27 -0600 Subject: [PATCH 371/395] update esmf and pio externals used in srt github workflow --- .github/workflows/srt.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 39526be99..e478c355a 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -26,8 +26,8 @@ jobs: CPPFLAGS: "-I/usr/include -I/usr/local/include " LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.4.0 - PARALLELIO_VERSION: pio2_5_10 + ESMF_VERSION: v8.5.0 + PARALLELIO_VERSION: pio2_6_0 CIME_MODEL: cesm CIME_DRIVER: nuopc GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} From 896b6a15158637ee633c6b50ab4e5816b9d5cd00 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 1 Aug 2023 10:16:21 -0600 Subject: [PATCH 372/395] debug workflow --- .github/workflows/srt.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index e478c355a..4eb158870 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -175,6 +175,6 @@ jobs: popd # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details -# - name: Setup tmate session -# if: ${{ failure() }} -# uses: mxschmitt/action-tmate@v3 + - name: Setup tmate session + if: ${{ failure() }} + uses: mxschmitt/action-tmate@v3 From 5945f786aa767d4d897053ce5239b47f28176929 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 1 Aug 2023 11:17:04 -0600 Subject: [PATCH 373/395] try adding SRCROOT env variable --- .github/workflows/srt.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 4eb158870..34252cb63 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -153,6 +153,7 @@ jobs: mkdir -p $HOME/cesm/scratch mkdir -p $HOME/cesm/inputdata pushd $GITHUB_WORKSPACE/cesm/cime/CIME/tests + export SRCROOT=$GITHUB_WORKSPACE/cesm/ export CIME_TEST_PLATFORM=ubuntu-latest export PIO_INCDIR=$HOME/pio/include export PIO_LIBDIR=$HOME/pio/lib From 8282ebc1791fd43c7896d9806cabaa62817bcbe5 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 1 Aug 2023 17:06:07 -0600 Subject: [PATCH 374/395] remove rof_name --- mediator/med_map_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 82544370d..3ab205bd6 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -718,7 +718,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & use ESMF use esmFlds , only : med_fldList_entry_type, med_fldList_getNumFlds, med_fldList_type use esmFlds , only : med_fld_getFldInfo - use med_internalstate_mod , only : compname, mapnames, rof_name + use med_internalstate_mod , only : compname, mapnames use med_internalstate_mod , only : packed_data_type, nmappers ! input/output variables From ec41c2fc333d74691bf7b302e7f53bda0b517367 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 7 Aug 2023 08:07:13 -0400 Subject: [PATCH 375/395] revert changes for swnet in prep_ocn --- mediator/med_phases_prep_ocn_mod.F90 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 8cae24f3e..7a71f7e90 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -482,6 +482,8 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrad' , ofracr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen', Fioi_swpen, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (FB_fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdr', rc=rc)) then import_swpen_by_bands = .true. call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_vdr', Fioi_swpen_vdr, rc=rc) @@ -494,8 +496,6 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else import_swpen_by_bands = .false. - call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen', Fioi_swpen, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr',rc=rc)) then @@ -528,9 +528,8 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) ifracr_scaled = ifracr(n) / (frac_sum) ofracr_scaled = ofracr(n) / (frac_sum) endif - if (.not.import_swpen_by_bands) then - Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) - end if + Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) + if (export_swnet_afracr) then Foxx_swnet_afracr(n) = ofracr_scaled*(fswabsv + fswabsi) end if From 72ee0b2fa13b125e49cfca3db1ec7ee557d30a28 Mon Sep 17 00:00:00 2001 From: Jian Sun Date: Tue, 8 Aug 2023 09:08:18 -0600 Subject: [PATCH 376/395] Add a new XML variable to apply the MPI wrapper script more generically. --- cime_config/config_component.xml | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 0137597af..a329be743 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -802,6 +802,16 @@ If set will compile and submit with this gpu offload method enabled + + char + + + build_def + env_build.xml + If set will attach this script to the MPI run command, mapping + different MPI ranks to different GPUs within the same compute node + + logical TRUE,FALSE From a6071c17480e86b59f993064596da88a14c5d3c9 Mon Sep 17 00:00:00 2001 From: Chris Fischer Date: Mon, 21 Aug 2023 16:03:43 -0600 Subject: [PATCH 377/395] Add length to logic format. --- mediator/med_phases_ocnalb_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 31bd211f0..304d0c7fd 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -242,7 +242,7 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) end if end if - write(msg,'(A,l)') trim(subname)//': use_nextswcday setting is ',use_nextswcday + write(msg,'(A,l1)') trim(subname)//': use_nextswcday setting is ',use_nextswcday call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) if (dbug_flag > 5) then From 65aeefb34ea5d3aefba759c500a67ea6592d3153 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 10 Oct 2023 13:42:12 -0600 Subject: [PATCH 378/395] fix hang on abort issue --- cesm/driver/esmApp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cesm/driver/esmApp.F90 b/cesm/driver/esmApp.F90 index 12cf1537d..5215ea2aa 100644 --- a/cesm/driver/esmApp.F90 +++ b/cesm/driver/esmApp.F90 @@ -139,7 +139,7 @@ program esmApp ! Call Run for the ensemble driver !----------------------------------------------------------------------------- call ESMF_GridCompRun(ensemble_driver_comp, userRc=urc, rc=rc) - if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) From 493a9b9a228dc520cf94d183a14a70048aedb13e Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 12 Oct 2023 16:28:43 -0600 Subject: [PATCH 379/395] support for job_priority on derecho --- cime_config/config_component.xml | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index a329be743..d73964961 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -534,6 +534,15 @@ List of job ids for most recent case.submit + + char + regular + regular,premium,economy + run_begin_stop_restart + env_run.xml + job priority for systems supporting this option + + From 1f0d9e8739b85819ebd5741b6433349548527fa1 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Mon, 23 Oct 2023 14:52:41 -0500 Subject: [PATCH 380/395] remove this unused variable --- cime_config/config_component.xml | 17 ----------------- cime_config/namelist_definition_drv.xml | 18 ------------------ 2 files changed, 35 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index d73964961..d0267b1f9 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -1035,23 +1035,6 @@ this to work. - - char - ESMF_LOGKIND_SINGLE,ESMF_LOGKIND_MULTI,ESMF_LOGKIND_NONE - ESMF_LOGKIND_NONE - run_flags - env_run.xml - - Determines what ESMF log files (if any) are generated when - USE_ESMF_LIB is TRUE. - ESMF_LOGKIND_SINGLE: Use a single log file, combining messages from - all of the PETs. Not supported on some platforms. - ESMF_LOGKIND_MULTI: Use multiple log files -- one per PET. - ESMF_LOGKIND_NONE: Do not issue messages to a log file. - By default, no ESMF log files are generated. - - - char off,low,high,max diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index dec6868f1..5b6d01249 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -18,24 +18,6 @@ - - char - cime_pes - PELAYOUT_attributes - - Determines what ESMF log files (if any) are generated when - USE_ESMF_LIB is TRUE. - ESMF_LOGKIND_SINGLE: Use a single log file, combining messages from - all of the PETs. Not supported on some platforms. - ESMF_LOGKIND_MULTI: Use multiple log files — one per PET. - ESMF_LOGKIND_NONE: Do not issue messages to a log file. - By default, no ESMF log files are generated. - - - $ESMF_LOGFILE_KIND - - - integer pio From e5d08d4233b0c783a4840dcbc3252a170e3c3bb1 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Tue, 31 Oct 2023 15:58:39 -0400 Subject: [PATCH 381/395] change nems to ufs, update coupling modes (#101) * change nems to ufs * update docs --- doc/source/addendum/req_attributes.rst | 8 +- doc/source/esmflds.rst | 38 ++--- doc/source/generic.rst | 2 +- doc/source/introduction.rst | 132 +++++++++--------- doc/source/prep.rst | 19 ++- mediator/CMakeLists.txt | 2 +- mediator/ESMFConvenienceMacros.h | 2 +- mediator/ESMFVersionDefine.h | 3 +- mediator/Makefile | 4 +- ...ms_mod.F90 => esmFldsExchange_ufs_mod.F90} | 18 +-- mediator/med.F90 | 10 +- mediator/med_fraction_mod.F90 | 6 +- mediator/med_internalstate_mod.F90 | 4 +- mediator/med_map_mod.F90 | 4 +- mediator/med_phases_aofluxes_mod.F90 | 12 +- mediator/med_phases_prep_atm_mod.F90 | 3 +- 16 files changed, 132 insertions(+), 135 deletions(-) rename mediator/{esmFldsExchange_nems_mod.F90 => esmFldsExchange_ufs_mod.F90} (98%) diff --git a/doc/source/addendum/req_attributes.rst b/doc/source/addendum/req_attributes.rst index 410303632..ed2130b32 100644 --- a/doc/source/addendum/req_attributes.rst +++ b/doc/source/addendum/req_attributes.rst @@ -6,12 +6,12 @@ The following attributes are obtained from the respective driver and available to all components that the driver uses. In the case of -NEMS, the NEMS driver ingests these attributes from the -``nems.configure`` file. In the case of CESM, the CESM driver ingests +UFS, the UFS driver ingests these attributes from the +``ufs.configure`` file. In the case of CESM, the CESM driver ingests these attributes from the ``nuopc.runconfig`` file. The list of attributes below are separated into application independent attributes and at this time additional attributes required by CESM. There are no -NEMS-specific attributes required by the NEMS application. +UFS-specific attributes required by the UFS application. General @@ -24,7 +24,7 @@ General CMEPS and is also leveraged in some of the custom calculations in the ``prep`` modules. - The currently supported values for ``coupling_mode`` are ``cesm``, ``nems_orig``, ``nems_frac`` and ``hafs``. + The currently supported values for ``coupling_mode`` are ``cesm``, ``ufs.(frac,nfrac).(aoflux)``, and ``hafs``. Scalar attributes ----------------- diff --git a/doc/source/esmflds.rst b/doc/source/esmflds.rst index 960789491..3289ddeb5 100644 --- a/doc/source/esmflds.rst +++ b/doc/source/esmflds.rst @@ -14,8 +14,8 @@ For each supported application, CMEPS contains two specific files that determine Three application specific versions are currently contained within CMEPS: * for CESM: **esmFldsExchange_cesm_mod.F90** and **fd_cesm.yaml** -* for UFS-S2S: **esmFldsExchange_nems_mod.F90** and **fd_nems.yaml** -* for UFS-HAFS: **esmFldsExchange_hafs_mod.F90** and **fd_hafs.yaml** +* for UFS-S2S: **esmFldsExchange_ufs_mod.F90** and **fd_ufs.yaml** +* for UFS-HAFS: **esmFldsExchange_hafs_mod.F90** and **fd_ufs.yaml** CMEPS advertises **all possible fields** that can be imported to and exported by the mediator for the target coupled system. Not all of @@ -23,10 +23,10 @@ these fields will be connected to the various components. The connections will be determined by what the components advertise in their respective advertise phase. -Across applications, component-specific names for the same fields may vary. The field +Across applications, component-specific names for the same fields may vary. The field dictionary is used to define how the application or component-specific name relates -to the name that the CMEPS mediator uses for that field. The mediator variable -names and their application specific aliases are found in the YAML field dictionary. +to the name that the CMEPS mediator uses for that field. The mediator variable +names and their application specific aliases are found in the YAML field dictionary. Details of the naming conventions and API's of this file can be found in the description of the :ref:`exchange of fields in @@ -38,7 +38,7 @@ Field Naming Convention The CMEPS field name convention in the YAML files is independent of the model components. The convention differentiates between variables that are state fields versus flux fields. The naming convention assumes the following one letter designation for the various components as -well as the mediator. +well as the mediator. **import to mediator**:: @@ -58,30 +58,30 @@ well as the mediator. State variables have a 3 character prefix followed by the state name. The prefix has the form ``S[a,i,l,g,o,r,w,x]_`` and is followed by - the field name. - + the field name. + As an example, ``Sx_t`` is the merged surface temperature from land, ice and ocean sent to the atmosphere for CESM. **Flux variables**: - Flux variables specify both source and destination components and have a - 5 character prefix followed by an identifier name of the flux. The first 5 - characters of the flux prefix ``Flmn_`` indicate a flux between - components l and m, computed by component n. The flux-prefix is followed - by the relevant flux-name. - + Flux variables specify both source and destination components and have a + 5 character prefix followed by an identifier name of the flux. The first 5 + characters of the flux prefix ``Flmn_`` indicate a flux between + components l and m, computed by component n. The flux-prefix is followed + by the relevant flux-name. + **mediator import flux prefixes**:: - + Faxa_, atm flux computed by atm Fall_, lnd-atm flux computed by lnd Fioi_, ice-ocn flux computed by ice Faii_, ice_atm flux computed by ice Flrr_, lnd-rof flux computed by rof Firr_, rof-ice flux computed by rof - + **mediator export flux prefixes**:: - + Faxx_, mediator merged fluxes sent to the atm Foxx_, mediator merged fluxes sent to the ocn Fixx_, mediator merged fluxes sent to the ice @@ -122,7 +122,7 @@ The API for this call is: .. code-block:: Fortran call addfld(fldListFr(comp_index)%flds, 'field_name') - call addfld(fldListTo(comp_index)%flds, 'field_name') + call addfld(fldListTo(comp_index)%flds, 'field_name') where: @@ -206,7 +206,7 @@ fraction corrections are not required in other mappings to improve accuracy beca call addmap(fldListFr(compice)%flds, 'Si_snowh', compatm, mapconsf, 'ifrac', 'unset') This will create an entry in ``fldListFr(compatm)`` specifying that the ``Si_snowh`` field from the ice should be mapped conservatively to the atmosphere using -fractional normalization where the ice fraction is obtained from ``FBFrac(compice)[snowh]``. The route handle for this mapping will be created at run time. +fractional normalization where the ice fraction is obtained from ``FBFrac(compice)[snowh]``. The route handle for this mapping will be created at run time. .. _addmrg: diff --git a/doc/source/generic.rst b/doc/source/generic.rst index 62055af1c..1be409a9a 100644 --- a/doc/source/generic.rst +++ b/doc/source/generic.rst @@ -15,7 +15,7 @@ application specific and provide general functionality. component state in the mediator's InternalState * initializing the mediator component specific fields via a call to - ``esmFldsExchange_xxx_`` (where currently xxx can be ``cesm``, ``nems`` or ``hafs``). + ``esmFldsExchange_xxx_`` (where currently xxx can be ``cesm``, ``ufs`` or ``hafs``). * determining which components are present diff --git a/doc/source/introduction.rst b/doc/source/introduction.rst index 3b79e1ed0..54a16761b 100644 --- a/doc/source/introduction.rst +++ b/doc/source/introduction.rst @@ -31,7 +31,7 @@ matching of standard field names. These standard names are defined in a field dictionary. Since CMEPS is a community mediator, these standard names are specific to each application. - + Organization of the CMEPS mediator code ####################################### @@ -39,28 +39,28 @@ Organization of the CMEPS mediator code When you check out the code you will files, which can be organized into three groups: -* totally generic components that carry out the mediator functionality such as mapping, - merging, restarts and history writes. Included here is a a "fraction" module that - determines the fractions of different source model components on every source +* totally generic components that carry out the mediator functionality such as mapping, + merging, restarts and history writes. Included here is a a "fraction" module that + determines the fractions of different source model components on every source destination mesh. -* application specific code that determines what fields are exchanged between +* application specific code that determines what fields are exchanged between components and how they are merged and mapped. -* prep phase modules that carry out the mapping and merging from one or more +* prep phase modules that carry out the mapping and merging from one or more source components to the destination component. =========================== ============================ =========================== Generic Code Application Specific Code Prep Phase Code =========================== ============================ =========================== med.F90 esmFldsExchange_cesm_mod.F90 med_phases_prep_atm_mod.F90 -esmFlds.F90 esmFldsExchange_nems_mod.F90 med_phases_prep_ice_mod.F90 +esmFlds.F90 esmFldsExchange_ufs_mod.F90 med_phases_prep_ice_mod.F90 med_map_mod.F90 esmFldsExchange_hafs_mod.F90 med_phases_prep_ocn_mod.F90 med_merge_mod.F90 fd_cesm.yaml med_phases_prep_glc_mod.F90 -med_frac_mod.F90 fd_nems.yaml med_phases_prep_lnd_mod.F90 -med_internalstate_mod.F90 fd_hafs.yaml med_phases_prep_rof_mod.F90 -med_methods_mod.F90. -med_phases_aofluxes_mod.F90 +med_frac_mod.F90 fd_ufs.yaml med_phases_prep_lnd_mod.F90 +med_internalstate_mod.F90 fd_ufs.yaml med_phases_prep_rof_mod.F90 +med_methods_mod.F90. +med_phases_aofluxes_mod.F90 med_phases_ocnalb_mod.F90 med_phases_history_mod.F90 med_phases_restart_mod.F90 @@ -78,8 +78,8 @@ Mapping and Merging Primer ####################################### This section provides a primer on mapping (interpolation) and merging of gridded -coupled fields. Masks, support for partial fractions on grids, weights generation, -and fraction +coupled fields. Masks, support for partial fractions on grids, weights generation, +and fraction weighted mapping and merging all play roles in the conservation and quality of the coupled fields. @@ -89,11 +89,11 @@ A pair of atmosphere and ocean/ice grids can be used to highlight the analysis. :width: 400 :alt: Sample CMEPS grids -The most general CMEPS mediator assumes the ocean and sea ice surface grids are +The most general CMEPS mediator assumes the ocean and sea ice surface grids are identical while the atmosphere and land grids are also identical. The ocean/ice grid defines the mask which means each ocean/ice gridcell is either a fully -active ocean/ice gridcell or not (i.e. land). Other configurations have been -and can be implemented and analyzed as well. +active ocean/ice gridcell or not (i.e. land). Other configurations have been +and can be implemented and analyzed as well. The ocean/ice mask interpolated to the atmosphere/land grid determines the complementary ocean/ice and land masks on the atmosphere grid. @@ -112,12 +112,12 @@ The gridcells can be labeled as follows. :width: 300 :alt: Sample CMEPS gridcell naming convention -The atmosphere gridcell is labeled "a". On the atmosphere gridcell (the red box), +The atmosphere gridcell is labeled "a". On the atmosphere gridcell (the red box), in general, there is a land fraction (fal), an ocean fraction (fao), and a sea ice fraction (fai). The sum of the surface fractions should always be 1.0 in these -conventions. There is also a gridbox average field on the atmosphere grid (Fa). -This could be a flux or a state that is +conventions. There is also a gridbox average field on the atmosphere grid (Fa). +This could be a flux or a state that is derived from the equivalent land (Fal), ocean (Fao), and sea ice (Fai) fields. The gridbox average field is computed by merging the various surfaces:: @@ -130,9 +130,9 @@ This is a standard merge where:: and each surface field, Fal, Fao, and Fai are the values of the surface fields on the atmosphere grid. -The ocean gridcells (blue boxes) are labeled 1, 2, 3, and 4 in this example. -In general, -each ocean/ice gridcell partially overlaps multiple atmosphere gridcells. +The ocean gridcells (blue boxes) are labeled 1, 2, 3, and 4 in this example. +In general, +each ocean/ice gridcell partially overlaps multiple atmosphere gridcells. Each ocean/ice gridcell has an overlapping Area (A) and a Mask (M) associated with it. In this example, land is colored green, ocean blue, and sea ice white so just for the figure depicted:: @@ -159,7 +159,7 @@ gridcells. Nonlinear interpolation is not yet supported in most coupled systems Mapping weights can be defined in a number of ways even beyond conservative or bilinear. They can be masked or normalized using multiple approaches. The -weights generation is intricately tied to other aspects of the coupling method. +weights generation is intricately tied to other aspects of the coupling method. In CMEPS, area-overlap conservative weights are defined as follows:: w1 = A1/Aa @@ -167,7 +167,7 @@ In CMEPS, area-overlap conservative weights are defined as follows:: w3 = A3/Aa w4 = A4/Aa -This simple approach which does not include any masking or normalization provides a +This simple approach which does not include any masking or normalization provides a number of useful attributes. The weights always add up to 1.0:: w1 + w2 + w3 + w4 = 1.0 @@ -207,11 +207,11 @@ And the equation for f_land and fal above are consistent if fl1=1-M1:: fal = w1 + w2 + w3 + w4 - (w1*M1 + w2*M2 + w3*M3 + w4*M4) fal = 1 - (w1*M1 + w2*M2 + w3*M3 + w4*M4) -Clearly defined and consistent weights, areas, fractions, and masks is critical +Clearly defined and consistent weights, areas, fractions, and masks is critical to generating conservation in the system. When mapping masked or fraction weighted fields, these weights require that the -mapped field be normalized by the mapped fraction. Consider a case where sea +mapped field be normalized by the mapped fraction. Consider a case where sea surface temperature (SST) is to be mapped to the atmosphere grid with:: M1 = 0; M2 = M3 = M4 = 1 @@ -223,15 +223,15 @@ because w1 is non-zero and Fo1 is underfined since it's a land gridcell on the ocean grid. A masked weighted average, **Fa = M1*w1*Fo1 + M2*w2*Fo2 + M3*w3*Fo3 + M4*w4*Fo4 is also problematic** because M1 is zero, so the contribution of the first term is zero. But the sum -of the remaining weights (M2*w2 + M3*w3 + M4*w4) is now not identically 1 -which means the weighted average is incorrect. (To test this, assume all the +of the remaining weights (M2*w2 + M3*w3 + M4*w4) is now not identically 1 +which means the weighted average is incorrect. (To test this, assume all the weights are each 0.25 and all the Fo values are 10 degC, Fa would then be 7.5 degC). Next consider a masked weighted normalized average, **f_ocean = (w1*M1 + w2*M2 + w3*M3 + w4*M4) combined with Fa = (M1*w1*Fo1 + M2*w2*Fo2 + M3*w3*Fo3 + M4*w4*Fo4) / (f_ocean) which produces a reasonable but incorrect result** because the weighted average uses the mask instead of the fraction. The mask only produces a correct result -in cases where there is no sea ice because sea ice impacts the surface fractions. +in cases where there is no sea ice because sea ice impacts the surface fractions. Finally, consider a fraction weighted normalized average using the dynamically varying ocean fraction that is exposed to the atmosphere:: @@ -249,9 +249,9 @@ fao is the mapped ocean fraction on the atmosphere gridcell, and Fa is the mapped SST. The ocean fractions are only defined where the ocean mask is 1, otherwise the ocean and sea ice fractions are zero. Now, the SST in each ocean gridcell is weighted by the fraction of the ocean -box exposed to the atmosphere and that weighted average is normalized by +box exposed to the atmosphere and that weighted average is normalized by the mapped dynamically varying fraction. This produces a reasonable result -as well as a conservative result. +as well as a conservative result. The conservation check involves thinking of Fo and Fa as a flux. On the ocean grid, the quantity associated with the flux is:: @@ -268,7 +268,7 @@ Via some simple math, it can be shown that Qo = Qa if:: fao = w1*fo1 + w2*fo2 + w3*fo3 + w4*fo4 Fao = (fo1*w1*Fo1 + fo2*w2*Fo2 + fo3*w3*Fo3 + fo4*w4*Fo4) / (fao) -In practice, the fraction weighted normlized mapping field is computed +In practice, the fraction weighted normlized mapping field is computed by mapping the ocean fraction and the fraction weighted field from the ocean to the atmosphere grid separately and then using the mapped fraction to normalize the field as a four step process:: @@ -278,19 +278,19 @@ using the mapped fraction to normalize the field as a four step process:: Fao' = w1*Fo1' + w2*Fo2' + w3*Fo3' + w4*Fo4' (c) Fao = Fao'/fao (d) -Steps (b) and (c) above are the sparse matrix multiply by the standard +Steps (b) and (c) above are the sparse matrix multiply by the standard conservative weights. -Step (a) fraction weighs the field and step (d) normalizes the mapped field. +Step (a) fraction weighs the field and step (d) normalizes the mapped field. Another way to think of this is that the mapped flux (Fao') is normalized by the -same fraction (fao) that is used in the merge, so they actually cancel. -Both the normalization at the end of the mapping and the fraction weighting +same fraction (fao) that is used in the merge, so they actually cancel. +Both the normalization at the end of the mapping and the fraction weighting in the merge can be skipped and the results should be identical. But then the mediator will carry around Fao' instead of Fao and that field is far less intuitive as it no longer represents the gridcell average value, but some subarea average value. In addition, that approach is only valid when carrying out full surface merges. If, -for instance, the SST is to be interpolated and not merged with anything, the field +for instance, the SST is to be interpolated and not merged with anything, the field must be normalized after mapping to be useful. The same mapping and merging process is valid for the sea ice:: @@ -311,23 +311,23 @@ where now:: Fao = (fo1*w1*Fo1 + fo2*w2*Fo2 + fo3*w3*Fo3 + fo4*w4*Fo4) / (fao) Fai = (fi1*w1*Fi1 + fi2*w2*Fi2 + fi3*w3*Fi3 + fi4*w4*Fi4) / (fai) -will simplify to an equation that contains twelve distinct terms for each of the +will simplify to an equation that contains twelve distinct terms for each of the four ocean gridboxes and the three different surfaces:: - Fa = (w1*fl1*Fl1 + w2*fl2*Fl2 + w3*fl3*Fl3 + w4*fl4*Fl4) + - (w1*fo1*Fo1 + w2*fo2*Fo2 + w3*fo3*Fo3 + w4*fo4*Fo4) + - (w1*fi1*Fi1 + w2*fi2*Fi2 + w3*fi3*Fi3 + w4*fi4*Fi4) + Fa = (w1*fl1*Fl1 + w2*fl2*Fl2 + w3*fl3*Fl3 + w4*fl4*Fl4) + + (w1*fo1*Fo1 + w2*fo2*Fo2 + w3*fo3*Fo3 + w4*fo4*Fo4) + + (w1*fi1*Fi1 + w2*fi2*Fi2 + w3*fi3*Fi3 + w4*fi4*Fi4) and this further simplifies to something that looks like a mapping of the field merged on the ocean grid:: - Fa = w1*(fl1*Fl1+fo1*Fo1+fi1*Fi1) + + Fa = w1*(fl1*Fl1+fo1*Fo1+fi1*Fi1) + w2*(fl2*Fl2+fo2*Fo2+fi2*Fi2) + - w3*(fl3*Fl3+fo3*Fo3+fi3*Fi3) + + w3*(fl3*Fl3+fo3*Fo3+fi3*Fi3) + w4*(fl4*Fl4+fo4*Fo4+fi4*Fi4) Like the exercise with Fao above, these equations can be shown to be -fully conservative. +fully conservative. To summarize, multiple features such as area calculations, weights, masking, normalization, fraction weighting, and merging approaches @@ -335,9 +335,9 @@ have to be considered together to ensure conservation. The CMEPS mediator uses unmasked and unnormalized weights and then generally maps using the fraction weighted normalized approach. Merges are carried out with fraction weights. -This is applied to both state and flux fields, with conservative, bilinear, +This is applied to both state and flux fields, with conservative, bilinear, and other mapping approaches, and for both merged and unmerged fields. -This ensures that the fields are always useful gridcell average values +This ensures that the fields are always useful gridcell average values when being coupled or analyzed throughout the coupling implementation. @@ -353,7 +353,7 @@ model discretization, they are NOT ad-hoc. If the previous section, areas and weights were introduced. Those areas were assumed to consist of the area overlaps between gridcells and were computed -using a consistent approach such that the areas conserve. ESMF is able to compute +using a consistent approach such that the areas conserve. ESMF is able to compute these area overlaps and the corresponding mapping weights such that fluxes can be mapped and quantities are conserved. @@ -369,13 +369,13 @@ ESMF are identical, and all the weights are 1.0. So:: F2*A2 = F1*A1 (conservation) Now lets assume that the two models have fundamentally different discretizations, -different area algorithms (i.e. great circle vs simpler lon/lat approximations), +different area algorithms (i.e. great circle vs simpler lon/lat approximations), or even different assumptions about the size and shape of the earth. The grids can be identical in -terms of the longitude and latitude of the +terms of the longitude and latitude of the gridcell corners and centers, but the areas can also -be different because of the underlying model implementation. When a flux is passed -to or from each component, the quantity associated with that flux is proportional to +be different because of the underlying model implementation. When a flux is passed +to or from each component, the quantity associated with that flux is proportional to the model area, so:: A1 = A2 (ESMF areas) @@ -385,7 +385,7 @@ the model area, so:: A1m != A2m (model areas) F1*A1m != F2*A2m (loss of conservation) -This can be corrected by multiplying the fluxes +This can be corrected by multiplying the fluxes by an area correction. For each model, outgoing fluxes should be multiplied by the model area divided by the ESMF area. Incoming fluxes should be multiplied by the ESMF area divided by the model area. So:: @@ -411,14 +411,14 @@ can actually be applied a number of ways. * Models can pass the areas to the mediator and the mediator can multiple fluxes by the source model area before mapping and divide by the destination model area area after mapping. * Models can pass the areas to the mediator and implement an area correction term on the incoming and outgoing fluxes that is the ratio of the model and ESMF areas. This is the approach shown above and is how CMEPS traditionally implements this feature. -Model areas should be passed to the mediator at initialization so the area corrections +Model areas should be passed to the mediator at initialization so the area corrections can be computed and applied. These area corrections do not vary in time. Lags, Accumulation and Averaging ####################################### -In a coupled model, the component model sequencing and coupling frequency tend to introduce +In a coupled model, the component model sequencing and coupling frequency tend to introduce some lags as well as a requirement to accumulate and average. This occurs when component models are running sequentially or concurrently. In general, the component models advance in time separately and the "current time" in each model becomes out of @@ -430,7 +430,7 @@ multiple timesteps are taken between coupling periods in a component model, the states should be averaged over those timesteps before being passed back out to the coupler. In the same way, the fluxes and states passed into the coupler should be averaged over shorter coupling periods for models that are coupled at longer coupling -periods. +periods. For conservation of mass and energy, the field that is accumluated should be consistent with the field that would be passed if there were no averaging required. Take for @@ -447,13 +447,13 @@ where sum_n represents the sum over n time periods. This can also be written as Fo = 1/n * (sum_n(fao*Fao) + sum_n(fio*Fio)) -So multiple terms can be summed and accumulated or the individual terms fao*Fao +So multiple terms can be summed and accumulated or the individual terms fao*Fao and fio*Fio can be accumulated and later summed and averaged in either order. Both approaches produce identical results. Finally, **it's important to note that sum_n(fao)*sum_n(Fao) does not produce the same results as the sum_n(fao*Fao)**. In other words, the fraction weighted flux has to be accumulated and NOT the fraction and flux separately. This is important for conservation -in flux coupling. The same approach should be taken with merged states to compute the +in flux coupling. The same approach should be taken with merged states to compute the most accurate representation of the average state over the slow coupling period. An analysis and review of each coupling field should be carried out to determine the most conservative and accurate representation of averaged fields. This is particularly @@ -493,14 +493,14 @@ Simplifying the above equation:: Fo = 1/n * sum_n(mapa2o(fao_a*Fao_a) -Accumulation (sum_n) and mapping (mapa2o) are both linear operations so this can +Accumulation (sum_n) and mapping (mapa2o) are both linear operations so this can be written as:: Fo = 1/n * mapa2o(sum_n(fao_a*Fao_a)) Fo = mapa2o(1/n*sum_n(fao_a*Fao_a)) which suggests that the accumulation can be done on the source side (i.e. atmosphere) -and only mapped on the slow coupling period. But again, fao_a*Fao_a has to be +and only mapped on the slow coupling period. But again, fao_a*Fao_a has to be accumulated and then when mapped, NO fraction would be applied to the merge as this is already included in the mapped field. In equation form, the full merged ocean field would be implemented as:: @@ -520,7 +520,7 @@ two atmosphere fields are mapped every fast coupling period, the merge is now fraction weighted for all terms, and the mapped fields, fao_o and Fao_o, have physically meaningful values. Fao'_o above does not. This implementation has a parallel with the normalization step. As suggested above, there are two -implementations for conservative mapping and merging in general. The one outlined +implementations for conservative mapping and merging in general. The one outlined above with fraction weighted normalized mapping and fraction weighted merging:: @@ -536,7 +536,7 @@ fraction is NOT applied during the merge:: These will produce identical results in the same way that their accumulated averages do. - + Flux Calculation Grid @@ -564,7 +564,7 @@ equations:: Fa = fl_a*Fal_a + fo_a*Fao_a + fi_a*Fai_a Fo = fo_o*Fao_o + fi_o*Fio_o -The above equations indicate that the land fraction on the atmosphere grid is the +The above equations indicate that the land fraction on the atmosphere grid is the complement of the mapped ocean mask and is static. The ice and ocean fractions are determined from the ice model and are dynamic. Both can be mapped to the atmosphere grid. Finally, the atmosphere flux is a three-way merge of the land, ocean, and @@ -572,7 +572,7 @@ ice terms on the atmosphere grid while the ocean flux is a two-way merge of the atmosphere and ice terms on the ocean grid. When the atmosphere/ocean and atmosphere/ice fluxes are both computed on the same -grid, at the same frequency, and both are mapped to the atmosphere grid, conservative +grid, at the same frequency, and both are mapped to the atmosphere grid, conservative mapping and merging is relatively straight-forward:: fo_a = mapo2a(fo_o) @@ -588,15 +588,15 @@ and everything conserves relatively directly:: fi_a*Fai_a = fi_o*Fai_o When the atmosphere/ice fluxes are computed on the ocean grid while -the atmosphere/ocean fluxes are computed on the atmosphere grid, +the atmosphere/ocean fluxes are computed on the atmosphere grid, extra care is needed with regard to fractions and conservation. In this case:: fo_a = mapo2a(fo_o) Fao_o = mapa2o(fo_a*Fao_a)/mapa2o(fo_a) fi_a = mapo2a(fi_o) Fai_a = mapo2a(fi_o*Fai_o)/fi_a - -fo_o, fi_o, Fai_o, and Fao_a are specified and Fao_o has to be computed. The most + +fo_o, fi_o, Fai_o, and Fao_a are specified and Fao_o has to be computed. The most important point here is that during the ocean merge, the mapped ocean fraction on the atmosphere grid is used so:: diff --git a/doc/source/prep.rst b/doc/source/prep.rst index 07595cb45..e75bf33a7 100644 --- a/doc/source/prep.rst +++ b/doc/source/prep.rst @@ -6,20 +6,20 @@ The following modules comprise the "prep phase" CMEPS code: -**med_phases_prep_atm_mod.F90**: prepares the mediator export state to the atmosphere component +**med_phases_prep_atm_mod.F90**: prepares the mediator export state to the atmosphere component + +**med_phases_prep_ice_mod.F90**: prepares the mediator export state to the sea-ice component + +**med_phases_prep_glc_mod.F90**: prepares the mediator export state to the land-ice component -**med_phases_prep_ice_mod.F90**: prepares the mediator export state to the sea-ice component - -**med_phases_prep_glc_mod.F90**: prepares the mediator export state to the land-ice component - **med_phases_prep_lnd_mod.F90**: prepares the mediator export state to the land component - + **med_phases_prep_ocn_mod.F90**: prepares the mediator export state to the ocean component **med_phases_prep_rof_mod.F90**: prepares the mediator export state to the river component - + **med_phases_prep_wav_mod.F90**: prepares the mediator export state to the wave component - + Each prep phase module has several sections: @@ -71,8 +71,7 @@ Each prep phase module has several sections: * ``med_phases_prep_ocn``: * computation of net shortwave that is sent to the ocean. - * apply precipitation fractor to scale rain and snow sent to ocean (for CESM) - * carry out custom merges for NEMS coupling modes (for NEMS) + * apply precipitation fractor to scale rain and snow sent to ocean * ``med_phases_prep_rof``: diff --git a/mediator/CMakeLists.txt b/mediator/CMakeLists.txt index 84f62675e..9630b5e23 100644 --- a/mediator/CMakeLists.txt +++ b/mediator/CMakeLists.txt @@ -5,7 +5,7 @@ set(SRCFILES esmFldsExchange_cesm_mod.F90 med_fraction_mod.F90 med_phases_restart_mod.F90 esmFldsExchange_hafs_mod.F90 med_internalstate_mod.F90 med_phases_aofluxes_mod.F90 med_phases_prep_lnd_mod.F90 med_time_mod.F90 - esmFldsExchange_nems_mod.F90 med_io_mod.F90 + esmFldsExchange_ufs_mod.F90 med_io_mod.F90 med_phases_history_mod.F90 med_phases_prep_ocn_mod.F90 med_utils_mod.F90 esmFlds.F90 med_kind_mod.F90 med_phases_prep_rof_mod.F90 diff --git a/mediator/ESMFConvenienceMacros.h b/mediator/ESMFConvenienceMacros.h index 092760585..660583eaa 100644 --- a/mediator/ESMFConvenienceMacros.h +++ b/mediator/ESMFConvenienceMacros.h @@ -2,6 +2,6 @@ // ----------- ERROR handling macros ------------------------------------------ #endif -#define ESMF_ERR_ABORT(rc) if (ESMF_LogFoundError(rc, msg="Aborting NEMS", line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) +#define ESMF_ERR_ABORT(rc) if (ESMF_LogFoundError(rc, msg="Aborting UFS", line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) #define ESMF_ERR_RETURN(rc,rcOut) if (ESMF_LogFoundError(rc, msg="Breaking out of subroutine", line=__LINE__, file=__FILE__, rcToReturn=rcOut)) return diff --git a/mediator/ESMFVersionDefine.h b/mediator/ESMFVersionDefine.h index 0038c9db1..b9a5054c8 100644 --- a/mediator/ESMFVersionDefine.h +++ b/mediator/ESMFVersionDefine.h @@ -1,9 +1,8 @@ #if 0 // // Make this header file available as ESMFVersionDefine.h in order to build -// NEMS against an ESMF installation that contains a reference level NUOPC Layer. +// UFS against an ESMF installation that contains a reference level NUOPC Layer. // #endif #include "./ESMFConvenienceMacros.h" - diff --git a/mediator/Makefile b/mediator/Makefile index 126d040bd..990fe58eb 100644 --- a/mediator/Makefile +++ b/mediator/Makefile @@ -34,12 +34,12 @@ med_kind_mod.o : med_constants_mod.o : med_kind_mod.o 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_nems_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 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_time_mod.o med_internalstate_mod.o med_phases_prep_atm_mod.o esmFldsExchange_cesm_mod.o esmFldsExchange_nems_mod.o \ + med_time_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 diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_ufs_mod.F90 similarity index 98% rename from mediator/esmFldsExchange_nems_mod.F90 rename to mediator/esmFldsExchange_ufs_mod.F90 index a11d62b53..a93a8ff81 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_ufs_mod.F90 @@ -1,4 +1,4 @@ -module esmFldsExchange_nems_mod +module esmFldsExchange_ufs_mod !--------------------------------------------------------------------- ! This is a mediator specific routine that determines ALL possible @@ -9,7 +9,7 @@ module esmFldsExchange_nems_mod implicit none public - public :: esmFldsExchange_nems + public :: esmFldsExchange_ufs character(*), parameter :: u_FILE_u = & __FILE__ @@ -18,7 +18,7 @@ module esmFldsExchange_nems_mod contains !================================================================================ - subroutine esmFldsExchange_nems(gcomp, phase, rc) + subroutine esmFldsExchange_ufs(gcomp, phase, rc) use ESMF use NUOPC @@ -54,7 +54,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) character(len=CL) :: cvalue character(len=CS) :: fldname character(len=CS), allocatable :: flds(:), oflds(:), aflds(:), iflds(:) - character(len=*) , parameter :: subname='(esmFldsExchange_nems)' + character(len=*) , parameter :: subname='(esmFldsExchange_ufs)' !-------------------------------------- rc = ESMF_SUCCESS @@ -68,7 +68,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Set maptype according to coupling_mode - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then + if (trim(coupling_mode) == 'ufs.nfrac' .or. trim(coupling_mode) == 'ufs.nfrac.aoflux') then maptype = mapnstod_consf else maptype = mapconsf @@ -76,7 +76,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) write(msgString,'(A,i6,A)') trim(subname)//': maptype is ',maptype,', '//mapnames(maptype) call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - if (trim(coupling_mode) == 'nems_orig_data' .or. trim(coupling_mode) == 'nems_frac_aoflux') then + if (trim(coupling_mode) == 'ufs.nfrac.aoflux' .or. trim(coupling_mode) == 'ufs.frac.aoflux') then med_aoflux_to_ocn = .true. else med_aoflux_to_ocn = .false. @@ -713,7 +713,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) !===================================================================== ! to lnd - states and fluxes from atm - if ( trim(coupling_mode) == 'nems_orig_data') then + if ( trim(coupling_mode) == 'ufs.nfrac.aoflux') then allocate(flds(21)) flds = (/'Sa_z ', 'Sa_topo ', 'Sa_tbot ', 'Sa_pbot ', & 'Sa_shum ', 'Sa_u ', 'Sa_v ', 'Faxa_lwdn ', & @@ -746,6 +746,6 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end do deallocate(flds) - end subroutine esmFldsExchange_nems + end subroutine esmFldsExchange_ufs -end module esmFldsExchange_nems_mod +end module esmFldsExchange_ufs_mod diff --git a/mediator/med.F90 b/mediator/med.F90 index 9bb936f60..98021c647 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -48,7 +48,7 @@ module MED use esmFlds , only : med_fldList_GetNumFlds, med_fldList_GetFldNames, med_fldList_GetFldInfo use esmFlds , only : med_fldList_Document_Mapping, med_fldList_Document_Merging use esmFlds , only : med_fldList_GetfldListFr, med_fldList_GetfldListTo, med_fldList_Realize - use esmFldsExchange_nems_mod , only : esmFldsExchange_nems + use esmFldsExchange_ufs_mod , only : esmFldsExchange_ufs use esmFldsExchange_cesm_mod , only : esmFldsExchange_cesm use esmFldsExchange_hafs_mod , only : esmFldsExchange_hafs use med_phases_profile_mod , only : med_phases_profile_finalize @@ -816,8 +816,8 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) if (trim(coupling_mode) == 'cesm') then call esmFldsExchange_cesm(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode(1:4)) == 'nems') then - call esmFldsExchange_nems(gcomp, phase='advertise', rc=rc) + else if (trim(coupling_mode(1:3)) == 'ufs') then + call esmFldsExchange_ufs(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode(1:4)) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='advertise', rc=rc) @@ -1802,8 +1802,8 @@ subroutine DataInitialize(gcomp, rc) if (trim(coupling_mode) == 'cesm') then call esmFldsExchange_cesm(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode(1:4)) == 'nems') then - call esmFldsExchange_nems(gcomp, phase='initialize', rc=rc) + else if (trim(coupling_mode(1:3)) == 'ufs') then + call esmFldsExchange_ufs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='initialize', rc=rc) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 7fe0315b6..2f7d43041 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -293,7 +293,7 @@ subroutine med_fraction_init(gcomp, rc) ! If ice and atm are on the same mesh - a redist route handle has already been created maptype = mapfcopy else - if (trim(coupling_mode) == 'nems_orig' ) then + if (trim(coupling_mode(1:9)) == 'ufs.nfrac' ) then maptype = mapnstod_consd else maptype = mapconsd @@ -345,7 +345,7 @@ subroutine med_fraction_init(gcomp, rc) ! If ocn and atm are on the same mesh - a redist route handle has already been created maptype = mapfcopy else - if (trim(coupling_mode) == 'nems_orig' ) then + if (trim(coupling_mode(1:9)) == 'ufs.nfrac' ) then maptype = mapnstod_consd else maptype = mapconsd @@ -756,7 +756,7 @@ subroutine med_fraction_set(gcomp, rc) call t_startf('MED:'//trim(subname)//' fbfrac(compatm)') ! Determine maptype - if (trim(coupling_mode) == 'nems_orig' ) then + if (trim(coupling_mode(1:9)) == 'ufs.nfrac' ) then maptype = mapnstod_consd else if (med_map_RH_is_created(is_local%wrap%RH(compice,compatm,:),mapfcopy, rc=rc)) then diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 66e2eb1db..fbe4617cf 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -47,7 +47,7 @@ module med_internalstate_mod character(len=CS), public :: glc_name = '' ! Coupling mode - character(len=CS), public :: coupling_mode ! valid values are [cesm,nems_orig,nems_frac,nems_orig_data,hafs,nems_frac_aoflux,nems_frac_aoflux_sbs] + character(len=CS), public :: coupling_mode ! valid values are [cesm,ufs.nfrac,ufs.frac,ufs.nfrac.aoflux,ufs.frac.aoflux,hafs] ! Atmosphere-ocean flux algorithm character(len=CS), public :: aoflux_code ! valid values are [cesm,ccpp] @@ -584,7 +584,7 @@ subroutine med_internalstate_defaultmasks(gcomp, rc) if (is_local%wrap%comp_present(compocn)) defaultMasks(compocn,:) = 0 if (is_local%wrap%comp_present(compice)) defaultMasks(compice,:) = 0 if (is_local%wrap%comp_present(compwav)) defaultMasks(compwav,:) = 0 - if ( trim(coupling_mode(1:4)) == 'nems') then + if ( trim(coupling_mode(1:3)) == 'ufs') then if (is_local%wrap%comp_present(compatm)) defaultMasks(compatm,:) = 1 endif if ( trim(coupling_mode) == 'hafs') then diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 54bcbb154..0df18a770 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -408,7 +408,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dstMaskValue = ispval_mask endif end if - if (trim(coupling_mode(1:4)) == 'nems') then + if (trim(coupling_mode(1:3)) == 'ufs') then if (n1 == compatm .and. n2 == complnd) then srcMaskValue = ispval_mask dstMaskValue = ispval_mask @@ -424,7 +424,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, call ESMF_LogWrite(trim(string), ESMF_LOGMSG_INFO) polemethod=ESMF_POLEMETHOD_ALLAVG - if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode(1:4)) == 'nems') then + if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode(1:3)) == 'ufs') then if (n1 == compwav .or. n2 == compwav) then polemethod = ESMF_POLEMETHOD_NONE ! todo: remove this when ESMF tripolar mapping fix is in place. endif diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 48055e92e..8c3d87c61 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1024,7 +1024,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) end if if (compute_atm_dens) then if (trim(aoflux_code) == 'ccpp' .and. & - (trim(coupling_mode) == 'nems_frac_aoflux' .or. trim(coupling_mode) == 'nems_frac_aoflux_sbs')) then + (trim(coupling_mode) == 'ufs.frac.aoflux')) then ! Add limiting factor to humidity to be consistent with UFS aoflux calculation do n = 1,aoflux_in%lsize if (aoflux_in%mask(n) /= 0.0_r8) then @@ -1562,8 +1562,8 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r lsize = size(aoflux_in%zbot) aoflux_in%lsize = lsize - ! bulk formula quantities for nems_orig_data - if (trim(coupling_mode) == 'nems_orig_data' .and. ocn_surface_flux_scheme == -1) then + ! bulk formula quantities for ufs non-frac with med-aoflux + if (trim(coupling_mode) == 'ufs.nfrac.aoflux' .and. ocn_surface_flux_scheme == -1) then call fldbun_getfldptr(fldbun_a, 'Sa_u10m', aoflux_in%ubot, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun_a, 'Sa_v10m', aoflux_in%vbot, xgrid=xgrid, rc=rc) @@ -1583,8 +1583,8 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (chkerr(rc,__LINE__,u_FILE_u)) return end if - ! extra fields for nems_frac_aoflux - if (trim(coupling_mode) == 'nems_frac_aoflux' .or. trim(coupling_mode) == 'nems_frac_aoflux_sbs') then + ! extra fields for ufs.frac.aoflux + if (trim(coupling_mode) == 'ufs.frac.aoflux') then call fldbun_getfldptr(fldbun_a, 'Sa_u10m', aoflux_in%usfc, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun_a, 'Sa_v10m', aoflux_in%vsfc, xgrid=xgrid, rc=rc) @@ -1618,7 +1618,7 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (compute_atm_dens .or. compute_atm_thbot) then call fldbun_getfldptr(fldbun_a, 'Sa_pbot', aoflux_in%pbot, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (trim(coupling_mode) == 'nems_frac_aoflux' .or. trim(coupling_mode) == 'nems_frac_aoflux_sbs') then + if (trim(coupling_mode) == 'ufs.frac.aoflux') then call fldbun_getfldptr(fldbun_a, 'Sa_pslv', aoflux_in%psfc, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 01d1a52d0..abb6b7d5b 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -115,8 +115,7 @@ subroutine med_phases_prep_atm(gcomp, rc) !--- map atm/ocn fluxes from ocn to atm grid if appropriate !--------------------------------------- if (trim(coupling_mode) == 'cesm' .or. & - trim(coupling_mode) == 'nems_frac_aoflux' .or. & - trim(coupling_mode) == 'nems_frac_aoflux_sbs') then + trim(coupling_mode) == 'ufs.frac.aoflux') then if (is_local%wrap%aoflux_grid == 'ogrid') then call med_aofluxes_map_ogrid2agrid_output(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From 20352660928f2dcaabe920ca048b95fa91a4de45 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 22 Nov 2023 07:56:33 -0700 Subject: [PATCH 382/395] more changes for derecho --- cime_config/testdefs/testlist_drv.xml | 106 +++++++++++++------------- 1 file changed, 53 insertions(+), 53 deletions(-) diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index 985bd6ce9..e17b2ffcf 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -5,36 +5,36 @@ - + - + - + - + - + - + - + - + @@ -46,18 +46,18 @@ - + - + - + - + @@ -69,18 +69,18 @@ - + - + - + - + @@ -92,27 +92,27 @@ - + - + - + - + - + - + @@ -124,27 +124,27 @@ - + - + - + - + - + - + @@ -156,9 +156,9 @@ - + - + @@ -170,24 +170,24 @@ - + - + - + - + - + @@ -200,36 +200,36 @@ - + - + - + - + - + - + - + - + @@ -241,18 +241,18 @@ - + - + - + - + @@ -263,18 +263,18 @@ - + - + - + - + @@ -282,9 +282,9 @@ - + - + From a2c16dc67064b8687702d6b39be0b2c92a69b264 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 14 Dec 2023 15:54:46 -0700 Subject: [PATCH 383/395] remove the SMP_PRESENT variable and replace with BUILD_THREADED --- cime_config/config_component.xml | 9 --------- 1 file changed, 9 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index d0267b1f9..938e0e31c 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -821,15 +821,6 @@ different MPI ranks to different GPUs within the same compute node - - logical - TRUE,FALSE - FALSE - build_def - env_build.xml - TRUE implies that at least one of the components is built threaded (DO NOT EDIT) - - logical TRUE,FALSE From e0731f9987735701c9f11e44e89810fc0ca48cbf Mon Sep 17 00:00:00 2001 From: Meg Fowler Date: Tue, 19 Dec 2023 13:31:13 -0700 Subject: [PATCH 384/395] Add modifications to compute gust addition to U10 and control with a namelist --- cesm/flux_atmocn/shr_flux_mod.F90 | 41 ++++++++++++++++--------- cime_config/namelist_definition_drv.xml | 12 ++++++++ mediator/esmFldsExchange_cesm_mod.F90 | 20 ++++++++++++ mediator/fd_cesm.yaml | 4 +++ mediator/med_phases_aofluxes_mod.F90 | 26 ++++++++++++++-- 5 files changed, 87 insertions(+), 16 deletions(-) diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index 741447d93..d35d054d6 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -133,7 +133,7 @@ end subroutine shr_flux_adjust_constants ! Thomas Toniazzo (Bjerknes Centre, Bergen) ” !=============================================================================== SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & - & qbot ,s16O ,sHDO ,s18O ,rbot, & + & qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & & tbot ,us ,vs, pslv, & & ts ,mask , seq_flux_atmocn_minwind, & & sen ,lat ,lwup , & @@ -141,7 +141,10 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & & evap ,evap_16O, evap_HDO, evap_18O, & & taux ,tauy ,tref ,qref , & & ocn_surface_flux_scheme, & - & duu10n, ustar_sv ,re_sv ,ssq_sv, & + & add_gusts, & + & duu10n, & + & ugust_out, & + & ustar_sv ,re_sv ,ssq_sv, & & missval) ! !USES: @@ -156,11 +159,13 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & integer(IN),intent(in) :: nMax ! data vector length integer(IN),intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain integer(IN),intent(in) :: ocn_surface_flux_scheme + logical ,intent(in) :: add_gusts real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) real(R8) ,intent(in) :: ubot (nMax) ! atm u wind (m/s) real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) + real(R8) ,intent(in) :: rainc(nMax) ! atm precip for convective gustiness (kg/m^3) - RBN 24Nov2008/MDF 31Jan2022 real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) @@ -188,6 +193,7 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + real(R8),intent(out) :: ugust_out(nMax) ! diag: gustiness addition to U10 (m/s) real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) @@ -257,22 +263,21 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & real(R8) :: tdiff(nMax) ! tbot - ts real(R8) :: vscl + real(R8) :: ugust ! function: gustiness as a function of convective rainfall. + real(R8) :: gprec ! dummy arg ~ ? qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) - - ! Large and Yeager 2009 - cdn(Umps) = 0.0027_R8 / min(33.0000_R8,Umps) + 0.000142_R8 + & - 0.0000764_R8 * min(33.0000_R8,Umps) - 3.14807e-13_r8 * min(33.0000_R8,Umps)**6 - ! Capped Large and Pond by wind - ! cdn(Umps) = 0.0027_R8 / min(30.0_R8,Umps) + 0.000142_R8 + 0.0000764_R8 * min(30.0_R8,Umps) - ! Capped Large and Pond by Cd - ! cdn(Umps) = min(0.0025_R8, (0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps )) - ! Large and Pond - ! cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps - + cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) + ! Convective gustiness appropriate for input precipitation. + ! Following Regelsperger et al. (2000, J. Clim) + ! Ug = log(1.0+6.69R-0.476R^2) + ! Coefficients X by 8640 for mm/s (from cam) -> cm/day (for above forumla) + ugust(gprec) = log(1._R8+57801.6_r8*gprec-3.55332096e7_r8*(gprec**2)) + + !--- formats ---------------------------------------- character(*),parameter :: subName = '(flux_atmOcn) ' character(*),parameter :: F00 = "('(flux_atmOcn) ',4a)" @@ -327,7 +332,14 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & if (mask(n) /= 0) then !--- compute some needed quantities --- - vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + if (add_gusts) then + vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) + ugust(min(rainc(n),6.94444e-4_r8)) ) + ugust_out(n) = ugust(min(rainc(n),6.94444e-4_r8)) + else + vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + ugust_out(n) = 0.0_r8 + end if + if (use_coldair_outbreak_mod) then ! Cold Air Outbreak Modification: ! Increase windspeed for negative tbot-ts @@ -462,6 +474,7 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & tref (n) = spval ! 2m reference height temperature (K) qref (n) = spval ! 2m reference height humidity (kg/kg) duu10n(n) = spval ! 10m wind speed squared (m/s)^2 + ugust_out(n) = spval ! gustiness addition (m/s) if (present(ustar_sv)) ustar_sv(n) = spval if (present(re_sv )) re_sv (n) = spval diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index dec6868f1..a3fb520fb 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -964,6 +964,18 @@ + + logical + control + MED_attributes + + add a wind gustiness factor + + + .false. + + + logical budget diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index a2c4fe435..c7cee8d98 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -276,6 +276,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_from(compatm, 'Sa_shum') call addfld_from(compatm, 'Sa_ptem') call addfld_from(compatm, 'Sa_dens') + call addfld_from(compatm, 'Faxa_rainc') if (flds_wiso) then call addfld_from(compatm, 'Sa_shum_wiso') end if @@ -288,6 +289,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap_from(compatm, 'Sa_u' , compocn, mappatch, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_v' , compocn, mappatch, 'one', atm2ocn_map) end if + call addmap_from(compatm, 'Faxa_rainc', compocn, mapconsf, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_z' , compocn, mapbilnr, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_tbot', compocn, mapbilnr, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_pbot', compocn, mapbilnr, 'one', atm2ocn_map) @@ -1365,6 +1367,24 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if + ! --------------------------------------------------------------------- + ! to atm: unmerged ugust_out from ocn + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_aoflux('So_ugustOut') + call addfld_to(compatm, 'So_ugustOut') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'So_ugustOut', rc=rc)) then + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_ugustOut', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap_aoflux('So_ugustOut', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg_to(compatm , 'So_ugustOut', & + mrg_from=compmed, mrg_fld='So_ugustOut', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if + ! --------------------------------------------------------------------- ! to atm: surface snow depth from ice (needed for cam) ! to atm: mean ice volume per unit area from ice diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index c09a63c58..eaef1dc78 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -487,6 +487,10 @@ canonical_units: m description: atmosphere import # + - standard_name: So_ugustOut + canonical_units: m/s + description: atmosphere import + # #----------------------------------- # section: land-ice export # Note that the fields sent from glc->med do NOT have elevation classes, diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 48055e92e..0713019ff 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -78,6 +78,7 @@ module med_phases_aofluxes_mod logical :: compute_atm_dens logical :: compute_atm_thbot integer :: ocn_surface_flux_scheme ! use case + logical :: add_gusts character(len=CS), pointer :: fldnames_ocn_in(:) character(len=CS), pointer :: fldnames_atm_in(:) @@ -125,6 +126,7 @@ module med_phases_aofluxes_mod real(R8) , pointer :: shum_HDO (:) => null() ! atm HDO tracer real(R8) , pointer :: shum_18O (:) => null() ! atm H218O tracer real(R8) , pointer :: lwdn (:) => null() ! atm downward longwave heat flux + real(R8) , pointer :: rainc (:) => null() ! convective rain flux ! local size and computational mask and area: on aoflux grid integer :: lsize ! local size integer , pointer :: mask (:) => null() ! integer ocn domain mask: 0 <=> inactive cell @@ -146,6 +148,7 @@ module med_phases_aofluxes_mod real(R8) , pointer :: qref (:) => null() ! diagnostic: 2m ref Q real(R8) , pointer :: u10 (:) => null() ! diagnostic: 10m wind speed real(R8) , pointer :: duu10n (:) => null() ! diagnostic: 10m wind speed squared + real(R8) , pointer :: ugust_out (:) => null() ! diagnostic: gust wind added real(R8) , pointer :: ustar (:) => null() ! saved ustar real(R8) , pointer :: re (:) => null() ! saved re real(R8) , pointer :: ssq (:) => null() ! saved sq @@ -402,6 +405,14 @@ subroutine med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc) end if #endif + call NUOPC_CompAttributeGet(gcomp, name='add_gusts', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) add_gusts + else + add_gusts = .false. + end if + ! bottom level potential temperature and/or botom level density ! will need to be computed if not received from the atm if (FB_fldchk(is_local%Wrap%FBImp(Compatm,Compatm), 'Sa_ptem', rc=rc)) then @@ -1052,6 +1063,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) call flux_atmocn (logunit=logunit, & nMax=aoflux_in%lsize, & zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, qbot=aoflux_in%shum, & + rainc=aoflux_in%rainc, & s16O=aoflux_in%shum_16O, sHDO=aoflux_in%shum_HDO, s18O=aoflux_in%shum_18O, rbot=aoflux_in%dens, & tbot=aoflux_in%tbot, us=aoflux_in%uocn, vs=aoflux_in%vocn, pslv=aoflux_in%psfc, ts=aoflux_in%tocn, & mask=aoflux_in%mask, seq_flux_atmocn_minwind=0.5_r8, & @@ -1060,7 +1072,10 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) evap=aoflux_out%evap, evap_16O=aoflux_out%evap_16O, evap_HDO=aoflux_out%evap_HDO, evap_18O=aoflux_out%evap_18O, & taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & ocn_surface_flux_scheme=ocn_surface_flux_scheme, & - duu10n=aoflux_out%duu10n, ustar_sv=aoflux_out%ustar, re_sv=aoflux_out%re, ssq_sv=aoflux_out%ssq, & + add_gusts=add_gusts, & + duu10n=aoflux_out%duu10n, & + ugust_out = aoflux_out%ugust_out, & + ustar_sv=aoflux_out%ustar, re_sv=aoflux_out%re, ssq_sv=aoflux_out%ssq, & missval=0.0_r8) #else @@ -1080,11 +1095,14 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) call flux_atmocn (logunit=logunit, & nMax=aoflux_in%lsize, mask=aoflux_in%mask, & zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, qbot=aoflux_in%shum, & + rainc=aoflux_in%rainc, & rbot=aoflux_in%dens, tbot=aoflux_in%tbot, us=aoflux_in%uocn, vs=aoflux_in%vocn, ts=aoflux_in%tocn, & ocn_surface_flux_scheme=ocn_surface_flux_scheme, & sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evap=aoflux_out%evap, & taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & - duu10n=aoflux_out%duu10n, missval=0.0_r8) + duu10n=aoflux_out%duu10n, & + ugust_out = aoflux_out%ugust_out, & + missval=0.0_r8) #ifdef UFS_AOFLUX end if #endif @@ -1581,6 +1599,8 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun_a, 'Sa_shum', aoflux_in%shum, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun_a, 'Faxa_rainc', aoflux_in%rainc, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if ! extra fields for nems_frac_aoflux @@ -1692,6 +1712,8 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'So_duu10n', aoflux_out%duu10n, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'So_ugustOut', aoflux_out%ugust_out, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'Faox_taux', aoflux_out%taux, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'Faox_tauy', aoflux_out%tauy, xgrid=xgrid, rc=rc) From 2df34149b7fb00db20895a17fadc0fcf48813dc7 Mon Sep 17 00:00:00 2001 From: Meg Fowler Date: Wed, 20 Dec 2023 09:44:02 -0700 Subject: [PATCH 385/395] Fix shr_flux comments and cdn calculation --- cesm/flux_atmocn/shr_flux_mod.F90 | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index d35d054d6..58f7ae923 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -264,10 +264,20 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & real(R8) :: vscl real(R8) :: ugust ! function: gustiness as a function of convective rainfall. - real(R8) :: gprec ! dummy arg ~ ? + real(R8) :: gprec ! convective rainfall argument for ugust qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) - cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps + + ! Large and Yeager 2009 + cdn(Umps) = 0.0027_R8 / min(33.0000_R8,Umps) + 0.000142_R8 + & + 0.0000764_R8 * min(33.0000_R8,Umps) - 3.14807e-13_r8 * min(33.0000_R8,Umps)**6 + ! Capped Large and Pond by wind + ! cdn(Umps) = 0.0027_R8 / min(30.0_R8,Umps) + 0.000142_R8 + 0.0000764_R8 * min(30.0_R8,Umps) + ! Capped Large and Pond by Cd + ! cdn(Umps) = min(0.0025_R8, (0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps )) + ! Large and Pond + ! cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps + psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) From 6c321f1cec77d4b8238b2d425ddb748a577c9186 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 21 Dec 2023 07:19:54 -0700 Subject: [PATCH 386/395] update github tests --- .github/workflows/extbuild.yml | 16 ++++++++-------- .github/workflows/srt.yml | 10 +++++----- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 6e26b40a5..0614d5acb 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -20,11 +20,11 @@ jobs: CPPFLAGS: "-I/usr/include -I/usr/local/include" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.4.2 + ESMF_VERSION: v8.6.0 PNETCDF_VERSION: checkpoint.1.12.3 - NETCDF_FORTRAN_VERSION: v4.6.0 - PIO_VERSION: pio2_6_0 - CDEPS_VERSION: cdeps1.0.15 + NETCDF_FORTRAN_VERSION: v4.6.1 + PIO_VERSION: pio2_6_2 + CDEPS_VERSION: cdeps1.0.26 steps: - uses: actions/checkout@v3 # Build the ESMF library, if the cache contains a previous build @@ -84,7 +84,7 @@ jobs: ref: ${{ env.CDEPS_VERSION }} - name: Build CDEPS if: steps.cache-cdeps.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildcdeps@cdeps1.0.15 + uses: ESCOMP/CDEPS/.github/actions/buildcdeps@cdeps1.0.26 with: esmfmkfile: $HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk pio_path: $HOME/pio @@ -102,6 +102,6 @@ jobs: make VERBOSE=1 popd - - name: Setup tmate session - if: ${{ failure() }} - uses: mxschmitt/action-tmate@v3 +# - name: Setup tmate session +# if: ${{ failure() }} +# uses: mxschmitt/action-tmate@v3 diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 34252cb63..65f3a24e9 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -26,8 +26,8 @@ jobs: CPPFLAGS: "-I/usr/include -I/usr/local/include " LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.5.0 - PARALLELIO_VERSION: pio2_6_0 + ESMF_VERSION: v8.6.0 + PARALLELIO_VERSION: pio2_6_2 CIME_MODEL: cesm CIME_DRIVER: nuopc GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} @@ -176,6 +176,6 @@ jobs: popd # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details - - name: Setup tmate session - if: ${{ failure() }} - uses: mxschmitt/action-tmate@v3 +# - name: Setup tmate session +# if: ${{ failure() }} +# uses: mxschmitt/action-tmate@v3 From 09568f1f7065619242a6f9afa8e6def33b7dbc69 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 21 Dec 2023 08:04:43 -0700 Subject: [PATCH 387/395] fix testing issues --- .github/workflows/srt.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 65f3a24e9..e4bd71629 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -80,6 +80,8 @@ jobs: run: | pushd cesm ./manage_externals/checkout_externals ccs_config cdeps cime share mct cpl7 parallelio + cd ccs_config + git checkout main - name: Cache ESMF id: cache-esmf From e96e1995b812dc0cc2333b59a82abff0ce9c22d3 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 21 Dec 2023 08:30:51 -0700 Subject: [PATCH 388/395] fixing tests --- .github/workflows/srt.yml | 3 ++- mediator/med_phases_aofluxes_mod.F90 | 1 - 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index e4bd71629..62b2c3d86 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -82,7 +82,8 @@ jobs: ./manage_externals/checkout_externals ccs_config cdeps cime share mct cpl7 parallelio cd ccs_config git checkout main - + cd ../cime + git checkout master - name: Cache ESMF id: cache-esmf uses: actions/cache@v3 diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 0713019ff..24eafd119 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1095,7 +1095,6 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) call flux_atmocn (logunit=logunit, & nMax=aoflux_in%lsize, mask=aoflux_in%mask, & zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, qbot=aoflux_in%shum, & - rainc=aoflux_in%rainc, & rbot=aoflux_in%dens, tbot=aoflux_in%tbot, us=aoflux_in%uocn, vs=aoflux_in%vocn, ts=aoflux_in%tocn, & ocn_surface_flux_scheme=ocn_surface_flux_scheme, & sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evap=aoflux_out%evap, & From 18c510ba648aa5e9f98074d44c9e3b91e36bfe2f Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 21 Dec 2023 08:43:26 -0700 Subject: [PATCH 389/395] add check for cam_dev if add_gusts is true --- cime_config/buildnml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/cime_config/buildnml b/cime_config/buildnml index 32be8ead4..504ab5a4a 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -144,6 +144,10 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): if config["COMP_OCN"] == "docn" and "aqua" in case.get_value("DOCN_MODE"): nmlgen.set_value("aqua_planet", value=".true.") + # make sure that variable add_gusts is only set to true if compset includes cam_dev + if nmlgen.get_value("add_gusts"): + expect("CAM%DEV" in case.get_value("COMPSET"),"ERROR: add_gusts can only be set if CAM%DEV in compset {}".format(case.get_value("COMPSET"))) + # -------------------------------- # Overwrite: set component coupling frequencies # -------------------------------- @@ -658,6 +662,7 @@ def buildnml(case, caseroot, component): create_namelist_infile(case, user_nl_file, namelist_infile, infile_text) infile = [namelist_infile] + # create the files nuopc.runconfig, nuopc.runseq, drv_in and drv_flds_in _create_drv_namelists(case, infile, confdir, nmlgen, files) From f04687b0c7e23c8fa57192a3cf1082ab1ffcfdc1 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 21 Dec 2023 09:24:58 -0700 Subject: [PATCH 390/395] add check for cam_dev --- cime_config/buildnml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 504ab5a4a..3e0718538 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -15,6 +15,7 @@ from CIME.case import Case from CIME.nmlgen import NamelistGenerator from CIME.utils import expect from CIME.utils import get_model, get_time_in_seconds, get_timestamp +from CIME.namelist import literal_to_python_value from CIME.buildnml import create_namelist_infile, parse_input from CIME.XML.files import Files @@ -145,7 +146,8 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): nmlgen.set_value("aqua_planet", value=".true.") # make sure that variable add_gusts is only set to true if compset includes cam_dev - if nmlgen.get_value("add_gusts"): + add_gusts = literal_to_python_value(nmlgen.get_value("add_gusts"), type_="logical") + if add_gusts: expect("CAM%DEV" in case.get_value("COMPSET"),"ERROR: add_gusts can only be set if CAM%DEV in compset {}".format(case.get_value("COMPSET"))) # -------------------------------- From 962484bca4cc9c8d041f6dbadbc4dbb215a2619f Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 21 Dec 2023 11:21:32 -0700 Subject: [PATCH 391/395] another reference to gust outside of cesm code --- mediator/med_phases_aofluxes_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 24eafd119..97ad8fe1e 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1100,7 +1100,6 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evap=aoflux_out%evap, & taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & duu10n=aoflux_out%duu10n, & - ugust_out = aoflux_out%ugust_out, & missval=0.0_r8) #ifdef UFS_AOFLUX end if From 6d0e37e0092ef250c6b112872f208ea738140d9d Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 21 Dec 2023 11:22:12 -0700 Subject: [PATCH 392/395] debug tests --- .github/workflows/srt.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 62b2c3d86..197f6e234 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -179,6 +179,6 @@ jobs: popd # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details -# - name: Setup tmate session -# if: ${{ failure() }} -# uses: mxschmitt/action-tmate@v3 + - name: Setup tmate session + if: ${{ failure() }} + uses: mxschmitt/action-tmate@v3 From 3051280234fb80a0a81b4414f3ef07a7f7694e16 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 21 Dec 2023 12:12:51 -0700 Subject: [PATCH 393/395] add submodule command --- .github/workflows/srt.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 197f6e234..2d73d2668 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -84,6 +84,7 @@ jobs: git checkout main cd ../cime git checkout master + git submodule update --init - name: Cache ESMF id: cache-esmf uses: actions/cache@v3 From aaa78b8a813f045dfc2045ebec46a56bf8fa12ab Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 21 Dec 2023 12:38:48 -0700 Subject: [PATCH 394/395] add submodule command complication --- .github/workflows/srt.yml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 2d73d2668..df5eb3c0e 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -84,6 +84,12 @@ jobs: git checkout main cd ../cime git checkout master + if [[ ! -e "${PWD}/.gitmodules.bak" ]] + then + echo "Convering git@github.com to https://github.com urls in ${PWD}/.gitmodules" + + sed -i".bak" "s/git@github.com:/https:\/\/github.com\//g" "${PWD}/.gitmodules" + fi git submodule update --init - name: Cache ESMF id: cache-esmf From 46bf811f03bcf50ce24eaa550e3c352c4befb839 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 21 Dec 2023 16:41:01 -0700 Subject: [PATCH 395/395] turn add_gusts on by default for camdev --- cime_config/buildnml | 3 ++- cime_config/namelist_definition_drv.xml | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 3e0718538..ff2553be7 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -106,7 +106,8 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["COMP_OCN"] = case.get_value("COMP_OCN") config["COMP_ROF"] = case.get_value("COMP_ROF") config["COMP_WAV"] = case.get_value("COMP_WAV") - + config["CAMDEV"] = "True" if "CAM%DEV" in case.get_value("COMPSET") else "False" + if ( ( case.get_value("COMP_ROF") == "mosart" diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 36c230342..3e4d6bf6b 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -954,7 +954,8 @@ add a wind gustiness factor - .false. + .true. + .false.