From 646ad20b2fee10bf5543d39b86d4a0707b3d294b Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 3 Nov 2021 18:50:13 -0600 Subject: [PATCH 001/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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/430] 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 fd65403a201c5a907e9d5794e91a18ec714790c3 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 29 Sep 2023 14:03:26 -0600 Subject: [PATCH 378/430] update for se scm --- cesm/driver/esm.F90 | 49 ++++++++++++++++++++++++++++++++------------- 1 file changed, 35 insertions(+), 14 deletions(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index b5207955a..605d01a34 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -1224,13 +1224,17 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) real (r8), allocatable :: lats(:) ! temporary real (r8), allocatable :: lons(:) ! temporary real (r8), allocatable :: pos_lons(:) ! temporary + real (r8), allocatable :: pos_lats(:) ! temporary + real (r8), allocatable :: cols(:) ! temporary real (r8), allocatable :: glob_grid(:,:) ! temporary real (r8) :: pos_scol_lon ! temporary + real (r8) :: pos_scol_lat ! temporary real (r8) :: scol_data(1) integer :: iscol_data(1) integer :: petcount character(len=CL) :: cvalue character(len=*), parameter :: subname= ' (esm_get_single_column_attributes) ' + logical :: unstructured = .false. !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1324,7 +1328,15 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) if (status /= nf90_noerr) call shr_sys_abort (subname//' inq_varid frac') ! Read in domain file for single column - allocate(lats(nj)) + ! Check for unstructured data ni>1 and nj==1 + if (ni.gt.1 .and. nj == 1) unstructured=.true. + + if (unstructured) then + allocate(lats(ni)) + allocate(pos_lats(ni)) + else + allocate(lats(nj)) + end if allocate(lons(ni)) allocate(pos_lons(ni)) allocate(glob_grid(ni,nj)) @@ -1334,28 +1346,37 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) count3=(/ni,nj,1/) status = nf90_get_var(ncid, varid_xc, glob_grid, start3, count3) if (status /= nf90_noerr) call shr_sys_abort (subname//' get_var xc') - do i = 1,ni - lons(i) = glob_grid(i,1) - end do + lons(1:ni) = glob_grid(1:ni,1) status = nf90_get_var(ncid, varid_yc, glob_grid, start3, count3) if (status /= nf90_noerr) call shr_sys_abort (subname//' get_var yc') - do j = 1,nj - lats(j) = glob_grid(1,j) - end do - + if (unstructured) then + lats(1:ni) = glob_grid(1:ni,1) + else + lats(1:nj) = glob_grid(1,1:nj) + end if ! 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 - pos_lons(:) = mod(lons(:) + 360._r8, 360._r8) - pos_scol_lon = mod(scol_lon + 360._r8, 360._r8) - start(1) = (MINLOC(abs(pos_lons - pos_scol_lon), dim=1)) - start(2) = (MINLOC(abs(lats -scol_lat ), dim=1)) - + if (unstructured) then + allocate(cols(ni)) + pos_lons(:) = mod(lons(:) + 360._r8, 360._r8) + pos_scol_lon = mod(scol_lon + 360._r8, 360._r8) + pos_lats(:) = lats(:) + 90._r8 + pos_scol_lat = scol_lat + 90._r8 + cols=abs(pos_lons - pos_scol_lon)+abs(pos_lats - pos_scol_lat) + start(1) = MINLOC(cols, dim=1) + start(2) = 1 + deallocate(cols) + else + pos_lons(:) = mod(lons(:) + 360._r8, 360._r8) + pos_scol_lon = mod(scol_lon + 360._r8, 360._r8) + start(1) = (MINLOC(abs(pos_lons - pos_scol_lon), dim=1)) + start(2) = (MINLOC(abs(lats -scol_lat ), dim=1)) + end if deallocate(lats) deallocate(lons) deallocate(pos_lons) deallocate(glob_grid) - ! read in value of nearest neighbor lon and RESET scol_lon and scol_lat ! also get area of gridcell, mask and frac status = nf90_get_var(ncid, varid_xc, scol_lon, start) From 65aeefb34ea5d3aefba759c500a67ea6592d3153 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 10 Oct 2023 13:42:12 -0600 Subject: [PATCH 379/430] 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 380/430] 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 381/430] 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 d86f4056d24e2243ef0d9148d92839cb636cfd22 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Wed, 25 Oct 2023 14:31:51 -0600 Subject: [PATCH 382/430] initial work for inline cdeps --- mediator/med.F90 | 16 ++++++++ mediator/med_phases_cdeps_mod.F90 | 68 +++++++++++++++++++++++++++++++ 2 files changed, 84 insertions(+) create mode 100644 mediator/med_phases_cdeps_mod.F90 diff --git a/mediator/med.F90 b/mediator/med.F90 index 9bb936f60..31f67486a 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -123,6 +123,9 @@ subroutine SetServices(gcomp, rc) use med_diag_mod , only: med_phases_diag_ice_ice2med, med_phases_diag_ice_med2ice use med_fraction_mod , only: med_fraction_init, med_fraction_set use med_phases_profile_mod , only: med_phases_profile +#ifdef CDEPS_INLINE + use med_phases_cdeps_mod , only: med_phases_cdeps_run +#endif ! input/output variables type(ESMF_GridComp) :: gcomp @@ -505,6 +508,19 @@ subroutine SetServices(gcomp, rc) specPhaselabel="med_phases_diag_print", specRoutine=NUOPC_NoOp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return +#ifdef CDEPS_INLINE + !------------------ + ! phase routine for cdeps inline capabilty + !------------------ + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_cdeps_run"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_cdeps_run", specRoutine=med_phases_cdeps_run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return +#endif + !------------------ ! attach specializing method(s) ! -> NUOPC specializes by default --->>> first need to remove the default diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 new file mode 100644 index 000000000..86bf8c0ee --- /dev/null +++ b/mediator/med_phases_cdeps_mod.F90 @@ -0,0 +1,68 @@ +module med_phases_cdeps_mod + + use ESMF, only: ESMF_GridComp + use ESMF, only: ESMF_LogWrite + use ESMF, only: ESMF_SUCCESS, ESMF_LOGMSG_INFO + + use dshr_strdata_mod, only: shr_strdata_type + use dshr_strdata_mod, only: shr_strdata_init_from_inline + use perf_mod , only: t_startf, t_stopf + + implicit none + private + + !-------------------------------------------------------------------------- + ! Public interf aces + !-------------------------------------------------------------------------- + + public med_phases_cdeps_run + + !-------------------------------------------------------------------------- + ! Private interfaces + !-------------------------------------------------------------------------- + + + + !-------------------------------------------------------------------------- + ! Private data + !-------------------------------------------------------------------------- + + + + character(*),parameter :: u_FILE_u = __FILE__ + +!============================================================================ +contains +!============================================================================ + + subroutine med_phases_cdeps_run(gcomp, rc) + + !------------------------------------------------------------------------ + ! Use CDEPS inline capability to read in data + !------------------------------------------------------------------------ + + use ESMF, only : ESMF_GridComp + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + character(len=*) , parameter :: subname='(med_phases_cdeps_run)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + !if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + !endif + + + !if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + !endif + call t_stopf('MED:'//subname) + + end subroutine med_phases_cdeps_run + +end module med_phases_cdeps_mod From 5510ad7c3e68bf3cf08ec8b279618f793e0b9b85 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 26 Oct 2023 23:59:07 -0600 Subject: [PATCH 383/430] more work for cdeps inline --- mediator/med_internalstate_mod.F90 | 9 +- mediator/med_phases_cdeps_mod.F90 | 188 ++++++++++++++++++++++++++--- 2 files changed, 174 insertions(+), 23 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 66e2eb1db..9aceac49b 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -147,10 +147,11 @@ module med_internalstate_mod ! 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) , 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 + 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 + type(ESMF_FieldBundle) , pointer :: FBExpInline(:) ! Export data coming from CDEPS inline for various components, on their grid ! Mediator field bundles for ocean albedo type(ESMF_FieldBundle) :: FBMed_ocnalb_o ! Ocn albedo on ocn grid diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index 86bf8c0ee..900e0aac9 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -1,33 +1,61 @@ module med_phases_cdeps_mod - use ESMF, only: ESMF_GridComp + use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_Time, ESMF_TimeGet + use ESMF, only: ESMF_Mesh + use ESMF, only: ESMF_GridComp, ESMF_GridCompGet use ESMF, only: ESMF_LogWrite + use ESMF, only: ESMF_Field, ESMF_FieldGet + use ESMF, only: ESMF_FieldBundleGet + use ESMF, only: ESMF_StateIsCreated + use ESMF, only: ESMF_GridCompGetInternalState use ESMF, only: ESMF_SUCCESS, ESMF_LOGMSG_INFO - use dshr_strdata_mod, only: shr_strdata_type - use dshr_strdata_mod, only: shr_strdata_init_from_inline - use perf_mod , only: t_startf, t_stopf + use med_internalstate_mod, only: InternalState + use med_internalstate_mod, only: compname, compatm, compocn + use perf_mod , only: t_startf, t_stopf + use med_kind_mod , only: cl => shr_kind_cl + use med_kind_mod , only: 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_methods_mod , only: med_methods_FB_FldChk + use med_methods_mod , only: med_methods_FB_getFieldN + use med_methods_mod , only: FB_init_pointer => med_methods_FB_Init_pointer + + use dshr_strdata_mod , only: shr_strdata_type + use dshr_strdata_mod , only: shr_strdata_init_from_inline + use dshr_strdata_mod , only: shr_strdata_advance implicit none private !-------------------------------------------------------------------------- - ! Public interf aces + ! Public interfaces !-------------------------------------------------------------------------- public med_phases_cdeps_run - !-------------------------------------------------------------------------- - ! Private interfaces - !-------------------------------------------------------------------------- - - - !-------------------------------------------------------------------------- ! Private data !-------------------------------------------------------------------------- - + type config + integer :: year_first + integer :: year_last + integer :: year_align + integer :: offset + real(r8) :: dtlimit + character(len=cl) :: mesh_filename + character(len=cl), allocatable :: data_filename(:) + character(len=cl), allocatable :: fld_list(:) + character(len=cl), allocatable :: fld_list_model(:) + character(len=cl) :: mapalgo + character(len=cl) :: taxmode + character(len=cl) :: tintalgo + character(len=cl) :: name + end type config + + type(config), allocatable :: stream(:) ! stream configuration + type(shr_strdata_type), allocatable :: sdat(:) ! input data stream character(*),parameter :: u_FILE_u = __FILE__ @@ -47,22 +75,144 @@ subroutine med_phases_cdeps_run(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - character(len=*) , parameter :: subname='(med_phases_cdeps_run)' + ! local variables + type(InternalState) :: is_local + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currTime + type(ESMF_Mesh) :: meshdst + type(ESMF_Field) :: flddst + integer :: n1, n2, item, localPet + integer :: curr_ymd, sec + integer :: year, month, day, hour, minute, second + logical, save :: first_time = .true. + character(len=*), parameter :: subname = '(med_phases_cdeps_run)' !--------------------------------------- rc = ESMF_SUCCESS call t_startf('MED:'//subname) - !if (dbug_flag > 5) then + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - !endif - - - !if (dbug_flag > 5) then + endif + + ! Get the internal state from gcomp + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Query component + call ESMF_GridCompGet(gcomp, clock=clock, localPet=localPet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Initialize cdeps inline + if (first_time) then + ! Set components in both side + ! TODO: This needs to be dynamic and read from hconfig file + n1 = compocn + n2 = compatm + + ! Allocate data structures + ! TODO: The number of stream will come from config file + if (.not. allocated(sdat)) allocate(sdat(1)) + if (.not. allocated(stream)) allocate(stream(1)) + + ! Check coupling direction + if (n1 /= n2) then + if (is_local%wrap%med_coupling_active(n1,n2)) then + ! Get destination field + call med_methods_FB_getFieldN(is_local%wrap%FBImp(n2,n2), 1, flddst, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Get destination field mesh + call ESMF_FieldGet(flddst, mesh=meshdst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Initialize cdeps inline + call shr_strdata_init_from_inline(sdat(1), my_task = localPet, logunit = 6, & + compname = trim(compname(n2)), & + model_clock = clock, model_mesh = meshdst, & + stream_meshfile = 'INPUT_DATA/ESMFmesh.nc', & + stream_filenames = (/ 'INPUT_DATA/tsfc_fv3grid_202318612_sub.nc' /), & + stream_yearFirst = 2023, & + stream_yearLast = 2023, & + stream_yearAlign = 2023, & + stream_fldlistFile = (/ 'twsfc' /), & + stream_fldListModel = (/ 'twsfc' /), & + stream_lev_dimname = 'null', & + stream_mapalgo = 'bilinear', & + stream_offset = 0, & + stream_taxmode = 'cycle', & + stream_dtlimit = 1.5d0, & + stream_tintalgo = 'linear', & + stream_name = 'fvcom great lakes', & + rc = rc) + + ! Create FB to store data + if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n2), rc=rc)) then + call FB_init_pointer(is_local%wrap%NStateExp(n2), is_local%wrap%FBExpInline(n2), & + is_local%wrap%flds_scalar_name, name='FBExpInline'//trim(compname(n2)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end if + end if + + ! Set flag to false + first_time = .false. + end if + + ! Get current time + call ESMF_ClockGet(clock, currTime=currTime, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Query current time + call ESMF_TimeGet(currTime, yy=year, mm=month, dd=day, h=hour, m=minute, s=second, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + curr_ymd = abs(year)*10000+month*100+day + sec = hour*3600+minute*60+second + + ! Run inline cdeps and read data + n1 = compocn + n2 = compatm + + if (n1 /= n2) then + if (is_local%wrap%med_coupling_active(n1,n2)) then + call shr_strdata_advance(sdat(1), ymd=curr_ymd, tod=sec, logunit=6, istr=trim(compname(n2)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Loop over fields provided by CDEPS inline and add it to FB + do item = 1, 1 !size(config%stream_fldListFile) + ! Get field + !call ESMF_FieldBundleGet(sdat(1)%pstrm(1)%fldbun_model, fieldName=trim(config%stream_fldListFile(item)), field=flddst, rc=rc) + call ESMF_FieldBundleGet(sdat(1)%pstrm(1)%fldbun_model, fieldName='So_t', field=flddst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Check FB for field + !if (med_methods_FB_FldChk(is_local%wrap%FBExpInline(n2), trim(config%stream_fldListFile(item)))) then + ! + !end if + + end do + end if + end if + + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - !endif + endif call t_stopf('MED:'//subname) end subroutine med_phases_cdeps_run + !========================================================================== + + subroutine read_config() + + !------------------------------------------------------------------------ + ! Read YAML based Hconfig file + !------------------------------------------------------------------------ + + + + end subroutine read_config + end module med_phases_cdeps_mod From 6438f3dc38d05f9e5bf619a0d5f59b0c5bf953bf Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 2 Nov 2023 11:36:59 -0600 Subject: [PATCH 384/430] more work for inline --- mediator/med_methods_mod.F90 | 67 ++++++++++++++ mediator/med_phases_cdeps_mod.F90 | 139 ++++++++++++++++++------------ 2 files changed, 150 insertions(+), 56 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 649c9c511..a62af95b7 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -44,6 +44,7 @@ module med_methods_mod public med_methods_FB_init_pointer public med_methods_FB_reset public med_methods_FB_diagnose + public med_methods_FB_write public med_methods_FB_FldChk public med_methods_FB_GetFldPtr public med_methods_FB_getNameN @@ -999,6 +1000,72 @@ subroutine med_methods_FB_diagnose(FB, string, rc) end subroutine med_methods_FB_diagnose !----------------------------------------------------------------------------- + + subroutine med_methods_FB_write(FB, string, rc) + ! ---------------------------------------------- + ! Diagnose status of FB + ! ---------------------------------------------- + + use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleGet + use ESMF, only : ESMF_Field, ESMF_FieldGet + use ESMF, only : ESMF_FieldWriteVTK + + type(ESMF_FieldBundle) , intent(inout) :: FB + character(len=*) , intent(in), optional :: string + integer , intent(out) :: rc + + ! local variables + integer :: n + integer :: fieldCount, lrank + character(ESMF_MAXSTR), pointer :: lfieldnamelist(:) + character(len=CL) :: lstring + type(ESMF_Field) :: lfield + character(len=*), parameter :: subname='(med_methods_FB_write)' + ! ---------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + rc = ESMF_SUCCESS + + lstring = '' + if (present(string)) then + lstring = trim(string)//'_' + endif + + ! Determine number of fields in field bundle and allocate memory for lfieldnamelist + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + + ! Get the fields in the field bundle + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! For each field in the bundle, get its memory location and print out the field + do n = 1, fieldCount + call ESMF_FieldBundleGet(FB, fieldName=trim(lfieldnamelist(n)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(lfield, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 1) then + call ESMF_FieldWriteVTK(lfield, trim(lstring)//trim(lfieldnamelist(n)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + end do + + ! Deallocate memory + deallocate(lfieldnamelist) + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + + end subroutine med_methods_FB_write + + !----------------------------------------------------------------------------- #ifdef DIAGNOSE subroutine med_methods_Array_diagnose(array, string, rc) diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index 900e0aac9..f6f4bb736 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -11,6 +11,7 @@ module med_phases_cdeps_mod use ESMF, only: ESMF_SUCCESS, ESMF_LOGMSG_INFO use med_internalstate_mod, only: InternalState + use med_internalstate_mod, only: logunit use med_internalstate_mod, only: compname, compatm, compocn use perf_mod , only: t_startf, t_stopf use med_kind_mod , only: cl => shr_kind_cl @@ -20,6 +21,8 @@ module med_phases_cdeps_mod use med_methods_mod , only: med_methods_FB_FldChk use med_methods_mod , only: med_methods_FB_getFieldN use med_methods_mod , only: FB_init_pointer => med_methods_FB_Init_pointer + use med_methods_mod , only: FB_diagnose => med_methods_FB_diagnose + use med_methods_mod , only: FB_write => med_methods_FB_write use dshr_strdata_mod , only: shr_strdata_type use dshr_strdata_mod , only: shr_strdata_init_from_inline @@ -85,15 +88,16 @@ subroutine med_phases_cdeps_run(gcomp, rc) integer :: curr_ymd, sec integer :: year, month, day, hour, minute, second logical, save :: first_time = .true. + character(len=cl) :: prefix character(len=*), parameter :: subname = '(med_phases_cdeps_run)' !--------------------------------------- rc = ESMF_SUCCESS call t_startf('MED:'//subname) - if (dbug_flag > 5) then + !if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - endif + !endif ! Get the internal state from gcomp nullify(is_local%wrap) @@ -113,8 +117,8 @@ subroutine med_phases_cdeps_run(gcomp, rc) ! Allocate data structures ! TODO: The number of stream will come from config file - if (.not. allocated(sdat)) allocate(sdat(1)) - if (.not. allocated(stream)) allocate(stream(1)) + if (.not. allocated(sdat)) allocate(sdat(3)) + if (.not. allocated(stream)) allocate(stream(3)) ! Check coupling direction if (n1 /= n2) then @@ -128,31 +132,38 @@ subroutine med_phases_cdeps_run(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Initialize cdeps inline - call shr_strdata_init_from_inline(sdat(1), my_task = localPet, logunit = 6, & + print*, "here 1 "//trim(compname(n2)) + call shr_strdata_init_from_inline(sdat(1), my_task = localPet, logunit = logunit, & compname = trim(compname(n2)), & model_clock = clock, model_mesh = meshdst, & - stream_meshfile = 'INPUT_DATA/ESMFmesh.nc', & - stream_filenames = (/ 'INPUT_DATA/tsfc_fv3grid_202318612_sub.nc' /), & - stream_yearFirst = 2023, & - stream_yearLast = 2023, & - stream_yearAlign = 2023, & - stream_fldlistFile = (/ 'twsfc' /), & - stream_fldListModel = (/ 'twsfc' /), & + !stream_meshfile = 'INPUT_CDEPS/sst_mesh.nc', & + !stream_filenames = (/ 'INPUT_CDEPS/sst20190829_new.nc' /), & + stream_meshfile = 'INPUT_CDEPS/mesh.nc', & + stream_filenames = (/ 'INPUT_CDEPS/sst.day.mean.2019.nc' /), & + stream_yearFirst = 2019, & + stream_yearLast = 2019, & + stream_yearAlign = 2019, & + !stream_fldlistFile = (/ 'TMPSFC' /), & + stream_fldlistFile = (/ 'sst' /), & + stream_fldListModel = (/ 'So_t' /), & stream_lev_dimname = 'null', & stream_mapalgo = 'bilinear', & stream_offset = 0, & - stream_taxmode = 'cycle', & + stream_taxmode = 'limit', & stream_dtlimit = 1.5d0, & stream_tintalgo = 'linear', & - stream_name = 'fvcom great lakes', & + stream_name = 'sst', & rc = rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + print*, "here 2" + ! Create FB to store data - if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n2), rc=rc)) then - call FB_init_pointer(is_local%wrap%NStateExp(n2), is_local%wrap%FBExpInline(n2), & - is_local%wrap%flds_scalar_name, name='FBExpInline'//trim(compname(n2)), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + !if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n2), rc=rc)) then + ! call FB_init_pointer(is_local%wrap%NStateExp(n2), is_local%wrap%FBExpInline(n2), & + ! is_local%wrap%flds_scalar_name, name='FBExpInline'//trim(compname(n2)), rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + !end if end if end if @@ -161,44 +172,60 @@ subroutine med_phases_cdeps_run(gcomp, rc) end if ! Get current time - call ESMF_ClockGet(clock, currTime=currTime, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Query current time - call ESMF_TimeGet(currTime, yy=year, mm=month, dd=day, h=hour, m=minute, s=second, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - curr_ymd = abs(year)*10000+month*100+day - sec = hour*3600+minute*60+second - - ! Run inline cdeps and read data - n1 = compocn - n2 = compatm - - if (n1 /= n2) then - if (is_local%wrap%med_coupling_active(n1,n2)) then - call shr_strdata_advance(sdat(1), ymd=curr_ymd, tod=sec, logunit=6, istr=trim(compname(n2)), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Loop over fields provided by CDEPS inline and add it to FB - do item = 1, 1 !size(config%stream_fldListFile) - ! Get field - !call ESMF_FieldBundleGet(sdat(1)%pstrm(1)%fldbun_model, fieldName=trim(config%stream_fldListFile(item)), field=flddst, rc=rc) - call ESMF_FieldBundleGet(sdat(1)%pstrm(1)%fldbun_model, fieldName='So_t', field=flddst, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Check FB for field - !if (med_methods_FB_FldChk(is_local%wrap%FBExpInline(n2), trim(config%stream_fldListFile(item)))) then - ! - !end if - - end do - end if - end if - - if (dbug_flag > 5) then + !call ESMF_ClockGet(clock, currTime=currTime, rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return + + !! Query current time + !call ESMF_TimeGet(currTime, yy=year, mm=month, dd=day, h=hour, m=minute, s=second, rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return + + !curr_ymd = abs(year)*10000+month*100+day + !sec = hour*3600+minute*60+second + ! print*, "here 3" + + !! Run inline cdeps and read data + !n1 = compocn + !n2 = compatm + + !if (n1 /= n2) then + ! if (is_local%wrap%med_coupling_active(n1,n2)) then + ! print*, "here 4" + ! ! Run cdeps inline adn read data + ! call shr_strdata_advance(sdat(1), ymd=curr_ymd, tod=sec, logunit=6, istr=trim(compname(n2)), rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! ! Check FB + ! call FB_diagnose(sdat(1)%pstrm(1)%fldbun_model, trim(subname)//": sst", rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! ! Write FB for debugging + ! !if (dbug_flag > 10) then + ! write(prefix, fmt='(a,i4,a1,i2.2,a1,i2.2,a1,i5.5)') "FBExpInline", & + ! year, '-', month, '-', day, '-', sec + ! call FB_write(sdat(1)%pstrm(1)%fldbun_model, prefix, rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + ! !end if + + + ! ! Loop over fields provided by CDEPS inline and add it to FB + ! !do item = 1, 1 !size(config%stream_fldListFile) + ! ! Get field + ! !call ESMF_FieldBundleGet(sdat(1)%pstrm(1)%fldbun_model, fieldName=trim(config%stream_fldListFile(item)), field=flddst, rc=rc) + ! ! call ESMF_FieldBundleGet(sdat(1)%pstrm(1)%fldbun_model, fieldName='So_t', field=flddst, rc=rc) + ! ! if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! ! Check FB for field + ! !if (med_methods_FB_FldChk(is_local%wrap%FBExpInline(n2), trim(config%stream_fldListFile(item)))) then + ! ! + ! !end if + + ! !end do + ! end if + !end if + + !if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - endif + !endif call t_stopf('MED:'//subname) end subroutine med_phases_cdeps_run From bcee457fb56ca7e218e52cca1df848fb18b06fa8 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Mon, 6 Nov 2023 23:45:22 -0600 Subject: [PATCH 385/430] use esmf config file to get stream information --- mediator/med_internalstate_mod.F90 | 8 +- mediator/med_methods_mod.F90 | 4 +- mediator/med_phases_cdeps_mod.F90 | 312 ++++++++++++++++------------- 3 files changed, 178 insertions(+), 146 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 9aceac49b..fd00d27b7 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -121,6 +121,7 @@ module med_internalstate_mod ! Present/allowed coupling/active coupling logical flags logical, pointer :: comp_present(:) ! comp present flag logical, pointer :: med_coupling_active(:,:) ! computes the active coupling + logical, pointer :: med_bg_fill_active(:,:) ! use cdeps for background fill integer :: num_icesheets ! obtained from attribute logical :: ocn2glc_coupling = .false. ! obtained from attribute logical :: lnd2glc_coupling = .false. @@ -151,7 +152,7 @@ module med_internalstate_mod 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 - type(ESMF_FieldBundle) , pointer :: FBExpInline(:) ! Export data coming from CDEPS inline for various components, on their grid + type(ESMF_FieldBundle) , pointer :: FBExpIn(:) ! Export data for various components, on their grid, CDEPS inline ! Mediator field bundles for ocean albedo type(ESMF_FieldBundle) :: FBMed_ocnalb_o ! Ocn albedo on ocn grid @@ -304,6 +305,7 @@ subroutine med_internalstate_init(gcomp, rc) ! Allocate memory now that ncomps is determined allocate(is_local%wrap%med_coupling_active(ncomps,ncomps)) + allocate(is_local%wrap%med_bg_fill_active(ncomps,ncomps)) allocate(is_local%wrap%nx(ncomps)) allocate(is_local%wrap%ny(ncomps)) allocate(is_local%wrap%NStateImp(ncomps)) @@ -365,6 +367,10 @@ subroutine med_internalstate_init(gcomp, rc) write(msgString,*) trim(subname)//': Mediator dststatus_print is ',dststatus_print call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + ! Initialize flag for background fill + is_local%wrap%med_bg_fill_active(:,:) = .false. + is_local%wrap%med_bg_fill_active(compocn,compatm) = .true. + end subroutine med_internalstate_init !===================================================================== diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index a62af95b7..d4bdab2a7 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -1028,7 +1028,7 @@ subroutine med_methods_FB_write(FB, string, rc) lstring = '' if (present(string)) then - lstring = trim(string)//'_' + lstring = trim(string) endif ! Determine number of fields in field bundle and allocate memory for lfieldnamelist @@ -1049,7 +1049,7 @@ subroutine med_methods_FB_write(FB, string, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (lrank == 1) then - call ESMF_FieldWriteVTK(lfield, trim(lstring)//trim(lfieldnamelist(n)), rc=rc) + call ESMF_FieldWriteVTK(lfield, trim(lfieldnamelist(n))//'_'//trim(lstring), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index f6f4bb736..b50809196 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -5,28 +5,31 @@ module med_phases_cdeps_mod use ESMF, only: ESMF_GridComp, ESMF_GridCompGet use ESMF, only: ESMF_LogWrite use ESMF, only: ESMF_Field, ESMF_FieldGet - use ESMF, only: ESMF_FieldBundleGet - use ESMF, only: ESMF_StateIsCreated + use ESMF, only: ESMF_FieldBundleGet, ESMF_FieldBundleIsCreated + use ESMF, only: ESMF_FieldBundleCreate use ESMF, only: ESMF_GridCompGetInternalState use ESMF, only: ESMF_SUCCESS, ESMF_LOGMSG_INFO use med_internalstate_mod, only: InternalState - use med_internalstate_mod, only: logunit - use med_internalstate_mod, only: compname, compatm, compocn + use med_internalstate_mod, only: logunit, maintask + use med_internalstate_mod, only: ncomps, compname, compatm, compocn use perf_mod , only: t_startf, t_stopf use med_kind_mod , only: cl => shr_kind_cl use med_kind_mod , only: 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_methods_mod , only: med_methods_FB_FldChk - use med_methods_mod , only: med_methods_FB_getFieldN - use med_methods_mod , only: FB_init_pointer => med_methods_FB_Init_pointer + use med_methods_mod , only: FB_FldChk => med_methods_FB_FldChk + use med_methods_mod , only: FB_getFieldN => med_methods_FB_getFieldN + use med_methods_mod , only: FB_getNumflds => med_methods_FB_getNumflds + use med_methods_mod , only: FB_init => med_methods_FB_Init use med_methods_mod , only: FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only: FB_write => med_methods_FB_write + use dshr_mod , only: dshr_pio_init use dshr_strdata_mod , only: shr_strdata_type use dshr_strdata_mod , only: shr_strdata_init_from_inline use dshr_strdata_mod , only: shr_strdata_advance + use dshr_stream_mod , only: shr_stream_init_from_esmfconfig implicit none private @@ -57,8 +60,8 @@ module med_phases_cdeps_mod character(len=cl) :: name end type config - type(config), allocatable :: stream(:) ! stream configuration - type(shr_strdata_type), allocatable :: sdat(:) ! input data stream + type(config) :: stream ! stream configuration + type(shr_strdata_type), allocatable :: sdat(:,:) ! input data stream character(*),parameter :: u_FILE_u = __FILE__ @@ -79,25 +82,27 @@ subroutine med_phases_cdeps_run(gcomp, rc) integer, intent(out) :: rc ! local variables - type(InternalState) :: is_local - type(ESMF_Clock) :: clock - type(ESMF_Time) :: currTime - type(ESMF_Mesh) :: meshdst - type(ESMF_Field) :: flddst - integer :: n1, n2, item, localPet - integer :: curr_ymd, sec - integer :: year, month, day, hour, minute, second - logical, save :: first_time = .true. - character(len=cl) :: prefix - character(len=*), parameter :: subname = '(med_phases_cdeps_run)' + type(InternalState) :: is_local + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currTime + type(ESMF_Mesh) :: meshdst + type(ESMF_Field) :: flddst + integer :: i, j, k, l, nflds, streamid + integer :: n1, n2, item, nstreams, localPet + integer :: curr_ymd, sec + integer :: year, month, day, hour, minute, second + logical :: isCreated + logical, save :: first_time = .true. + character(len=cl), allocatable :: fileList(:), varList(:,:) + character(len=cl) :: streamfilename, suffix, fldname + type(shr_strdata_type) :: sdat_config + character(len=*), parameter :: subname = '(med_phases_cdeps_run)' !--------------------------------------- rc = ESMF_SUCCESS call t_startf('MED:'//subname) - !if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - !endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) ! Get the internal state from gcomp nullify(is_local%wrap) @@ -108,138 +113,159 @@ subroutine med_phases_cdeps_run(gcomp, rc) call ESMF_GridCompGet(gcomp, clock=clock, localPet=localPet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Initialize sdat streams + if (.not. allocated(sdat)) allocate(sdat(ncomps,ncomps)) + sdat(:,:)%mainproc = (localPet == 0) + ! Initialize cdeps inline if (first_time) then - ! Set components in both side - ! TODO: This needs to be dynamic and read from hconfig file - n1 = compocn - n2 = compatm - - ! Allocate data structures - ! TODO: The number of stream will come from config file - if (.not. allocated(sdat)) allocate(sdat(3)) - if (.not. allocated(stream)) allocate(stream(3)) - - ! Check coupling direction - if (n1 /= n2) then - if (is_local%wrap%med_coupling_active(n1,n2)) then - ! Get destination field - call med_methods_FB_getFieldN(is_local%wrap%FBImp(n2,n2), 1, flddst, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Get destination field mesh - call ESMF_FieldGet(flddst, mesh=meshdst, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Initialize cdeps inline - print*, "here 1 "//trim(compname(n2)) - call shr_strdata_init_from_inline(sdat(1), my_task = localPet, logunit = logunit, & - compname = trim(compname(n2)), & - model_clock = clock, model_mesh = meshdst, & - !stream_meshfile = 'INPUT_CDEPS/sst_mesh.nc', & - !stream_filenames = (/ 'INPUT_CDEPS/sst20190829_new.nc' /), & - stream_meshfile = 'INPUT_CDEPS/mesh.nc', & - stream_filenames = (/ 'INPUT_CDEPS/sst.day.mean.2019.nc' /), & - stream_yearFirst = 2019, & - stream_yearLast = 2019, & - stream_yearAlign = 2019, & - !stream_fldlistFile = (/ 'TMPSFC' /), & - stream_fldlistFile = (/ 'sst' /), & - stream_fldListModel = (/ 'So_t' /), & - stream_lev_dimname = 'null', & - stream_mapalgo = 'bilinear', & - stream_offset = 0, & - stream_taxmode = 'limit', & - stream_dtlimit = 1.5d0, & - stream_tintalgo = 'linear', & - stream_name = 'sst', & - rc = rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - print*, "here 2" - - - ! Create FB to store data - !if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n2), rc=rc)) then - ! call FB_init_pointer(is_local%wrap%NStateExp(n2), is_local%wrap%FBExpInline(n2), & - ! is_local%wrap%flds_scalar_name, name='FBExpInline'//trim(compname(n2)), rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - !end if - end if - end if + ! Init PIO + call dshr_pio_init(gcomp, sdat_config, logunit, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Read stream configuration file + ! TODO: At this point it only suports ESMF config format (XML?) + streamfilename = 'stream.config' + call shr_stream_init_from_esmfconfig(streamfilename, sdat_config%stream, logunit, & + sdat_config%pio_subsystem, sdat_config%io_type, sdat_config%io_format, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Get number of streams + nstreams = size(sdat_config%stream) + + ! Loop over coupling directions and try to find field match in given streams + do n1 = 1, ncomps + do n2 = 1, ncomps + ! Check for coupling direction and background fill + if (n1 /= n2 .and. is_local%wrap%med_coupling_active(n1,n2) .and. is_local%wrap%med_bg_fill_active(n1,n2)) then + ! Get number of fields + call FB_getNumflds(is_local%wrap%FBImp(n1,n2), trim(subname), nflds, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Loop over fields and try to find it in the given stream + do i = 1, nflds + ! Query destination field + call FB_getFieldN(is_local%wrap%FBImp(n1,n2), i, flddst, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Query destination field name and its mesh + call ESMF_FieldGet(flddst, mesh=meshdst, name=fldname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Check if any field in FB in the given stream + ! NOTE: Single stream could provide multiple fields !!! + streamid = 0 + do j = 1, nstreams + do k = 1, sdat_config%stream(j)%nvars + if (trim(sdat_config%stream(j)%varlist(k)%nameinmodel) == trim(fldname)) then + streamid = j + end if + end do + end do + + ! If match is found, then initialize cdeps inline for the stream + if (streamid /= 0) then + ! Debug print + if (maintask) then + write(logunit,'(a,i)') trim(subname)//": "//trim(fldname)//" is found in stream ", streamid + end if + + ! Allocate temporary variable to store file names in the stream + allocate(fileList(sdat_config%stream(streamid)%nfiles)) + allocate(varList(sdat_config%stream(streamid)%nvars,2)) + + ! Fill file abd variable lists with data + do l = 1, sdat_config%stream(streamid)%nfiles + fileList(l) = trim(sdat_config%stream(streamid)%file(l)%name) + if (maintask) write(logunit,'(a,i2,x,a)') trim(subname)//": file ", l, trim(fileList(l)) + end do + do l = 1, sdat_config%stream(streamid)%nvars + varList(l,1) = trim(sdat_config%stream(streamid)%varlist(l)%nameinfile) + varList(l,2) = trim(sdat_config%stream(streamid)%varlist(l)%nameinmodel) + if (maintask) write(logunit,'(a,i2,x,a)') trim(subname)//": variable ", l, trim(varList(l,1))//" -> "//trim(varList(l,2)) + end do + + ! Set PIO related variables + sdat(n1,n2)%pio_subsystem => sdat_config%pio_subsystem + sdat(n1,n2)%io_type = sdat_config%io_type + sdat(n1,n2)%io_format = sdat_config%io_format + + ! Init stream + call shr_strdata_init_from_inline(sdat(n1,n2), my_task=localPet, logunit=logunit, & + compname = 'cmeps', model_clock=clock, model_mesh=meshdst, & + stream_meshfile=trim(sdat_config%stream(streamid)%meshfile), & + stream_filenames=fileList, & + stream_yearFirst=sdat_config%stream(streamid)%yearFirst, & + stream_yearLast=sdat_config%stream(streamid)%yearLast, & + stream_yearAlign=sdat_config%stream(streamid)%yearAlign, & + stream_fldlistFile=varList(:,1), & + stream_fldListModel=varList(:,2), & + stream_lev_dimname=trim(sdat_config%stream(streamid)%lev_dimname), & + stream_mapalgo=trim(sdat_config%stream(streamid)%mapalgo), & + stream_offset=sdat_config%stream(streamid)%offset, & + stream_taxmode=trim(sdat_config%stream(streamid)%taxmode), & + stream_dtlimit=sdat_config%stream(streamid)%dtlimit, & + stream_tintalgo=trim(sdat_config%stream(streamid)%tInterpAlgo), & + stream_name=trim(compname(n1))//'_'//trim(compname(n2)), & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Remove temporary variables + deallocate(fileList) + deallocate(varList) + end if + end do ! nflds + end if + end do ! n2 + end do ! n1 ! Set flag to false first_time = .false. end if ! Get current time - !call ESMF_ClockGet(clock, currTime=currTime, rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return - - !! Query current time - !call ESMF_TimeGet(currTime, yy=year, mm=month, dd=day, h=hour, m=minute, s=second, rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return - - !curr_ymd = abs(year)*10000+month*100+day - !sec = hour*3600+minute*60+second - ! print*, "here 3" - - !! Run inline cdeps and read data - !n1 = compocn - !n2 = compatm - - !if (n1 /= n2) then - ! if (is_local%wrap%med_coupling_active(n1,n2)) then - ! print*, "here 4" - ! ! Run cdeps inline adn read data - ! call shr_strdata_advance(sdat(1), ymd=curr_ymd, tod=sec, logunit=6, istr=trim(compname(n2)), rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! ! Check FB - ! call FB_diagnose(sdat(1)%pstrm(1)%fldbun_model, trim(subname)//": sst", rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! ! Write FB for debugging - ! !if (dbug_flag > 10) then - ! write(prefix, fmt='(a,i4,a1,i2.2,a1,i2.2,a1,i5.5)') "FBExpInline", & - ! year, '-', month, '-', day, '-', sec - ! call FB_write(sdat(1)%pstrm(1)%fldbun_model, prefix, rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - ! !end if - - - ! ! Loop over fields provided by CDEPS inline and add it to FB - ! !do item = 1, 1 !size(config%stream_fldListFile) - ! ! Get field - ! !call ESMF_FieldBundleGet(sdat(1)%pstrm(1)%fldbun_model, fieldName=trim(config%stream_fldListFile(item)), field=flddst, rc=rc) - ! ! call ESMF_FieldBundleGet(sdat(1)%pstrm(1)%fldbun_model, fieldName='So_t', field=flddst, rc=rc) - ! ! if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! ! Check FB for field - ! !if (med_methods_FB_FldChk(is_local%wrap%FBExpInline(n2), trim(config%stream_fldListFile(item)))) then - ! ! - ! !end if - - ! !end do - ! end if - !end if - - !if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - !endif - call t_stopf('MED:'//subname) - - end subroutine med_phases_cdeps_run - - !========================================================================== + call ESMF_ClockGet(clock, currTime=currTime, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - subroutine read_config() + ! Query current time + call ESMF_TimeGet(currTime, yy=year, mm=month, dd=day, h=hour, m=minute, s=second, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - !------------------------------------------------------------------------ - ! Read YAML based Hconfig file - !------------------------------------------------------------------------ + curr_ymd = abs(year)*10000+month*100+day + sec = hour*3600+minute*60+second + + ! Read data if stream initialized + do n1 = 1, ncomps + do n2 = 1, ncomps + if (size(sdat(n1,n2)%stream) > 0) then + ! Debug print + if (maintask) then + write(logunit,'(a,i)') trim(subname)//": read stream "//trim(compname(n1))//" -> "//trim(compname(n2)) + end if + + ! Read data + call shr_strdata_advance(sdat(n1,n2), ymd=curr_ymd, tod=sec, logunit=logunit, & + istr=trim(compname(n1))//'_'//trim(compname(n2)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Check FB + call FB_diagnose(sdat(n1,n2)%pstrm(1)%fldbun_model, & + trim(subname)//':'//trim(compname(n1))//'_'//trim(compname(n2)), rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Write FB for debugging + if (dbug_flag > 10) then + write(suffix, fmt='(i4,a1,i2.2,a1,i2.2,a1,i5.5)') year, '-', month, '-', day, '-', sec + call FB_write(sdat(n1,n2)%pstrm(1)%fldbun_model, suffix, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end if + end do + end do + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + call t_stopf('MED:'//subname) - end subroutine read_config + end subroutine med_phases_cdeps_run end module med_phases_cdeps_mod From 96c81b66a141c8e4b1c3f5ff94b106fa781a74a0 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Tue, 7 Nov 2023 00:42:20 -0600 Subject: [PATCH 386/430] more work for inline capability --- mediator/med_internalstate_mod.F90 | 1 + mediator/med_phases_cdeps_mod.F90 | 20 +++++++++++++++++--- 2 files changed, 18 insertions(+), 3 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index fd00d27b7..cdfbbfb2f 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -312,6 +312,7 @@ subroutine med_internalstate_init(gcomp, rc) allocate(is_local%wrap%NStateExp(ncomps)) allocate(is_local%wrap%FBImp(ncomps,ncomps)) allocate(is_local%wrap%FBExp(ncomps)) + allocate(is_local%wrap%FBExpIn(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)) diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index b50809196..272cefc02 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -24,6 +24,7 @@ module med_phases_cdeps_mod use med_methods_mod , only: FB_init => med_methods_FB_Init use med_methods_mod , only: FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only: FB_write => med_methods_FB_write + use med_methods_mod , only: FB_GetFldPtr => med_methods_FB_GetFldPtr use dshr_mod , only: dshr_pio_init use dshr_strdata_mod , only: shr_strdata_type @@ -91,7 +92,7 @@ subroutine med_phases_cdeps_run(gcomp, rc) integer :: n1, n2, item, nstreams, localPet integer :: curr_ymd, sec integer :: year, month, day, hour, minute, second - logical :: isCreated + logical :: found logical, save :: first_time = .true. character(len=cl), allocatable :: fileList(:), varList(:,:) character(len=cl) :: streamfilename, suffix, fldname @@ -143,6 +144,7 @@ subroutine med_phases_cdeps_run(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Loop over fields and try to find it in the given stream + found = .false. do i = 1, nflds ! Query destination field call FB_getFieldN(is_local%wrap%FBImp(n1,n2), i, flddst, rc) @@ -213,8 +215,17 @@ subroutine med_phases_cdeps_run(gcomp, rc) ! Remove temporary variables deallocate(fileList) deallocate(varList) + + ! Set flag + found = .true. end if end do ! nflds + + ! Create empty FB + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBExpIn(n2), rc=rc) .and. found) then + is_local%wrap%FBExpIn(n2) = ESMF_FieldBundleCreate(name="inline_"//trim(compname(n2)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end if end do ! n2 end do ! n1 @@ -252,11 +263,14 @@ subroutine med_phases_cdeps_run(gcomp, rc) call FB_diagnose(sdat(n1,n2)%pstrm(1)%fldbun_model, & trim(subname)//':'//trim(compname(n1))//'_'//trim(compname(n2)), rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + + ! Point FB from internal one + is_local%wrap%FBExpIn(n2) = sdat(n1,n2)%pstrm(1)%fldbun_model + ! Write FB for debugging if (dbug_flag > 10) then write(suffix, fmt='(i4,a1,i2.2,a1,i2.2,a1,i5.5)') year, '-', month, '-', day, '-', sec - call FB_write(sdat(n1,n2)%pstrm(1)%fldbun_model, suffix, rc) + call FB_write(is_local%wrap%FBExpIn(n2), suffix, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if end if From 794e6917ebfae50e6f1824c0f7dde5e4a0cc3950 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Thu, 9 Nov 2023 12:05:25 -0600 Subject: [PATCH 387/430] enabling setting source and destination mask for interpolation --- mediator/med_phases_cdeps_mod.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index 272cefc02..4c78da123 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -209,9 +209,15 @@ subroutine med_phases_cdeps_run(gcomp, rc) stream_dtlimit=sdat_config%stream(streamid)%dtlimit, & stream_tintalgo=trim(sdat_config%stream(streamid)%tInterpAlgo), & stream_name=trim(compname(n1))//'_'//trim(compname(n2)), & + stream_src_mask=sdat_config%stream(streamid)%src_mask_val, & + stream_dst_mask=sdat_config%stream(streamid)%dst_mask_val, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Print out source and destination mask used in the stream + if (maintask) write(logunit,'(a,2i2)') trim(subname)//": mask values src, dst ", & + sdat_config%stream(streamid)%src_mask_val, sdat_config%stream(streamid)%dst_mask_val + ! Remove temporary variables deallocate(fileList) deallocate(varList) From 17b127d4029b49354ade76c85ecbe7a02fd9f0e1 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Fri, 10 Nov 2023 23:54:48 -0600 Subject: [PATCH 388/430] more work for cdeps inline --- mediator/med_internalstate_mod.F90 | 6 +- mediator/med_map_mod.F90 | 171 ++++++++++++++++++++------- mediator/med_phases_cdeps_mod.F90 | 8 +- mediator/med_phases_prep_atm_mod.F90 | 1 + 4 files changed, 140 insertions(+), 46 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index cdfbbfb2f..d07923d35 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -152,7 +152,6 @@ module med_internalstate_mod 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 - type(ESMF_FieldBundle) , pointer :: FBExpIn(:) ! Export data for various components, on their grid, CDEPS inline ! Mediator field bundles for ocean albedo type(ESMF_FieldBundle) :: FBMed_ocnalb_o ! Ocn albedo on ocn grid @@ -175,6 +174,9 @@ module med_internalstate_mod ! Fractions type(ESMF_FieldBundle), pointer :: FBfrac(:) ! Fraction data for various components, on their grid + ! Data + type(ESMF_FieldBundle) , pointer :: FBData(:) ! Background data for various components, on their grid, provided by CDEPS inline + ! Accumulators for export field bundles type(ESMF_FieldBundle) :: FBExpAccumOcn ! Accumulator for Ocn export on Ocn grid integer :: ExpAccumOcnCnt = 0 ! Accumulator counter for FBExpAccumOcn @@ -312,7 +314,6 @@ subroutine med_internalstate_init(gcomp, rc) allocate(is_local%wrap%NStateExp(ncomps)) allocate(is_local%wrap%FBImp(ncomps,ncomps)) allocate(is_local%wrap%FBExp(ncomps)) - allocate(is_local%wrap%FBExpIn(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)) @@ -320,6 +321,7 @@ subroutine med_internalstate_init(gcomp, rc) 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%FBData(ncomps)) allocate(is_local%wrap%mesh_info(ncomps)) ! Determine component names diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 54bcbb154..75dc8189f 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -919,7 +919,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & end subroutine med_map_packed_field_create !================================================================================ - subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_data, routehandles, rc) + subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, packed_data, routehandles, rc) ! ----------------------------------------------- ! Do regridding via packed field bundles @@ -934,28 +934,33 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d use med_internalstate_mod , only : packed_data_type ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FBSrc - type(ESMF_FieldBundle) , intent(inout) :: FBDst - type(ESMF_Field) , intent(in) :: field_normOne(:) ! array over mapping types - type(ESMF_FieldBundle) , intent(in) :: FBFracSrc ! fraction field bundle for source - type(packed_data_type) , intent(inout) :: packed_data(:) ! array over mapping types - type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) - integer , intent(out) :: rc + type(ESMF_FieldBundle) , intent(in) :: FBSrc + type(ESMF_FieldBundle) , intent(inout) :: FBDst + type(ESMF_Field) , intent(in) :: field_normOne(:) ! array over mapping types + type(ESMF_FieldBundle) , intent(in) :: FBFracSrc ! fraction field bundle for source + type(packed_data_type) , intent(inout) :: packed_data(:) ! array over mapping types + type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) + type(ESMF_FieldBundle), optional, intent(in) :: FBDat ! data field bundle + integer, optional , intent(out) :: rc ! local variables - integer :: nf, nu, np, n - integer :: fieldcount - integer :: mapindex - integer :: ungriddedUBound(1) - real(r8), pointer :: dataptr1d(:) - real(r8), pointer :: dataptr2d(:,:) - real(r8), pointer :: dataptr2d_packed(:,:) - type(ESMF_Field) :: field_fracsrc - type(ESMF_Field), pointer :: fieldlist_src(:) - type(ESMF_Field), pointer :: fieldlist_dst(:) - real(r8), pointer :: data_norm(:) - real(r8), pointer :: data_dst(:,:) - character(len=*), parameter :: subname=' (med_map_mod:med_map_field_packed) ' + integer :: nf, nu, np, n, nfd + integer :: fieldcount, fieldcount_dat + integer :: mapindex + integer :: ungriddedUBound(1) + real(r8), pointer :: dataptr(:) + real(r8), pointer :: dataptr1d(:) + real(r8), pointer :: dataptr2d(:,:) + real(r8), pointer :: dataptr2d_packed(:,:) + type(ESMF_Field) :: field_fracsrc + type(ESMF_Field), pointer :: fieldlist_src(:) + type(ESMF_Field), pointer :: fieldlist_dst(:) + type(ESMF_Field), pointer :: fieldlist_dat(:) + real(r8), pointer :: data_norm(:) + real(r8), pointer :: data_dst(:,:) + character(cl) :: field_name + character(cl), allocatable :: field_namelist_dat(:) + character(len=*), parameter :: subname=' (med_map_mod:med_map_field_packed) ' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -977,6 +982,19 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d fieldcount=0 endif + ! Get field count for FBDat if it is given and created + fieldcount_dat = 0 + if (present(FBdat)) then + if (ESMF_FieldBundleIsCreated(FBdat)) then + call ESMF_FieldBundleGet(FBDat, fieldCount=fieldcount_dat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + allocate(fieldlist_dat(fieldcount_dat)) + allocate(field_namelist_dat(fieldcount_dat)) + call ESMF_FieldBundleGet(FBDat, fieldlist=fieldlist_dat, fieldNameList=field_namelist_dat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if ! Loop over mapping types do mapindex = 1,nmappers @@ -1027,8 +1045,63 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d end if end if end do + + ! Nullify pointers + nullify(dataptr2d_packed) + nullify(dataptr2d) + nullify(dataptr1d) + call t_stopf('MED:'//trim(subname)//' copy from src') + ! ----------------------------------- + ! Fill destination field with background data provided by CDEPS inline + ! ----------------------------------- + + if (fieldcount_dat > 0) then + ! First get the pointer for the packed destination data + call ESMF_FieldGet(packed_data(mapindex)%field_dst, farrayptr=dataptr2d_packed, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Loop over fields and fill it if there is a match + do nf = 1,fieldcount + ! Get the indices into the packed data structure + np = packed_data(mapindex)%fldindex(nf) + if (np > 0) then + ! Get size of ungridded dimension and name of the field + call ESMF_FieldGet(fieldlist_dst(nf), ungriddedUBound=ungriddedUBound, name=field_name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (maintask) write(logunit,'(a)') trim(subname)//" serach for "//trim(field_name) + + ! Check if field has match in data fields + do nfd = 1, fieldcount_dat + if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_namelist_dat(nfd)) + if (trim(field_name) == trim(field_namelist_dat(nfd))) then + if (maintask) write(logunit,'(a)') trim(subname)//" filling with background data " + + ! Get pointer from data field + call ESMF_FieldGet(fieldlist_dat(nfd), farrayptr=dataptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Get pointer from destination field and fill it with data + if (ungriddedUBound(1) > 0) then + call ESMF_FieldGet(fieldlist_dst(nf), farrayptr=dataptr2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! TODO: Currently assumes same data along the ungridded dimension + do nu = 1,ungriddedUBound(1) + dataptr2d_packed(np+nu-1,:) = dataptr(:) + end do + else + call ESMF_FieldGet(fieldlist_dst(nf), farrayptr=dataptr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr2d_packed(np,:) = dataptr(:) + end if + exit + end if + end do + end if + end do + end if + ! ----------------------------------- ! Do the mapping ! ----------------------------------- @@ -1067,7 +1140,8 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d field_src=packed_data(mapindex)%field_src, & field_dst=packed_data(mapindex)%field_dst, & routehandles=routehandles, & - maptype=mapindex, rc=rc) + maptype=mapindex, & + rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Obtain unity normalization factor and multiply @@ -1126,8 +1200,12 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d end do ! end of loop over mapindex if (ESMF_FieldBundleIsCreated(FBsrc)) then - deallocate(fieldlist_src) - deallocate(fieldlist_dst) + deallocate(fieldlist_src) + deallocate(fieldlist_dst) + end if + if (fieldcount_dat > 0) then + deallocate(fieldlist_dat) + deallocate(field_namelist_dat) end if call t_stopf('MED:'//subname) @@ -1263,18 +1341,19 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_Region_Flag, ESMF_REGION_TOTAL use ESMF , only : ESMF_REGION_SELECT use ESMF , only : ESMF_RouteHandle + use ESMF , only : ESMF_FieldWriteVTK 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 - type(ESMF_Field) , intent(inout) :: field_dst - type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) - integer , intent(in) :: maptype - character(len=*) , intent(in), optional :: fldname - integer , intent(out) :: rc + type(ESMF_Field) , intent(in) :: field_src + type(ESMF_Field) , intent(inout) :: field_dst + type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) + integer , intent(in) :: maptype + character(len=*), optional, intent(in) :: fldname + integer, optional , intent(out) :: rc ! local variables logical :: checkflag = .false. @@ -1322,19 +1401,31 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r if (chkerr(rc,__LINE__,u_FILE_u)) return end if else if (maptype == mapfillv_bilnr) then - call ESMF_FieldFill(field_dst, dataFillScheme="const", const1=fillValue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 1) then - call Field_diagnose(field_dst, lfldname, " --> after fillv: ", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + !call ESMF_FieldFill(field_dst, dataFillScheme="const", const1=fillValue, rc=rc) + !call ESMF_FieldFill(field_dst, dataFillScheme="const", const1=0.0d0, rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return + + !if (dbug_flag > 1) then + ! call Field_diagnose(field_dst, lfldname, " --> after fillv: ", rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + !end if + + !call ESMF_FieldWriteVTK(field_src, 'field_src_'//trim(lfldname), rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return + + !call ESMF_FieldWriteVTK(field_dst, 'field_dst_'//trim(lfldname)//'_before', rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(mapfillv_bilnr), & termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 1) then - call Field_diagnose(field_dst, lfldname, " --> after bilnr: ", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + !if (dbug_flag > 1) then + ! call Field_diagnose(field_dst, lfldname, " --> after bilnr: ", rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + !end if + + !call ESMF_FieldWriteVTK(field_dst, 'field_dst_'//trim(lfldname)//'_after', rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return else call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(maptype), & termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index 4c78da123..aa508979a 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -228,8 +228,8 @@ subroutine med_phases_cdeps_run(gcomp, rc) end do ! nflds ! Create empty FB - if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBExpIn(n2), rc=rc) .and. found) then - is_local%wrap%FBExpIn(n2) = ESMF_FieldBundleCreate(name="inline_"//trim(compname(n2)), rc=rc) + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBData(n2), rc=rc) .and. found) then + is_local%wrap%FBData(n2) = ESMF_FieldBundleCreate(name="inline_"//trim(compname(n2)), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if end if @@ -271,12 +271,12 @@ subroutine med_phases_cdeps_run(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Point FB from internal one - is_local%wrap%FBExpIn(n2) = sdat(n1,n2)%pstrm(1)%fldbun_model + is_local%wrap%FBData(n2) = sdat(n1,n2)%pstrm(1)%fldbun_model ! Write FB for debugging if (dbug_flag > 10) then write(suffix, fmt='(i4,a1,i2.2,a1,i2.2,a1,i5.5)') year, '-', month, '-', day, '-', sec - call FB_write(is_local%wrap%FBExpIn(n2), suffix, rc) + call FB_write(is_local%wrap%FBData(n2), suffix, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if end if diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 01d1a52d0..83a8853ec 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -81,6 +81,7 @@ subroutine med_phases_prep_atm(gcomp, rc) FBSrc=is_local%wrap%FBImp(compocn,compocn), & FBDst=is_local%wrap%FBImp(compocn,compatm), & FBFracSrc=is_local%wrap%FBFrac(compocn), & + FBDat=is_local%wrap%FBData(compatm), & field_NormOne=is_local%wrap%field_normOne(compocn,compatm,:), & packed_data=is_local%wrap%packed_data(compocn,compatm,:), & routehandles=is_local%wrap%RH(compocn,compatm,:), rc=rc) From f9ac7af1ae879b6d66a2a95e91e90c55675f3658 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Sun, 12 Nov 2023 01:10:48 -0600 Subject: [PATCH 389/430] more work for cmeps and cdeps inline integration --- mediator/med_map_mod.F90 | 91 ++++++++++++++++++++-------------------- 1 file changed, 45 insertions(+), 46 deletions(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 75dc8189f..e07b0d0c1 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -929,9 +929,12 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet use ESMF , only : ESMF_FieldBundleIsCreated use ESMF , only : ESMF_FieldRedist, ESMF_RouteHandle + use ESMF , only : ESMF_FieldFill + use ESMF , only : ESMF_KIND_R8 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 + use med_methods_mod , only : Field_diagnose => med_methods_Field_diagnose ! input/output variables type(ESMF_FieldBundle) , intent(in) :: FBSrc @@ -944,23 +947,24 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p integer, optional , intent(out) :: rc ! local variables - integer :: nf, nu, np, n, nfd - integer :: fieldcount, fieldcount_dat - integer :: mapindex - integer :: ungriddedUBound(1) - real(r8), pointer :: dataptr(:) - real(r8), pointer :: dataptr1d(:) - real(r8), pointer :: dataptr2d(:,:) - real(r8), pointer :: dataptr2d_packed(:,:) - type(ESMF_Field) :: field_fracsrc - type(ESMF_Field), pointer :: fieldlist_src(:) - type(ESMF_Field), pointer :: fieldlist_dst(:) - type(ESMF_Field), pointer :: fieldlist_dat(:) - real(r8), pointer :: data_norm(:) - real(r8), pointer :: data_dst(:,:) - character(cl) :: field_name - character(cl), allocatable :: field_namelist_dat(:) - character(len=*), parameter :: subname=' (med_map_mod:med_map_field_packed) ' + integer :: nf, nu, np, n, nfd + integer :: fieldcount, fieldcount_dat + integer :: mapindex + integer :: ungriddedUBound(1) + real(r8), pointer :: dataptr(:) + real(r8), pointer :: dataptr1d(:) + real(r8), pointer :: dataptr2d(:,:) + real(r8), pointer :: dataptr2d_packed(:,:) + type(ESMF_Field) :: field_fracsrc + type(ESMF_Field), pointer :: fieldlist_src(:) + type(ESMF_Field), pointer :: fieldlist_dst(:) + type(ESMF_Field), pointer :: fieldlist_dat(:) + real(r8), pointer :: data_norm(:) + real(r8), pointer :: data_dst(:,:) + character(cl) :: field_name + character(cl), allocatable :: field_namelist_dat(:) + real(ESMF_KIND_R8), parameter :: fillValue = 9.99e20_ESMF_KIND_R8 + character(len=*), parameter :: subname=' (med_map_mod:med_map_field_packed) ' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -1030,6 +1034,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p ! Get the indices into the packed data structure np = packed_data(mapindex)%fldindex(nf) if (np > 0) then + ! Fill packed source field call ESMF_FieldGet(fieldlist_src(nf), ungriddedUBound=ungriddedUBound, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (ungriddedUBound(1) > 0) then @@ -1070,18 +1075,22 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p ! Get size of ungridded dimension and name of the field call ESMF_FieldGet(fieldlist_dst(nf), ungriddedUBound=ungriddedUBound, name=field_name, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit,'(a)') trim(subname)//" serach for "//trim(field_name) + if (maintask) write(logunit,'(a)') trim(subname)//" search "//trim(field_name)//" field for bg fill" ! Check if field has match in data fields do nfd = 1, fieldcount_dat - if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_namelist_dat(nfd)) if (trim(field_name) == trim(field_namelist_dat(nfd))) then - if (maintask) write(logunit,'(a)') trim(subname)//" filling with background data " + if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_namelist_dat(nfd))//" is found!" ! Get pointer from data field call ESMF_FieldGet(fieldlist_dat(nfd), farrayptr=dataptr, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call Field_diagnose(fieldlist_dst(nf), trim(field_name), " --> before bg fill: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + ! Get pointer from destination field and fill it with data if (ungriddedUBound(1) > 0) then call ESMF_FieldGet(fieldlist_dst(nf), farrayptr=dataptr2d, rc=rc) @@ -1095,11 +1104,22 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p if (chkerr(rc,__LINE__,u_FILE_u)) return dataptr2d_packed(np,:) = dataptr(:) end if - exit + + if (dbug_flag > 1) then + call Field_diagnose(fieldlist_dst(nf), trim(field_name), " --> after bg fill: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + exit end if end do end if end do + else + ! Fill packed destination field/s with large value if data is unavailable + ! The data needs to be compated in the component side + call ESMF_FieldFill(packed_data(mapindex)%field_dst, dataFillScheme="const", const1=fillValue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if ! ----------------------------------- @@ -1335,9 +1355,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r 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 @@ -1358,7 +1376,6 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r ! local variables logical :: checkflag = .false. character(len=CS) :: lfldname - real(ESMF_KIND_R8), parameter :: fillValue = 9.99e20_ESMF_KIND_R8 character(len=*), parameter :: subname='(med_map_mod:med_map_field) ' !--------------------------------------------------- @@ -1401,31 +1418,13 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r if (chkerr(rc,__LINE__,u_FILE_u)) return end if else if (maptype == mapfillv_bilnr) then - !call ESMF_FieldFill(field_dst, dataFillScheme="const", const1=fillValue, rc=rc) - !call ESMF_FieldFill(field_dst, dataFillScheme="const", const1=0.0d0, rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return - - !if (dbug_flag > 1) then - ! call Field_diagnose(field_dst, lfldname, " --> after fillv: ", rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - !end if - - !call ESMF_FieldWriteVTK(field_src, 'field_src_'//trim(lfldname), rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return - - !call ESMF_FieldWriteVTK(field_dst, 'field_dst_'//trim(lfldname)//'_before', rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(mapfillv_bilnr), & termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - !if (dbug_flag > 1) then - ! call Field_diagnose(field_dst, lfldname, " --> after bilnr: ", rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - !end if - - !call ESMF_FieldWriteVTK(field_dst, 'field_dst_'//trim(lfldname)//'_after', rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call Field_diagnose(field_dst, lfldname, " --> after bilnr: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if else call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(maptype), & termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) From b0af4aad26f0925871987f98b50376c435ccd740 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Wed, 15 Nov 2023 13:59:37 -0600 Subject: [PATCH 390/430] add atm->ocn direction for cdeps inline capability --- mediator/med_internalstate_mod.F90 | 1 + mediator/med_map_mod.F90 | 8 +++++--- mediator/med_phases_cdeps_mod.F90 | 9 +++++---- mediator/med_phases_post_atm_mod.F90 | 1 + 4 files changed, 12 insertions(+), 7 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index d07923d35..9225fa8dd 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -373,6 +373,7 @@ subroutine med_internalstate_init(gcomp, rc) ! Initialize flag for background fill is_local%wrap%med_bg_fill_active(:,:) = .false. is_local%wrap%med_bg_fill_active(compocn,compatm) = .true. + is_local%wrap%med_bg_fill_active(compatm,compocn) = .true. end subroutine med_internalstate_init diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index e07b0d0c1..059677208 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -1062,6 +1062,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p ! Fill destination field with background data provided by CDEPS inline ! ----------------------------------- + if (maintask) write(logunit,'(a,i)') trim(subname), fieldcount_dat if (fieldcount_dat > 0) then ! First get the pointer for the packed destination data call ESMF_FieldGet(packed_data(mapindex)%field_dst, farrayptr=dataptr2d_packed, rc=rc) @@ -1075,10 +1076,11 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p ! Get size of ungridded dimension and name of the field call ESMF_FieldGet(fieldlist_dst(nf), ungriddedUBound=ungriddedUBound, name=field_name, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit,'(a)') trim(subname)//" search "//trim(field_name)//" field for bg fill" + if (maintask) write(logunit,'(a)') trim(subname)//" search "//trim(field_name)//" field for background fill." ! Check if field has match in data fields do nfd = 1, fieldcount_dat + if (maintask) write(logunit,'(a)') trim(field_name)//" - "//trim(field_namelist_dat(nfd)) if (trim(field_name) == trim(field_namelist_dat(nfd))) then if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_namelist_dat(nfd))//" is found!" @@ -1087,7 +1089,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then - call Field_diagnose(fieldlist_dst(nf), trim(field_name), " --> before bg fill: ", rc=rc) + call Field_diagnose(fieldlist_dst(nf), trim(field_name), " --> before background fill: ", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -1106,7 +1108,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p end if if (dbug_flag > 1) then - call Field_diagnose(fieldlist_dst(nf), trim(field_name), " --> after bg fill: ", rc=rc) + call Field_diagnose(fieldlist_dst(nf), trim(field_name), " --> after background fill: ", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index aa508979a..289447201 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -153,6 +153,7 @@ subroutine med_phases_cdeps_run(gcomp, rc) ! Query destination field name and its mesh call ESMF_FieldGet(flddst, mesh=meshdst, name=fldname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (maintask) write(logunit,'(a)') trim(subname)//": extracting destination mesh from "//trim(fldname) ! Check if any field in FB in the given stream ! NOTE: Single stream could provide multiple fields !!! @@ -165,11 +166,11 @@ subroutine med_phases_cdeps_run(gcomp, rc) end do end do - ! If match is found, then initialize cdeps inline for the stream - if (streamid /= 0) then + ! If match is found and previously not initialized, then initialize cdeps inline for the stream + if (size(sdat(n1,n2)%stream) == 0 .and. streamid /= 0) then ! Debug print if (maintask) then - write(logunit,'(a,i)') trim(subname)//": "//trim(fldname)//" is found in stream ", streamid + write(logunit,'(a,i)') trim(subname)//": initialize stream ", streamid end if ! Allocate temporary variable to store file names in the stream @@ -179,7 +180,7 @@ subroutine med_phases_cdeps_run(gcomp, rc) ! Fill file abd variable lists with data do l = 1, sdat_config%stream(streamid)%nfiles fileList(l) = trim(sdat_config%stream(streamid)%file(l)%name) - if (maintask) write(logunit,'(a,i2,x,a)') trim(subname)//": file ", l, trim(fileList(l)) + if (maintask) write(logunit,'(a,i2,x,a)') trim(subname)//": file ", l, trim(fileList(l)) end do do l = 1, sdat_config%stream(streamid)%nvars varList(l,1) = trim(sdat_config%stream(streamid)%varlist(l)%nameinfile) diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index 9ed1b78d4..c37749cf2 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -65,6 +65,7 @@ subroutine med_phases_post_atm(gcomp, rc) FBSrc=is_local%wrap%FBImp(compatm,compatm), & FBDst=is_local%wrap%FBImp(compatm,compocn), & FBFracSrc=is_local%wrap%FBFrac(compatm), & + FBDat=is_local%wrap%FBData(compocn), & field_normOne=is_local%wrap%field_normOne(compatm,compocn,:), & packed_data=is_local%wrap%packed_data(compatm,compocn,:), & routehandles=is_local%wrap%RH(compatm,compocn,:), rc=rc) From 1296a907239c88bd9bcd6da8cde6cc1d7ecf2089 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Thu, 16 Nov 2023 00:18:39 -0600 Subject: [PATCH 391/430] activate cdeps inline capability for atm->wav --- mediator/med_internalstate_mod.F90 | 1 + mediator/med_map_mod.F90 | 1 - mediator/med_phases_post_atm_mod.F90 | 1 + 3 files changed, 2 insertions(+), 1 deletion(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 9225fa8dd..bda3d9e21 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -374,6 +374,7 @@ subroutine med_internalstate_init(gcomp, rc) is_local%wrap%med_bg_fill_active(:,:) = .false. is_local%wrap%med_bg_fill_active(compocn,compatm) = .true. is_local%wrap%med_bg_fill_active(compatm,compocn) = .true. + is_local%wrap%med_bg_fill_active(compatm,compwav) = .true. end subroutine med_internalstate_init diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 059677208..77e15bd2a 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -1062,7 +1062,6 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p ! Fill destination field with background data provided by CDEPS inline ! ----------------------------------- - if (maintask) write(logunit,'(a,i)') trim(subname), fieldcount_dat if (fieldcount_dat > 0) then ! First get the pointer for the packed destination data call ESMF_FieldGet(packed_data(mapindex)%field_dst, farrayptr=dataptr2d_packed, rc=rc) diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index c37749cf2..333497a69 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -105,6 +105,7 @@ subroutine med_phases_post_atm(gcomp, rc) FBSrc=is_local%wrap%FBImp(compatm,compatm), & FBDst=is_local%wrap%FBImp(compatm,compwav), & FBFracSrc=is_local%wrap%FBFrac(compatm), & + FBDat=is_local%wrap%FBData(compwav), & field_normOne=is_local%wrap%field_normOne(compatm,compwav,:), & packed_data=is_local%wrap%packed_data(compatm,compwav,:), & routehandles=is_local%wrap%RH(compatm,compwav,:), rc=rc) From 20352660928f2dcaabe920ca048b95fa91a4de45 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 22 Nov 2023 07:56:33 -0700 Subject: [PATCH 392/430] 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 393/430] 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 394/430] 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 395/430] 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 396/430] 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 397/430] 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 398/430] 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 399/430] 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 400/430] 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 401/430] 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 402/430] 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 403/430] 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 404/430] 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 405/430] 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. From 40ce1107b2a6a851bb7ae1f348e7e3d49fe9e120 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 27 Dec 2023 14:42:56 -0700 Subject: [PATCH 406/430] For T compsets, only run GLC if med_to_glc is true This makes the logic for running GLC consistent with runseq_general.py. This change is relevant for the unusual case where a T compset (CISM forced by dlnd) is being run with CISM in noevolve mode: in this case, we don't want to run CISM, and trying to run CISM leads to incorrect behavior in a restart case (which is how this issue was detected). With this change, ERS_D_Ly3.f09_g17_gris4.T1850Gg.derecho_intel.cism-noevolve passes. --- cime_config/runseq/runseq_TG.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/runseq/runseq_TG.py b/cime_config/runseq/runseq_TG.py index c0bb4ab92..dea8aede5 100644 --- a/cime_config/runseq/runseq_TG.py +++ b/cime_config/runseq/runseq_TG.py @@ -34,7 +34,7 @@ def gen_runseq(case, coupling_times): runseq.add_action ("MED med_phases_post_lnd" , run_lnd) runseq.add_action ("MED med_phases_prep_glc" , med_to_glc) runseq.add_action ("MED -> GLC :remapMethod=redist" , med_to_glc) - runseq.add_action ("GLC" , run_glc) + runseq.add_action ("GLC" , run_glc and med_to_glc) runseq.add_action ("GLC -> MED :remapMethod=redist" , run_glc) runseq.add_action ("MED med_phases_history_write" , True) From cdb819bef6e66287d4ab9e74fb439e8ba3fa05fc Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Thu, 28 Dec 2023 16:25:00 -0600 Subject: [PATCH 407/430] feature to use all data in the first coupling timestep --- mediator/med.F90 | 16 +++++++ mediator/med_internalstate_mod.F90 | 29 ++++++----- mediator/med_map_mod.F90 | 72 ++++++++++++++++------------ mediator/med_phases_cdeps_mod.F90 | 2 +- mediator/med_phases_prep_ocn_mod.F90 | 35 +++++++++++++- mediator/med_phases_prep_wav_mod.F90 | 33 +++++++++++-- 6 files changed, 138 insertions(+), 49 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 31f67486a..603747fa1 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -950,6 +950,22 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) endif endif + ! Should terget component use all data for first time step? + do ncomp = 1,ncomps + if (ncomp /= compmed) then + call NUOPC_CompAttributeGet(gcomp, name=trim(compname(ncomp))//"_use_data_first_import", 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%med_data_force_first(ncomp) + else + is_local%wrap%med_data_force_first(ncomp) = .false. + endif + if (maintask) then + write(logunit,*) trim(compname(ncomp))//'_use_data_first_import is ', is_local%wrap%med_data_force_first(ncomp) + endif + end if + end do + if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index bda3d9e21..32b1446bc 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -19,7 +19,7 @@ module med_internalstate_mod integer, public :: logunit ! logunit for mediator log output integer, public :: diagunit ! diagunit for budget output (med main only) - logical, public :: maintask=.false. ! is this the maintask + logical, public :: maintask = .false. ! is this the maintask integer, public :: med_id ! needed currently in med_io_mod and set in esm.F90 ! Components @@ -119,11 +119,12 @@ module med_internalstate_mod type InternalStateStruct ! Present/allowed coupling/active coupling logical flags - logical, pointer :: comp_present(:) ! comp present flag - logical, pointer :: med_coupling_active(:,:) ! computes the active coupling - logical, pointer :: med_bg_fill_active(:,:) ! use cdeps for background fill - integer :: num_icesheets ! obtained from attribute - logical :: ocn2glc_coupling = .false. ! obtained from attribute + logical, pointer :: comp_present(:) ! comp present flag + logical, pointer :: med_coupling_active(:,:) ! computes the active coupling + logical, pointer :: med_data_active(:,:) ! uses stream data to provide background fill + logical, pointer :: med_data_force_first(:) ! force to use stream data for first coupling timestep + integer :: num_icesheets ! obtained from attribute + logical :: ocn2glc_coupling = .false. ! obtained from attribute logical :: lnd2glc_coupling = .false. logical :: accum_lnd2glc = .false. @@ -307,7 +308,8 @@ subroutine med_internalstate_init(gcomp, rc) ! Allocate memory now that ncomps is determined allocate(is_local%wrap%med_coupling_active(ncomps,ncomps)) - allocate(is_local%wrap%med_bg_fill_active(ncomps,ncomps)) + allocate(is_local%wrap%med_data_active(ncomps,ncomps)) + allocate(is_local%wrap%med_data_force_first(ncomps)) allocate(is_local%wrap%nx(ncomps)) allocate(is_local%wrap%ny(ncomps)) allocate(is_local%wrap%NStateImp(ncomps)) @@ -370,11 +372,14 @@ subroutine med_internalstate_init(gcomp, rc) write(msgString,*) trim(subname)//': Mediator dststatus_print is ',dststatus_print call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - ! Initialize flag for background fill - is_local%wrap%med_bg_fill_active(:,:) = .false. - is_local%wrap%med_bg_fill_active(compocn,compatm) = .true. - is_local%wrap%med_bg_fill_active(compatm,compocn) = .true. - is_local%wrap%med_bg_fill_active(compatm,compwav) = .true. + ! Initialize flag for background fill using data + is_local%wrap%med_data_active(:,:) = .false. + is_local%wrap%med_data_active(compocn,compatm) = .true. + is_local%wrap%med_data_active(compatm,compocn) = .true. + is_local%wrap%med_data_active(compatm,compwav) = .true. + + ! Initialize flag to force using data in first coupling time step + is_local%wrap%med_data_force_first(:) = .false. end subroutine med_internalstate_init diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 77e15bd2a..c5d569c62 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -919,7 +919,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & end subroutine med_map_packed_field_create !================================================================================ - subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, packed_data, routehandles, rc) + subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_normOne, packed_data, routehandles, rc) ! ----------------------------------------------- ! Do regridding via packed field bundles @@ -944,6 +944,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p type(packed_data_type) , intent(inout) :: packed_data(:) ! array over mapping types type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) type(ESMF_FieldBundle), optional, intent(in) :: FBDat ! data field bundle + logical, optional , intent(in) :: use_data ! skip mapping and use data instead integer, optional , intent(out) :: rc ! local variables @@ -963,6 +964,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p real(r8), pointer :: data_dst(:,:) character(cl) :: field_name character(cl), allocatable :: field_namelist_dat(:) + logical :: skip_mapping real(ESMF_KIND_R8), parameter :: fillValue = 9.99e20_ESMF_KIND_R8 character(len=*), parameter :: subname=' (med_map_mod:med_map_field_packed) ' !----------------------------------------------------------- @@ -988,6 +990,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p ! Get field count for FBDat if it is given and created fieldcount_dat = 0 + skip_mapping = .false. if (present(FBdat)) then if (ESMF_FieldBundleIsCreated(FBdat)) then call ESMF_FieldBundleGet(FBDat, fieldCount=fieldcount_dat, rc=rc) @@ -997,6 +1000,8 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p allocate(field_namelist_dat(fieldcount_dat)) call ESMF_FieldBundleGet(FBDat, fieldlist=fieldlist_dat, fieldNameList=field_namelist_dat, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (present(use_data)) skip_mapping = use_data end if end if @@ -1075,12 +1080,16 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p ! Get size of ungridded dimension and name of the field call ESMF_FieldGet(fieldlist_dst(nf), ungriddedUBound=ungriddedUBound, name=field_name, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (maintask) write(logunit,'(a)') trim(subname)//" search "//trim(field_name)//" field for background fill." ! Check if field has match in data fields do nfd = 1, fieldcount_dat - if (maintask) write(logunit,'(a)') trim(field_name)//" - "//trim(field_namelist_dat(nfd)) + ! Debug output for checked fields to find match + if (maintask .and. dbug_flag > 1) write(logunit,'(a)') trim(field_name)//" - "//trim(field_namelist_dat(nfd)) + if (trim(field_name) == trim(field_namelist_dat(nfd))) then + ! Debug output about match if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_namelist_dat(nfd))//" is found!" ! Get pointer from data field @@ -1088,29 +1097,26 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then - call Field_diagnose(fieldlist_dst(nf), trim(field_name), " --> before background fill: ", rc=rc) + call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> before background fill: ", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if ! Get pointer from destination field and fill it with data if (ungriddedUBound(1) > 0) then - call ESMF_FieldGet(fieldlist_dst(nf), farrayptr=dataptr2d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return ! TODO: Currently assumes same data along the ungridded dimension do nu = 1,ungriddedUBound(1) dataptr2d_packed(np+nu-1,:) = dataptr(:) end do else - call ESMF_FieldGet(fieldlist_dst(nf), farrayptr=dataptr1d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return dataptr2d_packed(np,:) = dataptr(:) end if if (dbug_flag > 1) then - call Field_diagnose(fieldlist_dst(nf), trim(field_name), " --> after background fill: ", rc=rc) + call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> after background fill: ", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if + ! Exit from loop since match is already found exit end if end do @@ -1156,31 +1162,35 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p else if ( trim(packed_data(mapindex)%mapnorm) == 'one' .or. trim(packed_data(mapindex)%mapnorm) == 'none') then - ! Mapping with no normalization that is not redistribution - call med_map_field (& - field_src=packed_data(mapindex)%field_src, & - field_dst=packed_data(mapindex)%field_dst, & - routehandles=routehandles, & - maptype=mapindex, & - rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Obtain unity normalization factor and multiply - ! interpolated field by reciprocal of normalization factor - if (trim(packed_data(mapindex)%mapnorm) == 'one') then - call ESMF_FieldGet(field_normOne(mapindex), farrayPtr=data_norm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(packed_data(mapindex)%field_dst, farrayPtr=data_dst, rc=rc) + ! Skip mapping if it is requested + if (skip_mapping) then + if (maintask) write(logunit,'(a)') trim(subname)//" skip mapping since use_data is set to .true." + else + ! Mapping with no normalization that is not redistribution + call med_map_field (& + field_src=packed_data(mapindex)%field_src, & + field_dst=packed_data(mapindex)%field_dst, & + routehandles=routehandles, & + maptype=mapindex, & + rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(data_dst,dim=2) - if (data_norm(n) == 0.0_r8) then - data_dst(:,n) = 0.0_r8 - else - data_dst(:,n) = data_dst(:,n)/data_norm(n) - end if - end do - end if + ! Obtain unity normalization factor and multiply + ! interpolated field by reciprocal of normalization factor + if (trim(packed_data(mapindex)%mapnorm) == 'one') then + call ESMF_FieldGet(field_normOne(mapindex), farrayPtr=data_norm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(packed_data(mapindex)%field_dst, farrayPtr=data_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(data_dst,dim=2) + if (data_norm(n) == 0.0_r8) then + data_dst(:,n) = 0.0_r8 + else + data_dst(:,n) = data_dst(:,n)/data_norm(n) + end if + end do + end if + end if end if call t_stopf('MED:'//trim(subname)//' map') diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index 289447201..7b703e460 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -138,7 +138,7 @@ subroutine med_phases_cdeps_run(gcomp, rc) do n1 = 1, ncomps do n2 = 1, ncomps ! Check for coupling direction and background fill - if (n1 /= n2 .and. is_local%wrap%med_coupling_active(n1,n2) .and. is_local%wrap%med_bg_fill_active(n1,n2)) then + if (n1 /= n2 .and. is_local%wrap%med_coupling_active(n1,n2) .and. is_local%wrap%med_data_active(n1,n2)) then ! Get number of fields call FB_getNumflds(is_local%wrap%FBImp(n1,n2), trim(subname), nflds, 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 d76f3e81a..6a769bcf1 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -110,12 +110,40 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) rc = ESMF_SUCCESS call memcheck(subname, 5, maintask) - ! Get the internal state + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- 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 + + !--------------------------------------- + ! --- map atm to ocn, only if data stream is available + !--------------------------------------- + if (is_local%wrap%med_coupling_active(compatm,compocn) .and. & + is_local%wrap%med_data_active(compatm,compocn) .and. & + is_local%wrap%med_data_force_first(compocn)) then + call t_startf('MED:'//trim(subname)//' map_atm2ocn') + call med_map_field_packed( & + FBSrc=is_local%wrap%FBImp(compatm,compatm), & + FBDst=is_local%wrap%FBImp(compatm,compocn), & + FBFracSrc=is_local%wrap%FBFrac(compocn), & + FBDat=is_local%wrap%FBData(compocn), & + use_data=is_local%wrap%med_data_force_first(compocn), & + field_normOne=is_local%wrap%field_normOne(compatm,compocn,:), & + packed_data=is_local%wrap%packed_data(compatm,compocn,:), & + routehandles=is_local%wrap%RH(compatm,compocn,:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//trim(subname)//' map_atm2ocn') + + ! Reset flag to use data + is_local%wrap%med_data_force_first(compocn) = .false. + end if + + !--------------------------------------- + !--- merge all fields to ocn + !--------------------------------------- call med_merge_auto(& is_local%wrap%med_coupling_active(:,compocn), & is_local%wrap%FBExp(compocn), & @@ -125,6 +153,9 @@ 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 + !--------------------------------------- + !--- custom calculations + !--------------------------------------- ! 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 diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index c690aa522..93755d59c 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -19,7 +19,7 @@ module med_phases_prep_wav_mod 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 med_internalstate_mod , only : compatm, compwav use perf_mod , only : t_startf, t_stopf implicit none @@ -92,12 +92,39 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) rc = ESMF_SUCCESS call memcheck(subname, 5, maintask) - ! Get the internal state + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! auto merges to wav + !--------------------------------------- + ! --- map atm to wav, only if data stream is available + !--------------------------------------- + if (is_local%wrap%med_coupling_active(compatm,compwav) .and. & + is_local%wrap%med_data_active(compatm,compwav) .and. & + is_local%wrap%med_data_force_first(compwav)) then + call t_startf('MED:'//trim(subname)//' map_atm2wav') + call med_map_field_packed( & + FBSrc=is_local%wrap%FBImp(compatm,compatm), & + FBDst=is_local%wrap%FBImp(compatm,compwav), & + FBFracSrc=is_local%wrap%FBFrac(compatm), & + FBDat=is_local%wrap%FBData(compwav), & + use_data=is_local%wrap%med_data_force_first(compwav), & + field_normOne=is_local%wrap%field_normOne(compatm,compwav,:), & + packed_data=is_local%wrap%packed_data(compatm,compwav,:), & + routehandles=is_local%wrap%RH(compatm,compwav,:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//trim(subname)//' map_atm2wav') + + ! Reset flag to use data + is_local%wrap%med_data_force_first(compwav) = .false. + end if + + !--------------------------------------- + !--- merge all fields to wav + !--------------------------------------- call med_merge_auto(& is_local%wrap%med_coupling_active(:,compwav), & is_local%wrap%FBExp(compwav), & From d56c50c60c29c44103e536d6174dcdfd1759b102 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Fri, 5 Jan 2024 15:37:57 -0600 Subject: [PATCH 408/430] fix for gust additions in the aoflux --- mediator/esmFldsExchange_ufs_mod.F90 | 8 -------- mediator/med_phases_aofluxes_mod.F90 | 12 ++++++++---- 2 files changed, 8 insertions(+), 12 deletions(-) diff --git a/mediator/esmFldsExchange_ufs_mod.F90 b/mediator/esmFldsExchange_ufs_mod.F90 index d7367172c..a93a8ff81 100644 --- a/mediator/esmFldsExchange_ufs_mod.F90 +++ b/mediator/esmFldsExchange_ufs_mod.F90 @@ -151,14 +151,6 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) call addfld_ocnalb('So_anidf') 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_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index cc62bbd36..1d8efe7e8 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1597,8 +1597,6 @@ 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 ufs.frac.aoflux @@ -1710,8 +1708,6 @@ 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) @@ -1724,6 +1720,7 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'Faox_lwup', aoflux_out%lwup, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (flds_wiso) then call fldbun_getfldptr(fldbun, 'Faox_evap_16O', aoflux_out%evap_16O, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1737,6 +1734,13 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) allocate(aoflux_out%evap_HDO(lsize)); aoflux_out%evap_HDO(:) = 0._R8 end if + if (add_gusts) then + call fldbun_getfldptr(fldbun, 'So_ugustOut', aoflux_out%ugust_out, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + allocate(aoflux_out%ugust_out(lsize)); aoflux_out%ugust_out(:) = 0._R8 + end if + end subroutine set_aoflux_out_pointers !================================================================================ From 55c890048db8aa1a7641adf0f7c9bfc2accd0ac1 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Mon, 15 Jan 2024 01:52:06 -0600 Subject: [PATCH 409/430] mods for regional mom6 configuration --- mediator/esmFldsExchange_hafs_mod.F90 | 361 +++++++++++++++++--------- mediator/med.F90 | 2 +- mediator/med_internalstate_mod.F90 | 2 +- mediator/med_map_mod.F90 | 2 +- 4 files changed, 243 insertions(+), 124 deletions(-) diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 1f645524e..4aa02a7b8 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -13,6 +13,7 @@ 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 : addfld_ocnalb => med_fldList_addfld_ocnalb !--------------------------------------------------------------------- ! This is a mediator specific routine that determines ALL possible @@ -133,7 +134,7 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return !===================================================================== - ! FIELDS TO MEDIATOR component (for fractions and atm/ocn flux calculation) + ! Mediator fields !===================================================================== !---------------------------------------------------------- @@ -146,6 +147,16 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) !---------------------------------------------------------- call addfld_to(compatm, 'So_ofrac') + !---------------------------------------------------------- + ! from med: ocean albedos (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 !===================================================================== @@ -154,28 +165,41 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) ! to atm: surface temperatures from ocn ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then - allocate(S_flds(1)) - S_flds = (/'So_t'/) ! sea_surface_temperature - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - call addfld_from(compocn, trim(fldname)) - call addfld_to(compatm, trim(fldname)) - end do - deallocate(S_flds) + if (trim(coupling_mode) == 'hafs') then + allocate(S_flds(1)) + S_flds = (/'So_t'/) ! sea_surface_temperature + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld_from(compocn, trim(fldname)) + call addfld_to(compatm, trim(fldname)) + end do + deallocate(S_flds) + else + allocate(S_flds(3)) + S_flds = (/'So_t', & ! sea_surface_temperature + 'So_u', & ! surface zonal current + 'So_v'/) ! surface meridional current + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld_from(compocn, trim(fldname)) + call addfld_to(compatm, trim(fldname)) + end do + deallocate(S_flds) + end if end if ! --------------------------------------------------------------------- ! to atm: surface roughness length ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%wav_present) then - allocate(S_flds(1)) - S_flds = (/'Sw_z0'/) ! wave_z0_roughness_length - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - call addfld_from(compwav, trim(fldname)) - call addfld_to(compatm, trim(fldname)) - end do - deallocate(S_flds) + allocate(S_flds(1)) + S_flds = (/'Sw_z0'/) ! wave_z0_roughness_length + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld_from(compwav, trim(fldname)) + call addfld_to(compatm, trim(fldname)) + end do + deallocate(S_flds) end if !===================================================================== @@ -186,40 +210,72 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) ! to ocn: state fields ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then - allocate(S_flds(6)) - S_flds = (/'Sa_u10m', & ! inst_zonal_wind_height10m - 'Sa_v10m', & ! inst_merid_wind_height10m - 'Sa_t2m ', & ! inst_temp_height2m - 'Sa_q2m ', & ! inst_spec_humid_height2m - 'Sa_pslv', & ! inst_pres_height_surface - 'Sa_tskn' /) ! inst_temp_height_surface - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - call addfld_from(compatm, trim(fldname)) - call addfld_to(compocn, trim(fldname)) - end do - deallocate(S_flds) + if (trim(coupling_mode) == 'hafs') then + allocate(S_flds(6)) + S_flds = (/'Sa_u10m', & ! inst_zonal_wind_height10m + 'Sa_v10m', & ! inst_merid_wind_height10m + 'Sa_t2m ', & ! inst_temp_height2m + 'Sa_q2m ', & ! inst_spec_humid_height2m + 'Sa_pslv', & ! inst_pres_height_surface + 'Sa_tskn' /) ! inst_temp_height_surface + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld_from(compatm, trim(fldname)) + call addfld_to(compocn, trim(fldname)) + end do + deallocate(S_flds) + else + allocate(S_flds(1)) + S_flds = (/'Sa_pslv'/) ! inst_pres_height_surface + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld_from(compatm, trim(fldname)) + call addfld_to(compocn, trim(fldname)) + end do + deallocate(S_flds) + end if end if ! --------------------------------------------------------------------- ! to ocn: flux fields ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then - allocate(F_flds(7,2)) - F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! mean_zonal_moment_flx_atm - F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! mean_merid_moment_flx_atm - F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate - F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! mean_net_sw_flx - F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! mean_net_lw_flx - F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! mean_sensi_heat_flx - F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! mean_laten_heat_flx - do n = 1,size(F_flds,1) - fldname1 = trim(F_flds(n,1)) - fldname2 = trim(F_flds(n,2)) - call addfld_from(compatm, trim(fldname1)) - call addfld_to(compocn, trim(fldname2)) - end do - deallocate(F_flds) + if (trim(coupling_mode) == 'hafs') then + allocate(F_flds(7,2)) + F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! mean_zonal_moment_flx_atm + F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! mean_merid_moment_flx_atm + F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate + F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! mean_net_sw_flx + F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! mean_net_lw_flx + F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! mean_sensi_heat_flx + F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! mean_laten_heat_flx + do n = 1,size(F_flds,1) + fldname1 = trim(F_flds(n,1)) + fldname2 = trim(F_flds(n,2)) + call addfld_from(compatm, trim(fldname1)) + call addfld_to(compocn, trim(fldname2)) + end do + deallocate(F_flds) + else + allocate(F_flds(10,2)) + F_flds(1 ,:) = (/'Faxa_taux ','Foxx_taux '/) ! mean_zonal_moment_flx_atm + F_flds(2 ,:) = (/'Faxa_tauy ','Foxx_tauy '/) ! mean_merid_moment_flx_atm + F_flds(3 ,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate + F_flds(4 ,:) = (/'Faxa_lwnet ','Foxx_lwnet '/) ! mean_net_lw_flx + F_flds(5 ,:) = (/'Faxa_sen ','Foxx_sen '/) ! mean_sensi_heat_flx + F_flds(6 ,:) = (/'Faxa_lat ','Foxx_evap '/) ! mean_laten_heat_flx + F_flds(7 ,:) = (/'Faxa_swndr ','Foxx_swnet_idr'/) ! inst_down_sw_ir_dir_flx + F_flds(8 ,:) = (/'Faxa_swndf ','Foxx_swnet_idf'/) ! inst_down_sw_ir_dif_flx + F_flds(9 ,:) = (/'Faxa_swvdr ','Foxx_swnet_vdr'/) ! inst_down_sw_vis_dir_flx + F_flds(10,:) = (/'Faxa_swvdf ','Foxx_swnet_vdf'/) ! inst_down_sw_vis_dif_flx + do n = 1,size(F_flds,1) + fldname1 = trim(F_flds(n,1)) + fldname2 = trim(F_flds(n,2)) + call addfld_from(compatm, trim(fldname1)) + call addfld_to(compocn, trim(fldname2)) + end do + deallocate(F_flds) + end if end if !===================================================================== @@ -230,14 +286,14 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) ! to wav: 10-m wind components ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%wav_present) then - allocate(S_flds(2)) - S_flds = (/'Sa_u10m', 'Sa_v10m'/) - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - call addfld_from(compatm, trim(fldname)) - call addfld_to(compwav, trim(fldname)) - end do - deallocate(S_flds) + allocate(S_flds(2)) + S_flds = (/'Sa_u10m', 'Sa_v10m'/) + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld_from(compatm, trim(fldname)) + call addfld_to(compwav, trim(fldname)) + end do + deallocate(S_flds) end if call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -356,40 +412,59 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) ! to atm: sea surface temperature ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then - allocate(S_flds(1)) - S_flds = (/'So_t'/) ! sea_surface_temperature - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compocn,compocn),trim(fldname),rc=rc) & - ) then - call addmap_from(compocn, trim(fldname), compatm, & - mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%ocn2atm_smap) - call addmrg_to(compatm, trim(fldname), & - mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') - end if - end do - deallocate(S_flds) + if (trim(coupling_mode) == 'hafs') then + allocate(S_flds(1)) + S_flds = (/'So_t'/) ! sea_surface_temperature + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn),trim(fldname),rc=rc) & + ) then + call addmap_from(compocn, trim(fldname), compatm, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%ocn2atm_smap) + call addmrg_to(compatm, trim(fldname), & + mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) + else + allocate(S_flds(3)) + S_flds = (/'So_t', & ! sea_surface_temperature + 'So_u', & ! surface zonal current + 'So_v'/) ! surface meridional current + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn),trim(fldname),rc=rc) & + ) then + call addmap_from(compocn, trim(fldname), compatm, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%ocn2atm_smap) + call addmrg_to(compatm, trim(fldname), & + mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) + end if end if ! --------------------------------------------------------------------- ! to atm: surface roughness length ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%wav_present) then - allocate(S_flds(1)) - S_flds = (/'Sw_z0'/) ! wave_z0_roughness_length - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav,compwav),trim(fldname),rc=rc) & - ) then - call addmap_from(compwav, trim(fldname), compatm, & - mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%wav2atm_smap) - call addmrg_to(compatm, trim(fldname), & - mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') - end if - end do - deallocate(S_flds) + allocate(S_flds(1)) + S_flds = (/'Sw_z0'/) ! wave_z0_roughness_length + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav,compwav),trim(fldname),rc=rc) & + ) then + call addmap_from(compwav, trim(fldname), compatm, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%wav2atm_smap) + call addmrg_to(compatm, trim(fldname), & + mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) end if !===================================================================== @@ -400,52 +475,96 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) ! to ocn: state fields ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then - allocate(S_flds(6)) - S_flds = (/'Sa_u10m', & ! inst_zonal_wind_height10m - 'Sa_v10m', & ! inst_merid_wind_height10m - 'Sa_t2m ', & ! inst_temp_height2m - 'Sa_q2m ', & ! inst_spec_humid_height2m - 'Sa_pslv', & ! inst_pres_height_surface - 'Sa_tskn' /) ! inst_temp_height_surface - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname),rc=rc) & - ) then - call addmap_from(compatm, trim(fldname), compocn, & - mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) - call addmrg_to(compocn, trim(fldname), & - mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') - end if - end do - deallocate(S_flds) + if (trim(coupling_mode) == 'hafs') then + allocate(S_flds(6)) + S_flds = (/'Sa_u10m', & ! inst_zonal_wind_height10m + 'Sa_v10m', & ! inst_merid_wind_height10m + 'Sa_t2m ', & ! inst_temp_height2m + 'Sa_q2m ', & ! inst_spec_humid_height2m + 'Sa_pslv', & ! inst_pres_height_surface + 'Sa_tskn' /) ! inst_temp_height_surface + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname),rc=rc) & + ) then + call addmap_from(compatm, trim(fldname), compocn, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) + call addmrg_to(compocn, trim(fldname), & + mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) + else + allocate(S_flds(1)) + S_flds = (/'Sa_pslv'/) ! inst_pres_height_surface + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname),rc=rc) & + ) then + call addmap_from(compatm, trim(fldname), compocn, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) + call addmrg_to(compocn, trim(fldname), & + mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) + end if end if ! --------------------------------------------------------------------- ! to ocn: flux fields ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then - allocate(F_flds(7,2)) - F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! mean_zonal_moment_flx_atm - F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! mean_merid_moment_flx_atm - F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate - F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! mean_net_sw_flx - F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! mean_net_lw_flx - F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! mean_sensi_heat_flx - F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! mean_laten_heat_flx - do n = 1,size(F_flds,1) - fldname1 = trim(F_flds(n,1)) - fldname2 = trim(F_flds(n,2)) - if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname2),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname1),rc=rc) & - ) then - call addmap_from(compatm, trim(fldname1), compocn, & - mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) - call addmrg_to(compocn, trim(fldname2), & - mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') - end if - end do - deallocate(F_flds) + if (trim(coupling_mode) == 'hafs') then + allocate(F_flds(7,2)) + F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! mean_zonal_moment_flx_atm + F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! mean_merid_moment_flx_atm + F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate + F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! mean_net_sw_flx + F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! mean_net_lw_flx + F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! mean_sensi_heat_flx + F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! mean_laten_heat_flx + do n = 1,size(F_flds,1) + fldname1 = trim(F_flds(n,1)) + fldname2 = trim(F_flds(n,2)) + if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname2),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname1),rc=rc) & + ) then + call addmap_from(compatm, trim(fldname1), compocn, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) + call addmrg_to(compocn, trim(fldname2), & + mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') + end if + end do + deallocate(F_flds) + else + allocate(F_flds(10,2)) + F_flds(1 ,:) = (/'Faxa_taux ','Foxx_taux '/) ! mean_zonal_moment_flx_atm + F_flds(2 ,:) = (/'Faxa_tauy ','Foxx_tauy '/) ! mean_merid_moment_flx_atm + F_flds(3 ,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate + F_flds(4 ,:) = (/'Faxa_lwnet ','Foxx_lwnet '/) ! mean_net_lw_flx + F_flds(5 ,:) = (/'Faxa_sen ','Foxx_sen '/) ! mean_sensi_heat_flx + F_flds(6 ,:) = (/'Faxa_lat ','Foxx_evap '/) ! mean_laten_heat_flx + F_flds(7 ,:) = (/'Faxa_swndr ','Foxx_swnet_idr'/) ! inst_down_sw_ir_dir_flx + F_flds(8 ,:) = (/'Faxa_swndf ','Foxx_swnet_idf'/) ! inst_down_sw_ir_dif_flx + F_flds(9 ,:) = (/'Faxa_swvdr ','Foxx_swnet_vdr'/) ! inst_down_sw_vis_dir_flx + F_flds(10,:) = (/'Faxa_swvdf ','Foxx_swnet_vdf'/) ! inst_down_sw_vis_dif_flx + do n = 1,size(F_flds,1) + fldname1 = trim(F_flds(n,1)) + fldname2 = trim(F_flds(n,2)) + if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname2),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname1),rc=rc) & + ) then + call addmap_from(compatm, trim(fldname1), compocn, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) + call addmrg_to(compocn, trim(fldname2), & + mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') + end if + end do + deallocate(F_flds) + end if end if !===================================================================== diff --git a/mediator/med.F90 b/mediator/med.F90 index 88245dedb..0cc9ee317 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1837,7 +1837,7 @@ subroutine DataInitialize(gcomp, 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 + else if (trim(coupling_mode(1:4)) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index c269608cc..b06f20c1c 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,ufs.nfrac,ufs.frac,ufs.nfrac.aoflux,ufs.frac.aoflux,hafs] + character(len=CS), public :: coupling_mode ! valid values are [cesm,ufs.nfrac,ufs.frac,ufs.nfrac.aoflux,ufs.frac.aoflux,hafs,hafs.mom6] ! Atmosphere-ocean flux algorithm character(len=CS), public :: aoflux_code ! valid values are [cesm,ccpp] diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 2e2d38197..fc7e1565d 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -414,7 +414,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dstMaskValue = ispval_mask end if end if - if (trim(coupling_mode) == 'hafs') then + if (trim(coupling_mode(1:4)) == 'hafs') then if (n1 == compatm .and. n2 == compwav) then srcMaskValue = ispval_mask end if From 6979bbdadcebd97cb630d22e2f989c020c348682 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Wed, 17 Jan 2024 16:45:16 -0600 Subject: [PATCH 410/430] fix for sw bands calculation for cases without sea-ice --- mediator/med_phases_prep_ocn_mod.F90 | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 6a769bcf1..d911d93e1 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -469,11 +469,18 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) 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(:) + if (trim(coupling_mode) == 'cesm') 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(:) + else + Foxx_swnet_vdr(:) = Faxa_swvdr(:) * (1.0_R8 - avsdr(:)) + Foxx_swnet_vdf(:) = Faxa_swvdf(:) * (1.0_R8 - avsdf(:)) + Foxx_swnet_idr(:) = Faxa_swndr(:) * (1.0_R8 - anidr(:)) + Foxx_swnet_idf(:) = Faxa_swndf(:) * (1.0_R8 - anidf(:)) + end if end if end if From 10e46c3ad443aae605a683f0461391cb68e32bfa Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Thu, 18 Jan 2024 22:49:13 -0600 Subject: [PATCH 411/430] more work for regional mom6 coupling --- mediator/esmFldsExchange_hafs_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 4aa02a7b8..635e51b04 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -263,7 +263,7 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) F_flds(3 ,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate F_flds(4 ,:) = (/'Faxa_lwnet ','Foxx_lwnet '/) ! mean_net_lw_flx F_flds(5 ,:) = (/'Faxa_sen ','Foxx_sen '/) ! mean_sensi_heat_flx - F_flds(6 ,:) = (/'Faxa_lat ','Foxx_evap '/) ! mean_laten_heat_flx + F_flds(6 ,:) = (/'Faxa_evap ','Foxx_evap '/) ! inst_evap_rate F_flds(7 ,:) = (/'Faxa_swndr ','Foxx_swnet_idr'/) ! inst_down_sw_ir_dir_flx F_flds(8 ,:) = (/'Faxa_swndf ','Foxx_swnet_idf'/) ! inst_down_sw_ir_dif_flx F_flds(9 ,:) = (/'Faxa_swvdr ','Foxx_swnet_vdr'/) ! inst_down_sw_vis_dir_flx @@ -546,7 +546,7 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) F_flds(3 ,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate F_flds(4 ,:) = (/'Faxa_lwnet ','Foxx_lwnet '/) ! mean_net_lw_flx F_flds(5 ,:) = (/'Faxa_sen ','Foxx_sen '/) ! mean_sensi_heat_flx - F_flds(6 ,:) = (/'Faxa_lat ','Foxx_evap '/) ! mean_laten_heat_flx + F_flds(6 ,:) = (/'Faxa_evap ','Foxx_evap '/) ! inst_evap_rate F_flds(7 ,:) = (/'Faxa_swndr ','Foxx_swnet_idr'/) ! inst_down_sw_ir_dir_flx F_flds(8 ,:) = (/'Faxa_swndf ','Foxx_swnet_idf'/) ! inst_down_sw_ir_dif_flx F_flds(9 ,:) = (/'Faxa_swvdr ','Foxx_swnet_vdr'/) ! inst_down_sw_vis_dir_flx From ad1e9a2ecbb6a240b8326ee36efd76a070aee4ae Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Fri, 19 Jan 2024 17:01:49 -0600 Subject: [PATCH 412/430] update for hafs.mom6 --- mediator/esmFldsExchange_hafs_mod.F90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 635e51b04..5800516f9 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -150,11 +150,13 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) !---------------------------------------------------------- ! from med: ocean albedos (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') + if (trim(coupling_mode) == 'hafs.mom6') then + 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 end if !===================================================================== From a1cbcbcb0189c49cdd3336b4f7c24b6e0b6aa0dc Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Fri, 19 Jan 2024 18:01:10 -0600 Subject: [PATCH 413/430] switch TOTAL to SELECT for other interpolation types too --- mediator/med_map_mod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index fc7e1565d..4331cfd97 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -1367,7 +1367,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_MAXSTR use ESMF , only : ESMF_Field, ESMF_FieldRegrid - use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_Region_Flag, ESMF_REGION_TOTAL + use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_Region_Flag use ESMF , only : ESMF_REGION_SELECT use ESMF , only : ESMF_RouteHandle use ESMF , only : ESMF_FieldWriteVTK @@ -1400,7 +1400,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r if (maptype == mapnstod_consd) then call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(mapnstod), & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then call Field_diagnose(field_dst, lfldname, " --> after nstod: ", rc=rc) @@ -1415,7 +1415,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r end if else if (maptype == mapnstod_consf) then call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(mapnstod), & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then call Field_diagnose(field_dst, lfldname, " --> after nstod: ", rc=rc) @@ -1438,7 +1438,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r end if else call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(maptype), & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if From fb993eb4b6a67859aa50e7a420517bfeb7713c92 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 25 Jan 2024 10:58:54 -0700 Subject: [PATCH 414/430] fix from Denise for crash when diagnose is on by initializing --- mediator/med_map_mod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 4331cfd97..48215333c 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -893,12 +893,14 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & if (npacked(mapindex) > 0) then ! Create the packed source field bundle for mapindex allocate(ptrsrc_packed(npacked(mapindex), lsize_src)) + ptrsrc_packed(npacked(mapindex),:) = 0._R8 packed_data(mapindex)%field_src = ESMF_FieldCreate(lmesh_src, & ptrsrc_packed, gridToFieldMap=(/2/), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Create the packed destination field bundle for mapindex allocate(ptrdst_packed(npacked(mapindex), lsize_dst)) + ptrdst_packed(npacked(mapindex),:) = 0._R8 packed_data(mapindex)%field_dst = ESMF_FieldCreate(lmesh_dst, & ptrdst_packed, gridToFieldMap=(/2/), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From 8c10846bbdcd6417e660c73ae6fc11c2e5559e63 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Sat, 27 Jan 2024 14:38:42 -0700 Subject: [PATCH 415/430] fix issue arised in CESM testing --- mediator/med_map_mod.F90 | 39 +++++++++++++++++++++++++++------------ 1 file changed, 27 insertions(+), 12 deletions(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 48215333c..8ba343f4e 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -933,6 +933,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ use ESMF , only : ESMF_FieldRedist, ESMF_RouteHandle use ESMF , only : ESMF_FieldFill use ESMF , only : ESMF_KIND_R8 + use ESMF , only : ESMF_Region_Flag, ESMF_REGION_SELECT, ESMF_REGION_TOTAL 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 @@ -967,6 +968,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ character(cl) :: field_name character(cl), allocatable :: field_namelist_dat(:) logical :: skip_mapping + type(ESMF_Region_Flag) :: zeroregion real(ESMF_KIND_R8), parameter :: fillValue = 9.99e20_ESMF_KIND_R8 character(len=*), parameter :: subname=' (med_map_mod:med_map_field_packed) ' !----------------------------------------------------------- @@ -1124,11 +1126,18 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ end do end if end do + + ! Set zeroregion option to select since we are blending data + zeroregion = ESMF_REGION_SELECT else ! Fill packed destination field/s with large value if data is unavailable - ! The data needs to be compated in the component side + ! The data needs to be merged in the component side + ! This is also required for mapfillv_bilnr interpolation type call ESMF_FieldFill(packed_data(mapindex)%field_dst, dataFillScheme="const", const1=fillValue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Set zeroregion option to total since we have no data to blend + zeroregion = ESMF_REGION_TOTAL end if ! ----------------------------------- @@ -1174,6 +1183,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ field_dst=packed_data(mapindex)%field_dst, & routehandles=routehandles, & maptype=mapindex, & + zeroregiontype=zeroregion, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1360,7 +1370,7 @@ subroutine med_map_field_normalized(field_src, field_dst, routehandles, maptype, end subroutine med_map_field_normalized !================================================================================ - subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, rc) + subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, zeroregiontype, rc) !--------------------------------------------------- ! map the source field to the destination field @@ -1370,7 +1380,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_MAXSTR use ESMF , only : ESMF_Field, ESMF_FieldRegrid use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_Region_Flag - use ESMF , only : ESMF_REGION_SELECT + use ESMF , only : ESMF_REGION_TOTAL, ESMF_REGION_SELECT use ESMF , only : ESMF_RouteHandle use ESMF , only : ESMF_FieldWriteVTK use med_internalstate_mod , only : mapnstod_consd, mapnstod_consf, mapnstod_consd, mapnstod @@ -1379,16 +1389,18 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r use med_methods_mod , only : Field_diagnose => med_methods_Field_diagnose ! input/output variables - type(ESMF_Field) , intent(in) :: field_src - type(ESMF_Field) , intent(inout) :: field_dst - type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) - integer , intent(in) :: maptype - character(len=*), optional, intent(in) :: fldname - integer, optional , intent(out) :: rc + type(ESMF_Field) , intent(in) :: field_src + type(ESMF_Field) , intent(inout) :: field_dst + type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) + integer , intent(in) :: maptype + character(len=*), optional , intent(in) :: fldname + type(ESMF_Region_Flag), optional, intent(in) :: zeroregiontype + integer, optional , intent(out) :: rc ! local variables logical :: checkflag = .false. character(len=CS) :: lfldname + type(ESMF_Region_Flag) :: zeroregion character(len=*), parameter :: subname='(med_map_mod:med_map_field) ' !--------------------------------------------------- @@ -1400,9 +1412,12 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r lfldname = 'unknown' if (present(fldname)) lfldname = trim(fldname) + zeroregion = ESMF_REGION_TOTAL + if (present(zeroregiontype)) zeroregion = zeroregiontype + if (maptype == mapnstod_consd) then call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(mapnstod), & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=zeroregion, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then call Field_diagnose(field_dst, lfldname, " --> after nstod: ", rc=rc) @@ -1417,7 +1432,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r end if else if (maptype == mapnstod_consf) then call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(mapnstod), & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=zeroregion, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then call Field_diagnose(field_dst, lfldname, " --> after nstod: ", rc=rc) @@ -1440,7 +1455,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r end if else call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(maptype), & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if From 64e1c276dee0de636b03a9bd1186fb794699b02d Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Sun, 28 Jan 2024 19:35:04 -0700 Subject: [PATCH 416/430] fix Faxa_rainc issue when add_gusts is turned on --- mediator/med_phases_aofluxes_mod.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 1d8efe7e8..5252e6edc 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1597,6 +1597,10 @@ 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 + if (add_gusts) then + call fldbun_getfldptr(fldbun_a, 'Faxa_rainc', aoflux_in%rainc, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end if ! extra fields for ufs.frac.aoflux From 09dfd3c432cc97f7f4eb265c5be7a9b8f7127694 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Mon, 29 Jan 2024 09:28:27 -0600 Subject: [PATCH 417/430] fix comments mean -> inst and minor typo --- mediator/esmFldsExchange_hafs_mod.F90 | 48 +++++++++++++-------------- mediator/med.F90 | 2 +- 2 files changed, 25 insertions(+), 25 deletions(-) diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 5800516f9..b545b9b1c 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -244,13 +244,13 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then if (trim(coupling_mode) == 'hafs') then allocate(F_flds(7,2)) - F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! mean_zonal_moment_flx_atm - F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! mean_merid_moment_flx_atm - F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate - F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! mean_net_sw_flx - F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! mean_net_lw_flx - F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! mean_sensi_heat_flx - F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! mean_laten_heat_flx + F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! inst_zonal_moment_flx_atm + F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! inst_merid_moment_flx_atm + F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! inst_prec_rate + F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! inst_net_sw_flx + F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! inst_net_lw_flx + F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! inst_sensi_heat_flx + F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! inst_laten_heat_flx do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) fldname2 = trim(F_flds(n,2)) @@ -260,11 +260,11 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) deallocate(F_flds) else allocate(F_flds(10,2)) - F_flds(1 ,:) = (/'Faxa_taux ','Foxx_taux '/) ! mean_zonal_moment_flx_atm - F_flds(2 ,:) = (/'Faxa_tauy ','Foxx_tauy '/) ! mean_merid_moment_flx_atm - F_flds(3 ,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate - F_flds(4 ,:) = (/'Faxa_lwnet ','Foxx_lwnet '/) ! mean_net_lw_flx - F_flds(5 ,:) = (/'Faxa_sen ','Foxx_sen '/) ! mean_sensi_heat_flx + F_flds(1 ,:) = (/'Faxa_taux ','Foxx_taux '/) ! inst_zonal_moment_flx_atm + F_flds(2 ,:) = (/'Faxa_tauy ','Foxx_tauy '/) ! inst_merid_moment_flx_atm + F_flds(3 ,:) = (/'Faxa_rain ','Faxa_rain '/) ! inst_prec_rate + F_flds(4 ,:) = (/'Faxa_lwnet ','Foxx_lwnet '/) ! inst_net_lw_flx + F_flds(5 ,:) = (/'Faxa_sen ','Foxx_sen '/) ! inst_sensi_heat_flx F_flds(6 ,:) = (/'Faxa_evap ','Foxx_evap '/) ! inst_evap_rate F_flds(7 ,:) = (/'Faxa_swndr ','Foxx_swnet_idr'/) ! inst_down_sw_ir_dir_flx F_flds(8 ,:) = (/'Faxa_swndf ','Foxx_swnet_idf'/) ! inst_down_sw_ir_dif_flx @@ -521,13 +521,13 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then if (trim(coupling_mode) == 'hafs') then allocate(F_flds(7,2)) - F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! mean_zonal_moment_flx_atm - F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! mean_merid_moment_flx_atm - F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate - F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! mean_net_sw_flx - F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! mean_net_lw_flx - F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! mean_sensi_heat_flx - F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! mean_laten_heat_flx + F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! inst_zonal_moment_flx_atm + F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! inst_merid_moment_flx_atm + F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! inst_prec_rate + F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! inst_net_sw_flx + F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! inst_net_lw_flx + F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! inst_sensi_heat_flx + F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! inst_laten_heat_flx do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) fldname2 = trim(F_flds(n,2)) @@ -543,11 +543,11 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) deallocate(F_flds) else allocate(F_flds(10,2)) - F_flds(1 ,:) = (/'Faxa_taux ','Foxx_taux '/) ! mean_zonal_moment_flx_atm - F_flds(2 ,:) = (/'Faxa_tauy ','Foxx_tauy '/) ! mean_merid_moment_flx_atm - F_flds(3 ,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate - F_flds(4 ,:) = (/'Faxa_lwnet ','Foxx_lwnet '/) ! mean_net_lw_flx - F_flds(5 ,:) = (/'Faxa_sen ','Foxx_sen '/) ! mean_sensi_heat_flx + F_flds(1 ,:) = (/'Faxa_taux ','Foxx_taux '/) ! inst_zonal_moment_flx_atm + F_flds(2 ,:) = (/'Faxa_tauy ','Foxx_tauy '/) ! inst_merid_moment_flx_atm + F_flds(3 ,:) = (/'Faxa_rain ','Faxa_rain '/) ! inst_prec_rate + F_flds(4 ,:) = (/'Faxa_lwnet ','Foxx_lwnet '/) ! inst_net_lw_flx + F_flds(5 ,:) = (/'Faxa_sen ','Foxx_sen '/) ! inst_sensi_heat_flx F_flds(6 ,:) = (/'Faxa_evap ','Foxx_evap '/) ! inst_evap_rate F_flds(7 ,:) = (/'Faxa_swndr ','Foxx_swnet_idr'/) ! inst_down_sw_ir_dir_flx F_flds(8 ,:) = (/'Faxa_swndf ','Foxx_swnet_idf'/) ! inst_down_sw_ir_dif_flx diff --git a/mediator/med.F90 b/mediator/med.F90 index 928aba9eb..99ec6902c 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -950,7 +950,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) endif endif - ! Should terget component use all data for first time step? + ! Should target component use all data for first time step? do ncomp = 1,ncomps if (ncomp /= compmed) then call NUOPC_CompAttributeGet(gcomp, name=trim(compname(ncomp))//"_use_data_first_import", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) From c4f5082a871b32e11f28311b0c466f913f070a8d Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Tue, 30 Jan 2024 14:27:56 -0600 Subject: [PATCH 418/430] minor fix - remove trim --- mediator/med.F90 | 2 +- mediator/med_map_mod.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 99ec6902c..4a8d3d90b 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1835,7 +1835,7 @@ subroutine DataInitialize(gcomp, 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(1:4)) == 'hafs') then + else if (coupling_mode(1:4) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='initialize', 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 f5ac5772f..bcf178fbd 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -414,7 +414,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dstMaskValue = ispval_mask end if end if - if (trim(coupling_mode(1:4)) == 'hafs') then + if (coupling_mode(1:4) == 'hafs') then if (n1 == compatm .and. n2 == compwav) then srcMaskValue = ispval_mask end if From e155c9ac743559c567611f20d905b0c14784cbc2 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 30 Jan 2024 13:56:21 -0700 Subject: [PATCH 419/430] srt does not work with most recent cime, cmeps requires most recent cdeps --- .github/workflows/srt.yml | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 34252cb63..8765650cc 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -79,7 +79,14 @@ jobs: - name: checkout externals run: | pushd cesm - ./manage_externals/checkout_externals ccs_config cdeps cime share mct cpl7 parallelio + # manage_externals does not work with the latest cime versions + git clone https://github.com/ESMCI/cime + cd cime + git submodule update --init + cd ../ + ./manage_externals/checkout_externals ccs_config cdeps share mct cpl7 parallelio + cd components/cdeps + git checkout main - name: Cache ESMF id: cache-esmf From 682a497b613ec396ea6c2f8236d3a22c7df11bc0 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 30 Jan 2024 16:53:08 -0700 Subject: [PATCH 420/430] fix cime checkout --- .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 ad580d275..eaf9973cf 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -79,11 +79,11 @@ jobs: - name: checkout externals run: | pushd cesm - ./manage_externals/checkout_externals ccs_config cdeps cime share mct cpl7 parallelio + ./manage_externals/checkout_externals ccs_config cdeps share mct cpl7 parallelio cd ccs_config - git checkout main - cd ../cime - git checkout master + git checkout main + cd ../ + git clone https://github.com/ESMCI/cime if [[ ! -e "${PWD}/.gitmodules.bak" ]] then echo "Convering git@github.com to https://github.com urls in ${PWD}/.gitmodules" From 87c473c73b6537951113cba0567ef95da068b93e Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 30 Jan 2024 16:53:45 -0700 Subject: [PATCH 421/430] turn off tmate --- .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 eaf9973cf..e75fae5b3 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -189,6 +189,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 12901407e0abb0e46b0191cde14252b87327e0ae Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 30 Jan 2024 16:58:02 -0700 Subject: [PATCH 422/430] fix path --- .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 e75fae5b3..d65dcb45f 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -84,9 +84,10 @@ jobs: git checkout main cd ../ git clone https://github.com/ESMCI/cime + cd cime if [[ ! -e "${PWD}/.gitmodules.bak" ]] then - echo "Convering git@github.com to https://github.com urls in ${PWD}/.gitmodules" + echo "Converting 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 From 455b2be66f1ae0b760183160ca5ed1e876f5d92e Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 30 Jan 2024 18:27:00 -0700 Subject: [PATCH 423/430] 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 d65dcb45f..1044661ba 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -190,6 +190,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 170adbe25abbf368b7f2aba89c69c12f6d4df751 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 30 Jan 2024 18:40:53 -0700 Subject: [PATCH 424/430] give format a length --- mediator/med_phases_cdeps_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index 7b703e460..72ac560cc 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -170,7 +170,7 @@ subroutine med_phases_cdeps_run(gcomp, rc) if (size(sdat(n1,n2)%stream) == 0 .and. streamid /= 0) then ! Debug print if (maintask) then - write(logunit,'(a,i)') trim(subname)//": initialize stream ", streamid + write(logunit,'(a,i3)') trim(subname)//": initialize stream ", streamid end if ! Allocate temporary variable to store file names in the stream @@ -258,7 +258,7 @@ subroutine med_phases_cdeps_run(gcomp, rc) if (size(sdat(n1,n2)%stream) > 0) then ! Debug print if (maintask) then - write(logunit,'(a,i)') trim(subname)//": read stream "//trim(compname(n1))//" -> "//trim(compname(n2)) + write(logunit,'(a)') trim(subname)//": read stream "//trim(compname(n1))//" -> "//trim(compname(n2)) end if ! Read data From 41276365db776abf6ac69d6d190da72e08478d93 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 31 Jan 2024 09:20:23 -0500 Subject: [PATCH 425/430] fix dummy arguments w/o values --- ufs/glc_elevclass_mod.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/ufs/glc_elevclass_mod.F90 b/ufs/glc_elevclass_mod.F90 index 6524f064f..626bb3ee0 100644 --- a/ufs/glc_elevclass_mod.F90 +++ b/ufs/glc_elevclass_mod.F90 @@ -37,6 +37,7 @@ subroutine glc_get_elevation_classes_without_bareland(glc_topo, glc_elevclass, l real(r8), intent(in) :: glc_topo(:) ! topographic height integer , intent(out) :: glc_elevclass(:) ! elevation class integer , intent(in) :: logunit + glc_elevclass = 0 end subroutine glc_get_elevation_classes_without_bareland !----------------------------------------------------------------------- @@ -45,6 +46,7 @@ subroutine glc_get_elevation_classes_with_bareland(glc_ice_covered, glc_topo, gl real(r8), intent(in) :: glc_topo(:) ! ice topographic height integer , intent(out) :: glc_elevclass(:) ! elevation class integer , intent(in) :: logunit + glc_elevclass = 0 end subroutine glc_get_elevation_classes_with_bareland !----------------------------------------------------------------------- @@ -57,11 +59,12 @@ end function glc_mean_elevation_virtual !----------------------------------------------------------------------- subroutine glc_get_fractional_icecov(nec, glc_topo, glc_icefrac, glc_icefrac_ec, logunit) - integer , intent(in) :: nec ! number of elevation classes + integer , intent(in) :: nec ! number of elevation classes real(r8), intent(in) :: glc_topo(:) ! topographic height real(r8), intent(in) :: glc_icefrac(:) real(r8), intent(out) :: glc_icefrac_ec(:,:) integer , intent(in) :: logunit + glc_icefrac_ec = 0.0_r8 end subroutine glc_get_fractional_icecov end module glc_elevclass_mod From 14878f49cbfb15c422bf54718214e7af5555f8a9 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Sun, 3 Mar 2024 08:19:59 -0500 Subject: [PATCH 426/430] add cpl_scalar for tiled grids, other minor fixes * add new cpl_scalar for mediator history files for tiled gridded domains, eg cube-sphere. Replaces existing use of config variables which restricted the use to 6-tiles domain * remove unnecessary trims, fix minor typos and indentation --- mediator/med.F90 | 34 +++++++--- mediator/med_fraction_mod.F90 | 6 +- mediator/med_internalstate_mod.F90 | 8 ++- mediator/med_io_mod.F90 | 41 ++++++----- mediator/med_map_mod.F90 | 102 ++++++++++++++-------------- mediator/med_phases_history_mod.F90 | 42 ++++-------- 6 files changed, 117 insertions(+), 116 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 4a8d3d90b..7c379ad90 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -510,7 +510,7 @@ subroutine SetServices(gcomp, rc) #ifdef CDEPS_INLINE !------------------ - ! phase routine for cdeps inline capabilty + ! phase routine for cdeps inline capabilty !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & @@ -832,10 +832,10 @@ 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:3)) == 'ufs') then + else if (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 + else if (coupling_mode(1:4) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else @@ -867,6 +867,15 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) is_local%wrap%flds_scalar_index_ny + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNTile", 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%flds_scalar_index_ntile + else + is_local%wrap%flds_scalar_index_ntile = 0 + end if + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -962,7 +971,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) endif if (maintask) then write(logunit,*) trim(compname(ncomp))//'_use_data_first_import is ', is_local%wrap%med_data_force_first(ncomp) - endif + endif end if end do @@ -1067,7 +1076,7 @@ subroutine ModifyDecompofMesh(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ - ! Recieve Grids + ! Receive Grids !------------------ do n1 = 1,ncomps @@ -1644,7 +1653,7 @@ subroutine DataInitialize(gcomp, rc) logical :: read_restart logical :: allDone = .false. logical,save :: first_call = .true. - real(r8) :: real_nx, real_ny + real(r8) :: real_nx, real_ny, real_ntile character(len=CX) :: msgString character(len=*), parameter :: subname = '('//__FILE__//':DataInitialize)' !----------------------------------------------------------- @@ -1832,7 +1841,7 @@ 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:3)) == 'ufs') then + else if (coupling_mode(1:3) == 'ufs') then call esmFldsExchange_ufs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (coupling_mode(1:4) == 'hafs') then @@ -2128,11 +2137,18 @@ subroutine DataInitialize(gcomp, rc) flds_scalar_name=is_local%wrap%flds_scalar_name, & flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call State_GetScalar(scalar_value=real_ntile, & + scalar_id=is_local%wrap%flds_scalar_index_ntile, & + state=is_local%wrap%NstateImp(n1), & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return 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) + is_local%wrap%ntile(n1) = nint(real_ntile) + write(msgString,'(3i8)') is_local%wrap%nx(n1), is_local%wrap%ny(n1), is_local%wrap%ntile(n1) if (maintask) then - write(logunit,'(a)') 'global nx,ny sizes for '//trim(compname(n1))//":"//trim(msgString) + write(logunit,'(a)') 'global nx,ny,ntile sizes for '//trim(compname(n1))//":"//trim(msgString) end if call ESMF_LogWrite(trim(subname)//":"//trim(compname(n1))//":"//trim(msgString), ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 2f7d43041..b0cd53a61 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(1:9)) == 'ufs.nfrac' ) then + if (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(1:9)) == 'ufs.nfrac' ) then + if (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(1:9)) == 'ufs.nfrac' ) then + if (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 b06f20c1c..5609f5ea6 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -121,7 +121,7 @@ module med_internalstate_mod ! Present/allowed coupling/active coupling logical flags logical, pointer :: comp_present(:) ! comp present flag logical, pointer :: med_coupling_active(:,:) ! computes the active coupling - logical, pointer :: med_data_active(:,:) ! uses stream data to provide background fill + logical, pointer :: med_data_active(:,:) ! uses stream data to provide background fill logical, pointer :: med_data_force_first(:) ! force to use stream data for first coupling timestep integer :: num_icesheets ! obtained from attribute logical :: ocn2glc_coupling = .false. ! obtained from attribute @@ -132,13 +132,14 @@ module med_internalstate_mod type(ESMF_VM) :: vm ! Global nx,ny dimensions of input arrays (needed for mediator history output) - integer, pointer :: nx(:), ny(:) + integer, pointer :: nx(:), ny(:), ntile(:) ! 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_ntile = 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 @@ -312,6 +313,7 @@ subroutine med_internalstate_init(gcomp, rc) allocate(is_local%wrap%med_data_force_first(ncomps)) allocate(is_local%wrap%nx(ncomps)) allocate(is_local%wrap%ny(ncomps)) + allocate(is_local%wrap%ntile(ncomps)) allocate(is_local%wrap%NStateImp(ncomps)) allocate(is_local%wrap%NStateExp(ncomps)) allocate(is_local%wrap%FBImp(ncomps,ncomps)) @@ -601,7 +603,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:3)) == 'ufs') then + if ( 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_io_mod.F90 b/mediator/med_io_mod.F90 index 265a5ddda..f4abadaf6 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -698,7 +698,7 @@ end function med_io_sec2hms !=============================================================================== subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & - fillval, pre, flds, tavg, use_float, tilesize, rc) + fillval, pre, flds, tavg, use_float, ntile, rc) !--------------- ! Write FB to netcdf file @@ -728,7 +728,7 @@ subroutine med_io_write_FB(io_file, 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) :: tilesize ! if non-zero, write atm component on tiles + integer, optional , intent(in) :: ntile ! number of nx * ny tiles integer , intent(out):: rc ! local variables @@ -754,7 +754,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & character(CS) :: coordvarnames(2) ! coordinate variable names character(CS) :: coordnames(2) ! coordinate long names character(CS) :: coordunits(2) ! coordinate units - integer :: lnx,lny + integer :: lnx,lny,lntile logical :: luse_float real(r8) :: lfillvalue integer, pointer :: minIndexPTile(:,:) @@ -770,8 +770,7 @@ subroutine med_io_write_FB(io_file, 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 :: atmtiles - integer :: ntiles = 1 + logical :: tiles character(CL), allocatable :: fieldNameList(:) character(*),parameter :: subName = '(med_io_write_FB) ' !------------------------------------------------------------------------------- @@ -785,9 +784,9 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & luse_float = .false. if (present(use_float)) luse_float = use_float - atmtiles = .false. - if (present(tilesize)) then - if (tilesize > 0) atmtiles = .true. + tiles = .false. + if (present(ntile)) then + if (ntile > 0) tiles = .true. end if ! Error check @@ -870,14 +869,14 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & ! all the global grid values in the distgrid - e.g. CTSM ng = maxval(maxIndexPTile) - if (atmtiles) then - lnx = tilesize - lny = tilesize - ntiles = ng/(lnx*lny) - write(tmpstr,*) subname, 'ng,lnx,lny,ntiles = ',ng,lnx,lny,ntiles + if (tiles) then + lnx = nx + lny = ny + lntile = ng/(lnx*lny) + write(tmpstr,*) subname, 'ng,lnx,lny,lntile = ',ng,lnx,lny,lntile call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - if (ntiles /= 6) then - call ESMF_LogWrite(trim(subname)//' ERROR: only cubed sphere atm tiles valid ', ESMF_LOGMSG_INFO) + if (lntile /= ntile) then + call ESMF_LogWrite(trim(subname)//' ERROR: grid2d size and ntile are not consistent ', ESMF_LOGMSG_INFO) call ESMF_Finalize(endflag=ESMF_END_ABORT) endif else @@ -900,10 +899,10 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & ! Write header if (whead) then - if (atmtiles) then + if (tiles) then 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)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ntile', ntile, dimid3(3)) if (present(nt)) then dimid4(1:3) = dimid3 rcode = pio_inq_dimid(io_file, 'time', dimid4(4)) @@ -1020,8 +1019,8 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - if (atmtiles) then - call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny,ntiles/), dof, iodesc) + if (tiles) then + call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny,ntile/), dof, iodesc) else call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) !call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom) @@ -1579,8 +1578,8 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) allocate(fldptr1_tmp(lsize)) do n = 1,ungriddedUBound(1) - ! Creat a name for the 1d field on the mediator history or restart file based on the - ! ungridded dimension index of the field bundle 2d fiedl + ! Create a name for the 1d field on the mediator history or restart file based on the + ! ungridded dimension index of the field bundle 2d field write(cnumber,'(i0)') n name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index f77d4242e..2c4da67b4 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:3)) == 'ufs') then + if (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:3)) == 'ufs') then + if (trim(coupling_mode) == 'cesm' .or. 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 @@ -949,7 +949,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ type(ESMF_FieldBundle) , intent(in) :: FBFracSrc ! fraction field bundle for source type(packed_data_type) , intent(inout) :: packed_data(:) ! array over mapping types type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) - type(ESMF_FieldBundle), optional, intent(in) :: FBDat ! data field bundle + type(ESMF_FieldBundle), optional, intent(in) :: FBDat ! data field bundle logical, optional , intent(in) :: use_data ! skip mapping and use data instead integer, optional , intent(out) :: rc @@ -1008,7 +1008,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ allocate(field_namelist_dat(fieldcount_dat)) call ESMF_FieldBundleGet(FBDat, fieldlist=fieldlist_dat, fieldNameList=field_namelist_dat, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - + if (present(use_data)) skip_mapping = use_data end if end if @@ -1072,7 +1072,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ call t_stopf('MED:'//trim(subname)//' copy from src') ! ----------------------------------- - ! Fill destination field with background data provided by CDEPS inline + ! Fill destination field with background data provided by CDEPS inline ! ----------------------------------- if (fieldcount_dat > 0) then @@ -1085,52 +1085,52 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ ! Get the indices into the packed data structure np = packed_data(mapindex)%fldindex(nf) if (np > 0) then - ! Get size of ungridded dimension and name of the field - call ESMF_FieldGet(fieldlist_dst(nf), ungriddedUBound=ungriddedUBound, name=field_name, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (maintask) write(logunit,'(a)') trim(subname)//" search "//trim(field_name)//" field for background fill." - - ! Check if field has match in data fields - isFound = .false. - do nfd = 1, fieldcount_dat - ! Debug output for checked fields to find match - if (maintask .and. dbug_flag > 1) write(logunit,'(a)') trim(field_name)//" - "//trim(field_namelist_dat(nfd)) - - if (trim(field_name) == trim(field_namelist_dat(nfd))) then - ! Debug output about match - if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_namelist_dat(nfd))//" is found!" - - ! Get pointer from data field - call ESMF_FieldGet(fieldlist_dat(nfd), farrayptr=dataptr, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (dbug_flag > 1) then - call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> before background fill: ", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - - ! Fill destination field with background data coming from stream - dataptr2d_packed(np,:) = dataptr(:) - - if (dbug_flag > 1) then - call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> after background fill: ", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - - ! Exit from loop since match is already found - isFound = .true. - exit - end if - end do ! loop for stream fields - - ! Could not find match in the list of stream fields - if (.not. isFound) then - if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_name)//" is not found!" - - ! Fill destination field with very large background data - dataptr2d_packed(np,:) = fillValue - end if + ! Get size of ungridded dimension and name of the field + call ESMF_FieldGet(fieldlist_dst(nf), ungriddedUBound=ungriddedUBound, name=field_name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (maintask) write(logunit,'(a)') trim(subname)//" search "//trim(field_name)//" field for background fill." + + ! Check if field has match in data fields + isFound = .false. + do nfd = 1, fieldcount_dat + ! Debug output for checked fields to find match + if (maintask .and. dbug_flag > 1) write(logunit,'(a)') trim(field_name)//" - "//trim(field_namelist_dat(nfd)) + + if (trim(field_name) == trim(field_namelist_dat(nfd))) then + ! Debug output about match + if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_namelist_dat(nfd))//" is found!" + + ! Get pointer from data field + call ESMF_FieldGet(fieldlist_dat(nfd), farrayptr=dataptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 1) then + call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> before background fill: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! Fill destination field with background data coming from stream + dataptr2d_packed(np,:) = dataptr(:) + + if (dbug_flag > 1) then + call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> after background fill: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! Exit from loop since match is already found + isFound = .true. + exit + end if + end do ! loop for stream fields + + ! Could not find match in the list of stream fields + if (.not. isFound) then + if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_name)//" is not found!" + + ! Fill destination field with very large background data + dataptr2d_packed(np,:) = fillValue + end if end if end do ! loop for destination fields diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 7d59a7fea..606b6159b 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -322,12 +322,14 @@ subroutine med_phases_history_write(gcomp, rc) if (is_local%wrap%comp_present(n)) then if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then 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) + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Imp', & + ntile=is_local%wrap%ntile(n), 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(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) + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Exp', & + ntile=is_local%wrap%ntile(n), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif end if @@ -672,13 +674,13 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) integer :: hist_n ! freq_n setting relative to freq_option character(CL) :: hist_option_in character(CL) :: hist_n_in - integer :: hist_tilesize logical :: isPresent logical :: isSet type(ESMF_VM) :: vm type(ESMF_Calendar) :: calendar ! calendar type integer :: m ! indices integer :: nx,ny ! global grid size + integer :: ntile ! number of tiles for tiled domain eg CSG character(CL) :: time_units ! units of time variable character(CL) :: hist_file ! history file name real(r8) :: time_val ! time coordinate output @@ -694,16 +696,6 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine if tiled output to history file is requested - call NUOPC_CompAttributeGet(gcomp, name='history_tile_'//trim(compname(compid)), isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - call NUOPC_CompAttributeGet(gcomp, name='history_tile_'//trim(compname(compid)), value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) hist_tilesize - else - hist_tilesize = 0 - end if ! alarm is not set determine hist_option and hist_n if (.not. instfile%is_clockset) then @@ -775,22 +767,23 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) nx = is_local%wrap%nx(compid) ny = is_local%wrap%ny(compid) + ntile = is_local%wrap%ntile(compid) ! Define/write import field bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then 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) + nt=1, pre=trim(compname(compid))//'Imp', ntile=ntile, 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(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) + nt=1, pre=trim(compname(compid))//'Exp', ntile=ntile, 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(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) + nt=1, pre='Med_frac_'//trim(compname(compid)), ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -830,13 +823,13 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) integer :: hist_n ! freq_n setting relative to freq_option character(CL) :: hist_option_in character(CL) :: hist_n_in - integer :: hist_tilesize logical :: isPresent logical :: isSet type(ESMF_VM) :: vm type(ESMF_Calendar) :: calendar ! calendar type integer :: m ! indices integer :: nx,ny ! global grid size + integer :: ntile ! number of tiles for tiled domain eg CSG character(CL) :: time_units ! units of time variable character(CL) :: hist_file ! history file name real(r8) :: time_val ! time coordinate output @@ -854,16 +847,6 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine if tiled output to history file is requested - call NUOPC_CompAttributeGet(gcomp, name='history_tile_'//trim(compname(compid)), isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - call NUOPC_CompAttributeGet(gcomp, name='history_tile_'//trim(compname(compid)), value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) hist_tilesize - else - hist_tilesize = 0 - end if ! alarm is not set determine hist_option and hist_n if (.not. avgfile%is_clockset) then @@ -982,9 +965,10 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) if (is_local%wrap%comp_present(compid)) then nx = is_local%wrap%nx(compid) ny = is_local%wrap%ny(compid) + ntile = is_local%wrap%ntile(compid) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then 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) + nt=1, pre=trim(compname(compid))//'Imp', ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (wdata(m)) then call med_methods_FB_reset(avgfile%FBAccum_import, czero, rc=rc) @@ -993,7 +977,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then 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) + nt=1, pre=trim(compname(compid))//'Exp', ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (wdata(m)) then call med_methods_FB_reset(avgfile%FBAccum_export, czero, rc=rc) From 3515360f67a4f17ed6788646ff5851e347f0c57e Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sun, 3 Mar 2024 13:51:44 -0500 Subject: [PATCH 427/430] set ntile=0 when ntile scalar doesn't exist --- mediator/med.F90 | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 7c379ad90..9c7572a90 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -882,7 +882,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) if (isPresent .and. isSet) then read(cvalue,*) is_local%wrap%flds_scalar_index_nextsw_cday else - is_local%wrap%flds_scalar_index_nextsw_cday = spval + is_local%wrap%flds_scalar_index_nextsw_cday = 0 end if call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxPrecipFactor", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) @@ -2137,15 +2137,19 @@ subroutine DataInitialize(gcomp, rc) flds_scalar_name=is_local%wrap%flds_scalar_name, & flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call State_GetScalar(scalar_value=real_ntile, & - scalar_id=is_local%wrap%flds_scalar_index_ntile, & - state=is_local%wrap%NstateImp(n1), & - flds_scalar_name=is_local%wrap%flds_scalar_name, & - flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (is_local%wrap%flds_scalar_index_ntile > 0) then + call State_GetScalar(scalar_value=real_ntile, & + scalar_id=is_local%wrap%flds_scalar_index_ntile, & + state=is_local%wrap%NstateImp(n1), & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + is_local%wrap%ntile(n1) = nint(real_ntile) + else + is_local%wrap%ntile(n1) = 0 + end if is_local%wrap%nx(n1) = nint(real_nx) is_local%wrap%ny(n1) = nint(real_ny) - is_local%wrap%ntile(n1) = nint(real_ntile) write(msgString,'(3i8)') is_local%wrap%nx(n1), is_local%wrap%ny(n1), is_local%wrap%ntile(n1) if (maintask) then write(logunit,'(a)') 'global nx,ny,ntile sizes for '//trim(compname(n1))//":"//trim(msgString) From ac5520fa195cf5136f0a836b7183cf06d87d052f Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 4 Mar 2024 17:11:56 -0500 Subject: [PATCH 428/430] fix restarts when ntile>0 --- mediator/med.F90 | 2 +- mediator/med_internalstate_mod.F90 | 4 +++- mediator/med_phases_restart_mod.F90 | 4 ++++ 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 9c7572a90..dc0f68cf2 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -510,7 +510,7 @@ subroutine SetServices(gcomp, rc) #ifdef CDEPS_INLINE !------------------ - ! phase routine for cdeps inline capabilty + ! phase routine for cdeps inline capability !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 5609f5ea6..e45331f76 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -132,7 +132,9 @@ module med_internalstate_mod type(ESMF_VM) :: vm ! Global nx,ny dimensions of input arrays (needed for mediator history output) - integer, pointer :: nx(:), ny(:), ntile(:) + integer, pointer :: nx(:), ny(:) + ! Number of nx*ny domains (needed for cubed-sphere and regional domains) + integer, pointer :: ntile(:) ! Import/Export Scalars character(len=CL) :: flds_scalar_name = '' diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index a225ff97c..1bbbb0fbf 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -346,6 +346,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (is_local%wrap%comp_present(n)) then nx = is_local%wrap%nx(n) ny = is_local%wrap%ny(n) + if (is_local%wrap%ntile(n) > 0) then + nx = is_local%wrap%ntile(n)*is_local%wrap%ny(n)*is_local%wrap%nx(n) + ny = 1 + end if ! Write import field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then call med_io_write(io_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), nx, ny, & From 45d63c4384b8244cdc596435c94fd946c5b9761c Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 13 Mar 2024 10:02:36 -0600 Subject: [PATCH 429/430] add two fixes * testing of this feature w/ UFS noahmp lnd component, which currently runs on the CSG, found two issues. One to write the mediator fractions and areas on the tiles when using the single history file. A second fix is the mapping masking for lnd-atm coupling in UFS. --- mediator/med_map_mod.F90 | 4 ++++ mediator/med_phases_history_mod.F90 | 6 ++++-- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 2c4da67b4..c20fe4bdc 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -413,6 +413,10 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, srcMaskValue = ispval_mask dstMaskValue = ispval_mask end if + if (n1 == complnd .and. n2 == compatm) then + srcMaskValue = ispval_mask + dstMaskValue = 0 + end if end if if (coupling_mode(1:4) == 'hafs') then if (n1 == compatm .and. n2 == compwav) then diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 606b6159b..52b20c035 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -336,12 +336,14 @@ subroutine med_phases_history_write(gcomp, rc) ! Write mediator fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then 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) + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='Med_frac_'//trim(compname(n)), & + ntile=is_local%wrap%ntile(n), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write component mediator area field bundles 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) + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='MED_'//trim(compname(n)), & + ntile=is_local%wrap%ntile(n), rc=rc) end do ! Write atm/ocn fluxes and ocean albedoes if field bundles are created From 8309884aa4ef46caa672b3e38fd0b6a9bc18c199 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Wed, 13 Mar 2024 18:28:59 -0400 Subject: [PATCH 430/430] modify dstmask for lnd->atm in UFS --- 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 c20fe4bdc..3d888bcfa 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -415,7 +415,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, end if if (n1 == complnd .and. n2 == compatm) then srcMaskValue = ispval_mask - dstMaskValue = 0 + dstMaskValue = ispval_mask end if end if if (coupling_mode(1:4) == 'hafs') then