From 850d2ea2783cb19789052ab71f30e5366f9b102c Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 13 Jan 2021 13:21:47 -0500 Subject: [PATCH 1/5] fix character string 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 8bf7b73dd..7d7daea56 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -84,7 +84,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! 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'/) + 'Sa_u10m','Sa_v10m', 'Sa_t2m ', 'Sa_q2m '/) do n = 1,size(flds) fldname = trim(flds(n)) call addfld(fldListFr(compatm)%flds, trim(fldname)) From f1e95074fbf75095d4edbb33be6a245639a6fcf4 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 24 Mar 2021 08:35:14 -0400 Subject: [PATCH 2/5] clean branch for dststatus and mapbilnr_nstod *add dststatus field retrieval and optional write to file *add mapbilnr_nstop mapping type *add abort of coupling_mode is not supported *trailing whitespace cleanup --- mediator/esmFlds.F90 | 6 +- mediator/esmFldsExchange_hafs_mod.F90 | 2 +- mediator/fd_nems.yaml | 52 ++++++++--------- mediator/med.F90 | 7 ++- mediator/med_diag_mod.F90 | 14 ++--- mediator/med_fraction_mod.F90 | 4 +- mediator/med_io_mod.F90 | 16 +++--- mediator/med_map_mod.F90 | 83 ++++++++++++++++++++++++++- mediator/med_phases_post_ice_mod.F90 | 2 +- mediator/med_phases_prep_glc_mod.F90 | 22 +++---- mediator/med_phases_prep_ice_mod.F90 | 4 +- mediator/med_phases_prep_lnd_mod.F90 | 2 +- 12 files changed, 149 insertions(+), 65 deletions(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index 4f4d938c9..9a937ebfa 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -54,7 +54,8 @@ module esmflds 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 :: nmappers = 15 + integer , public, parameter :: mapbilnr_nstod = 16 ! bilinear with nstod extrapolation + integer , public, parameter :: nmappers = 16 character(len=*) , public, parameter :: mapnames(nmappers) = & (/'bilnr ',& @@ -71,7 +72,8 @@ module esmflds 'rof2ocn_liq',& 'glc2ocn_ice',& 'glc2ocn_liq',& - 'fillv_bilnr'/) + 'fillv_bilnr',& + 'bilnr_nstod'/) !----------------------------------------------- ! Set coupling mode diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 37e8cb3e3..1786f3684 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -187,7 +187,7 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) call addfld(fldListTo(compatm)%flds, 'So_ofrac') !---------------------------------------------------------- - ! to atm: surface temperatures from ocn + ! to atm: surface temperatures from ocn !---------------------------------------------------------- call addfld(fldListFr(compocn)%flds, 'So_t') call addfld(fldListTo(compatm)%flds, 'So_t') diff --git a/mediator/fd_nems.yaml b/mediator/fd_nems.yaml index 1fc70726d..75db4177d 100644 --- a/mediator/fd_nems.yaml +++ b/mediator/fd_nems.yaml @@ -575,7 +575,7 @@ description: atmosphere export - latent heat flux conversion - alias: Faox_evap standard_name : mean_evap_rate - description: mediator calculation - atm/ocn specific humidity flux + description: mediator calculation - atm/ocn specific humidity flux # #----------------------------------- # section: atmosphere fields that need to be defined but are not used @@ -694,8 +694,8 @@ #----------------------------------- # - standard_name: sea_surface_height_above_sea_level - canonical_units: m - description: ww3 import + canonical_units: m + description: ww3 import # - standard_name: sea_surface_salinity alias: s_surf @@ -705,22 +705,22 @@ - standard_name: surface_eastward_sea_water_velocity alias: ocn_current_zonal canonical_units: m s-1 - description: ww3 import + description: ww3 import # - standard_name: surface_northward_sea_water_velocity alias: ocn_current_merid canonical_units: m s-1 - description: ww3 import + description: ww3 import # - standard_name: eastward_wind_at_10m_height alias: inst_zonal_wind_height10m canonical_units: m s-1 - description: ww3 import + description: ww3 import # - standard_name: northward_wind_at_10m_height alias: inst_merid_wind_height10m canonical_units: m s-1 - description: ww3 import + description: ww3 import # - standard_name: sea_ice_concentration alias: ice_fraction @@ -732,77 +732,77 @@ # - standard_name: wave_induced_charnock_parameter canonical_units: 1 - description: ww3 export + description: ww3 export # - standard_name: wave_z0_roughness_length canonical_units: 1 - description: ww3 export + description: ww3 export # - standard_name: northward_stokes_drift_current canonical_units: m s-1 - description: ww3 export + description: ww3 export # - standard_name: eastward_stokes_drift_current canonical_units: m s-1 - description: ww3 export + description: ww3 export # - standard_name: eastward_partitioned_stokes_drift_1 canonical_units: m s-1 - description: ww3 export + description: ww3 export # - standard_name: eastward_partitioned_stokes_drift_2 canonical_units: m s-1 - description: ww3 export + description: ww3 export # - standard_name: eastward_partitioned_stokes_drift_3 canonical_units: m s-1 - description: ww3 export + description: ww3 export # - standard_name: northward_partitioned_stokes_drift_1 canonical_units: m s-1 - description: ww3 export + description: ww3 export # - standard_name: northward_partitioned_stokes_drift_2 canonical_units: m s-1 - description: ww3 export + description: ww3 export # - standard_name: northward_partitioned_stokes_drift_3 canonical_units: m s-1 - description: ww3 export + description: ww3 export # - standard_name: eastward_wave_bottom_current canonical_units: m s-1 - description: ww3 export + description: ww3 export # - standard_name: northward_wave_bottom_current canonical_units: m s-1 - description: ww3 export + description: ww3 export # - standard_name: wave_bottom_current_radian_frequency canonical_units: rad s-1 - description: ww3 export + description: ww3 export # - standard_name: eastward_wave_radiation_stress_gradient canonical_units: Pa - description: ww3 export + description: ww3 export # - standard_name: northward_wave_radiation_stress_gradient canonical_units: Pa - description: ww3 export + description: ww3 export # - standard_name: eastward_wave_radiation_stress canonical_units: N m-1 - description: ww3 export + description: ww3 export # - standard_name: eastward_northward_wave_radiation_stress canonical_units: N m-1 - description: ww3 export + description: ww3 export # - standard_name: wave_bottom_current_period canonical_units: s - description: ww3 export + description: ww3 export # - standard_name: northward_wave_radiation_stress canonical_units: Pa - description: ww3 export + description: ww3 export # diff --git a/mediator/med.F90 b/mediator/med.F90 index ecc17851d..06a2e61af 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -644,6 +644,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_SUCCESS, ESMF_LogFoundAllocError use ESMF , only : ESMF_LogMsg_Info, ESMF_LogWrite + use ESMF , only : ESMF_END_ABORT, ESMF_Finalize use NUOPC , only : NUOPC_AddNamespace, NUOPC_Advertise, NUOPC_AddNestedState use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd @@ -749,12 +750,16 @@ 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(1:4)) == 'nems') then + else if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac' & + .or. trim(coupling_mode) == 'nems_orig_data') 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 call esmFldsExchange_hafs(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(coupling_mode)//' is not a valid coupling_mode', ESMF_LOGMSG_INFO) + call ESMF_Finalize(endflag=ESMF_END_ABORT) end if !------------------ diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index c191b7121..72295a5ac 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -22,7 +22,7 @@ module med_diag_mod use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time use ESMF , only : ESMF_VM, ESMF_VMReduce, ESMF_REDUCE_SUM use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet - use ESMF , only : ESMF_Alarm, ESMF_ClockGetAlarm, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff + use ESMF , only : ESMF_Alarm, ESMF_ClockGetAlarm, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff use ESMF , only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldGet use shr_const_mod , only : shr_const_rearth, shr_const_pi, shr_const_latice use shr_const_mod , only : shr_const_ice_ref_sal, shr_const_ocn_ref_sal, shr_const_isspval @@ -800,7 +800,7 @@ subroutine diag_atm_wiso_recv(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_Field) :: lfield + type(ESMF_Field) :: lfield real(r8), pointer :: data(:,:) => null() ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -857,7 +857,7 @@ subroutine diag_atm_wiso_send(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_Field) :: lfield + type(ESMF_Field) :: lfield real(r8), pointer :: data(:,:) => null() ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1575,7 +1575,7 @@ subroutine diag_ice_recv(FB, fldname, nf, areas, lats, ifrac, budget, minus, sca integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_Field) :: lfield + type(ESMF_Field) :: lfield real(r8), pointer :: data(:) => null() ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1621,7 +1621,7 @@ subroutine diag_ice_recv_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_Field) :: lfield + type(ESMF_Field) :: lfield real(r8), pointer :: data(:,:) => null() ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1754,7 +1754,7 @@ subroutine diag_ice_send(FB, fldname, nf, areas, lats, ifrac, budget, rc) integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_Field) :: lfield + type(ESMF_Field) :: lfield real(r8), pointer :: data(:) => null() ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1788,7 +1788,7 @@ subroutine diag_ice_send_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ! local variables integer :: n, ip - type(ESMF_Field) :: lfield + type(ESMF_Field) :: lfield real(r8), pointer :: data(:,:) => null() ! ------------------------------------------------------------------ rc = ESMF_SUCCESS diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 0d083f0e6..018b4339c 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -295,7 +295,7 @@ subroutine med_fraction_init(gcomp, rc) end if !--------------------------------------- - ! Set 'ofrac' in FBFrac(compocn) + ! Set 'ofrac' in FBFrac(compocn) !--------------------------------------- if (is_local%wrap%comp_present(compocn)) then @@ -681,7 +681,7 @@ subroutine med_fraction_set(gcomp, rc) ! The model mask is normally assumed to be an selected ocean mask from a fully coupled run ! So in it is (1-land fraction) on the atm grid - ! set ifrac + ! set ifrac if (associated(ifrac)) then ifrac(:) = Si_ifrac(:) * Si_imask(:) endif diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index a13d66762..d4f767d6e 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -181,7 +181,7 @@ subroutine med_io_init(gcomp, rc) call ESMF_VMGet(vm, mpiCommunicator=comm, localPet=localPet, petCount=petCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! query component specific PIO attributes + ! query component specific PIO attributes ! pio_netcdf_format call NUOPC_CompAttributeGet(gcomp, name='pio_netcdf_format', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -212,9 +212,9 @@ subroutine med_io_init(gcomp, rc) if (isPresent .and. isSet) then cvalue = ESMF_UtilStringUpperCase(cvalue) if (trim(cvalue) .eq. 'NETCDF') then - pio_iotype = PIO_IOTYPE_NETCDF + pio_iotype = PIO_IOTYPE_NETCDF else if (trim(cvalue) .eq. 'PNETCDF') then - pio_iotype = PIO_IOTYPE_PNETCDF + pio_iotype = PIO_IOTYPE_PNETCDF else if (trim(cvalue) .eq. 'NETCDF4C') then pio_iotype = PIO_IOTYPE_NETCDF4C else if (trim(cvalue) .eq. 'NETCDF4P') then @@ -276,7 +276,7 @@ subroutine med_io_init(gcomp, rc) write(logunit,*) ' parallel io requires at least two io pes - following parameters are updated:' write(logunit,*) trim(subname), ' : pio_stride = ', pio_stride write(logunit,*) trim(subname), ' : pio_numiotasks = ', pio_numiotasks - end if + end if endif ! check/set/correct io pio parameters @@ -294,7 +294,7 @@ subroutine med_io_init(gcomp, rc) end if if (pio_stride == 1) then pio_root = 0 - endif + endif if (pio_root + (pio_stride)*(pio_numiotasks-1) >= petCount .or. & pio_stride <= 0 .or. pio_numiotasks <= 0 .or. pio_root < 0 .or. pio_root > petCount-1) then @@ -366,8 +366,8 @@ subroutine med_io_init(gcomp, rc) ! set PIO debug level call pio_setdebuglevel(pio_debug_level) - ! query shared PIO rearranger attributes - ! pio_rearr_comm_type + ! query shared PIO rearranger attributes + ! pio_rearr_comm_type call NUOPC_CompAttributeGet(gcomp, name='pio_rearr_comm_type', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -386,7 +386,7 @@ subroutine med_io_init(gcomp, rc) cvalue = 'P2P' pio_rearr_comm_type = PIO_REARR_COMM_P2P end if - if (localPet == 0) write(logunit,*) trim(subname), ' : pio_rearr_comm_type = ', trim(cvalue), pio_rearr_comm_type + if (localPet == 0) write(logunit,*) trim(subname), ' : pio_rearr_comm_type = ', trim(cvalue), pio_rearr_comm_type ! pio_rearr_comm_fcd call NUOPC_CompAttributeGet(gcomp, name='pio_rearr_comm_fcd', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 01892601d..b6fbd2220 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -1,6 +1,7 @@ module med_map_mod 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 : I4=>SHR_KIND_I4 use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_LOGMSG_INFO, ESMF_LogWrite use ESMF , only : ESMF_Field @@ -207,17 +208,21 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandlePrint, ESMF_Field, ESMF_MAXSTR use ESMF , only : ESMF_PoleMethod_Flag, ESMF_POLEMETHOD_ALLAVG use ESMF , only : ESMF_FieldSMMStore, ESMF_FieldRedistStore, ESMF_FieldRegridStore - use ESMF , only : ESMF_RouteHandleIsCreated + use ESMF , only : ESMF_RouteHandleIsCreated 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 + use esmFlds , only : mapfillv_bilnr, mapbilnr_nstod use esmFlds , only : ncomps, compatm, compice, compocn, compname use esmFlds , only : mapfcopy, mapconsd, mapconsf, mapnstod - use esmFlds , only : coupling_mode, compname + use esmFlds , only : coupling_mode use esmFlds , only : atm_name use med_constants_mod , only : ispval_mask => med_constants_ispval_mask @@ -232,12 +237,19 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, integer , intent(out) :: rc ! local variables + type(ESMF_Mesh) :: dstmesh + type(ESMF_Field) :: dststatusfield, doffield + type(ESMF_DistGrid) :: distgrid character(len=CS) :: string character(len=CS) :: mapname + character(len=CL) :: fname integer :: srcMaskValue integer :: dstMaskValue character(len=ESMF_MAXSTR) :: lmapfile logical :: rhprint = .false. + logical :: dststatus_print = .false. + integer :: ns + integer(I4), pointer :: dof(:) => null() integer :: srcTermProcessing_Value = 0 type(ESMF_PoleMethod_Flag), parameter :: polemethod=ESMF_POLEMETHOD_ALLAVG character(len=*), parameter :: subname=' (module_med_map: med_map_routehandles_initfrom_field) ' @@ -249,6 +261,13 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, end if mapname = trim(mapnames(mapindex)) + call ESMF_LogWrite(trim(subname)//": mapname "//trim(mapname), ESMF_LOGMSG_INFO) + + ! create a field to retrieve the dststatus field + call ESMF_FieldGet(flddst, mesh=dstmesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dststatusfield = ESMF_FieldCreate(dstmesh, ESMF_TYPEKIND_I4, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return if (trim(coupling_mode) == 'cesm') then dstMaskValue = ispval_mask @@ -317,6 +336,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, polemethod=polemethod, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & + dstStatusField=dststatusfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -331,6 +351,22 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, polemethod=polemethod, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & + dstStatusField=dststatusfield, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else if (mapindex == mapbilnr_nstod) then + if (mastertask) then + write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) + end if + call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapbilnr_nstod), & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & + extrapMethod=ESMF_EXTRAPMETHOD_NEAREST_STOD, & + polemethod=polemethod, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., & + dstStatusField=dststatusfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else if (mapindex == mapconsf .or. mapindex == mapnstod_consf) then @@ -344,6 +380,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, normType=ESMF_NORMTYPE_FRACAREA, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & + dstStatusField=dststatusfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -358,6 +395,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, normType=ESMF_NORMTYPE_DSTAREA, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & + dstStatusField=dststatusfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -386,6 +424,33 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, return end if + ! Output destination status field to file if requested + if (dststatus_print) then + if (mapindex /= mapfcopy .or. lmapfile /= 'unset') then + fname = 'dststatus.'//trim(compname(n1))//'.'//trim(compname(n2))//'.'//trim(mapname)//'.nc' + call ESMF_LogWrite(trim(subname)//": writing dstStatusField to "//trim(fname), ESMF_LOGMSG_INFO) + + call ESMF_FieldWrite(dststatusfield, filename=trim(fname), variableName='dststatus', & + overwrite=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! the sequence index in order to sort the dststatus field + call ESMF_MeshGet(dstmesh, elementDistgrid=distgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(dof(ns)) + call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + doffield = ESMF_FieldCreate(dstmesh, dof, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldWrite(doffield, fileName='dof.'//trim(compname(n2))//'.nc', variableName='dof', & + overwrite=.true., rc=rc) + deallocate(dof) + call ESMF_FieldDestroy(doffield, rc=rc, noGarbage=.true.) + end if + end if + ! consd_nstod method requires a second routehandle if (mapindex == mapnstod .or. mapindex == mapnstod_consd .or. mapindex == mapnstod_consf) then call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapnstod), & @@ -394,9 +459,19 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, regridmethod=ESMF_REGRIDMETHOD_NEAREST_STOD, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & + dstStatusField=dststatusfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Output destination status field to file if requested + if (dststatus_print) then + fname = 'dststatus.'//trim(compname(n1))//'.'//trim(compname(n2))//'.'//trim(mapname)//'_2.nc' + call ESMF_LogWrite(trim(subname)//": writing dstStatusField to "//trim(fname), ESMF_LOGMSG_INFO) + + call ESMF_FieldWrite(dststatusfield, filename=trim(fname), variableName='dststatus', overwrite=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end if ! Check that a valid route handle has been created @@ -416,6 +491,8 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, if (chkerr(rc,__LINE__,u_FILE_u)) return endif + call ESMF_FieldDestroy(dststatusfield, rc=rc, noGarbage=.true.) + end subroutine med_map_routehandles_initfrom_field !================================================================================ diff --git a/mediator/med_phases_post_ice_mod.F90 b/mediator/med_phases_post_ice_mod.F90 index b7bfbb679..f605006e5 100644 --- a/mediator/med_phases_post_ice_mod.F90 +++ b/mediator/med_phases_post_ice_mod.F90 @@ -25,7 +25,7 @@ subroutine med_phases_post_ice(gcomp, rc) use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_map_mod , only : med_map_field_packed - use med_fraction_mod , only : med_fraction_set + use med_fraction_mod , only : med_fraction_set use med_internalstate_mod , only : InternalState, mastertask use esmFlds , only : compice, compatm, compocn, compwav use perf_mod , only : t_startf, t_stopf diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index adff495d5..4c0879a2c 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -20,7 +20,7 @@ module med_phases_prep_glc_mod use ESMF , only : ESMF_FieldBundleCreate, ESMF_FieldBundleIsCreated use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate 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_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, ocn2glc_coupling @@ -106,7 +106,7 @@ module med_phases_prep_glc_mod type(ESMF_FieldBundle) :: FBocnAccum_o integer :: FBocnAccumCnt character(len=14) :: fldnames_fr_ocn(2) = (/'So_t_depth','So_s_depth'/) ! TODO: what else needs to be added here - type(ESMF_DynamicMask) :: dynamicOcnMask + type(ESMF_DynamicMask) :: dynamicOcnMask integer, parameter :: num_ocndepths = 7 logical :: ocn_sends_depths = .false. @@ -429,7 +429,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) end if end do - ! Create a dynamic mask object + ! Create a dynamic mask object ! The dynamic mask object further holds a pointer to the routine that will be called in order to ! handle dynamically masked elements - in this case its DynOcnMaskProc (see below) call ESMF_DynamicMaskSetR8R8R8(dynamicOcnMask, dynamicSrcMaskValue=czero, & @@ -450,10 +450,10 @@ subroutine med_phases_prep_glc_accum_lnd(gcomp, rc) !--------------------------------------- ! Carry out accumulation for the lnd->glc and ocn->glc - ! Accumulation and averaging is done on + ! Accumulation and averaging is done on ! - on the land mesh for land input ! - on the ocean mesh for ocean input - ! Mapping from the land to the glc grid and from the ocean to the glc grid + ! Mapping from the land to the glc grid and from the ocean to the glc grid ! is then done after the accumulated fields have been time averaged !--------------------------------------- @@ -497,7 +497,7 @@ subroutine med_phases_prep_glc_accum_lnd(gcomp, rc) do n = 1, size(fldnames_fr_lnd) call fldbun_getdata2d(is_local%wrap%FBImp(complnd,complnd), fldnames_fr_lnd(n), data2d_in, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getdata2d(FBlndAccum_l, fldnames_fr_lnd(n), data2d_out, rc) + call fldbun_getdata2d(FBlndAccum_l, fldnames_fr_lnd(n), data2d_out, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do i = 1,size(data2d_out, dim=2) data2d_out(:,i) = data2d_out(:,i) + data2d_in(:,i) @@ -520,7 +520,7 @@ subroutine med_phases_prep_glc_accum_ocn(gcomp, rc) !--------------------------------------- ! Carry out accumulation for ocn->glc - ! Accumulation and averaging is done on + ! Accumulation and averaging is done on ! - on the ocean mesh for ocean input ! Mapping from from the ocean to the glc grid is then done after ! the accumulated fields have been time averaged @@ -567,7 +567,7 @@ subroutine med_phases_prep_glc_accum_ocn(gcomp, rc) do n = 1, size(fldnames_fr_ocn) call fldbun_getdata2d(is_local%wrap%FBImp(compocn,compocn), fldnames_fr_ocn(n), data2d_in, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getdata2d(FBocnAccum_o, fldnames_fr_ocn(n), data2d_out, rc) + call fldbun_getdata2d(FBocnAccum_o, fldnames_fr_ocn(n), data2d_out, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do i = 1,size(data2d_out, dim=2) data2d_out(:,i) = data2d_out(:,i) + data2d_in(:,i) @@ -887,7 +887,7 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return ! ------------------------------------------------------------------------ - ! Loop over fields in export field bundle to glc for ice sheet ns and + ! Loop over fields in export field bundle to glc for ice sheet ns and ! perform vertical interpolation of data onto ice sheet topography ! This maps all of the input elevation classes into an export to glc without elevation classes ! ------------------------------------------------------------------------ @@ -1076,7 +1076,7 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, rc) real(r8) :: accum_renorm_factor ! ratio between global accumulation on the two grids 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 + real(r8), pointer :: area_g(:) ! areas on glc grid character(len=*), parameter :: subname=' (renormalize_smb) ' !--------------------------------------------------------------- @@ -1257,7 +1257,7 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, rc) end subroutine med_phases_prep_glc_renormalize_smb !================================================================================================ - subroutine dynOcnMaskProc(dynamicMaskList, dynamicSrcMaskValue, dynamicDstMaskValue, rc) + subroutine dynOcnMaskProc(dynamicMaskList, dynamicSrcMaskValue, dynamicDstMaskValue, rc) use ESMF, only : ESMF_RC_ARG_BAD diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index ae20593c5..7ec38e877 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -24,7 +24,7 @@ module med_phases_prep_ice_mod subroutine med_phases_prep_ice(gcomp, rc) use ESMF , only : operator(/=) - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_StateGet + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_StateGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_Field use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE @@ -119,7 +119,7 @@ subroutine med_phases_prep_ice(gcomp, rc) ! obtain nextsw_cday from atm if it is in the import state and send it to ice scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday if (scalar_id > 0 .and. mastertask) then - call ESMF_StateGet(is_local%wrap%NstateImp(compatm), & + 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 call ESMF_FieldGet(lfield, farrayPtr=dataptr_scalar_atm, rc=rc) diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 179b61b43..ca1ed38d5 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -94,7 +94,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) ! obtain nextsw_cday from atm if it is in the import state and send it to lnd scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday if (scalar_id > 0 .and. mastertask) then - call ESMF_StateGet(is_local%wrap%NstateImp(compatm), & + 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 call ESMF_FieldGet(lfield, farrayPtr=dataptr_scalar_atm, rc=rc) From 02ceba38f590c829ea5b83476077f2fb0210dadc Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 24 Mar 2021 12:39:35 -0400 Subject: [PATCH 3/5] add missing dststatusfield for mappatch and mappatch_uv3d --- mediator/med_map_mod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index b6fbd2220..0a8ab3580 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -411,6 +411,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, polemethod=polemethod, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & + dstStatusField=dststatusfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if From 9a0cad5f6f667ac8c222507f1a62d9341398243a Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 24 Mar 2021 16:41:45 -0600 Subject: [PATCH 4/5] optionally read dststatus_print from MED_attributes --- mediator/esmFlds.F90 | 2 ++ mediator/med.F90 | 10 +++++++++- mediator/med_map_mod.F90 | 3 +-- 3 files changed, 12 insertions(+), 3 deletions(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index 9a937ebfa..185d52096 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -34,6 +34,8 @@ module esmflds integer, public :: num_icesheets = 1 logical, public :: ocn2glc_coupling ! obtained from attribute + logical, public :: dststatus_print = .false. + !----------------------------------------------- ! Set mappers !----------------------------------------------- diff --git a/mediator/med.F90 b/mediator/med.F90 index 06a2e61af..fa157fe45 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -557,7 +557,8 @@ 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 - + use esmFlds, only : dststatus_print + type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -626,6 +627,13 @@ 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; otherwise use default value in med_constants + 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 diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 0a8ab3580..f9baa6033 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -222,7 +222,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, use esmFlds , only : mapfillv_bilnr, mapbilnr_nstod use esmFlds , only : ncomps, compatm, compice, compocn, compname use esmFlds , only : mapfcopy, mapconsd, mapconsf, mapnstod - use esmFlds , only : coupling_mode + use esmFlds , only : coupling_mode, dststatus_print use esmFlds , only : atm_name use med_constants_mod , only : ispval_mask => med_constants_ispval_mask @@ -247,7 +247,6 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, integer :: dstMaskValue character(len=ESMF_MAXSTR) :: lmapfile logical :: rhprint = .false. - logical :: dststatus_print = .false. integer :: ns integer(I4), pointer :: dof(:) => null() integer :: srcTermProcessing_Value = 0 From c6a10fd971b98a38b3cfb3bd2879302d5d38dbb1 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 24 Mar 2021 16:43:35 -0600 Subject: [PATCH 5/5] clean up comment --- mediator/med.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index fa157fe45..74073e86a 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -627,7 +627,7 @@ 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; otherwise use default value in med_constants + ! 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")