From faf5d1cee5daf610aa314594b4766ad213a77f9d Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Mon, 27 Jul 2020 15:12:22 -0400 Subject: [PATCH 01/12] cice6 compile (#71) (#34) * update cice6 component mk * update path for forapps/ufs * update paths to MOM6 and CICE interfaces (#33) Co-authored-by: Rahul Mahajan Co-authored-by: Rahul Mahajan --- src/incmake/component_CICE6.mk | 7 ++++--- src/incmake/component_MOM6.mk | 4 ++-- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/incmake/component_CICE6.mk b/src/incmake/component_CICE6.mk index 7bf26c86..7e1b1d36 100644 --- a/src/incmake/component_CICE6.mk +++ b/src/incmake/component_CICE6.mk @@ -3,9 +3,9 @@ cice6_mk=$(CICE_BINDIR)/cice6.mk all_component_mk_files+=$(cice6_mk) # Location of source code and installation -CICE_SRCDIR?=$(ROOTDIR)/CICE6 -CICE_UFSDIR?=$(ROOTDIR)/CICE6/forapps/ufs -CICE_BINDIR?=$(ROOTDIR)/CICE6_INSTALL +CICE_SRCDIR?=$(ROOTDIR)/CICE-interface/CICE +CICE_UFSDIR?=$(ROOTDIR)/CICE-interface/CICE/configuration/scripts/forapps/ufs +CICE_BINDIR?=$(ROOTDIR)/CICE-interface/CICE_INSTALL # NEMS_GRID was found in CICE and defaults to a low-res GSM grid # This is obsolete and perhaps should be removed. @@ -49,6 +49,7 @@ build_CICE6: $(cice6_mk) # Rules for cleaning the SRCDIR and BINDIR: clean_CICE6_SRC: configure + cp -n $(MODULE_DIR)/$(CHOSEN_MODULE) $(CONFDIR)/modules.nems ; \ $(MODULE_LOGIC) ; \ set -eu ; \ export $(CICE_ALL_OPTS) $(CICE_MAKEOPT) ; \ diff --git a/src/incmake/component_MOM6.mk b/src/incmake/component_MOM6.mk index 0b03dee4..cf733335 100644 --- a/src/incmake/component_MOM6.mk +++ b/src/incmake/component_MOM6.mk @@ -3,8 +3,8 @@ mom6_mk = $(MOM6_BINDIR)/mom6.mk all_component_mk_files+=$(mom6_mk) # Location of source code and installation -MOM6_SRCDIR?=$(ROOTDIR)/MOM6 -MOM6_BINDIR?=$(ROOTDIR)/MOM6/MOM6_INSTALL +MOM6_SRCDIR?=$(ROOTDIR)/MOM6-interface +MOM6_BINDIR?=$(ROOTDIR)/MOM6-interface/MOM6_INSTALL # Make sure the expected directories exist and are non-empty: $(call require_dir,$(MOM6_SRCDIR),MOM6 source directory) From c96dd2995798f1fa861505494ad612aff56de885 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sat, 17 Apr 2021 08:59:21 -0400 Subject: [PATCH 02/12] start cleanup * remove NEMS mediator files and Spaceweather Mediator file --- src/module_MEDIATOR.F90 | 9414 -------------------------- src/module_MEDIATOR_SpaceWeather.F90 | 1534 ----- src/module_MEDIATOR_methods.F90 | 345 - 3 files changed, 11293 deletions(-) delete mode 100644 src/module_MEDIATOR.F90 delete mode 100644 src/module_MEDIATOR_SpaceWeather.F90 delete mode 100644 src/module_MEDIATOR_methods.F90 diff --git a/src/module_MEDIATOR.F90 b/src/module_MEDIATOR.F90 deleted file mode 100644 index 8eef0203..00000000 --- a/src/module_MEDIATOR.F90 +++ /dev/null @@ -1,9414 +0,0 @@ -#include "./ESMFVersionDefine.h" - -module module_MEDIATOR - - !----------------------------------------------------------------------------- - ! NEMS Mediator Component. - ! - ! The Mediator has multiple Run() phases to support coupling of varied - ! configurations. These phases are defined via compsetentry calls. - ! Each mediator phase has it's check_import timestamp check turned off to - ! support coupling with arbitrary coupling periods and lags. The - ! SetRunClock is forcing the mediator clock to match the driver clock, - ! again to support arbitrary coupling periods and lags. That also - ! allows use of the generic export timestamp method to timestamp - ! all export fields in the mediator. - ! - ! Modification Log - ! * 2015-09-11 Added Land (lnd,l) to Mediator at atm,ice coupling period - DCR - ! ATM <-> LND: Redist, LND not connected to OCN, ICE - ! * 2015-10-30 Added Hydro (hyd,h) to Mediator at atm,ice, lnd coupling period - DCR - ! LND <-> HYD: Regrid, HYD not connected to ATM, OCN, ICE - ! * 2015-12-16 Added NEMS_GridCopyCoord - DCR - ! ATM <-> LND: Changed from Redist to Regrid - ! * 2017-09-08 Regridding from GSM to CICE or ocean models is done using only - ! sea points from GSM - B Li - ! * 2017-09-19 Added Nearest neighbor regridding option - B Li - ! * 2017-09-26 Set land_mask to be 1 if the interpolated land_mask from - ! ocean model is >= 10**(-6) - B Li - ! * 2017-10-24 Regridding from GSM to ocean and ice models (OCN/ICE) by masking out - ! GSM's land points (i.e. ignoring values at GSM's land points). - ! If no interpolated values can be obtained over OCN/ICE models' sea points - ! using bilinear or conservative methods, the interpolated values - ! from the nearest neighbor method will be used. - B Li. - ! * 2017-12-01 Removed fld_list_add(fldsFrIce,"dummyfield","cannot provide","bilinear"). - ! Add the nearest neighbor regridding option for regridding from - ! OCN and ICE to ATM grid (search "BL2017b" in the code to see - ! where changes are made.) - ! * 2017-12-15 The bilinear and patch interpolation methods are currently not used - ! for any export variables from ice model. If - ! bilinear or path interpolation method is used in the future for regridding - ! ice variables to other model components, changes in subroutine - ! "MedPhase_prep_atm" is required. -B Li. - !----------------------------------------------------------------------------- - - use ESMF - use NUOPC - use NUOPC_Mediator, & - mediator_routine_SS => SetServices, & - mediator_routine_Run => routine_Run, & - mediator_label_DataInitialize => label_DataInitialize, & - mediator_label_Advance => label_Advance, & - mediator_label_CheckImport => label_CheckImport, & - mediator_label_TimestampExport => label_TimestampExport, & - mediator_label_SetRunClock => label_SetRunClock - use module_MEDIATOR_methods - - implicit none - - private - - ! private internal state to keep instance data - type InternalStateStruct - integer :: fastcntr ! slice counter for writing to NetCDF file - integer :: slowcntr ! slice counter for writing to NetCDF file - integer :: accumcntAtm ! accumulator counter - integer :: accumcntOcn ! accumulator counter - integer :: accumcntIce ! accumulator counter - integer :: accumcntLnd ! accumulator counter - integer :: accumcntHyd ! accumulator counter - integer :: accumcntAtmOcn ! accumulator counter - type(ESMF_FieldBundle):: FBaccumAtm ! accumulator of atm export data - type(ESMF_FieldBundle):: FBaccumOcn ! accumulator of ocn export data - type(ESMF_FieldBundle):: FBaccumIce ! accumulator of ice export data - type(ESMF_FieldBundle):: FBaccumLnd ! accumulator of lnd export data - type(ESMF_FieldBundle):: FBaccumHyd ! accumulator of lnd export data - type(ESMF_FieldBundle):: FBaccumAtmOcn ! accumulator of atm export data - type(ESMF_FieldBundle):: FBAtm_a ! Atm export data on atm grid - type(ESMF_FieldBundle):: FBAtm_o ! Atm export data mapped to ocn grid -!BL2017 - type(ESMF_FieldBundle):: FBAtm2_o ! Atm export data mapped to ocn grid - type(ESMF_FieldBundle):: FBAtm2_i ! Atm export data mapped to ice grid -!BL2017 - type(ESMF_FieldBundle):: FBAtm_i ! Atm export data mapped to ice grid - type(ESMF_FieldBundle):: FBAtm_l ! Atm export data mapped to lnd grid - type(ESMF_FieldBundle):: FBAtm_h ! Atm export data mapped to hyd grid - type(ESMF_FieldBundle):: FBOcn_a ! Ocn export data mapped to atm grid - type(ESMF_FieldBundle):: FBOcn_o ! Ocn export data on ocn grid - type(ESMF_FieldBundle):: FBOcn_i ! Ocn export data mapped to ice grid - type(ESMF_FieldBundle):: FBIce_a ! Ice export data mapped to atm grid - type(ESMF_FieldBundle):: FBIce_o ! Ice export data mapped to ocn grid - type(ESMF_FieldBundle):: FBIce_i ! Ice export data on ice grid - type(ESMF_FieldBundle):: FBIce_if ! Ice export data on ice grid multiplied by ice fraction - type(ESMF_FieldBundle):: FBLnd_a ! Lnd export data mapped to atm grid - type(ESMF_FieldBundle):: FBLnd_l ! Lnd export on lnd grid - type(ESMF_FieldBundle):: FBLnd_h ! Lnd export data mapped to hyd grid - type(ESMF_FieldBundle):: FBHyd_l ! Hyd export data mapped to lnd grid - type(ESMF_FieldBundle):: FBHyd_a ! Hyd export data mapped to atm grid - type(ESMF_FieldBundle):: FBHyd_h ! Hyd export on hyd grid - type(ESMF_FieldBundle):: FBAtmOcn_o ! Atm/Ocn flux fields on ocn grid - !type(ESMF_FieldBundle):: FBAtmOcn_a ! Atm/Ocn flux fields on atm grid -!BL2017b - type(ESMF_FieldBundle):: FBOcn2_a ! Ocn export data mapped to atm grid - type(ESMF_FieldBundle):: FBIce2_a ! Ice export data mapped to atm grid - !type(ESMF_FieldBundle):: FBAtmOcn2_a ! Atm/Ocn flux fields on atm grid -!BL2017b - type(ESMF_FieldBundle):: FBforAtm ! data storage for atm import - type(ESMF_FieldBundle):: FBforOcn ! data storage for ocn import - type(ESMF_FieldBundle):: FBforIce ! data storage for ice import - type(ESMF_FieldBundle):: FBforLnd ! data storage for lnd import - type(ESMF_FieldBundle):: FBforHyd ! data storage for hyd import - type(ESMF_RouteHandle):: RH_a2o_bilnr ! atm to ocn bilinear - type(ESMF_RouteHandle):: RH_o2a_bilnr ! ocn to atm - type(ESMF_RouteHandle):: RH_a2i_bilnr ! atm to ice - type(ESMF_RouteHandle):: RH_i2a_bilnr ! ice to atm - type(ESMF_RouteHandle):: RH_a2l_bilnr ! atm to lnd - type(ESMF_RouteHandle):: RH_l2a_bilnr ! lnd to atm - type(ESMF_RouteHandle):: RH_a2h_bilnr ! atm to hyd - type(ESMF_RouteHandle):: RH_h2a_bilnr ! hyd to atm - type(ESMF_RouteHandle):: RH_o2i_bilnr ! ocn to ice - type(ESMF_RouteHandle):: RH_i2o_bilnr ! ice to ocn - type(ESMF_RouteHandle):: RH_l2h_bilnr ! lnd to hyd - type(ESMF_RouteHandle):: RH_h2l_bilnr ! hyd to lnd - type(ESMF_RouteHandle):: RH_a2o_consf ! atm to ocn conservative fracarea - type(ESMF_RouteHandle):: RH_o2a_consf ! ocn to atm - type(ESMF_RouteHandle):: RH_a2i_consf ! atm to ice - type(ESMF_RouteHandle):: RH_i2a_consf ! ice to atm - type(ESMF_RouteHandle):: RH_a2l_consf ! atm to lnd - type(ESMF_RouteHandle):: RH_l2a_consf ! lnd to atm - type(ESMF_RouteHandle):: RH_a2h_consf ! atm to hyd - type(ESMF_RouteHandle):: RH_h2a_consf ! hyd to atm - type(ESMF_RouteHandle):: RH_o2i_consf ! ocn to ice - type(ESMF_RouteHandle):: RH_i2o_consf ! ice to ocn - type(ESMF_RouteHandle):: RH_l2h_consf ! lnd to hyd - type(ESMF_RouteHandle):: RH_h2l_consf ! hyd to lnd - type(ESMF_RouteHandle):: RH_a2o_consd ! atm to ocn conservative dstarea - type(ESMF_RouteHandle):: RH_o2a_consd ! ocn to atm - type(ESMF_RouteHandle):: RH_a2i_consd ! atm to ice - type(ESMF_RouteHandle):: RH_i2a_consd ! ice to atm - type(ESMF_RouteHandle):: RH_a2l_consd ! atm to lnd - type(ESMF_RouteHandle):: RH_l2a_consd ! lnd to atm - type(ESMF_RouteHandle):: RH_a2h_consd ! atm to hyd - type(ESMF_RouteHandle):: RH_h2a_consd ! hyd to atm - type(ESMF_RouteHandle):: RH_o2i_consd ! ocn to ice - type(ESMF_RouteHandle):: RH_i2o_consd ! ice to ocn - type(ESMF_RouteHandle):: RH_l2h_consd ! lnd to hyd - type(ESMF_RouteHandle):: RH_h2l_consd ! hyd to lnd -!BL2017 - type(ESMF_RouteHandle):: RH_a2o_nearest ! atm to ocn nearest neighbor stod - type(ESMF_RouteHandle):: RH_a2i_nearest ! atm to ice nearest neighbor stod -!BL2017 -!BL2017b - type(ESMF_RouteHandle):: RH_i2a_nearest ! ice to atm nearest neighbor stod - type(ESMF_RouteHandle):: RH_o2a_nearest ! ocn to atm nearest neighbor stod -!BL2017b - type(ESMF_RouteHandle):: RH_a2o_patch ! atm to ocn patch - type(ESMF_RouteHandle):: RH_o2a_patch ! ocn to atm - type(ESMF_RouteHandle):: RH_a2i_patch ! atm to ice - type(ESMF_RouteHandle):: RH_i2a_patch ! ice to atm - type(ESMF_RouteHandle):: RH_a2l_patch ! atm to lnd - type(ESMF_RouteHandle):: RH_l2a_patch ! lnd to atm - type(ESMF_RouteHandle):: RH_a2h_patch ! atm to hyd - type(ESMF_RouteHandle):: RH_h2a_patch ! hyd to atm - type(ESMF_RouteHandle):: RH_o2i_patch ! ocn to ice - type(ESMF_RouteHandle):: RH_i2o_patch ! ice to ocn - type(ESMF_RouteHandle):: RH_l2h_patch ! lnd to hyd - type(ESMF_RouteHandle):: RH_h2l_patch ! hyd to lnd - type(ESMF_RouteHandle):: RH_a2o_fcopy ! atm to ocn fcopy - type(ESMF_RouteHandle):: RH_o2a_fcopy ! ocn to atm - type(ESMF_RouteHandle):: RH_a2i_fcopy ! atm to ice - type(ESMF_RouteHandle):: RH_i2a_fcopy ! ice to atm - type(ESMF_RouteHandle):: RH_a2l_fcopy ! atm to lnd - type(ESMF_RouteHandle):: RH_l2a_fcopy ! lnd to atm - type(ESMF_RouteHandle):: RH_a2h_fcopy ! atm to hyd - type(ESMF_RouteHandle):: RH_h2a_fcopy ! hyd to atm - type(ESMF_RouteHandle):: RH_o2i_fcopy ! ocn to ice - type(ESMF_RouteHandle):: RH_i2o_fcopy ! ice to ocn - type(ESMF_RouteHandle):: RH_l2h_fcopy ! lnd to hyd - type(ESMF_RouteHandle):: RH_h2l_fcopy ! hyd to lnd - logical :: a2o_active - logical :: o2a_active - logical :: a2i_active - logical :: i2a_active - logical :: a2l_active - logical :: l2a_active - logical :: a2h_active - logical :: h2a_active - logical :: o2i_active - logical :: i2o_active - logical :: l2h_active - logical :: h2l_active -! logical :: o2l_active ! (o2l connection not implemented) -! logical :: l2o_active ! (l2o connection not implemented) -! logical :: o2h_active ! (o2h connection not implemented) -! logical :: h2o_active ! (h2o connection not implemented) -! logical :: i2l_active ! (i2l connection not implemented) -! logical :: l2i_active ! (l2i connection not implemented) -! logical :: i2h_active ! (i2h connection not implemented) -! logical :: h2i_active ! (h2i connection not implemented) - -! tcx Xgrid -! type(ESMF_RouteHandle):: RHa2x ! atm to xgrid RH -! type(ESMF_RouteHandle):: RHo2x ! ocn to xgrid RH -! type(ESMF_RouteHandle):: RHx2a ! xgrid to atm RH -! type(ESMF_RouteHandle):: RHx2o ! xgrid to ocn RH - end type - - type InternalState - type(InternalStateStruct), pointer :: wrap - end type - - interface fieldBundle_accum ; module procedure & - fieldBundle_accumFB2FB, & - fieldBundle_accumFB2ST, & - fieldBundle_accumST2FB - end interface - - interface fieldBundle_copy ; module procedure & - fieldBundle_copyFB2FB, & - fieldBundle_copyFB2ST, & - fieldBundle_copyST2FB - end interface - - interface NUOPCplus_UpdateTimestamp; module procedure & - NUOPCplus_UpdateTimestampS, & - NUOPCplus_UpdateTimestampF - end interface - - ! local variables - type(ESMF_Grid) :: gridAtm, gridOcn, gridIce, gridLnd, gridHyd, gridMed - integer, parameter :: nx_med=400, ny_med=200 - integer :: dbug_flag = 5 - integer :: restart_interval = 0 - logical :: statewrite_flag = .true. ! diagnostics output, default - logical :: rhprint_flag = .false. ! diagnostics output, default - logical :: profile_memory = .true. ! diagnostics output, default - logical :: coldstart = .false. ! coldstart flag - logical :: atmocn_flux_from_atm = .true. ! where is atm/ocn flux computed - logical :: generate_landmask = .true. ! landmask flag - integer :: dbrc - character(len=256) :: msgString - logical :: isPresent - type(ESMF_Time) :: time_invalidTimeStamp - type(ESMF_Clock) :: clock_invalidTimeStamp - real(ESMF_KIND_R8), parameter :: const_lhvap = 2.501e6_ESMF_KIND_R8 ! latent heat of evaporation ~ J/kg - integer :: srcTermProcessing_Value = 0 - logical :: read_rest_FBaccumAtm = .false. - logical :: read_rest_FBaccumOcn = .false. - logical :: read_rest_FBaccumIce = .false. - logical :: read_rest_FBaccumLnd = .false. - logical :: read_rest_FBaccumHyd = .false. - logical :: read_rest_FBaccumAtmOcn = .false. - logical :: read_rest_FBAtm_a = .false. - logical :: read_rest_FBIce_i = .false. - logical :: read_rest_FBOcn_o = .false. - logical :: read_rest_FBLnd_l = .false. - logical :: read_rest_FBHyd_h = .false. - logical :: read_rest_FBAtmOcn_o = .false. -! real(ESMF_KIND_R8), parameter :: spval_init = -9.99999e6_ESMF_KIND_R8 ! spval for initialization -! real(ESMF_KIND_R8), parameter :: spval = -1.0e36_ESMF_KIND_R8 ! spval - real(ESMF_KIND_R8), parameter :: spval_init = 0.0_ESMF_KIND_R8 ! spval for initialization - real(ESMF_KIND_R8), parameter :: spval = 0.0_ESMF_KIND_R8 ! spval - real(ESMF_KIND_R8), parameter :: czero = 0.0_ESMF_KIND_R8 ! spval -!BL2017b -! real(ESMF_KIND_R8), parameter :: c9999 = 9999.0_ESMF_KIND_R8 ! spval -! real(ESMF_KIND_R8), parameter :: c9999 = 0.0_ESMF_KIND_R8 ! spval -!BL2017b - integer , parameter :: ispval_mask = -987987 ! spval for RH mask values - - type fld_list_type - integer :: num = -1 - character(len=64), pointer :: stdname(:) - character(len=64), pointer :: shortname(:) - character(len=64), pointer :: transferOffer(:) - character(len=64), pointer :: mapping(:) - end type fld_list_type - type(ESMF_State) :: NState_AtmImp ! Atm Import nested state - type(ESMF_State) :: NState_OcnImp ! Ocn Import nested state - type(ESMF_State) :: NState_IceImp ! Ice Import nested state - type(ESMF_State) :: NState_LndImp ! Lnd Import nested state - type(ESMF_State) :: NState_HydImp ! Hyd Import nested state - type(ESMF_State) :: NState_AtmExp ! Atm Export nested state - type(ESMF_State) :: NState_OcnExp ! Ocn Export nested state - type(ESMF_State) :: NState_IceExp ! Ice Export nested state - type(ESMF_State) :: NState_LndExp ! Lnd Export nested state - type(ESMF_State) :: NState_HydExp ! Hyd Export nested state - type (fld_list_type) :: fldsToAtm - type (fld_list_type) :: fldsFrAtm - type (fld_list_type) :: fldsToOcn - type (fld_list_type) :: fldsFrOcn - type (fld_list_type) :: fldsToIce - type (fld_list_type) :: fldsFrIce - type (fld_list_type) :: fldsToLnd - type (fld_list_type) :: fldsFrLnd - type (fld_list_type) :: fldsToHyd - type (fld_list_type) :: fldsFrHyd - type (fld_list_type) :: fldsAtmOcn - real(ESMF_KIND_R8), allocatable :: land_mask(:,:) - - type(ESMF_PoleMethod_Flag), parameter :: polemethod=ESMF_POLEMETHOD_ALLAVG - - public SetServices - - !----------------------------------------------------------------------------- - contains - !----------------------------------------------------------------------------- - - subroutine SetServices(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - character(len=*),parameter :: subname='(module_MEDIATOR:SetServices)' - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - ! the NUOPC mediator component will register the generic methods - call NUOPC_CompDerive(gcomp, mediator_routine_SS, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! Provide InitializeP0 to switch from default IPDv00 to IPDv03 - call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - InitializeP0, phase=0, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! IPDv03p1: advertise Fields - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeIPDv03p1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! IPDv03p3: realize connected Fields with transfer action "provide" - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p3"/), userRoutine=InitializeIPDv03p3, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! IPDv03p4: optionally modify the decomp/distr of transferred Grid/Mesh - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p4"/), userRoutine=InitializeIPDv03p4, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! IPDv03p5: realize all Fields with transfer action "accept" - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p5"/), userRoutine=InitializeIPDv03p5, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! attach specializing method(s) - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_DataInitialize, & - specRoutine=DataInitialize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! overwrite Finalize - call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_FINALIZE, & - userRoutine=Finalize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! set entry point for Run( phase = slow ) and specialize - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"MedPhase_slow"/), & - userRoutine=mediator_routine_Run, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="MedPhase_slow", specRoutine=MedPhase_slow, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! set entry point for Run( phase = fast_before ) and specialize - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"MedPhase_fast_before"/), & - userRoutine=mediator_routine_Run, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="MedPhase_fast_before", & - specRoutine=MedPhase_fast_before, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! set entry point for Run( phase = fast_after ) and specialize - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"MedPhase_fast_after"/), & - userRoutine=mediator_routine_Run, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="MedPhase_fast_after", & - specRoutine=MedPhase_fast_after, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! set entry point for Run( phase = accum_fast ) and specialize - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"MedPhase_accum_fast"/), & - userRoutine=mediator_routine_Run, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="MedPhase_accum_fast", specRoutine=MedPhase_accum_fast, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! set entry point for Run( phase = atm_ocn_flux ) and specialize - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"MedPhase_atm_ocn_flux"/), & - userRoutine=mediator_routine_Run, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="MedPhase_atm_ocn_flux", specRoutine=MedPhase_atm_ocn_flux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! set entry point for Run( phase = prep_ocn ) and specialize - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"MedPhase_prep_ocn"/), & - userRoutine=mediator_routine_Run, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="MedPhase_prep_ocn", specRoutine=MedPhase_prep_ocn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! set entry point for Run( phase = prep_ice ) and specialize - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"MedPhase_prep_ice"/), & - userRoutine=mediator_routine_Run, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="MedPhase_prep_ice", specRoutine=MedPhase_prep_ice, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! set entry point for Run( phase = prep_atm ) and specialize - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"MedPhase_prep_atm"/), & - userRoutine=mediator_routine_Run, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="MedPhase_prep_atm", specRoutine=MedPhase_prep_atm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & - specPhaseLabel="MedPhase_prep_atm", & - specRoutine=TimestampExport_prep_atm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! set entry point for Run( phase = prep_lnd ) and specialize - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"MedPhase_prep_lnd"/), & - userRoutine=mediator_routine_Run, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="MedPhase_prep_lnd", specRoutine=MedPhase_prep_lnd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! set entry point for Run( phase = prep_hyd ) and specialize - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"MedPhase_prep_hyd"/), & - userRoutine=mediator_routine_Run, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="MedPhase_prep_hyd", specRoutine=MedPhase_prep_hyd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! set entry point for Run( phase = write_restart ) and specialize - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"MedPhase_write_restart"/), & - userRoutine=mediator_routine_Run, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="MedPhase_write_restart", specRoutine=MedPhase_write_restart, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! attach specializing method(s) - ! -> NUOPC specializes by default --->>> first need to remove the default - call ESMF_MethodRemove(gcomp, mediator_label_CheckImport, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_CheckImport, & - specRoutine=NUOPC_NoOp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! attach specializing method(s) - ! -> NUOPC specializes by default --->>> first need to remove the default - call ESMF_MethodRemove(gcomp, mediator_label_SetRunClock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_SetRunClock, & - specRoutine=SetRunClock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! AtmOcn Coupling Fields - call fld_list_add(fldsAtmOcn,"mean_up_lw_flx_ocn" , "cannot provide","conservefrac") - call fld_list_add(fldsAtmOcn,"mean_sensi_heat_flx_atm_into_ocn", "cannot provide","conservefrac") - call fld_list_add(fldsAtmOcn,"mean_laten_heat_flx_atm_into_ocn", "cannot provide","conservefrac") - call fld_list_add(fldsAtmOcn,"mean_evap_rate_atm_into_ocn" , "cannot provide","conservefrac") - call fld_list_add(fldsAtmOcn,"stress_on_air_ocn_zonal" , "cannot provide","conservefrac") - call fld_list_add(fldsAtmOcn,"stress_on_air_ocn_merid" , "cannot provide","conservefrac") -! call fld_list_add(fldsAtmOcn,"temperature_2m" , "cannot provide","bilinear") -! call fld_list_add(fldsAtmOcn,"humidity_2m" , "cannot provide","bilinear") -! call fld_list_add(fldsAtmOcn,"wind_speed_squared_10m" , "cannot provide","bilinear") - call fld_list_add(fldsAtmOcn,"temperature_2m" , "cannot provide","conservefrac") - call fld_list_add(fldsAtmOcn,"humidity_2m" , "cannot provide","conservefrac") - call fld_list_add(fldsAtmOcn,"wind_speed_squared_10m" , "cannot provide","conservefrac") - - ! Fields to ATM - call fld_list_add(fldsToAtm,"land_mask" , "cannot provide") - call fld_list_add(fldsToAtm,"surface_temperature" , "will provide") - call fld_list_add(fldsToAtm,"sea_surface_temperature" , "will provide") - call fld_list_add(fldsToAtm,"inst_ice_ir_dir_albedo" , "will provide") - call fld_list_add(fldsToAtm,"inst_ice_ir_dif_albedo" , "will provide") - call fld_list_add(fldsToAtm,"inst_ice_vis_dir_albedo" , "will provide") - call fld_list_add(fldsToAtm,"inst_ice_vis_dif_albedo" , "will provide") - call fld_list_add(fldsToAtm,"ice_fraction" , "will provide") - call fld_list_add(fldsToAtm,"stress_on_air_ice_zonal" , "will provide") - call fld_list_add(fldsToAtm,"stress_on_air_ice_merid" , "will provide") - call fld_list_add(fldsToAtm,"mean_up_lw_flx_ice" , "will provide") - call fld_list_add(fldsToAtm,"mean_sensi_heat_flx_atm_into_ice", "will provide") - call fld_list_add(fldsToAtm,"mean_laten_heat_flx_atm_into_ice", "will provide") - call fld_list_add(fldsToAtm,"mean_sensi_heat_flx_atm_into_lnd", "will provide") - call fld_list_add(fldsToAtm,"mean_laten_heat_flx_atm_into_lnd", "will provide") - call fld_list_add(fldsToAtm,"mean_evap_rate_atm_into_ice" , "will provide") - call fld_list_add(fldsToAtm,"mean_zonal_moment_flx" , "will provide") - call fld_list_add(fldsToAtm,"mean_merid_moment_flx" , "will provide") - call fld_list_add(fldsToAtm,"mean_sensi_heat_flx" , "will provide") - call fld_list_add(fldsToAtm,"mean_laten_heat_flx" , "will provide") - call fld_list_add(fldsToAtm,"mean_up_lw_flx" , "will provide") - call fld_list_add(fldsToAtm,"mean_evap_rate" , "will provide") - call fld_list_add(fldsToAtm,"liquid_water_content_of_soil_layer_1", "will provide") - call fld_list_add(fldsToAtm,"liquid_water_content_of_soil_layer_2", "will provide") - call fld_list_add(fldsToAtm,"liquid_water_content_of_soil_layer_3", "will provide") - call fld_list_add(fldsToAtm,"liquid_water_content_of_soil_layer_4", "will provide") - call fld_list_add(fldsToAtm,"mean_ice_volume" , "will provide") - call fld_list_add(fldsToAtm,"mean_snow_volume" , "will provide") - call fld_list_add(fldsToAtm,"sea_ice_surface_temperature" , "will provide") -! call fld_list_add(fldsFrHyd,"volume_fraction_of_total_water_in_soil", "will provide") -! call fld_list_add(fldsFrHyd,"surface_snow_thickness" , "will provide") -! call fld_list_add(fldsFrHyd,"liquid_water_content_of_surface_snow" , "will provide") - - - ! Fields from ATM - call fld_list_add(fldsFrAtm,"mean_zonal_moment_flx_atm" , "cannot provide","conservefrac") - call fld_list_add(fldsFrAtm,"mean_merid_moment_flx_atm" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"mean_sensi_heat_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"mean_laten_heat_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"mean_down_lw_flx" , "will provide","conservefrac") -! call fld_list_add(fldsFrAtm,"mean_up_lw_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"mean_down_sw_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"mean_prec_rate" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"mean_fprec_rate" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_zonal_moment_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_merid_moment_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_sensi_heat_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_laten_heat_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_down_lw_flx" , "will provide","conservefrac") -! call fld_list_add(fldsFrAtm,"inst_up_lw_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_down_sw_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_temp_height2m" , "will provide","bilinear") - call fld_list_add(fldsFrAtm,"inst_spec_humid_height2m", "will provide","bilinear") -#ifdef PATCH_BFB_FIXED - call fld_list_add(fldsFrAtm,"inst_u_wind_height10m" , "will provide","patch") - call fld_list_add(fldsFrAtm,"inst_v_wind_height10m" , "will provide","patch") - call fld_list_add(fldsFrAtm,"inst_zonal_wind_height10m" , "will provide","patch") - call fld_list_add(fldsFrAtm,"inst_merid_wind_height10m" , "will provide","patch") -#else - call fld_list_add(fldsFrAtm,"inst_u_wind_height10m" , "will provide","bilinear") - call fld_list_add(fldsFrAtm,"inst_v_wind_height10m" , "will provide","bilinear") - call fld_list_add(fldsFrAtm,"inst_zonal_wind_height10m" , "will provide","bilinear") - call fld_list_add(fldsFrAtm,"inst_merid_wind_height10m" , "will provide","bilinear") -#endif - call fld_list_add(fldsFrAtm,"inst_temp_height_surface", "will provide","bilinear") - call fld_list_add(fldsFrAtm,"inst_pres_height_surface", "will provide","bilinear") - call fld_list_add(fldsFrAtm,"inst_surface_height" , "will provide","bilinear") - ! new imports from GSM added 04/23/14: - call fld_list_add(fldsFrAtm,"mean_net_lw_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"mean_net_sw_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_net_lw_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_net_sw_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"mean_down_sw_ir_dir_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"mean_down_sw_ir_dif_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"mean_down_sw_vis_dir_flx", "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"mean_down_sw_vis_dif_flx", "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_down_sw_ir_dir_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_down_sw_ir_dif_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_down_sw_vis_dir_flx", "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_down_sw_vis_dif_flx", "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"mean_net_sw_ir_dir_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"mean_net_sw_ir_dif_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"mean_net_sw_vis_dir_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"mean_net_sw_vis_dif_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_net_sw_ir_dir_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_net_sw_ir_dif_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_net_sw_vis_dir_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_net_sw_vis_dif_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_ir_dir_albedo" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_ir_dif_albedo" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_vis_dir_albedo" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_vis_dif_albedo" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_ocn_ir_dir_albedo" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_ocn_ir_dif_albedo" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_ocn_vis_dir_albedo" , "will provide","conservefrac") - call fld_list_add(fldsFrAtm,"inst_ocn_vis_dif_albedo" , "will provide","conservefrac") - ! new imports from GSM added 06/09/15: - call fld_list_add(fldsFrAtm,"inst_temp_height_lowest" , "will provide","bilinear") - call fld_list_add(fldsFrAtm,"inst_spec_humid_height_lowest" , "will provide","bilinear") - call fld_list_add(fldsFrAtm,"inst_zonal_wind_height_lowest" , "will provide","bilinear") - call fld_list_add(fldsFrAtm,"inst_merid_wind_height_lowest" , "will provide","bilinear") - call fld_list_add(fldsFrAtm,"inst_pres_height_lowest" , "will provide","bilinear") - call fld_list_add(fldsFrAtm,"inst_height_lowest" , "will provide","bilinear") - - ! Fields to OCN - call fld_list_add(fldsToOcn,"mean_zonal_moment_flx" , "cannot provide") - call fld_list_add(fldsToOcn,"mean_merid_moment_flx" , "will provide") - call fld_list_add(fldsToOcn,"mean_sensi_heat_flx" , "will provide") - call fld_list_add(fldsToOcn,"mean_laten_heat_flx" , "will provide") - call fld_list_add(fldsToOcn,"mean_down_lw_flx" , "will provide") - call fld_list_add(fldsToOcn,"mean_down_sw_vis_dir_flx", "will provide") - call fld_list_add(fldsToOcn,"mean_down_sw_vis_dif_flx", "will provide") - call fld_list_add(fldsToOcn,"mean_down_sw_ir_dir_flx" , "will provide") - call fld_list_add(fldsToOcn,"mean_down_sw_ir_dif_flx" , "will provide") - call fld_list_add(fldsToOcn,"mean_net_sw_vis_dir_flx" , "will provide") - call fld_list_add(fldsToOcn,"mean_net_sw_vis_dif_flx" , "will provide") - call fld_list_add(fldsToOcn,"mean_net_sw_ir_dir_flx" , "will provide") - call fld_list_add(fldsToOcn,"mean_net_sw_ir_dif_flx" , "will provide") -! call fld_list_add(fldsToOcn,"mean_salt_flx" , "will provide") - call fld_list_add(fldsToOcn,"mean_prec_rate" , "will provide") - call fld_list_add(fldsToOcn,"mean_fprec_rate" , "will provide") - call fld_list_add(fldsToOcn,"mean_evap_rate" , "will provide") -! call fld_list_add(fldsToOcn,"mean_runoff_rate" , "will provide") -! call fld_list_add(fldsToOcn,"mean_calving_rate" , "will provide") -! call fld_list_add(fldsToOcn,"mean_runoff_flx" , "will provide") -! call fld_list_add(fldsToOcn,"mean_calving_flx" , "will provide") - call fld_list_add(fldsToOcn,"inst_pres_height_surface", "will provide") -! call fld_list_add(fldsToOcn,"mass_of_overlying_sea_ice, "will provide") - call fld_list_add(fldsToOcn,"stress_on_ocn_ice_zonal" , "will provide") - call fld_list_add(fldsToOcn,"stress_on_ocn_ice_merid" , "will provide") -! call fld_list_add(fldsToOcn,"stress_on_ocn_ice_idir" , "will provide") -! call fld_list_add(fldsToOcn,"stress_on_ocn_ice_jdir" , "will provide") - call fld_list_add(fldsToOcn,"mean_sw_pen_to_ocn" , "will provide") - call fld_list_add(fldsToOcn,"mean_down_sw_flx" , "will provide") - call fld_list_add(fldsToOcn,"mean_net_sw_flx" , "will provide") - call fld_list_add(fldsToOcn,"mean_net_lw_flx" , "will provide") -! call fld_list_add(fldsToOcn,"mean_up_lw_flx" , "will provide") - call fld_list_add(fldsToOcn,"inst_temp_height2m" , "will provide") - call fld_list_add(fldsToOcn,"inst_spec_humid_height2m", "will provide") - call fld_list_add(fldsToOcn,"net_heat_flx_to_ocn" , "will provide") - call fld_list_add(fldsToOcn,"mean_fresh_water_to_ocean_rate", "will provide") - call fld_list_add(fldsToOcn,"mean_salt_rate" , "will provide") - call fld_list_add(fldsToOcn,"ice_fraction" , "will provide") - - ! Fields from OCN - call fld_list_add(fldsFrOcn,"ocean_mask" , "cannot provide","conservedst") - call fld_list_add(fldsFrOcn,"sea_surface_temperature" , "will provide","copy") - call fld_list_add(fldsFrOcn,"s_surf" , "will provide","copy") -#ifdef PATCH_BFB_FIXED - call fld_list_add(fldsFrOcn,"ocn_current_zonal" , "will provide","patch") - call fld_list_add(fldsFrOcn,"ocn_current_merid" , "will provide","patch") -#else - call fld_list_add(fldsFrOcn,"ocn_current_zonal" , "will provide","copy") - call fld_list_add(fldsFrOcn,"ocn_current_merid" , "will provide","copy") -#endif -! call fld_list_add(fldsFrOcn,"ocn_current_idir" , "will provide","copy") -! call fld_list_add(fldsFrOcn,"ocn_current_jdir" , "will provide","copy") - call fld_list_add(fldsFrOcn,"sea_lev" , "will provide","copy") - call fld_list_add(fldsFrOcn,"freezing_melting_potential", "will provide","copy") - call fld_list_add(fldsFrOcn,"upward_sea_ice_basal_available_heat_flux" & - , "will provide","conservefrac") - call fld_list_add(fldsFrOcn,"mixed_layer_depth" , "will provide","copy") - call fld_list_add(fldsFrOcn,"sea_surface_slope_zonal" , "will provide","copy") - call fld_list_add(fldsFrOcn,"sea_surface_slope_merid" , "will provide","copy") - call fld_list_add(fldsFrOcn,"accum_heat_frazil" , "will provide","copy") - call fld_list_add(fldsFrOcn,"inst_melt_potential " , "will provide","copy") - - ! Fields to ICE - call fld_list_add(fldsToIce,"dummyfield" , "cannot provide") - call fld_list_add(fldsToIce,"inst_temp_height2m" , "cannot provide") - call fld_list_add(fldsToIce,"inst_spec_humid_height2m" , "will provide") - call fld_list_add(fldsToIce,"inst_zonal_wind_height10m", "will provide") - call fld_list_add(fldsToIce,"inst_merid_wind_height10m", "will provide") - call fld_list_add(fldsToIce,"inst_temp_height_surface" , "will provide") - call fld_list_add(fldsToIce,"inst_surface_height" , "will provide") - call fld_list_add(fldsToIce,"inst_pres_height_surface" , "will provide") - call fld_list_add(fldsToIce,"mean_down_lw_flx" , "will provide") - call fld_list_add(fldsToIce,"mean_down_sw_vis_dir_flx" , "will provide") - call fld_list_add(fldsToIce,"mean_down_sw_vis_dif_flx" , "will provide") - call fld_list_add(fldsToIce,"mean_down_sw_ir_dir_flx" , "will provide") - call fld_list_add(fldsToIce,"mean_down_sw_ir_dif_flx" , "will provide") - call fld_list_add(fldsToIce,"mean_prec_rate" , "will provide") - call fld_list_add(fldsToIce,"mean_fprec_rate" , "will provide") - call fld_list_add(fldsToIce,"sea_surface_temperature" , "will provide") - call fld_list_add(fldsToIce,"s_surf" , "will provide") - call fld_list_add(fldsToIce,"sea_lev" , "will provide") - call fld_list_add(fldsToIce,"sea_surface_slope_zonal" , "will provide") - call fld_list_add(fldsToIce,"sea_surface_slope_merid" , "will provide") - call fld_list_add(fldsToIce,"ocn_current_zonal" , "will provide") - call fld_list_add(fldsToIce,"ocn_current_merid" , "will provide") -! call fld_list_add(fldsToIce,"ocn_current_idir" , "will provide") -! call fld_list_add(fldsToIce,"ocn_current_jdir" , "will provide") - call fld_list_add(fldsToIce,"freezing_melting_potential", "will provide") - call fld_list_add(fldsToIce,"mixed_layer_depth" , "will provide") - ! new exports from GSM added 06/09/15: - call fld_list_add(fldsToIce,"inst_temp_height_lowest" , "will provide") - call fld_list_add(fldsToIce,"inst_spec_humid_height_lowest" , "will provide") - call fld_list_add(fldsToIce,"inst_zonal_wind_height_lowest" , "will provide") - call fld_list_add(fldsToIce,"inst_merid_wind_height_lowest" , "will provide") - call fld_list_add(fldsToIce,"inst_pres_height_lowest" , "will provide") - call fld_list_add(fldsToIce,"inst_height_lowest" , "will provide") - call fld_list_add(fldsToIce,"mean_zonal_moment_flx" , "will provide") - call fld_list_add(fldsToIce,"mean_merid_moment_flx" , "will provide") - call fld_list_add(fldsToIce,"air_density_height_lowest" , "will provide") - - ! Fields from ICE -! call fld_list_add(fldsFrIce,"dummyfield" , "cannot provide","bilinear") - call fld_list_add(fldsFrIce,"ice_mask" , "cannot provide","conservedst") - call fld_list_add(fldsFrIce,"sea_ice_surface_temperature" , "will provide","conservefrac") - call fld_list_add(fldsFrIce,"inst_ice_ir_dir_albedo" , "will provide","conservefrac") - call fld_list_add(fldsFrIce,"inst_ice_ir_dif_albedo" , "will provide","conservefrac") - call fld_list_add(fldsFrIce,"inst_ice_vis_dir_albedo" , "will provide","conservefrac") - call fld_list_add(fldsFrIce,"inst_ice_vis_dif_albedo" , "will provide","conservefrac") - call fld_list_add(fldsFrIce,"ice_fraction" , "will provide","conservedst") - call fld_list_add(fldsFrIce,"stress_on_air_ice_zonal" , "will provide","conservefrac") - call fld_list_add(fldsFrIce,"stress_on_air_ice_merid" , "will provide","conservefrac") - call fld_list_add(fldsFrIce,"stress_on_ocn_ice_zonal" , "will provide","conservefrac") - call fld_list_add(fldsFrIce,"stress_on_ocn_ice_merid" , "will provide","conservefrac") -! call fld_list_add(fldsFrIce,"stress_on_ocn_ice_idir" , "will provide","copy") -! call fld_list_add(fldsFrIce,"stress_on_ocn_ice_jdir" , "will provide","copy") - call fld_list_add(fldsFrIce,"mean_sw_pen_to_ocn" , "will provide","conservefrac") - call fld_list_add(fldsFrIce,"mean_sw_pen_to_ocn_vis_dir_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrIce,"mean_sw_pen_to_ocn_vis_dif_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrIce,"mean_sw_pen_to_ocn_ir_dir_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrIce,"mean_sw_pen_to_ocn_ir_dif_flx" , "will provide","conservefrac") - call fld_list_add(fldsFrIce,"mean_up_lw_flx_ice" , "will provide","conservefrac") - call fld_list_add(fldsFrIce,"mean_sensi_heat_flx_atm_into_ice", "will provide","conservefrac") - call fld_list_add(fldsFrIce,"mean_laten_heat_flx_atm_into_ice", "will provide","conservefrac") - call fld_list_add(fldsFrIce,"mean_evap_rate_atm_into_ice" , "will provide","conservefrac") - call fld_list_add(fldsFrIce,"net_heat_flx_to_ocn" , "will provide","conservefrac") - call fld_list_add(fldsFrIce,"mean_fresh_water_to_ocean_rate" , "will provide","conservefrac") - call fld_list_add(fldsFrIce,"mean_salt_rate" , "will provide","conservefrac") - call fld_list_add(fldsFrIce,"mean_ice_volume" , "will provide","conservefrac") - call fld_list_add(fldsFrIce,"mean_snow_volume" , "will provide","conservefrac") - - ! Required met forcing fields to LND - call fld_list_add(fldsToLnd,"inst_down_lw_flx" , "cannot provide") - call fld_list_add(fldsToLnd,"inst_down_sw_flx" , "cannot provide") - call fld_list_add(fldsToLnd,"inst_merid_wind_height_lowest" , "cannot provide") - call fld_list_add(fldsToLnd,"inst_pres_height_surface" , "cannot provide") - call fld_list_add(fldsToLnd,"inst_spec_humid_height_lowest" , "cannot provide") - call fld_list_add(fldsToLnd,"inst_temp_height_lowest" , "cannot provide") - call fld_list_add(fldsToLnd,"inst_zonal_wind_height_lowest" , "cannot provide") - call fld_list_add(fldsToLnd,"mean_prec_rate" , "cannot provide") - ! Feedback from HYD - call fld_list_add(fldsToLnd,"liquid_water_content_of_soil_layer_1" , "cannot provide") - call fld_list_add(fldsToLnd,"liquid_water_content_of_soil_layer_2" , "cannot provide") - call fld_list_add(fldsToLnd,"liquid_water_content_of_soil_layer_3" , "cannot provide") - call fld_list_add(fldsToLnd,"liquid_water_content_of_soil_layer_4" , "cannot provide") -! call fld_list_add(fldsToLnd,"volume_fraction_of_total_water_in_soil", "cannot provide") ! Missing -! call fld_list_add(fldsToLnd,"surface_snow_thickness" , "cannot provide") ! Missing -! call fld_list_add(fldsToLnd,"liquid_water_content_of_surface_snow" , "cannot provide") ! Missing - ! Other fields to LND -! call fld_list_add(fldsToLnd,"aerodynamic_roughness_length" , "cannot provide") -! call fld_list_add(fldsToLnd,"canopy_moisture_storage" , "cannot provide") ! Missing -! call fld_list_add(fldsToLnd,"carbon_dioxide" , "cannot provide") ! Future -! call fld_list_add(fldsToLnd,"cosine_zenith_angle" , "cannot provide") -! call fld_list_add(fldsToLnd,"exchange_coefficient_heat" , "cannot provide") -! call fld_list_add(fldsToLnd,"exchange_coefficient_heat_height2m" , "cannot provide") -! call fld_list_add(fldsToLnd,"exchange_coefficient_moisture_height2m", "cannot provide") -! call fld_list_add(fldsToLnd,"ice_mask" , "cannot provide") -! call fld_list_add(fldsToLnd,"inst_height_lowest" , "cannot provide") -! call fld_list_add(fldsToLnd,"inst_pres_height_lowest" , "cannot provide") -! call fld_list_add(fldsToLnd,"inst_temp_height_surface" , "cannot provide") ! Missing -! call fld_list_add(fldsToLnd,"inst_wind_speed_height_lowest" , "cannot provide") -! call fld_list_add(fldsToLnd,"mean_cprec_rate" , "cannot provide") -! call fld_list_add(fldsToLnd,"mean_down_lw_flx" , "cannot provide") ! Missing -! call fld_list_add(fldsToLnd,"mean_down_sw_flx" , "cannot provide") ! Missing -! call fld_list_add(fldsToLnd,"mean_fprec_rate" , "cannot provide") -! call fld_list_add(fldsToLnd,"mean_surface_albedo" , "cannot provide") -! call fld_list_add(fldsToLnd,"saturated_mixing_ratio" , "cannot provide") -! call fld_list_add(fldsToLnd,"moisture_content_of_soil_layer_1" , "cannot provide") ! Missing -! call fld_list_add(fldsToLnd,"moisture_content_of_soil_layer_2" , "cannot provide") ! Missing -! call fld_list_add(fldsToLnd,"moisture_content_of_soil_layer_3" , "cannot provide") ! Missing -! call fld_list_add(fldsToLnd,"moisture_content_of_soil_layer_4" , "cannot provide") ! Missing -! call fld_list_add(fldsToLnd,"temperature_of_soil_layer_1" , "cannot provide") ! Missing -! call fld_list_add(fldsToLnd,"temperature_of_soil_layer_2" , "cannot provide") ! Missing -! call fld_list_add(fldsToLnd,"temperature_of_soil_layer_3" , "cannot provide") ! Missing -! call fld_list_add(fldsToLnd,"temperature_of_soil_layer_4" , "cannot provide") ! Missing -! call fld_list_add(fldsToLnd,"soil_temperature_bottom" , "cannot provide") -! call fld_list_add(fldsToLnd,"surface_microwave_emissivity" , "cannot provide") - - ! Forcing fields to hydrology - call fld_list_add(fldsFrLnd,"temperature_of_soil_layer_1" , "cannot provide","conservefrac") - call fld_list_add(fldsFrLnd,"temperature_of_soil_layer_2" , "cannot provide","conservefrac") - call fld_list_add(fldsFrLnd,"temperature_of_soil_layer_3" , "cannot provide","conservefrac") - call fld_list_add(fldsFrLnd,"temperature_of_soil_layer_4" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"moisture_content_of_soil_layer_1" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"moisture_content_of_soil_layer_2" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"moisture_content_of_soil_layer_3" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"moisture_content_of_soil_layer_4" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"liquid_water_content_of_soil_layer_1" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"liquid_water_content_of_soil_layer_2" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"liquid_water_content_of_soil_layer_3" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"liquid_water_content_of_soil_layer_4" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"surface_runoff_flux" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"subsurface_runoff_flux" , "cannot provide","conservefrac") - ! Feedback to atmosphere - call fld_list_add(fldsFrLnd,"mean_sensi_heat_flx_atm_into_lnd", "cannot provide","conservefrac") - call fld_list_add(fldsFrLnd,"mean_laten_heat_flx_atm_into_lnd", "cannot provide","conservefrac") - ! Other fields from LND -! call fld_list_add(fldsFrLnd,"aerodynamic_roughness_length" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"canopy_moisture_storage" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"exchange_coefficient_heat_height2m" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"exchange_coefficient_moisture_height2m", "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"ice_mask" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"inst_temp_height_lowest" , "cannot provide","conservefrac") ! Missing -! call fld_list_add(fldsFrLnd,"inst_temp_height_surface" , "cannot provide","conservefrac") ! Missing -! call fld_list_add(fldsFrLnd,"mean_grnd_sensi_heat_flx" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"mean_laten_heat_flx_kinematic" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"mean_net_lw_flx" , "cannot provide","conservefrac") ! Missing -! call fld_list_add(fldsFrLnd,"mean_net_sw_flx" , "cannot provide","conservefrac") ! Missing -! call fld_list_add(fldsFrLnd,"mean_surface_albedo" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"mean_surface_skin_temp" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"mixing_ratio_surface" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"root_moisture" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"surface_snow_area_fraction" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"surface_snow_melt_flux" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"liquid_water_content_of_surface_snow" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"surface_snow_thickness" , "cannot provide","conservefrac") ! Missing -! call fld_list_add(fldsFrLnd,"soil_hydraulic_conductivity_at_saturation", "cannot provide","conservefrac") ! Missing -! call fld_list_add(fldsFrLnd,"soil_porosity" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"soil_temperature_bottom" , "cannot provide","conservefrac") ! Missing -! call fld_list_add(fldsFrLnd,"soil_type" , "cannot provide","conservefrac") ! Missing -! call fld_list_add(fldsFrLnd,"soil_moisture_content" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"subsurface_basin_mask" , "cannot provide","conservefrac") ! Missing -! call fld_list_add(fldsFrLnd,"surface_microwave_emissivity" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"vegetation_type" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"volume_fraction_of_frozen_water_in_soil", "cannot provide","conservefrac") ! Missing -! call fld_list_add(fldsFrLnd,"volume_fraction_of_total_water_in_soil", "cannot provide","conservefrac") -! call fld_list_add(fldsFrLnd,"volume_fraction_of_total_water_in_soil_at_critical_point", "cannot provide","conservefrac") ! Missing -! call fld_list_add(fldsFrLnd,"volume_fraction_of_total_water_in_soil_at_field_capacity", "cannot provide","conservefrac") ! Missing -! call fld_list_add(fldsFrLnd,"volume_fraction_of_total_water_in_soil_at_wilting_point" , "cannot provide","conservefrac") ! Missing - - ! Required LND forcing fields to HYD - call fld_list_add(fldsToHyd,"temperature_of_soil_layer_1" , "cannot provide") - call fld_list_add(fldsToHyd,"temperature_of_soil_layer_2" , "cannot provide") - call fld_list_add(fldsToHyd,"temperature_of_soil_layer_3" , "cannot provide") - call fld_list_add(fldsToHyd,"temperature_of_soil_layer_4" , "cannot provide") -! call fld_list_add(fldsToHyd,"moisture_content_of_soil_layer_1" , "cannot provide") -! call fld_list_add(fldsToHyd,"moisture_content_of_soil_layer_2" , "cannot provide") -! call fld_list_add(fldsToHyd,"moisture_content_of_soil_layer_3" , "cannot provide") -! call fld_list_add(fldsToHyd,"moisture_content_of_soil_layer_4" , "cannot provide") -! call fld_list_add(fldsToHyd,"liquid_water_content_of_soil_layer_1", "cannot provide") -! call fld_list_add(fldsToHyd,"liquid_water_content_of_soil_layer_2", "cannot provide") -! call fld_list_add(fldsToHyd,"liquid_water_content_of_soil_layer_3", "cannot provide") -! call fld_list_add(fldsToHyd,"liquid_water_content_of_soil_layer_4", "cannot provide") -! call fld_list_add(fldsToHyd,"surface_runoff_flux" , "cannot provide") -! call fld_list_add(fldsToHyd,"subsurface_runoff_flux" , "cannot provide") - ! Met forcing fields to HYD - call fld_list_add(fldsToHyd,"inst_down_lw_flx" , "cannot provide") - call fld_list_add(fldsToHyd,"inst_down_sw_flx" , "cannot provide") -! call fld_list_add(fldsToHyd,"inst_merid_wind_height_lowest" , "cannot provide") -! call fld_list_add(fldsToHyd,"inst_pres_height_surface" , "cannot provide") -! call fld_list_add(fldsToHyd,"inst_spec_humid_height_lowest" , "cannot provide") -! call fld_list_add(fldsToHyd,"inst_temp_height_lowest" , "cannot provide") -! call fld_list_add(fldsToHyd,"inst_zonal_wind_height_lowest" , "cannot provide") -! call fld_list_add(fldsToHyd,"mean_prec_rate" , "cannot provide") - - ! Fields from HYD to LND and ATM - call fld_list_add(fldsFrHyd,"liquid_water_content_of_soil_layer_1" , "cannot provide","conservefrac") - call fld_list_add(fldsFrHyd,"liquid_water_content_of_soil_layer_2" , "cannot provide","conservefrac") - call fld_list_add(fldsFrHyd,"liquid_water_content_of_soil_layer_3" , "cannot provide","conservefrac") - call fld_list_add(fldsFrHyd,"liquid_water_content_of_soil_layer_4" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrHyd,"volume_fraction_of_total_water_in_soil" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrHyd,"surface_snow_thickness" , "cannot provide","conservefrac") -! call fld_list_add(fldsFrHyd,"liquid_water_content_of_surface_snow" , "cannot provide","conservefrac") - ! Other fields from HYD -! call fld_list_add(fldsFrHyd,"water_surface_height_above_reference_datum" , "cannot provide","conservefrac") - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine SetServices - - !----------------------------------------------------------------------------- - - subroutine InitializeP0(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! local variables - character(len=NUOPC_PhaseMapStringLength) :: initPhases(6) - character(len=*),parameter :: subname='(module_MEDIATOR:InitializeP0)' - character(len=10) :: value - - call ESMF_AttributeGet(gcomp, name="Verbosity", value=value, defaultValue="max", & - convention="NUOPC", purpose="Instance", rc=rc) - call ESMF_LogWrite(trim(subname)//": Verbosity="//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dbug_flag = ESMF_UtilString2Int(value, & - specialStringList=(/character(4)::"off","low","high","max"/), & - specialValueList=(/0,1,100,255/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - write(msgString,'(A,i6)') trim(subname)//' dbug_flag = ',dbug_flag - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - ! Switch to IPDv03 by filtering all other phaseMap entries - call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, & - acceptStringList=(/"IPDv03p"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_AttributeGet(gcomp, name="restart_interval", value=value, defaultValue="unset", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - restart_interval = ESMF_UtilString2Int(value, & - specialStringList=(/"unset"/), specialValueList=(/0/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - write(msgString,'(A,i6)') trim(subname)//' restart_interval = ',restart_interval - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_AttributeGet(gcomp, name="coldstart", value=value, defaultValue="false", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - coldstart=(trim(value)=="true") - write(msgString,'(A,l6)') trim(subname)//' coldstart = ',coldstart - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_AttributeGet(gcomp, name="generate_landmask", value=value, defaultValue="true", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - generate_landmask=(trim(value)=="true") - write(msgString,'(A,l6)') trim(subname)//' generate_landmask = ',generate_landmask - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_AttributeGet(gcomp, name="DumpFields", value=value, defaultValue="true", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - statewrite_flag=(trim(value)=="true") - write(msgString,'(A,l6)') trim(subname)//' statewrite_flag = ',statewrite_flag - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_AttributeGet(gcomp, name="DumpRHs", value=value, defaultValue="false", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - rhprint_flag=(trim(value)=="true") - write(msgString,'(A,l6)') trim(subname)//' rhprint_flag = ',rhprint_flag - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_AttributeGet(gcomp, name="ProfileMemory", value=value, defaultValue="true", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - profile_memory=(trim(value)/="false") - write(msgString,'(A,l6)') trim(subname)//' profile_memory = ',profile_memory - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_AttributeGet(gcomp, name="AoMedFlux", value=value, defaultValue="true", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - atmocn_flux_from_atm=(trim(value)/="false") - write(msgString,'(A,l6)') trim(subname)//' atmocn_flux_from_atm = ',atmocn_flux_from_atm - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - - ! Set clock_invalidTimeStamp - call ESMF_TimeSet(time_invalidTimeStamp, yy=99999999, mm=1, dd=1, h=0, m=0, s=0, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - clock_invalidTimeStamp = ESMF_ClockCreate(clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_ClockSet(clock_invalidTimeStamp, currTime=time_invalidTimeStamp, & - stopTime=time_invalidTimeStamp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine InitializeP0 - - !----------------------------------------------------------------------- - - subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! local variables - integer :: n - character(len=*),parameter :: subname='(module_MEDIATOR:InitializeIPDv03p1)' - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - ! importable fields: - - ! add a namespace - call NUOPC_AddNamespace(importState, namespace="ATM", nestedStateName="NestedState-AtmImp", nestedState=NState_AtmImp, rc=rc) - call NUOPC_AddNamespace(importState, namespace="OCN", nestedStateName="NestedState-OcnImp", nestedState=NState_OcnImp, rc=rc) - call NUOPC_AddNamespace(importState, namespace="ICE", nestedStateName="NestedState-IceImp", nestedState=NState_IceImp, rc=rc) - call NUOPC_AddNamespace(importState, namespace="LND", nestedStateName="NestedState-LndImp", nestedState=NState_LndImp, rc=rc) - call NUOPC_AddNamespace(importState, namespace="HYD", nestedStateName="NestedState-HydImp", nestedState=NState_HydImp, rc=rc) - call NUOPC_AddNamespace(exportState, namespace="ATM", nestedStateName="NestedState-AtmExp", nestedState=NState_AtmExp, rc=rc) - call NUOPC_AddNamespace(exportState, namespace="OCN", nestedStateName="NestedState-OcnExp", nestedState=NState_OcnExp, rc=rc) - call NUOPC_AddNamespace(exportState, namespace="ICE", nestedStateName="NestedState-IceExp", nestedState=NState_IceExp, rc=rc) - call NUOPC_AddNamespace(exportState, namespace="LND", nestedStateName="NestedState-LndExp", nestedState=NState_LndExp, rc=rc) - call NUOPC_AddNamespace(exportState, namespace="HYD", nestedStateName="NestedState-HydExp", nestedState=NState_HydExp, rc=rc) - - do n = 1,fldsFrAtm%num - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": FrAtm Advertise "// & - trim(fldsFrAtm%stdname(n))//":"// & - trim(fldsFrAtm%shortname(n)), ESMF_LOGMSG_INFO, rc=dbrc) - endif - call NUOPC_Advertise(NState_AtmImp, & - StandardName = trim(fldsFrAtm%stdname(n)), & - name=fldsFrAtm%shortname(n), & - TransferOfferGeomObject=fldsFrAtm%transferOffer(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - enddo - - do n = 1,fldsFrOcn%num - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": FrOcn Advertise "// & - trim(fldsFrOcn%stdname(n))//":"// & - trim(fldsFrOcn%shortname(n)), ESMF_LOGMSG_INFO, rc=dbrc) - endif - call NUOPC_Advertise(NState_OcnImp, & - StandardName = fldsFrOcn%stdname(n), & - name = fldsFrOcn%shortname(n), & - TransferOfferGeomObject=fldsFrOcn%transferOffer(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - enddo - - do n = 1,fldsFrIce%num - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": FrIce Advertise "// & - trim(fldsFrIce%stdname(n))//":"// & - trim(fldsFrIce%shortname(n)), ESMF_LOGMSG_INFO, rc=dbrc) - endif - call NUOPC_Advertise(NState_IceImp, & - StandardName = fldsFrIce%stdname(n), & - name = fldsFrIce%shortname(n), & - TransferOfferGeomObject=fldsFrIce%transferOffer(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - enddo - - do n = 1,fldsFrLnd%num - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": FrLnd Advertise "// & - trim(fldsFrLnd%stdname(n))//":"// & - trim(fldsFrLnd%shortname(n)), ESMF_LOGMSG_INFO, rc=dbrc) - endif - call NUOPC_Advertise(NState_LndImp, & - StandardName = fldsFrLnd%stdname(n), & - name = fldsFrLnd%shortname(n), & - TransferOfferGeomObject=fldsFrLnd%transferOffer(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - enddo - - do n = 1,fldsFrHyd%num - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": FrHyd Advertise "// & - trim(fldsFrHyd%stdname(n))//":"// & - trim(fldsFrHyd%shortname(n)), ESMF_LOGMSG_INFO, rc=dbrc) - endif - call NUOPC_Advertise(NState_HydImp, & - StandardName = fldsFrHyd%stdname(n), & - name = fldsFrHyd%shortname(n), & - TransferOfferGeomObject=fldsFrHyd%transferOffer(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - enddo - - ! exportable fields: - - do n = 1,fldsToAtm%num - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": ToAtm Advertise "// & - trim(fldsToAtm%stdname(n))//":"// & - trim(fldsToAtm%shortname(n)), ESMF_LOGMSG_INFO, rc=dbrc) - endif - call NUOPC_Advertise(NState_AtmExp, & - StandardName = fldsToAtm%stdname(n), & - name = fldsToAtm%shortname(n), & - TransferOfferGeomObject=fldsToAtm%transferOffer(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - enddo - - do n = 1,fldsToOcn%num - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": ToOcn Advertise "// & - trim(fldsToOcn%stdname(n))//":"// & - trim(fldsToOcn%shortname(n)), ESMF_LOGMSG_INFO, rc=dbrc) - endif - call NUOPC_Advertise(NState_OcnExp, & - StandardName = fldsToOcn%stdname(n), & - name = fldsToOcn%shortname(n), & - TransferOfferGeomObject=fldsToOcn%transferOffer(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - enddo - - do n = 1,fldsToIce%num - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": ToIce Advertise "// & - trim(fldsToIce%stdname(n))//":"// & - trim(fldsToIce%shortname(n)), ESMF_LOGMSG_INFO, rc=dbrc) - endif - call NUOPC_Advertise(NState_IceExp, & - StandardName = fldsToIce%stdname(n), & - name = fldsToIce%shortname(n), & - TransferOfferGeomObject=fldsToIce%transferOffer(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - enddo - - do n = 1,fldsToLnd%num - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": ToLnd Advertise "// & - trim(fldsToLnd%stdname(n))//":"// & - trim(fldsToLnd%shortname(n)), ESMF_LOGMSG_INFO, rc=dbrc) - endif - call NUOPC_Advertise(NState_LndExp, & - StandardName = fldsToLnd%stdname(n), & - name = fldsToLnd%shortname(n), & - TransferOfferGeomObject=fldsToLnd%transferOffer(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - enddo - - do n = 1,fldsToHyd%num - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": ToHyd Advertise "// & - trim(fldsToHyd%stdname(n))//":"// & - trim(fldsToHyd%shortname(n)), ESMF_LOGMSG_INFO, rc=dbrc) - endif - call NUOPC_Advertise(NState_HydExp, & - StandardName = fldsToHyd%stdname(n), & - name = fldsToHyd%shortname(n), & - TransferOfferGeomObject=fldsToHyd%transferOffer(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - enddo - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine InitializeIPDv03p1 - - !----------------------------------------------------------------------------- - - subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! local variables - integer :: i, j - real(kind=ESMF_KIND_R8),pointer :: lonPtr(:,:), latPtr(:,:) - type(InternalState) :: is_local - integer :: stat - real(ESMF_KIND_R8) :: intervalSec - type(ESMF_TimeInterval) :: timeStep - character(ESMF_MAXSTR) :: transferAction -! tcx XGrid -! type(ESMF_Field) :: fieldX, fieldA, fieldO -! type(ESMF_XGrid) :: xgrid - character(len=*),parameter :: subname='(module_MEDIATOR:InitializeIPDv03p3)' - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - ! Allocate memory for the internal state and set it in the Component. - allocate(is_local%wrap, stat=stat) - if (ESMF_LogFoundAllocError(statusToCheck=stat, & - msg="Allocation of the internal state memory failed.", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridCompSetInternalState(gcomp, is_local, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! Initialize the internal state members - is_local%wrap%fastcntr = 1 - is_local%wrap%slowcntr = 1 - - gridMed = ESMF_GridCreate1PeriDimUfrm(maxIndex=(/nx_med,ny_med/), & - minCornerCoord=(/0._ESMF_KIND_R8, -85._ESMF_KIND_R8/), & - maxCornerCoord=(/360._ESMF_KIND_R8, 85._ESMF_KIND_R8/), & - staggerLocList=(/ESMF_STAGGERLOC_CENTER/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - -! gridLnd = NUOPC_GridCreateSimpleSph(0._ESMF_KIND_R8, -85._ESMF_KIND_R8, & -! 360._ESMF_KIND_R8, 85._ESMF_KIND_R8, nx_med, ny_med, & -! scheme=ESMF_REGRID_SCHEME_FULL3D, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out - -! gridHyd = NUOPC_GridCreateSimpleSph(0._ESMF_KIND_R8, -85._ESMF_KIND_R8, & -! 360._ESMF_KIND_R8, 85._ESMF_KIND_R8, nx_med, ny_med, & -! scheme=ESMF_REGRID_SCHEME_FULL3D, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out - - !--- Generate RouteHandles -! tcx Xgrid -! what needs to be in the grids to create an XGrid (corners?) -! add error checking code - -! xgrid = ESMF_XGridCreate(sideAGrid=(/gridatm/), sideBGrid=(/gridocn/), rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out -! fieldX = ESMF_FieldCreate(xgrid , typekind=ESMF_TYPEKIND_R8, rc=rc) -! fieldA = ESMF_FieldCreate(gridAtm, typekind=ESMF_TYPEKIND_R8, rc=rc) -! fieldO = ESMF_FieldCreate(gridAtm, typekind=ESMF_TYPEKIND_R8, rc=rc) -! call ESMF_FieldRegridStore(xgrid, fieldA, fieldX, routehandle=is_local%wrap%RHa2x, rc=rc) -! call ESMF_FieldRegridStore(xgrid, fieldO, fieldX, routehandle=is_local%wrap%RHo2x, rc=rc) -! call ESMF_FieldRegridStore(xgrid, fieldX, fieldA, routehandle=is_local%wrap%RHx2a, rc=rc) -! call ESMF_FieldRegridStore(xgrid, fieldX, fieldO, routehandle=is_local%wrap%RHx2o, rc=rc) -! call ESMF_FieldDestroy(fieldX, rc=rc) -! call ESMF_FieldDestroy(fieldA, rc=rc) -! call ESMF_FieldDestroy(fieldO, rc=rc) -! call ESMF_XGridDestroy(xgrid, rc=rc) - - !--- Importable fields from atm: - -!gjt: import fields from ATM are now marked as "cannot provide" thus accept Grid -!gjt: -> eventually comment out the following lines... - call realizeConnectedFields(NState_AtmImp, & - fieldNameList=fldsFrAtm%shortname(1:fldsFrAtm%num), & - string='AtmImp',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--- Exportable fields to atm: - - call realizeConnectedFields(NState_AtmExp, & - fieldNameList=fldsToAtm%shortname(1:fldsToAtm%num), & - string='AtmExp',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--- Importable fields from ocn: - - call realizeConnectedFields(NState_OcnImp, & - fieldNameList=fldsFrOcn%shortname(1:fldsFrOcn%num), & - string='OcnImp',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--- Exportable fields to ocn: - - call realizeConnectedFields(NState_OcnExp, & - fieldNameList=fldsToOcn%shortname(1:fldsToOcn%num), & - string='OcnExp',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--- Importable fields from ice: - - call realizeConnectedFields(NState_IceImp, & - fieldNameList=fldsFrIce%shortname(1:fldsFrIce%num), & - string='IceImp',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--- Exportable fields to ice: - - call realizeConnectedFields(NState_IceExp, & - fieldNameList=fldsToIce%shortname(1:fldsToIce%num), & - string='IceExp',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--- Importable fields from lnd: - - call realizeConnectedFields(NState_LndImp, & - fieldNameList=fldsFrLnd%shortname(1:fldsFrLnd%num), & - string='LndImp',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--- Exportable fields to lnd: - - call realizeConnectedFields(NState_LndExp, & - fieldNameList=fldsToLnd%shortname(1:fldsToLnd%num), & - string='LndExp',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--- Importable fields from hyd: - - call realizeConnectedFields(NState_HydImp, & - fieldNameList=fldsFrHyd%shortname(1:fldsFrHyd%num), & - string='HydImp',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--- Exportable fields to hyd: - - call realizeConnectedFields(NState_HydExp, & - fieldNameList=fldsToHyd%shortname(1:fldsToHyd%num), & - string='HydExp',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! Clean Up - -! call ESMF_GridDestroy(gridAtm, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out -! call ESMF_GridDestroy(gridOcn, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - subroutine realizeConnectedFields(state, fieldNameList, grid, string, rc) - type(ESMF_State) :: state - character(len=*) :: fieldNameList(:) - type(ESMF_Grid),optional :: grid - character(len=*) :: string - integer, intent(out) :: rc - - integer :: n - type(ESMF_Field) :: field - character(len=*),parameter :: subname='(module_MEDIATOR:realizeConnectedFields)' - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - do n=1, size(fieldNameList) - if (NUOPC_IsConnected(state, fieldName=fieldNameList(n))) then - - call ESMF_StateGet(state, field=field, itemName=fieldNameList(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call NUOPC_GetAttribute(field, name="TransferActionGeomObject", & - value=transferAction, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (trim(transferAction) == "accept") then - call ESMF_LogWrite(trim(subname)//trim(string)//" field+grid connected "//trim(fieldNameList(n)), ESMF_LOGMSG_INFO, rc=dbrc) - - else ! provide - -#ifdef NUOPC_DOES_SMART_GRID_TRANSFER - ! realize the connected Field using the internal coupling Field - if (.not.present(grid)) then - call ESMF_LogWrite(trim(subname)//trim(string)//": ERROR grid expected", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - endif - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, name=fieldNameList(n),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call NUOPC_Realize(state, field=field, rc=rc) - call ESMF_LogWrite(trim(subname)//trim(string)//" field connected "//trim(fieldNameList(n)), ESMF_LOGMSG_INFO, rc=dbrc) - -#else - call NUOPC_SetAttribute(field, name="TransferActionGeomObject", & - value="accept-internal", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - -#endif - endif ! transferAction - - else ! StateIsFieldConnected - - ! remove a not connected Field from State - call ESMF_StateRemove(state, (/fieldNameList(n)/), rc=rc) - call ESMF_LogWrite(trim(subname)//trim(string)//" field NOT connected "//trim(fieldNameList(n)), ESMF_LOGMSG_INFO, rc=dbrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - enddo - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine realizeConnectedFields - - end subroutine InitializeIPDv03p3 - - !----------------------------------------------------------------------------- - - !----------------------------------------------------------------------------- - - subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! local variables -! type(ESMF_Field) :: field -! type(ESMF_Grid) :: grid -! integer :: localDeCount - -! type(ESMF_DistGrid) :: distgrid -! integer :: dimCount, tileCount, petCount -! integer :: deCountPTile, extraDEs -! integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) -! integer, allocatable :: regDecompPTile(:,:) -! integer :: i, j, n, n1 -! character(ESMF_MAXSTR) :: transferAction - - character(len=*),parameter :: subname='(module_MEDIATOR:InitializeIPDv03p4)' - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - rc = ESMF_SUCCESS - - call realizeConnectedGrid(NState_atmImp, 'AtmImp', rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call realizeConnectedGrid(NState_atmExp, 'AtmExp', rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call realizeConnectedGrid(NState_ocnImp, 'OcnImp', rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call realizeConnectedGrid(NState_ocnExp, 'OcnExp', rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call realizeConnectedGrid(NState_iceImp, 'IceImp', rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call realizeConnectedGrid(NState_iceExp, 'IceExp', rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call realizeConnectedGrid(NState_lndImp, 'LndImp', rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call realizeConnectedGrid(NState_lndExp, 'LndExp', rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call realizeConnectedGrid(NState_hydImp, 'HydImp', rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call realizeConnectedGrid(NState_hydExp, 'HydExp', rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - subroutine realizeConnectedGrid(State,string,rc) - - type(ESMF_State) , intent(inout) :: State - character(len=*) , intent(in) :: string - integer , intent(out) :: rc - - ! local variables - type(ESMF_Field) :: field - type(ESMF_Grid) :: grid - integer :: localDeCount, petCount - integer, allocatable :: regDecomp(:), regDecompPTile(:,:) - - type(ESMF_DistGrid) :: distgrid - type(ESMF_DistGridConnection), allocatable :: connectionList(:) - integer :: dimCount, tileCount - integer :: connectionCount - integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) - integer :: i, j, n, n1, fieldCount, nxg - character(ESMF_MAXSTR),allocatable :: fieldNameList(:) - character(ESMF_MAXSTR) :: transferAction - character(len=*),parameter :: subname='(module_MEDIATOR:realizeConnectedGrid)' - - !NOTE: All of the Fields that set their TransferOfferGeomObject Attribute - !NOTE: to "cannot provide" should now have the accepted Grid available. - !NOTE: Go and pull out this Grid for one of a representative Field and - !NOTE: modify the decomposition and distribution of the Grid to match the - !NOTE: Mediator PETs. - - !TODO: quick implementation, do it for each field one by one - !TODO: commented out below are application to other fields - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_Success - - call ESMF_GridCompGet(gcomp, petCount=petCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(State, itemNameList=fieldNameList, & - itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - do n=1, fieldCount -!tcx do n=1, 1 - - call ESMF_StateGet(State, field=field, itemName=fieldNameList(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call NUOPC_GetAttribute(field, name="TransferActionGeomObject", & - value=transferAction, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (trim(transferAction) == "accept") then - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//trim(string)//": accept grid for "//trim(fieldNameList(n)), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - ! this is still an empty field, but holds a Grid with DistGrid - call ESMF_FieldGet(field, grid=grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! diagnostic print - call Grid_Print(grid,trim(fieldNameList(n))//'_orig',rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! access the DistGrid inside the Grid - call ESMF_GridGet(grid, distgrid=distgrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! Create a custom DistGrid, based on the minIndex, maxIndex of the - ! accepted DistGrid, but with a default regDecomp for the current VM - ! that leads to 1DE/PET. - - ! get dimCount and tileCount - call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, & - connectionCount=connectionCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! allocate minIndexPTile and maxIndexPTile accord. to dimCount and tileCount - allocate(minIndexPTile(dimCount, tileCount), & - maxIndexPTile(dimCount, tileCount)) - allocate(connectionList(connectionCount)) - - ! get minIndex and maxIndex arrays, and connectionList - call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & - maxIndexPTile=maxIndexPTile, connectionList=connectionList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - -#if ESMF_VERSION_MAJOR >= 8 - if (petCount/tileCount * tileCount == petCount) then - ! petCount is a multiple of tileCount: - ! determine a "most square" factorization of the available petCount - ! for each tile in dimCount dims - allocate(regDecomp(dimCount)) - call ESMF_DistGridRegDecompSetCubic(regDecomp, & - deCount=petCount/tileCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate(regDecompPTile(dimCount,tileCount)) - do i=1, tileCount - regDecompPTile(:,i) = regDecomp(:) - enddo - ! create the new DistGrid with the same minIndexPTile and - ! maxIndexPTile, but with most square regDecompPTile for the - ! local petCount - distgrid = ESMF_DistGridCreate(minIndexPTile=minIndexPTile, & - maxIndexPTile=maxIndexPTile, connectionList=connectionList, & - regDecompPTile=regDecompPTile, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - deallocate(regDecomp, regDecompPTile) - else -#endif - ! petCount is NOT a multiple of tileCount: - ! create the new DistGrid with the same minIndexPTile and - ! maxIndexPTile, but with default multi-tile regDecomp: 1DE/PET - distgrid = ESMF_DistGridCreate(minIndexPTile=minIndexPTile, & - maxIndexPTile=maxIndexPTile, connectionList=connectionList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -#if ESMF_VERSION_MAJOR >= 8 - endif -#endif - - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//trim(string)//': distgrid with connlist', ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - ! local clean-up - deallocate(minIndexPTile, maxIndexPTile, connectionList) - - ! Create a new Grid on the new DistGrid and swap it in the Field - grid = ESMF_GridCreate(distgrid, & - gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! check to ensure 1DE/PET condition is satisfied - call ESMF_GridGet(grid, localDeCount=localDeCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (localDeCount /= 1) then - call ESMF_LogSetError(ESMF_RC_INTNRL_BAD, & - msg=SUBNAME//": Violation of 1 DE/PET condition in the Mediator",& - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - - ! Swap all the Grids in the State - -!tcx do n1=1, fieldCount - do n1=n,n - ! access a field in the importState and set the Grid - call ESMF_StateGet(State, field=field, & - itemName=fieldNameList(n1), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldEmptySet(field, grid=grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//trim(string)//": attach grid for "//trim(fieldNameList(n1)), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - call Grid_print(grid,trim(fieldNameList(n))//'_new',rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - enddo - - else - - call ESMF_LogWrite(trim(subname)//trim(string)//": provide grid for "//trim(fieldNameList(n)), ESMF_LOGMSG_INFO, rc=dbrc) - - endif ! accept - - enddo ! nflds - - deallocate(fieldNameList) - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine realizeConnectedGrid - - end subroutine InitializeIPDv03p4 - - !----------------------------------------------------------------------------- - - subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! local variables - type(ESMF_Field) :: field, field1, field2 - type(ESMF_Field) :: fieldArea - type(ESMF_Grid) :: grid - type(InternalState) :: is_local - integer :: fieldCount - real(ESMF_KIND_R8), pointer :: factorList(:) - character(ESMF_MAXSTR) :: name - character(ESMF_MAXSTR) ,pointer :: fieldNameList(:) - integer :: i,j - type(ESMF_Field) :: fieldAtm, fieldOcn - type(ESMF_Array) :: arrayOcn, arrayIce - type(ESMF_RouteHandle) :: RH_mapmask ! unmasked conservative remapping - type(ESMF_Grid) :: gridAtmCoord, gridOcnCoord - integer(ESMF_KIND_I4), pointer :: dataPtr_arrayOcn(:,:), dataPtr_arrayIce(:,:) - integer(ESMF_KIND_I4), pointer :: dataPtr_arrayAtm(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_fieldOcn(:,:), dataPtr_fieldAtm(:,:) - logical :: isPresentOcn, isPresentIce - character(len=*),parameter :: subname='(module_MEDIATOR:InitializeIPDv03p5)' - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - rc = ESMF_SUCCESS - - !---------------------------------------------------------- - !--- Finish initializing the State Fields - !---------------------------------------------------------- - - call completeFieldInitialization(NState_atmImp, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call state_reset(NState_atmImp, value=spval_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call completeFieldInitialization(NState_atmExp, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call state_reset(NState_atmExp, value=spval_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call completeFieldInitialization(NState_ocnImp, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call state_reset(NState_ocnImp, value=spval_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call completeFieldInitialization(NState_ocnExp, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call state_reset(NState_ocnExp, value=spval_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call completeFieldInitialization(NState_iceImp, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call state_reset(NState_iceImp, value=spval_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call completeFieldInitialization(NState_iceExp, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call state_reset(NState_iceExp, value=spval_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call completeFieldInitialization(NState_lndImp, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call state_reset(NState_lndImp, value=spval_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call completeFieldInitialization(NState_lndExp, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call state_reset(NState_lndExp, value=spval_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call completeFieldInitialization(NState_hydImp, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call state_reset(NState_hydImp, value=spval_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call completeFieldInitialization(NState_hydExp, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call state_reset(NState_hydExp, value=spval_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !---------------------------------------------------------- - !--- Set the model grids using first field in each model's import state - !---------------------------------------------------------- - -!tcraig old version -! call ESMF_StateGet(NState_atmImp, field=field, itemName=fldsFrAtm%shortname(1), rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out - -! call ESMF_FieldGet(field, grid=gridAtm, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out - -! call ESMF_StateGet(NState_ocnImp, field=field, itemName=fldsFrOcn%shortname(1), rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out - -! call ESMF_FieldGet(field, grid=gridOcn, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_StateGet(NState_atmImp, itemCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(NState_atmImp, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_StateGet(NState_atmImp, field=field, itemName=fieldNameList(1), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldGet(field, grid=gridAtm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - deallocate(fieldNameList) - -!jwtest -! call ESMF_LogWrite("MED: before get fv3grid vtk", ESMF_LOGMSG_INFO, rc=rc) -! call ESMF_GridWriteVTK(gridAtm, staggerloc=ESMF_STAGGERLOC_CENTER, & -! filename='mediator_fv3Grid', rc=rc) -! call ESMF_LogWrite("MED: aft get fv3grid vtk", ESMF_LOGMSG_INFO, rc=rc) - - else - gridAtm = gridMed - endif - - call ESMF_StateGet(NState_ocnImp, itemCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(NState_ocnImp, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_StateGet(NState_ocnImp, field=field, itemName=fieldNameList(1), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldGet(field, grid=gridOcn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - deallocate(fieldNameList) - else - gridOcn = gridMed - endif - - call ESMF_StateGet(NState_iceImp, itemCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(NState_iceImp, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_StateGet(NState_iceImp, field=field, itemName=fieldNameList(1), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldGet(field, grid=gridIce, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - deallocate(fieldNameList) - else - gridIce = gridMed - endif - -! Land will pick up the grid from the first field exported to Land - - call ESMF_StateGet(NState_lndExp, itemCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(NState_lndExp, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_StateGet(NState_lndExp, field=field, itemName=fieldNameList(1), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldGet(field, grid=gridLnd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridGetCoord(gridLnd, staggerloc=ESMF_STAGGERLOC_CENTER, & - isPresent=isPresent,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (.NOT. isPresent) then - call NEMS_GridCopyCoord(gridcomp=gcomp, gridSrc=gridAtm, gridDst=gridLnd, & - staggerloc=(/ESMF_STAGGERLOC_CENTER/), invert=(/2/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(trim(subname)// & - ": Copied gridATM center coordinates to gridLnd", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - call ESMF_GridGetCoord(gridLnd, staggerloc=ESMF_STAGGERLOC_CORNER, & - isPresent=isPresent,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (.NOT. isPresent) then - call NEMS_GridCopyCoord(gridcomp=gcomp, gridSrc=gridAtm, gridDst=gridLnd, & - staggerloc=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), invert=(/2/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(trim(subname)// & - ": Copied gridATM center and corner coordinates to gridLnd", ESMF_LOGMSG_INFO, rc=dbrc) - call NEMS_GridCopyItem(gridcomp=gcomp, gridSrc=gridAtm, gridDst=gridLnd, & - item=(/ESMF_GRIDITEM_AREA/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(trim(subname)// & - ": Copied gridATM areas to gridLnd", ESMF_LOGMSG_INFO, rc=dbrc) - endif - deallocate(fieldNameList) - else - gridLnd = gridMed - endif - -! Hydro will pick up the grid from the first field exported to Hydro - - call ESMF_StateGet(NState_hydExp, itemCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(NState_hydExp, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_StateGet(NState_hydExp, field=field, itemName=fieldNameList(1), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldGet(field, grid=gridHyd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - deallocate(fieldNameList) - else - gridHyd = gridMed - endif -!BL2017 - !--- land mask - - if (generate_landmask) then - - call ESMF_GridGetItem(gridOcn, itemflag=ESMF_GRIDITEM_MASK, staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresentOcn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetItem(gridIce, itemflag=ESMF_GRIDITEM_MASK, staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresentIce, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - if (isPresentOcn .or. isPresentIce) then - - if (isPresentOcn .and. isPresentIce) then - - ! ocn mask from ocn grid - - call ESMF_GridGetItem(gridOcn, staggerLoc=ESMF_STAGGERLOC_CENTER, itemflag=ESMF_GRIDITEM_MASK, array=arrayOcn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetItem(gridOcn, staggerLoc=ESMF_STAGGERLOC_CENTER, itemflag=ESMF_GRIDITEM_MASK, farrayPtr=dataPtr_arrayOcn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_ArraySet(arrayOcn, name="ocean_mask", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - write (msgString,*) trim(subname)//"ocn_mask raw = ",minval(dataPtr_arrayOcn),maxval(dataPtr_arrayOcn) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - call ESMF_ArrayWrite(arrayOcn, 'field_med_ocn_a_ocean_mask.nc', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ! ice mask from ice grid - - call ESMF_GridGetItem(gridIce, staggerLoc=ESMF_STAGGERLOC_CENTER, itemflag=ESMF_GRIDITEM_MASK, array=arrayIce, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetItem(gridIce, staggerLoc=ESMF_STAGGERLOC_CENTER, itemflag=ESMF_GRIDITEM_MASK, farrayPtr=dataPtr_arrayIce, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_ArraySet(arrayIce, name="ice_mask", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - write (msgString,*) trim(subname)//"ice_mask raw = ",minval(dataPtr_arrayIce),maxval(dataPtr_arrayIce) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - call ESMF_ArrayWrite(arrayIce, 'field_med_ocn_a_ice_mask.nc', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ! generate ocn grid with just coords, no mask or area - ! create ocn/ice mask field on ocn grid, coords only - - call Grid_CreateCoords(gridOcnCoord, gridOcn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - fieldOcn = ESMF_FieldCreate(gridOcnCoord, ESMF_TYPEKIND_R8, name='ocnice_mask', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_FieldGet(fieldOcn, farrayPtr=dataPtr_fieldOcn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ! generate atm grid with just coords, no mask or area - ! create land mask field on atm grid, coords only - - call Grid_CreateCoords(gridAtmCoord, gridAtm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - fieldAtm = ESMF_FieldCreate(gridAtmCoord, ESMF_TYPEKIND_R8, name='land_mask', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_FieldGet(fieldAtm, farrayPtr=dataPtr_FieldAtm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ! Here, the ocean/ice mask is the intersection of ocean and ice masks, which are integer fields of 0 or 1 - ! Convert to real and make sure values are only 0 or 1. - - do j = lbound(dataPtr_fieldOcn,2),ubound(dataPtr_fieldOcn,2) - do i = lbound(dataPtr_fieldOcn,1),ubound(dataPtr_fieldOcn,1) - dataPtr_fieldOcn(i,j) = min(dataPtr_arrayIce(i,j),dataPtr_arrayOcn(i,j)) - if (dataPtr_fieldOcn(i,j) < 0.50_ESMF_KIND_R8) then - dataPtr_fieldOcn(i,j) = 0.0_ESMF_KIND_R8 - else - dataPtr_fieldOcn(i,j) = 1.0_ESMF_KIND_R8 - endif - enddo - enddo - - ! generate a new RH from Atm and Ocn coords, no masks, no areas. Should not use o2a_consd mapping - ! because it has masks and area corrections. - - call ESMF_FieldRegridStore(fieldOcn, fieldAtm, routehandle=RH_mapmask, & - regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & - srcTermProcessing=srcTermProcessing_Value, & - ignoreDegenerate=.true., & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ! regrid ocean mask from ocn to atm grid using unmasked conservative mapping - - if (ESMF_RouteHandleIsCreated(RH_mapmask, rc=rc)) then - dataPtr_fieldAtm = 0.0_ESMF_KIND_R8 - call ESMF_FieldRegrid(fieldOcn, fieldAtm, routehandle=RH_mapmask, & - termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_FieldRegridRelease(RH_mapmask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - else - call ESMF_LogWrite(trim(subname)//": ERROR RH_mapmask not created", ESMF_LOGMSG_INFO, rc=rc) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - - ! convert from ocean mask to land mask - ! check min/max - ! also fill "land_mask" array and save it for later - - allocate(land_mask(lbound(dataPtr_fieldAtm,1):ubound(dataPtr_fieldAtm,1),lbound(dataPtr_fieldAtm,2):ubound(dataPtr_fieldAtm,2))) - - do j = lbound(dataPtr_fieldAtm,2),ubound(dataPtr_fieldAtm,2) - do i = lbound(dataPtr_fieldAtm,1),ubound(dataPtr_fieldAtm,1) - dataPtr_fieldAtm(i,j) = 1.0_ESMF_KIND_R8 - dataPtr_fieldAtm(i,j) - if (dataPtr_fieldAtm(i,j) > 1.0_ESMF_KIND_R8) dataPtr_fieldAtm(i,j) = 1.0_ESMF_KIND_R8 - if (dataPtr_fieldAtm(i,j) < 1.0e-6_ESMF_KIND_R8) dataPtr_fieldAtm(i,j) = 0.0_ESMF_KIND_R8 - land_mask(i,j) = dataPtr_fieldAtm(i,j) - enddo - enddo - - ! write out masks - - call ESMF_FieldWrite(fieldOcn,'field_med_ocn_a_ocnice_mask.nc',overwrite=.true.,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__, file=__FILE__)) return - write (msgString,*) trim(subname)//"ocean_mask = ",minval(dataPtr_fieldOcn),maxval(dataPtr_fieldOcn) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - -#ifndef FRONT_FV3 - call ESMF_FieldWrite(fieldAtm,'field_med_atm_a_land_mask.nc',overwrite=.true.,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__, file=__FILE__)) return - write (msgString,*) trim(subname)//"land_mask = ",minval(dataPtr_fieldAtm),maxval(dataPtr_fieldAtm) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) -#endif - ! clean up - - call ESMF_GridDestroy(gridAtmCoord,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__, file=__FILE__)) return - call ESMF_FieldDestroy(fieldAtm,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__, file=__FILE__)) return - call ESMF_GridDestroy(gridOcnCoord,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__, file=__FILE__)) return - call ESMF_FieldDestroy(fieldOcn,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__, file=__FILE__)) return - - else ! isPresentOcn .and. isPresentIce - call ESMF_LogWrite(trim(subname)//": ABORT more support needed for Ocn or Ice mask", ESMF_LOGMSG_INFO, rc=rc) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - - endif ! isPresentOcn .or. isPresentIce - -!BL2017b -! call ESMF_GridGetItem(gridAtm, staggerLoc=ESMF_STAGGERLOC_CENTER, itemflag=ESMF_GRIDITEM_MASK, farrayPtr=dataPtr_arrayAtm, rc=rc) -! do j = lbound(dataPtr_arrayAtm,2),ubound(dataPtr_arrayAtm,2) -! do i = lbound(dataPtr_arrayAtm,1),ubound(dataPtr_arrayAtm,1) -! dataPtr_arrayAtm(i,j) = 0 ! over ocean -!! if (land_mask(i,j) >= 0.01_ESMF_KIND_R8) dataPtr_arrayAtm(i,j) =1_ESMF_KIND_I4 -! if (land_mask(i,j) >= 1.0e-6_ESMF_KIND_R8) dataPtr_arrayAtm(i,j) =1_ESMF_KIND_I4 -! enddo -! enddo -!BL2017 - endif ! generate_landmask - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - !---------------------------------------------------------- - !--- Diagnose Grid Info - !---------------------------------------------------------- - - call Grid_Print(gridAtm,'gridAtm',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call Grid_Print(gridOcn,'gridOcn',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call Grid_Print(gridIce,'gridIce',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call Grid_Print(gridLnd,'gridLnd',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call Grid_Print(gridHyd,'gridHyd',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call Grid_Print(gridMed,'gridMed',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - -#if 1 - !---------------------------------------------------------- - ! dump the Grid coordinate arrays for reference - !---------------------------------------------------------- - -#ifndef FRONT_FV3 - call Grid_Write(gridAtm, 'array_med_atm', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -#endif - - call Grid_Write(gridOcn, 'array_med_ocn', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call Grid_Write(gridIce, 'array_med_ice', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call Grid_Write(gridLnd, 'array_med_lnd', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call Grid_Write(gridHyd, 'array_med_hyd', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call Grid_Write(gridMed, 'array_med_med', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - -#endif - - !---------------------------------------------------------- - ! NOW allocate other Mediator datatypes - !---------------------------------------------------------- - - ! Get the internal state from Component. - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !---------------------------------------------------------- - ! Initialize FB for each model import states on each grid - !---------------------------------------------------------- - - !--- atm - - call fieldBundle_init(is_local%wrap%FBAtm_a, grid=gridAtm, & - state=NState_AtmImp, name='FBAtm_a', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBAtm_o, grid=gridOcn, & - state=NState_AtmImp, name='FBAtm_o', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBAtm2_o, grid=gridOcn, & - state=NState_AtmImp, name='FBAtm2_o', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBAtm_i, grid=gridIce, & - state=NState_AtmImp, name='FBAtm_i', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBAtm2_i, grid=gridIce, & - state=NState_AtmImp, name='FBAtm2_i', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBAtm_l, grid=gridLnd, & - state=NState_AtmImp, name='FBAtm_l', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBAtm_h, grid=gridHyd, & - state=NState_AtmImp, name='FBAtm_h', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--- ocn - - call fieldBundle_init(is_local%wrap%FBOcn_a, grid=gridAtm, & - state=NState_OcnImp, name='FBOcn_a', rc=rc) -!BL2017b - call fieldBundle_init(is_local%wrap%FBOcn2_a, grid=gridAtm, & - state=NState_OcnImp, name='FBOcn2_a', rc=rc) -!BL2017b - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBOcn_o, grid=gridOcn, & - state=NState_OcnImp, name='FBOcn_o', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBOcn_i, grid=gridIce, & - state=NState_OcnImp, name='FBOcn_i', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--- ice - - call fieldBundle_init(is_local%wrap%FBIce_a, grid=gridAtm, & - state=NState_IceImp, name='FBIce_a', rc=rc) -!BL2017b - call fieldBundle_init(is_local%wrap%FBIce2_a, grid=gridAtm, & - state=NState_IceImp, name='FBIce2_a', rc=rc) -!BL2017b - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBIce_o, grid=gridOcn, & - state=NState_IceImp, name='FBIce_o', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBIce_i, grid=gridIce, & - state=NState_IceImp, name='FBIce_i', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBIce_if, grid=gridIce, & - state=NState_IceImp, name='FBIce_if', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--- lnd - - call fieldBundle_init(is_local%wrap%FBLnd_a, grid=gridAtm, & - state=NState_LndImp, name='FBLnd_a', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBLnd_l, grid=gridLnd, & - state=NState_LndImp, name='FBLnd_l', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBLnd_h, grid=gridHyd, & - state=NState_LndImp, name='FBLnd_h', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--- hyd - - call fieldBundle_init(is_local%wrap%FBHyd_l, grid=gridLnd, & - state=NState_HydImp, name='FBHyd_l', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBHyd_a, grid=gridAtm, & - state=NState_HydImp, name='FBHyd_a', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBHyd_h, grid=gridHyd, & - state=NState_HydImp, name='FBHyd_h', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !---------------------------------------------------------- - ! Initialize Accumulators - !---------------------------------------------------------- - - call fieldBundle_init(is_local%wrap%FBaccumAtm, grid=gridAtm, & - state=NState_AtmImp, name='FBaccumAtm', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBaccumOcn, grid=gridOcn, & - state=NState_OcnImp, name='FBaccumOcn', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBaccumIce, grid=gridIce, & - state=NState_IceImp, name='FBaccumIce', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBaccumLnd, grid=gridLnd, & - state=NState_LndImp, name='FBaccumLnd', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBaccumHyd, grid=gridHyd, & - state=NState_HydImp, name='FBaccumHyd', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !---------------------------------------------------------- - ! Initialize AtmOcn FBs - !---------------------------------------------------------- - - call fieldBundle_init(is_local%wrap%FBAtmOcn_o, grid=gridOcn, & - fieldnamelist=fldsAtmOcn%shortname(1:fldsAtmOcn%num), name='FBAtmOcn_o', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !call fieldBundle_init(is_local%wrap%FBAtmOcn_a, grid=gridAtm, & - ! fieldnamelist=fldsAtmOcn%shortname(1:fldsAtmOcn%num), name='FBAtmOcn_a', rc=rc) -!BL2017b - !call fieldBundle_init(is_local%wrap%FBAtmOcn2_a, grid=gridAtm, & - ! fieldnamelist=fldsAtmOcn%shortname(1:fldsAtmOcn%num), name='FBAtmOcn2_a', rc=rc) -!BL2017b - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBaccumAtmOcn, grid=gridOcn, & - fieldnamelist=fldsAtmOcn%shortname(1:fldsAtmOcn%num), name='FBaccumAtmOcn', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !---------------------------------------------------------- - ! Initialize FB for export to models - !---------------------------------------------------------- - - call fieldBundle_init(is_local%wrap%FBforAtm, & - state=NState_AtmExp, name='FBforAtm', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBforOcn, & - state=NState_OcnExp, name='FBforOcn', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBforIce, & - state=NState_IceExp, name='FBforIce', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBforLnd, & - state=NState_LndExp, name='FBforLnd', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_init(is_local%wrap%FBforHyd, & - state=NState_HydExp, name='FBforHyd', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !---------------------------------------------------------- - !--- Check for active regrid directions - !---------------------------------------------------------- - - ! initialize - is_local%wrap%a2o_active = .false. - is_local%wrap%a2i_active = .false. - is_local%wrap%a2l_active = .false. - is_local%wrap%a2h_active = .false. - is_local%wrap%o2a_active = .false. - is_local%wrap%o2i_active = .false. - is_local%wrap%i2a_active = .false. - is_local%wrap%i2o_active = .false. - is_local%wrap%l2a_active = .false. - is_local%wrap%l2h_active = .false. - is_local%wrap%h2l_active = .false. - is_local%wrap%h2a_active = .false. - - ! a2o, a2i, a2l, a2h - call ESMF_FieldBundleGet(is_local%wrap%FBAtm_a, fieldCount=fieldCount, rc=rc) ! Atmosphere Export Field Count - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - call ESMF_FieldBundleGet(is_local%wrap%FBforOcn, fieldCount=fieldCount, rc=rc) ! Ocean Import Field Count - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - is_local%wrap%a2o_active = .true. - endif - call ESMF_FieldBundleGet(is_local%wrap%FBforIce, fieldCount=fieldCount, rc=rc) ! Ice Import Field Count - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - is_local%wrap%a2i_active = .true. - endif - call ESMF_FieldBundleGet(is_local%wrap%FBforLnd, fieldCount=fieldCount, rc=rc) ! Land Import Field Count - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - is_local%wrap%a2l_active = .true. - endif - call ESMF_FieldBundleGet(is_local%wrap%FBforHyd, fieldCount=fieldCount, rc=rc) ! Hydro Import Field Count - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - is_local%wrap%a2h_active = .true. - endif - endif - - ! o2a, o2i - call ESMF_FieldBundleGet(is_local%wrap%FBOcn_o, fieldCount=fieldCount, rc=rc) ! Ocean Export Field Count - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - call ESMF_FieldBundleGet(is_local%wrap%FBforAtm, fieldCount=fieldCount, rc=rc) ! Atmosphere Import Field Count - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - is_local%wrap%o2a_active = .true. - endif - call ESMF_FieldBundleGet(is_local%wrap%FBforIce, fieldCount=fieldCount, rc=rc) ! Ice Import Field Count - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - is_local%wrap%o2i_active = .true. - endif - endif - - ! i2a, i2o - call ESMF_FieldBundleGet(is_local%wrap%FBIce_i, fieldCount=fieldCount, rc=rc) ! Ice Export Field Count - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - call ESMF_FieldBundleGet(is_local%wrap%FBforAtm, fieldCount=fieldCount, rc=rc) ! Atmosphere Import Field Count - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - is_local%wrap%i2a_active = .true. - endif - call ESMF_FieldBundleGet(is_local%wrap%FBforOcn, fieldCount=fieldCount, rc=rc) ! Ocean Import Field Count - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - is_local%wrap%i2o_active = .true. - endif - endif - - ! l2a, l2h - call ESMF_FieldBundleGet(is_local%wrap%FBLnd_l, fieldCount=fieldCount, rc=rc) ! Land Export Field Count - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - call ESMF_FieldBundleGet(is_local%wrap%FBforAtm, fieldCount=fieldCount, rc=rc) ! Atmosphere Import Field Count - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - is_local%wrap%l2a_active = .true. - endif - call ESMF_FieldBundleGet(is_local%wrap%FBforHyd, fieldCount=fieldCount, rc=rc) ! Hyd Import Field Count - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - is_local%wrap%l2h_active = .true. - endif - endif - - ! h2l, h2a - call ESMF_FieldBundleGet(is_local%wrap%FBHyd_h, fieldCount=fieldCount, rc=rc) ! Hydro Export Field Count - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - call ESMF_FieldBundleGet(is_local%wrap%FBforLnd, fieldCount=fieldCount, rc=rc) ! Land Import Field Count - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - is_local%wrap%h2l_active = .true. - endif - call ESMF_FieldBundleGet(is_local%wrap%FBforAtm, fieldCount=fieldCount, rc=rc) ! Atmosphere Import Field Count - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (fieldCount > 0) then - is_local%wrap%h2a_active = .true. - endif - endif - - write(msgString,*) is_local%wrap%a2o_active - call ESMF_LogWrite(trim(subname)//": a2o active: " // trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - write(msgString,*) is_local%wrap%a2i_active - call ESMF_LogWrite(trim(subname)//": a2i active: " // trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - write(msgString,*) is_local%wrap%a2l_active - call ESMF_LogWrite(trim(subname)//": a2l active: " // trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - write(msgString,*) is_local%wrap%a2h_active - call ESMF_LogWrite(trim(subname)//": a2h active: " // trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - - write(msgString,*) is_local%wrap%o2a_active - call ESMF_LogWrite(trim(subname)//": o2a active: " // trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - write(msgString,*) is_local%wrap%o2i_active - call ESMF_LogWrite(trim(subname)//": o2i active: " // trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - - write(msgString,*) is_local%wrap%i2a_active - call ESMF_LogWrite(trim(subname)//": i2a active: " // trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - write(msgString,*) is_local%wrap%i2o_active - call ESMF_LogWrite(trim(subname)//": i2o active: " // trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - - write(msgString,*) is_local%wrap%l2a_active - call ESMF_LogWrite(trim(subname)//": l2a active: " // trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - write(msgString,*) is_local%wrap%l2h_active - call ESMF_LogWrite(trim(subname)//": l2h active: " // trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - - write(msgString,*) is_local%wrap%h2l_active - call ESMF_LogWrite(trim(subname)//": h2l active: " // trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - write(msgString,*) is_local%wrap%h2a_active - call ESMF_LogWrite(trim(subname)//": h2a active: " // trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - - !---------------------------------------------------------- - !--- Initialize route handles - !---------------------------------------------------------- - - if (dbug_flag > 1) then - call ESMF_LogWrite("Starting to initialize RHs", ESMF_LOGMSG_INFO) - call ESMF_LogFlush() - endif - - if (is_local%wrap%a2o_active) then - call Compute_RHs(FBsrc=is_local%wrap%FBAtm_a, FBdst=is_local%wrap%FBAtm_o, & - bilnrmap=is_local%wrap%RH_a2o_bilnr, & - consfmap=is_local%wrap%RH_a2o_consf, & - consdmap=is_local%wrap%RH_a2o_consd, & - patchmap=is_local%wrap%RH_a2o_patch, & - fcopymap=is_local%wrap%RH_a2o_fcopy, & - nearestmap=is_local%wrap%RH_a2o_nearest, & - srcMaskValue=1, & - dstMaskValue=0, & - fldlist1=FldsFrAtm, string='a2o_weights', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (is_local%wrap%a2i_active) then - call Compute_RHs(FBsrc=is_local%wrap%FBAtm_a, FBdst=is_local%wrap%FBAtm_i, & - bilnrmap=is_local%wrap%RH_a2i_bilnr, & - consfmap=is_local%wrap%RH_a2i_consf, & - consdmap=is_local%wrap%RH_a2i_consd, & - patchmap=is_local%wrap%RH_a2i_patch, & - fcopymap=is_local%wrap%RH_a2i_fcopy, & - nearestmap=is_local%wrap%RH_a2i_nearest, & - srcMaskValue=1, & - dstMaskValue=0, & - fldlist1=FldsFrAtm, string='a2i_weights', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (is_local%wrap%a2l_active) then - call Compute_RHs(FBsrc=is_local%wrap%FBAtm_a, FBdst=is_local%wrap%FBAtm_l, & - bilnrmap=is_local%wrap%RH_a2l_bilnr, & - consfmap=is_local%wrap%RH_a2l_consf, & - consdmap=is_local%wrap%RH_a2l_consd, & - patchmap=is_local%wrap%RH_a2l_patch, & - fcopymap=is_local%wrap%RH_a2l_fcopy, & - fldlist1=FldsFrAtm, string='a2l_weights', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (is_local%wrap%a2h_active) then - call Compute_RHs(FBsrc=is_local%wrap%FBAtm_a, FBdst=is_local%wrap%FBAtm_h, & - bilnrmap=is_local%wrap%RH_a2h_bilnr, & - consfmap=is_local%wrap%RH_a2h_consf, & - consdmap=is_local%wrap%RH_a2h_consd, & - patchmap=is_local%wrap%RH_a2h_patch, & - fcopymap=is_local%wrap%RH_a2h_fcopy, & - fldlist1=FldsFrAtm, string='a2h_weights', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (is_local%wrap%o2a_active) then - call Compute_RHs(FBsrc=is_local%wrap%FBOcn_o, FBdst=is_local%wrap%FBOcn_a, & - bilnrmap=is_local%wrap%RH_o2a_bilnr, & - consfmap=is_local%wrap%RH_o2a_consf, & - consdmap=is_local%wrap%RH_o2a_consd, & - patchmap=is_local%wrap%RH_o2a_patch, & - fcopymap=is_local%wrap%RH_o2a_fcopy, & - nearestmap=is_local%wrap%RH_o2a_nearest, & - srcMaskValue=0, & - dstMaskValue=1, & - fldlist1=FldsFrOcn, fldlist2=FldsAtmOcn, string='o2a_weights', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (is_local%wrap%o2i_active) then - call Compute_RHs(FBsrc=is_local%wrap%FBOcn_o, FBdst=is_local%wrap%FBOcn_i, & - bilnrmap=is_local%wrap%RH_o2i_bilnr, & - consfmap=is_local%wrap%RH_o2i_consf, & - consdmap=is_local%wrap%RH_o2i_consd, & - patchmap=is_local%wrap%RH_o2i_patch, & - fcopymap=is_local%wrap%RH_o2i_fcopy, & - srcMaskValue=0, dstMaskValue=0, & - fldlist1=FldsFrOcn, string='o2i_weights', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (is_local%wrap%i2a_active) then - call Compute_RHs(FBsrc=is_local%wrap%FBIce_i, FBdst=is_local%wrap%FBIce_a, & - bilnrmap=is_local%wrap%RH_i2a_bilnr, & - consfmap=is_local%wrap%RH_i2a_consf, & - consdmap=is_local%wrap%RH_i2a_consd, & - patchmap=is_local%wrap%RH_i2a_patch, & - fcopymap=is_local%wrap%RH_i2a_fcopy, & - nearestmap=is_local%wrap%RH_i2a_nearest, & - srcMaskValue=0, & - dstMaskValue=1, & - fldlist1=FldsFrIce, string='i2a_weights', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (is_local%wrap%i2o_active) then - call Compute_RHs(FBsrc=is_local%wrap%FBIce_i, FBdst=is_local%wrap%FBIce_o, & - bilnrmap=is_local%wrap%RH_i2o_bilnr, & - consfmap=is_local%wrap%RH_i2o_consf, & - consdmap=is_local%wrap%RH_i2o_consd, & - patchmap=is_local%wrap%RH_i2o_patch, & - fcopymap=is_local%wrap%RH_i2o_fcopy, & - srcMaskValue=0, dstMaskValue=0, & - fldlist1=FldsFrIce, string='i2o_weights', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (is_local%wrap%l2a_active) then - call Compute_RHs(FBsrc=is_local%wrap%FBLnd_l, FBdst=is_local%wrap%FBLnd_a, & - bilnrmap=is_local%wrap%RH_l2a_bilnr, & - consfmap=is_local%wrap%RH_l2a_consf, & - consdmap=is_local%wrap%RH_l2a_consd, & - patchmap=is_local%wrap%RH_l2a_patch, & - fcopymap=is_local%wrap%RH_l2a_fcopy, & - fldlist1=FldsFrLnd, string='l2a_weights', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (is_local%wrap%l2h_active) then - call Compute_RHs(FBsrc=is_local%wrap%FBLnd_l, FBdst=is_local%wrap%FBLnd_h, & - bilnrmap=is_local%wrap%RH_l2h_bilnr, & - consfmap=is_local%wrap%RH_l2h_consf, & - consdmap=is_local%wrap%RH_l2h_consd, & - patchmap=is_local%wrap%RH_l2h_patch, & - fcopymap=is_local%wrap%RH_l2h_fcopy, & - fldlist1=FldsFrLnd, string='l2h_weights', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (is_local%wrap%h2a_active) then - call Compute_RHs(FBsrc=is_local%wrap%FBHyd_h, FBdst=is_local%wrap%FBHyd_a, & - bilnrmap=is_local%wrap%RH_h2a_bilnr, & - consfmap=is_local%wrap%RH_h2a_consf, & - consdmap=is_local%wrap%RH_h2a_consd, & - patchmap=is_local%wrap%RH_h2a_patch, & - fcopymap=is_local%wrap%RH_h2a_fcopy, & - fldlist1=FldsFrHyd, string='h2a_weights', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (is_local%wrap%h2l_active) then - call Compute_RHs(FBsrc=is_local%wrap%FBHyd_h, FBdst=is_local%wrap%FBHyd_l, & - bilnrmap=is_local%wrap%RH_h2l_bilnr, & - consfmap=is_local%wrap%RH_h2l_consf, & - consdmap=is_local%wrap%RH_h2l_consd, & - patchmap=is_local%wrap%RH_h2l_patch, & - fcopymap=is_local%wrap%RH_h2l_fcopy, & - fldlist1=FldsFrHyd, string='h2l_weights', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - subroutine completeFieldInitialization(State,rc) - - type(ESMF_State) , intent(inout) :: State - integer , intent(out) :: rc - - integer :: n, fieldCount - character(ESMF_MAXSTR),allocatable :: fieldNameList(:) - type(ESMF_FieldStatus_Flag) :: fieldStatus - - character(len=*),parameter :: subname='(module_MEDIATOR:completeFieldInitialization)' -#ifndef NUOPC_DOES_SMART_GRID_TRANSFER - type(ESMF_Grid) :: grid -#endif - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - rc = ESMF_Success - - call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(State, itemNameList=fieldNameList, & - itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - do n=1, fieldCount - - call ESMF_StateGet(State, field=field, itemName=fieldNameList(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_FieldGet(field, status=fieldStatus, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (fieldStatus==ESMF_FIELDSTATUS_GRIDSET) then - if (dbug_flag > 1) then - call ESMF_LogWrite(subname//" is accepting grid for field "//trim(fieldNameList(n)), & - ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - ! the transferred Grid is already set, allocate field data memory - ! DCR - The WRFHYDRO soil fields have an ungridded 3rd dimension. - ! The ESMF_FieldEmptyComplete is not allocating memory for this 3rd dimension - call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -#ifndef NUOPC_DOES_SMART_GRID_TRANSFER - ! access the transferred Grid to use for other fields - call ESMF_FieldGet(field, grid=grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - else - if (dbug_flag > 1) then - call ESMF_LogWrite(subname//" is accepting INTERNAL grid for field "//trim(fieldNameList(n)), & - ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - ! now use the Grid object in other fields - call ESMF_FieldEmptySet(field, grid=grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -#endif - endif ! accept - - call FldGrid_Print(field,fieldNameList(n),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - enddo - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine completeFieldInitialization - - end subroutine InitializeIPDv03p5 - - !----------------------------------------------------------------------------- - - subroutine DataInitialize(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_State) :: importState, exportState - type(ESMF_Time) :: time - type(ESMF_Field) :: field - type(ESMF_StateItem_Flag) :: itemType - logical :: atCorrectTime, allDone, connected - type(InternalState) :: is_local - character(len=*), parameter :: subname='(module_MEDIATOR:DataInitialize)' - integer :: n - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - rc = ESMF_SUCCESS - - ! the MED needs valid ATM export Fields to initialize its internal state - - ! query the Component for its clock, importState and exportState - call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & - exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! Get the internal state from Component. - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! get the current time out of the clock - call ESMF_ClockGet(clock, currTime=time, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! initialze cumulative flag - allDone = .true. ! reset if an item is found that is not done - - ! check that all imported fields from ATM show correct timestamp - do n = 1,fldsFrAtm%num - call ESMF_StateGet(NState_AtmImp, itemName=fldsFrAtm%shortname(n), & - itemType=itemType, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (itemType /= ESMF_STATEITEM_NOTFOUND) then - connected = NUOPC_IsConnected(NState_AtmImp, & - fieldName=fldsFrAtm%shortname(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (connected) then - call ESMF_StateGet(NState_AtmImp, itemName=fldsFrAtm%shortname(n), & - field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - atCorrectTime = NUOPC_IsAtTime(field, time, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (.not.atCorrectTime) then - call ESMF_LogWrite("MED - Initialize-Data-Dependency NOT YET SATISFIED!!!", & - ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allDone = .false. - exit ! break out of the loop when first not satisfied found - else - call ESMF_LogWrite("MED - Initialize-Data-Dependency SATISFIED!!!", & - ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - endif - endif - enddo - - !TODO: need to loop through fields from all of the components from which - !TODO: valid field data is expected at this time!! - - if (allDone) then - ! -> set InitializeDataComplete Component Attribute to "true", indicating - ! to the driver that this Component has fully initialized its data - call NUOPC_CompAttributeSet(gcomp, & - name="InitializeDataComplete", value="true", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! gjt: The above code ensures that the MED has initial conditions from ATM. - - ! TODO - For the real case this should probably use the fields from the - ! importState and do something with it as a sensible starting point - ! for the accumulation field so that the OCN receives a meaningful - ! fields during its first time step. However, here for testing - ! I simply initialize to zero. - - call state_reset(NState_atmImp, value=spval_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call state_reset(NState_ocnImp, value=spval_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call state_reset(NState_iceImp, value=spval_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call state_reset(NState_lndImp, value=spval_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call state_reset(NState_hydImp, value=spval_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_reset(is_local%wrap%FBaccumAtm, value=czero, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - is_local%wrap%accumcntAtm = 0 - - call fieldBundle_reset(is_local%wrap%FBaccumOcn, value=czero, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - is_local%wrap%accumcntOcn = 0 - - call fieldBundle_reset(is_local%wrap%FBaccumIce, value=czero, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - is_local%wrap%accumcntIce = 0 - - call fieldBundle_reset(is_local%wrap%FBaccumLnd, value=czero, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - is_local%wrap%accumcntLnd = 0 - - call fieldBundle_reset(is_local%wrap%FBaccumHyd, value=czero, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - is_local%wrap%accumcntHyd = 0 - - !--------------------------------------- - ! read mediator restarts - !--------------------------------------- - - !---tcraig, turn if on to force no mediator restarts for testing - !if (.not.coldstart) then - call Mediator_restart(gcomp,'read','mediator',rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - !endif - - ! default initialize s_surf to work around limitations of current initialization sequence - call ESMF_StateGet(NState_IceExp, itemName='s_surf', & - itemType=itemType, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (itemType /= ESMF_STATEITEM_NOTFOUND) then - if (NUOPC_IsConnected(NState_IceExp,'s_surf',rc=rc)) then - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call State_SetFldPtr(NState_IceExp, 's_surf', 34.0_ESMF_KIND_R8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - endif - - endif - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine DataInitialize - - !----------------------------------------------------------------------------- - - subroutine SetRunClock(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: mediatorClock, driverClock - type(ESMF_Time) :: currTime - type(ESMF_TimeInterval) :: timeStep - character(len=*),parameter :: subname='(module_MEDIATOR:SetRunClock)' - - rc = ESMF_SUCCESS - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - ! query the Mediator for clocks - call NUOPC_MediatorGet(gcomp, mediatorClock=mediatorClock, & - driverClock=driverClock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 1) then - call ClockTimePrint(driverClock ,trim(subname)//'driver clock1',rc) - call ClockTimePrint(mediatorClock,trim(subname)//'mediat clock1',rc) - endif - - ! set the mediatorClock to have the current start time as the driverClock - call ESMF_ClockGet(driverClock, currTime=currTime, timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_ClockSet(mediatorClock, currTime=currTime, timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 1) then - call ClockTimePrint(driverClock ,trim(subname)//'driver clock2',rc) - call ClockTimePrint(mediatorClock,trim(subname)//'mediat clock2',rc) - endif - - ! check and set the component clock against the driver clock - call NUOPC_CompCheckSetClock(gcomp, driverClock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine SetRunClock - - !----------------------------------------------------------------------------- - - subroutine MedPhase_fast_before(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! This Mediator phase runs before ATM and ICE are being called and - ! prepares the ATM and ICE import Fields. - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Time) :: time - character(len=64) :: timestr - type(ESMF_State) :: importState, exportState - type(ESMF_Field) :: field - type(InternalState) :: is_local - real(ESMF_KIND_R8), pointer :: dataPtr1(:,:),dataPtr2(:,:),dataPtr3(:,:) - integer :: i,j,n - character(len=*),parameter :: subname='(module_MEDIATOR:MedPhase_fast_before)' - - if(profile_memory) call ESMF_VMLogMemInfo("Entering "//trim(subname)) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - call MedPhase_prep_atm(gcomp,rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call MedPhase_prep_ice(gcomp,rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call MedPhase_prep_lnd(gcomp,rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call MedPhase_prep_hyd(gcomp,rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - if(profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) - - end subroutine MedPhase_fast_before - - !----------------------------------------------------------------------------- - - subroutine MedPhase_prep_atm(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! This Mediator phase runs before ATM and ICE are being called and - ! prepares the ATM and ICE import Fields. - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Time) :: time - character(len=64) :: timestr - type(ESMF_State) :: importState, exportState - type(ESMF_Field) :: field - type(InternalState) :: is_local - real(ESMF_KIND_R8), pointer :: dataPtr1(:,:),dataPtr2(:,:),dataPtr3(:,:),dataPtr4(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr5(:,:) - real(ESMF_KIND_R8), pointer :: ifrac_i(:,:) ! ice fraction on ice grid - real(ESMF_KIND_R8), pointer :: ifrac_af(:,:), ifrac_afr(:,:) ! ice fraction on atm grid consf map - real(ESMF_KIND_R8), pointer :: ifrac_ad(:,:), ifrac_adr(:,:) ! ice fraction on atm grid consd map - real(ESMF_KIND_R8), pointer :: ifrac_ab(:,:), ifrac_abr(:,:) ! ice fraction on atm grid bilnr map - real(ESMF_KIND_R8), pointer :: ifrac_ap(:,:), ifrac_apr(:,:) ! ice fraction on atm grid patch map - real(ESMF_KIND_R8), pointer :: icewgt(:,:) - integer :: i,j,n - integer :: regridwriteAtmExp_timeslice = 0 - character(len=128) :: fname - character(len=*),parameter :: subname='(module_MEDIATOR:MedPhase_prep_atm)' -!BL2017b - character(ESMF_MAXSTR) ,pointer :: fieldNameList(:) - integer :: fieldCount -!BL2017b - - if(profile_memory) call ESMF_VMLogMemInfo("Entering "//trim(subname)) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - ! query the Component for its clock, importState and exportState - call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & - exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! Get the internal state from Component. - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_ClockGet(clock,currtime=time,rc=rc) - call ESMF_TimeGet(time,timestring=timestr) - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": time = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - if (dbug_flag > 1) then - call ESMF_ClockPrint(clock, options="currTime", & - preString="-------->"//trim(subname)//" mediating for: ", & - unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - !--------------------------------------- - !--- this is fast, no accumulator needed - !--------------------------------------- - - if (dbug_flag > 1) then - call fieldBundle_reset(is_local%wrap%FBAtm_a, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBOcn_o, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBIce_i, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBLnd_l, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBHyd_h, value=czero, rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBAtm_a, trim(subname)//' FBAtm_a zero', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBOcn_o, trim(subname)//' FBOcn_o zero', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBIce_i, trim(subname)//' FBIce_i zero', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBLnd_l, trim(subname)//' FBLnd_l zero', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBHyd_h, trim(subname)//' FBhyd_h zero', rc=rc) - call State_diagnose(NState_AtmImp, trim(subname)//' AtmImp ', rc=rc) - call State_diagnose(NState_OcnImp, trim(subname)//' OcnImp ', rc=rc) - call State_diagnose(NState_IceImp, trim(subname)//' IceImp ', rc=rc) - call State_diagnose(NState_LndImp, trim(subname)//' LndImp ', rc=rc) - call State_diagnose(NState_HydImp, trim(subname)//' HydImp ', rc=rc) - endif - - call fieldBundle_copy(is_local%wrap%FBAtm_a, NState_AtmImp, rc=rc) - call fieldBundle_copy(is_local%wrap%FBOcn_o, NState_OcnImp, rc=rc) - call fieldBundle_copy(is_local%wrap%FBIce_i, NState_IceImp, rc=rc) - call fieldBundle_copy(is_local%wrap%FBLnd_l, NState_LndImp, rc=rc) - call fieldBundle_copy(is_local%wrap%FBHyd_h, NState_HydImp, rc=rc) - - if (dbug_flag > 1) then - call FieldBundle_diagnose(is_local%wrap%FBAtm_a, trim(subname)//' FBAtm_a ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBOcn_o, trim(subname)//' FBOcn_o ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBIce_i, trim(subname)//' FBIce_i ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBLnd_l, trim(subname)//' FBLnd_l ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBHyd_h, trim(subname)//' FBHyd_h ', rc=rc) - endif - - ! Regrid Full Field Bundles conservatively - - call fieldBundle_reset(is_local%wrap%FBOcn_a, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBIce_a, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBIce_if, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBLnd_a, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBHyd_a, value=czero, rc=rc) - !call fieldBundle_reset(is_local%wrap%FBAtmOcn_a, value=czero, rc=rc) -!BL2017b - call fieldBundle_reset(is_local%wrap%FBOcn2_a, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBIce2_a, value=czero, rc=rc) - !call fieldBundle_reset(is_local%wrap%FBAtmOcn2_a, value=czero, rc=rc) -!BL2017b - - if (is_local%wrap%o2a_active) then - call Fieldbundle_Regrid(fldsFrOcn, is_local%wrap%FBOcn_o, is_local%wrap%FBOcn_a, & - consfmap=is_local%wrap%RH_o2a_consf, & - consdmap=is_local%wrap%RH_o2a_consd, & - bilnrmap=is_local%wrap%RH_o2a_bilnr, & - patchmap=is_local%wrap%RH_o2a_patch, & - string='o2a', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - -!BL2017b -! use the nearest neighbor method - call Fieldbundle_Regrid2(fldsFrOcn, is_local%wrap%FBOcn_o, is_local%wrap%FBOcn2_a, & - nearestmap=is_local%wrap%RH_o2a_nearest, & - string='o2a_nearest', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_FieldBundleGet(is_local%wrap%FBOcn_a, fieldCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate(fieldNameList(fieldCount)) - call ESMF_FieldBundleGet(is_local%wrap%FBOcn_a, fieldNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - do n = 1, fieldCount - call FieldBundle_GetFldPtr(is_local%wrap%FBOcn_a, fieldNameList(n),dataPtr1,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call FieldBundle_GetFldPtr(is_local%wrap%FBOcn2_a, fieldNameList(n), dataPtr2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - do j=lbound(dataPtr1,2),ubound(dataPtr1,2) - do i=lbound(dataPtr1,1),ubound(dataPtr1,1) - if(dataPtr1(i,j).eq.0._ESMF_KIND_R8.and.abs(dataPtr2(i,j)).gt.0._ESMF_KIND_R8) then - dataPtr1(i,j)=dataPtr2(i,j) - endif - enddo - enddo - enddo - deallocate(fieldNameList) -!BL2017b -! -! call Fieldbundle_Regrid(fldsAtmOcn, is_local%wrap%FBAtmOcn_o, is_local%wrap%FBAtmOcn_a, & -! consfmap=is_local%wrap%RH_o2a_consf, & -! consdmap=is_local%wrap%RH_o2a_consd, & -! bilnrmap=is_local%wrap%RH_o2a_bilnr, & -! patchmap=is_local%wrap%RH_o2a_patch, & -! string='o2aatmocn', rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out -! -!!BL2017b -!! use the nearest neighbor method -! call Fieldbundle_Regrid2(fldsAtmOcn, is_local%wrap%FBAtmOcn_o, is_local%wrap%FBAtmOcn2_a, & -! nearestmap=is_local%wrap%RH_o2a_nearest, & -! string='atmocn_o2a_nearest', rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out -! -! call ESMF_FieldBundleGet(is_local%wrap%FBAtmOcn_a, fieldCount=fieldCount, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out -! allocate(fieldNameList(fieldCount)) -! call ESMF_FieldBundleGet(is_local%wrap%FBAtmOcn_a, fieldNameList=fieldNameList, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out -! -! do n = 1, fieldCount -! call FieldBundle_GetFldPtr(is_local%wrap%FBAtmOcn_a, fieldNameList(n),dataPtr1,rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out -! -! call FieldBundle_GetFldPtr(is_local%wrap%FBAtmOcn2_a, fieldNameList(n), dataPtr2, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out -! -! do j=lbound(dataPtr1,2),ubound(dataPtr1,2) -! do i=lbound(dataPtr1,1),ubound(dataPtr1,1) -! if(dataPtr1(i,j).eq.0._ESMF_KIND_R8.and.abs(dataPtr2(i,j)).gt.0._ESMF_KIND_R8) then -! dataPtr1(i,j)=dataPtr2(i,j) -! endif -! enddo -! enddo -! enddo -! deallocate(fieldNameList) -!BL2017b - endif - - if (is_local%wrap%i2a_active) then - if (FieldBundle_FldChk(is_local%wrap%FBIce_i, 'ice_fraction', rc=rc) .and. & - FieldBundle_FldChk(is_local%wrap%FBIce_a, 'ice_fraction', rc=rc)) then - !--- tcraig, need to weight the ice2atm regrid by the ice fraction - !--- need to compute weight by the frac mapped with the correct mapping - !--- first compute the ice fraction on the atm grid for all active mappings - - !--- copy out the ifrac on ice grid - - call FieldBundle_GetFldPtr(is_local%wrap%FBIce_i, 'ice_fraction', dataPtr1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate(ifrac_i (lbound(dataPtr1,1):ubound(dataPtr1,1),lbound(dataPtr1,2):ubound(dataPtr1,2))) - do j=lbound(dataptr1,2),ubound(dataptr1,2) - do i=lbound(dataptr1,1),ubound(dataptr1,1) - ifrac_i(i,j) = dataPtr1(i,j) - enddo - enddo -!BL2017b - !--- need to add the nearest neighbor regridding method here - B Li - call FieldBundle_FieldRegrid(is_local%wrap%FBIce_i,'ice_fraction', & - is_local%wrap%FBIce2_a,'ice_fraction', & - is_local%wrap%RH_i2a_nearest, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call FieldBundle_GetFldPtr(is_local%wrap%FBIce2_a,'ice_fraction', dataPtr5, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -!BL2017b - - !--- conservative frac - if (ESMF_RouteHandleIsCreated(is_local%wrap%RH_i2a_consf, rc=rc)) then - call FieldBundle_FieldRegrid(is_local%wrap%FBIce_i,'ice_fraction', & - is_local%wrap%FBIce_a,'ice_fraction', & - is_local%wrap%RH_i2a_consf, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--- copy out the ifrac on atm grid - call FieldBundle_GetFldPtr(is_local%wrap%FBIce_a, 'ice_fraction', dataPtr2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - do j=lbound(dataPtr2,2),ubound(dataPtr2,2) - do i=lbound(dataPtr2,1),ubound(dataPtr2,1) - if(dataPtr2(i,j).eq.0._ESMF_KIND_R8.and.abs(dataPtr5(i,j)).gt.0._ESMF_KIND_R8) then - dataPtr2(i,j) = dataPtr5(i,j) - endif - enddo - enddo -!BL2017b - - allocate(ifrac_afr(lbound(dataptr2,1):ubound(dataptr2,1),lbound(dataptr2,2):ubound(dataptr2,2))) - allocate(ifrac_af (lbound(dataptr2,1):ubound(dataptr2,1),lbound(dataptr2,2):ubound(dataptr2,2))) - - do j=lbound(dataptr2,2),ubound(dataptr2,2) - do i=lbound(dataptr2,1),ubound(dataptr2,1) - !--- compute ice fraction on atm grid and reciprocal - ifrac_af(i,j) = dataPtr2(i,j) - if (dataPtr2(i,j) == 0._ESMF_KIND_R8) then - ifrac_afr(i,j) = 1.0_ESMF_KIND_R8 - else - ifrac_afr(i,j) = 1.0_ESMF_KIND_R8/dataPtr2(i,j) - endif - enddo - enddo - endif - - !--- conservative dst - if (ESMF_RouteHandleIsCreated(is_local%wrap%RH_i2a_consd, rc=rc)) then - call FieldBundle_FieldRegrid(is_local%wrap%FBIce_i,'ice_fraction', & - is_local%wrap%FBIce_a,'ice_fraction', & - is_local%wrap%RH_i2a_consd, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -!BL2017b - !--- copy out the ifrac on atm grid - call FieldBundle_GetFldPtr(is_local%wrap%FBIce_a, 'ice_fraction', dataPtr2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - allocate(ifrac_adr(lbound(dataptr2,1):ubound(dataptr2,1),lbound(dataptr2,2):ubound(dataptr2,2))) - allocate(ifrac_ad (lbound(dataptr2,1):ubound(dataptr2,1),lbound(dataptr2,2):ubound(dataptr2,2))) - -!BL2017b - do j=lbound(dataptr2,2),ubound(dataptr2,2) - do i=lbound(dataptr2,1),ubound(dataptr2,1) - if(dataPtr2(i,j).eq.0._ESMF_KIND_R8.and.abs(dataPtr5(i,j)).gt.0._ESMF_KIND_R8) then - dataPtr2(i,j) = dataPtr5(i,j) - endif - enddo - enddo -!BL2017b - - do j=lbound(dataptr2,2),ubound(dataptr2,2) - do i=lbound(dataptr2,1),ubound(dataptr2,1) - !--- compute ice fraction on atm grid and reciprocal - ifrac_ad(i,j) = dataPtr2(i,j) - if (dataPtr2(i,j) == 0._ESMF_KIND_R8) then - ifrac_adr(i,j) = 1.0_ESMF_KIND_R8 - else - ifrac_adr(i,j) = 1.0_ESMF_KIND_R8/dataPtr2(i,j) - endif - enddo - enddo - endif -!BL2017b - !--- the bilinear and patch interpolation methods are currently not used - !--- for any export variables from ice model - B Li - - !--- bilinear - if (ESMF_RouteHandleIsCreated(is_local%wrap%RH_i2a_bilnr, rc=rc)) then - call FieldBundle_FieldRegrid(is_local%wrap%FBIce_i,'ice_fraction', & - is_local%wrap%FBIce_a,'ice_fraction', & - is_local%wrap%RH_i2a_bilnr, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--- copy out the ifrac on ice grid and ifrac on atm grid - call FieldBundle_GetFldPtr(is_local%wrap%FBIce_a, 'ice_fraction', dataPtr2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - allocate(ifrac_abr(lbound(dataptr2,1):ubound(dataptr2,1),lbound(dataptr2,2):ubound(dataptr2,2))) - allocate(ifrac_ab (lbound(dataptr2,1):ubound(dataptr2,1),lbound(dataptr2,2):ubound(dataptr2,2))) - - do j=lbound(dataptr1,2),ubound(dataptr1,2) - do i=lbound(dataptr1,1),ubound(dataptr1,1) - ifrac_i(i,j) = dataPtr1(i,j) - enddo - enddo - - do j=lbound(dataptr2,2),ubound(dataptr2,2) - do i=lbound(dataptr2,1),ubound(dataptr2,1) - !--- compute ice fraction on atm grid and reciprocal - ifrac_ab(i,j) = dataPtr2(i,j) - if (dataPtr2(i,j) == 0._ESMF_KIND_R8) then - ifrac_abr(i,j) = 1.0_ESMF_KIND_R8 - else - ifrac_abr(i,j) = 1.0_ESMF_KIND_R8/dataPtr2(i,j) - endif - enddo - enddo - endif - - !--- patch - if (ESMF_RouteHandleIsCreated(is_local%wrap%RH_i2a_patch, rc=rc)) then - call FieldBundle_FieldRegrid(is_local%wrap%FBIce_i,'ice_fraction', & - is_local%wrap%FBIce_a,'ice_fraction', & - is_local%wrap%RH_i2a_patch, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--- copy out the ifrac on ice grid and ifrac on atm grid - call FieldBundle_GetFldPtr(is_local%wrap%FBIce_a, 'ice_fraction', dataPtr2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - allocate(ifrac_apr(lbound(dataptr2,1):ubound(dataptr2,1),lbound(dataptr2,2):ubound(dataptr2,2))) - allocate(ifrac_ap (lbound(dataptr2,1):ubound(dataptr2,1),lbound(dataptr2,2):ubound(dataptr2,2))) - - do j=lbound(dataptr1,2),ubound(dataptr1,2) - do i=lbound(dataptr1,1),ubound(dataptr1,1) - ifrac_i(i,j) = dataPtr1(i,j) - enddo - enddo - - do j=lbound(dataptr2,2),ubound(dataptr2,2) - do i=lbound(dataptr2,1),ubound(dataptr2,1) - !--- compute ice fraction on atm grid and reciprocal - ifrac_ap(i,j) = dataPtr2(i,j) - if (dataPtr2(i,j) == 0._ESMF_KIND_R8) then - ifrac_apr(i,j) = 1.0_ESMF_KIND_R8 - else - ifrac_apr(i,j) = 1.0_ESMF_KIND_R8/dataPtr2(i,j) - endif - enddo - enddo - endif - - !--- multiply FBIce_i by ifrac_i - - do n = 1,fldsFrIce%num - if (FieldBundle_FldChk(is_local%wrap%FBIce_i, fldsFrIce%shortname(n), rc=rc) .and. & - FieldBundle_FldChk(is_local%wrap%FBIce_if,fldsFrIce%shortname(n), rc=rc)) then - call FieldBundle_GetFldPtr(is_local%wrap%FBIce_i , fldsFrIce%shortname(n), dataPtr4, rc=rc) - call FieldBundle_GetFldPtr(is_local%wrap%FBIce_if, fldsFrIce%shortname(n), dataPtr3, rc=rc) - do j=lbound(dataptr3,2),ubound(dataptr3,2) - do i=lbound(dataptr3,1),ubound(dataptr3,1) - dataPtr3(i,j) = dataPtr4(i,j) * ifrac_i(i,j) - enddo - enddo - endif - enddo - - !--- regrid FBIce_if, fields with fraction multiplied - - call Fieldbundle_Regrid(fldsFrIce, is_local%wrap%FBIce_if, is_local%wrap%FBIce_a, & - consfmap=is_local%wrap%RH_i2a_consf, & - consdmap=is_local%wrap%RH_i2a_consd, & - bilnrmap=is_local%wrap%RH_i2a_bilnr, & - patchmap=is_local%wrap%RH_i2a_patch, & - string='i2a', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -!BL2017b - call Fieldbundle_Regrid2(fldsFrIce, is_local%wrap%FBIce_if, is_local%wrap%FBIce2_a, & - nearestmap=is_local%wrap%RH_i2a_nearest, & - string='i2a_nearest', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -!BL2017b - - !--- divide FBIce_a by ifrac_a, interpolated ice fraction - !--- actually multiply by reciprocal of ifrac_a, ifrac_ar - - do n = 1,fldsFrIce%num - if (FieldBundle_FldChk(is_local%wrap%FBIce_a, fldsFrIce%shortname(n), rc=rc)) then - call FieldBundle_GetFldPtr(is_local%wrap%FBIce_a, fldsFrIce%shortname(n), dataPtr3, rc=rc) -!BL2017b - call FieldBundle_GetFldPtr(is_local%wrap%FBIce2_a, fldsFrIce%shortname(n), dataPtr4, rc=rc) - do j=lbound(dataptr3,2),ubound(dataptr3,2) - do i=lbound(dataptr3,1),ubound(dataptr3,1) - if(dataPtr3(i,j).eq.0._ESMF_KIND_R8.and.abs(dataPtr4(i,j)).gt.0._ESMF_KIND_R8) then - dataPtr3(i,j) = dataPtr4(i,j) - endif - enddo - enddo -!BL2017b - if (fldsFrIce%mapping(n) == "conservefrac") then - do j=lbound(dataptr3,2),ubound(dataptr3,2) - do i=lbound(dataptr3,1),ubound(dataptr3,1) - dataPtr3(i,j) = dataPtr3(i,j) * ifrac_afr(i,j) - enddo - enddo - elseif (fldsFrIce%mapping(n) == "conservedst") then - do j=lbound(dataptr3,2),ubound(dataptr3,2) - do i=lbound(dataptr3,1),ubound(dataptr3,1) - dataPtr3(i,j) = dataPtr3(i,j) * ifrac_adr(i,j) - enddo - enddo - elseif (fldsFrIce%mapping(n) == 'bilinear') then - do j=lbound(dataptr3,2),ubound(dataptr3,2) - do i=lbound(dataptr3,1),ubound(dataptr3,1) - dataPtr3(i,j) = dataPtr3(i,j) * ifrac_abr(i,j) - enddo - enddo - elseif (fldsFrIce%mapping(n) == 'patch') then - do j=lbound(dataptr3,2),ubound(dataptr3,2) - do i=lbound(dataptr3,1),ubound(dataptr3,1) - dataPtr3(i,j) = dataPtr3(i,j) * ifrac_apr(i,j) - enddo - enddo - else - call ESMF_LogWrite(trim(subname)//": mapping name error "//trim(fldsFrIce%mapping(n)), ESMF_LOGMSG_INFO, rc=rc) - rc=ESMF_FAILURE - return - endif - endif - enddo - !--- make sure ifrac_a in the mapped bundle is correct - call FieldBundle_GetFldPtr(is_local%wrap%FBIce_a, 'ice_fraction', dataPtr3, rc=rc) - do j=lbound(dataptr3,2),ubound(dataptr3,2) - do i=lbound(dataptr3,1),ubound(dataptr3,1) - dataPtr3(i,j) = ifrac_af(i,j) - enddo - enddo - - deallocate(ifrac_i) - if (ESMF_RouteHandleIsCreated(is_local%wrap%RH_i2a_consf, rc=rc)) & - deallocate(ifrac_af, ifrac_afr) - if (ESMF_RouteHandleIsCreated(is_local%wrap%RH_i2a_consd, rc=rc)) & - deallocate(ifrac_ad, ifrac_adr) - if (ESMF_RouteHandleIsCreated(is_local%wrap%RH_i2a_bilnr, rc=rc)) & - deallocate(ifrac_ab, ifrac_abr) - if (ESMF_RouteHandleIsCreated(is_local%wrap%RH_i2a_patch, rc=rc)) & - deallocate(ifrac_ap, ifrac_apr) - - else - call Fieldbundle_Regrid(fldsFrIce, is_local%wrap%FBIce_i, is_local%wrap%FBIce_a, & - consfmap=is_local%wrap%RH_i2a_consf, & - consdmap=is_local%wrap%RH_i2a_consd, & - bilnrmap=is_local%wrap%RH_i2a_bilnr, & - patchmap=is_local%wrap%RH_i2a_patch, & - string='i2a', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call Fieldbundle_Regrid2(fldsFrIce, is_local%wrap%FBIce_i, is_local%wrap%FBIce2_a, & - nearestmap=is_local%wrap%RH_i2a_nearest, & - string='i2a_nearest', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - do n = 1,fldsFrIce%num - call FieldBundle_GetFldPtr(is_local%wrap%FBIce_a, fldsFrIce%shortname(n), dataPtr3, rc=rc) - call FieldBundle_GetFldPtr(is_local%wrap%FBIce2_a, fldsFrIce%shortname(n), dataPtr4, rc=rc) - do j=lbound(dataPtr3,2),ubound(dataPtr3,2) - do i=lbound(dataPtr3,1),ubound(dataPtr3,1) - if(dataPtr3(i,j).eq.0._ESMF_KIND_R8.and.abs(dataPtr4(i,j)).gt.0._ESMF_KIND_R8) then - dataPtr3(i,j) = dataPtr4(i,j) - endif - enddo - enddo - enddo - endif - endif -!BL2017b -! call ESMF_FieldBundleWrite(is_local%wrap%FBIce2_a, 'fields_med_ice2.nc', & -! singleFile=.true., overwrite=.true., timeslice=is_local%wrap%fastcntr, & -! iofmt=ESMF_IOFMT_NETCDF, rc=rc) -!BL2017b - - if (is_local%wrap%l2a_active) then - call Fieldbundle_Regrid(fldsFrLnd, is_local%wrap%FBLnd_l, is_local%wrap%FBLnd_a, & - consfmap=is_local%wrap%RH_l2a_consf, & - consdmap=is_local%wrap%RH_l2a_consd, & - bilnrmap=is_local%wrap%RH_l2a_bilnr, & - patchmap=is_local%wrap%RH_l2a_patch, & - string='l2a', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (is_local%wrap%h2a_active) then - call Fieldbundle_Regrid(fldsFrHyd, is_local%wrap%FBHyd_h, is_local%wrap%FBHyd_a, & - consfmap=is_local%wrap%RH_h2a_consf, & - consdmap=is_local%wrap%RH_h2a_consd, & - bilnrmap=is_local%wrap%RH_h2a_bilnr, & - patchmap=is_local%wrap%RH_h2a_patch, & - string='h2a', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (dbug_flag > 1) then - call FieldBundle_diagnose(is_local%wrap%FBOcn_a, trim(subname)//' FBOcn_a ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBIce_a, trim(subname)//' FBIce_a ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBLnd_a, trim(subname)//' FBLnd_a ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBHyd_a, trim(subname)//' FBHyd_a ', rc=rc) - !call FieldBundle_diagnose(is_local%wrap%FBAtmOcn_a, trim(subname)//' FBAtmOcn_a ', rc=rc) - endif - - call fieldBundle_copy(is_local%wrap%FBforAtm, is_local%wrap%FBOcn_a, rc=rc) - call fieldBundle_copy(is_local%wrap%FBforAtm, is_local%wrap%FBIce_a, rc=rc) - call fieldBundle_copy(is_local%wrap%FBforAtm, is_local%wrap%FBLnd_a, rc=rc) - call fieldBundle_copy(is_local%wrap%FBforAtm, is_local%wrap%FBHyd_a, rc=rc) - !call fieldBundle_copy(is_local%wrap%FBforAtm, is_local%wrap%FBAtmOcn_a, rc=rc) - - if (dbug_flag > 1) then - call FieldBundle_diagnose(is_local%wrap%FBforAtm, trim(subname)//' FBforAtm ', rc=rc) - endif - - if (statewrite_flag) then - ! write the fields imported from ocn to file -#ifndef FRONT_FV3 - call ESMF_FieldBundleWrite(is_local%wrap%FBOcn_a, 'fields_med_ocn_a.nc', & - singleFile=.true., overwrite=.true., timeslice=is_local%wrap%fastcntr, & - iofmt=ESMF_IOFMT_NETCDF, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_FieldBundleWrite(is_local%wrap%FBIce_a, 'fields_med_ice_a.nc', & - singleFile=.true., overwrite=.true., timeslice=is_local%wrap%fastcntr, & - iofmt=ESMF_IOFMT_NETCDF, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -#endif - endif - - !--- check for ice fraction out of range - - call FieldBundle_GetFldPtr(is_local%wrap%FBIce_a, 'ice_fraction', icewgt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! FLAG icewgt > 1.0 - write(msgString,'(A,3g17.10)')trim(subname)//trim(' FLAG icewgt>1.0'), & - minval(icewgt),maxval(icewgt-1.0_ESMF_KIND_R8),sum(icewgt) - if(maxval(icewgt) .gt. 1.0_ESMF_KIND_R8)call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - - !--- fill land mask every coupling from initial computation - - if (generate_landmask) then - call FieldBundle_GetFldPtr(is_local%wrap%FBforAtm, 'land_mask', dataPtr3, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - do j=lbound(dataPtr3,2),ubound(dataPtr3,2) - do i=lbound(dataPtr3,1),ubound(dataPtr3,1) -! dataPtr3(i,j) = land_mask(i,j) - dataPtr3(i,j) = 1.0_ESMF_KIND_R8 - enddo - enddo -!BL2017b - else - call ESMF_LogWrite(trim(subname)//": ERROR generate_landmask must be true ", ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - rc = ESMF_FAILURE - return - endif - - !--------------------------------------- - !--- set export State to special value for testing - !--------------------------------------- - - call state_reset(NState_AtmExp, value=spval, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 1) then - call State_diagnose(NState_AtmExp, trim(subname)//' AtmExp_99 ', rc=rc) - endif - - !--------------------------------------- - !--- copy into export state - !--------------------------------------- - - call fieldBundle_copy(NState_AtmExp, is_local%wrap%FBforAtm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (statewrite_flag) then - ! write the fields exported to atm to file - write(msgString,'(A,i10)')trim(subname)//trim(': write field_med_to_atm '), is_local%wrap%fastcntr - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) -#ifdef FV3_CPLD - write(fname,'(a,i6.6)') 'field_med_to_atm_',is_local%wrap%fastcntr - call FieldBundle_RWFields_tiles('write',trim(fname),is_local%wrap%FBforAtm,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -#else -! TODO: check method for DATM - call NUOPC_Write(NState_AtmExp, & - fldsToAtm%shortname(1:fldsToAtm%num), & - "field_med_to_atm_", timeslice=is_local%wrap%fastcntr, & - relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -! write(fname,'(a,i6.6)') 'field_med_to_atm_',is_local%wrap%fastcntr -! call FieldBundle_RWFields('write',trim(fname),is_local%wrap%FBforAtm,rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out -#endif - endif - - if (dbug_flag > 1) then - call state_diagnose(NState_AtmExp, trim(subname)//' AtmExp_final ', rc=rc) - endif - - !--------------------------------------- - !--- clean up - !--------------------------------------- - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - if(profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) - - contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - subroutine ESMFPP_RegridWriteFB(FieldBundle, fileName, timeslice, rc) - type(ESMF_FieldBundle), intent(in) :: fieldBundle - character(len=*), intent(in) :: fileName - integer, intent(in) :: timeslice - integer, intent(out) :: rc - - ! local - type(ESMF_Field) :: field - type(ESMF_Grid) :: outGrid - integer :: icount - character(64), allocatable :: itemNameList(:) - !PT unused! type(ESMF_StateItem_Flag), allocatable :: typeList(:) - - rc = ESMF_SUCCESS - - outGrid = ESMF_GridCreate1PeriDimUfrm( & - maxIndex=(/180,360/), & - minCornerCoord=(/0.0_ESMF_KIND_R8,-90.0_ESMF_KIND_R8/), & - maxCornerCoord=(/360.0_ESMF_KIND_R8,90.0_ESMF_KIND_R8/), & - staggerLocList=(/ESMF_STAGGERLOC_CORNER, ESMF_STAGGERLOC_CENTER/), & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldBundleGet(fieldBundle, fieldCount=icount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - allocate(itemNameList(icount)) - - call ESMF_FieldBundleGet(fieldBundle, fieldNameList=itemNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - do i = 1, icount - call ESMF_LogWrite("RegridWrite Field Name Initiated: "//trim(itemNameList(i)), ESMF_LOGMSG_INFO) - call ESMF_FieldBundleGet(fieldBundle, fieldName=itemNameList(i), field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMFPP_RegridWrite(field, outGrid, ESMF_REGRIDMETHOD_BILINEAR, & - fileName//trim(itemNameList(i))//'.nc', timeslice, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_LogWrite("RegridWrite Field Name done: "//trim(itemNameList(i)), ESMF_LOGMSG_INFO) - enddo - - ! deallocate(typeList, itemNameList) - deallocate(itemNameList) - - end subroutine ESMFPP_RegridWriteFB - - subroutine ESMFPP_RegridWrite(inField, outGrid, regridMethod, fileName, timeslice, rc) - - ! input arguments - type(ESMF_Field), intent(in) :: inField - type(ESMF_Grid), intent(in) :: outGrid - type(ESMF_RegridMethod_Flag), intent(in) :: regridMethod - character(len=*), intent(in) :: filename - integer, intent(in) :: timeslice - integer, intent(inout) :: rc - - ! local arguments - type(ESMF_Routehandle) :: rh - type(ESMF_Field) :: outField - - outField = ESMF_FieldCreate(outGrid, typekind=ESMF_TYPEKIND_R8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! For other options for the regrid operation, please refer to: - ! http://www.earthsystemmodeling.org/esmf_releases/last_built/ESMF_refdoc/node5.html#SECTION050366000000000000000 - call ESMF_FieldRegridStore(inField, outField, regridMethod=regridMethod, & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & - srcTermProcessing=srcTermProcessing_Value, & - Routehandle=rh, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldRegrid(inField, outField, Routehandle=rh, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldWrite(outField, fileName, overwrite=.true., timeslice=timeslice, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - rc = ESMF_SUCCESS - - end subroutine ESMFPP_RegridWrite - end subroutine MedPhase_prep_atm - - !----------------------------------------------------------------------------- - - subroutine TimestampExport_prep_atm(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! This attaches an invalid timestamp on fields sometimes. - ! Otherwise, it just sets the timestamp to the current clock. - - ! local variables - integer :: n, fieldcount - type(ESMF_Clock) :: driverClock - type(ESMF_Clock) :: clock - type(ESMF_time) :: currtime - type(InternalState) :: is_local - type(ESMF_Field), pointer :: fieldList(:) - character(ESMF_MAXSTR),allocatable :: fieldNameList(:) - character(len=*),parameter :: subname='(module_MEDIATOR:TimestampExport_prep_atm)' - - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - ! query the Component for info - call NUOPC_MediatorGet(gcomp, driverClock=driverClock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! set the Clock to have the current time as the driverClock - call ESMF_ClockGet(driverClock, currTime=currTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_ClockSet(Clock, currTime=currTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! Get the internal state from Component. - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--------------------------- - ! validate all data by default - !--------------------------- - -#if ESMF_VERSION_MAJOR >= 8 - call NUOPC_SetTimestamp(NState_AtmExp, clock, rc=rc) -#else - call NUOPC_UpdateTimestamp(NState_AtmExp, clock, rc=rc) -#endif - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--------------------------- - ! COLDSTART: - ! invalidate all data on timestep 1 - ! invalidate SST on all timesteps - !--------------------------- - - if (coldstart) then - if (is_local%wrap%fastcntr == 1) then -#if ESMF_VERSION_MAJOR >= 8 - call NUOPC_SetTimestamp(NState_AtmExp, clock_invalidTimeStamp, rc=rc) -#else - call NUOPC_UpdateTimestamp(NState_AtmExp, clock_invalidTimeStamp, rc=rc) -#endif - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - else - call ESMF_StateGet(NState_AtmExp, itemCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(NState_AtmExp, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - nullify(fieldList) - call NUOPC_GetStateMemberLists(NState_AtmExp, fieldList=fieldList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - do n = 1, fieldCount - if (trim(fieldNameList(n))=="sea_surface_temperature") then -#if ESMF_VERSION_MAJOR >= 8 - call NUOPC_SetTimestamp(fieldList(n), time_invalidTimeStamp, rc=rc) -#else - call NUOPCplus_UpdateTimestamp(fieldList(n), time_invalidTimeStamp, rc=rc) -#endif - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - enddo - if (associated(fieldList)) deallocate(fieldList) - deallocate(fieldNameList) - endif - endif - - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine TimestampExport_prep_atm - - !----------------------------------------------------------------------------- - - subroutine MedPhase_prep_ice(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! This Mediator phase runs before ATM and ICE are being called and - ! prepares the ATM and ICE import Fields. - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Time) :: time - character(len=64) :: timestr - type(ESMF_State) :: importState, exportState - type(ESMF_Field) :: field - type(InternalState) :: is_local - real(ESMF_KIND_R8), pointer :: dataPtr1(:,:),dataPtr2(:,:),dataPtr3(:,:) - real(ESMF_KIND_R8), pointer :: temperature(:,:), humidity(:,:), pressure(:,:) - real(ESMF_KIND_R8), pointer :: air_density(:,:) - character(ESMF_MAXSTR) ,pointer :: fieldNameList(:) - integer :: fieldCount - integer :: i,j,n - character(len=*),parameter :: subname='(module_MEDIATOR:MedPhase_prep_ice)' -!BL2018 -! real(ESMF_KIND_R8), pointer :: temp293(:,:) -! type(ESMF_Grid) :: outGrid -! type(ESMF_Field) :: outField -! type(ESMF_Field) :: inField -! type(ESMF_Routehandle) :: rh180 -!BL2018 - - if(profile_memory) call ESMF_VMLogMemInfo("Entering "//trim(subname)) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - ! query the Component for its clock, importState and exportState - call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & - exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! Get the internal state from Component. - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_ClockGet(clock,currtime=time,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_TimeGet(time,timestring=timestr) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": time = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - if (dbug_flag > 1) then - call ESMF_ClockPrint(clock, options="currTime", & - preString="-------->"//trim(subname)//" mediating for: ", & - unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - !--------------------------------------- - !--- this is fast, no accumulator needed - !--------------------------------------- - - if (dbug_flag > 1) then - call fieldBundle_reset(is_local%wrap%FBAtm_a, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBOcn_o, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBIce_i, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBLnd_l, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBHyd_h, value=czero, rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBAtm_a, trim(subname)//' FBAtm_a zero', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBOcn_o, trim(subname)//' FBOcn_o zero', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBIce_i, trim(subname)//' FBIce_i zero', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBLnd_l, trim(subname)//' FBLnd_l zero', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBHyd_h, trim(subname)//' FBhyd_h zero', rc=rc) - call State_diagnose(NState_AtmImp, trim(subname)//' AtmImp ', rc=rc) - call State_diagnose(NState_OcnImp, trim(subname)//' OcnImp ', rc=rc) - call State_diagnose(NState_IceImp, trim(subname)//' IceImp ', rc=rc) - call State_diagnose(NState_LndImp, trim(subname)//' LndImp ', rc=rc) - call State_diagnose(NState_HydImp, trim(subname)//' HydImp ', rc=rc) - endif - - call fieldBundle_copy(is_local%wrap%FBAtm_a, NState_AtmImp, rc=rc) - call fieldBundle_copy(is_local%wrap%FBOcn_o, NState_OcnImp, rc=rc) - call fieldBundle_copy(is_local%wrap%FBIce_i, NState_IceImp, rc=rc) - call fieldBundle_copy(is_local%wrap%FBLnd_l, NState_LndImp, rc=rc) - call fieldBundle_copy(is_local%wrap%FBHyd_h, NState_HydImp, rc=rc) - - if (dbug_flag > 1) then - call FieldBundle_diagnose(is_local%wrap%FBAtm_a, trim(subname)//' FBAtm_a ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBOcn_o, trim(subname)//' FBOcn_o ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBIce_i, trim(subname)//' FBIce_i ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBLnd_l, trim(subname)//' FBLnd_l ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBHyd_h, trim(subname)//' FBHyd_h ', rc=rc) - endif - -!BL2018 -! call FieldBundle_GetFldPtr(is_local%wrap%FBAtm_a, 'inst_temp_height_lowest', temp293, rc=rc) -! do j = lbound(temp293,2),ubound(temp293,2) -! do i = lbound(temp293,1),ubound(temp293,1) -! temp293(i,j) = 293.0_ESMF_KIND_R8 -! enddo -! enddo - ! Regrid to lat-lon 180*360 -! call ESMF_FieldBundleGet(is_local%wrap%FBAtm_a,& -! fieldName='inst_temp_height_lowest', & -! field=inField,rc=rc) - -! outGrid = ESMF_GridCreate1PeriDimUfrm( & -! maxIndex=(/180,360/), & -! minCornerCoord=(/0.0_ESMF_KIND_R8,-90.0_ESMF_KIND_R8/), & -! maxCornerCoord=(/360.0_ESMF_KIND_R8,90.0_ESMF_KIND_R8/), & -! staggerLocList=(/ESMF_STAGGERLOC_CORNER, ESMF_STAGGERLOC_CENTER/), & -! rc=rc) - -! outField = ESMF_FieldCreate(outGrid, typekind=ESMF_TYPEKIND_R8, rc=rc) -! call ESMF_FieldRegridStore(inField, outField,& -! regridMethod=ESMF_REGRIDMETHOD_BILINEAR,& -! unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & -! Routehandle=rh180, & -! rc=rc) -! call ESMF_FieldRegrid(inField, outField, Routehandle=rh180, rc=rc) -! call ESMF_FieldWrite(outField,'field_fv3_to_latlon.nc',overwrite=.true.,rc=rc) -!BL2018 - - ! Regrid Full Field Bundles conservatively - - call fieldBundle_reset(is_local%wrap%FBAtm_i, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBOcn_i, value=czero, rc=rc) -!BL2017 - call fieldBundle_reset(is_local%wrap%FBAtm2_i, value=czero, rc=rc) -!BL2017 - - if (is_local%wrap%a2i_active) then - call Fieldbundle_Regrid(fldsFrAtm, is_local%wrap%FBAtm_a, is_local%wrap%FBAtm_i, & - consfmap=is_local%wrap%RH_a2i_consf, & - consdmap=is_local%wrap%RH_a2i_consd, & - bilnrmap=is_local%wrap%RH_a2i_bilnr, & - patchmap=is_local%wrap%RH_a2i_patch, & - string='a2i', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - -!BL2017 use nearest neighbor method - call Fieldbundle_Regrid2(fldsFrAtm, is_local%wrap%FBAtm_a, is_local%wrap%FBAtm2_i, & - nearestmap=is_local%wrap%RH_a2i_nearest, & - string='a2i_nearest', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_FieldBundleGet(is_local%wrap%FBAtm_i, fieldCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate(fieldNameList(fieldCount)) - call ESMF_FieldBundleGet(is_local%wrap%FBAtm_i, fieldNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - do n = 1, fieldCount - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm_i, fieldNameList(n),dataPtr1,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm2_i, fieldNameList(n), dataPtr2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - do j=lbound(dataPtr1,2),ubound(dataPtr1,2) - do i=lbound(dataPtr1,1),ubound(dataPtr1,1) - if(dataPtr1(i,j).eq.0._ESMF_KIND_R8.and.abs(dataPtr2(i,j)).gt.0._ESMF_KIND_R8) then - dataPtr1(i,j)=dataPtr2(i,j) - endif - enddo - enddo - enddo - deallocate(fieldNameList) -!BL2017 - endif - - if (is_local%wrap%o2i_active) then - call Fieldbundle_Regrid(fldsFrOcn, is_local%wrap%FBOcn_o, is_local%wrap%FBOcn_i, & - consfmap=is_local%wrap%RH_o2i_consf, & - consdmap=is_local%wrap%RH_o2i_consd, & - bilnrmap=is_local%wrap%RH_o2i_bilnr, & - patchmap=is_local%wrap%RH_o2i_patch, & - fcopymap=is_local%wrap%RH_o2i_fcopy, & - string='o2i', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (dbug_flag > 1) then - call FieldBundle_diagnose(is_local%wrap%FBAtm_i, trim(subname)//' FBAtm_i ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBOcn_i, trim(subname)//' FBOcn_i ', rc=rc) - endif - - call fieldBundle_copy(is_local%wrap%FBforIce, is_local%wrap%FBAtm_i, rc=rc) - call fieldBundle_copy(is_local%wrap%FBforIce, is_local%wrap%FBOcn_i, rc=rc) - - if (dbug_flag > 1) then - call FieldBundle_diagnose(is_local%wrap%FBforIce, trim(subname)//' FBforIce ', rc=rc) - endif - - !--------------------------------------- - !--- merges to ice - !--------------------------------------- - - !--- calculate air density for cice - - call FieldBundle_GetFldPtr(is_local%wrap%FBforIce, 'inst_temp_height_lowest', temperature, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBforIce, 'inst_pres_height_lowest', pressure, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBforIce, 'inst_spec_humid_height_lowest', humidity, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call FieldBundle_GetFldPtr(is_local%wrap%FBforIce, 'air_density_height_lowest', air_density, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - do j = lbound(temperature,2),ubound(temperature,2) - do i = lbound(temperature,1),ubound(temperature,1) - if (temperature(i,j) /= 0._ESMF_KIND_R8) then - air_density(i,j) = pressure(i,j)/& - (287.058_ESMF_KIND_R8*(1._ESMF_KIND_R8+0.608_ESMF_KIND_R8*humidity(i,j))*temperature(i,j)) - else - air_density(i,j) = 0._ESMF_KIND_R8 - endif - enddo - enddo - - !--------------------------------------- - !--- set export State to special value for testing - !--------------------------------------- - - call state_reset(NState_IceExp, value=spval, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 1) then - call State_diagnose(NState_IceExp, trim(subname)//' IceExp_99 ', rc=rc) - endif - - !--------------------------------------- - !--- copy into export state - !--------------------------------------- - - call fieldBundle_copy(NState_IceExp, is_local%wrap%FBforIce, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 1) then - call state_diagnose(NState_IceExp, trim(subname)//' IceExp_final ', rc=rc) - endif - - if (statewrite_flag) then - write(msgString,'(A,i10)')trim(subname)//trim(': write field_med_to_ice '), is_local%wrap%fastcntr - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - - ! write the fields exported to ice to file - call NUOPC_Write(NState_IceExp, & - fldsToIce%shortname(1:fldsToIce%num), & - "field_med_to_ice_", timeslice=is_local%wrap%fastcntr, & - relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - !--------------------------------------- - !--- clean up - !--------------------------------------- - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - if(profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) - - end subroutine MedPhase_prep_ice - - !----------------------------------------------------------------------------- - - subroutine MedPhase_prep_lnd(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! This Mediator phase preps land exports - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Time) :: time - character(len=64) :: timestr - type(ESMF_State) :: importState, exportState - type(ESMF_Field) :: field - type(InternalState) :: is_local - character(len=*),parameter :: subname='(module_MEDIATOR:MedPhase_prep_lnd)' - - if(profile_memory) call ESMF_VMLogMemInfo("Entering "//trim(subname)) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - ! query the Component for its clock, importState and exportState - call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & - exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! Get the internal state from Component. - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_ClockGet(clock,currtime=time,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_TimeGet(time,timestring=timestr) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": time = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - if (dbug_flag > 1) then - call ESMF_ClockPrint(clock, options="currTime", & - preString="-------->"//trim(subname)//" mediating for: ", & - unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - !--------------------------------------- - !--- this is fast, no accumulator needed - !--------------------------------------- - - if (dbug_flag > 1) then - call fieldBundle_reset(is_local%wrap%FBAtm_a, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBOcn_o, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBIce_i, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBLnd_l, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBHyd_h, value=czero, rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBAtm_a, trim(subname)//' FBAtm_a zero', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBOcn_o, trim(subname)//' FBOcn_o zero', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBIce_i, trim(subname)//' FBIce_i zero', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBLnd_l, trim(subname)//' FBLnd_l zero', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBHyd_h, trim(subname)//' FBhyd_h zero', rc=rc) - call State_diagnose(NState_AtmImp, trim(subname)//' AtmImp ', rc=rc) - call State_diagnose(NState_OcnImp, trim(subname)//' OcnImp ', rc=rc) - call State_diagnose(NState_IceImp, trim(subname)//' IceImp ', rc=rc) - call State_diagnose(NState_LndImp, trim(subname)//' LndImp ', rc=rc) - call State_diagnose(NState_HydImp, trim(subname)//' HydImp ', rc=rc) - endif - - call fieldBundle_copy(is_local%wrap%FBAtm_a, NState_AtmImp, rc=rc) - call fieldBundle_copy(is_local%wrap%FBOcn_o, NState_OcnImp, rc=rc) - call fieldBundle_copy(is_local%wrap%FBIce_i, NState_IceImp, rc=rc) - call fieldBundle_copy(is_local%wrap%FBLnd_l, NState_LndImp, rc=rc) - call fieldBundle_copy(is_local%wrap%FBHyd_h, NState_HydImp, rc=rc) - - if (dbug_flag > 1) then - call FieldBundle_diagnose(is_local%wrap%FBAtm_a, trim(subname)//' FBAtm_a ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBOcn_o, trim(subname)//' FBOcn_o ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBIce_i, trim(subname)//' FBIce_i ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBLnd_l, trim(subname)//' FBLnd_l ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBHyd_h, trim(subname)//' FBHyd_h ', rc=rc) - endif - - ! Regrid Full Field Bundles conservatively - - call fieldBundle_reset(is_local%wrap%FBAtm_l, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBHyd_l, value=czero, rc=rc) - - if (is_local%wrap%a2l_active) then - call Fieldbundle_Regrid(fldsFrAtm, is_local%wrap%FBAtm_a, is_local%wrap%FBAtm_l, & - consfmap=is_local%wrap%RH_a2l_consf, & - consdmap=is_local%wrap%RH_a2l_consd, & - bilnrmap=is_local%wrap%RH_a2l_bilnr, & - patchmap=is_local%wrap%RH_a2l_patch, & - string='a2l', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (is_local%wrap%h2l_active) then - call Fieldbundle_Regrid(fldsFrHyd, is_local%wrap%FBHyd_h, is_local%wrap%FBHyd_l, & - consfmap=is_local%wrap%RH_h2l_consf, & - consdmap=is_local%wrap%RH_h2l_consd, & - bilnrmap=is_local%wrap%RH_h2l_bilnr, & - patchmap=is_local%wrap%RH_h2l_patch, & - string='h2l', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (dbug_flag > 1) then - call FieldBundle_diagnose(is_local%wrap%FBAtm_l, trim(subname)//' FBAtm_l ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBHyd_l, trim(subname)//' FBHyd_l ', rc=rc) - endif - - call fieldBundle_copy(is_local%wrap%FBforLnd, is_local%wrap%FBAtm_l, rc=rc) - call fieldBundle_copy(is_local%wrap%FBforLnd, is_local%wrap%FBHyd_l, rc=rc) - - if (dbug_flag > 1) then - call FieldBundle_diagnose(is_local%wrap%FBforLnd, trim(subname)//' FBforLnd ', rc=rc) - endif - - !--------------------------------------- - !--- custom calculations to lnd - !--------------------------------------- - - ! None yet - - !--------------------------------------- - !--- set export State to special value for testing - !--------------------------------------- - - call state_reset(NState_LndExp, value=spval, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 1) then - call State_diagnose(NState_LndExp, trim(subname)//' LndExp_99 ', rc=rc) - endif - - !--------------------------------------- - !--- copy into export state - !--------------------------------------- - - call fieldBundle_copy(NState_LndExp, is_local%wrap%FBforLnd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 1) then - call state_diagnose(NState_LndExp, trim(subname)//' LndExp_final ', rc=rc) - endif - - if (statewrite_flag) then - ! write the fields exported to lnd to file - call NUOPC_Write(NState_LndExp, & - fieldNameList=fldsToLnd%shortname(1:fldsToLnd%num), & - fileNamePrefix="field_med_to_lnd_", timeslice=is_local%wrap%fastcntr, & - relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - !--------------------------------------- - !--- clean up - !--------------------------------------- - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - if(profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) - - end subroutine MedPhase_prep_lnd - - !----------------------------------------------------------------------------- - - subroutine MedPhase_prep_hyd(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! This Mediator phase prepares data for they hyd component - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Time) :: time - character(len=64) :: timestr - type(ESMF_State) :: importState, exportState - type(ESMF_Field) :: field - type(InternalState) :: is_local - character(len=*),parameter :: subname='(module_MEDIATOR:MedPhase_prep_hyd)' - - if(profile_memory) call ESMF_VMLogMemInfo("Entering "//trim(subname)) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - ! query the Component for its clock, importState and exportState - call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & - exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! Get the internal state from Component. - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_ClockGet(clock,currtime=time,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_TimeGet(time,timestring=timestr) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": time = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - if (dbug_flag > 1) then - call ESMF_ClockPrint(clock, options="currTime", & - preString="-------->"//trim(subname)//" mediating for: ", & - unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - !--------------------------------------- - !--- this is fast, no accumulator needed - !--------------------------------------- - - if (dbug_flag > 1) then - call fieldBundle_reset(is_local%wrap%FBAtm_a, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBOcn_o, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBIce_i, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBLnd_l, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBHyd_h, value=czero, rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBAtm_a, trim(subname)//' FBAtm_a zero', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBOcn_o, trim(subname)//' FBOcn_o zero', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBIce_i, trim(subname)//' FBIce_i zero', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBLnd_l, trim(subname)//' FBLnd_l zero', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBHyd_h, trim(subname)//' FBhyd_h zero', rc=rc) - call State_diagnose(NState_AtmImp, trim(subname)//' AtmImp ', rc=rc) - call State_diagnose(NState_OcnImp, trim(subname)//' OcnImp ', rc=rc) - call State_diagnose(NState_IceImp, trim(subname)//' IceImp ', rc=rc) - call State_diagnose(NState_LndImp, trim(subname)//' LndImp ', rc=rc) - call State_diagnose(NState_HydImp, trim(subname)//' HydImp ', rc=rc) - endif - - call fieldBundle_copy(is_local%wrap%FBAtm_a, NState_AtmImp, rc=rc) - call fieldBundle_copy(is_local%wrap%FBOcn_o, NState_OcnImp, rc=rc) - call fieldBundle_copy(is_local%wrap%FBIce_i, NState_IceImp, rc=rc) - call fieldBundle_copy(is_local%wrap%FBLnd_l, NState_LndImp, rc=rc) - call fieldBundle_copy(is_local%wrap%FBHyd_h, NState_HydImp, rc=rc) - - if (dbug_flag > 1) then - call FieldBundle_diagnose(is_local%wrap%FBAtm_a, trim(subname)//' FBAtm_a ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBOcn_o, trim(subname)//' FBOcn_o ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBIce_i, trim(subname)//' FBIce_i ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBLnd_l, trim(subname)//' FBLnd_l ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBHyd_h, trim(subname)//' FBHyd_h ', rc=rc) - endif - - ! Regrid Full Field Bundles conservatively - - call fieldBundle_reset(is_local%wrap%FBAtm_h, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBLnd_h, value=czero, rc=rc) - - if (is_local%wrap%a2h_active) then - call Fieldbundle_Regrid(fldsFrAtm, is_local%wrap%FBAtm_a, is_local%wrap%FBAtm_h, & - consfmap=is_local%wrap%RH_a2h_consf, & - consdmap=is_local%wrap%RH_a2h_consd, & - bilnrmap=is_local%wrap%RH_a2h_bilnr, & - patchmap=is_local%wrap%RH_a2h_patch, & - string='a2h', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (is_local%wrap%l2h_active) then - call Fieldbundle_Regrid(fldsFrLnd, is_local%wrap%FBLnd_l, is_local%wrap%FBLnd_h, & - consfmap=is_local%wrap%RH_l2h_consf, & - consdmap=is_local%wrap%RH_l2h_consd, & - bilnrmap=is_local%wrap%RH_l2h_bilnr, & - patchmap=is_local%wrap%RH_l2h_patch, & - string='l2h', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (dbug_flag > 1) then - call FieldBundle_diagnose(is_local%wrap%FBAtm_h, trim(subname)//' FBAtm_h ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBLnd_h, trim(subname)//' FBLnd_h ', rc=rc) - endif - - call fieldBundle_copy(is_local%wrap%FBforHyd, is_local%wrap%FBLnd_h, rc=rc) - call fieldBundle_copy(is_local%wrap%FBforHyd, is_local%wrap%FBAtm_h, rc=rc) - - if (dbug_flag > 1) then - call FieldBundle_diagnose(is_local%wrap%FBforHyd, trim(subname)//' FBforHyd ', rc=rc) - endif - - !--------------------------------------- - !--- custom calculations to hyd - !--------------------------------------- - - ! None yet - - !--------------------------------------- - !--- set export State to special value for testing - !--------------------------------------- - - call state_reset(NState_HydExp, value=spval, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 1) then - call State_diagnose(NState_HydExp, trim(subname)//' HydExp_99 ', rc=rc) - endif - - !--------------------------------------- - !--- copy into export state - !--------------------------------------- - - call fieldBundle_copy(NState_HydExp, is_local%wrap%FBforHyd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 1) then - call state_diagnose(NState_HydExp, trim(subname)//' HydExp_final ', rc=rc) - endif - - if (statewrite_flag) then - ! write the fields exported to hyd to file - call NUOPC_Write(NState_HydExp, & - fieldNameList=fldsToHyd%shortname(1:fldsToHyd%num), & - fileNamePrefix="field_med_to_hyd_", timeslice=is_local%wrap%fastcntr, & - relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - !--------------------------------------- - !--- clean up - !--------------------------------------- - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - if(profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) - - end subroutine MedPhase_prep_hyd - - !----------------------------------------------------------------------------- - - subroutine MedPhase_fast_after(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Time) :: time - character(len=64) :: timestr - type(ESMF_State) :: importState, exportState - type(InternalState) :: is_local - integer :: i,j,n - real(ESMF_KIND_R8), pointer :: zbot(:,:),ubot(:,:),vbot(:,:),thbot(:,:), & - qbot(:,:),rbot(:,:),tbot(:,:), pbot(:,:) - real(ESMF_KIND_R8), pointer :: us (:,:),vs (:,:),ts (:,:),mask(:,:) - real(ESMF_KIND_R8), pointer :: sen (:,:),lat (:,:),lwup(:,:),evap(:,:), & - taux(:,:),tauy(:,:),tref(:,:),qref(:,:),duu10n(:,:) - real(ESMF_KIND_R8) :: zbot1(1),ubot1(1),vbot1(1),thbot1(1), & - qbot1(1),rbot1(1),tbot1(1) - integer :: mask1(1) - real(ESMF_KIND_R8) :: us1 (1),vs1 (1),ts1 (1) - real(ESMF_KIND_R8) :: sen1 (1),lat1 (1),lwup1(1),evap1(1), & - taux1(1),tauy1(1),tref1(1),qref1(1),duu10n1(1) - character(len=*),parameter :: subname='(module_MEDIATOR:MedPhase_fast_after)' - - if(profile_memory) call ESMF_VMLogMemInfo("Entering "//trim(subname)) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - call MedPhase_atm_ocn_flux(gcomp,rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call MedPhase_accum_fast(gcomp,rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - if(profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) - - end subroutine MedPhase_fast_after - - !----------------------------------------------------------------------------- - - subroutine MedPhase_accum_fast(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Time) :: time - character(len=64) :: timestr - type(ESMF_State) :: importState, exportState - type(InternalState) :: is_local - integer :: i,j,n - character(len=128) :: fname - character(len=*),parameter :: subname='(module_MEDIATOR:MedPhase_accum_fast)' - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - ! query the Component for its clock, importState and exportState - call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & - exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! Get the internal state from Component. - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_ClockGet(clock,currtime=time,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_TimeGet(time,timestring=timestr) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": time = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - if (dbug_flag > 1) then - call ESMF_ClockPrint(clock, options="currTime", & - preString="-------->"//trim(subname)//" mediating for: ", & - unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (statewrite_flag) then - ! write the fields imported from atm to file - write(msgString,'(A,i10)')trim(subname)//trim(': write field_med_from_atm '), is_local%wrap%fastcntr - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) -#ifdef FV3_CPLD - write(fname,'(a,i6.6)') 'field_med_from_atm_',is_local%wrap%fastcntr - call FieldBundle_RWFields_tiles('write',trim(fname),is_local%wrap%FBAtm_a,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -#else -! TODO: check method for DATM - call NUOPC_Write(NState_AtmImp, & - fldsFrAtm%shortname(1:fldsFrAtm%num), & - "field_med_from_atm_", timeslice=is_local%wrap%fastcntr, & - relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -! write(fname,'(a,i6.6)') 'field_med_from_atm_',is_local%wrap%fastcntr -! call FieldBundle_RWFields('write',trim(fname),is_local%wrap%FBAtm_a,rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out -#endif - ! write the fields imported from ice to file - write(msgString,'(A,i10)')trim(subname)//trim(': write field_med_from_ice '), is_local%wrap%fastcntr - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - call NUOPC_Write(NState_IceImp, & - fldsFrIce%shortname(1:fldsFrIce%num), & - "field_med_from_ice_", timeslice=is_local%wrap%fastcntr, & - relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! write the fields imported from lnd to file - call NUOPC_Write(NState_LndImp, & - fieldNameList=fldsFrLnd%shortname(1:fldsFrLnd%num), & - fileNamePrefix="field_med_from_lnd_", timeslice=is_local%wrap%fastcntr, & - relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! write the fields imported from hyd to file - call NUOPC_Write(NState_HydImp, & - fieldNameList=fldsFrHyd%shortname(1:fldsFrHyd%num), & - fileNamePrefix="field_med_from_hyd_", timeslice=is_local%wrap%fastcntr, & - relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - !--------------------------------------- - !--- atm, ice, lnd, hyd accumulator for ocean - !--------------------------------------- - - if (dbug_flag > 1) then - call State_diagnose(NState_AtmImp, trim(subname)//' AtmImp ', rc=rc) - call State_diagnose(NState_IceImp, trim(subname)//' IceImp ', rc=rc) - call State_diagnose(NState_LndImp, trim(subname)//' LndImp ', rc=rc) - call State_diagnose(NState_HydImp, trim(subname)//' HydImp ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBaccumAtm, trim(subname)//' FBaccAtm_B4accum ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBaccumIce, trim(subname)//' FBaccIce_B4accum ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBaccumLnd, trim(subname)//' FBaccLnd_B4accum ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBaccumHyd, trim(subname)//' FBaccHyd_B4accum ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBaccumAtmOcn, trim(subname)//' FBaccAtmOcn_B4accum ', rc=rc) - endif - - call fieldBundle_accum(is_local%wrap%FBaccumAtm, NState_AtmImp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - is_local%wrap%accumcntAtm = is_local%wrap%accumcntAtm + 1 - - call fieldBundle_accum(is_local%wrap%FBaccumIce, NState_IceImp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - is_local%wrap%accumcntIce = is_local%wrap%accumcntIce + 1 - - call fieldBundle_accum(is_local%wrap%FBaccumLnd, NState_LndImp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - is_local%wrap%accumcntLnd = is_local%wrap%accumcntLnd + 1 - - call fieldBundle_accum(is_local%wrap%FBaccumHyd, NState_HydImp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - is_local%wrap%accumcntHyd = is_local%wrap%accumcntHyd + 1 - - call fieldBundle_accum(is_local%wrap%FBaccumAtmOcn, is_local%wrap%FBAtmOcn_o, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - is_local%wrap%accumcntAtmOcn = is_local%wrap%accumcntAtmOcn + 1 - - if (dbug_flag > 1) then - call FieldBundle_diagnose(is_local%wrap%FBaccumAtm, trim(subname)//' FBaccAtm_AFaccum ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBaccumIce, trim(subname)//' FBaccIce_AFaccum ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBaccumLnd, trim(subname)//' FBaccLnd_AFaccum ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBaccumHyd, trim(subname)//' FBaccHyd_AFaccum ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBaccumAtmOcn, trim(subname)//' FBaccAtmOcn_AFaccum ', rc=rc) - endif - - !--------------------------------------- - !--- clean up - !--------------------------------------- - - !--------------------------------------- - - is_local%wrap%fastcntr = is_local%wrap%fastcntr + 1 - - !--------------------------------------- - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine MedPhase_accum_fast - - !----------------------------------------------------------------------------- - - subroutine MedPhase_atm_ocn_flux(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Time) :: time - character(len=64) :: timestr - type(ESMF_State) :: importState, exportState - type(InternalState) :: is_local - integer :: i,j,n - character(ESMF_MAXSTR) ,pointer :: fieldNameList(:) - real(ESMF_KIND_R8), pointer :: zbot(:,:),ubot(:,:),vbot(:,:),thbot(:,:), & - qbot(:,:),rbot(:,:),tbot(:,:), pbot(:,:) - real(ESMF_KIND_R8), pointer :: us (:,:),vs (:,:),ts (:,:),mask(:,:) - real(ESMF_KIND_R8), pointer :: sen (:,:),lat (:,:),lwup(:,:),evap(:,:), & - taux(:,:),tauy(:,:),tref(:,:),qref(:,:),duu10n(:,:) - real(ESMF_KIND_R8) :: zbot1(1),ubot1(1),vbot1(1),thbot1(1), & - qbot1(1),rbot1(1),tbot1(1) - integer :: mask1(1) - real(ESMF_KIND_R8) :: us1 (1),vs1 (1),ts1 (1) - real(ESMF_KIND_R8) :: sen1 (1),lat1 (1),lwup1(1),evap1(1), & - taux1(1),tauy1(1),tref1(1),qref1(1),duu10n1(1) -!BL2017 - integer :: fieldCount - real(ESMF_KIND_R8), pointer :: zbot2(:,:),ubot2(:,:),vbot2(:,:) - real(ESMF_KIND_R8), pointer :: tbot2(:,:),pbot2(:,:),qbot2(:,:) -!BL2017 - character(len=*),parameter :: subname='(module_MEDIATOR:MedPhase_atm_ocn_flux)' - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - ! query the Component for its clock, importState and exportState - call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & - exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_ClockGet(clock,currtime=time,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_TimeGet(time,timestring=timestr) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": time = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - if (dbug_flag > 1) then - call ESMF_ClockPrint(clock, options="currTime", & - preString="-------->"//trim(subname)//" mediating for: ", & - unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - ! Get the internal state from Component. - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--------------------------------------- - !--- compute atm/ocn fluxes - !--------------------------------------- - - call fieldBundle_reset(is_local%wrap%FBAtmOcn_o, value=czero, rc=rc) -!BL2017 - call fieldBundle_reset(is_local%wrap%FBAtm_o, value=czero, rc=rc) - call fieldBundle_reset(is_local%wrap%FBAtm2_o, value=czero, rc=rc) -!BL2017 - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--- atm fields on ocean grid input - if (is_local%wrap%a2o_active) then - - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//' calling FBRegrid FBAtm_a to FBAtm_o', ESMF_LOGMSG_INFO, rc=rc) - endif - - call FieldBundle_Regrid(fldsFrAtm, is_local%wrap%FBAtm_a, is_local%wrap%FBAtm_o, & - consfmap=is_local%wrap%RH_a2o_consf, & - consdmap=is_local%wrap%RH_a2o_consd, & - bilnrmap=is_local%wrap%RH_a2o_bilnr, & -! patchmap=is_local%wrap%RH_a2o_patch, & - string='a2oflx', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - -!BL2017 use nearest neighbor method - call FieldBundle_Regrid2(fldsFrAtm, is_local%wrap%FBAtm_a, is_local%wrap%FBAtm2_o, & - nearestmap=is_local%wrap%RH_a2o_nearest, & - string='a2oflx_nearest', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_FieldBundleGet(is_local%wrap%FBAtm_o, fieldCount=fieldCount, rc=rc) - - allocate(fieldNameList(fieldCount)) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm_o, 'inst_height_lowest', zbot, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm2_o, 'inst_height_lowest', zbot2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - -! write(msgString,'(A,3g14.7)') trim(subname)//':'//trim(fieldNameList(1)), & -! minval(zbot2),maxval(zbot2),sum(zbot2) -! call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - -! write(msgString,'(A,3g14.7)') trim(subname)//':'//trim(fieldNameList(1)), & -! minval(zbot),maxval(zbot),sum(zbot) -! call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm_o, 'inst_temp_height_lowest', tbot, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm2_o, 'inst_temp_height_lowest', tbot2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm_o, 'inst_zonal_wind_height_lowest', ubot, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm2_o, 'inst_zonal_wind_height_lowest',ubot2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm_o, 'inst_merid_wind_height_lowest', vbot, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm2_o, 'inst_merid_wind_height_lowest',vbot2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm_o, 'inst_pres_height_lowest', pbot, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm2_o, 'inst_pres_height_lowest', pbot2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm_o, 'inst_spec_humid_height_lowest', qbot, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm2_o, 'inst_spec_humid_height_lowest',qbot2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - do j=lbound(zbot,2),ubound(zbot,2) - do i=lbound(zbot,1),ubound(zbot,1) - if(tbot(i,j).eq.0._ESMF_KIND_R8.and.abs(tbot2(i,j)).gt.0._ESMF_KIND_R8) then - zbot(i,j)=zbot2(i,j) - tbot(i,j)=tbot2(i,j) - ubot(i,j)=ubot2(i,j) - vbot(i,j)=vbot2(i,j) - qbot(i,j)=qbot2(i,j) - pbot(i,j)=pbot2(i,j) - endif - enddo - enddo - deallocate(fieldNameList) -!BL2017 - endif - - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm_o, 'inst_height_lowest', zbot, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm_o, 'inst_zonal_wind_height_lowest', ubot, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm_o, 'inst_merid_wind_height_lowest', vbot, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -! call FieldBundle_GetFldPtr(is_local%wrap%FBAtm_o, 'inst_pot_temp_height_lowest', thbot, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm_o, 'inst_spec_humid_height_lowest', qbot, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -! call FieldBundle_GetFldPtr(is_local%wrap%FBAtm_o, 'inst_density_height_lowest', rbot, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm_o, 'inst_temp_height_lowest', tbot, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm_o, 'inst_pres_height_lowest', pbot, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--- ocean fields input - call FieldBundle_GetFldPtr(is_local%wrap%FBOcn_o, 'ocean_mask', mask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBOcn_o, 'ocn_current_zonal', us, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBOcn_o, 'ocn_current_merid', vs, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBOcn_o, 'sea_surface_temperature', ts, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--- atm/ocn fluxes output - call FieldBundle_GetFldPtr(is_local%wrap%FBAtmOcn_o, 'mean_up_lw_flx_ocn', lwup, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBAtmOcn_o, 'mean_sensi_heat_flx_atm_into_ocn', sen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBAtmOcn_o, 'mean_laten_heat_flx_atm_into_ocn', lat, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBAtmOcn_o, 'mean_evap_rate_atm_into_ocn', evap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBAtmOcn_o, 'stress_on_air_ocn_zonal', taux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBAtmOcn_o, 'stress_on_air_ocn_merid', tauy, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBAtmOcn_o, 'temperature_2m', tref, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBAtmOcn_o, 'humidity_2m', qref, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBAtmOcn_o, 'wind_speed_squared_10m', duu10n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--- flux calculation - do j=lbound(zbot,2),ubound(zbot,2) - do i=lbound(zbot,1),ubound(zbot,1) - zbot1(1) = zbot(i,j) - ubot1(1) = ubot(i,j) - vbot1(1) = vbot(i,j) - if(pbot(i,j) .gt. 0.0) & - thbot1(1) = tbot(i,j)*((100000._ESMF_KIND_R8/pbot(i,j))**0.286_ESMF_KIND_R8) ! tcx temporary -!tcx thbot1(1) = thbot(i,j) - qbot1(1) = qbot(i,j) - if(tbot(i,j) .gt. 0.0) & - rbot1(1) = pbot(i,j)/(287.058_ESMF_KIND_R8*(1._ESMF_KIND_R8+0.608_ESMF_KIND_R8*qbot(i,j))*tbot(i,j)) ! tcx temporary -!tcx rbot1(1) = rbot(i,j) - tbot1(1) = tbot(i,j) - us1(1) = us(i,j) - vs1(1) = vs(i,j) - ts1(1) = ts(i,j) - - mask1(1) = nint(mask(i,j)) - call shr_flux_atmOcn(1 ,zbot1(1) ,ubot1(1) ,vbot1(1) ,thbot1(1) , & - qbot1(1) ,rbot1(1) ,tbot1(1) ,us1(1) ,vs1(1) , & - ts1(1) ,mask1(1) ,sen1(1) ,lat1(1) ,lwup1(1) , & -! evap1(1) ,taux1(1) ,tauy1(1) ,tref1(1) ,qref1(1) ,duu10n1(1)) -!tcx include this for the time being to get over the initialization hump - evap1(1) ,taux1(1) ,tauy1(1) ,tref1(1) ,qref1(1) ,duu10n1(1), & - missval = 0.0_ESMF_KIND_R8 ) - sen(i,j) = sen1(1) - lat(i,j) = lat1(1) - lwup(i,j) = lwup1(1) - evap(i,j) = evap1(1) - taux(i,j) = taux1(1) - tauy(i,j) = tauy1(1) - tref(i,j) = tref1(1) - qref(i,j) = qref1(1) - duu10n(i,j) = duu10n1(1) - enddo - enddo - - !--------------------------------------- - !--- atmocn diagnostics - !--------------------------------------- - - if (dbug_flag > 1) then - call FieldBundle_diagnose(is_local%wrap%FBAtmOcn_o, trim(subname)//' FBAtmOcn_o ', rc=rc) - endif - - if (statewrite_flag) then - ! write the fields imported from ocn to file - call ESMF_FieldBundleWrite(is_local%wrap%FBAtmOcn_o, 'fields_med_atmocn.nc', & - singleFile=.true., overwrite=.true., timeslice=is_local%wrap%fastcntr, & - iofmt=ESMF_IOFMT_NETCDF, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine MedPhase_atm_ocn_flux - - !----------------------------------------------------------------------------- - - subroutine MedPhase_slow(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Time) :: time - character(len=64) :: timestr - type(ESMF_State) :: importState, exportState - type(ESMF_StateItem_Flag) :: itemType - type(InternalState) :: is_local - integer :: i,j,n - character(ESMF_MAXSTR) :: fieldname1(10),fieldname2(10),fieldname3(10) - real(ESMF_KIND_R8), pointer :: dataPtr1(:,:),dataPtr2(:,:),dataPtr3(:,:) - real(ESMF_KIND_R8), pointer :: atmwgt(:,:),icewgt(:,:),customwgt(:,:) - logical :: checkOK, checkOK1, checkOK2 - character(len=*),parameter :: subname='(module_MEDIATOR:MedPhase_slow)' - - if(profile_memory) call ESMF_VMLogMemInfo("Entering "//trim(subname)) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - call MedPhase_prep_ocn(gcomp,rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - if(profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) - - end subroutine MedPhase_slow - - !----------------------------------------------------------------------------- - - subroutine MedPhase_prep_ocn(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Time) :: time - character(len=64) :: timestr - type(ESMF_State) :: importState, exportState - type(ESMF_StateItem_Flag) :: itemType - type(InternalState) :: is_local - integer :: i,j,n - character(ESMF_MAXSTR) :: fieldname1(10),fieldname2(10),fieldname3(10) -! real(ESMF_KIND_R8), pointer :: dataPtr1(:,:),dataPtr2(:,:),dataPtr3(:,:) - real(ESMF_KIND_R8), pointer :: atmwgt(:,:),icewgt(:,:),customwgt(:,:) - real(ESMF_KIND_R8), pointer :: atmwgt1(:,:),icewgt1(:,:),wgtp01(:,:),wgtm01(:,:) - real(ESMF_KIND_R8), pointer :: tmp_n1(:,:),tmp_n2(:,:) - character(ESMF_MAXSTR) ,pointer :: fieldNameList(:) - type(ESMF_Field) :: aofield - integer :: fieldCount - logical :: checkOK, checkOK1, checkOK2 - character(len=*),parameter :: subname='(module_MEDIATOR:MedPhase_prep_ocn)' - - integer :: ii,jj - - if(profile_memory) call ESMF_VMLogMemInfo("Entering "//trim(subname)) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - ! query the Component for its clock, importState and exportState - call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & - exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! Get the internal state from Component. - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_ClockGet(clock,currtime=time,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_TimeGet(time,timestring=timestr) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": time = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - if (dbug_flag > 1) then - call ESMF_ClockPrint(clock, options="currTime", & - preString="-------->"//trim(subname)//" mediating for: ", & - unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (statewrite_flag) then - ! write the fields imported from ocn to file - write(msgString,'(A,i10)')trim(subname)//trim(': write field_med_from_ocn '), is_local%wrap%slowcntr - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - call NUOPC_Write(NState_OcnImp, & - fldsFrOcn%shortname(1:fldsFrOcn%num), & - "field_med_from_ocn_", timeslice=is_local%wrap%slowcntr, & - overwrite=.true., relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - !--------------------------------------- - !--- average atm, ice, lnd accumulators - !--------------------------------------- - - if (dbug_flag > 1) then - call FieldBundle_diagnose(is_local%wrap%FBaccumAtm, trim(subname)//' FBaccA_B4avg ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBaccumIce, trim(subname)//' FBaccI_B4avg ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBaccumLnd, trim(subname)//' FBaccL_B4avg ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBaccumHyd, trim(subname)//' FBaccH_B4avg ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBaccumAtmOcn, trim(subname)//' FBaccAO_B4avg ', rc=rc) - endif - - call FieldBundle_average(is_local%wrap%FBaccumAtm, is_local%wrap%accumcntAtm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call FieldBundle_average(is_local%wrap%FBaccumIce, is_local%wrap%accumcntIce, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call FieldBundle_average(is_local%wrap%FBaccumLnd, is_local%wrap%accumcntLnd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call FieldBundle_average(is_local%wrap%FBaccumHyd, is_local%wrap%accumcntHyd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call FieldBundle_average(is_local%wrap%FBaccumAtmOcn, is_local%wrap%accumcntAtmOcn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 1) then - call FieldBundle_diagnose(is_local%wrap%FBaccumAtm, trim(subname)//' FBaccA_avg ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBaccumIce, trim(subname)//' FBaccI_avg ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBaccumLnd, trim(subname)//' FBaccL_avg ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBaccumHyd, trim(subname)//' FBaccH_avg ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBaccumAtmOcn, trim(subname)//' FBaccAO_avg ', rc=rc) - endif - - !--------------------------------------- - !--- regrid average atm+ice+lnd+hyd fields to ocean grid - !--------------------------------------- - - if (is_local%wrap%a2o_active) then - call ESMF_LogWrite(trim(subname)//' calling FBRegrid FBaccumAtm to FBAtm_o', ESMF_LOGMSG_INFO, rc=rc) - call FieldBundle_Regrid(fldsFrAtm, is_local%wrap%FBaccumAtm, is_local%wrap%FBAtm_o, & - consfmap=is_local%wrap%RH_a2o_consf, & - consdmap=is_local%wrap%RH_a2o_consd, & - bilnrmap=is_local%wrap%RH_a2o_bilnr, & - patchmap=is_local%wrap%RH_a2o_patch, & - string='a2o', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - -!BL2017 use nearest neighbor method - call FieldBundle_Regrid2(fldsFrAtm, is_local%wrap%FBaccumAtm, is_local%wrap%FBAtm2_o, & - nearestmap=is_local%wrap%RH_a2o_nearest, & - string='a2o_nearest', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_FieldBundleGet(is_local%wrap%FBAtm_o, fieldCount=fieldCount, rc=rc) - allocate(fieldNameList(fieldCount)) - call ESMF_FieldBundleGet(is_local%wrap%FBAtm_o, fieldNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - do n = 1, fieldCount - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm_o, fieldNameList(n), tmp_n1,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(is_local%wrap%FBAtm2_o, fieldNameList(n), tmp_n2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - do j=lbound(tmp_n1,2),ubound(tmp_n1,2) - do i=lbound(tmp_n1,1),ubound(tmp_n1,1) - if(tmp_n1(i,j).eq.0._ESMF_KIND_R8.and.abs(tmp_n2(i,j)).gt.0._ESMF_KIND_R8) then - tmp_n1(i,j)=tmp_n2(i,j) - endif - enddo - enddo - enddo - deallocate(fieldNameList) -!BL2017 - endif - - if (is_local%wrap%i2o_active) then - call ESMF_LogWrite(trim(subname)//' calling FBRegrid FBaccumIce to FBIce_o', ESMF_LOGMSG_INFO, rc=rc) - call FieldBundle_Regrid(fldsFrIce, is_local%wrap%FBaccumIce, is_local%wrap%FBIce_o, & - consfmap=is_local%wrap%RH_i2o_consf, & - consdmap=is_local%wrap%RH_i2o_consd, & - bilnrmap=is_local%wrap%RH_i2o_bilnr, & - patchmap=is_local%wrap%RH_i2o_patch, & - fcopymap=is_local%wrap%RH_i2o_fcopy, & - string='i2o', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - if (dbug_flag > 1) then - call FieldBundle_diagnose(is_local%wrap%FBAtm_o, trim(subname)//' FBAtm_o ', rc=rc) - call FieldBundle_diagnose(is_local%wrap%FBIce_o, trim(subname)//' FBIce_o ', rc=rc) - endif - -! tcx Xgrid - ! XGrid intermediary required? instantiate FBXgrid FieldBundle? - ! call ESMF_FieldBundleRegrid(is_local%wrap%FBaccumAtm, FBXgrid, is_local%wrap%RHa2x, & - ! termorderflag=(/ESMF_TERMORDER_SRCSEQ/), rc=rc) - ! call ESMF_FieldBundleRegrid(FBXgrid, is_local%wrap%FBforOcn , is_local%wrap%RHx2o, & - ! termorderflag=(/ESMF_TERMORDER_SRCSEQ/), rc=rc) - ! tcraig temporarily copy - - call fieldBundle_copy(is_local%wrap%FBforOcn, is_local%wrap%FBAtm_o, rc=rc) - call fieldBundle_copy(is_local%wrap%FBforOcn, is_local%wrap%FBIce_o, rc=rc) - call fieldBundle_copy(is_local%wrap%FBforOcn, is_local%wrap%FBAccumAtmOcn, rc=rc) - - if (dbug_flag > 1) then - call FieldBundle_diagnose(is_local%wrap%FBforOcn, trim(subname)//' FB4ocn_AFregrid ', rc=rc) - endif - - !--------------------------------------- - !--- custom calculations to ocn - !--------------------------------------- - - !if (dbug_flag > 1) then - ! call FieldBundle_diagnose(is_local%wrap%FBforOcn, trim(subname)//' FB4ocn_AFcc ', rc=rc) - !endif - - !--------------------------------------- - !--- write the Mediator Atm-Ocn fluxes - !--------------------------------------- - - if (statewrite_flag) then - ! write the fields cantaining the mediator fluxes to ocn to file - write(msgString,'(A,i10)')trim(subname)//trim(': write field_aofield_to_ocn '), is_local%wrap%slowcntr - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - - call ESMF_FieldBundleGet(is_local%wrap%FBAccumAtmOcn, fieldCount=fieldCount, rc=rc) - allocate(fieldNameList(fieldCount)) - call ESMF_FieldBundleGet(is_local%wrap%FBAccumAtmOcn, fieldNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__, file=__FILE__)) return - - do n = 1, fieldCount - call ESMF_FieldBundleGet(is_local%wrap%FBAccumAtmOcn, fieldname=fieldNameList(n), field=aofield, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__, file=__FILE__)) return - call ESMF_FieldWrite(aofield,'field_aofield_to_ocn_'//trim(fieldnameList(n))//'.nc', & - timeslice=is_local%wrap%slowcntr, overwrite=.true.,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__, file=__FILE__)) return - end do - deallocate(fieldNameList) - endif - - !--------------------------------------- - !--- merges to ocn - !--------------------------------------- - - if ((is_local%wrap%i2o_active) .and. (is_local%wrap%a2o_active))then - - ! atm and ice fraction - ! atmwgt and icewgt are the "normal" fractions - ! atmwgt1, icewgt1, and wgtp01 are the fractions that switch between atm and mediator fluxes - ! wgtp01 and wgtm01 are the same just one is +1 and the other is -1 to change sign - ! depending on the ice fraction. atmwgt1+icewgt1+wgtp01 = 1.0 always, either - ! wgtp01 is 1 (when ice fraction is 0) or wgtp01 is zero (when ice fraction is > 0) - call FieldBundle_GetFldPtr(is_local%wrap%FBIce_o, 'ice_fraction', icewgt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate(atmwgt(lbound(icewgt,1):ubound(icewgt,1),lbound(icewgt,2):ubound(icewgt,2))) - allocate(customwgt(lbound(icewgt,1):ubound(icewgt,1),lbound(icewgt,2):ubound(icewgt,2))) - allocate(atmwgt1(lbound(icewgt,1):ubound(icewgt,1),lbound(icewgt,2):ubound(icewgt,2))) - allocate(icewgt1(lbound(icewgt,1):ubound(icewgt,1),lbound(icewgt,2):ubound(icewgt,2))) - allocate(wgtp01(lbound(icewgt,1):ubound(icewgt,1),lbound(icewgt,2):ubound(icewgt,2))) - allocate(wgtm01(lbound(icewgt,1):ubound(icewgt,1),lbound(icewgt,2):ubound(icewgt,2))) - do j=lbound(icewgt,2),ubound(icewgt,2) - do i=lbound(icewgt,1),ubound(icewgt,1) -#ifndef FV3_CPLD -! DATM uses mediator aoflux calc in icy water - atmwgt(i,j) = 1.0_ESMF_KIND_R8 - icewgt(i,j) - atmwgt1(i,j) = atmwgt(i,j) - icewgt1(i,j) = icewgt(i,j) - wgtp01(i,j) = 0.0_ESMF_KIND_R8 - wgtm01(i,j) = 0.0_ESMF_KIND_R8 -! DATM uses atm fluxes in non-icy water - if (atmocn_flux_from_atm .and. icewgt(i,j) <= 0.0_ESMF_KIND_R8) then - atmwgt1(i,j) = 1.0_ESMF_KIND_R8 - icewgt1(i,j) = 0.0_ESMF_KIND_R8 - wgtp01(i,j) = 0.0_ESMF_KIND_R8 - wgtm01(i,j) = 0.0_ESMF_KIND_R8 - endif - - ! check wgts do add to 1 as expected - if (abs(atmwgt(i,j) + icewgt(i,j) - 1.0_ESMF_KIND_R8) > 1.0e-12 .or. & - abs(atmwgt1(i,j) + icewgt1(i,j) + wgtp01(i,j) - 1.0_ESMF_KIND_R8) > 1.0e-12 .or. & - abs(atmwgt1(i,j) + icewgt1(i,j) - wgtm01(i,j) - 1.0_ESMF_KIND_R8) > 1.0e-12) then - call ESMF_LogWrite(trim(subname)//": ERROR atm + ice fracs inconsistent", ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - rc = ESMF_FAILURE - return - endif -#else - atmwgt(i,j) = 1.0_ESMF_KIND_R8 - icewgt(i,j) - atmwgt1(i,j) = 0.0_ESMF_KIND_R8 - icewgt1(i,j) = icewgt(i,j) - wgtm01(i,j) = -atmwgt(i,j) - wgtp01(i,j) = atmwgt(i,j) -#endif - enddo - enddo - - ii =lbound(icewgt,1)+(ubound(icewgt,1) - lbound(icewgt,1))/2 - jj =lbound(icewgt,2)+(ubound(icewgt,2) - lbound(icewgt,2))/2 - write(msgString,'(A,6f12.5)')trim(subname)//trim(' sample wts for atm-ocn merges'), & - real(icewgt(ii,jj),4), real(atmwgt(ii,jj),4),& - real(icewgt1(ii,jj),4), real( atmwgt1(ii,jj),4),& - real(wgtp01(ii,jj),4), real( wgtm01(ii,jj),4) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - - !------------- - ! mean_evap_rate = mean_laten_heat_flux * (1-ice_fraction)/const_lhvap - !------------- - - customwgt = wgtm01 / const_lhvap - call fieldBundle_FieldMerge(is_local%wrap%FBforOcn , 'mean_evap_rate' , & - is_local%wrap%FBAccumAtmOcn, 'mean_evap_rate_atm_into_ocn', atmwgt1, & - is_local%wrap%FBAtm_o , 'mean_laten_heat_flx' , customwgt, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !------------- - ! field_for_ocn = field_from_atm * (1-ice_fraction) - !------------- - - call fieldBundle_FieldMerge(is_local%wrap%FBforOcn, 'mean_fprec_rate', & - is_local%wrap%FBAtm_o , 'mean_fprec_rate', atmwgt, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_FieldMerge(is_local%wrap%FBforOcn, 'mean_prec_rate', & - is_local%wrap%FBAtm_o , 'mean_prec_rate', atmwgt, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !------------- - ! field_for_ocn = field_from_ice * ice_fraction - !------------- - - call fieldBundle_FieldMerge(is_local%wrap%FBforOcn, 'net_heat_flx_to_ocn', & - is_local%wrap%FBIce_o , 'net_heat_flx_to_ocn', icewgt, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - - call fieldBundle_FieldMerge(is_local%wrap%FBforOcn, 'mean_fresh_water_to_ocean_rate', & - is_local%wrap%FBIce_o , 'mean_fresh_water_to_ocean_rate', icewgt, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - -! not used by mom, mom uses net, also mean_down_lw_flx not connected to ocn -! call fieldBundle_FieldMerge(is_local%wrap%FBforOcn, 'mean_down_lw_flx', & -! is_local%wrap%FBAtm_o , 'mean_down_lw_flx', atmwgt, & -! rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out - -! not used by mom, mom uses evap -! hycom uses latent heat flux - !call fieldBundle_FieldMerge(is_local%wrap%FBforOcn , 'mean_laten_heat_flx' , & - ! is_local%wrap%FBAccumAtmOcn, 'mean_laten_heat_flx_atm_into_ocn', atmwgt1, & - ! is_local%wrap%FBAtm_o , 'mean_laten_heat_flx' , wgtm01, & - ! rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_FieldMerge(is_local%wrap%FBforOcn , 'mean_sensi_heat_flx' , & - is_local%wrap%FBAccumAtmOcn, 'mean_sensi_heat_flx_atm_into_ocn', atmwgt1, & - is_local%wrap%FBAtm_o , 'mean_sensi_heat_flx' , wgtm01, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_FieldMerge(is_local%wrap%FBforOcn , 'mean_net_lw_flx' , & - is_local%wrap%FBAtm_o , 'mean_down_lw_flx' , atmwgt1, & - is_local%wrap%FBAccumAtmOcn, 'mean_up_lw_flx_ocn', atmwgt1, & - is_local%wrap%FBAtm_o , 'mean_net_lw_flx' , wgtp01, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - -! not used by mom, mom uses net, also mean_up_lw_flx not recvd from atm -! call fieldBundle_FieldMerge(is_local%wrap%FBforOcn , 'mean_up_lw_flx' , & -! is_local%wrap%FBAccumAtmOcn, 'mean_up_lw_flx_ocn', atmwgt1, & -! is_local%wrap%FBAtm_o , 'mean_up_lw_flx' , wgtp01, & -! rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out - - !------------- - ! field_for_ocn = field_from_ice * ice_fraction - !------------- - - call fieldBundle_FieldMerge(is_local%wrap%FBforOcn, 'mean_salt_rate', & - is_local%wrap%FBIce_o , 'mean_salt_rate', icewgt, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !------------- - ! field_for_ocn = field_from_atm * (1-ice_fraction) + field_from_ice * (ice_fraction) - !------------- - - call fieldBundle_FieldMerge(is_local%wrap%FBforOcn , 'mean_zonal_moment_flx' , & - is_local%wrap%FBAccumAtmOcn, 'stress_on_air_ocn_zonal', atmwgt1, & - is_local%wrap%FBIce_o , 'stress_on_ocn_ice_zonal', icewgt1, & - is_local%wrap%FBAtm_o , 'mean_zonal_moment_flx_atm' , wgtm01, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_FieldMerge(is_local%wrap%FBforOcn , 'mean_merid_moment_flx' , & - is_local%wrap%FBAccumAtmOcn, 'stress_on_air_ocn_merid', atmwgt1, & - is_local%wrap%FBIce_o , 'stress_on_ocn_ice_merid', icewgt1, & - is_local%wrap%FBAtm_o , 'mean_merid_moment_flx_atm' , wgtm01, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !------------- - ! netsw_for_ocn = downsw_from_atm * (1-ocn_albedo) * (1-ice_fraction) + pensw_from_ice * (ice_fraction) - !------------- - - customwgt = atmwgt * (1.0 - 0.06) -! customwgt = (1.0 - 0.06) - call fieldBundle_FieldMerge(is_local%wrap%FBforOcn,'mean_net_sw_flx' , & - is_local%wrap%FBAtm_o ,'mean_down_sw_flx',customwgt, & - is_local%wrap%FBIce_o ,'mean_sw_pen_to_ocn' ,icewgt, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_FieldMerge(is_local%wrap%FBforOcn,'mean_net_sw_vis_dir_flx' , & - is_local%wrap%FBAtm_o ,'mean_down_sw_vis_dir_flx',customwgt, & - is_local%wrap%FBIce_o ,'mean_sw_pen_to_ocn_vis_dir_flx' ,icewgt, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_FieldMerge(is_local%wrap%FBforOcn,'mean_net_sw_vis_dif_flx' , & - is_local%wrap%FBAtm_o ,'mean_down_sw_vis_dif_flx',customwgt, & - is_local%wrap%FBIce_o ,'mean_sw_pen_to_ocn_vis_dif_flx',icewgt, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_FieldMerge(is_local%wrap%FBforOcn,'mean_net_sw_ir_dir_flx' , & - is_local%wrap%FBAtm_o ,'mean_down_sw_ir_dir_flx',customwgt, & - is_local%wrap%FBIce_o ,'mean_sw_pen_to_ocn_ir_dir_flx',icewgt, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_FieldMerge(is_local%wrap%FBforOcn,'mean_net_sw_ir_dif_flx' , & - is_local%wrap%FBAtm_o ,'mean_down_sw_ir_dif_flx',customwgt, & - is_local%wrap%FBIce_o ,'mean_sw_pen_to_ocn_ir_dif_flx',icewgt, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !------------- - ! End merges - !------------- - - deallocate(atmwgt,customwgt,atmwgt1,icewgt1,wgtp01) - - if (dbug_flag > 1) then - call FieldBundle_diagnose(is_local%wrap%FBforOcn, trim(subname)//' FB4ocn_AFmrg ', rc=rc) - endif - - endif - - !--------------------------------------- - !--- zero accumulator - !--------------------------------------- - - is_local%wrap%accumcntAtm = 0 - call fieldBundle_reset(is_local%wrap%FBaccumAtm, value=czero, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - is_local%wrap%accumcntIce = 0 - call fieldBundle_reset(is_local%wrap%FBaccumIce, value=czero, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - is_local%wrap%accumcntLnd = 0 - call fieldBundle_reset(is_local%wrap%FBaccumLnd, value=czero, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - is_local%wrap%accumcntHyd = 0 - call fieldBundle_reset(is_local%wrap%FBaccumHyd, value=czero, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - is_local%wrap%accumcntAtmOcn = 0 - call fieldBundle_reset(is_local%wrap%FBaccumAtmOcn, value=czero, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 1) then -!tcx call FieldBundle_diagnose(is_local%wrap%FBaccumAtm, trim(subname)//' FBacc_AFzero ', rc=rc) -!tcx call FieldBundle_diagnose(is_local%wrap%FBaccumIce, trim(subname)//' FBacc_AFzero ', rc=rc) -!dcr call FieldBundle_diagnose(is_local%wrap%FBaccumLnd, trim(subname)//' FBacc_AFzero ', rc=rc) -!dcr call FieldBundle_diagnose(is_local%wrap%FBaccumHyd, trim(subname)//' FBacc_AFzero ', rc=rc) -!tcx call FieldBundle_diagnose(is_local%wrap%FBaccumAtmOcn, trim(subname)//' FBacc_AFzero ', rc=rc) - endif - - !--- set export State to special value for testing - - call state_reset(NState_OcnExp, value=spval, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 1) then - call State_diagnose(NState_OcnExp, trim(subname)//' es_AF99 ', rc=rc) - endif - - !--------------------------------------- - !--- copy into export state - !--------------------------------------- - - call fieldBundle_copy(NState_OcnExp, is_local%wrap%FBforOcn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 1) then - call State_diagnose(NState_OcnExp, trim(subname)//' es_AFcp ', rc=rc) - endif - - if (statewrite_flag) then - ! write the fields exported to ocn to file - write(msgString,'(A,i10)')trim(subname)//trim(': write field_med_to_ocn '), is_local%wrap%slowcntr - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - - call NUOPC_Write(NState_OcnExp, & - fldsToOcn%shortname(1:fldsToOcn%num), & - "field_med_to_ocn_", timeslice=is_local%wrap%slowcntr, & - relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - !--------------------------------------- - - is_local%wrap%slowcntr = is_local%wrap%slowcntr + 1 - - !--------------------------------------- - !--- clean up - !--------------------------------------- - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - if(profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) - -! call ESMF_LogWrite(trim(subname)//": tcx aborting", ESMF_LOGMSG_INFO, rc=dbrc) -! call ESMF_Finalize(endflag=ESMF_END_ABORT) - - end subroutine MedPhase_prep_ocn - - !----------------------------------------------------------------------------- - !----------------------------------------------------------------------------- - - subroutine MedPhase_write_restart(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Time) :: currTime - type(ESMF_Time) :: startTime - type(ESMF_TimeInterval) :: elapsedTime - ! ESMF_TimeInterval - integer*8 :: sec8 - integer :: yr,mon,day,hr,min,sec - character(len=128) :: fname - character(len=*),parameter :: subname='(module_MEDIATOR:MedPhase_write_restart)' - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - if (restart_interval > 0) then - call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_ClockGet(clock,currTime=currTime,startTime=startTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - elapsedTime = currTime - startTime - - call ESMF_TimeIntervalGet(elapsedTime,s_i8=sec8,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (mod(sec8,restart_interval) == 0) then - write(msgString,*) trim(subname)//' restart at sec8= ',sec8,restart_interval - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_TimeGet(currTime,yy=yr,mm=mon,dd=day,h=hr,m=min,s=sec,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - write(fname,'(i4.4,2i2.2,a,3i2.2,a)') yr,mon,day,'-',hr,min,sec,'_mediator' - write(msgString,*) trim(subname)//' restart to '//trim(fname) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=dbrc) - - call Mediator_restart(gcomp,'write',trim(fname),rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - endif - - !if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - !endif - - end subroutine MedPhase_write_restart - - !----------------------------------------------------------------------------- - - subroutine Finalize(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! local variables - type(InternalState) :: is_local - integer :: stat - character(len=*),parameter :: subname='(module_MEDIATOR:Finalize)' - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - call Mediator_restart(gcomp,'write','mediator',rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! Get the internal state from Component. - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! Destroy objects inside of internal state. - ! TODO: destroy objects inside objects - - call fieldBundle_clean(is_local%wrap%FBaccumAtm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - -! tcraig - generates errors -! call fieldBundle_clean(is_local%wrap%FBaccumOcn, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_clean(is_local%wrap%FBaccumIce, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_clean(is_local%wrap%FBaccumLnd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_clean(is_local%wrap%FBaccumHyd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_clean(is_local%wrap%FBaccumAtmOcn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_clean(is_local%wrap%FBforAtm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_clean(is_local%wrap%FBforOcn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_clean(is_local%wrap%FBforIce, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_clean(is_local%wrap%FBforLnd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_clean(is_local%wrap%FBforHyd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! Deallocate the internal state memory. - deallocate(is_local%wrap, stat=stat) - if (ESMF_LogFoundDeallocError(statusToCheck=stat, & - msg="Deallocation of internal state memory failed.", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_LogWrite(trim(subname)//" complete", ESMF_LOGMSG_INFO, rc=dbrc) - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine Finalize - - !----------------------------------------------------------------------------- - subroutine Mediator_restart(gcomp,mode,bfname,rc) - ! - ! read/write mediator restart file - ! - type(ESMF_GridComp) :: gcomp - character(len=*), intent(in) :: mode - character(len=*), intent(in) :: bfname - integer , intent(inout) :: rc - - type(InternalState) :: is_local - character(len=1280) :: fname - integer :: funit - logical :: fexists - character(len=*),parameter :: subname='(module_MEDIATOR:Mediator_restart)' - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - if (mode /= 'write' .and. mode /= 'read') then - call ESMF_LogWrite(trim(subname)//": ERROR mode not allowed "//trim(mode), ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - rc = ESMF_FAILURE - return - endif - - ! Get the internal state from Component. - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -#ifdef FV3_CPLD - fname = trim(bfname)//'_FBaccumAtm_restart.nc' - call FieldBundle_RWFields_tiles(mode,fname,is_local%wrap%FBaccumAtm,read_rest_FBaccumAtm,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -#else - fname = trim(bfname)//'_FBaccumAtm_restart.nc' - call FieldBundle_RWFields(mode,fname,is_local%wrap%FBaccumAtm,read_rest_FBaccumAtm,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -#endif - - fname = trim(bfname)//'_FBaccumOcn_restart.nc' - call FieldBundle_RWFields(mode,fname,is_local%wrap%FBaccumOcn,read_rest_FBaccumOcn,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - fname = trim(bfname)//'_FBaccumIce_restart.nc' - call FieldBundle_RWFields(mode,fname,is_local%wrap%FBaccumIce,read_rest_FBaccumIce,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - fname = trim(bfname)//'_FBaccumLnd_restart.nc' - call FieldBundle_RWFields(mode,fname,is_local%wrap%FBaccumLnd,read_rest_FBaccumLnd,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - fname = trim(bfname)//'_FBaccumHyd_restart.nc' - call FieldBundle_RWFields(mode,fname,is_local%wrap%FBaccumHyd,read_rest_FBaccumHyd,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - fname = trim(bfname)//'_FBaccumAtmOcn_restart.nc' - call FieldBundle_RWFields(mode,fname,is_local%wrap%FBaccumAtmOcn,read_rest_FBaccumAtmOcn,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - -#ifdef FV3_CPLD - fname = trim(bfname)//'_FBAtm_a_restart.nc' - call FieldBundle_RWFields_tiles(mode,fname,is_local%wrap%FBAtm_a,read_rest_FBAtm_a,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -#else - fname = trim(bfname)//'_FBAtm_a_restart.nc' - call FieldBundle_RWFields(mode,fname,is_local%wrap%FBAtm_a,read_rest_FBAtm_a,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -#endif - if (mode == 'read') then - call fieldBundle_copy(NState_AtmImp, is_local%wrap%FBAtm_a, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - fname = trim(bfname)//'_FBIce_i_restart.nc' - call FieldBundle_RWFields(mode,fname,is_local%wrap%FBIce_i,read_rest_FBIce_i,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (mode == 'read') then - call fieldBundle_copy(NState_IceImp, is_local%wrap%FBIce_i, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - fname = trim(bfname)//'_FBOcn_o_restart.nc' - call FieldBundle_RWFields(mode,fname,is_local%wrap%FBOcn_o,read_rest_FBOCN_o,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (mode == 'read') then - call fieldBundle_copy(NState_OcnImp, is_local%wrap%FBOcn_o, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - fname = trim(bfname)//'_FBLnd_l_restart.nc' - call FieldBundle_RWFields(mode,fname,is_local%wrap%FBLnd_l,read_rest_FBLnd_l,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (mode == 'read') then - call fieldBundle_copy(NState_LndImp, is_local%wrap%FBLnd_l, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - fname = trim(bfname)//'_FBHyd_h_restart.nc' - call FieldBundle_RWFields(mode,fname,is_local%wrap%FBHyd_h,read_rest_FBHyd_h,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (mode == 'read') then - call fieldBundle_copy(NState_HydImp, is_local%wrap%FBHyd_h, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - fname = trim(bfname)//'_FBAtmOcn_o_restart.nc' - call FieldBundle_RWFields(mode,fname,is_local%wrap%FBAtmOcn_o,read_rest_FBAtmOcn_o,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - funit = 1101 - fname = trim(bfname)//'_scalars_restart.txt' - if (mode == 'write') then - call ESMF_LogWrite(trim(subname)//": write "//trim(fname), ESMF_LOGMSG_INFO, rc=dbrc) - open(funit,file=fname,form='formatted') - write(funit,*) is_local%wrap%accumcntAtm - write(funit,*) is_local%wrap%accumcntOcn - write(funit,*) is_local%wrap%accumcntIce - write(funit,*) is_local%wrap%accumcntAtmOcn - write(funit,*) is_local%wrap%accumcntLnd - write(funit,*) is_local%wrap%accumcntHyd - close(funit) - elseif (mode == 'read') then - inquire(file=fname,exist=fexists) - if (fexists) then - call ESMF_LogWrite(trim(subname)//": read "//trim(fname), ESMF_LOGMSG_INFO, rc=dbrc) - open(funit,file=fname,form='formatted') - ! DCR - temporary skip reading Lnd and Hyd until components are added to test case - ! restart files - is_local%wrap%accumcntAtm=0 - is_local%wrap%accumcntOcn=0 - is_local%wrap%accumcntIce=0 - is_local%wrap%accumcntAtmOcn=0 - is_local%wrap%accumcntLnd=0 - is_local%wrap%accumcntHyd=0 - read (funit,*) is_local%wrap%accumcntAtm - read (funit,*) is_local%wrap%accumcntOcn - read (funit,*) is_local%wrap%accumcntIce - read (funit,*) is_local%wrap%accumcntAtmOcn -! read (funit,*) is_local%wrap%accumcntLnd -! read (funit,*) is_local%wrap%accumcntHyd - close(funit) - else - read_rest_FBaccumAtm = .false. - read_rest_FBaccumOcn = .false. - read_rest_FBaccumIce = .false. - read_rest_FBaccumLnd = .false. - read_rest_FBaccumHyd = .false. - read_rest_FBaccumAtmOcn = .false. - endif - endif - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine Mediator_restart - - !----------------------------------------------------------------------------- - - subroutine FieldBundle_RWFields(mode,fname,FB,flag,rc) - character(len=*) :: mode - character(len=*) :: fname - type(ESMF_FieldBundle) :: FB - logical,optional :: flag - integer,optional :: rc - - ! local variables - type(ESMF_Field) :: field - character(len=ESMF_MAXSTR) :: name - integer :: fieldcount, n - logical :: fexists - character(len=*),parameter :: subname='(module_MEDIATOR:FieldBundle_RWFields)' - - rc = ESMF_SUCCESS - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//trim(fname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - if (mode == 'write') then - call ESMF_LogWrite(trim(subname)//": write "//trim(fname), ESMF_LOGMSG_INFO, rc=dbrc) - call ESMF_FieldBundleWrite(FB, fname, & - singleFile=.true., status=ESMF_FILESTATUS_REPLACE, iofmt=ESMF_IOFMT_NETCDF, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call fieldBundle_diagnose(FB, 'write '//trim(fname), rc) - elseif (mode == 'read') then - inquire(file=fname,exist=fexists) - - if(.not.fexists .and. .not. coldstart)then - call ESMF_LogWrite(trim(fname)//' does not exist', ESMF_LOGMSG_INFO, rc=dbrc) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - - if (fexists) then - call ESMF_LogWrite(trim(subname)//": read "//trim(fname), ESMF_LOGMSG_INFO, rc=dbrc) -!----------------------------------------------------------------------------------------------------- -! tcraig, ESMF_FieldBundleRead fails if a field is not on the field bundle, but we really want to just -! ignore that field and read the rest, so instead read each field one at a time through ESMF_FieldRead -! call ESMF_FieldBundleRead (FB, fname, & -! singleFile=.true., iofmt=ESMF_IOFMT_NETCDF, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) call ESMF_LogWrite(trim(subname)//' WARNING missing fields',rc=dbrc) -!----------------------------------------------------------------------------------------------------- - call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - do n = 1,fieldCount - call fieldBundle_getName(FB, n, name, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call fieldBundle_getFieldN(FB, n, field, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldRead (field, fname, iofmt=ESMF_IOFMT_NETCDF, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_LogWrite(trim(subname)//' WARNING missing field '//trim(name),rc=dbrc) - enddo - - call fieldBundle_diagnose(FB, 'read '//trim(fname), rc) - if (present(flag)) flag = .true. - endif - else - call ESMF_LogWrite(trim(subname)//": mode WARNING "//trim(fname)//" mode="//trim(mode), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//trim(fname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine FieldBundle_RWFields - - -! This subroutine requires ESMFv8 - for coupled FV3 -#ifdef FV3_CPLD - subroutine FieldBundle_RWFields_tiles(mode,fname,FB,flag,rc) - character(len=*) :: mode - character(len=*) :: fname - type(ESMF_FieldBundle) :: FB - logical,optional :: flag - integer,optional :: rc - - ! local variables - type(ESMF_Field),allocatable :: flds(:) - type(ESMF_GridComp) :: IOComp - type(ESMF_Grid) :: gridFv3 - character(len=ESMF_MAXSTR) :: name - character(len=ESMF_MAXSTR) :: fname_tile1 - integer :: fieldcount, n - logical :: fexists - character(len=*),parameter :: subname='(module_MEDIATOR:FieldBundle_RWFields_tiles)' - - rc = ESMF_SUCCESS - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//trim(fname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !write(msgString,*) trim(subname)//' fieldCount = ',fieldCount - !call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - - allocate(flds(fieldCount)) - - if (mode == 'write') then - - call ESMF_LogWrite(trim(subname)//": write "//trim(fname)// & - "tile1-tile6", ESMF_LOGMSG_INFO, rc=dbrc) - - call fieldBundle_getFieldN(FB, 1, flds(1), rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_FieldGet(flds(1), grid=gridFv3, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - IOComp = ESMFIO_Create(gridFv3, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(trim(subname)//": write "//trim(fname), ESMF_LOGMSG_INFO, rc=dbrc) - - do n=2, fieldCount - call fieldBundle_getFieldN(FB, n, flds(n), rc) - enddo - - call ESMFIO_Write(IOComp, fname, flds, filePath='./', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - elseif (mode == 'read') then - fname_tile1='mediator_FBAtm_a_restart.tile1.nc' - inquire(file=fname_tile1,exist=fexists) - - if(.not.fexists .and. .not. coldstart)then - call ESMF_LogWrite(trim(fname_tile1)//' does not exist', ESMF_LOGMSG_INFO, rc=dbrc) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - - if (fexists) then - - call ESMF_LogWrite(trim(subname)//": read "//trim(fname)// & - "tile1-tile6", ESMF_LOGMSG_INFO, rc=dbrc) - - call fieldBundle_getFieldN(FB, 1, flds(1), rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_FieldGet(flds(1), grid=gridFv3, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - IOComp = ESMFIO_Create(gridFv3, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - do n=2, fieldCount - call fieldBundle_getFieldN(FB, n, flds(n), rc) - enddo - - call ESMFIO_Read(IOComp, fname, flds, filePath='./', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (present(flag)) flag = .true. - endif - else - call ESMF_LogWrite(trim(subname)//": mode WARNING "//trim(fname)//" mode="//trim(mode), ESMF_LOGMSG_INFO, rc=dbrc) - endif -! -- Finalize ESMFIO - deallocate(flds) - call ESMFIO_Destroy(IOComp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize() - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//trim(fname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine FieldBundle_RWFields_tiles -#endif - - !----------------------------------------------------------------------------- - - subroutine Compute_RHs(FBsrc, FBdst, bilnrmap, consfmap, consdmap, patchmap, fcopymap, & - nearestmap, srcMaskValue, dstMaskValue, & - fldlist1, fldlist2, fldlist3, fldlist4, string, rc) - type(ESMF_FieldBundle) :: FBsrc - type(ESMF_FieldBundle) :: FBdst - type(ESMF_Routehandle),optional :: bilnrmap - type(ESMF_Routehandle),optional :: consfmap - type(ESMF_Routehandle),optional :: consdmap - type(ESMF_Routehandle),optional :: patchmap - type(ESMF_Routehandle),optional :: fcopymap - type(ESMF_Routehandle),optional :: nearestmap - integer ,optional :: srcMaskValue - integer ,optional :: dstMaskValue - type(fld_list_type) ,optional :: fldlist1 - type(fld_list_type) ,optional :: fldlist2 - type(fld_list_type) ,optional :: fldlist3 - type(fld_list_type) ,optional :: fldlist4 - character(len=*) ,optional :: string - integer ,optional :: rc - - ! local variables - integer :: n - character(len=128) :: lstring - logical :: do_consf, do_consd, do_bilnr, do_patch, do_fcopy - logical :: do_nearest - integer :: lsrcMaskValue, ldstMaskValue - type(ESMF_Field) :: fldsrc, flddst - real(ESMF_KIND_R8), pointer :: factorList(:) - character(len=*),parameter :: subname='(module_MEDIATOR:Compute_RHs)' - type(ESMF_VM):: vm - - rc = ESMF_SUCCESS - - if (present(string)) then - lstring = trim(string) - else - lstring = " " - endif - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - if (present(srcMaskValue)) then - lsrcMaskValue = srcMaskValue - else - lsrcMaskValue = ispval_mask ! chosen to be ignored - endif - - if (present(dstMaskValue)) then - ldstMaskValue = dstMaskValue - else - ldstMaskValue = ispval_mask ! chosen to be ignored - endif - - if (.not.present(rc)) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": ERROR rc expected", ESMF_LOGMSG_INFO, rc=rc) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - - !--------------------------------------------------- - !--- decide which map files to generate. - !--- check fldlist mapping types. - !--- if there are no fldlists, then generate them all. - !--- but only for mapfiles that are passed into the subroutine. - !--------------------------------------------------- - - if (.not.present(fldlist1) .and. .not.present(fldlist2) .and. & - .not.present(fldlist3) .and. .not.present(fldlist4)) then - do_bilnr = .true. - do_consf = .true. - do_consd = .true. - do_patch = .true. - do_fcopy = .true. - do_nearest = .true. - else - do_bilnr = .false. - do_consf = .false. - do_consd = .false. - do_patch = .false. - do_fcopy = .false. - do_nearest = .false. - endif - if (present(fldlist1)) then - do n = 1,fldlist1%num - if (fldlist1%mapping(n) == 'bilinear' ) do_bilnr = .true. - if (fldlist1%mapping(n) == "conservefrac") do_consf = .true. - if (fldlist1%mapping(n) == "conservedst" ) do_consd = .true. - if (fldlist1%mapping(n) == 'patch' ) do_patch = .true. - if (fldlist1%mapping(n) == 'copy' ) do_fcopy = .true. - enddo - endif - - if (present(fldlist2)) then - do n = 1,fldlist2%num - if (fldlist2%mapping(n) == 'bilinear' ) do_bilnr = .true. - if (fldlist2%mapping(n) == "conservefrac") do_consf = .true. - if (fldlist2%mapping(n) == "conservedst" ) do_consd = .true. - if (fldlist2%mapping(n) == 'patch' ) do_patch = .true. - if (fldlist2%mapping(n) == 'copy' ) do_fcopy = .true. - enddo - endif - - if (present(fldlist3)) then - do n = 1,fldlist3%num - if (fldlist3%mapping(n) == 'bilinear' ) do_bilnr = .true. - if (fldlist3%mapping(n) == "conservefrac") do_consf = .true. - if (fldlist3%mapping(n) == "conservedst" ) do_consd = .true. - if (fldlist3%mapping(n) == 'patch' ) do_patch = .true. - if (fldlist3%mapping(n) == 'copy' ) do_fcopy = .true. - enddo - endif - - if (present(fldlist4)) then - do n = 1,fldlist4%num - if (fldlist4%mapping(n) == 'bilinear' ) do_bilnr = .true. - if (fldlist4%mapping(n) == "conservefrac") do_consf = .true. - if (fldlist4%mapping(n) == "conservedst" ) do_consd = .true. - if (fldlist4%mapping(n) == 'patch' ) do_patch = .true. - if (fldlist4%mapping(n) == 'copy' ) do_fcopy = .true. - enddo - endif - - if (.not.present(bilnrmap)) do_bilnr = .false. - if (.not.present(consfmap)) do_consf = .false. - if (.not.present(consdmap)) do_consd = .false. - if (.not.present(patchmap)) do_patch = .false. - if (.not.present(fcopymap)) do_fcopy = .false. - if (present(nearestmap)) do_nearest = .true. - - !--------------------------------------------------- - !--- get single fields from bundles - !--- assumes all fields in the bundle are on identical grids - !--------------------------------------------------- - - call fieldBundle_getFieldN(FBsrc, 1, fldsrc, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call fieldBundle_getFieldN(FBdst, 1, flddst, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - !--------------------------------------------------- - !--- bilinear - !--------------------------------------------------- - - if (do_bilnr) then - call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=bilnrmap, & - srcMaskValues=(/lsrcMaskValue/), dstMaskValues=(/ldstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & - polemethod=polemethod, & - srcTermProcessing=srcTermProcessing_Value, & - factorList=factorList, ignoreDegenerate=.true., & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -#if 0 -if (trim(string)=="o2a_weights") then - call ESMF_VMGetCurrent(vm) - call ESMF_VMBarrier(vm) - call ESMF_Finalize(endflag=ESMF_END_ABORT) -endif -#endif - if (rhprint_flag) then - call NUOPC_Write(factorList, "array_med_"//trim(lstring)//"_bilnr.nc", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_RouteHandlePrint(bilnrmap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - if (ESMF_RouteHandleIsCreated(bilnrmap, rc=rc)) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": computed RH bilnr", ESMF_LOGMSG_INFO, rc=dbrc) - else - call ESMF_LogWrite(trim(subname)//trim(lstring)//": failed RH bilnr", ESMF_LOGMSG_INFO, rc=dbrc) - endif - endif - - !--------------------------------------------------- - !--- conservative frac - !--------------------------------------------------- - - if (do_consf) then - call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=consfmap, & - srcMaskValues=(/lsrcMaskValue/), dstMaskValues=(/ldstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & - normType=ESMF_NORMTYPE_FRACAREA, & - srcTermProcessing=srcTermProcessing_Value, & - factorList=factorList, ignoreDegenerate=.true., & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -#if 0 -if (trim(string)=="o2a_weights") then - call ESMF_VMGetCurrent(vm) - call ESMF_VMBarrier(vm) - call ESMF_Finalize(endflag=ESMF_END_ABORT) -endif -#endif - if (rhprint_flag) then - call NUOPC_Write(factorList, "array_med_"//trim(lstring)//"_consf.nc", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_RouteHandlePrint(consfmap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - if (ESMF_RouteHandleIsCreated(consfmap, rc=rc)) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": computed RH consf", ESMF_LOGMSG_INFO, rc=dbrc) - else - call ESMF_LogWrite(trim(subname)//trim(lstring)//": failed RH consf", ESMF_LOGMSG_INFO, rc=dbrc) - endif - endif - - !--------------------------------------------------- - !--- conservative dst - !--------------------------------------------------- - - if (do_consd) then - call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=consdmap, & - srcMaskValues=(/lsrcMaskValue/), dstMaskValues=(/ldstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & - normType=ESMF_NORMTYPE_DSTAREA, & - srcTermProcessing=srcTermProcessing_Value, & - factorList=factorList, ignoreDegenerate=.true., & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (rhprint_flag) then - call NUOPC_Write(factorList, "array_med_"//trim(lstring)//"_consd.nc", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_RouteHandlePrint(consdmap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - if (ESMF_RouteHandleIsCreated(consdmap, rc=rc)) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": computed RH consd", ESMF_LOGMSG_INFO, rc=dbrc) - else - call ESMF_LogWrite(trim(subname)//trim(lstring)//": failed RH consd", ESMF_LOGMSG_INFO, rc=dbrc) - endif - endif - - !--------------------------------------------------- - !--- nearest stod - !--------------------------------------------------- - - if (do_nearest) then - call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=nearestmap, & - srcMaskValues=(/lsrcMaskValue/), dstMaskValues=(/ldstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_NEAREST_STOD, & - srcTermProcessing=srcTermProcessing_Value, & - factorList=factorList, ignoreDegenerate=.true., & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (rhprint_flag) then - call NUOPC_Write(factorList, "array_med_"//trim(lstring)//"_nearest.nc", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_RouteHandlePrint(nearestmap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - if (ESMF_RouteHandleIsCreated(nearestmap, rc=rc)) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": computed RH nearest", ESMF_LOGMSG_INFO, rc=dbrc) - else - call ESMF_LogWrite(trim(subname)//trim(lstring)//": failed RH nearest", ESMF_LOGMSG_INFO, rc=dbrc) - endif - endif - - !--------------------------------------------------- - !--- patch - !--------------------------------------------------- - - if (do_patch) then - call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=patchmap, & - srcMaskValues=(/lsrcMaskValue/), dstMaskValues=(/ldstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_PATCH, & - polemethod=polemethod, & - srcTermProcessing=srcTermProcessing_Value, & - factorList=factorList, ignoreDegenerate=.true., & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (rhprint_flag) then - call NUOPC_Write(factorList, "array_med_"//trim(lstring)//"_patch.nc", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_RouteHandlePrint(patchmap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - if (ESMF_RouteHandleIsCreated(patchmap, rc=rc)) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": computed RH patch", ESMF_LOGMSG_INFO, rc=dbrc) - else - call ESMF_LogWrite(trim(subname)//trim(lstring)//": failed RH patch", ESMF_LOGMSG_INFO, rc=dbrc) - endif - endif - - !--------------------------------------------------- - !--- copy - !--------------------------------------------------- - - if (do_fcopy) then - call ESMF_FieldRedistStore(fldsrc, flddst, & - routehandle=fcopymap, & - ignoreUnmatchedIndices=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (rhprint_flag) then - call ESMF_RouteHandlePrint(fcopymap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - if (ESMF_RouteHandleIsCreated(fcopymap, rc=rc)) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": computed RH fcopy", ESMF_LOGMSG_INFO, rc=dbrc) - else - call ESMF_LogWrite(trim(subname)//trim(lstring)//": failed RH fcopy", ESMF_LOGMSG_INFO, rc=dbrc) - endif - endif - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine Compute_RHs - - !----------------------------------------------------------------------------- - subroutine Grid_CreateCoords(gridNew,gridOld,rc) - - ! ---------------------------------------------- - ! Create FieldBundle from another FieldBundle. - ! Zero out new FieldBundle - ! If grid is not passed, use grid from FBin - ! ---------------------------------------------- - type(ESMF_Grid), intent(inout) :: gridNew - type(ESMF_Grid), intent(inout) :: gridOld - integer , intent(out) :: rc - - ! local variables - integer :: localDE, localDECount - type(ESMF_DistGrid) :: distgrid - type(ESMF_CoordSys_Flag) :: coordSys - type(ESMF_Index_Flag) :: indexflag - real(ESMF_KIND_R8),pointer :: dataPtr1(:,:), dataPtr2(:,:) - integer :: dimCount - integer, pointer :: gridEdgeLWidth(:), gridEdgeUWidth(:) - character(len=*),parameter :: subname='(module_MEDIATOR:Grid_createCoords)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - call ESMF_LogWrite(trim(subname)//": tcxA", ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_GridGet(gridold, dimCount=dimCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate(gridEdgeLWidth(dimCount),gridEdgeUWidth(dimCount)) - call ESMF_GridGet(gridold,distgrid=distgrid, coordSys=coordSys, indexflag=indexflag, dimCount=dimCount, & - gridEdgeLWidth=gridEdgeLWidth, gridEdgeUWidth=gridEdgeUWidth, localDECount=localDECount, rc=rc) -! localDECount=localDECount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_LogWrite(trim(subname)//": tcxB", ESMF_LOGMSG_INFO, rc=dbrc) - - write(msgString,*) trim(subname)//' localDECount = ',localDECount - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - write(msgString,*) trim(subname)//' dimCount = ',dimCount - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - write(msgString,*) trim(subname)//' size(gELW) = ',size(gridEdgeLWidth) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - write(msgString,*) trim(subname)//' gridEdgeLWidth = ',gridEdgeLWidth - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - write(msgString,*) trim(subname)//' gridEdgeUWidth = ',gridEdgeUWidth - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_LogWrite(trim(subname)//": tcxC", ESMF_LOGMSG_INFO, rc=dbrc) - - gridnew = ESMF_GridCreate(distgrid=distgrid, coordSys=coordSys, indexflag=indexflag, & - gridEdgeLWidth=gridEdgeLWidth, gridEdgeUWidth=gridEdgeUWidth, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - deallocate(gridEdgeLWidth, gridEdgeUWidth) - - call ESMF_GridAddCoord(gridnew, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_GridAddCoord(gridnew, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - do localDE = 0,localDeCount-1 - - call ESMF_GridGetCoord(gridold, coordDim=1, localDE=localDE, & - staggerLoc=ESMF_STAGGERLOC_CENTER, farrayPtr=dataPtr1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_GridGetCoord(gridnew, coordDim=1, localDE=localDE, & - staggerLoc=ESMF_STAGGERLOC_CENTER, farrayPtr=dataPtr2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dataPtr2 = dataPtr1 - - call ESMF_GridGetCoord(gridold, coordDim=2, localDE=localDE, & - staggerLoc=ESMF_STAGGERLOC_CENTER, farrayPtr=dataPtr1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_GridGetCoord(gridnew, coordDim=2, localDE=localDE, & - staggerLoc=ESMF_STAGGERLOC_CENTER, farrayPtr=dataPtr2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dataPtr2 = dataPtr1 - - call ESMF_GridGetCoord(gridold, coordDim=1, localDE=localDE, & - staggerLoc=ESMF_STAGGERLOC_CORNER, farrayPtr=dataPtr1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_GridGetCoord(gridnew, coordDim=1, localDE=localDE, & - staggerLoc=ESMF_STAGGERLOC_CORNER, farrayPtr=dataPtr2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dataPtr2 = dataPtr1 - - call ESMF_GridGetCoord(gridold, coordDim=2, localDE=localDE, & - staggerLoc=ESMF_STAGGERLOC_CORNER, farrayPtr=dataPtr1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_GridGetCoord(gridnew, coordDim=2, localDE=localDE, & - staggerLoc=ESMF_STAGGERLOC_CORNER, farrayPtr=dataPtr2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dataPtr2 = dataPtr1 - - enddo - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine Grid_CreateCoords - - !----------------------------------------------------------------------------- - - subroutine fieldBundle_initFromFB(FBout, FBin, grid, name, rc) - ! ---------------------------------------------- - ! Create FieldBundle from another FieldBundle. - ! Zero out new FieldBundle - ! If grid is not passed, use grid from FBin - ! ---------------------------------------------- - type(ESMF_FieldBundle), intent(inout) :: FBout - type(ESMF_FieldBundle), intent(in) :: FBin - type(ESMF_Grid) , intent(in), optional :: grid - character(len=*) , intent(in), optional :: name - integer , intent(out) :: rc - - ! local variables - integer :: i,j,n - integer :: fieldCount - character(ESMF_MAXSTR) ,pointer :: fieldNameList(:) - type(ESMF_Field) :: field - type(ESMF_Grid) :: lgrid - character(ESMF_MAXSTR) :: lname - character(len=*),parameter :: subname='(module_MEDIATOR:fieldBundle_initFromFB)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - lname = 'undefined' - if (present(name)) then - lname = trim(name) - endif - - call ESMF_FieldBundleGet(FBin, fieldCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate(fieldNameList(fieldCount)) - call ESMF_FieldBundleGet(FBin, fieldNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (present(grid)) then - call fieldBundle_init(FBout, fieldNameList=fieldNameList, grid=grid, name=trim(lname), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - else - call ESMF_FieldBundleGet(FBin, grid=lgrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call fieldBundle_init(FBout, fieldNameList=fieldNameList, grid=lgrid, name=trim(lname), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - deallocate(fieldNameList) - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine fieldbundle_initFromFB - - !----------------------------------------------------------------------------- - - subroutine fieldBundle_init(FieldBundle, fieldNameList, grid, State, name, rc) - ! ---------------------------------------------- - ! Create FieldBundle from fieldNameList and grid OR - ! from State with State field grids or argument grid - ! ---------------------------------------------- - type(ESMF_FieldBundle), intent(inout) :: FieldBundle - character(len=*) , intent(in), optional :: fieldNameList(:) - type(ESMF_Grid) , intent(in), optional :: grid - type(ESMF_State) , intent(in), optional :: State ! check if fieldnames are there - character(len=*) , intent(in), optional :: name - integer , intent(out) :: rc - - ! local variables - integer :: i,j,n,fieldCount - character(ESMF_MAXSTR) :: lname - character(ESMF_MAXSTR),allocatable :: lfieldNameList(:) - type(ESMF_Field) :: field,lfield - type(ESMF_Grid) :: lgrid - character(len=*),parameter :: subname='(module_MEDIATOR:fieldBundle_init)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - lname = 'undefined' - if (present(name)) then - lname = trim(name) - endif - - !--- check argument consistency - - if (present(fieldNameList)) then - if (.not. present(grid)) then - call ESMF_LogWrite(trim(subname)//": ERROR fieldNameList requires grid", ESMF_LOGMSG_INFO, rc=rc) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - if (present(State)) then - call ESMF_LogWrite(trim(subname)//": ERROR fieldNameList cannot pass State", ESMF_LOGMSG_INFO, rc=rc) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - endif - - FieldBundle = ESMF_FieldBundleCreate(name=trim(lname), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (present(fieldNameList)) then - do n = 1, size(fieldNameList) - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, name=fieldNameList(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldBundleAdd(FieldBundle, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//":add "//trim(fieldNameList(n)), ESMF_LOGMSG_INFO, rc=dbrc) - endif - enddo ! fieldNameList - endif ! present fldnamelist - - if (present(State)) then - call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate(lfieldNameList(fieldCount)) - call ESMF_StateGet(State, itemNameList=lfieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - do n = 1, fieldCount - if (present(grid)) then - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, name=lfieldNameList(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldBundleAdd(FieldBundle, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//":add "//trim(lfieldNameList(n)), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - else - call ESMF_StateGet(State, itemName=trim(lfieldNameList(n)), field=lfield, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldGet(lfield, grid=lgrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - field = ESMF_FieldCreate(lgrid, ESMF_TYPEKIND_R8, name=lfieldNameList(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldBundleAdd(FieldBundle, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//":add "//trim(lfieldNameList(n)), ESMF_LOGMSG_INFO, rc=dbrc) - endif - endif - enddo ! fieldCount - deallocate(lfieldNameList) - endif ! present State - - call fieldBundle_reset(FieldBundle, value=spval_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - end subroutine fieldBundle_init - - !----------------------------------------------------------------------------- - - subroutine fieldBundle_getName(FieldBundle, fieldnum, fieldname, rc) - ! ---------------------------------------------- - ! Destroy fields in FieldBundle and FieldBundle - ! ---------------------------------------------- - type(ESMF_FieldBundle), intent(inout) :: FieldBundle - integer , intent(in) :: fieldnum - character(len=*) , intent(out) :: fieldname - integer , intent(out) :: rc - - ! local variables - integer :: fieldCount - character(ESMF_MAXSTR) ,pointer :: fieldNameList(:) - character(len=*),parameter :: subname='(module_MEDIATOR:fieldBundle_getName)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - fieldname = ' ' - - call ESMF_FieldBundleGet(FieldBundle, fieldCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (fieldnum > fieldCount) then - call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - rc = ESMF_FAILURE - return - endif - - allocate(fieldNameList(fieldCount)) - call ESMF_FieldBundleGet(FieldBundle, fieldNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - fieldname = fieldNameList(fieldnum) - - deallocate(fieldNameList) - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine fieldBundle_getName - - !----------------------------------------------------------------------------- - - subroutine fieldBundle_getFieldN(FieldBundle, fieldnum, field, rc) - ! ---------------------------------------------- - ! Destroy fields in FieldBundle and FieldBundle - ! ---------------------------------------------- - type(ESMF_FieldBundle), intent(inout) :: FieldBundle - integer , intent(in) :: fieldnum - type(ESMF_Field) , intent(inout) :: field - integer , intent(out) :: rc - - ! local variables - character(len=ESMF_MAXSTR) :: name - character(len=*),parameter :: subname='(module_MEDIATOR:fieldBundle_getFieldN)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - call fieldBundle_getName(FieldBundle, fieldnum, name, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_FieldBundleGet(FieldBundle, fieldName=name, field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine fieldBundle_getFieldN - - !----------------------------------------------------------------------------- - - subroutine fieldBundle_getFieldName(FieldBundle, fieldname, field, rc) - ! ---------------------------------------------- - ! Destroy fields in FieldBundle and FieldBundle - ! ---------------------------------------------- - type(ESMF_FieldBundle), intent(inout) :: FieldBundle - character(len=*) , intent(in) :: fieldname - type(ESMF_Field) , intent(inout) :: field - integer , intent(out) :: rc - - ! local variables - character(len=*),parameter :: subname='(module_MEDIATOR:fieldBundle_getFieldName)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - call ESMF_FieldBundleGet(FieldBundle, fieldName=fieldname, field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine fieldBundle_getFieldName - - !----------------------------------------------------------------------------- - - subroutine fieldBundle_clean(FieldBundle, rc) - ! ---------------------------------------------- - ! Destroy fields in FieldBundle and FieldBundle - ! ---------------------------------------------- - type(ESMF_FieldBundle), intent(inout) :: FieldBundle - integer , intent(out) :: rc - - ! local variables - integer :: i,j,n - integer :: fieldCount - character(ESMF_MAXSTR) ,pointer :: fieldNameList(:) - type(ESMF_Field) :: field - character(len=*),parameter :: subname='(module_MEDIATOR:fieldBundle_clean)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - call ESMF_FieldBundleGet(FieldBundle, fieldCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate(fieldNameList(fieldCount)) - call ESMF_FieldBundleGet(FieldBundle, fieldNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - do n = 1, fieldCount - call ESMF_FieldBundleGet(FieldBundle, fieldName=fieldNameList(n), field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldDestroy(field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - enddo - call ESMF_FieldBundleDestroy(FieldBundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - deallocate(fieldNameList) - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine fieldBundle_clean - - !----------------------------------------------------------------------------- - - subroutine fieldBundle_reset(FieldBundle, value, rc) - ! ---------------------------------------------- - ! Set all fields to value in FieldBundle - ! If value is not provided, reset to 0.0 - ! ---------------------------------------------- - type(ESMF_FieldBundle), intent(inout) :: FieldBundle - real(ESMF_KIND_R8) , intent(in), optional :: value - integer , intent(out) :: rc - - ! local variables - integer :: i,j,n - integer :: fieldCount - character(ESMF_MAXSTR) ,pointer :: fieldNameList(:) - real(ESMF_KIND_R8) :: lvalue - real(ESMF_KIND_R8), pointer :: dataPtr(:,:) - character(len=*),parameter :: subname='(module_MEDIATOR:fieldBundle_reset)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - lvalue = czero - if (present(value)) then - lvalue = value - endif - - call ESMF_FieldBundleGet(FieldBundle, fieldCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate(fieldNameList(fieldCount)) - call ESMF_FieldBundleGet(FieldBundle, fieldNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - do n = 1, fieldCount - call FieldBundle_GetFldPtr(FieldBundle, fieldNameList(n), dataPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - do j=lbound(dataPtr,2),ubound(dataPtr,2) - do i=lbound(dataPtr,1),ubound(dataPtr,1) - dataPtr(i,j) = lvalue - enddo - enddo - - enddo - deallocate(fieldNameList) - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine fieldBundle_reset - - !----------------------------------------------------------------------------- - - subroutine FieldBundle_FieldCopy(FBin,fldin,FBout,fldout,rc) - ! ---------------------------------------------- - ! Copy a field in a field bundle to another field in a field bundle - ! ---------------------------------------------- - type(ESMF_FieldBundle), intent(inout) :: FBin - character(len=*) , intent(in) :: fldin - type(ESMF_FieldBundle), intent(inout) :: FBout - character(len=*) , intent(in) :: fldout - integer , intent(out) :: rc - - ! local - real(ESMF_KIND_R8), pointer :: dataPtrIn(:,:) - real(ESMF_KIND_R8), pointer :: dataPtrOut(:,:) - character(len=*),parameter :: subname='(module_MEDIATOR:FieldBundle_FieldCopy)' - - rc = ESMF_SUCCESS - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - if (FieldBundle_FldChk(FBin , trim(fldin) , rc=rc) .and. & - FieldBundle_FldChk(FBout, trim(fldout), rc=rc)) then - - call FieldBundle_GetFldPtr(FBin, trim(fldin), dataPtrIn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(FBout, trim(fldout), dataPtrOut, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (.not.FldPtr_SameCheck(dataPtrIn, dataPtrOut, subname, rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR fname not present with FBin", ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - rc = ESMF_FAILURE - return - endif - - dataPtrOut = dataPtrIn - - else - - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//" field not found: "//trim(fldin)//","//trim(fldout), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - endif - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine FieldBundle_FieldCopy - - !----------------------------------------------------------------------------- - - subroutine Fieldbundle_Regrid(fldlist, FBin, FBout, consfmap, consdmap, bilnrmap, patchmap, & - fcopymap,string, rc) - type(fld_list_type) :: fldlist - type(ESMF_FieldBundle) :: FBin - type(ESMF_FieldBundle) :: FBout - type(ESMF_Routehandle),optional :: consfmap - type(ESMF_Routehandle),optional :: consdmap - type(ESMF_Routehandle),optional :: bilnrmap - type(ESMF_Routehandle),optional :: patchmap - type(ESMF_Routehandle),optional :: fcopymap - character(len=*) ,optional :: string - integer ,optional :: rc - - ! local variables - integer :: n - character(len=64) :: lstring - logical :: okconsf, okconsd, okbilnr, okpatch, okfcopy - character(len=*),parameter :: subname='(module_MEDIATOR:Fieldbundle_Regrid)' - - rc = ESMF_SUCCESS - - if (present(string)) then - lstring = trim(string) - else - lstring = " " - endif - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - if (.not.present(rc)) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": ERROR rc expected", ESMF_LOGMSG_INFO, rc=rc) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - - okconsf = .false. - if (present(consfmap)) then - if (ESMF_RouteHandleIsCreated(consfmap, rc=rc)) okconsf = .true. - endif - - okconsd = .false. - if (present(consdmap)) then - if (ESMF_RouteHandleIsCreated(consdmap, rc=rc)) okconsd = .true. - endif - - okbilnr = .false. - if (present(bilnrmap)) then - if (ESMF_RouteHandleIsCreated(bilnrmap, rc=rc)) okbilnr = .true. - endif - - okpatch = .false. - if (present(patchmap)) then - if (ESMF_RouteHandleIsCreated(patchmap, rc=rc)) okpatch = .true. - endif - - okfcopy = .false. - if (present(fcopymap)) then - if (ESMF_RouteHandleIsCreated(fcopymap, rc=rc)) okfcopy = .true. - endif - - do n = 1,fldlist%num - if (FieldBundle_FldChk(FBin , fldlist%shortname(n), rc=rc) .and. & - FieldBundle_FldChk(FBout, fldlist%shortname(n), rc=rc)) then - - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": map="//trim(fldlist%mapping(n))// & - ": fld="//trim(fldlist%shortname(n)), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - if (fldlist%mapping(n) == 'bilinear') then - if (.not. okbilnr) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": ERROR RH not available for "//trim(fldlist%mapping(n))// & - ": fld="//trim(fldlist%shortname(n)), ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - rc = ESMF_FAILURE - return - endif - call FieldBundle_FieldRegrid(FBin,fldlist%shortname(n), & - FBout,fldlist%shortname(n), & - bilnrmap,rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - elseif (fldlist%mapping(n) == "conservefrac") then - if (.not. okconsf) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": ERROR RH not available for "//trim(fldlist%mapping(n))// & - ": fld="//trim(fldlist%shortname(n)), ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - rc = ESMF_FAILURE - return - endif - call FieldBundle_FieldRegrid(FBin ,fldlist%shortname(n), & - FBout,fldlist%shortname(n), & - consfmap, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - elseif (fldlist%mapping(n) == "conservedst") then - if (.not. okconsd) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": ERROR RH not available for "//trim(fldlist%mapping(n))// & - ": fld="//trim(fldlist%shortname(n)), ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - rc = ESMF_FAILURE - return - endif - call FieldBundle_FieldRegrid(FBin ,fldlist%shortname(n), & - FBout,fldlist%shortname(n), & - consdmap, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - elseif (fldlist%mapping(n) == 'patch') then - if (.not. okpatch) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": ERROR RH not available for "//trim(fldlist%mapping(n))// & - ": fld="//trim(fldlist%shortname(n)), ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - rc = ESMF_FAILURE - return - endif - call FieldBundle_FieldRegrid(FBin ,fldlist%shortname(n), & - FBout,fldlist%shortname(n), & - patchmap,rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - elseif (fldlist%mapping(n) == 'copy') then - !------------------------------------------- - ! copy will not exist for some grid combinations - ! so fall back to conservative frac as a secondary option - !------------------------------------------- - if (.not. okfcopy) then - if (.not. okconsf) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": ERROR RH not available for "//trim(fldlist%mapping(n))// & - ": fld="//trim(fldlist%shortname(n)), ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - rc = ESMF_FAILURE - return - else - call ESMF_LogWrite(trim(subname)//trim(lstring)//": NOTE using conservative instead of copy for"// & - " fld="//trim(fldlist%shortname(n)), ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=dbrc) - call FieldBundle_FieldRegrid(FBin ,fldlist%shortname(n), & - FBout,fldlist%shortname(n), & - consfmap,rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - else - call FieldBundle_FieldRegrid(FBin ,fldlist%shortname(n), & - FBout,fldlist%shortname(n), & - fcopymap,rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - - else - call ESMF_LogWrite(trim(subname)//trim(lstring)//": ERROR unrecognized mapping "//trim(fldlist%mapping(n))// & - ": fld="//trim(fldlist%shortname(n)), ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - rc = ESMF_FAILURE - return - endif - - else - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//" field not found in FB: "//trim(fldlist%shortname(n)), ESMF_LOGMSG_INFO, rc=dbrc) - endif - endif - enddo - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine Fieldbundle_Regrid - - !----------------------------------------------------------------------------- -!BL2017 - - subroutine Fieldbundle_Regrid2(fldlist, FBin, FBout, & - nearestmap,string, rc) - type(fld_list_type) :: fldlist - type(ESMF_FieldBundle) :: FBin - type(ESMF_FieldBundle) :: FBout - type(ESMF_Routehandle),optional :: nearestmap - character(len=*) ,optional :: string - integer ,optional :: rc - - ! local variables - integer :: n - character(len=64) :: lstring - logical :: oknearest - character(len=*),parameter :: subname='(module_MEDIATOR:Fieldbundle_Regrid2)' - - rc = ESMF_SUCCESS - - if (present(string)) then - lstring = trim(string) - else - lstring = " " - endif - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - if (.not.present(rc)) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": ERROR rc expected", ESMF_LOGMSG_INFO, rc=rc) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - - oknearest = .false. - if (present(nearestmap)) then - if (ESMF_RouteHandleIsCreated(nearestmap, rc=rc)) oknearest = .true. - endif - - do n = 1,fldlist%num - if (FieldBundle_FldChk(FBin , fldlist%shortname(n), rc=rc) .and. & - FieldBundle_FldChk(FBout, fldlist%shortname(n), rc=rc)) then - - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//trim(lstring)//": map=neareststod"// & - ": fld="//trim(fldlist%shortname(n)), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - call FieldBundle_FieldRegrid(FBin ,fldlist%shortname(n), & - FBout,fldlist%shortname(n), & - nearestmap,rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - enddo - end subroutine Fieldbundle_Regrid2 -!BL2017 - !----------------------------------------------------------------------------- - - subroutine FieldBundle_FieldRegrid(FBin,fldin,FBout,fldout,RH,rc) - ! ---------------------------------------------- - ! Regrid a field in a field bundle to another field in a field bundle - ! ---------------------------------------------- - type(ESMF_FieldBundle), intent(inout) :: FBin - character(len=*) , intent(in) :: fldin - type(ESMF_FieldBundle), intent(inout) :: FBout - character(len=*) , intent(in) :: fldout - type(ESMF_RouteHandle), intent(inout) :: RH - integer , intent(out) :: rc - - ! local - type(ESMF_Field) :: field1, field2 - character(len=*),parameter :: subname='(module_MEDIATOR:FieldBundle_FieldRegrid)' - - rc = ESMF_SUCCESS - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - if (FieldBundle_FldChk(FBin , trim(fldin) , rc=rc) .and. & - FieldBundle_FldChk(FBout, trim(fldout), rc=rc)) then - - call FieldBundle_GetFieldName(FBin, trim(fldin), field1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFieldName(FBout, trim(fldout), field2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_FieldRegrid(field1, field2, routehandle=RH, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - else - - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//" field not found: "//trim(fldin)//","//trim(fldout), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - endif - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine FieldBundle_FieldRegrid - - !----------------------------------------------------------------------------- - - subroutine FieldBundle_FieldMerge(FBout, fnameout, & - FBinA, fnameA, wgtA, & - FBinB, fnameB, wgtB, & - FBinC, fnameC, wgtC, & - FBinD, fnameD, wgtD, & - FBinE, fnameE, wgtE, rc) - ! ---------------------------------------------- - ! Supports up to a five way merge - ! ---------------------------------------------- - type(ESMF_FieldBundle), intent(inout) :: FBout - character(len=*) , intent(in) :: fnameout - type(ESMF_FieldBundle), intent(in), optional :: FBinA - character(len=*) , intent(in), optional :: fnameA - real(ESMF_KIND_R8) , intent(in), optional, pointer :: wgtA(:,:) - type(ESMF_FieldBundle), intent(in), optional :: FBinB - character(len=*) , intent(in), optional :: fnameB - real(ESMF_KIND_R8) , intent(in), optional, pointer :: wgtB(:,:) - type(ESMF_FieldBundle), intent(in), optional :: FBinC - character(len=*) , intent(in), optional :: fnameC - real(ESMF_KIND_R8) , intent(in), optional, pointer :: wgtC(:,:) - type(ESMF_FieldBundle), intent(in), optional :: FBinD - character(len=*) , intent(in), optional :: fnameD - real(ESMF_KIND_R8) , intent(in), optional, pointer :: wgtD(:,:) - type(ESMF_FieldBundle), intent(in), optional :: FBinE - character(len=*) , intent(in), optional :: fnameE - real(ESMF_KIND_R8) , intent(in), optional, pointer :: wgtE(:,:) - integer , intent(out) :: rc - - ! local variables - real(ESMF_KIND_R8), pointer :: dataOut(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr(:,:) - real(ESMF_KIND_R8), pointer :: wgt(:,:) - character(len=ESMF_MAXSTR) :: fname - integer :: lb1,ub1,lb2,ub2,i,j,n - logical :: wgtfound, FBinfound - character(len=*),parameter :: subname='(module_MEDIATOR:FieldBundle_FieldMerge)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc=ESMF_SUCCESS - - if (.not. FieldBundle_FldChk(FBout, trim(fnameout), rc=rc)) then - call ESMF_LogWrite(trim(subname)//": WARNING output field not in FBout, skipping merge of: "//trim(fnameout), ESMF_LOGMSG_WARNING, line=__LINE__, file=__FILE__, rc=dbrc) - return - endif - call FieldBundle_GetFldPtr(FBout, trim(fnameout), dataOut, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - lb1 = lbound(dataOut,1) - ub1 = ubound(dataOut,1) - lb2 = lbound(dataOut,2) - ub2 = ubound(dataOut,2) - - dataOut = czero - - ! check each field has a fieldname passed in - if ((present(FBinA) .and. .not.present(fnameA)) .or. & - (present(FBinB) .and. .not.present(fnameB)) .or. & - (present(FBinC) .and. .not.present(fnameC)) .or. & - (present(FBinD) .and. .not.present(fnameD)) .or. & - (present(FBinE) .and. .not.present(fnameE))) then - call ESMF_LogWrite(trim(subname)//": ERROR fname not present with FBin", ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - rc = ESMF_FAILURE - return - endif - - ! check that each field passed in actually exists, if not DO NOT do any merge - FBinfound = .true. - if (present(FBinA)) then - fname = fnameA - if (.not. FieldBundle_FldChk(FBinA, trim(fname), rc=rc)) then - FBinfound = .false. - endif - endif - if (present(FBinB)) then - fname = fnameB - if (.not. FieldBundle_FldChk(FBinB, trim(fname), rc=rc)) then - FBinfound = .false. - endif - endif - if (present(FBinC)) then - fname = fnameC - if (.not. FieldBundle_FldChk(FBinC, trim(fname), rc=rc)) then - FBinfound = .false. - endif - endif - if (present(FBinD)) then - fname = fnameD - if (.not. FieldBundle_FldChk(FBinD, trim(fname), rc=rc)) then - FBinfound = .false. - endif - endif - if (present(FBinE)) then - fname = fnameE - if (.not. FieldBundle_FldChk(FBinE, trim(fname), rc=rc)) then - FBinfound = .false. - endif - endif - if (.not. FBinfound) then - call ESMF_LogWrite(trim(subname)//": WARNING field: "//trim(fname)//" :not found in FBin, skipping merge of: "//trim(fnameout), ESMF_LOGMSG_WARNING, line=__LINE__, file=__FILE__, rc=dbrc) - return - endif - - ! n=1,5 represents adding A to E inputs if they exist - do n = 1,5 - FBinfound = .false. - wgtfound = .false. - - if (n == 1 .and. present(FBinA)) then - fname = fnameA - FBinfound = .true. - call FieldBundle_GetFldPtr(FBinA, trim(fname), dataPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (present(wgtA)) then - wgtfound = .true. - wgt => wgtA - endif - - elseif (n == 2 .and. present(FBinB)) then - fname = fnameB - FBinfound = .true. - call FieldBundle_GetFldPtr(FBinB, trim(fname), dataPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (present(wgtB)) then - wgtfound = .true. - wgt => wgtB - endif - - elseif (n == 3 .and. present(FBinC)) then - fname = fnameC - FBinfound = .true. - call FieldBundle_GetFldPtr(FBinC, trim(fname), dataPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (present(wgtC)) then - wgtfound = .true. - wgt => wgtC - endif - - elseif (n == 4 .and. present(FBinD)) then - fname = fnameD - FBinfound = .true. - call FieldBundle_GetFldPtr(FBinD, trim(fname), dataPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (present(wgtD)) then - wgtfound = .true. - wgt => wgtD - endif - - elseif (n == 5 .and. present(FBinE)) then - fname = fnameE - FBinfound = .true. - call FieldBundle_GetFldPtr(FBinE, trim(fname), dataPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (present(wgtE)) then - wgtfound = .true. - wgt => wgtE - endif - - endif - - if (FBinfound) then - if (.not.FldPtr_SameCheck(dataPtr, dataOut, subname, rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR FBin wrong size", ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - rc = ESMF_FAILURE - return - endif - - if (wgtfound) then - if (.not.FldPtr_SameCheck(dataPtr, wgt, subname, rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR wgt wrong size", ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - rc = ESMF_FAILURE - return - endif - do j = lb2,ub2 - do i = lb1,ub1 - dataOut(i,j) = dataOut(i,j) + dataPtr(i,j) * wgt(i,j) - enddo - enddo - else - do j = lb2,ub2 - do i = lb1,ub1 - dataOut(i,j) = dataOut(i,j) + dataPtr(i,j) - enddo - enddo - endif ! wgtfound - - endif ! FBin found - enddo ! n - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine FieldBundle_FieldMerge - - !----------------------------------------------------------------------------- - - subroutine state_reset(State, value, rc) - ! ---------------------------------------------- - ! Set all fields to value in State - ! If value is not provided, reset to 0.0 - ! ---------------------------------------------- - type(ESMF_State) , intent(inout) :: State - real(ESMF_KIND_R8), intent(in), optional :: value - integer , intent(out) :: rc - - ! local variables - integer :: i,j,n - integer :: fieldCount - character(ESMF_MAXSTR) ,pointer :: fieldNameList(:) - real(ESMF_KIND_R8) :: lvalue - real(ESMF_KIND_R8), pointer :: dataPtr(:,:) - character(len=*),parameter :: subname='(module_MEDIATOR:state_reset)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - lvalue = czero - if (present(value)) then - lvalue = value - endif - - call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(State, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - do n = 1, fieldCount - call State_GetFldPtr(State, fieldNameList(n), dataPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - do j=lbound(dataPtr,2),ubound(dataPtr,2) - do i=lbound(dataPtr,1),ubound(dataPtr,1) - dataPtr(i,j) = lvalue - enddo - enddo - - enddo - deallocate(fieldNameList) - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine state_reset - - !----------------------------------------------------------------------------- - - subroutine fieldBundle_average(FieldBundle, count, rc) - ! ---------------------------------------------- - ! Set all fields to zero in FieldBundle - ! ---------------------------------------------- - type(ESMF_FieldBundle), intent(inout) :: FieldBundle - integer , intent(in) :: count - integer , intent(out) :: rc - - ! local variables - integer :: i,j,n - integer :: fieldCount - character(ESMF_MAXSTR) ,pointer :: fieldNameList(:) - real(ESMF_KIND_R8), pointer :: dataPtr(:,:) - character(len=*),parameter :: subname='(module_MEDIATOR:fieldBundle_average)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - if (count == 0) then - - call ESMF_LogWrite(trim(subname)//": WARNING count is 0", ESMF_LOGMSG_INFO, rc=dbrc) -! call ESMF_LogWrite(trim(subname)//": WARNING count is 0 set avg to spval", ESMF_LOGMSG_INFO, rc=dbrc) -! call fieldBundle_reset(FieldBundle, value=spval, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, file=__FILE__)) return ! bail out - - else - - call ESMF_FieldBundleGet(FieldBundle, fieldCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate(fieldNameList(fieldCount)) - call ESMF_FieldBundleGet(FieldBundle, fieldNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - do n = 1, fieldCount - call FieldBundle_GetFldPtr(FieldBundle, fieldNameList(n), dataPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - do j=lbound(dataPtr,2),ubound(dataPtr,2) - do i=lbound(dataPtr,1),ubound(dataPtr,1) - dataPtr(i,j) = dataPtr(i,j) / real(count, ESMF_KIND_R8) - enddo - enddo - enddo - deallocate(fieldNameList) - - endif - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine fieldBundle_average - - !----------------------------------------------------------------------------- - - subroutine fieldBundle_diagnose(FieldBundle, string, rc) - ! ---------------------------------------------- - ! Diagnose status of fieldBundle - ! ---------------------------------------------- - type(ESMF_FieldBundle), intent(inout) :: FieldBundle - character(len=*) , intent(in), optional :: string - integer , intent(out) :: rc - - ! local variables - integer :: i,j,n - integer :: fieldCount - character(ESMF_MAXSTR) ,pointer :: fieldNameList(:) - character(len=64) :: lstring - real(ESMF_KIND_R8), pointer :: dataPtr(:,:) - character(len=*),parameter :: subname='(module_MEDIATOR:fieldBundle_diagnose)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - lstring = '' - if (present(string)) then - lstring = trim(string) - endif - - call ESMF_FieldBundleGet(FieldBundle, fieldCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate(fieldNameList(fieldCount)) - call ESMF_FieldBundleGet(FieldBundle, fieldNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - do n = 1, fieldCount - call FieldBundle_GetFldPtr(FieldBundle, fieldNameList(n), dataPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - write(msgString,'(A,3g14.7)') trim(subname)//' '//trim(lstring)//':'//trim(fieldNameList(n)), & - minval(dataPtr),maxval(dataPtr),sum(dataPtr) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - enddo - deallocate(fieldNameList) - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine fieldBundle_diagnose - - !----------------------------------------------------------------------------- - - subroutine array_diagnose(array, string, rc) - ! ---------------------------------------------- - ! Diagnose status of fieldBundle - ! ---------------------------------------------- - type(ESMF_Array), intent(inout) :: array - character(len=*), intent(in), optional :: string - integer , intent(out) :: rc - - ! local variables - character(len=64) :: lstring - real(ESMF_KIND_R8), pointer :: dataPtr(:,:,:) - character(len=*),parameter :: subname='(module_MEDIATOR:array_diagnose)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - ! this is not working yet, not sure about dataPtr dim/type - return - - lstring = '' - if (present(string)) then - lstring = trim(string) - endif - - call ESMF_ArrayGet(Array, farrayPtr=dataPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - write(msgString,'(A,3g14.7)') trim(subname)//' '//trim(lstring), & - minval(dataPtr),maxval(dataPtr),sum(dataPtr) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine array_diagnose - - !----------------------------------------------------------------------------- - - subroutine state_diagnose(State, string, rc) - ! ---------------------------------------------- - ! Diagnose status of fieldBundle - ! ---------------------------------------------- - type(ESMF_State), intent(inout) :: State - character(len=*), intent(in), optional :: string - integer , intent(out) :: rc - - ! local variables - integer :: i,j,n - integer :: fieldCount - character(ESMF_MAXSTR) ,pointer :: fieldNameList(:) - character(len=64) :: lstring - real(ESMF_KIND_R8), pointer :: dataPtr(:,:) - character(len=*),parameter :: subname='(module_MEDIATOR:state_diagnose)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - lstring = '' - if (present(string)) then - lstring = trim(string) - endif - - call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(State, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - do n = 1, fieldCount - call State_GetFldPtr(State, fieldNameList(n), dataPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - write(msgString,'(A,3g14.7)') trim(subname)//' '//trim(lstring)//':'//trim(fieldNameList(n)), & - minval(dataPtr),maxval(dataPtr),sum(dataPtr) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - enddo - deallocate(fieldNameList) - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine state_diagnose - - !----------------------------------------------------------------------------- - - subroutine fieldBundle_copyFB2FB(FBout, FBin, rc) - ! ---------------------------------------------- - ! Copy common field names from FBin to FBout - ! ---------------------------------------------- - type(ESMF_FieldBundle), intent(inout) :: FBout - type(ESMF_FieldBundle), intent(in) :: FBin - integer , intent(out) :: rc - - character(len=*),parameter :: subname='(module_MEDIATOR:fieldBundle_copyFB2FB)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - call fieldBundle_accum(FBout, FBin, copy=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine fieldBundle_copyFB2FB - - !----------------------------------------------------------------------------- - - subroutine fieldBundle_copyFB2ST(STout, FBin, rc) - ! ---------------------------------------------- - ! Copy common field names from FBin to STout - ! ---------------------------------------------- - type(ESMF_State) , intent(inout) :: STout - type(ESMF_FieldBundle), intent(in) :: FBin - integer , intent(out) :: rc - - character(len=*),parameter :: subname='(module_MEDIATOR:fieldBundle_copyFB2ST)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - call fieldBundle_accum(STout, FBin, copy=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine fieldBundle_copyFB2ST - - !----------------------------------------------------------------------------- - - subroutine fieldBundle_copyST2FB(FBout, STin, rc) - ! ---------------------------------------------- - ! Copy common field names from STin to FBout - ! ---------------------------------------------- - type(ESMF_FieldBundle), intent(inout) :: FBout - type(ESMF_State) , intent(in) :: STin - integer , intent(out) :: rc - - character(len=*),parameter :: subname='(module_MEDIATOR:fieldBundle_copyST2FB)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - call fieldBundle_accum(FBout, STin, copy=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine fieldBundle_copyST2FB - - !----------------------------------------------------------------------------- - - subroutine fieldBundle_accumFB2FB(FBout, FBin, copy, rc) - ! ---------------------------------------------- - ! Accumulate common field names from FBin to FBout - ! If copy is passed in and true, the this is a copy - ! ---------------------------------------------- - type(ESMF_FieldBundle), intent(inout) :: FBout - type(ESMF_FieldBundle), intent(in) :: FBin - logical, optional , intent(in) :: copy - integer , intent(out) :: rc - - ! local variables - integer :: i,j,n - integer :: fieldCount - character(ESMF_MAXSTR) ,pointer :: fieldNameList(:) - logical :: exists - logical :: lcopy - type(ESMF_StateItem_Flag) :: itemType - real(ESMF_KIND_R8), pointer :: dataPtri(:,:), dataPtro(:,:) - character(len=*),parameter :: subname='(module_MEDIATOR:fieldBundle_accumFB2FB)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - lcopy = .false. ! accumulate by default - if (present(copy)) then - lcopy = copy - endif - - call ESMF_FieldBundleGet(FBout, fieldCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate(fieldNameList(fieldCount)) - call ESMF_FieldBundleGet(FBout, fieldNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - do n = 1, fieldCount - call ESMF_FieldBundleGet(FBin, fieldName=fieldNameList(n), isPresent=exists, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (exists) then - call FieldBundle_GetFldPtr(FBin, fieldNameList(n), dataPtri, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(FBout, fieldNameList(n), dataPtro, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (.not.FldPtr_SameCheck(dataPtro, dataPtri, subname, rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr size ", ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=rc) - return - endif - - if (lcopy) then - do j=lbound(dataPtri,2),ubound(dataPtri,2) - do i=lbound(dataPtri,1),ubound(dataPtri,1) - dataPtro(i,j) = dataPtri(i,j) - enddo - enddo - else - do j=lbound(dataPtri,2),ubound(dataPtri,2) - do i=lbound(dataPtri,1),ubound(dataPtri,1) - dataPtro(i,j) = dataPtro(i,j) + dataPtri(i,j) - enddo - enddo - endif - - endif - enddo - - deallocate(fieldNameList) - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine fieldBundle_accumFB2FB - !----------------------------------------------------------------------------- - - subroutine fieldBundle_accumST2FB(FBout, STin, copy, rc) - ! ---------------------------------------------- - ! Accumulate common field names from State to FieldBundle - ! If copy is passed in and true, the this is a copy - ! ---------------------------------------------- - type(ESMF_FieldBundle), intent(inout) :: FBout - type(ESMF_State) , intent(in) :: STin - logical, optional , intent(in) :: copy - integer , intent(out) :: rc - - ! local variables - integer :: i,j,n - integer :: fieldCount - logical :: lcopy - character(ESMF_MAXSTR) ,pointer :: fieldNameList(:) - type(ESMF_StateItem_Flag) :: itemType - real(ESMF_KIND_R8), pointer :: dataPtrS(:,:), dataPtrB(:,:) - character(len=*),parameter :: subname='(module_MEDIATOR:fieldBundle_accumST2FB)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - lcopy = .false. - if (present(copy)) then - lcopy = copy - endif - - call ESMF_FieldBundleGet(FBout, fieldCount=fieldCount, rc=rc) - allocate(fieldNameList(fieldCount)) - call ESMF_FieldBundleGet(FBout, fieldNameList=fieldNameList, rc=rc) - do n = 1, fieldCount - call ESMF_StateGet(STin, itemName=fieldNameList(n), itemType=itemType, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (itemType /= ESMF_STATEITEM_NOTFOUND) then - - call State_GetFldPtr(STin, fieldNameList(n), dataPtrS, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call FieldBundle_GetFldPtr(FBout, fieldNameList(n), dataPtrB, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (.not.FldPtr_SameCheck(dataPtrS, dataPtrB, subname, rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr size ", ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=rc) - return - endif - - if (lcopy) then - do j=lbound(dataPtrB,2),ubound(dataPtrB,2) - do i=lbound(dataPtrB,1),ubound(dataPtrB,1) - dataPtrB(i,j) = dataPtrS(i,j) - enddo - enddo - else - do j=lbound(dataPtrB,2),ubound(dataPtrB,2) - do i=lbound(dataPtrB,1),ubound(dataPtrB,1) - dataPtrB(i,j) = dataPtrB(i,j) + dataPtrS(i,j) - enddo - enddo - endif - - endif ! statefound - enddo ! fieldCount - - deallocate(fieldNameList) - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine fieldBundle_accumST2FB - - !----------------------------------------------------------------------------- - - subroutine fieldBundle_accumFB2ST(STout, FBin, copy, rc) - ! ---------------------------------------------- - ! Accumulate common field names from FieldBundle to State - ! If copy is passed in and true, the this is a copy - ! ---------------------------------------------- - type(ESMF_State) , intent(inout) :: STout - type(ESMF_FieldBundle), intent(in) :: FBin - logical, optional , intent(in) :: copy - integer , intent(out) :: rc - - ! local variables - integer :: i,j,n - integer :: fieldCount - logical :: lcopy - character(ESMF_MAXSTR) ,pointer :: fieldNameList(:) - type(ESMF_StateItem_Flag) :: itemType - real(ESMF_KIND_R8), pointer :: dataPtrS(:,:), dataPtrB(:,:) - character(len=*),parameter :: subname='(module_MEDIATOR:fieldBundle_accumFB2ST)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - lcopy = .false. - if (present(copy)) then - lcopy = copy - endif - - call ESMF_FieldBundleGet(FBin, fieldCount=fieldCount, rc=rc) - allocate(fieldNameList(fieldCount)) - call ESMF_FieldBundleGet(FBin, fieldNameList=fieldNameList, rc=rc) - do n = 1, fieldCount - call ESMF_StateGet(STout, itemName=fieldNameList(n), itemType=itemType, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (itemType /= ESMF_STATEITEM_NOTFOUND) then - - call FieldBundle_GetFldPtr(FBin, fieldNameList(n), dataPtrB, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call State_GetFldPtr(STout, fieldNameList(n), dataPtrS, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (.not.FldPtr_SameCheck(dataPtrS, dataPtrB, subname, rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr size ", ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=rc) - return - endif - - if (lcopy) then - do j=lbound(dataPtrB,2),ubound(dataPtrB,2) - do i=lbound(dataPtrB,1),ubound(dataPtrB,1) - dataPtrS(i,j) = dataPtrB(i,j) - enddo - enddo - else - do j=lbound(dataPtrB,2),ubound(dataPtrB,2) - do i=lbound(dataPtrB,1),ubound(dataPtrB,1) - dataPtrS(i,j) = dataPtrS(i,j) + dataPtrB(i,j) - enddo - enddo - endif - - endif ! statefound - enddo ! fieldCount - - deallocate(fieldNameList) - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine fieldBundle_accumFB2ST - - !----------------------------------------------------------------------------- - - logical function FieldBundle_FldChk(FB, fldname, rc) - type(ESMF_FieldBundle), intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(out) :: rc - - ! local variables - character(len=*),parameter :: subname='(module_MEDIATOR:FieldBundle_FldChk)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - FieldBundle_FldChk = .false. - - call ESMF_FieldBundleGet(FB, fieldName=trim(fldname), isPresent=isPresent, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (isPresent) then - FieldBundle_FldChk = .true. - endif - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end function FieldBundle_FldChk - - !----------------------------------------------------------------------------- - - subroutine FieldBundle_GetFldPtr(FB, fldname, fldptr, rc) - type(ESMF_FieldBundle), intent(in) :: FB - character(len=*) , intent(in) :: fldname - real(ESMF_KIND_R8), pointer, intent(in) :: fldptr(:,:) - integer , intent(out) :: rc - - ! local variables - type(ESMF_Field) :: lfield - character(len=*),parameter :: subname='(module_MEDIATOR:FieldBundle_GetFldPtr)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - if (.not. FieldBundle_FldChk(FB, trim(fldname), rc=rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR field not in FB "//trim(fldname), ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - rc = ESMF_FAILURE - return - endif - - call ESMF_FieldBundleGet(FB, fieldName=trim(fldname), field=lfield, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine FieldBundle_GetFldPtr - - !----------------------------------------------------------------------------- - - subroutine FieldBundle_SetFldPtr(FB, fldname, val, rc) - type(ESMF_FieldBundle), intent(in) :: FB - character(len=*) , intent(in) :: fldname - real(ESMF_KIND_R8) , intent(in) :: val - integer , intent(out) :: rc - - ! local variables - type(ESMF_Field) :: lfield - real(ESMF_KIND_R8), pointer :: fldptr(:,:) - character(len=*),parameter :: subname='(module_MEDIATOR:FieldBundle_SetFldPtr)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - if (.not. FieldBundle_FldChk(FB, trim(fldname), rc=rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR field not in FB "//trim(fldname), ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - rc = ESMF_FAILURE - return - endif - - call ESMF_FieldBundleGet(FB, fieldName=trim(fldname), field=lfield, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - fldptr = val - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine FieldBundle_SetFldPtr - - !----------------------------------------------------------------------------- - - subroutine State_GetFldPtr(ST, fldname, fldptr, rc) - type(ESMF_State), intent(in) :: ST - character(len=*), intent(in) :: fldname - real(ESMF_KIND_R8), pointer, intent(in) :: fldptr(:,:) - integer , intent(out) :: rc - - ! local variables - type(ESMF_Field) :: lfield - character(len=*),parameter :: subname='(module_MEDIATOR:State_GetFldPtr)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=rc) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": fldname ="//trim(fldname), ESMF_LOGMSG_INFO,rc=dbrc) - endif -! call ESMF_StatePrint(ST,rc=dbrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine State_GetFldPtr - - !----------------------------------------------------------------------------- - - subroutine State_SetFldPtr(ST, fldname, val, rc) - type(ESMF_State), intent(in) :: ST - character(len=*), intent(in) :: fldname - real(ESMF_KIND_R8), intent(in) :: val - integer , intent(out) :: rc - - ! local variables - type(ESMF_Field) :: lfield - real(ESMF_KIND_R8), pointer :: fldptr(:,:) - character(len=*),parameter :: subname='(module_MEDIATOR:State_SetFldPtr)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=rc) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": fldname ="//trim(fldname), ESMF_LOGMSG_INFO,rc=dbrc) - endif -! call ESMF_StatePrint(ST,rc=dbrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - fldptr = val - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine State_SetFldPtr - - !----------------------------------------------------------------------------- - - logical function FldPtr_SameCheck(fldptr1, fldptr2, cstring, rc) - real(ESMF_KIND_R8), pointer, intent(in) :: fldptr1(:,:) - real(ESMF_KIND_R8), pointer, intent(in) :: fldptr2(:,:) - character(len=*) , intent(in) :: cstring - integer , intent(out) :: rc - - ! local variables - character(len=*),parameter :: subname='(module_MEDIATOR:FldPtr_SameCheck)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - FldPtr_SameCheck = .false. - if (lbound(fldptr2,2) /= lbound(fldptr1,2) .or. & - lbound(fldptr2,1) /= lbound(fldptr1,1) .or. & - ubound(fldptr2,2) /= ubound(fldptr1,2) .or. & - ubound(fldptr2,1) /= ubound(fldptr1,1)) then - call ESMF_LogWrite(trim(subname)//": ERROR in data size "//trim(cstring), ESMF_LOGMSG_ERROR, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - write(msgString,*) trim(subname)//': fldptr2 ',lbound(fldptr2),ubound(fldptr2) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - write(msgString,*) trim(subname)//': fldptr1 ',lbound(fldptr1),ubound(fldptr1) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - else - FldPtr_SameCheck = .true. - endif - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end function FldPtr_SameCheck - - !----------------------------------------------------------------------------- - - subroutine FldGrid_Print(field, string, rc) - - type(ESMF_Field), intent(in) :: field - character(len=*), intent(in) :: string - integer , intent(out) :: rc - - type(ESMF_Grid) :: grid - real(ESMF_KIND_R8), pointer :: dataPtr(:,:) - character(len=*),parameter :: subname='(module_MEDIATOR:FldGrid_Print)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - call ESMF_FieldGet(field, grid=grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call Grid_Print(grid, string, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_FieldGet(field,farrayPtr=dataptr,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - write (msgString,*) trim(subname)//":"//trim(string)//": dataptr bounds dim=1 ",lbound(dataptr,1),ubound(dataptr,1) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - write (msgString,*) trim(subname)//":"//trim(string)//": dataptr bounds dim=2 ",lbound(dataptr,2),ubound(dataptr,2) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine FldGrid_Print - - !----------------------------------------------------------------------------- - - subroutine Grid_Print(grid, string, rc) - - type(ESMF_Grid) , intent(in) :: grid - character(len=*), intent(in) :: string - integer , intent(out) :: rc - - type(ESMF_Distgrid) :: distgrid - character(ESMF_MAXSTR) :: transferAction - integer :: localDeCount - integer :: dimCount, tileCount - integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) - character(len=*),parameter :: subname='(module_MEDIATOR:Grid_Print)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - ! access localDeCount to show this is a real Grid - call ESMF_GridGet(grid, localDeCount=localDeCount, distgrid=distgrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - write (msgString,*) trim(subname)//":"//trim(string)//": localDeCount=", localDeCount - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! get dimCount and tileCount - call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - write (msgString,*) trim(subname)//":"//trim(string)//": dimCount=", dimCount - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - write (msgString,*) trim(subname)//":"//trim(string)//": tileCount=", tileCount - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! allocate minIndexPTile and maxIndexPTile accord. to dimCount and tileCount - allocate(minIndexPTile(dimCount, tileCount), & - maxIndexPTile(dimCount, tileCount)) - - ! get minIndex and maxIndex arrays - call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & - maxIndexPTile=maxIndexPTile, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - write (msgString,*) trim(subname)//":"//trim(string)//": minIndexPTile=", minIndexPTile - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - write (msgString,*) trim(subname)//":"//trim(string)//": maxIndexPTile=", maxIndexPTile - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - deallocate(minIndexPTile, maxIndexPTile) - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine Grid_Print - -!----------------------------------------------------------------------------- - subroutine ClockTimePrint(clock,string,rc) - - type(ESMF_Clock),intent(in) :: clock - character(len=*),intent(in),optional :: string - integer, intent(out) :: rc - - type(ESMF_Time) :: time - type(ESMF_TimeInterval) :: timeStep - character(len=64) :: timestr - character(len=512) :: lstring - character(len=*),parameter :: subname='(module_MEDIATOR:ClockTimePrint)' - - rc = ESMF_SUCCESS - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - if (present(string)) then - lstring = trim(subname)//":"//trim(string) - else - lstring = trim(subname) - endif - - call ESMF_ClockGet(clock,currtime=time,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_TimeGet(time,timestring=timestr,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(trim(lstring)//": currtime = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_ClockGet(clock,starttime=time,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_TimeGet(time,timestring=timestr,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(trim(lstring)//": startime = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_ClockGet(clock,stoptime=time,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_TimeGet(time,timestring=timestr,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(trim(lstring)//": stoptime = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_ClockGet(clock,timestep=timestep,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_TimeIntervalGet(timestep,timestring=timestr,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(trim(lstring)//": timestep = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine ClockTimePrint - - !----------------------------------------------------------------------------- - - subroutine Grid_Write(grid, string, rc) - type(ESMF_Grid) ,intent(in) :: grid - character(len=*),intent(in) :: string - integer ,intent(out) :: rc - - ! local - type(ESMF_Array) :: array - character(len=*),parameter :: subname='(module_MEDIATOR:Grid_Write)' - - ! -- centers -- - - rc = ESMF_SUCCESS - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - ! -- centers -- - - call ESMF_GridGetCoord(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresent, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (isPresent) then - call ESMF_GridGetCoord(grid, coordDim=1, staggerLoc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_ArraySet(array, name="lon_center", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call Array_diagnose(array,trim(string)//"_grid_coord1", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_ArrayWrite(array, trim(string)//"_grid_coord1.nc", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetCoord(grid, coordDim=2, staggerLoc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_ArraySet(array, name="lat_center", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call Array_diagnose(array,trim(string)//"_grid_coord2", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_ArrayWrite(array, trim(string)//"_grid_coord2.nc", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - endif - - ! -- corners -- - - call ESMF_GridGetCoord(grid, staggerLoc=ESMF_STAGGERLOC_CORNER, isPresent=isPresent, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (isPresent) then - call ESMF_GridGetCoord(grid, coordDim=1, staggerLoc=ESMF_STAGGERLOC_CORNER, array=array, rc=rc) - if (.not. ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call ESMF_ArraySet(array, name="lon_corner", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call Array_diagnose(array,trim(string)//"_grid_corner1", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_ArrayWrite(array, trim(string)//"_grid_corner1.nc", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - endif - call ESMF_GridGetCoord(grid, coordDim=2, staggerLoc=ESMF_STAGGERLOC_CORNER, array=array, rc=rc) - if (.not. ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call ESMF_ArraySet(array, name="lat_corner", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call Array_diagnose(array,trim(string)//"_grid_corner2", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_ArrayWrite(array, trim(string)//"_grid_corner2.nc", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - endif - endif - - - ! -- mask -- - - call ESMF_GridGetItem(grid, itemflag=ESMF_GRIDITEM_MASK, staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresent, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (isPresent) then - call ESMF_GridGetItem(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, itemflag=ESMF_GRIDITEM_MASK, array=array, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_ArraySet(array, name="mask", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call Array_diagnose(array,trim(string)//"_grid_mask", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_ArrayWrite(array, trim(string)//"_grid_mask.nc", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - endif - - ! -- area -- - - call ESMF_GridGetItem(grid, itemflag=ESMF_GRIDITEM_AREA, staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresent, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (isPresent) then - call ESMF_GridGetItem(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, itemflag=ESMF_GRIDITEM_AREA, array=array, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_ArraySet(array, name="area", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call Array_diagnose(array,trim(string)//"_grid_area", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_ArrayWrite(array, trim(string)//"_grid_area.nc", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - endif - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine Grid_Write - - !----------------------------------------------------------------------------- - - subroutine fld_list_add(fldlist, stdname, transferOffer, mapping) - ! ---------------------------------------------- - ! Set up a list of field information - ! ---------------------------------------------- - type(fld_list_type), intent(inout) :: fldlist - character(len=*), intent(in) :: stdname - character(len=*), intent(in) :: transferOffer - character(len=*), intent(in), optional :: mapping - - ! local variables - integer :: cnum ! current size of array - integer :: nnum ! new size of array - integer :: rc - character(len=256), pointer :: tmpString(:) - character(len=*), parameter :: subname='(module_MEDIATOR:fld_list_add)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - ! make sure that stdname is in the NUOPC Field Dictionary - call NUOPC_FieldDictionaryGetEntry(stdname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=trim(subname)//& - ": invalid stdname: "//trim(stdname), & - line=__LINE__, file=__FILE__)) return ! bail out - - ! potentially extend the existing lists - - if (fldlist%num < 0) then - nnum = 10 - fldlist%num = 0 - allocate(fldlist%stdname(nnum)) - allocate(fldlist%shortname(nnum)) - allocate(fldlist%transferOffer(nnum)) - allocate(fldlist%mapping(nnum)) - endif - - cnum = size(fldlist%stdname) - if (fldlist%num > cnum) then - call ESMF_LogWrite(trim(subname)//& - ": ERROR in num for fld "//trim(stdname), ESMF_LOGMSG_ERROR) - return - endif - if (fldlist%num == cnum) then - nnum = cnum + 10 - allocate(tmpString(cnum)) - tmpString(1:cnum) = fldlist%stdname(1:cnum) - deallocate(fldlist%stdname) - allocate(fldlist%stdname(nnum)) - fldlist%stdname(1:cnum) = tmpString(1:cnum) - tmpString(1:cnum) = fldlist%shortname(1:cnum) - deallocate(fldlist%shortname) - allocate(fldlist%shortname(nnum)) - fldlist%shortname(1:cnum) = tmpString(1:cnum) - tmpString(1:cnum) = fldlist%transferOffer(1:cnum) - deallocate(fldlist%transferOffer) - allocate(fldlist%transferOffer(nnum)) - fldlist%transferOffer(1:cnum) = tmpString(1:cnum) - tmpString(1:cnum) = fldlist%mapping(1:cnum) - deallocate(fldlist%mapping) - allocate(fldlist%mapping(nnum)) - fldlist%mapping(1:cnum) = tmpString(1:cnum) - deallocate(tmpString) - endif - - ! fill in the new entry - - fldlist%num = fldlist%num + 1 - fldlist%stdname (fldlist%num) = trim(stdname) - fldlist%shortname (fldlist%num) = trim(stdname) - fldlist%transferOffer (fldlist%num) = trim(transferOffer) - if (present(mapping)) then - if (trim(mapping) /= "conservefrac" .and. trim(mapping) /= 'bilinear' .and. & - trim(mapping) /= 'conservedst' .and. & - trim(mapping) /= 'nearest' .and. & - trim(mapping) /= 'patch' .and. trim(mapping) /= 'copy') then - call ESMF_LogWrite(trim(subname)//": ERROR mapping not allowed "//trim(mapping), ESMF_LOGMSG_ERROR, rc=rc) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - fldlist%mapping (fldlist%num) = trim(mapping) - else - fldlist%mapping (fldlist%num) = 'undefined' - endif - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine fld_list_add - - !----------------------------------------------------------------------------- - - function NEMS_DistGridMatch(distGrid1, distGrid2, rc) - - ! Arguments - type(ESMF_DistGrid), intent(in) :: distGrid1 - type(ESMF_DistGrid), intent(in) :: distGrid2 - integer, intent(out), optional :: rc - - ! Return Value - logical :: NEMS_DistGridMatch - - ! Local Variables - integer :: dimCount1, dimCount2 - integer :: tileCount1, tileCount2 - integer, allocatable :: minIndexPTile1(:,:), minIndexPTile2(:,:) - integer, allocatable :: maxIndexPTile1(:,:), maxIndexPTile2(:,:) - integer, allocatable :: elementCountPTile1(:), elementCountPTile2(:) - CHARACTER(LEN=*), PARAMETER :: SUBNAME='(module_MEDIATOR:NEMS_DistGridMatch)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(SUBNAME//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - if(present(rc)) rc = ESMF_SUCCESS - NEMS_DistGridMatch = .true. - - call ESMF_DistGridGet(distGrid1, & - dimCount=dimCount1, tileCount=tileCount1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - - call ESMF_DistGridGet(distGrid2, & - dimCount=dimCount2, tileCount=tileCount2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - - if ( dimCount1 /= dimCount2) then - NEMS_DistGridMatch = .false. - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": Grid dimCount MISMATCH ", & - ESMF_LOGMSG_INFO, rc=dbrc) - endif - endif - - if ( tileCount1 /= tileCount2) then - NEMS_DistGridMatch = .false. - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": Grid tileCount MISMATCH ", & - ESMF_LOGMSG_INFO, rc=dbrc) - endif - endif - - allocate(elementCountPTile1(tileCount1)) - allocate(elementCountPTile2(tileCount2)) - allocate(minIndexPTile1(dimCount1,tileCount1)) - allocate(minIndexPTile2(dimCount2,tileCount2)) - allocate(maxIndexPTile1(dimCount1,tileCount1)) - allocate(maxIndexPTile2(dimCount2,tileCount2)) - - call ESMF_DistGridGet(distGrid1, & - elementCountPTile=elementCountPTile1, & - minIndexPTile=minIndexPTile1, & - maxIndexPTile=maxIndexPTile1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - - call ESMF_DistGridGet(distGrid2, & - elementCountPTile=elementCountPTile2, & - minIndexPTile=minIndexPTile2, & - maxIndexPTile=maxIndexPTile2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - - if ( ANY((elementCountPTile1 - elementCountPTile2) .NE. 0) ) then - NEMS_DistGridMatch = .false. - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": Grid elementCountPTile MISMATCH ", & - ESMF_LOGMSG_INFO, rc=dbrc) - endif - endif - - if ( ANY((minIndexPTile1 - minIndexPTile2) .NE. 0) ) then - NEMS_DistGridMatch = .false. - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": Grid minIndexPTile MISMATCH ", & - ESMF_LOGMSG_INFO, rc=dbrc) - endif - endif - - if ( ANY((maxIndexPTile1 - maxIndexPTile2) .NE. 0) ) then - NEMS_DistGridMatch = .false. - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": Grid maxIndexPTile MISMATCH ", & - ESMF_LOGMSG_INFO, rc=dbrc) - endif - endif - - deallocate(elementCountPTile1) - deallocate(elementCountPTile2) - deallocate(minIndexPTile1) - deallocate(minIndexPTile2) - deallocate(maxIndexPTile1) - deallocate(maxIndexPTile2) - - ! TODO: Optionally Check Coordinates - - - if (dbug_flag > 10) then - call ESMF_LogWrite(SUBNAME//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end function NEMS_DistGridMatch - - !----------------------------------------------------------------------------- - - subroutine NEMS_GridCopyCoord(gridcomp, gridSrc, gridDst, staggerloc, tolerance, compare, invert, rc) - - ! Arguments - type(ESMF_GridComp),intent(in) :: gridcomp - type(ESMF_Grid), intent(in) :: gridSrc - type(ESMF_Grid), intent(in) :: gridDst - type(ESMF_StaggerLoc),intent(in) :: staggerloc(:) - real, intent(in), optional :: tolerance - logical, intent(in), optional :: compare - integer, intent(in), optional :: invert(:) - integer, intent(out),optional :: rc - - ! Local Variables - real :: l_tolerance - logical :: l_compare - integer, allocatable :: l_invert(:) - integer :: i - type(ESMF_VM) :: vm - type(ESMF_DistGrid) :: distGridSrc, distGridDst - type(ESMF_Array) :: coordArraySrc, coordArrayDst - integer(ESMF_KIND_I4),allocatable :: factorList(:) - integer, allocatable :: factorIndexList(:,:) - type(ESMF_RouteHandle) :: routehandle - integer :: dimCountSrc, dimCountDst - integer :: deCountDst - integer, allocatable :: elementCountPDeDst(:) - integer(ESMF_KIND_I8) :: sumElementCountPDeDst - type(ESMF_TypeKind_Flag) :: coordTypeKindSrc, coordTypeKindDst - type(ESMF_CoordSys_Flag) :: coordSysSrc, coordSysDst - logical :: isPresentSrc, isPresentDst - integer :: dimIndex, staggerlocIndex - integer :: localPet - character(len=10) :: numString - CHARACTER(LEN=*), PARAMETER :: SUBNAME='(module_MEDIATOR:NEMS_GridCopyCoord)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(SUBNAME//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - l_tolerance = 0.0 - if (present(tolerance)) l_tolerance = tolerance - l_compare = .FALSE. - if (present(compare)) l_compare = compare - if (present(invert)) then - allocate(l_invert(size(invert))) - l_invert = invert - else - allocate(l_invert(1)) - l_invert = -1 - endif - - call ESMF_GridGet(gridSrc, distGrid=distGridSrc, & - dimCount=dimCountSrc, coordTypeKind=coordTypeKindSrc, & - coordSys=coordSysSrc, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - - call ESMF_GridGet(gridDst, distGrid=distGridDst, & - dimCount=dimCountDst, coordTypeKind=coordTypeKindDst, & - coordSys=coordSysDst, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - - if (.NOT. NEMS_DistGridMatch(distGrid1=distGridSrc, distGrid2=distGridDst, rc=rc)) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": Unable to redistribute coordinates. DistGrids do not match.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - - if ( dimCountSrc /= dimCountDst) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": DIMCOUNT MISMATCH", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - - if ( coordTypeKindSrc /= coordTypeKindDst) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": COORDTYPEKIND MISMATCH", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - - if ( coordSysSrc /= coordSysDst) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": COORDSYS MISMATCH", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - - do dimIndex=1, dimCountDst - do staggerlocIndex=1, size(staggerloc) - call ESMF_GridGetCoord(gridSrc, staggerloc=staggerloc(staggerlocIndex), & - isPresent=isPresentSrc, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - if(isPresentSrc) then - call ESMF_GridGetCoord(gridSrc, coordDim=dimIndex, & - staggerloc=staggerloc(staggerlocIndex), & - array=coordArraySrc, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - call ESMF_GridGetCoord(gridDst, & - staggerloc=staggerloc(staggerlocIndex), & - isPresent=isPresentDst, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - if(.NOT.isPresentDst) then - call ESMF_GridAddCoord(gridDst, & - staggerLoc=staggerloc(staggerlocIndex), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - else - if(l_compare .EQV. .TRUE.) then - ! TODO: Compare existing coordinates - call ESMF_LogSetError(ESMF_RC_NOT_IMPL, & - msg=SUBNAME//": Cannot compare existing coordinates.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - end if - endif - call ESMF_GridGetCoord(gridDst, coordDim=dimIndex, & - staggerloc=staggerloc(staggerlocIndex), & - array=coordArrayDst, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - call ESMF_ArrayGet(coordArraySrc, distGrid=distGridSrc, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - call ESMF_ArrayGet(coordArrayDst, distGrid=distGridDst, & - dimCount=dimCountDst, deCount=deCountDst, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - if (.NOT. NEMS_DistGridMatch(distGrid1=distGridSrc, distGrid2=distGridDst, rc=rc)) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": Unable to redistribute coordinates. DistGrids do not match.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - - if ( ANY( l_invert == dimIndex )) then - call ESMF_GridCompGet(gridcomp, vm=vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - - call ESMF_VMGet(vm, localPet=localPet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - - if (localPet == 0) then - call ESMF_DistGridGet(distGridDst, deCount=deCountDst, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - - allocate(elementCountPDeDst(deCountDst)) - call ESMF_DistGridGet(distGridDst, & - elementCountPDe=elementCountPDeDst, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - - sumElementCountPDeDst = SUM(elementCountPDeDst) - if (dbug_flag >= 2) then - write (numString, "(I10)") sumElementCountPDeDst - call ESMF_LogWrite(SUBNAME//": sumElementCountPDeDst: "//trim(adjustl(numString)), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - allocate(factorList(sumElementCountPDeDst)) - allocate(factorIndexList(2,sumElementCountPDeDst)) - - factorList(:) = 1 - factorIndexList(1,:) = (/(i, i=1, sumElementCountPDeDst, 1)/) - factorIndexList(2,:) = (/(i, i=sumElementCountPDeDst, 1, -1)/) - - if (dbug_flag >= 2) then - write (numString, "(I10)") factorIndexList(1,1) - write (msgString, "(A)") "Src=>Dst: "//trim(adjustl(numString))//"=>" - write (numString, "(I10)") factorIndexList(2,1) - write (msgString, "(A)") trim(msgString)//trim(adjustl(numString)) - write (numString, "(I10)") factorIndexList(1,sumElementCountPDeDst) - write (msgString, "(A)") trim(msgString)//" "//trim(adjustl(numString))//"=>" - write (numString, "(I10)") factorIndexList(2,sumElementCountPDEDst) - write (msgString, "(A)") trim(msgString)//trim(adjustl(numString)) - call ESMF_LogWrite(SUBNAME//": Invert Mapping: "//msgString, ESMF_LOGMSG_INFO, rc=dbrc) - endif - - call ESMF_ArraySMMStore(srcArray=coordArraySrc, dstArray=coordArrayDst, & - routehandle=routehandle, factorList=factorList, & - factorIndexList=factorIndexList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - deallocate(elementCountPDeDst) - deallocate(factorList) - deallocate(factorIndexList) - else - call ESMF_ArraySMMStore(srcArray=coordArraySrc, dstArray=coordArrayDst, & - routehandle=routehandle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - endif - - call ESMF_ArraySMM(srcArray=coordArraySrc, dstArray=coordArrayDst, & - routehandle=routehandle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - call ESMF_ArraySMMRelease(routehandle=routehandle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - - else - call ESMF_ArrayRedistStore(coordArraySrc, coordArrayDst, routehandle=routehandle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - call ESMF_ArrayRedist(coordArraySrc, coordArrayDst, routehandle=routehandle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - call ESMF_ArrayRedistRelease(routehandle=routehandle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - endif - else - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": SOURCE GRID MISSING STAGGER LOCATION", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - enddo - enddo - - deallocate(l_invert) - - if (dbug_flag > 10) then - call ESMF_LogWrite(SUBNAME//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine NEMS_GridCopyCoord - - !----------------------------------------------------------------------------- - - subroutine NEMS_GridCopyItem(gridcomp, gridSrc, gridDst, item, tolerance, compare, invert, rc) - - ! Arguments - type(ESMF_GridComp),intent(in) :: gridcomp - type(ESMF_Grid), intent(in) :: gridSrc - type(ESMF_Grid), intent(in) :: gridDst - type(ESMF_GridItem_Flag),intent(in) :: item(:) - real, intent(in), optional :: tolerance - logical, intent(in), optional :: compare - integer, intent(in), optional :: invert(:) - integer, intent(out),optional :: rc - - ! Local Variables - real :: l_tolerance - logical :: l_compare - integer, allocatable :: l_invert(:) - type(ESMF_StaggerLoc) :: l_staggerloc - type(ESMF_DistGrid) :: distGridSrc, distGridDst - type(ESMF_Array) :: itemArraySrc, itemArrayDst - type(ESMF_RouteHandle) :: routehandle - integer :: dimCountSrc, dimCountDst - type(ESMF_TypeKind_Flag) :: coordTypeKindSrc, coordTypeKindDst - type(ESMF_CoordSys_Flag) :: coordSysSrc, coordSysDst - logical :: isPresentSrc, isPresentDst - integer :: itemIndex - integer :: localPet - character(len=10) :: numString - CHARACTER(LEN=*), PARAMETER :: SUBNAME='(module_MEDIATOR:NEMS_GridCopyItem)' - - if (dbug_flag > 10) then - call ESMF_LogWrite(SUBNAME//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - l_tolerance = 0.0 - if (present(tolerance)) l_tolerance = tolerance - l_compare = .FALSE. - if (present(compare)) l_compare = compare - if (present(invert)) then - allocate(l_invert(size(invert))) - l_invert = invert - else - allocate(l_invert(1)) - l_invert = -1 - endif - l_staggerloc = ESMF_STAGGERLOC_CENTER - - call ESMF_GridGet(gridSrc, distGrid=distGridSrc, & - dimCount=dimCountSrc, coordTypeKind=coordTypeKindSrc, & - coordSys=coordSysSrc, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - - call ESMF_GridGet(gridDst, distGrid=distGridDst, & - dimCount=dimCountDst, coordTypeKind=coordTypeKindDst, & - coordSys=coordSysDst, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - - if (.NOT. NEMS_DistGridMatch(distGrid1=distGridSrc, distGrid2=distGridDst, rc=rc)) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": Unable to redistribute coordinates. DistGrids do not match.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - - if ( dimCountSrc /= dimCountDst) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": DIMCOUNT MISMATCH", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - - if ( coordTypeKindSrc /= coordTypeKindDst) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": COORDTYPEKIND MISMATCH", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - - if ( coordSysSrc /= coordSysDst) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": COORDSYS MISMATCH", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - - do itemIndex=1, size(item) - call ESMF_GridGetItem(gridSrc, itemflag=item(itemIndex), & - staggerloc=l_staggerloc, isPresent=isPresentSrc, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - if(isPresentSrc) then - call ESMF_GridGetItem(gridSrc, itemflag=item(itemIndex), & - staggerloc=l_staggerloc, array=itemArraySrc, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - call ESMF_GridGetItem(gridDst, itemflag=item(itemIndex), & - staggerloc=l_staggerloc, isPresent=isPresentDst, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - if(.NOT.isPresentDst) then - call ESMF_GridAddItem(gridDst, itemflag=item(itemIndex), & - staggerLoc=l_staggerloc, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - else - if(l_compare .EQV. .TRUE.) then - ! TODO: Compare existing coordinates - call ESMF_LogSetError(ESMF_RC_NOT_IMPL, & - msg=SUBNAME//": Cannot compare existing coordinates.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - end if - endif - call ESMF_GridGetItem(gridDst, itemflag=item(itemIndex), & - staggerloc=l_staggerloc, array=itemArrayDst, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - call ESMF_ArrayGet(itemArraySrc, distGrid=distGridSrc, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - call ESMF_ArrayGet(itemArrayDst, distGrid=distGridDst, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - if (.NOT. NEMS_DistGridMatch(distGrid1=distGridSrc, distGrid2=distGridDst, rc=rc)) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": Unable to redistribute coordinates. DistGrids do not match.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - - if ( ANY( l_invert > 0 )) then - ! TODO: Invert Item - call ESMF_LogSetError(ESMF_RC_NOT_IMPL, & - msg=SUBNAME//": Cannot invert item.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - else - call ESMF_ArrayRedistStore(itemArraySrc, itemArrayDst, routehandle=routehandle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - call ESMF_ArrayRedist(itemArraySrc, itemArrayDst, routehandle=routehandle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - call ESMF_ArrayRedistRelease(routehandle=routehandle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__)) return ! bail out - endif - else - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": SOURCE GRID MISSING ITEM", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - enddo - - deallocate(l_invert) - - if (dbug_flag > 10) then - call ESMF_LogWrite(SUBNAME//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine NEMS_GridCopyItem - - !----------------------------------------------------------------------------- - - subroutine NUOPCplus_UpdateTimestampS(state, time, rc) - type(ESMF_State) :: state - type(ESMF_Time) :: time - integer, intent(out) :: rc - - ! local variables - integer :: i - type(ESMF_Field), pointer :: fieldList(:) - - rc = ESMF_SUCCESS - - nullify(fieldList) - call NUOPC_GetStateMemberLists(state, fieldList=fieldList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - do i=1, size(fieldList) - call NUOPCplus_UpdateTimestamp(fieldList(i), time, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - enddo - - if (associated(fieldList)) deallocate(fieldList) - - end subroutine NUOPCplus_UpdateTimestampS - - !----------------------------------------------------------------------------- - - subroutine NUOPCplus_UpdateTimestampF(field, time, rc) - type(ESMF_Field) :: field - type(ESMF_Time) :: time - integer, intent(out) :: rc - - ! local variables - integer :: yy, mm, dd, h, m, s, ms, us, ns - - rc = ESMF_SUCCESS - - call ESMF_TimeGet(time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, ms=ms, us=us, & - ns=ns, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_AttributeSet(field, & - name="TimeStamp", valueList=(/yy,mm,dd,h,m,s,ms,us,ns/), & - convention="NUOPC", purpose="Instance", & - attnestflag=ESMF_ATTNEST_ON, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine NUOPCplus_UpdateTimestampF - - !----------------------------------------------------------------------------- - -end module diff --git a/src/module_MEDIATOR_SpaceWeather.F90 b/src/module_MEDIATOR_SpaceWeather.F90 deleted file mode 100644 index 23a0471f..00000000 --- a/src/module_MEDIATOR_SpaceWeather.F90 +++ /dev/null @@ -1,1534 +0,0 @@ -#include "./ESMFVersionDefine.h" - -module module_MEDSpaceWeather - - use ESMF - use ESMF_IO_NCPutGetMod - - use NUOPC - use NUOPC_Mediator, & - mediator_routine_SS => SetServices, & - mediator_routine_Run => routine_Run, & - mediator_label_DataInitialize => label_DataInitialize, & - mediator_label_Advance => label_Advance, & - mediator_label_CheckImport => label_CheckImport, & - mediator_label_TimestampExport => label_TimestampExport, & - mediator_label_SetRunClock => label_SetRunClock, & - mediator_label_Finalize => label_Finalize - -#define ESMF_NETCDF -#ifdef ESMF_NETCDF - use netcdf -#endif - - implicit none - - private - - include "mpif.h" - -!#define USE_CART3D_COORDSYS -!#define OUT_WEIGHT - - integer, parameter :: MAXNAMELEN = 128 - - ! private internal state to keep instance data - type InternalStateStruct - integer :: wamdims(3) - real(ESMF_KIND_R8), pointer :: wamhgt(:) - integer :: myrows, startlevel, totallevels - integer :: wamtotalnodes, localnodes - type(ESMF_Mesh):: wam2dMesh, wamMesh, ipeMesh - type(ESMF_RouteHandle) :: routehandle - integer :: PetNo, PetCnt - end type - - type InternalState - type(InternalStateStruct), pointer :: wrap - end type - - public SetServices - - !----------------------------------------------------------------------------- - contains - !----------------------------------------------------------------------------- - - subroutine SetServices(mediator, rc) - type(ESMF_GridComp) :: mediator - integer, intent(out) :: rc - - ! local variables - - rc = ESMF_SUCCESS - - ! the NUOPC model component will register the generic methods - call NUOPC_CompDerive(mediator, mediator_routine_SS, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Provide InitializeP0 to switch from default IPDv00 to IPDv03 - call ESMF_GridCompSetEntryPoint(mediator, ESMF_METHOD_INITIALIZE, & - userRoutine=InitializeP0, phase=0, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! set entry point for methods that require specific implementation - call NUOPC_CompSetEntryPoint(mediator, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeAdvertise, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_CompSetEntryPoint(mediator, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p3"/), userRoutine=InitializeRealize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_CompSetEntryPoint(mediator, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p4"/), userRoutine=InitializeP4, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_CompSetEntryPoint(mediator, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p5"/), userRoutine=InitializeP5, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! attach specializing method(s) - - call NUOPC_CompSpecialize(mediator, specLabel=mediator_label_DataInitialize, & - specRoutine=DataInitialize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call NUOPC_CompSpecialize(mediator, specLabel=mediator_label_Advance, & - specRoutine=MediatorAdvance, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_CompSpecialize(mediator, specLabel=mediator_label_Finalize, & - specRoutine=Finalize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine InitializeP0(mediator, importState, exportState, clock, rc) - type(ESMF_GridComp) :: mediator - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - ! Switch to IPDv03 by filtering all other phaseMap entries - call NUOPC_CompFilterPhaseMap(mediator, ESMF_METHOD_INITIALIZE, & - acceptStringList=(/"IPDv03p"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine - - subroutine InitializeAdvertise(mediator, importState, exportState, clock, rc) - type(ESMF_GridComp) :: mediator - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - ! exportable fields: WAM export fields - call NUOPC_Advertise(importState, StandardNames=(/ & - "northward_wind_neutral ", & - "eastward_wind_neutral ", & - "temp_neutral ", & - "height " & - /), transferOfferGeomObject = "will provide", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! exportable fields: IPE import fields - call NUOPC_Advertise(exportState, StandardNames=(/ & - "northward_wind_neutral ", & - "eastward_wind_neutral ", & -! "upward_wind_neutral ", & - "temp_neutral " & -! "O_Density ", & -! "O2_Density ", & -! "N2_Density " & - /), TransferOfferGeomObject="cannot provide", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine InitializeRealize(mediator, importState, exportState, clock, rc) - type(ESMF_GridComp) :: mediator - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - type(ESMF_Mesh):: wam2dMesh - - rc = ESMF_SUCCESS - - ! calling into Peggy's code - call initGrids(mediator, wam2dMesh, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! create fields - call realizeConnectedFields(importState, wam2dMesh, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - contains - - subroutine realizeConnectedFields(state, mesh, rc) - ! TODO: this method may move into the NUOPC_ utility layer - type(ESMF_State) :: state - type(ESMF_Mesh) :: mesh - integer, intent(out), optional :: rc - - ! local variables - character(len=80), allocatable :: fieldNameList(:) - integer :: i, itemCount, k - type(ESMF_ArraySpec) :: arrayspec - type(ESMF_Field) :: field - integer :: levels - - if (present(rc)) rc = ESMF_SUCCESS - - levels = 150 ! hardcode level, probably should get it from internal state - - call ESMF_StateGet(state, itemCount=itemCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - allocate(fieldNameList(itemCount)) - call ESMF_StateGet(state, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - k=1 ! initialize - do i=1, itemCount - ! create a Field with one undistributed dimension - call ESMF_ArraySpecSet(arrayspec,2,ESMF_TYPEKIND_R8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - field = ESMF_FieldCreate(mesh, arrayspec, & - ungriddedLBound=(/1/), ungriddedUBound=(/levels/), & - name=fieldNameList(i), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! realize the connected Field using the just created Field - call NUOPC_Realize(state, field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - enddo - - end subroutine realizeConnectedFields - - end subroutine initializeRealize - - subroutine InitializeP4(mediator, importState, exportState, clock, rc) - type(ESMF_GridComp) :: mediator - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - type(ESMF_VM) :: vm - type(ESMF_Mesh) :: ipemesh, medmesh - type(ESMF_Field) :: field - character(len=80), allocatable :: fieldNameList(:) - integer :: i, itemCount, k - type(ESMF_DistGrid) :: ipedistgrid, meddistgrid - integer :: minIndices(1,1), maxIndices(1,1) - integer :: decount, PetNo, PetCnt - type(InternalState) :: is - logical :: freeflag - - rc = ESMF_SUCCESS - - ! query component for its internal state - nullify(is%wrap) - call ESMF_GridCompGetInternalState(mediator, is, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - PetNo = is%wrap%PetNo - PetCnt = is%wrap%PetCnt - - ! Get the IPE field from the IPE module, get the elemDistgrid and redistribute in over - ! the number of processors used by the Mediator - - call ESMF_StateGet(exportState, itemCount=itemCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - allocate(fieldNameList(itemCount)) - call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Get the mesh from the first itme - call ESMF_StateGet(exportState, field=field, itemName=fieldNameList(1), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_FieldGet(field, mesh=ipemesh, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_MeshGet(ipemesh, nodalDistgrid=ipedistgrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_DistGridGet(ipedistgrid, deCount=decount, & - minIndexPTile=minIndices, maxIndexPTile=maxIndices, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! If the original distribution (decount) use the same number of - ! PETs (PetCnt), not need to redistribute. Otherwise, redistribute - ! the elementDistgrid to use PetCnt processors - if (PetCnt /= decount) then - ! create a new distgrid evenly distribute the nodes over all the PEs. - meddistgrid = ESMF_DistGridCreate((/minIndices(1,1)/), (/maxIndices(1,1)/), & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - medmesh = ESMF_MeshCreate(meddistgrid, meddistgrid, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_MeshDestroy(ipemesh, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! replace the field with new mesh - k=1 ! initialize - do i=1, itemCount - ! create a Field with one undistributed dimension - call ESMF_StateGet(exportState, field=field, itemName=fieldNameList(i), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldEmptySet(field, medmesh, meshloc=ESMF_MESHLOC_NODE,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - enddo - endif - - end subroutine initializeP4 - - !---------------------------------------------------------------------------- - - subroutine InitializeP5(mediator, importState, exportState, clock, rc) - type(ESMF_GridComp) :: mediator - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! local variables - type(ESMF_VM) :: vm - character(len=80), allocatable :: fieldNameList(:) - integer :: i, itemCount, k - type(ESMF_Field) :: field, wamfield, ipefield - type(ESMF_ArraySpec) :: arrayspec - real(ESMF_KIND_R8) :: starttime, endtime, timesend(1), timereport(1) - type(InternalState) :: is - - rc = ESMF_SUCCESS - - call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! query component for its internal state - nullify(is%wrap) - call ESMF_GridCompGetInternalState(mediator, is, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_StateGet(exportState, itemCount=itemCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - allocate(fieldNameList(itemCount)) - call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - k=1 ! initialize - do i=1, itemCount - ! create a Field with one undistributed dimension - call ESMF_StateGet(exportState, field=field, itemName=fieldNameList(i), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (i==1) then - call ESMF_FieldGet(field, mesh=is%wrap%ipeMesh, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - enddo - - ! Now we have both wammesh and ipemesh, call ESMF_FieldRegridStore() to create - ! a routehandle - ! Create src and dst fields and run RegridStore() - call ESMF_ArraySpecSet(arrayspec, 1, ESMF_TYPEKIND_R8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - wamField = ESMF_FieldCreate(is%wrap%wamMesh, arrayspec, meshloc=ESMF_MESHLOC_NODE,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ipeField = ESMF_FieldCreate(is%wrap%ipeMesh, arrayspec, meshloc=ESMF_MESHLOC_NODE,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - -#if 1 - call ESMF_VMBarrier(vm) - call ESMF_VMWTime(starttime) -#endif - call ESMF_FieldRegridStore(wamField, ipeField, & - unmappedaction =ESMF_UNMAPPEDACTION_IGNORE, & - regridmethod = ESMF_REGRIDMETHOD_BILINEAR, & - polemethod = ESMF_POLEMETHOD_NONE, & - lineType = ESMF_LINETYPE_GREAT_CIRCLE, & - routehandle = is%wrap%routehandle, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - -#if 1 - call ESMF_VMWtime(endtime) - timesend(1)=endtime-starttime - call ESMF_VMReduce(vm, sendData=timesend, recvData=timereport, count=1, & - reduceflag=ESMF_REDUCE_MAX, rootPet=0, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (is%wrap%PetNo==0) then - print *, 'Time to do RegridStore WAM->IPE is ', timereport(1)*1000, 'msec' - endif -#endif - call ESMF_FieldDestroy(wamfield) - call ESMF_FieldDestroy(ipefield) - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine DataInitialize(mediator, rc) - type(ESMF_GridComp) :: mediator - integer, intent(out) :: rc - - ! indicate that data initialization is complete (breaking out of init-loop) - call NUOPC_CompAttributeSet(mediator, & - name="InitializeDataComplete", value="true", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine MediatorAdvance(mediator, rc) - type(ESMF_GridComp) :: mediator - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_State) :: importState, exportState - - rc = ESMF_SUCCESS - - ! query the Component for its clock, importState and exportState - call ESMF_GridCompGet(mediator, clock=clock, importState=importState, & - exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! HERE THE MEDIATOR does the mediation of Fields that come in on the - ! importState with a timestamp consistent to the currTime of the - ! mediators Clock. - - ! The Mediator uses the data on the import Fields to update the data - ! held by Fields in the exportState. - - ! After this routine returns the generic Mediator will correctly - ! timestamp the export Fields and update the Mediator Clock to: - ! - ! currTime -> currTime + timeStep - ! - ! Where the timeStep is equal to the parent timeStep. - - call ESMF_ClockPrint(clock, options="currTime", & - preString="-------->MED Advance() mediating for: ", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! calling into Peggy's code - call RunRegrid(mediator, importstate, exportstate, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_ClockPrint(clock, options="stopTime", & - preString="----------------> model time step to: ", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine - - !----------------------------------------------------------------------------- - !----------------------------------------------------------------------------- - ! Peggy's routines below.... - !----------------------------------------------------------------------------- - !----------------------------------------------------------------------------- - - subroutine initGrids(model, wam2dMesh, rc) - type(ESMF_GridComp) :: model - type(ESMF_MESH) :: wam2dmesh - integer, intent(out) :: rc - - - type(ESMF_VM) :: vm - type(InternalState) :: is - type(ESMF_MESH) :: wammesh - real(ESMF_KIND_R8), pointer :: wamlon(:,:), wamlat(:,:), wamhgt(:) - real(ESMF_KIND_R8), pointer :: ipelon(:,:), ipelat(:,:), ipehgt(:), ipedata(:) - real(ESMF_KIND_R8), pointer :: hgtbuf(:,:,:), varbuf(:,:,:,:) - real(ESMF_KIND_R8), pointer :: databuf(:) - integer(ESMF_KIND_I4), pointer :: maxlevs(:) - integer(ESMF_KIND_I4), pointer :: numPerRow(:), shuffleOrder(:) - integer :: nc1, nc2 - integer :: varid - integer :: ndims, dimids(3) - integer :: wamdims(3), ipedims(3) - integer :: PetNo, PetCnt - integer(ESMF_KIND_I4), pointer :: elementIds(:), elementTypes(:), elementConn(:) - integer(ESMF_KIND_I4), pointer :: nodeIds(:), nodeOwners(:) - real(ESMF_KIND_R8), pointer :: nodeCoords(:) - integer(ESMF_KIND_I4), pointer :: southind(:), northind(:), totallats(:), gap(:) - integer :: minheight, maxheight, halo, neighbor, remind - integer(ESMF_KIND_I4), pointer :: totalheight(:) - real(ESMF_KIND_R8) :: lon, lat, hgt, lon1, lat1, hgt1 - real(ESMF_KIND_R4) :: interval - integer :: i,j, k, l, ii, jj, kk, count1, count3, count8, localcount, countup, save, base, base1 - logical :: even - integer :: start, count, diff, lastlat, totalelements, totalnodes, localnodes, startid - integer :: wamtotalnodes - integer :: elmtcount, increment - integer :: startlevel, next, ind, ind1, totalnodes2d, totallevels, myrows, trigs - integer, pointer :: rowinds(:), petTable(:), baseind(:) - integer(ESMF_KIND_I4), pointer :: elementCnt(:), nodeCnt(:), sendbuf(:), recvbuf(:) - integer(ESMF_KIND_I4), allocatable :: indList(:) - real(ESMF_KIND_R8), pointer :: conntbl(:), globalCoords(:,:), fptr2d(:,:), fptr1d(:) - type(ESMF_Arrayspec) :: arrayspec - type(ESMF_Array) :: array, array1, array2 - real(ESMF_KIND_R8) :: maxerror, minerror, totalerrors, deg2rad - real(ESMF_KIND_R8) :: starttime, endtime, timesend(1), timereport(1) - real(ESMF_KIND_R8) :: differr - real(ESMF_KIND_R8), pointer :: varout(:), lonbuf(:) - real(ESMF_KIND_R8), pointer :: weights(:) - integer(ESMF_KIND_I4), pointer :: indices(:,:) - character(len=MAXNAMELEN) :: wamfilename - integer :: wgtcount(1) - integer, pointer :: allCounts(:), connectbase(:) - real, parameter :: PI=3.1415927 - integer :: j1 - integer :: localrc, status - real, parameter :: earthradius=6371.0 !in kilometers - - ! For output - real(ESMF_KIND_R8), pointer :: lontbl(:), lattbl(:), hgttbl(:) - integer :: lonid, latid, hgtid, vertid, elmtid, nodeid, numid, connid, timeid - integer :: data1id, data2id, wgtid, wamid, ipeid - integer :: globalTotal, globalTotalelmt, nodestartid, totalwgts - type(ESMF_Distgrid) :: nodalDistgrid, distgrid - - rc = ESMF_SUCCESS - - !------------------------------------------------------------------------ - ! get global vm information - ! - call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! set up local pet info - call ESMF_VMGet(vm, localPet=PetNo, petCount=PetCnt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !------------------------------------------------------------------------ - ! Allocate memory for the internal state and set it in the Component. - allocate(is%wrap, stat=rc) - if (ESMF_LogFoundAllocError(statusToCheck=rc, & - msg="Allocation of the internal state memory failed.", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridCompSetInternalState(model, is, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - wamfilename = 'data/wam3dgridnew.nc' - - minheight = 90 - maxheight = 800 - deg2rad = PI/180.0 - -#ifdef ESMF_NETCDF - !!------------------------------------- - !! Create WAM mesh - !!------------------------------------- - ! We need to create a 2D mesh with distgrid only and use it to get the data - ! from the DATAWAM - ! we also need to create the 3D intermediate WAM mesh to be used to regrid - ! with IPE grid - - ! Read in WAM grid from wam3dgrid.nc - !! - status = nf90_open(path= wamfilename, mode=nf90_nowrite, ncid=nc1) - call CheckNCError(status, wamfilename) - status = nf90_inq_varid(nc1,'lons', varid) - call CheckNCError(status, 'lons') - status = nf90_inquire_variable(nc1, varid, ndims=ndims, dimids = dimids) - call CheckNCError(status, 'lons') - status = nf90_inquire_dimension(nc1,dimids(1), len=wamdims(1)) - call CheckNCError(status, 'lons 1st dimension') - status = nf90_inquire_dimension(nc1,dimids(2), len=wamdims(2)) - call CheckNCError(status, 'lons 2nd dimension') - - ! WAM dimension order: lons, lats (192, 94) - allocate(wamlon(wamdims(1), wamdims(2)), & - wamlat(wamdims(1), wamdims(2))) - status = nf90_get_var(nc1, varid, wamlon) - call CheckNCError(status, 'lons') - status = nf90_inq_varid(nc1,'lats', varid) - call CheckNCError(status, 'lats') - status = nf90_get_var(nc1, varid, wamlat) - call CheckNCError(status, 'lats') - - ! intermediate height fields - status = nf90_inq_varid(nc1,'height', varid) - call CheckNCError(status, 'height') - status = nf90_inquire_variable(nc1, varid, ndims=ndims, dimids = dimids) - call CheckNCError(status, 'height') - status = nf90_inquire_dimension(nc1,dimids(1), len=wamdims(3)) - call CheckNCError(status, 'height 1st dimension') - - allocate(wamhgt(wamdims(3))) - status = nf90_get_var(nc1, varid, wamhgt) - call CheckNCError(status, 'height') - allocate(NumPerRow(wamdims(2)), ShuffleOrder(wamdims(2))) - status = nf90_inq_varid(nc1,'NumPerRow', varid) - call CheckNCError(status, 'NumPerRow') - status = nf90_get_var(nc1, varid, NumPerRow) - call CheckNCError(status, 'NumPerRow') - status = nf90_inq_varid(nc1,'ShuffleOrder', varid) - call CheckNCError(status, 'ShuffleOrder') - status = nf90_get_var(nc1, varid, ShuffleOrder) - call CheckNCError(status, 'ShuffleOrder') - status= nf90_close(nc1) - call CheckNCError(status, wamfilename) - - ! Use the shuffle order to create the 2D mesh first - ! find the total number of nodes in each processor and create local index table - localnodes=0 - myrows = wamdims(2)/PetCnt - if ((wamdims(2)-myrows*PetCnt) > PetNo) myrows = myrows+1 - allocate(rowinds(myrows)) !my local row index - allocate(petTable(wamdims(2))) !the owner PET for each row - next = 0 - ind1 = 0 - do i=1,wamdims(2) - ind=ShuffleOrder(i) - petTable(ind)=next - if (next == PetNo) then - ind1=ind1+1 - rowinds(ind1)=ind - localnodes=localnodes + numPerRow(ind) - endif - next=next+1 - if (next == PetCnt) next=0 - enddo - - ! sort rowinds - call ESMF_UtilSort(rowinds, ESMF_SORTFLAG_ASCENDING, rc) - - ! Create a distgrid using a collapsed 1D index array based on the local row index - allocate(indList(localnodes)) - k=1 - do i=1,myrows - ind=rowinds(i) - do j=1,numPerRow(ind) - indList(k)=(ind-1)*wamdims(1)+j - k=k+1 - enddo - enddo - - distgrid = ESMF_DistGridCreate(indList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! Create mesh using the distgrid as the nodaldistgrid, no elemdistgrid available - ! just use nodeldistgrid for both - wam2dmesh = ESMF_MeshCreate(distgrid,distgrid,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Create the 3D mesh with fixed height - ! find the lower height level where height > minheight - do i=1,wamdims(3) - if (wamhgt(i) > minheight) then - startlevel = i-1 - exit - endif - enddo - totallevels = wamdims(3)-startlevel+1 - - ! create the node table, find the total number of nodes in each processor, including the not-owned node - totalnodes=0 - totalelements=0 - allocate(baseind(myrows)) - do i=1,myrows - ind=rowinds(i) - baseind(i)=totalnodes - ! Add the neighbor nodes - ! If PetCnt==1, no need to add neighbor node - ! If last row, no need to add neighbors - ! If the neighbor is local, no need to add - if (ind < wamdims(2)) then - if (PetCnt>1) then - if ((i < myrows .and. rowinds(i+1) /= ind+1) .or. i==myrows) then - totalnodes=totalnodes+numPerRow(ind)+numPerRow(ind+1) - else - totalnodes=totalnodes+numPerRow(ind) - endif - endif - if (numPerRow(ind) >= numPerRow(ind+1)) then - totalelements = totalelements + numPerRow(ind) - else - totalelements = totalelements + numPerRow(ind+1) - endif - else - totalnodes=totalnodes+numPerRow(ind) - !Add extra elements at the top - totalelements = totalelements+numPerRow(ind)-2 - endif - enddo - if (PetCnt == 1) then - baseind(1)=0 - do i=2,wamdims(2) - baseind(i)=baseind(i-1)+numPerRow(i-1) - enddo - endif - - totalnodes2d=totalnodes ! totalnodes includes neighboring nodes and my own nodes - totalnodes = totalnodes * totallevels - localnodes = localnodes * totallevels ! localnodes are locally owned nodes - totalelements = totalelements * (totallevels-1) - allocate(nodeIds(totalnodes), nodeOwners(totalnodes), nodeCoords(totalnodes*3)) - - ! Fill nodeIds, nodeOwners, and nodeCoords arrays, longitude first, latitude, then height - count1=1 - localcount=1 - count3=1 - if (PetCnt > 1) then - do k=1, totallevels - do i=1,myrows - ind=rowinds(i) - do j=1,numPerRow(ind) - ! Global id based on the 3D indices - nodeIds(count1)= j+wamdims(1)*(ind-1)+wamdims(1)*wamdims(2)*(k-1) - nodeOwners(count1)=PetNo - lon = wamlon(j,ind) - lat = wamlat(j,ind) - hgt = wamhgt(startlevel+k-1) - call convert2Cart(lon, lat, hgt, nodeCoords(count3:count3+2)) - count1=count1+1 - localcount=localcount+1 - count3=count3+3 - enddo - ! if not the last row, add the neighbor row's nodes and the neighbor - ! is not local - if (ind < wamdims(2)) then - if (i==myrows .or. (i < myrows .and. rowinds(i+1)/= ind+1)) then - do j=1, numPerRow(ind+1) - ! Global id based on the 3D indices - nodeIds(count1)= j+wamdims(1)*ind+wamdims(1)*wamdims(2)*(k-1) - if (PetTable(ind+1) == PetNo) then - print *, PetNo, 'wrong neighbor ', count1, PetTable(ind+1) - endif - nodeOwners(count1)=PetTable(ind+1) - lon = wamlon(j,ind+1) - lat = wamlat(j,ind+1) - hgt = wamhgt(k+startlevel-1) - call convert2Cart(lon, lat, hgt, nodeCoords(count3:count3+2)) - count1=count1+1 - count3=count3+3 - enddo - endif - endif - enddo - enddo - else ! PetCnt==1 - ! For sequential case, store the rows in its order, do not shuffle - do k=1, totallevels - do ind=1,myrows - do j=1,numPerRow(ind) - ! Global id based on the 3D indices - nodeIds(count1)= j+wamdims(1)*(ind-1)+wamdims(1)*wamdims(2)*(k-1) - nodeOwners(count1)=PetNo - lon = wamlon(j,ind) - lat = wamlat(j,ind) - hgt = wamhgt(k+startlevel-1) - call convert2Cart(lon, lat, hgt, nodeCoords(count3:count3+2)) - count1=count1+1 - localcount=localcount+1 - count3=count3+3 - enddo - enddo - enddo - endif ! PetCnt > 1 - - if (count1-1 /= totalnodes .or. localcount-1 /= localnodes) then - print *, 'totalcount mismatch ', count1-1, totalnodes, localcount-1, localnodes - endif - -#ifdef USE_CART3D_COORDSYS - wamMesh = ESMF_MeshCreate(3,3,coordSys=ESMF_COORDSYS_CART, rc=rc) -#else - wamMesh = ESMF_MeshCreate(3,3,coordSys=ESMF_COORDSYS_SPH_DEG, rc=rc) -#endif - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_MeshAddNodes(wamMesh, nodeIds, nodeCoords, nodeOwners, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - deallocate(wamlon, wamlat) - deallocate(nodeIds, nodeCoords, nodeOwners) - - allocate(elementIds(totalelements), elementTypes(totalelements), & - elementConn(totalelements*8)) - - elementTypes(:)=ESMF_MESHELEMTYPE_HEX - - ! find out the starting global id of the local element - allocate(elementCnt(PetCnt),sendbuf(1)) - sendbuf(1)=totalelements - call ESMF_VMAllGather(vm, sendbuf, elementCnt, 1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! find the starting elementID - startid=0 - do i=1,PetNo - startid=startid+elementCnt(i) - enddo - globaltotalelmt = 0 - do i=1,PetCnt - globaltotalelmt=globaltotalelmt+elementCnt(i) - enddo - deallocate(elementCnt, sendbuf) - - ! Build the local elementConn table using local node indices - ! If PetCnt=1, no shuffle, the rows are in order - count1=1 - count8=1 - do k=1, totallevels-1 - do i=1,myrows - if (PetCnt > 1) then - ind=rowinds(i) - else - ind = i - endif - base = baseind(i)+totalnodes2d*(k-1) - if (ind == wamdims(2)) then -#if 0 - ! create dummy elements by connecting every other nodes to form a triangle to cover the pole - do j=1, numPerRow(ind)-2, 2 - elementIds(count1)=startid+count1 - elementConn(count8)= base+j - elementConn(count8+1)=base+j+1 - elementConn(count8+2)=base+j+2 - elementConn(count8+3)=base+j+2 - elementConn(count8+4)=base+totalnodes2d+j - elementConn(count8+5)=base+totalnodes2d+j+1 - elementConn(count8+6)=base+totalnodes2d+j+2 - elementConn(count8+7)=base+totalnodes2d+j+2 - count1=count1+1 - count8=count8+8 - enddo - ! Last one, connect it back to the first node - elementIds(count1)=startid+count1 - elementConn(count8)= base+j - elementConn(count8+1)=base+j+1 - elementConn(count8+2)=base+1 - elementConn(count8+3)=base+1 - elementConn(count8+4)=base+totalnodes2d+j - elementConn(count8+5)=base+totalnodes2d+j+1 - elementConn(count8+6)=base+totalnodes2d+1 - elementConn(count8+7)=base+totalnodes2d+1 - count1=count1+1 - count8=count8+8 - cycle -#else - ! using the zigzag method to create triangles that covers the pole - ! First half - do j=1, numPerRow(ind)/2-1 - elementIds(count1)=startid+count1 - elementConn(count8)= base+j - elementConn(count8+1)=base+j+1 - elementConn(count8+2)=base+numPerRow(ind)-j - elementConn(count8+3)=base+numPerRow(ind)-j - elementConn(count8+4)=base+totalnodes2d+j - elementConn(count8+5)=base+totalnodes2d+j+1 - elementConn(count8+6)=base+totalnodes2d+numPerRow(ind)-j - elementConn(count8+7)=base+totalnodes2d+j+numPerRow(ind)-j - count1=count1+1 - count8=count8+8 - enddo - ! second half - do j=numPerRow(ind)/2+1, numPerRow(ind)-1 - elementIds(count1)=startid+count1 - elementConn(count8)= base+j - elementConn(count8+1)=base+j+1 - elementConn(count8+2)=base+numPerRow(ind)-j - elementConn(count8+3)=base+numPerRow(ind)-j - elementConn(count8+4)=base+totalnodes2d+j - elementConn(count8+5)=base+totalnodes2d+j+1 - elementConn(count8+6)=base+totalnodes2d+numPerRow(ind)-j - elementConn(count8+7)=base+totalnodes2d+j+numPerRow(ind)-j - count1=count1+1 - count8=count8+8 - enddo - cycle -#endif - endif - ! the two adjacent rows have the same number of points, elements are cubes - if (numPerRow(ind+1) == numPerRow(ind)) then - do j=1,numPerRow(ind)-1 - elementIds(count1)=startid+count1 - elementConn(count8)= base+j - elementConn(count8+1)=base+j+1 - elementConn(count8+2)=base+numPerRow(ind)+j+1 - elementConn(count8+3)=base+numPerRow(ind)+j - elementConn(count8+4)=base+totalnodes2d+j - elementConn(count8+5)=base+totalnodes2d+j+1 - elementConn(count8+6)=base+numPerRow(ind)+totalnodes2d+j+1 - elementConn(count8+7)=base+numPerRow(ind)+totalnodes2d+j - count1=count1+1 - count8=count8+8 - enddo - ! last one in the row, wrap around - elementIds(count1)=startid+count1 - elementConn(count8)= base+j - elementConn(count8+1)=base+1 - elementConn(count8+2)=base+numPerRow(ind)+1 - elementConn(count8+3)=base+numPerRow(ind)+j - elementConn(count8+4)=base+totalnodes2d+j - elementConn(count8+5)=base+totalnodes2d+1 - elementConn(count8+6)=base+numPerRow(ind)+totalnodes2d+1 - elementConn(count8+7)=base+numPerRow(ind)+totalnodes2d+j - count1=count1+1 - count8=count8+8 - else - ! the number of nodes are different, make prism elements - diff=numPerRow(ind)-numPerRow(ind+1) - if (diff > 0) then - ! make triangles with base at lower row - ! triangles will be evenly distributed - interval = real(numPerRow(ind))/(diff+1) - jj=1 - trigs=1 - do j=1,numPerRow(ind)-1 - if (j > trigs*interval) then -! if (mod(j,increment)==0) then - ! triangles - base at bottom - trigs=trigs+1 - elementIds(count1)=startid+count1 - elementConn(count8)= base+j - elementConn(count8+1)=base+j+1 - elementConn(count8+2)=base+numPerRow(ind)+jj - elementConn(count8+3)=base+numPerRow(ind)+jj - elementConn(count8+4)=base+totalnodes2d+j - elementConn(count8+5)=base+totalnodes2d+j+1 - elementConn(count8+6)=base+numPerRow(ind)+totalnodes2d+jj - elementConn(count8+7)=base+numPerRow(ind)+totalnodes2d+jj - else - elementIds(count1)=startid+count1 - elementConn(count8)= base+j - elementConn(count8+1)=base+j+1 - elementConn(count8+2)=base+numPerRow(ind)+jj+1 - elementConn(count8+3)=base+numPerRow(ind)+jj - elementConn(count8+4)=base+totalnodes2d+j - elementConn(count8+5)=base+totalnodes2d+j+1 - elementConn(count8+6)=base+numPerRow(ind)+totalnodes2d+jj+1 - elementConn(count8+7)=base+numPerRow(ind)+totalnodes2d+jj - jj=jj+1 - endif - count1=count1+1 - count8=count8+8 - enddo - ! last one in the row, wrap around - elementIds(count1)=startid+count1 - elementConn(count8)= base+j - elementConn(count8+1)=base+1 - elementConn(count8+2)=base+numPerRow(ind)+1 - elementConn(count8+3)=base+numPerRow(ind)+jj - elementConn(count8+4)=base+totalnodes2d+j - elementConn(count8+5)=base+totalnodes2d+1 - elementConn(count8+6)=base+numPerRow(ind)+totalnodes2d+1 - elementConn(count8+7)=base+numPerRow(ind)+totalnodes2d+jj - count1=count1+1 - count8=count8+8 - if (k==1 .and. (jj /= numPerRow(ind+1))) then - print *, PetNo, 'Upper row index mismatch', ind, jj, numPerRow(ind+1) - endif - else ! diff < 0 - ! make triangles with base at upper row - ! triangles will be evenly distributed - interval = real(numPerRow(ind+1))/(-1*diff+1) - jj=1 - trigs=1 - do j=1,numPerRow(ind+1)-1 - if (j > trigs*interval) then - trigs = trigs+1 - ! triangles - base at bottom - elementIds(count1)=startid+count1 - elementConn(count8)= base+jj - elementConn(count8+1)=base+jj - elementConn(count8+2)=base+numPerRow(ind)+j+1 - elementConn(count8+3)=base+numPerRow(ind)+j - elementConn(count8+4)=base+totalnodes2d+jj - elementConn(count8+5)=base+totalnodes2d+jj - elementConn(count8+6)=base+numPerRow(ind)+totalnodes2d+j+1 - elementConn(count8+7)=base+numPerRow(ind)+totalnodes2d+j - else - elementIds(count1)=startid+count1 - elementConn(count8)= base+jj - elementConn(count8+1)=base+jj+1 - elementConn(count8+2)=base+numPerRow(ind)+j+1 - elementConn(count8+3)=base+numPerRow(ind)+j - elementConn(count8+4)=base+totalnodes2d+jj - elementConn(count8+5)=base+totalnodes2d+jj+1 - elementConn(count8+6)=base+numPerRow(ind)+totalnodes2d+j+1 - elementConn(count8+7)=base+numPerRow(ind)+totalnodes2d+j - jj=jj+1 - endif - count1=count1+1 - count8=count8+8 - enddo - ! last one in the row, wrap around - elementIds(count1)=startid+count1 - elementConn(count8)= base+jj - elementConn(count8+1)=base+1 - elementConn(count8+2)=base+numPerRow(ind)+1 - elementConn(count8+3)=base+numPerRow(ind)+j - elementConn(count8+4)=base+totalnodes2d+jj - elementConn(count8+5)=base+totalnodes2d+1 - elementConn(count8+6)=base+numPerRow(ind)+totalnodes2d+1 - elementConn(count8+7)=base+numPerRow(ind)+totalnodes2d+j - count1=count1+1 - count8=count8+8 - if (k==1 .and. (jj /= numPerRow(ind))) then - print *, PetNo, 'Lower row index mismatch', ind, jj, numPerRow(ind) - endif - endif - endif - enddo - enddo - - if (count1-1 /= totalelements) then - print *, 'total element mismatch ', count1-1, totalelements - endif - - do i=1, totalelements*8 - if (elementConn(i) > totalnodes) then - print *, PetNo, 'node id out of bound', i/8, elementConn(i) - endif - enddo - call ESMF_MeshAddElements(wamMesh, elementIds, elementTypes, elementConn,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - deallocate(NumPerRow, ShuffleOrder, rowinds, petTable) - deallocate(indList, baseind) - deallocate(elementIds, elementTypes, elementConn) - - ! Info passed to the run routine - is%wrap%wamdims = wamdims - is%wrap%wamhgt => wamhgt - is%wrap%startlevel = startlevel - is%wrap%totallevels = totallevels - is%wrap%wamtotalnodes = totalnodes - is%wrap%localnodes = localnodes - is%wrap%wam2dMesh = wam2dMesh - is%wrap%wamMesh = wamMesh - is%wrap%PetNo = PetNo - is%wrap%PetCnt = PetCnt - - return -#else - call ESMF_LogSetError(ESMF_RC_LIB_NOT_PRESENT, & - msg="- ESMF_NETCDF not defined when lib was compiled") - return -#endif - -end subroutine InitGrids - -! Run Routine -subroutine RunRegrid(model, importState, exportState, rc) - type(ESMF_GridComp) :: model - type(ESMF_State) :: importState, exportState - integer, intent(out) :: rc - - type(ESMF_VM) :: vm - type(InternalState) :: is - type(ESMF_RouteHandle) :: routehandle - type(ESMF_Field) :: hgtfield, datafield, ipefield, wamfield - real(ESMF_KIND_R8), pointer :: hgtbuf(:,:), varbuf(:,:) - real(ESMF_KIND_R8), pointer :: databuf(:), dstdata(:), wamhgt(:) - real(ESMF_KIND_R8), pointer :: wamdata(:,:) - integer :: nc1, nc2 - integer :: varid, data2id - integer :: ndims, dimids(3), wamdims(3) - integer :: PetNo, PetCnt - integer :: totalnodes - real(ESMF_KIND_R8), pointer :: fptr2d(:,:), fptr1d(:), fieldarray(:) - type(ESMF_Arrayspec) :: arrayspec - type(ESMF_Array) :: array - type(ESMF_DistGrid) :: distgrid - real(ESMF_KIND_R8) :: maxerror, minerror, totalerrors, deg2rad - real(ESMF_KIND_R8) :: starttime, endtime, timesend(1), timereport(1) - real(ESMF_KIND_R8) :: differr - real(ESMF_KIND_R8), pointer :: varout(:), lonbuf(:) - character(len=80) :: filename - real, parameter :: PI=3.1415927 - integer :: i, ii, j, jj, j1, k, kk, l, count1 - integer :: localrc, status - integer :: itemCount, localnodes, startlevel, totallevels, inlevels - integer :: ubnd(2), lbnd(2) - character(len=80), allocatable :: fieldNameList(:) - integer :: numNodes, numElmts - integer, save :: slice=1 - - rc = ESMF_SUCCESS - - !------------------------------------------------------------------------ - ! get global vm information - ! - ! query component for its internal state - nullify(is%wrap) - call ESMF_GridCompGetInternalState(model, is, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - wamdims=is%wrap%wamdims - wamhgt => is%wrap%wamhgt - PetCnt = is%wrap%PetCnt - PetNo = is%wrap%PetNo - startlevel = is%wrap%startlevel - totallevels = is%wrap%totallevels - - ! Get the data from DATAWAM import fields - ! Do 1D linear interpolation of the variables in the z direction to the fixed height grid first, - - call ESMF_StateGet(importstate, itemCount=itemCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - allocate(fieldNameList(itemCount)) - call ESMF_StateGet(importstate, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_StateGet(importState, itemName="height", & - field=hgtfield, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -#if 0 - if (slice == 2) then - call ESMF_FieldGet(hgtfield, array=array, rc=rc) - call ESMF_ArrayWrite(array, 'wamhgt.nc', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif -#endif - call ESMF_FieldGet(hgtfield, farrayPtr=hgtbuf, computationalLbound=lbnd, & - computationalUbound=ubnd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - inlevels = ubnd(2)-lbnd(2)+1 - -#if 0 - if (slice==2) then - ! write out text file for heights - write(filename, "(A7,I2)") 'height.', PetNo+32 - open(100, file=filename) - write(100, '(8(1X, F6.2))') wamhgt - do i=lbnd(1), ubnd(1) - write(100, '(8(1X, F6.2))') hgtbuf(i,:) - enddo - close(100) - endif -#endif - - do j=1, itemCount - if (fieldNameList(j) .ne. "height") then - call ESMF_StateGet(importstate, itemname=fieldNameList(j), & - field=datafield, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_FieldGet(datafield, farrayPtr=varbuf, computationalLbound=lbnd, & - computationalUbound=ubnd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - localnodes=ubnd(1)-lbnd(1)+1 - totalnodes = localnodes * totallevels - - ! interpolate dataptr(localnodes, inlevels) to wamdata(localnodes, totallevels) - ! alone the second dimension - ! using hgtbuf(localnodes,inlevels) as the source height and wamhgt(totallevels) - ! as the destination heights - ! kk is the source index in 2nd dimension, k is the destination index - ! note hgtbuf has the heigth of the original WAM grid (150), the wamdim(3) is the - ! fixed height WAM grid extended to 800KM, which is > 150 - - if (j==1) allocate(wamdata(localnodes, totallevels)) - ! At the first time step, the values from the importstate are all invalid - if (slice==1) then - wamdata(:,:)=1.0 - else - do i=1,localnodes - kk = 1 ! source ind - do k=startlevel, wamdims(3) - do while (kk<=inlevels .and. hgtbuf(i,kk)inlevels) then - do l=k,wamdims(3) ! use the value as the highest level in the source grid - ! to fill the remaining levels in the destination - wamdata(i,l-startlevel+1)=varbuf(i,kk-1) - enddo - exit - endif - if (kk>1) then - wamdata(i,k-startlevel+1)=(varbuf(i,kk)*(wamhgt(k)-hgtbuf(i,kk-1))+ & - varbuf(i,kk-1)*(hgtbuf(i,kk)-wamhgt(k)))/ & - (hgtbuf(i,kk)-hgtbuf(i,kk-1)) - else - wamdata(i,k-startlevel+1)=varbuf(i,kk) - endif - enddo - enddo - endif - - wamfield=ESMF_FieldCreate(is%wrap%wammesh, reshape(wamdata, (/localnodes*totallevels/)), & - ESMF_INDEX_DELOCAL, datacopyflag=ESMF_DATACOPY_VALUE, meshloc=ESMF_MESHLOC_NODE, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Find the field of the same name in the export state -- that is built on IPE mesh - call ESMF_StateGet(exportstate, itemname=fieldNameList(j), & - field=ipefield, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! Regrid!! - call ESMF_FieldRegrid(wamfield, ipefield, is%wrap%routehandle, & - zeroregion=ESMF_REGION_TOTAL, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldDestroy(wamfield) - endif - enddo - deallocate(wamdata) - - ! advance the time slice counter - slice = slice + 1 - - return - -end subroutine RunRegrid - -!Finalize Routine -subroutine Finalize(model, rc) - type(ESMF_GridComp) :: model - integer, intent(out) :: rc - - type(ESMF_VM) :: vm - type(InternalState) :: is - - ! query component for its internal state - nullify(is%wrap) - call ESMF_GridCompGetInternalState(model, is, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Destroy ESMF objects - call ESMF_MeshDestroy(is%wrap%wam2dmesh) - call ESMF_MeshDestroy(is%wrap%wammesh) - call ESMF_MeshDestroy(is%wrap%ipemesh) - call ESMF_FieldRegridRelease(is%wrap%routehandle) - - ! deallocate - deallocate(is%wrap%wamhgt) - deallocate(is%wrap) - - print *, 'Complete MEDIATOR' -end subroutine Finalize - -subroutine ErrorMsgAndAbort(localPet) - integer :: localPet - - if (localPet >= 0) then - write(*,*) "ERROR: Problem on processor ",localPet,". Please see the PET*.ESMF_LogFile files for a traceback." - else - write(*,*) "ERROR: Please see the PET*.LogFile files for a traceback." - endif - - call ESMF_Finalize(endflag=ESMF_END_ABORT) - -end subroutine ErrorMsgAndAbort - -!------------------------------------------------------------------------------ -! -! check CDF file error code -! -#undef ESMF_METHOD -#define ESMF_METHOD "CheckNCError" -subroutine CheckNCError (ncStatus, errmsg) - - integer, intent(in) :: ncStatus - character(len=*), intent(in) :: errmsg - - integer, parameter :: nf90_noerror = 0 - -#ifdef ESMF_NETCDF - if ( ncStatus .ne. nf90_noerror) then - print '("NetCDF Error: ", A, " : ", A)', & - trim(errmsg),trim(nf90_strerror(ncStatus)) - call ErrorMsgAndAbort(-1) - end if -#else - call ESMF_LogSetError(ESMF_RC_LIB_NOT_PRESENT, & - msg="- ESMF_NETCDF not defined when lib was compiled") - return -#endif - -end subroutine CheckNCError - -!------------------------------------------------------------------------------ -! -! Convert 3D Spherical to 3D Cartisian if USE_CART3D_COORDSYS is set, -! otherwise, just normalize the z field -! -#undef ESMF_METHOD -#define ESMF_METHOD "convet2Cart" -#ifdef USE_CART3D_COORDSYS -subroutine convert2Cart (lon, lat, hgt, coords, rc) - real(ESMF_KIND_R8):: lon, lat, hgt - real(ESMF_KIND_R8):: coords(3) - integer, optional :: rc - - real(ESMF_KIND_R8) :: earthradius, nhgt - integer :: localrc - - if (present(rc)) rc=ESMF_FAILURE - earthradius = 6371.0 - nhgt = 1+hgt/earthradius - - call c_esmc_sphdeg_to_cart(lon, lat, & - coords(1), coords(2), coords(3), & - localrc) - if (localrc /= ESMF_SUCCESS) return - - coords(1)=nhgt*coords(1) - coords(2)=nhgt*coords(2) - coords(3)=nhgt*coords(3) - - if (present(rc)) rc=ESMF_SUCCESS - -end subroutine convert2Cart -#else -subroutine convert2Cart (lon, lat, hgt, coords, rc) - real(ESMF_KIND_R8):: lon, lat, hgt - real(ESMF_KIND_R8):: coords(3) - integer, optional :: rc - - real(ESMF_KIND_R8) :: earthradius, nhgt - integer :: localrc - - if (present(rc)) rc=ESMF_FAILURE - earthradius = 6371.0 - nhgt = 1+hgt/earthradius - - coords(1)=lon - coords(2)=lat - coords(3)=nhgt - - if (present(rc)) rc=ESMF_SUCCESS - -end subroutine convert2Cart -#endif -#undef ESMF_METHOD -#define ESMF_METHOD "convet2Sphdeg" -subroutine convert2Sphdeg (coord1, coord2, coord3, lon, lat, hgt) - real(ESMF_KIND_R8):: coord1, coord2, coord3 - real(ESMF_KIND_R8):: lon, lat, hgt - - real(ESMF_KIND_R8) :: earthradius, nhgt, rad2deg - real, parameter :: PI=3.1415927 - integer :: localrc - - earthradius = 6371.0 - rad2deg = 180.0/PI - nhgt = sqrt(coord1*coord1+coord2*coord2+coord3*coord3) - hgt = (nhgt-1)*earthradius - lon = atan(coord2/coord1)*rad2deg - if (coord1 < 0) lon = lon + 180.0 - if (coord1 > 0 .and. coord2 < 0) lon = 360.0 + lon - lat = 90-acos(coord3/nhgt)*rad2deg - -end subroutine convert2Sphdeg - -end module diff --git a/src/module_MEDIATOR_methods.F90 b/src/module_MEDIATOR_methods.F90 deleted file mode 100644 index 4391e04c..00000000 --- a/src/module_MEDIATOR_methods.F90 +++ /dev/null @@ -1,345 +0,0 @@ -#include "./ESMFVersionDefine.h" - -module module_MEDIATOR_methods - - !----------------------------------------------------------------------------- - ! General MEDIATOR support methods - !----------------------------------------------------------------------------- - - use ESMF - - implicit none - - private - - integer, parameter :: IN = kind(1) - integer, parameter :: R8 = ESMF_KIND_R8 - - real(R8),parameter :: SHR_CONST_G = 9.80616_R8 ! acceleration of gravity ~ m/s^2 - real(R8),parameter :: SHR_CONST_STEBOL = 5.67e-8_R8 ! Stefan-Boltzmann constant ~ W/m^2/K^4 - real(R8),parameter :: SHR_CONST_BOLTZ = 1.38065e-23_R8 ! Boltzmann's constant ~ J/K/molecule - real(R8),parameter :: SHR_CONST_AVOGAD = 6.02214e26_R8 ! Avogadro's number ~ molecules/kmole - real(R8),parameter :: SHR_CONST_RGAS = SHR_CONST_AVOGAD*SHR_CONST_BOLTZ ! Universal gas constant ~ J/K/kmole - real(R8),parameter :: SHR_CONST_MWDAIR = 28.966_R8 ! molecular weight dry air ~ kg/kmole - real(R8),parameter :: SHR_CONST_MWWV = 18.016_R8 ! molecular weight water vapor - real(R8),parameter :: SHR_CONST_RDAIR = SHR_CONST_RGAS/SHR_CONST_MWDAIR ! Dry air gas constant ~ J/K/kg - real(R8),parameter :: SHR_CONST_RWV = SHR_CONST_RGAS/SHR_CONST_MWWV ! Water vapor gas constant ~ J/K/kg - real(R8),parameter :: SHR_CONST_ZVIR = (SHR_CONST_RWV/SHR_CONST_RDAIR)-1.0_R8 ! RWV/RDAIR - 1.0 - real(R8),parameter :: SHR_CONST_KARMAN = 0.4_R8 ! Von Karman constant - real(R8),parameter :: SHR_CONST_CPDAIR = 1.00464e3_R8 ! specific heat of dry air ~ J/kg/K - real(R8),parameter :: SHR_CONST_CPWV = 1.810e3_R8 ! specific heat of water vap ~ J/kg/K - real(R8),parameter :: SHR_CONST_CPVIR = (SHR_CONST_CPWV/SHR_CONST_CPDAIR)-1.0_R8 ! CPWV/CPDAIR - 1.0 - real(R8),parameter :: SHR_CONST_LATICE = 3.337e5_R8 ! latent heat of fusion ~ J/kg - real(R8),parameter :: SHR_CONST_LATVAP = 2.501e6_R8 ! latent heat of evaporation ~ J/kg - real(R8),parameter :: SHR_CONST_LATSUB = & ! latent heat of sublimation ~ J/kg - SHR_CONST_LATICE + SHR_CONST_LATVAP - real(R8),parameter :: SHR_CONST_SPVAL = 1.0e30_R8 ! special missing value - - integer, parameter :: debug = 0 - integer, parameter :: s_loglev = 0 - integer, parameter :: s_logunit = 6 - - public shr_flux_atmOcn - - !----------------------------------------------------------------------------- - contains - !----------------------------------------------------------------------------- - -!=============================================================================== -! !BOP ========================================================================= -! -! !IROUTINE: shr_flux_atmOcn -- internal atm/ocn flux calculation -! -! !DESCRIPTION: -! -! Internal atm/ocn flux calculation -! Provided by CESM September 2015 -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -SUBROUTINE shr_flux_atmOcn(nMax ,zbot ,ubot ,vbot ,thbot , & - & qbot ,rbot ,tbot ,us ,vs , & - & ts ,mask ,sen ,lat ,lwup , & - & evap ,taux ,tauy ,tref ,qref , & - & duu10n, ustar_sv ,re_sv ,ssq_sv, & - & missval ) - -! !USES: - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - - !--- input arguments -------------------------------- - integer(IN),intent(in) :: nMax ! data vector length - integer(IN),intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain - real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) - real(R8) ,intent(in) :: ubot (nMax) ! atm u wind (m/s) - real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) - real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) - real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) - real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) - real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) - 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) - - !--- 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) :: evap (nMax) ! water 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),optional :: ustar_sv(nMax) ! diag: ustar - real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) - real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) - - real(R8),intent(in) ,optional :: missval ! masked value - -! !EOP - - !--- local constants -------------------------------- - real(R8),parameter :: umin = 0.5_R8 ! minimum wind speed (m/s) - real(R8),parameter :: zref = 10.0_R8 ! reference height (m) - real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) - - !--- local variables -------------------------------- - integer(IN) :: n ! vector loop index - real(R8) :: vmag ! surface wind magnitude (m/s) - real(R8) :: thvbot ! virtual temperature (K) - real(R8) :: ssq ! sea surface humidity (kg/kg) - real(R8) :: delt ! potential T difference (K) - real(R8) :: delq ! humidity difference (kg/kg) - real(R8) :: stable ! stability factor - real(R8) :: rdn ! sqrt of neutral exchange coeff (momentum) - real(R8) :: rhn ! sqrt of neutral exchange coeff (heat) - real(R8) :: ren ! sqrt of neutral exchange coeff (water) - real(R8) :: rd ! sqrt of exchange coefficient (momentum) - real(R8) :: rh ! sqrt of exchange coefficient (heat) - real(R8) :: re ! sqrt of exchange coefficient (water) - real(R8) :: ustar ! ustar - real(R8) :: qstar ! qstar - real(R8) :: tstar ! tstar - real(R8) :: hol ! H (at zbot) over L - real(R8) :: xsq ! ? - real(R8) :: xqq ! ? - real(R8) :: psimh ! stability function at zbot (momentum) - real(R8) :: psixh ! stability function at zbot (heat and water) - real(R8) :: psix2 ! stability function at ztref reference height - real(R8) :: alz ! ln(zbot/zref) - real(R8) :: al2 ! ln(zref/ztref) - real(R8) :: u10n ! 10m neutral wind - real(R8) :: tau ! stress at zbot - real(R8) :: cp ! specific heat of moist air - real(R8) :: bn ! exchange coef funct for interpolation - real(R8) :: bh ! exchange coef funct for interpolation - real(R8) :: fac ! vertical interpolation factor - real(R8) :: spval ! local missing value - - !--- local functions -------------------------------- - real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) - real(R8) :: cdn ! function: neutral drag coeff at 10m - real(R8) :: psimhu ! function: unstable part of psimh - real(R8) :: psixhu ! function: unstable part of psimx - real(R8) :: Umps ! dummy arg ~ wind velocity (m/s) - real(R8) :: Tk ! dummy arg ~ temperature (K) - real(R8) :: xd ! dummy arg ~ ? - - qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) - cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps - psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 - psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) - - !--- formats ---------------------------------------- - character(*),parameter :: subName = '(shr_flux_atmOcn) ' - character(*),parameter :: F00 = "('(shr_flux_atmOcn) ',4a)" - -!------------------------------------------------------------------------------- -! PURPOSE: -! computes atm/ocn surface fluxes -! -! NOTES: -! o all fluxes are positive downward -! o net heat flux = net sw + lw up + lw down + sen + lat -! o here, tstar = /U*, and qstar = /U*. -! o wind speeds should all be above a minimum speed (eg. 1.0 m/s) -! -! ASSUMPTIONS: -! o Neutral 10m drag coeff: cdn = .0027/U10 + .000142 + .0000764 U10 -! o Neutral 10m stanton number: ctn = .0327 sqrt(cdn), unstable -! ctn = .0180 sqrt(cdn), stable -! o Neutral 10m dalton number: cen = .0346 sqrt(cdn) -! o The saturation humidity of air at T(K): qsat(T) (kg/m^3) -!------------------------------------------------------------------------------- - - if (debug > 0 .and. s_loglev > 0) write(s_logunit,F00) "enter" - - if (present(missval)) then - spval = missval - else - spval = shr_const_spval - endif - - al2 = log(zref/ztref) - - DO n=1,nMax - if (mask(n) /= 0) then - - !--- compute some needed quantities --- - vmag = max(umin, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) - thvbot = thbot(n) * (1.0_R8 + shr_const_zvir * qbot(n)) ! virtual temp (K) - ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) - delt = thbot(n) - ts(n) ! pot temp diff (K) - delq = qbot(n) - ssq ! spec hum dif (kg/kg) - alz = log(zbot(n)/zref) - cp = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*ssq) - - !------------------------------------------------------------ - ! first estimate of Z/L and ustar, tstar and qstar - !------------------------------------------------------------ - - !--- neutral coefficients, z/L = 0.0 --- - stable = 0.5_R8 + sign(0.5_R8 , delt) - rdn = sqrt(cdn(vmag)) - rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 - ren = 0.0346_R8 - - !--- ustar, tstar, qstar --- - ustar = rdn * vmag - tstar = rhn * delt - qstar = ren * delq - - !--- compute stability & evaluate all stability functions --- - hol = shr_const_karman*shr_const_g*zbot(n)* & - (tstar/thbot(n)+qstar/(1.0_R8/shr_const_zvir+qbot(n)))/ustar**2 - hol = sign( min(abs(hol),10.0_R8), hol ) - stable = 0.5_R8 + sign(0.5_R8 , hol) - xsq = max(sqrt(abs(1.0_R8 - 16.0_R8*hol)) , 1.0_R8) - xqq = sqrt(xsq) - psimh = -5.0_R8*hol*stable + (1.0_R8-stable)*psimhu(xqq) - psixh = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) - - !--- shift wind speed using old coefficient --- - rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) - u10n = vmag * rd / rdn - - !--- update transfer coeffs at 10m and neutral stability --- - rdn = sqrt(cdn(u10n)) - ren = 0.0346_R8 - rhn = (1.0_R8-stable)*0.0327_R8 + stable * 0.018_R8 - - !--- shift all coeffs to measurement height and stability --- - rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) - rh = rhn / (1.0_R8 + rhn/shr_const_karman*(alz-psixh)) - re = ren / (1.0_R8 + ren/shr_const_karman*(alz-psixh)) - - !--- update ustar, tstar, qstar using updated, shifted coeffs -- - ustar = rd * vmag - tstar = rh * delt - qstar = re * delq - - !------------------------------------------------------------ - ! iterate to converge on Z/L, ustar, tstar and qstar - !------------------------------------------------------------ - - !--- compute stability & evaluate all stability functions --- - hol = shr_const_karman*shr_const_g*zbot(n)* & - (tstar/thbot(n)+qstar/(1.0_R8/shr_const_zvir+qbot(n)))/ustar**2 - hol = sign( min(abs(hol),10.0_R8), hol ) - stable = 0.5_R8 + sign(0.5_R8 , hol) - xsq = max(sqrt(abs(1.0_R8 - 16.0_R8*hol)) , 1.0_R8) - xqq = sqrt(xsq) - psimh = -5.0_R8*hol*stable + (1.0_R8-stable)*psimhu(xqq) - psixh = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) - - !--- shift wind speed using old coeffs --- - rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) - u10n = vmag * rd/rdn - - !--- update transfer coeffs at 10m and neutral stability --- - rdn = sqrt(cdn(u10n)) - ren = 0.0346_R8 - rhn = (1.0_R8 - stable)*0.0327_R8 + stable * 0.018_R8 - - !--- shift all coeffs to measurement height and stability --- - rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) - rh = rhn / (1.0_R8 + rhn/shr_const_karman*(alz-psixh)) - re = ren / (1.0_R8 + ren/shr_const_karman*(alz-psixh)) - - !--- update ustar, tstar, qstar using updated, shifted coeffs --- - ustar = rd * vmag - tstar = rh * delt - qstar = re * delq - - !------------------------------------------------------------ - ! compute the fluxes - !------------------------------------------------------------ - - tau = rbot(n) * ustar * ustar - - !--- momentum flux --- - taux(n) = tau * (ubot(n)-us(n)) / vmag - tauy(n) = tau * (vbot(n)-vs(n)) / vmag - - !--- heat flux --- - sen (n) = cp * tau * tstar / ustar - lat (n) = shr_const_latvap * tau * qstar / ustar - lwup(n) = -shr_const_stebol * ts(n)**4 - - !--- water flux --- - evap(n) = lat(n)/shr_const_latvap - - !------------------------------------------------------------ - ! compute diagnositcs: 2m ref T & Q, 10m wind speed squared - !------------------------------------------------------------ - hol = hol*ztref/zbot(n) - xsq = max( 1.0_R8, sqrt(abs(1.0_R8-16.0_R8*hol)) ) - xqq = sqrt(xsq) - psix2 = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) - fac = (rh/shr_const_karman) * (alz + al2 - psixh + psix2 ) - tref(n) = thbot(n) - delt*fac - tref(n) = tref(n) - 0.01_R8*ztref ! pot temp to temp correction - fac = (re/shr_const_karman) * (alz + al2 - psixh + psix2 ) - qref(n) = qbot(n) - delq*fac - - duu10n(n) = u10n*u10n ! 10m wind speed squared - - !------------------------------------------------------------ - ! optional diagnostics, needed for water tracer fluxes (dcn) - !------------------------------------------------------------ - if (present(ustar_sv)) ustar_sv(n) = ustar - if (present(re_sv )) re_sv(n) = re - if (present(ssq_sv )) ssq_sv(n) = ssq - - else - !------------------------------------------------------------ - ! no valid data here -- out of domain - !------------------------------------------------------------ - sen (n) = spval ! sensible heat flux (W/m^2) - lat (n) = spval ! latent heat flux (W/m^2) - lwup (n) = spval ! long-wave upward heat flux (W/m^2) - evap (n) = spval ! evaporative water flux ((kg/s)/m^2) - taux (n) = spval ! x surface stress (N) - tauy (n) = spval ! y surface stress (N) - tref (n) = spval ! 2m reference height temperature (K) - qref (n) = spval ! 2m reference height humidity (kg/kg) - duu10n(n) = spval ! 10m wind speed squared (m/s)^2 - - if (present(ustar_sv)) ustar_sv(n) = spval - if (present(re_sv )) re_sv (n) = spval - if (present(ssq_sv )) ssq_sv (n) = spval - endif - ENDDO - -END subroutine shr_flux_atmOcn - - !----------------------------------------------------------------------------- - -end module From ac9558c3d730bec5cef3684c843f2bac9ccd76c1 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sat, 17 Apr 2021 09:15:39 -0400 Subject: [PATCH 03/12] remove FieldDictionary add and unused components * use fd_nems.yaml for FieldDictionary * remove unused FRONT_COMPONENT and DriverAddComp: * NMMB,GSM,MOM5,CICE5,POM,WRFHYDRO * "S" components, "X" components --- src/module_EARTH_GRID_COMP.F90 | 3507 +------------------------------- 1 file changed, 22 insertions(+), 3485 deletions(-) diff --git a/src/module_EARTH_GRID_COMP.F90 b/src/module_EARTH_GRID_COMP.F90 index 2e5b85c3..e3833585 100644 --- a/src/module_EARTH_GRID_COMP.F90 +++ b/src/module_EARTH_GRID_COMP.F90 @@ -33,9 +33,9 @@ MODULE module_EARTH_GRID_COMP ! | | | ! | | (CICE, etc.) ! | | -! | (MOM5, MOM6, HYCOM, POM, etc.) +! | (MOM6, HYCOM, etc.) ! | -! CORE component (GSM, NMM, FV3, etc.) +! CORE component (FV3, etc.) ! !----------------------------------------------------------------------- ! @@ -50,21 +50,6 @@ MODULE module_EARTH_GRID_COMP Driver_label_Finalize => label_Finalize use NUOPC_Connector, only: conSS => SetServices ! - Handle build time ATM options: -#ifdef FRONT_SATM - use FRONT_SATM, only: SATM_SS => SetServices -#endif -#ifdef FRONT_XATM - use FRONT_XATM, only: XATM_SS => SetServices -#endif -#ifdef FRONT_DATAWAM - use FRONT_DATAWAM, only: DATAWAM_SS=> SetServices -#endif -#ifdef FRONT_GSM - use FRONT_GSM, only: GSM_SS => SetServices -#endif -#ifdef FRONT_NMMB - use FRONT_NMMB, only: NMMB_SS => SetServices -#endif #ifdef FRONT_FV3 use FRONT_FV3, only: FV3_SS => SetServices #endif @@ -72,54 +57,21 @@ MODULE module_EARTH_GRID_COMP use FRONT_DATM, only: DATM_SS => SetServices #endif ! - Handle build time OCN options: -#ifdef FRONT_SOCN - use FRONT_SOCN, only: SOCN_SS => SetServices -#endif -#ifdef FRONT_XOCN - use FRONT_XOCN, only: XOCN_SS => SetServices -#endif #ifdef FRONT_HYCOM use FRONT_HYCOM, only: HYCOM_SS => SetServices #endif -#ifdef FRONT_MOM5 - use FRONT_MOM5, only: MOM5_SS => SetServices -#endif #ifdef FRONT_MOM6 use FRONT_MOM6, only: MOM6_SS => SetServices -#endif -#ifdef FRONT_POM - use FRONT_POM, only: POM_SS => SetServices #endif ! - Handle build time ICE options: -#ifdef FRONT_SICE - use FRONT_SICE, only: SICE_SS => SetServices -#endif -#ifdef FRONT_XICE - use FRONT_XICE, only: XICE_SS => SetServices -#endif -#ifdef FRONT_CICE - use FRONT_CICE, only: CICE_SS => SetServices -#endif #ifdef FRONT_CICE6 use FRONT_CICE6, only: CICE6_SS => SetServices #endif ! - Handle build time WAV options: -#ifdef FRONT_SWAV - use FRONT_SWAV, only: SWAV_SS => SetServices -#endif -#ifdef FRONT_XWAV - use FRONT_XWAV, only: XWAV_SS => SetServices -#endif #ifdef FRONT_WW3 use FRONT_WW3, only: WW3_SS => SetServices #endif ! - Handle build time LND options: -#ifdef FRONT_SLND - use FRONT_SLND, only: SLND_SS => SetServices -#endif -#ifdef FRONT_XLND - use FRONT_XLND, only: XLND_SS => SetServices -#endif #ifdef FRONT_NOAH use FRONT_NOAH, only: NOAH_SS => SetServices #endif @@ -127,38 +79,17 @@ MODULE module_EARTH_GRID_COMP use FRONT_LIS, only: LIS_SS => SetServices #endif ! - Handle build time IPM options: -#ifdef FRONT_SIPM - use FRONT_SIPM, only: SIPM_SS => SetServices -#endif -#ifdef FRONT_XIPM - use FRONT_XIPM, only: XIPM_SS => SetServices -#endif #ifdef FRONT_IPE use FRONT_IPE, only: IPE_SS => SetServices #endif -#ifdef FRONT_DATAIPE - use FRONT_DATAIPE, only: DATAIPE_SS=> SetServices -#endif - ! - Handle build time HYD options: -#ifdef FRONT_SHYD - use FRONT_SHYD, only: SHYD_SS => SetServices -#endif -#ifdef FRONT_XHYD - use FRONT_XHYD, only: XHYD_SS => SetServices -#endif -#ifdef FRONT_WRFHYDRO - use FRONT_WRFHYDRO, only: WRFHYDRO_SS => SetServices -#endif + ! - Handle build time GSDCHEM options: #ifdef FRONT_GSDCHEM use FRONT_GSDCHEM, only: GSDCHEM_SS => SetServices #endif ! - Mediator -#ifdef CMEPS - use MED, only : MED_SS => SetServices -#else - use module_MEDIATOR, only: MED_SS => SetServices +#ifdef FRONT_CMEPS + use MED, only: MED_SS => SetServices #endif - use module_MEDSpaceWeather, only: MEDSW_SS => SetServices USE module_EARTH_INTERNAL_STATE,ONLY: EARTH_INTERNAL_STATE & ,WRAP_EARTH_INTERNAL_STATE @@ -256,7 +187,7 @@ SUBROUTINE EARTH_REGISTER(EARTH_GRID_COMP,RC_REG) call NUOPC_CompSpecialize(EARTH_GRID_COMP, & specLabel=Driver_label_SetRunClock, specRoutine=NUOPC_NoOp, rc=RC_REG) ESMF_ERR_RETURN(RC,RC_REG) -#endif +#endif #if 0 call NUOPC_CompSpecialize(EARTH_GRID_COMP, & specLabel=Driver_label_Finalize, specRoutine=Finalize, & @@ -270,3108 +201,19 @@ SUBROUTINE EARTH_REGISTER(EARTH_GRID_COMP,RC_REG) ESMF_ERR_RETURN(RC,RC_REG) ! create, open, and set the config - config = ESMF_ConfigCreate(rc=RC) - ESMF_ERR_RETURN(RC,RC_REG) - call ESMF_ConfigLoadFile(config, "nems.configure", rc=RC) - ESMF_ERR_RETURN(RC,RC_REG) - call ESMF_GridCompSet(EARTH_GRID_COMP, config=config, rc=RC) - ESMF_ERR_RETURN(RC,RC_REG) - - ! Added the following Field Dictionary block to the EARTH component level - ! in order to prevent different dictionary definitions in the lower - ! components. Doing this here isn't without problems because it - ! potentially makes the components (ATM & OCN) depend on this environment, - ! which lowers their transferability to other coupled systems. However, - ! extending the Field Dictionary is a temporary solution anyway (see the - ! TODO: below), so this isn't going to stay for ever this way. - - ! Extend the NUOPC Field Dictionary to hold required entries. - !TODO: In the long run this section will not be needed when we have - !TODO: absorbed the needed standard names into the default dictionary. - ! -> 20 fields identified as exports by the GSM component -#ifdef CMEPS - call NUOPC_FieldDictionarySetup("fd_nems.yaml", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -#else - if (.not.NUOPC_FieldDictionaryHasEntry( & - "air_density_height_lowest")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="air_density_height_lowest", & - canonicalUnits="kg m-3", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_zonal_moment_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_zonal_moment_flx", & - canonicalUnits="N m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_zonal_moment_flx_atm")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_zonal_moment_flx_atm", & - canonicalUnits="N m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_merid_moment_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_merid_moment_flx", & - canonicalUnits="N m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_merid_moment_flx_atm")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_merid_moment_flx_atm", & - canonicalUnits="N m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_sensi_heat_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_sensi_heat_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_sensi_heat_flx_atm")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_sensi_heat_flx_atm", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_sensi_heat_flx_atm_into_ice")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_sensi_heat_flx_atm_into_ice", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_sensi_heat_flx_atm_into_ocn")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_sensi_heat_flx_atm_into_ocn", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_laten_heat_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_laten_heat_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_laten_heat_flx_atm")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_laten_heat_flx_atm", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_laten_heat_flx_atm_into_ice")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_laten_heat_flx_atm_into_ice", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_laten_heat_flx_atm_into_ocn")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_laten_heat_flx_atm_into_ocn", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_down_lw_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_down_lw_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_down_sw_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_down_sw_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_fprec_rate")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_fprec_rate", & - canonicalUnits="kg s m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_prec_rate")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_prec_rate", & - canonicalUnits="kg s m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_evap_rate")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_evap_rate", & - canonicalUnits="kg s m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_evap_rate_atm_into_ice")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_evap_rate_atm_into_ice", & - canonicalUnits="kg s m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_evap_rate_atm_into_ocn")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_evap_rate_atm_into_ocn", & - canonicalUnits="kg s m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_zonal_moment_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_zonal_moment_flx", & - canonicalUnits="N m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_merid_moment_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_merid_moment_flx", & - canonicalUnits="N m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_sensi_heat_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_sensi_heat_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_laten_heat_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_laten_heat_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_down_lw_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_down_lw_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_down_sw_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_down_sw_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_temp_height2m")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_temp_height2m", & - canonicalUnits="K", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_spec_humid_height2m")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_spec_humid_height2m", & - canonicalUnits="kg kg-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_u_wind_height10m")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_u_wind_height10m", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_v_wind_height10m")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_v_wind_height10m", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_zonal_wind_height10m")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_zonal_wind_height10m", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_merid_wind_height10m")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_merid_wind_height10m", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - !For MOM6 and WW3 variables to match: - if (.not.NUOPC_FieldDictionaryHasEntry( & - "eastward_partitioned_stokes_drift_1")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="eastward_partitioned_stokes_drift_1", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "northward_partitioned_stokes_drift_1")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="northward_partitioned_stokes_drift_1", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "eastward_partitioned_stokes_drift_2")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="eastward_partitioned_stokes_drift_2", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "northward_partitioned_stokes_drift_2")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="northward_partitioned_stokes_drift_2", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "eastward_partitioned_stokes_drift_3")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="eastward_partitioned_stokes_drift_3", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "northward_partitioned_stokes_drift_3")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="northward_partitioned_stokes_drift_3", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - ! end of MOM6 and WW3 variables to match - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_temp_height_surface")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_temp_height_surface", & - canonicalUnits="K", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_pres_height_surface")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_pres_height_surface", & - canonicalUnits="Pa", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_surface_height")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_surface_height", & - canonicalUnits="m", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - ! -> Additional fields identified as needed by MOM5 and others... - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_down_sw_vis_dir_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_down_sw_vis_dir_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_down_sw_vis_dif_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_down_sw_vis_dif_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_down_sw_ir_dir_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_down_sw_ir_dir_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_down_sw_ir_dif_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_down_sw_ir_dif_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_down_sw_vis_dir_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_down_sw_vis_dir_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_down_sw_vis_dif_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_down_sw_vis_dif_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_down_sw_ir_dir_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_down_sw_ir_dir_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_down_sw_ir_dif_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_down_sw_ir_dif_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_net_sw_vis_dir_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_net_sw_vis_dir_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_net_sw_vis_dif_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_net_sw_vis_dif_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_net_sw_ir_dir_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_net_sw_ir_dir_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_net_sw_ir_dif_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_net_sw_ir_dif_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_net_sw_vis_dir_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_net_sw_vis_dir_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_net_sw_vis_dif_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_net_sw_vis_dif_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_net_sw_ir_dir_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_net_sw_ir_dir_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_net_sw_ir_dif_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_net_sw_ir_dif_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_salt_rate")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_salt_rate", & - canonicalUnits="kg psu m-2 s", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_runoff_rate")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_runoff_rate", & - canonicalUnits="kg m-2 s", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_calving_rate")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_calving_rate", & - canonicalUnits="kg m-2 s", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_runoff_heat_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_runoff_heat_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_calving_heat_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_calving_heat_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "ice_fraction")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="ice_fraction", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_sw_pen_to_ocn")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_sw_pen_to_ocn", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_up_lw_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_up_lw_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "openwater_frac_in_atm")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="openwater_frac_in_atm", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mass_of_overlying_sea_ice")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mass_of_overlying_sea_ice", & - canonicalUnits="kg", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "s_surf")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="s_surf", & - canonicalUnits="psu", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "freezing_melting_potential")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="freezing_melting_potential", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - ! following two added for export from MOM6 - if (.not. NUOPC_FieldDictionaryHasEntry( & - "accum_heat_frazil")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="accum_heat_frazil", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_melt_potential")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_melt_potential", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "u_surf")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="u_surf", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "v_surf")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="v_surf", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "sea_lev")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="sea_lev", & - canonicalUnits="m", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "wind_stress_zonal")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="wind_stress_zonal", & - canonicalUnits="N m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "wind_stress_merid")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="wind_stress_merid", & - canonicalUnits="N m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "ocn_current_zonal")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="ocn_current_zonal", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "ocn_current_merid")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="ocn_current_merid", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "ocn_current_idir")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="ocn_current_idir", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "ocn_current_jdir")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="ocn_current_jdir", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "sea_surface_slope_zonal")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="sea_surface_slope_zonal", & - canonicalUnits="m m-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "sea_surface_slope_merid")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="sea_surface_slope_merid", & - canonicalUnits="m m-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "sea_surface_slope_zonal")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="sea_surface_slope_zonal", & - canonicalUnits="m m-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "sea_surface_slope_merid")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="sea_surface_slope_merid", & - canonicalUnits="m m-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "stress_on_air_ice_zonal")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="stress_on_air_ice_zonal", & - canonicalUnits="N m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "stress_on_air_ice_merid")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="stress_on_air_ice_merid", & - canonicalUnits="N m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "stress_on_air_ocn_zonal")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="stress_on_air_ocn_zonal", & - canonicalUnits="N m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "stress_on_air_ocn_merid")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="stress_on_air_ocn_merid", & - canonicalUnits="N m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "stress_on_ocn_ice_zonal")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="stress_on_ocn_ice_zonal", & - canonicalUnits="N m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "stress_on_ocn_ice_merid")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="stress_on_ocn_ice_merid", & - canonicalUnits="N m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "stress_on_ocn_ice_idir")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="stress_on_ocn_ice_idir", & - canonicalUnits="N m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "stress_on_ocn_ice_jdir")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="stress_on_ocn_ice_jdir", & - canonicalUnits="N m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mixed_layer_depth")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mixed_layer_depth", & - canonicalUnits="m", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_net_lw_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_net_lw_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_net_lw_flx_atm")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_net_lw_flx_atm", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_net_sw_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_net_sw_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_up_lw_flx_ice")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_up_lw_flx_ice", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_up_lw_flx_ocn")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_up_lw_flx_ocn", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_net_lw_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_net_lw_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_net_sw_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_net_sw_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_sw_pen_to_ocn_vis_dir_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_sw_pen_to_ocn_vis_dir_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_sw_pen_to_ocn_vis_dif_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_sw_pen_to_ocn_vis_dif_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_sw_pen_to_ocn_ir_dir_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_sw_pen_to_ocn_ir_dir_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_sw_pen_to_ocn_ir_dif_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_sw_pen_to_ocn_ir_dif_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_ir_dir_albedo")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_ir_dir_albedo", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_ir_dif_albedo")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_ir_dif_albedo", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_vis_dir_albedo")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_vis_dir_albedo", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_vis_dif_albedo")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_vis_dif_albedo", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_ocn_ir_dir_albedo")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_ocn_ir_dir_albedo", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_ocn_ir_dif_albedo")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_ocn_ir_dif_albedo", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_ocn_vis_dir_albedo")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_ocn_vis_dir_albedo", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_ocn_vis_dif_albedo")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_ocn_vis_dif_albedo", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_ice_ir_dir_albedo")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_ice_ir_dir_albedo", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_ice_ir_dif_albedo")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_ice_ir_dif_albedo", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_ice_vis_dir_albedo")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_ice_vis_dir_albedo", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_ice_vis_dif_albedo")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_ice_vis_dif_albedo", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_land_sea_mask")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_land_sea_mask", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_temp_height_lowest")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_temp_height_lowest", & - canonicalUnits="K", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_spec_humid_height_lowest")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_spec_humid_height_lowest", & - canonicalUnits="kg kg-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "humidity_2m")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="humidity_2m", & - canonicalUnits="kg kg-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_zonal_wind_height_lowest")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_zonal_wind_height_lowest", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_merid_wind_height_lowest")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_merid_wind_height_lowest", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_pres_height_lowest")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_pres_height_lowest", & - canonicalUnits="Pa", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "inst_height_lowest")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_height_lowest", & - canonicalUnits="m", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "ocean_mask")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="ocean_mask", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "ice_mask")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="ice_mask", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "land_mask")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="land_mask", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - ! special HYCOM exports - if (.not. NUOPC_FieldDictionaryHasEntry( & - "surface_downward_eastward_stress")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="surface_downward_eastward_stress", & - canonicalUnits="Pa", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "surface_downward_northward_stress")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="surface_downward_northward_stress", & - canonicalUnits="Pa", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "wind_speed_height10m")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="wind_speed_height10m", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "wind_speed_squared_10m")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="wind_speed_squared_10m", & - canonicalUnits="m2 s-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "friction_speed")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="friction_speed", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_lat_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_lat_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_sens_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_sens_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "water_flux_into_sea_water")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="water_flux_into_sea_water", & - canonicalUnits="kg m-2 s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "frozen_water_flux_into_sea_water")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="frozen_water_flux_into_sea_water", & - canonicalUnits="kg m-2 s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "surface_temperature")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="surface_temperature", & - canonicalUnits="K", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "air_surface_temperature")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="air_surface_temperature", & - canonicalUnits="K", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "temperature_2m")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="temperature_2m", & - canonicalUnits="K", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "upward_sea_ice_basal_available_heat_flux")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="upward_sea_ice_basal_available_heat_flux", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - ! special HYCOM imports - if (.not. NUOPC_FieldDictionaryHasEntry( & - "sea_ice_area_fraction")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="sea_ice_area_fraction", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "downward_x_stress_at_sea_ice_base")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="downward_x_stress_at_sea_ice_base", & - canonicalUnits="Pa", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "downward_y_stress_at_sea_ice_base")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="downward_y_stress_at_sea_ice_base", & - canonicalUnits="Pa", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "downward_sea_ice_basal_solar_heat_flux")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="downward_sea_ice_basal_solar_heat_flux", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "upward_sea_ice_basal_heat_flux")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="upward_sea_ice_basal_heat_flux", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "downward_sea_ice_basal_salt_flux")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="downward_sea_ice_basal_salt_flux", & - canonicalUnits="kg m-2 s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "downward_sea_ice_basal_water_flux")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="downward_sea_ice_basal_water_flux", & - canonicalUnits="kg m-2 s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "sea_ice_surface_temperature")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="sea_ice_surface_temperature", & - canonicalUnits="K", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "sea_ice_temperature")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="sea_ice_temperature", & - canonicalUnits="K", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "sea_ice_thickness")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="sea_ice_thickness", & - canonicalUnits="m", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "sea_ice_x_velocity")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="sea_ice_x_velocity", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "sea_ice_y_velocity")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="sea_ice_y_velocity", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not. NUOPC_FieldDictionaryHasEntry( & - "net_heat_flx_to_ocn")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="net_heat_flx_to_ocn", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_fresh_water_to_ocean_rate")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_fresh_water_to_ocean_rate", & - canonicalUnits="kg m-2 s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_ice_volume")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_ice_volume", & - canonicalUnits="m", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "mean_snow_volume")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_snow_volume", & - canonicalUnits="m", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - !Mass flux of liquid runoff - if (.not. NUOPC_FieldDictionaryHasEntry( & - "Foxx_rofl")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="Foxx_rofl", & - canonicalUnits="kg m-2 s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - !Mass flux of frozen runoff - if (.not. NUOPC_FieldDictionaryHasEntry( & - "Foxx_rofi")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="Foxx_rofi", & - canonicalUnits="kg m-2 s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - !Ocean surface boundary layer depth - if (.not. NUOPC_FieldDictionaryHasEntry( & - "So_bldepth")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="So_bldepth", & - canonicalUnits="m", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - ! Synonyms for HYCOM fields - call NUOPC_FieldDictionarySetSyno( & - standardNames = (/"surface_downward_eastward_stress",& - "mean_zonal_moment_flx "/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_FieldDictionarySetSyno( & - standardNames = (/"surface_downward_northward_stress",& - "mean_merid_moment_flx "/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_FieldDictionarySetSyno( & - standardNames = (/"mean_lat_flx ",& - "mean_laten_heat_flx"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_FieldDictionarySetSyno( & - standardNames = (/"mean_sens_flx ",& - "mean_sensi_heat_flx"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! DCR - Fields added for Regional Application - ! ATM-OCN-ICE-LND-HYD - ! List of exisitng fields - ! ice_mask, inst_down_lw_flx, inst_down_sw_flx, inst_height_lowest, - ! inst_merid_wind_height_lowest, inst_pres_height_lowest, - ! inst_pres_height_surface, inst_spec_humid_height_lowest, - ! inst_temp_height_lowest, inst_temp_height_surface, - ! inst_zonal_wind_height_lowest, mean_down_lw_flx, mean_down_sw_flx, - ! mean_fprec_rate, mean_laten_heat_flx, mean_net_lw_flx, mean_net_sw_flx, - ! mean_prec_rate, mean_sensi_heat_flx - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "aerodynamic_roughness_length")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="aerodynamic_roughness_length", & - canonicalUnits="m", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "canopy_moisture_storage")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="canopy_moisture_storage", & - canonicalUnits="kg m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "carbon_dioxide")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="carbon_dioxide", & - canonicalUnits="ppmv", & ! Units must be clarified - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "cosine_zenith_angle")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="cosine_zenith_angle", & - canonicalUnits="degree", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "exchange_coefficient_heat")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="exchange_coefficient_heat", & - canonicalUnits="W m-2 K-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "exchange_coefficient_heat_height2m")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="exchange_coefficient_heat_height2m", & - canonicalUnits="W m-2 K-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "exchange_coefficient_moisture_height2m")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="exchange_coefficient_moisture_height2m", & - canonicalUnits="kg m-2 s-1 Pa-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_wind_speed_height_lowest")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_wind_speed_height_lowest", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_cprec_rate")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_cprec_rate", & - canonicalUnits="kg m-2 s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_grnd_sensi_heat_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_grnd_sensi_heat_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_laten_heat_flx_kinematic")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_laten_heat_flx_kinematic", & - canonicalUnits="Kg m-2 s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_surface_albedo")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_surface_albedo", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_surface_skin_temp")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_surface_skin_temp", & - canonicalUnits="K", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mixing_ratio_surface")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mixing_ratio_surface", & - canonicalUnits="kg kg-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "root_moisture")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="root_moisture", & - canonicalUnits="kg m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "saturated_mixing_ratio")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="saturated_mixing_ratio", & - canonicalUnits="kg kg-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "surface_snow_area_fraction")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="surface_snow_area_fraction", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "surface_snow_thickness")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="surface_snow_thickness", & - canonicalUnits="m", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "surface_snow_melt_flux")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="surface_snow_melt_flux", & - canonicalUnits="kg m-2 s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "liquid_water_content_of_surface_snow")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="liquid_water_content_of_surface_snow", & - canonicalUnits="kg m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "soil_depth")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="soil_depth", & - canonicalUnits="m", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "soil_hydraulic_conductivity_at_saturation")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="soil_hydraulic_conductivity_at_saturation", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "moisture_content_of_soil_layer")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="moisture_content_of_soil_layer", & - canonicalUnits="kg m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "moisture_content_of_soil_layer_1")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="moisture_content_of_soil_layer_1", & - canonicalUnits="kg m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "moisture_content_of_soil_layer_2")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="moisture_content_of_soil_layer_2", & - canonicalUnits="kg m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "moisture_content_of_soil_layer_3")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="moisture_content_of_soil_layer_3", & - canonicalUnits="kg m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "moisture_content_of_soil_layer_4")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="moisture_content_of_soil_layer_4", & - canonicalUnits="kg m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "soil_porosity")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="soil_porosity", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "temperature_of_soil_layer")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="temperature_of_soil_layer", & - canonicalUnits="K", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "temperature_of_soil_layer_1")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="temperature_of_soil_layer_1", & - canonicalUnits="K", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "temperature_of_soil_layer_2")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="temperature_of_soil_layer_2", & - canonicalUnits="K", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "temperature_of_soil_layer_3")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="temperature_of_soil_layer_3", & - canonicalUnits="K", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "temperature_of_soil_layer_4")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="temperature_of_soil_layer_4", & - canonicalUnits="K", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "soil_temperature_bottom")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="soil_temperature_bottom", & - canonicalUnits="K", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "soil_type")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="soil_type", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "soil_moisture_content")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="soil_moisture_content", & - canonicalUnits="kg m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "subsurface_basin_mask")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="subsurface_basin_mask", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "subsurface_runoff_flux")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="subsurface_runoff_flux", & - canonicalUnits="kg m-2 s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "surface_microwave_emissivity")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="surface_microwave_emissivity", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "surface_runoff_flux")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="surface_runoff_flux", & - canonicalUnits="kg m-2 s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "vegetation_type")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="vegetation_type", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "volume_fraction_of_frozen_water_in_soil")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="volume_fraction_of_frozen_water_in_soil", & - canonicalUnits="m3 m-3", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "liquid_water_content_of_soil_layer")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="liquid_water_content_of_soil_layer", & - canonicalUnits="kg m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "liquid_water_content_of_soil_layer_1")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="liquid_water_content_of_soil_layer_1", & - canonicalUnits="kg m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "liquid_water_content_of_soil_layer_2")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="liquid_water_content_of_soil_layer_2", & - canonicalUnits="kg m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "liquid_water_content_of_soil_layer_3")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="liquid_water_content_of_soil_layer_3", & - canonicalUnits="kg m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "liquid_water_content_of_soil_layer_4")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="liquid_water_content_of_soil_layer_4", & - canonicalUnits="kg m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "volume_fraction_of_total_water_in_soil")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="volume_fraction_of_total_water_in_soil", & - canonicalUnits="m3 m-3", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "volume_fraction_of_total_water_in_soil_at_critical_point")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="volume_fraction_of_total_water_in_soil_at_critical_point", & - canonicalUnits="m3 m-3", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "volume_fraction_of_total_water_in_soil_at_field_capacity")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="volume_fraction_of_total_water_in_soil_at_field_capacity", & - canonicalUnits="m3 m-3", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "volume_fraction_of_total_water_in_soil_at_wilting_point")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="volume_fraction_of_total_water_in_soil_at_wilting_point", & - canonicalUnits="m3 m-3", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not.NUOPC_FieldDictionaryHasEntry( & - "water_surface_height_above_reference_datum")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="water_surface_height_above_reference_datum", & - canonicalUnits="m", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_sensi_heat_flx_atm_into_lnd")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_sensi_heat_flx_atm_into_lnd", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "mean_laten_heat_flx_atm_into_lnd")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="mean_laten_heat_flx_atm_into_lnd", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - ! Fields from and to WW3 - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "eastward_wind_at_10m_height")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="eastward_wind_at_10m_height", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - call NUOPC_FieldDictionarySetSyno( & - standardNames = (/"eastward_wind_at_10m_height",& - "inst_zonal_wind_height10m "/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "northward_wind_at_10m_height")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="northward_wind_at_10m_height", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - call NUOPC_FieldDictionarySetSyno( & - standardNames = (/"northward_wind_at_10m_height",& - "inst_merid_wind_height10m "/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (.not. NUOPC_FieldDictionaryHasEntry( & - "sea_ice_concentration")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="sea_ice_concentration", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - call NUOPC_FieldDictionarySetSyno( & - standardNames = (/"ice_fraction ",& - "sea_ice_concentration"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !For MOM6 and WW3 variables to match: - call NUOPC_FieldDictionarySetSyno( & - standardNames = (/"surface_eastward_sea_water_velocity",& - "ocn_current_zonal "/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_FieldDictionarySetSyno( & - standardNames = (/"surface_northward_sea_water_velocity",& - "ocn_current_merid "/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "eastward_stokes_drift_current")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="eastward_stokes_drift_current", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "northward_stokes_drift_current")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="northward_stokes_drift_current", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "eastward_wave_bottom_current")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="eastward_wave_bottom_current", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "northward_wave_bottom_current")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="northward_wave_bottom_current", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "wave_bottom_current_radian_frequency")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="wave_bottom_current_radian_frequency", & - canonicalUnits="rad s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "eastward_wave_radiation_stress_gradient")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="eastward_wave_radiation_stress_gradient", & - canonicalUnits="Pa", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "northward_wave_radiation_stress_gradient")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="northward_wave_radiation_stress_gradient", & - canonicalUnits="Pa", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "eastward_wave_radiation_stress")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="eastward_wave_radiation_stress", & - canonicalUnits="N m-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "eastward_northward_wave_radiation_stress")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="eastward_northward_wave_radiation_stress", & - canonicalUnits="N m-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "northward_wave_radiation_stress")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="northward_wave_radiation_stress", & - canonicalUnits="N m-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "wave_induced_charnock_parameter")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="wave_induced_charnock_parameter", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "wave_z0_roughness_length")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="wave_z0_roughness_length", & - canonicalUnits="m", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "wave_bottom_current_period")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="wave_bottom_current_period", & - canonicalUnits="s", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - - ! Fields from WAM to IPE - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "northward_wind_neutral")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="northward_wind_neutral", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "eastward_wind_neutral")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="eastward_wind_neutral", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "upward_wind_neutral")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="upward_wind_neutral", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "temp_neutral")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="temp_neutral", & - canonicalUnits="K", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "O_Density")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="O_Density", & - canonicalUnits="m-3", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "O2_Density")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="O2_Density", & - canonicalUnits="m-3", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "N2_Density")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="N2_Density", & - canonicalUnits="m-3", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "height")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="height", & - canonicalUnits="km", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - ! Chemistry fields - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_pres_interface")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_pres_interface", & - canonicalUnits="Pa", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_pres_levels")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_pres_levels", & - canonicalUnits="Pa", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_geop_interface")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_geop_interface", & - canonicalUnits="m2 s-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_geop_levels")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_geop_levels", & - canonicalUnits="m2 s-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_temp_levels")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_temp_levels", & - canonicalUnits="K", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_zonal_wind_levels")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_zonal_wind_levels", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_merid_wind_levels")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_merid_wind_levels", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_omega_levels")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_omega_levels", & - canonicalUnits="Pa s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_tracer_mass_frac")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_tracer_mass_frac", & - canonicalUnits="kg kg-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_tracer_up_surface_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_tracer_up_surface_flx", & - canonicalUnits="kg m-2 s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_tracer_down_surface_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_tracer_down_surface_flx", & - canonicalUnits="kg m-2 s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_tracer_clmn_mass_dens")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_tracer_clmn_mass_dens", & - canonicalUnits="g m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_tracer_anth_biom_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_tracer_anth_biom_flx", & - canonicalUnits="ug m-2 s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_pbl_height")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_pbl_height", & - canonicalUnits="m", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "surface_cell_area")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="surface_cell_area", & - canonicalUnits="m2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_convective_rainfall_amount")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_convective_rainfall_amount", & - canonicalUnits="kg m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_exchange_coefficient_heat_levels")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_exchange_coefficient_heat_levels", & - canonicalUnits="W m-2 K-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_spec_humid_conv_tendency_levels")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_spec_humid_conv_tendency_levels", & - canonicalUnits="kg kg-1 s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_friction_velocity")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_friction_velocity", & - canonicalUnits="m s-1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_rainfall_amount")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_rainfall_amount", & - canonicalUnits="kg m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_soil_moisture_content")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_soil_moisture_content", & - canonicalUnits="kg m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_up_sensi_heat_flx")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_up_sensi_heat_flx", & - canonicalUnits="W m-2", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_lwe_snow_thickness")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_lwe_snow_thickness", & - canonicalUnits="m", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_vegetation_area_frac")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_vegetation_area_frac", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (.not.NUOPC_FieldDictionaryHasEntry( & - "inst_surface_roughness")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="inst_surface_roughness", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - ! Dummy fields + config = ESMF_ConfigCreate(rc=RC) + ESMF_ERR_RETURN(RC,RC_REG) + call ESMF_ConfigLoadFile(config, "nems.configure", rc=RC) + ESMF_ERR_RETURN(RC,RC_REG) + call ESMF_GridCompSet(EARTH_GRID_COMP, config=config, rc=RC) + ESMF_ERR_RETURN(RC,RC_REG) - if (.not. NUOPC_FieldDictionaryHasEntry( & - "dummyfield")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="dummyfield", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "dummyfield1")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="dummyfield1", & - canonicalUnits="1", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (.not. NUOPC_FieldDictionaryHasEntry( & - "dummyfield2")) then - call NUOPC_FieldDictionaryAddEntry( & - standardName="dummyfield2", & - canonicalUnits="1", & - rc=rc) + ! Load the required entries from the fd_nems.yaml file + call NUOPC_FieldDictionarySetup("fd_nems.yaml", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - endif -#endif !----------------------------------------------------------------------- ! @@ -3529,72 +371,7 @@ subroutine SetModelServices(driver, rc) petList(j-petListBounds(1)+1) = j ! PETs are 0 based enddo - if (trim(model) == "satm") then -#ifdef FRONT_SATM - call NUOPC_DriverAddComp(driver, trim(prefix), SATM_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out -#endif - elseif (trim(model) == "xatm") then -#ifdef FRONT_XATM - call NUOPC_DriverAddComp(driver, trim(prefix), XATM_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out -#endif - elseif (trim(model) == "datawam") then -#ifdef FRONT_DATAWAM - call NUOPC_DriverAddComp(driver, trim(prefix), DATAWAM_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out -#endif - elseif (trim(model) == "gsm") then -#ifdef FRONT_GSM - call NUOPC_DriverAddComp(driver, trim(prefix), GSM_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out -#endif - elseif (trim(model) == "nmmb") then -#ifdef FRONT_NMMB - call NUOPC_DriverAddComp(driver, trim(prefix), NMMB_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out -#endif - elseif (trim(model) == "fv3") then + if (trim(model) == "fv3") then #ifdef FRONT_FV3 call NUOPC_DriverAddComp(driver, trim(prefix), FV3_SS, & petList=petList, comp=comp, rc=rc) @@ -3619,32 +396,6 @@ subroutine SetModelServices(driver, rc) call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & file=__FILE__, rcToReturn=rc) return ! bail out -#endif - elseif (trim(model) == "socn") then -#ifdef FRONT_SOCN - call NUOPC_DriverAddComp(driver, trim(prefix), SOCN_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out -#endif - elseif (trim(model) == "xocn") then -#ifdef FRONT_XOCN - call NUOPC_DriverAddComp(driver, trim(prefix), XOCN_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out #endif elseif (trim(model) == "hycom") then #ifdef FRONT_HYCOM @@ -3658,19 +409,6 @@ subroutine SetModelServices(driver, rc) call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & file=__FILE__, rcToReturn=rc) return ! bail out -#endif - elseif (trim(model) == "mom5") then -#ifdef FRONT_MOM5 - call NUOPC_DriverAddComp(driver, trim(prefix), MOM5_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out #endif elseif (trim(model) == "mom6") then #ifdef FRONT_MOM6 @@ -3684,58 +422,6 @@ subroutine SetModelServices(driver, rc) call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & file=__FILE__, rcToReturn=rc) return ! bail out -#endif - elseif (trim(model) == "pom") then -#ifdef FRONT_POM - call NUOPC_DriverAddComp(driver, trim(prefix), POM_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out -#endif - elseif (trim(model) == "sice") then -#ifdef FRONT_SICE - call NUOPC_DriverAddComp(driver, trim(prefix), SICE_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out -#endif - elseif (trim(model) == "xice") then -#ifdef FRONT_XICE - call NUOPC_DriverAddComp(driver, trim(prefix), XICE_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out -#endif - elseif (trim(model) == "cice") then -#ifdef FRONT_CICE - call NUOPC_DriverAddComp(driver, trim(prefix), CICE_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out #endif elseif (trim(model) == "cice6") then #ifdef FRONT_CICE6 @@ -3749,32 +435,6 @@ subroutine SetModelServices(driver, rc) call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & file=__FILE__, rcToReturn=rc) return ! bail out -#endif - elseif (trim(model) == "swav") then -#ifdef FRONT_SWAV - call NUOPC_DriverAddComp(driver, trim(prefix), SWAV_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out -#endif - elseif (trim(model) == "xwav") then -#ifdef FRONT_XWAV - call NUOPC_DriverAddComp(driver, trim(prefix), XWAV_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out #endif elseif (trim(model) == "ww3") then #ifdef FRONT_WW3 @@ -3788,32 +448,6 @@ subroutine SetModelServices(driver, rc) call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & file=__FILE__, rcToReturn=rc) return ! bail out -#endif - elseif (trim(model) == "slnd") then -#ifdef FRONT_SLND - call NUOPC_DriverAddComp(driver, trim(prefix), SLND_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out -#endif - elseif (trim(model) == "xlnd") then -#ifdef FRONT_XLND - call NUOPC_DriverAddComp(driver, trim(prefix), XLND_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out #endif elseif (trim(model) == "noah") then #ifdef FRONT_NOAH @@ -3840,97 +474,6 @@ subroutine SetModelServices(driver, rc) call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & file=__FILE__, rcToReturn=rc) return ! bail out -#endif - elseif (trim(model) == "sipm") then -#ifdef FRONT_SIPM - call NUOPC_DriverAddComp(driver, trim(prefix), SIPM_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out -#endif - elseif (trim(model) == "xipm") then -#ifdef FRONT_XIPM - call NUOPC_DriverAddComp(driver, trim(prefix), XIPM_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out -#endif - elseif (trim(model) == "ipe") then -#ifdef FRONT_IPE - call NUOPC_DriverAddComp(driver, trim(prefix), IPE_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out -#endif - elseif (trim(model) == "dataipe") then -#ifdef FRONT_DATAIPE - call NUOPC_DriverAddComp(driver, trim(prefix), DATAIPE_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out -#endif - elseif (trim(model) == "shyd") then -#ifdef FRONT_SHYD - call NUOPC_DriverAddComp(driver, trim(prefix), SHYD_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out -#endif - elseif (trim(model) == "xhyd") then -#ifdef FRONT_XHYD - call NUOPC_DriverAddComp(driver, trim(prefix), XHYD_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out -#endif - elseif (trim(model) == "wrfhydro") then -#ifdef FRONT_WRFHYDRO - call NUOPC_DriverAddComp(driver, trim(prefix), WRFHYDRO_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out #endif elseif (trim(model) == "gsdchem") then #ifdef FRONT_GSDCHEM @@ -3945,20 +488,14 @@ subroutine SetModelServices(driver, rc) file=__FILE__, rcToReturn=rc) return ! bail out #endif - ! - Two mediator choices currently built into NEMS from internal - elseif (trim(model) == "nems") then -#ifdef CMEPS + elseif (trim(model) == "cmeps") then +#ifdef FRONT_CMEPS med_id = i+1 -#endif call NUOPC_DriverAddComp(driver, trim(prefix), MED_SS, & petList=petList, comp=comp, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - elseif (trim(model) == "spaceweather") then - call NUOPC_DriverAddComp(driver, trim(prefix), MEDSW_SS, & - petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out +#endif else ! Error condition: unknown model requested write (msg, *) "The requested model '", trim(model), & @@ -3992,7 +529,7 @@ subroutine SetModelServices(driver, rc) call AddAttributes(comp, driver, config, i+1, trim(prefix), inst_suffix, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#endif +#endif enddo #if ESMF_VERSION_MAJOR < 8 @@ -4087,8 +624,8 @@ subroutine SetFromConfig(driver, mode, rc) character(len=ESMF_MAXSTR) :: msgString character(len=10) :: value - !can set to 'max' to recover intro/extro CurrGarbInfo for - !all connectors + !can set to 'max' to recover intro/extro CurrGarbInfo for + !all connectors character(len=10) :: defaultVerbosity = "0" !character(len=10) :: defaultVerbosity = "max" @@ -4318,7 +855,7 @@ subroutine SetFromConfig(driver, mode, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - endif + endif ! clean-up deallocate(line) From 8bbeb2a4d17dc602e6a396c2e624e948c7cea0be Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sat, 17 Apr 2021 09:19:44 -0400 Subject: [PATCH 04/12] remove ESMF Version<8 code blocks --- src/module_EARTH_GRID_COMP.F90 | 294 --------------------------------- 1 file changed, 294 deletions(-) diff --git a/src/module_EARTH_GRID_COMP.F90 b/src/module_EARTH_GRID_COMP.F90 index e3833585..adbcfb36 100644 --- a/src/module_EARTH_GRID_COMP.F90 +++ b/src/module_EARTH_GRID_COMP.F90 @@ -532,14 +532,6 @@ subroutine SetModelServices(driver, rc) #endif enddo -#if ESMF_VERSION_MAJOR < 8 -!TODOgjt: REMOVE THIS BLOCK ONCE SHOWN TO WORK WITHOUT - ! SetServices for Connectors - call SetFromConfig(driver, mode="setServicesConnectors", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#endif - ! clean-up deallocate(compLabels) @@ -553,10 +545,8 @@ subroutine SetRunSequence(driver, rc) ! local variables character(ESMF_MAXSTR) :: name -#if ESMF_VERSION_MAJOR >= 8 type(ESMF_Config) :: config type(NUOPC_FreeFormat) :: runSeqFF -#endif rc = ESMF_SUCCESS @@ -565,7 +555,6 @@ subroutine SetRunSequence(driver, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#if ESMF_VERSION_MAJOR >= 8 ! read free format run sequence from config call ESMF_GridCompGet(driver, config=config, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -579,12 +568,6 @@ subroutine SetRunSequence(driver, rc) autoAddConnectors=.true., rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - ! access runSeq in the config - call SetFromConfig(driver, mode="setRunSequence", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#endif ! Diagnostic output if(verbose_diagnostics()) then @@ -597,283 +580,6 @@ subroutine SetRunSequence(driver, rc) !----------------------------------------------------------------------------- -#if ESMF_VERSION_MAJOR < 8 -!TODOgjt: REMOVE THIS BLOCK ONCE SHOWN TO WORK WITHOUT - subroutine SetFromConfig(driver, mode, rc) - type(ESMF_GridComp) :: driver - character(len=*) :: mode - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: name - type(ESMF_Config) :: config - integer :: lineCount, columnCount, i, slotCount - integer, allocatable :: count(:) - character(len=32), allocatable :: line(:) - character(len=32) :: tempString - logical :: phaseFlag - integer :: level, slot, slotHWM - real(ESMF_KIND_R8) :: seconds - integer, allocatable :: slotStack(:) - type(ESMF_TimeInterval) :: timeStep - type(ESMF_Clock) :: internalClock, subClock - character(len=60), allocatable :: connectorInstance(:) - integer :: connectorCount, j - type(ESMF_CplComp) :: conn - - character(len=ESMF_MAXSTR) :: msgString - character(len=10) :: value - - !can set to 'max' to recover intro/extro CurrGarbInfo for - !all connectors - character(len=10) :: defaultVerbosity = "0" - !character(len=10) :: defaultVerbosity = "max" - - rc = ESMF_SUCCESS - - ! query the Component for info - call ESMF_GridCompGet(driver, name=name, config=config, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - - ! reset config to beginning of runSeq:: block - call ESMF_ConfigFindLabel(config, label="runSeq::", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - call ESMF_ConfigGetDim(config, lineCount, columnCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - - allocate(count(lineCount)) - - if (trim(mode)=="setServicesConnectors") then - allocate(connectorInstance(lineCount)) ! max number of connectors - connectorCount = 0 ! reset - write(msgString,'(a,i6)')'max number of connectors ',lineCount - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - endif - - ! reset config to beginning of runSeq:: block - call ESMF_ConfigFindLabel(config, label="runSeq::", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - - ! determine number of entries on each line - do i=1, lineCount - call ESMF_ConfigNextLine(config) - count(i) = ESMF_ConfigGetLen(config) ! entries on line i - enddo - - ! reset config to beginning of runSeq:: block - call ESMF_ConfigFindLabel(config, label="runSeq::", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - - ! read each line and determine slotCount - slotCount = 0 - do i=1, lineCount - call ESMF_ConfigNextLine(config) - allocate(line(count(i))) - call ESMF_ConfigGetAttribute(config, line, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - - ! process the configuration line - if (size(line) == 1) then - if (index(trim(line(1)),"@") == 1) then - slotCount = slotCount + 1 - endif - elseif ((size(line) == 3) .or. (size(line) == 4)) then - if (trim(mode)=="setServicesConnectors") then - ! a connector if the second element is "->" - if (trim(line(2)) /= "->") then - call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, & - msg="Configuration line incorrectly formatted.", & - line=__LINE__, & - file=__FILE__) - return ! bail out - else - ! found a connector entry, see if it is the first instance - do j=1, connectorCount - if (trim(connectorInstance(j)) == & - trim(line(1))//trim(line(2))//trim(line(3))) exit - enddo - if (j>connectorCount) then - ! this is a new Connector instance - connectorCount = j - connectorInstance(j) = trim(line(1))//trim(line(2))//trim(line(3)) - write(msgString,'(a,i4,a,i4,4a)')'Connector j = ',j,& - ' line number ', i,& - ' ',trim(connectorInstance(j)),& - ' Verbosity = ',trim(defaultVerbosity) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - ! SetServices for new Connector instance - call NUOPC_DriverAddComp(driver, & - srcCompLabel=trim(line(1)), dstCompLabel=trim(line(3)), & - compSetServicesRoutine=conSS, comp=conn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail - call NUOPC_CompAttributeSet(conn, name="Verbosity", value=defaultVerbosity, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail - if (size(line) == 4) then - ! there are additional connection options specified - ! -> set as Attribute for now on the connector object - call ESMF_AttributeSet(conn, name="ConnectionOptions", & - value=trim(line(4)), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail - endif - endif - endif - endif - endif - ! clean-up - deallocate(line) - enddo - slotCount = (slotCount+1) / 2 - slotCount = max(slotCount, 1) ! at least one slot - - if (trim(mode)=="setRunSequence") then - - allocate(slotStack(slotCount)) - - ! Replace the default RunSequence with a customized one - call NUOPC_DriverNewRunSequence(driver, slotCount=slotCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Get driver intenalClock - call ESMF_GridCompGet(driver, clock=internalClock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! reset config to beginning of runSeq:: block - call ESMF_ConfigFindLabel(config, label="runSeq::", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - - level = 0 - slot = 0 - slotHWM = 0 - do i=1, lineCount - call ESMF_ConfigNextLine(config) - allocate(line(count(i))) - call ESMF_ConfigGetAttribute(config, line, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - - ! process the configuration line - if ((size(line) < 1) .or. (size(line) > 4)) then - call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, & - msg="Configuration line incorrectly formatted.", & - line=__LINE__, & - file=__FILE__) - return ! bail out - elseif (size(line) == 1) then - ! either a model or a time step indicator - if (index(trim(line(1)),"@") == 1) then - ! time step indicator - tempString=trim(line(1)) - if (len(trim(tempString)) > 1) then - ! entering new time loop level - level = level + 1 - slotStack(level)=slot - slot = slotHWM + 1 - slotHWM = slotHWM + 1 - read(tempString(2:len(tempString)), *) seconds - !print *, "found time step indicator: ", seconds - call ESMF_TimeIntervalSet(timeStep, s_r8=seconds, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (slot==1) then - ! Set the timeStep of the internalClock - call ESMF_ClockSet(internalClock, timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else - ! Insert the link to a new slot, and set the timeStep - call NUOPC_DriverAddRunElement(driver, slot=slotStack(level), & - linkSlot=slot, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - subClock = ESMF_ClockCreate(internalClock, rc=rc) ! make a copy first - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - call ESMF_ClockSet(subClock, timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - call NUOPC_DriverSetRunSequence(driver, slot=slot, & - clock=subClock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - endif - else - ! exiting time loop level - slot = slotStack(level) - level = level - 1 - endif - else - ! model - slot = max(slot, 1) ! model outside of a time loop - call NUOPC_DriverAddRunElement(driver, slot=slot, & - compLabel=trim(line(1)), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - elseif (size(line) == 2) then - ! a model with a specific phase label - call NUOPC_DriverAddRunElement(driver, slot=slot, & - compLabel=trim(line(1)), phaseLabel=trim(line(2)), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - elseif ((size(line) == 3) .or. (size(line) == 4)) then - ! a connector if the second element is "->", with options if 4th part - if (trim(line(2)) /= "->") then - call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, & - msg="Configuration line incorrectly formatted.", & - line=__LINE__, & - file=__FILE__) - return ! bail out - endif - call NUOPC_DriverAddRunElement(driver, slot=slot, & - srcCompLabel=trim(line(1)), dstCompLabel=trim(line(3)), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - ! clean-up - deallocate(line) - enddo - ! clean-up - deallocate(slotStack) - endif - - ! clean-up - deallocate(count) - if (trim(mode)=="setServicesConnectors") then - deallocate(connectorInstance) - endif - - end subroutine -#endif - !----------------------------------------------------------------------------- - subroutine Finalize(driver, rc) type(ESMF_GridComp) :: driver integer, intent(out) :: rc From ae01a66bf2d70af0184e04478c7855d68fddc761 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sat, 17 Apr 2021 09:25:24 -0400 Subject: [PATCH 05/12] clean up error logging *use ChkErr function like in CMEPS,MOM6,CICE6 caps --- src/module_EARTH_GRID_COMP.F90 | 280 ++++++++++----------------------- 1 file changed, 85 insertions(+), 195 deletions(-) diff --git a/src/module_EARTH_GRID_COMP.F90 b/src/module_EARTH_GRID_COMP.F90 index adbcfb36..8828a596 100644 --- a/src/module_EARTH_GRID_COMP.F90 +++ b/src/module_EARTH_GRID_COMP.F90 @@ -88,7 +88,7 @@ MODULE module_EARTH_GRID_COMP #endif ! - Mediator #ifdef FRONT_CMEPS - use MED, only: MED_SS => SetServices + use MED, only: MED_SS => SetServices #endif USE module_EARTH_INTERNAL_STATE,ONLY: EARTH_INTERNAL_STATE & @@ -113,7 +113,8 @@ MODULE module_EARTH_GRID_COMP ! LOGICAL, PRIVATE :: flag_verbose_diagnostics = .false. - + character(len=*),parameter :: u_FILE_u = & + __FILE__ CONTAINS @@ -129,6 +130,17 @@ logical function verbose_diagnostics(set) verbose_diagnostics=flag_verbose_diagnostics end function verbose_diagnostics + logical function ChkErr(rc, line, file) + integer, intent(in) :: rc !< return code to check + integer, intent(in) :: line !< Integer source line number + character(len=*), intent(in) :: file !< User-provided source file name + integer :: lrc + ChkErr = .false. + lrc = rc + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + ChkErr = .true. + endif + end function ChkErr !----------------------------------------------------------------------- !####################################################################### !----------------------------------------------------------------------- @@ -210,10 +222,7 @@ SUBROUTINE EARTH_REGISTER(EARTH_GRID_COMP,RC_REG) ! Load the required entries from the fd_nems.yaml file call NUOPC_FieldDictionarySetup("fd_nems.yaml", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !----------------------------------------------------------------------- ! @@ -255,8 +264,7 @@ subroutine SetModelServices(driver, rc) ! query the Component for info call ESMF_GridCompGet(driver, name=name, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! allocate memory for the internal state and store in Component allocate(is%EARTH_INT_STATE, stat=stat) @@ -265,56 +273,44 @@ subroutine SetModelServices(driver, rc) line=__LINE__, file=trim(name)//":"//__FILE__, rcToReturn=rc)) & return ! bail out call ESMF_GridCompSetInternalState(driver, is, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! get petCount and config call ESMF_GridCompGet(driver, petCount=petCount, config=config, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! read and ingest free format driver attributes attrFF = NUOPC_FreeFormatCreate(config, label="EARTH_attributes::", & relaxedflag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeIngest(driver, attrFF, addFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_FreeFormatDestroy(attrFF, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! dump the current field dictionary into the Log file call ESMF_AttributeGet(driver, name="DumpFieldDictionary", & value=value, defaultValue="false", & convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(value)=="true") then call ESMF_LogWrite( & "===>===>===>===> Begin Dumping Field Dictionary <===<===<===<===",& - ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + ESMF_LOGMSG_INFO) call NUOPC_FieldDictionaryEgest(fdFF, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_FreeFormatLog(fdFF, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite( & "===>===>===>===> Done Dumping Field Dictionary <===<===<===<===", & - ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + ESMF_LOGMSG_INFO) endif - + ! determine the generic component labels componentCount = ESMF_ConfigGetLen(config, & label="EARTH_component_list:", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(compLabels(componentCount), stat=stat) if (ESMF_LogFoundAllocError(statusToCheck=stat, & msg="Allocation of compLabels failed.", & @@ -322,20 +318,15 @@ subroutine SetModelServices(driver, rc) return ! bail out call ESMF_ConfigGetAttribute(config, valueList=compLabels, & label="EARTH_component_list:", count=componentCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - + if (ChkErr(rc,__LINE__,u_FILE_u)) return #ifdef CMEPS inst_suffix = "" ! obtain driver attributes (for CMEPS) call ReadAttributes(driver, config, "DRIVER_attributes::", formatprint=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(driver, config, "ALLCOMP_attributes::", formatprint=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return #endif ! determine information for each component and add to the driver @@ -345,8 +336,8 @@ subroutine SetModelServices(driver, rc) ! read in petList bounds call ESMF_ConfigGetAttribute(config, petListBounds, & label=trim(prefix)//"_petlist_bounds:", default=-1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! handle the default situation if (petListBounds(1)==-1 .or. petListBounds(2)==-1) then petListBounds(1) = 0 @@ -355,8 +346,8 @@ subroutine SetModelServices(driver, rc) ! read in model instance name call ESMF_ConfigGetAttribute(config, model, & label=trim(prefix)//"_model:", default="none", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! check that there was a model instance specified if (trim(model) == "none") then ! Error condition: no model was specified @@ -508,14 +499,11 @@ subroutine SetModelServices(driver, rc) ! read and ingest free format component attributes attrFF = NUOPC_FreeFormatCreate(config, & label=trim(prefix)//"_attributes::", relaxedflag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeIngest(comp, attrFF, addFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_FreeFormatDestroy(attrFF, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! clean-up deallocate(petList) @@ -523,12 +511,10 @@ subroutine SetModelServices(driver, rc) #ifdef CMEPS ! Perform restarts if appropriate call InitRestart(driver, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call AddAttributes(comp, driver, config, i+1, trim(prefix), inst_suffix, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return #endif enddo @@ -552,28 +538,23 @@ subroutine SetRunSequence(driver, rc) ! query the Component for info call ESMF_GridCompGet(driver, name=name, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! read free format run sequence from config call ESMF_GridCompGet(driver, config=config, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return runSeqFF = NUOPC_FreeFormatCreate(config, label="runSeq::", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ingest FreeFormat run sequence call NUOPC_DriverIngestRunSequence(driver, runSeqFF, & autoAddConnectors=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Diagnostic output if(verbose_diagnostics()) then call NUOPC_DriverPrint(driver, orderflag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif end subroutine @@ -594,14 +575,12 @@ subroutine Finalize(driver, rc) ! query the Component for info call ESMF_GridCompGet(driver, name=name, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! query Component for this internal State nullify(is%EARTH_INT_STATE) call ESMF_GridCompGetInternalState(driver, is, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! deallocate internal state memory deallocate(is%EARTH_INT_STATE, stat=stat) @@ -633,54 +612,34 @@ recursive subroutine ModifyCplLists(driver, importState, exportState, clock, & ! query Component for this internal State nullify(is%EARTH_INT_STATE) call ESMF_GridCompGetInternalState(driver, is, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite("Driver is in ModifyCplLists()", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_LogWrite("Driver is in ModifyCplLists()", ESMF_LOGMSG_INFO) nullify(connectorList) call NUOPC_DriverGetComp(driver, compList=connectorList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return write (msg,*) "Found ", size(connectorList), " Connectors."// & " Modifying CplList Attribute...." - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) do i=1, size(connectorList) ! query Connector i for its name call ESMF_CplCompGet(connectorList(i), name=name, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! access CplList for Connector i call NUOPC_CompAttributeGet(connectorList(i), name="CplList", & itemCount=cplListSize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (cplListSize>0) then allocate(cplList(cplListSize)) call NUOPC_CompAttributeGet(connectorList(i), name="CplList", & valueList=cplList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! go through all of the entries in the cplList and add options do j=1, cplListSize cplList(j) = trim(cplList(j))//":DumpWeights=true" @@ -688,19 +647,13 @@ recursive subroutine ModifyCplLists(driver, importState, exportState, clock, & ! add connection options read in from configuration file call ESMF_AttributeGet(connectorList(i), name="ConnectionOptions", & value=value, defaultValue="", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return cplList(j) = trim(cplList(j))//trim(value) enddo ! store the modified cplList in CplList attribute of connector i call NUOPC_CompAttributeSet(connectorList(i), & name="CplList", valueList=cplList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(cplList) endif enddo @@ -735,29 +688,16 @@ subroutine ReadAttributes(gcomp, config, label, relaxedflag, formatprint, rc) if (present(relaxedflag)) then attrFF = NUOPC_FreeFormatCreate(config, label=trim(label), relaxedflag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return else attrFF = NUOPC_FreeFormatCreate(config, label=trim(label), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if call NUOPC_CompAttributeIngest(gcomp, attrFF, addFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_FreeFormatDestroy(attrFF, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine ReadAttributes @@ -783,38 +723,26 @@ subroutine InitRestart(driver, rc) !------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) !----------------------------------------------------- ! Carry out restart if appropriate !----------------------------------------------------- read_restart = IsRestart(driver, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Add rest_case_name and read_restart to driver attributes call NUOPC_CompAttributeAdd(driver, attrList=(/'rest_case_name','read_restart '/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return rest_case_name = ' ' call NUOPC_CompAttributeSet(driver, name='rest_case_name', value=rest_case_name, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return write(cvalue,*) read_restart call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(cvalue), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine InitRestart @@ -842,10 +770,7 @@ function IsRestart(gcomp, rc) ! First Determine if restart is read call NUOPC_CompAttributeGet(gcomp, name='start_type', value=start_type, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return if ((trim(start_type) /= start_type_start) .and. & (trim(start_type) /= start_type_cont ) .and. & @@ -915,46 +840,28 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, r attrList = (/"read_restart"/) call NUOPC_CompAttributeAdd(gcomp, attrList=attrList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,size(attrList) if (trim(attrList(n)) == "read_restart") then call NUOPC_CompAttributeGet(driver, name="mediator_read_restart", value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) lvalue if (.not. lvalue) then call NUOPC_CompAttributeGet(driver, name=trim(attrList(n)), value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if call NUOPC_CompAttributeSet(gcomp, name=trim(attrList(n)), value=trim(cvalue), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return else print*, trim(attrList(n)) call NUOPC_CompAttributeGet(driver, name=trim(attrList(n)), value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeSet(gcomp, name=trim(attrList(n)), value=trim(cvalue), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if enddo deallocate(attrList) @@ -963,48 +870,31 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, r ! Add component specific attributes !------ call ReadAttributes(gcomp, config, trim(compname)//"_attributes::", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(gcomp, config, "ALLCOMP_attributes::", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------ ! Add multi-instance specific attributes !------ call NUOPC_CompAttributeAdd(gcomp, attrList=(/'inst_index'/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! add inst_index attribute (inst_index is not required for cime internal components) ! for now hard-wire inst_index to 1 inst_index = 1 write(cvalue,*) inst_index call NUOPC_CompAttributeSet(gcomp, name='inst_index', value=trim(cvalue), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! add inst_suffix attribute if (len_trim(inst_suffix) > 0) then call NUOPC_CompAttributeAdd(gcomp, attrList=(/'inst_suffix'/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name='inst_suffix', value=inst_suffix, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end subroutine AddAttributes From 6f7ea443af34ba4cd4b50dd2acc654f136dc8f4d Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sat, 17 Apr 2021 09:29:08 -0400 Subject: [PATCH 06/12] clean up DriverAddComp statements * reduce lines required to add each component or reporting on an unfound component by adding "found_comp" logical. This allows a single error statement to be used for each possible "not found" error --- src/module_EARTH_GRID_COMP.F90 | 144 +++++++++++++-------------------- 1 file changed, 54 insertions(+), 90 deletions(-) diff --git a/src/module_EARTH_GRID_COMP.F90 b/src/module_EARTH_GRID_COMP.F90 index 8828a596..98adbc0d 100644 --- a/src/module_EARTH_GRID_COMP.F90 +++ b/src/module_EARTH_GRID_COMP.F90 @@ -254,6 +254,7 @@ subroutine SetModelServices(driver, rc) integer :: petListBounds(2) integer :: componentCount type(NUOPC_FreeFormat) :: attrFF, fdFF + logical :: found_comp #ifdef CMEPS logical :: read_restart character(ESMF_MAXSTR) :: cvalue @@ -362,138 +363,101 @@ subroutine SetModelServices(driver, rc) petList(j-petListBounds(1)+1) = j ! PETs are 0 based enddo - if (trim(model) == "fv3") then + found_comp = .false. #ifdef FRONT_FV3 + if (trim(model) == "fv3") then call NUOPC_DriverAddComp(driver, trim(prefix), FV3_SS, & petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + found_comp = .true. + end if #endif - elseif (trim(model) == "datm") then #ifdef FRONT_DATM + if (trim(model) == "datm") then call NUOPC_DriverAddComp(driver, trim(prefix), DATM_SS, & petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + found_comp = .true. + end if #endif - elseif (trim(model) == "hycom") then #ifdef FRONT_HYCOM + if (trim(model) == "hycom") then call NUOPC_DriverAddComp(driver, trim(prefix), HYCOM_SS, & petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + found_comp = .true. + end if #endif - elseif (trim(model) == "mom6") then #ifdef FRONT_MOM6 + if (trim(model) == "mom6") then call NUOPC_DriverAddComp(driver, trim(prefix), MOM6_SS, & petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + found_comp = .true. + end if #endif - elseif (trim(model) == "cice6") then #ifdef FRONT_CICE6 + if (trim(model) == "cice6") then call NUOPC_DriverAddComp(driver, trim(prefix), CICE6_SS, & petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + found_comp = .true. + end if #endif - elseif (trim(model) == "ww3") then #ifdef FRONT_WW3 + if (trim(model) == "ww3") then call NUOPC_DriverAddComp(driver, trim(prefix), WW3_SS, & petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + found_comp = .true. + end if #endif - elseif (trim(model) == "noah") then #ifdef FRONT_NOAH + if (trim(model) == "noah") then call NUOPC_DriverAddComp(driver, trim(prefix), NOAH_SS, & petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + found_comp = .true. + end if #endif - elseif (trim(model) == "lis") then #ifdef FRONT_LIS + if (trim(model) == "lis") then call NUOPC_DriverAddComp(driver, trim(prefix), LIS_SS, & petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + found_comp = .true. + end if +#endif +#ifdef FRONT_IPE + if (trim(model) == "ipe") then + call NUOPC_DriverAddComp(driver, trim(prefix), IPE_SS, & + petList=petList, comp=comp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + found_comp = .true. + end if #endif - elseif (trim(model) == "gsdchem") then #ifdef FRONT_GSDCHEM + if (trim(model) == "gsdchem") then call NUOPC_DriverAddComp(driver, trim(prefix), GSDCHEM_SS, & petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out -#else - write (msg, *) "Model '", trim(model), "' was requested, "// & - "but is not available in the executable!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + found_comp = .true. + end if #endif - elseif (trim(model) == "cmeps") then #ifdef FRONT_CMEPS + if (trim(model) == "cmeps") then med_id = i+1 call NUOPC_DriverAddComp(driver, trim(prefix), MED_SS, & petList=petList, comp=comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + found_comp = .true. + end if #endif - else - ! Error condition: unknown model requested - write (msg, *) "The requested model '", trim(model), & - "' is an invalid choice!" - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & + if (.not. found_comp) then + write(msg,*) 'No component ',trim(model),' found' + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, & file=__FILE__, rcToReturn=rc) - return ! bail out + return endif ! read and ingest free format component attributes From da9a8ae2bae59f5bf7c7ca6a5f01be6ce6970ac4 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sat, 17 Apr 2021 09:32:27 -0400 Subject: [PATCH 07/12] add attribute print flag * add logical flag to control whether attributes are written to PET logs at startup --- src/module_EARTH_GRID_COMP.F90 | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/src/module_EARTH_GRID_COMP.F90 b/src/module_EARTH_GRID_COMP.F90 index 98adbc0d..f18fe3c1 100644 --- a/src/module_EARTH_GRID_COMP.F90 +++ b/src/module_EARTH_GRID_COMP.F90 @@ -113,6 +113,8 @@ MODULE module_EARTH_GRID_COMP ! LOGICAL, PRIVATE :: flag_verbose_diagnostics = .false. + logical, private :: printattr = .true. + character(len=*),parameter :: u_FILE_u = & __FILE__ @@ -141,6 +143,7 @@ logical function ChkErr(rc, line, file) ChkErr = .true. endif end function ChkErr + !----------------------------------------------------------------------- !####################################################################### !----------------------------------------------------------------------- @@ -324,9 +327,9 @@ subroutine SetModelServices(driver, rc) inst_suffix = "" ! obtain driver attributes (for CMEPS) - call ReadAttributes(driver, config, "DRIVER_attributes::", formatprint=.true., rc=rc) + call ReadAttributes(driver, config, "DRIVER_attributes::", formatprint=printattr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(driver, config, "ALLCOMP_attributes::", formatprint=.true., rc=rc) + call ReadAttributes(driver, config, "ALLCOMP_attributes::", formatprint=printattr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return #endif @@ -455,7 +458,7 @@ subroutine SetModelServices(driver, rc) #endif if (.not. found_comp) then write(msg,*) 'No component ',trim(model),' found' - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, & + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msg, line=__LINE__, & file=__FILE__, rcToReturn=rc) return endif @@ -660,6 +663,14 @@ subroutine ReadAttributes(gcomp, config, label, relaxedflag, formatprint, rc) call NUOPC_CompAttributeIngest(gcomp, attrFF, addFlag=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (present (formatprint)) then + call ESMF_LogWrite('ReadAttributes '//trim(label)//' start:', ESMF_LOGMSG_INFO) + call NUOPC_FreeFormatLog(attrFF, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('ReadAttributes '//trim(label)//' end:', ESMF_LOGMSG_INFO) + end if + call NUOPC_FreeFormatDestroy(attrFF, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -833,10 +844,10 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, r !------ ! Add component specific attributes !------ - call ReadAttributes(gcomp, config, trim(compname)//"_attributes::", rc=rc) + call ReadAttributes(gcomp, config, trim(compname)//"_attributes::", formatprint=printattr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(gcomp, config, "ALLCOMP_attributes::", rc=rc) + call ReadAttributes(gcomp, config, "ALLCOMP_attributes::", formatprint=printattr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------ From ba179d3d9f50e0065446d95c86e033a84cc7dd0a Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 19 Apr 2021 13:33:40 +0000 Subject: [PATCH 08/12] set attribute printing false --- src/module_EARTH_GRID_COMP.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/module_EARTH_GRID_COMP.F90 b/src/module_EARTH_GRID_COMP.F90 index f18fe3c1..b33957c3 100644 --- a/src/module_EARTH_GRID_COMP.F90 +++ b/src/module_EARTH_GRID_COMP.F90 @@ -113,7 +113,7 @@ MODULE module_EARTH_GRID_COMP ! LOGICAL, PRIVATE :: flag_verbose_diagnostics = .false. - logical, private :: printattr = .true. + logical, private :: printattr = .false. character(len=*),parameter :: u_FILE_u = & __FILE__ From 2ee59bafc88eac42ed7246895c4a692be674ff4b Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 20 Apr 2021 12:38:43 +0000 Subject: [PATCH 09/12] remove unused bits of NEMS_UTILS; whitespace cleanup --- src/MAIN_NEMS.F90 | 14 +++--- src/module_EARTH_GRID_COMP.F90 | 2 +- src/module_NEMS_GRID_COMP.F90 | 6 +-- src/module_NEMS_Rusage.F90 | 4 +- src/module_NEMS_UTILS.F90 | 90 +--------------------------------- 5 files changed, 14 insertions(+), 102 deletions(-) diff --git a/src/MAIN_NEMS.F90 b/src/MAIN_NEMS.F90 index 7229831c..ef0a5aac 100644 --- a/src/MAIN_NEMS.F90 +++ b/src/MAIN_NEMS.F90 @@ -34,7 +34,7 @@ PROGRAM MAIN_NEMS ! 2010-04 Yang - Add GEFS and GFS for the revised NEMS. ! 2010-11 Yang - Add the "Generic Core" to NEMS ! 2011-02 Yang - Updated to use both the ESMF 4.0.0rp2 library, -! ESMF 5 series library and the the +! ESMF 5 series library and the the ! ESMF 3.1.0rp2 library. ! 2011-05 Theurich & Yang - Modified for using the ESMF 5.2.0r_beta_snapshot_07. ! 2011-10 Yang - Modified for using the ESMF 5.2.0r library. @@ -57,7 +57,7 @@ PROGRAM MAIN_NEMS !*** The following module contains error-checking, and other utilities !----------------------------------------------------------------------- ! - USE module_NEMS_UTILS, ONLY: check_esmf_pet, err_msg, message_check + USE module_NEMS_UTILS, ONLY: check_esmf_pet, message_check ! !----------------------------------------------------------------------- !*** This module calculates resource usage across all ranks. @@ -102,7 +102,7 @@ PROGRAM MAIN_NEMS ! TYPE(ESMF_State) :: NEMS_EXP_STATE & !<-- The NEMS export state ,NEMS_IMP_STATE !<-- The NEMS import state -! +! TYPE(ESMF_Clock) :: CLOCK_MAIN !<-- The ESMF time management clock ! TYPE(ESMF_Config) :: CF_MAIN !<-- The Configure object @@ -130,9 +130,9 @@ PROGRAM MAIN_NEMS CALL CHECK_ESMF_PET(PRINT_ESMF) ! !----------------------------------------------------------------------- -!*** Initialize the ESMF framework. +!*** Initialize the ESMF framework. !----------------------------------------------------------------------- -! +! IF(PRINT_ESMF) THEN CALL ESMF_Initialize(VM =VM & !<-- The ESMF Virtual Machine ,defaultCalKind =ESMF_CALKIND_GREGORIAN & !<-- Set up the default calendar. @@ -223,7 +223,7 @@ PROGRAM MAIN_NEMS CF_MAIN=ESMF_ConfigCreate(rc=RC) ! CALL ESMF_ConfigLoadFile(config =CF_MAIN & !<-- The Configure object - ,filename='model_configure' & !<-- The name of the configure file + ,filename='model_configure' & !<-- The name of the configure file ,rc =RC) ESMF_ERR_ABORT(RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ @@ -450,7 +450,7 @@ PROGRAM MAIN_NEMS NEMS_EXP_STATE=ESMF_StateCreate(name='NEMS Export State' & ,rc =RC) ESMF_ERR_ABORT(RC) -! +! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! !----------------------------------------------------------------------- diff --git a/src/module_EARTH_GRID_COMP.F90 b/src/module_EARTH_GRID_COMP.F90 index b33957c3..a1c3fd07 100644 --- a/src/module_EARTH_GRID_COMP.F90 +++ b/src/module_EARTH_GRID_COMP.F90 @@ -96,7 +96,7 @@ MODULE module_EARTH_GRID_COMP ! ! USE module_ATM_GRID_COMP ! - USE module_NEMS_UTILS,ONLY: ERR_MSG,MESSAGE_CHECK + USE module_NEMS_UTILS,ONLY: MESSAGE_CHECK ! !----------------------------------------------------------------------- ! diff --git a/src/module_NEMS_GRID_COMP.F90 b/src/module_NEMS_GRID_COMP.F90 index d77af48e..394cdc2c 100644 --- a/src/module_NEMS_GRID_COMP.F90 +++ b/src/module_NEMS_GRID_COMP.F90 @@ -23,9 +23,9 @@ MODULE module_NEMS_GRID_COMP ! | | ! | | ! | | -! | (MOM5, HYCOM, etc.) +! | (MOM6, HYCOM, etc.) ! | -! CORE component (GSM, NMM, FIM, GEN, etc.) +! CORE component (FV3, DATM, etc.) ! !----------------------------------------------------------------------- ! 2011-05-11 Theurich & Yang - Modified for using the ESMF 5.2.0r_beta_snapshot_07. @@ -40,7 +40,7 @@ MODULE module_NEMS_GRID_COMP ! USE module_EARTH_GRID_COMP ! - USE module_NEMS_UTILS,ONLY: ERR_MSG,MESSAGE_CHECK + USE module_NEMS_UTILS,ONLY: MESSAGE_CHECK ! !----------------------------------------------------------------------- ! diff --git a/src/module_NEMS_Rusage.F90 b/src/module_NEMS_Rusage.F90 index 02c0485d..f00a3600 100644 --- a/src/module_NEMS_Rusage.F90 +++ b/src/module_NEMS_Rusage.F90 @@ -627,7 +627,7 @@ end subroutine check_names !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine color_by_hash(name,namelen,commin,comm_name,comm_hosts,rank_world,ierr) - !! Groups processors into ranks by name. + !! Groups processors into ranks by name. !! !! Each group in comm_name will have the same name in each rank. !! The first rank of each communicator will be in the same group @@ -714,7 +714,7 @@ subroutine color_by_hash(name,namelen,commin,comm_name,comm_hosts,rank_world,ier endif if(match) exit hashtries - ! We get here on hash collisions. That means the + ! We get here on hash collisions. That means the end do hashtries if(.not.match) then diff --git a/src/module_NEMS_UTILS.F90 b/src/module_NEMS_UTILS.F90 index 9182b87e..993a9397 100644 --- a/src/module_NEMS_UTILS.F90 +++ b/src/module_NEMS_UTILS.F90 @@ -9,100 +9,12 @@ MODULE module_NEMS_UTILS implicit none private - public :: check_esmf_pet, err_msg, message_check + public :: check_esmf_pet, message_check - logical, parameter :: iprint = .false. character(esmf_maxstr) :: message_check contains -!----------------------------------------------------------------------- -! - subroutine err_msg_int(rc1,msg,val,rcfinal) -! - integer, intent(inout) :: rc1 - integer, intent(out) :: rcfinal - character (len=*), intent(in) :: msg - integer, intent(in) :: val - if(esmf_logfounderror(rcToCheck=rc1, msg=msg)) then - rcfinal = esmf_failure - print*, 'error happened for ',msg,' ',val,' rc = ', rc1 - write(0,*)' ERROR: ',msg,' ',val,' rc = ', rc1 - rc1 = esmf_success - else - if(iprint) print*, 'pass ',msg,' ',val - end if - return - end subroutine err_msg_int - - subroutine err_msg_val(rc1,msg,val,rcfinal) -! - integer, intent(inout) :: rc1 - integer, intent(out) :: rcfinal - character (len=*), intent(in) :: msg - real, intent(in) :: val - if(esmf_logfounderror(rc1, msg=msg)) then - rcfinal = esmf_failure - print*, 'error happened for ',msg,' ',val,' rc = ', rc1 - write(0,*)' ERROR: ',msg,' ',val,' rc = ', rc1 - rc1 = esmf_success - else - if(iprint) print*, 'pass ',msg,' ',val - end if - return - end subroutine err_msg_val - - subroutine err_msg_var(rc1,msg,chr,rcfinal) -! - integer, intent(inout) :: rc1 - integer, intent(out) :: rcfinal - character (len=*), intent(in) :: msg - character (len=*), intent(in) :: chr - if(esmf_logfounderror(rc1, msg=msg)) then - rcfinal = esmf_failure - print*, 'error happened for ',msg,' ',chr,' rc = ', rc1 - write(0,*)' ERROR: ',msg,' ',chr,' rc = ', rc1 - rc1 = esmf_success - else - if(iprint) print*, 'pass ',msg,' ',chr - end if - return - end subroutine err_msg_var - - subroutine err_msg(rc1,msg,rc) - integer, intent(inout) :: rc1 - integer, intent(out) :: rc - character (len=*), intent(in) :: msg - if(esmf_logfounderror(rc1, msg=msg)) then - rc = esmf_failure - print*, 'error happened for ',msg, ' rc = ', rc1 - write(0,*)' ERROR: ',trim(msg),' rc = ', rc1 - rc1 = esmf_success - else - rc = esmf_success - if(iprint) print*, 'pass ',msg - end if - return - end subroutine err_msg - - subroutine err_msg_final(rcfinal,msg,rc) - integer, intent(inout) :: rcfinal - integer, intent(inout) :: rc - character (len=*), intent(in) :: msg - if(rcfinal == esmf_success) then - if(iprint) print*, "final pass: ",msg - else - print*, "final fail: ",msg - write(0,*)' FINAL ERROR: ',msg - end if -! if(present(rc)) then - rc = rcfinal -! end if - return - end subroutine err_msg_final - -!----------------------------------------------------------------------- -! subroutine check_esmf_pet(print_esmf) ! !----------------------------------------------------------------------- From 9ffe95f2d825e5f473ab17ece691438120a69555 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 20 Apr 2021 13:14:51 +0000 Subject: [PATCH 10/12] remove RTC and TIMEF from MAIN_NEMS --- src/MAIN_NEMS.F90 | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/src/MAIN_NEMS.F90 b/src/MAIN_NEMS.F90 index ef0a5aac..86e0efb6 100644 --- a/src/MAIN_NEMS.F90 +++ b/src/MAIN_NEMS.F90 @@ -662,15 +662,3 @@ PROGRAM MAIN_NEMS END PROGRAM MAIN_NEMS ! !----------------------------------------------------------------------- - - -#ifndef IBM - REAL(8) FUNCTION RTC() - RTC = 0.d0 - END FUNCTION - - REAL(8) FUNCTION TIMEF() - TIMEF = 0.d0 - END FUNCTION -#endif - From 079f100edab54332b2a0d888becb4932317fbc4e Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 20 Apr 2021 19:25:57 +0000 Subject: [PATCH 11/12] remove earth and nems internal state files --- src/module_EARTH_GRID_COMP.F90 | 61 +---------------------------- src/module_EARTH_INTERNAL_STATE.F90 | 45 --------------------- src/module_NEMS_GRID_COMP.F90 | 19 --------- src/module_NEMS_INTERNAL_STATE.F90 | 46 ---------------------- 4 files changed, 1 insertion(+), 170 deletions(-) delete mode 100644 src/module_EARTH_INTERNAL_STATE.F90 delete mode 100644 src/module_NEMS_INTERNAL_STATE.F90 diff --git a/src/module_EARTH_GRID_COMP.F90 b/src/module_EARTH_GRID_COMP.F90 index a1c3fd07..8b9db7bc 100644 --- a/src/module_EARTH_GRID_COMP.F90 +++ b/src/module_EARTH_GRID_COMP.F90 @@ -46,8 +46,7 @@ MODULE module_EARTH_GRID_COMP Driver_routine_SS => SetServices, & Driver_label_SetModelServices => label_SetModelServices, & Driver_label_SetRunSequence => label_SetRunSequence, & - Driver_label_SetRunClock => label_SetRunClock, & - Driver_label_Finalize => label_Finalize + Driver_label_SetRunClock => label_SetRunClock use NUOPC_Connector, only: conSS => SetServices ! - Handle build time ATM options: #ifdef FRONT_FV3 @@ -91,11 +90,6 @@ MODULE module_EARTH_GRID_COMP use MED, only: MED_SS => SetServices #endif - USE module_EARTH_INTERNAL_STATE,ONLY: EARTH_INTERNAL_STATE & - ,WRAP_EARTH_INTERNAL_STATE -! -! USE module_ATM_GRID_COMP -! USE module_NEMS_UTILS,ONLY: MESSAGE_CHECK ! !----------------------------------------------------------------------- @@ -203,12 +197,6 @@ SUBROUTINE EARTH_REGISTER(EARTH_GRID_COMP,RC_REG) specLabel=Driver_label_SetRunClock, specRoutine=NUOPC_NoOp, rc=RC_REG) ESMF_ERR_RETURN(RC,RC_REG) #endif -#if 0 - call NUOPC_CompSpecialize(EARTH_GRID_COMP, & - specLabel=Driver_label_Finalize, specRoutine=Finalize, & - rc=RC) - ESMF_ERR_RETURN(RC,RC_REG) -#endif ! register an internal initialization method call NUOPC_CompSetInternalEntryPoint(EARTH_GRID_COMP, ESMF_METHOD_INITIALIZE, & @@ -246,7 +234,6 @@ subroutine SetModelServices(driver, rc) ! local variables integer :: localrc, stat, i, j, petCount character(ESMF_MAXSTR) :: name - type(WRAP_EARTH_INTERNAL_STATE) :: is type(ESMF_GridComp) :: comp type(ESMF_Config) :: config character(len=32), allocatable :: compLabels(:) @@ -270,14 +257,6 @@ subroutine SetModelServices(driver, rc) call ESMF_GridCompGet(driver, name=name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! allocate memory for the internal state and store in Component - allocate(is%EARTH_INT_STATE, stat=stat) - if (ESMF_LogFoundAllocError(statusToCheck=stat, & - msg="Allocation of internal state memory failed.", & - line=__LINE__, file=trim(name)//":"//__FILE__, rcToReturn=rc)) & - return ! bail out - call ESMF_GridCompSetInternalState(driver, is, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return ! get petCount and config call ESMF_GridCompGet(driver, petCount=petCount, config=config, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -526,38 +505,6 @@ subroutine SetRunSequence(driver, rc) end subroutine - !----------------------------------------------------------------------------- - - subroutine Finalize(driver, rc) - type(ESMF_GridComp) :: driver - integer, intent(out) :: rc - - ! local variables - integer :: localrc, stat - type(WRAP_EARTH_INTERNAL_STATE) :: is - logical :: existflag - character(ESMF_MAXSTR) :: name - - rc = ESMF_SUCCESS - - ! query the Component for info - call ESMF_GridCompGet(driver, name=name, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! query Component for this internal State - nullify(is%EARTH_INT_STATE) - call ESMF_GridCompGetInternalState(driver, is, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! deallocate internal state memory - deallocate(is%EARTH_INT_STATE, stat=stat) - if (ESMF_LogFoundDeallocError(statusToCheck=stat, & - msg="Deallocation of internal state memory failed.", & - line=__LINE__, file=trim(name)//":"//__FILE__, rcToReturn=rc)) & - return ! bail out - - end subroutine - !----------------------------------------------------------------------------- recursive subroutine ModifyCplLists(driver, importState, exportState, clock, & @@ -572,15 +519,9 @@ recursive subroutine ModifyCplLists(driver, importState, exportState, clock, & integer :: i, j, cplListSize character(len=160), allocatable :: cplList(:) character(len=160) :: value - type(WRAP_EARTH_INTERNAL_STATE) :: is rc = ESMF_SUCCESS - ! query Component for this internal State - nullify(is%EARTH_INT_STATE) - call ESMF_GridCompGetInternalState(driver, is, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite("Driver is in ModifyCplLists()", ESMF_LOGMSG_INFO) nullify(connectorList) diff --git a/src/module_EARTH_INTERNAL_STATE.F90 b/src/module_EARTH_INTERNAL_STATE.F90 deleted file mode 100644 index 00693c3b..00000000 --- a/src/module_EARTH_INTERNAL_STATE.F90 +++ /dev/null @@ -1,45 +0,0 @@ -#include "./ESMFVersionDefine.h" - -!----------------------------------------------------------------------- -! - MODULE module_EARTH_INTERNAL_STATE -! -!----------------------------------------------------------------------- -!*** Contents of the ESMF internal state of the EARTH component. -!----------------------------------------------------------------------- -! - USE ESMF -! -!----------------------------------------------------------------------- -! - IMPLICIT NONE -! -!----------------------------------------------------------------------- -! - PRIVATE -! - PUBLIC :: EARTH_INTERNAL_STATE, & - WRAP_EARTH_INTERNAL_STATE -! -!----------------------------------------------------------------------- -! - TYPE EARTH_INTERNAL_STATE -! - real(ESMF_KIND_R8) :: medAtmCouplingIntervalSec - real(ESMF_KIND_R8) :: medOcnCouplingIntervalSec -! - END TYPE EARTH_INTERNAL_STATE -! -!----------------------------------------------------------------------- -! - TYPE WRAP_EARTH_INTERNAL_STATE -! - TYPE(EARTH_INTERNAL_STATE),POINTER :: EARTH_INT_STATE -! - END TYPE WRAP_EARTH_INTERNAL_STATE -! -!----------------------------------------------------------------------- -! - END MODULE module_EARTH_INTERNAL_STATE -! -!----------------------------------------------------------------------- diff --git a/src/module_NEMS_GRID_COMP.F90 b/src/module_NEMS_GRID_COMP.F90 index 394cdc2c..acc4f1a4 100644 --- a/src/module_NEMS_GRID_COMP.F90 +++ b/src/module_NEMS_GRID_COMP.F90 @@ -34,9 +34,6 @@ MODULE module_NEMS_GRID_COMP !----------------------------------------------------------------------- ! USE ESMF -! - USE module_NEMS_INTERNAL_STATE,ONLY: NEMS_INTERNAL_STATE & - ,WRAP_NEMS_INTERNAL_STATE ! USE module_EARTH_GRID_COMP ! @@ -63,9 +60,6 @@ MODULE module_NEMS_GRID_COMP CHARACTER(ESMF_MAXSTR) :: IMP_EARTH_NAME !<-- Import state name of the EARTH components CHARACTER(ESMF_MAXSTR) :: EXP_EARTH_NAME !<-- Export state name of the EARTH components CHARACTER(ESMF_MAXSTR) :: GC_EARTH_NAME !<-- Name of the EARTH component -! - TYPE(NEMS_INTERNAL_STATE),POINTER,SAVE :: NEMS_INT_STATE - TYPE(WRAP_NEMS_INTERNAL_STATE) ,SAVE :: WRAP ! TYPE(ESMF_Clock), SAVE :: CLOCK_NEMS !<-- The ESMF Clock of the NEMS component TYPE(ESMF_Config),SAVE :: CF_NEMS !<-- The configure object of the NEMS component @@ -237,19 +231,6 @@ SUBROUTINE NEMS_INITIALIZE(NEMS_GRID_COMP & ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! !----------------------------------------------------------------------- -!*** Allocate the NEMS component's internal state, point at it, -!*** and attach it to the NEMS component. -!----------------------------------------------------------------------- -! - ALLOCATE(NEMS_INT_STATE,stat=RC) - wrap%NEMS_INT_STATE=>NEMS_INT_STATE -! - CALL ESMF_GridCompSetInternalState(NEMS_GRID_COMP & !<--The NEMS component - ,WRAP & !<-- Pointer to the NEMS internal state - ,RC) - ESMF_ERR_RETURN(RC,RC_INIT) -! -!----------------------------------------------------------------------- !*** Get the global VM (Virtual Machine). !*** Obtain the total task count and the local task ID. !----------------------------------------------------------------------- diff --git a/src/module_NEMS_INTERNAL_STATE.F90 b/src/module_NEMS_INTERNAL_STATE.F90 deleted file mode 100644 index e0263989..00000000 --- a/src/module_NEMS_INTERNAL_STATE.F90 +++ /dev/null @@ -1,46 +0,0 @@ -#include "./ESMFVersionDefine.h" - -!----------------------------------------------------------------------- -! - MODULE module_NEMS_INTERNAL_STATE -! -!----------------------------------------------------------------------- -!*** Contents of the ESMF internal state of the NEMS component. -!----------------------------------------------------------------------- -! - USE ESMF -! -!----------------------------------------------------------------------- -! - IMPLICIT NONE -! -!----------------------------------------------------------------------- -! - PRIVATE -! - PUBLIC :: NEMS_INTERNAL_STATE & - ,WRAP_NEMS_INTERNAL_STATE -! -!----------------------------------------------------------------------- -! - TYPE NEMS_INTERNAL_STATE -! - REAL :: DUMMY1 -! - END TYPE NEMS_INTERNAL_STATE -! -!----------------------------------------------------------------------- -! - TYPE WRAP_NEMS_INTERNAL_STATE -! - REAL :: DUMMY2 -! - TYPE(NEMS_INTERNAL_STATE),POINTER :: NEMS_INT_STATE -! - END TYPE WRAP_NEMS_INTERNAL_STATE -! -!----------------------------------------------------------------------- -! - END MODULE module_NEMS_INTERNAL_STATE -! -!----------------------------------------------------------------------- From 585cae0f977c10d01b61d37146d6f6d59b374f75 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 3 May 2021 09:04:48 -0400 Subject: [PATCH 12/12] replace ifdef IBM to fix gnu compile failure /scratch2/NCEPDEV/nwprod/hpc-stack/src/hpc-stack/pkg/upp-upp_v10.0.6/sorc/ncep_post.fd/PROCESS.f:81: undefined reference to `timef_' --- src/MAIN_NEMS.F90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/MAIN_NEMS.F90 b/src/MAIN_NEMS.F90 index 890c36cf..250a16cc 100644 --- a/src/MAIN_NEMS.F90 +++ b/src/MAIN_NEMS.F90 @@ -662,3 +662,13 @@ PROGRAM MAIN_NEMS END PROGRAM MAIN_NEMS ! !----------------------------------------------------------------------- + +#ifndef IBM + REAL(8) FUNCTION RTC() + RTC = 0.d0 + END FUNCTION + + REAL(8) FUNCTION TIMEF() + TIMEF = 0.d0 + END FUNCTION +#endif