From 646ad20b2fee10bf5543d39b86d4a0707b3d294b Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 3 Nov 2021 18:50:13 -0600 Subject: [PATCH 001/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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/121] 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 76306f69927f90859eaac1bd8da0e8a14a7873ee Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 2 Nov 2022 07:05:04 -0600 Subject: [PATCH 121/121] 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)' !---------------------------------------