From 3a8b481cf8b72848c7aa619fefc286bf42e9aac2 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 8 May 2026 09:33:18 -0700 Subject: [PATCH 01/16] Replace ESMX_Data implementation with NRL version of Navy-ESPC espc-ecosystem hash 5a24d65. --- src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 | 3836 +++++++++++------- src/addon/ESMX/Comps/ESMX_Data/README.md | 143 +- 2 files changed, 2557 insertions(+), 1422 deletions(-) diff --git a/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 b/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 index f862315f6b..64a369bc32 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 +++ b/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 @@ -1,13 +1,13 @@ -module esmx_data +module ESMX_Data !----------------------------------------------------------------------------- - ! X Component + ! ESMX Data Component !----------------------------------------------------------------------------- use ESMF use NUOPC - use NUOPC_Model, & - modelSS => SetServices + use NUOPC_ModelBase, & + modelBaseSS => SetServices implicit none @@ -15,65 +15,39 @@ module esmx_data public SetServices, SetVM - ! parameters - real(ESMF_KIND_R8), parameter :: filv = -1.0E34_ESMF_KIND_R8 - - ! derived types - type xdata_field - character(len=64) :: stdn = "dummy" - integer :: fdim = 2 - real(ESMF_KIND_R8) :: dflt = filv - logical :: rlze = .false. - real(ESMF_KIND_R8) :: minv = filv - real(ESMF_KIND_R8) :: maxv = filv - logical :: okay = .true. - real(ESMF_KIND_R8) :: lmin(1) = filv - real(ESMF_KIND_R8) :: gmin(1) = filv - real(ESMF_KIND_R8) :: lmax(1) = filv - real(ESMF_KIND_R8) :: gmax(1) = filv - real(ESMF_KIND_R8) :: lsum(2) = filv - real(ESMF_KIND_R8) :: gsum(2) = filv - real(ESMF_KIND_R8) :: gavg = filv - type(ESMF_Field), pointer :: efld => null() - real(ESMF_KIND_R8), pointer :: ptr2(:,:) => null() - real(ESMF_KIND_R8), pointer :: ptr3(:,:,:) => null() - type(xdata_field), pointer :: nfld => null() - endtype xdata_field - - type xdata_state - ! component information - character(32) :: cname = "XDATA" - integer :: verbosity = 0 - integer :: diagnostic = 0 - logical :: write_final = .true. - integer :: myid = -1 - integer :: outid = 0 - type(ESMF_VM) :: vm - ! grid information - integer :: nx = 64 - integer :: ny = 32 - integer :: nz = 4 - real(ESMF_KIND_R8) :: minx = -126.000_ESMF_KIND_R8 - real(ESMF_KIND_R8) :: maxx = -64.000_ESMF_KIND_R8 - real(ESMF_KIND_R8) :: miny = 22.000_ESMF_KIND_R8 - real(ESMF_KIND_R8) :: maxy = 50.000_ESMF_KIND_R8 - type(ESMF_CoordSys_Flag) :: coordSys = ESMF_COORDSYS_SPH_DEG - type(ESMF_Grid) :: grid - ! field information - type(xdata_field), pointer :: imp_flds_head => null() - type(xdata_field), pointer :: exp_flds_head => null() - type(xdata_field), pointer :: imp_flds_tail => null() - type(xdata_field), pointer :: exp_flds_tail => null() - endtype xdata_state - - type xstate_wrap - type(xdata_state), pointer :: ptr - endtype xstate_wrap + type GeomItem + character(len=:), allocatable :: name + type(ESMF_Geom) :: geom + end type + + type ImportItem + type(ESMF_Field) :: field + logical :: dataDiagnose + character(len=:), allocatable :: dataValidate + end type + + type ExportItem + type(ESMF_Field) :: field + logical :: dataDiagnose + character(len=:), allocatable :: dataValidate + character(len=:), allocatable :: dataAdvance + end type + + type InternalStateStruct + character(len=:), allocatable :: timeKeeping ! "Model" or "Mediator" + type(GeomItem), allocatable :: geomItems(:) + type(ImportItem), allocatable :: importItems(:) + type(ExportItem), allocatable :: exportItems(:) + end type + + type InternalState + type(InternalStateStruct), pointer :: wrap + end type + + !----------------------------------------------------------------------------- contains - !----------------------------------------------------------------------------- - ! X Component Specialization !----------------------------------------------------------------------------- subroutine SetServices(xdata, rc) @@ -81,1560 +55,2690 @@ subroutine SetServices(xdata, rc) type(ESMF_GridComp) :: xdata integer, intent(out) :: rc ! local variables + character(ESMF_MAXSTR) :: name integer :: stat - type(xstate_wrap) :: is - type(xdata_state), pointer :: xstate + type(InternalState) :: is character(len=64) :: value type(ESMF_HConfig) :: hconfig, hconfigNode - character(80) :: compLabel character(:), allocatable :: badKey logical :: isFlag rc = ESMF_SUCCESS + ! query the component for info + call NUOPC_CompGet(xdata, name=name, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + ! derive generic model phases - call NUOPC_CompDerive(xdata, modelSS, rc=rc) + call NUOPC_CompDerive(xdata, modelBaseSS, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out ! allocate memory for this internal state and set it in the component - allocate(is%ptr, stat=stat) + allocate(is%wrap, stat=stat) if (ESMF_LogFoundAllocError(statusToCheck=stat, & - msg='XDATA: Memory allocation failed.', & - line=__LINE__, & - file=__FILE__, & - rcToReturn=rc)) return - call ESMF_GridCompSetInternalState(xdata, is, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xstate => is%ptr - if (.not. associated(xstate)) then - call ESMF_LogSetError(ESMF_RC_PTR_NOTALLOC, & - msg='XDATA: xstate has not been associated', & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - - ! query component for information - call NUOPC_CompGet(xdata, name=xstate%cname, & - verbosity=xstate%verbosity, diagnostic=xstate%diagnostic, rc=rc) + msg="Allocation of the internal state memory failed.", & + line=__LINE__, file=trim(name)//":"//__FILE__, & + rcToReturn=rc)) return ! bail out + call ESMF_InternalStateAdd(xdata, internalState=is, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out ! specialize model call NUOPC_CompSpecialize(xdata, specLabel=label_Advertise, & specRoutine=Advertise, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out call NUOPC_CompSpecialize(xdata, specLabel=label_RealizeProvided, & specRoutine=Realize, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out call NUOPC_CompSpecialize(xdata, specLabel=label_DataInitialize, & specRoutine=DataInitialize, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call NUOPC_CompSpecialize(xdata, specLabel=label_CheckImport, & - specRoutine=CheckImport, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out call NUOPC_CompSpecialize(xdata, specLabel=label_Advance, & - specRoutine=ModelAdvance, rc=rc) + specRoutine=Advance, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call NUOPC_CompSpecialize(xdata, specLabel=label_Finalize, & - specRoutine=ModelFinalize, rc=rc) + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + call NUOPC_CompSpecialize(xdata, specLabel=label_TimestampExport, & + specRoutine=TimestampExport, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - - ! query component for vm and local pet - call ESMF_GridCompGet(xdata, vm=xstate%vm, & - localPet=xstate%myid, rc=rc) + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + call NUOPC_CompSpecialize(xdata, specLabel=label_Finalize, & + specRoutine=Finalize, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out ! validate config - call ESMF_GridCompGet(xdata, name=compLabel, configIsPresent=isFlag, rc=rc) + call ESMF_GridCompGet(xdata, hconfigIsPresent=isFlag, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out if (isFlag) then ! Config present, assert it is in the ESMX YAML format call ESMF_GridCompGet(xdata, hconfig=hconfig, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - hconfigNode = ESMF_HConfigCreateAt(hconfig, keyString=compLabel, rc=rc) + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + hconfigNode = ESMF_HConfigCreateAt(hconfig, keyString=trim(name), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - ! component responsibility to validate ESMX handled options here, and - ! potentially locally handled options + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + + ! component responsibility to validate ESMX handled options here, + ! and potentially locally handled options isFlag = ESMF_HConfigValidateMapKeys(hconfigNode, & vocabulary=["model ", & ! ESMX_Driver handled option "petList ", & ! ESMX_Driver handled option + "devList ", & ! ESMX_Driver handled option "ompNumThreads", & ! ESMX_Driver handled option "stdout ", & ! ESMX_Driver handled option "stderr ", & ! ESMX_Driver handled option "attributes ", & ! ESMX_Driver handled option - "output ", & ! ESMX_Data handled option - "geom ", & ! ESMX_Data handled option + "timeKeeping ", & ! ESMX_Data handled option + "geometries ", & ! ESMX_Data handled option "importFields ", & ! ESMX_Data handled option "exportFields " & ! ESMX_Data handled option ], badKey=badKey, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out if (.not.isFlag) then call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & - msg="An invalid key was found in config under "//trim(compLabel)// & - " (maybe a typo?): "//badKey, & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return + msg="An invalid key was found for component '"//trim(name)// & + "' (maybe a typo?): "//badKey, & + line=__LINE__, file=trim(name)//":"//__FILE__, rcToReturn=rc) + return ! bail out endif + + ! ingest hconfig + call IngestFromHConfig(hconfigNode, is%wrap%timeKeeping, & + is%wrap%geomItems, is%wrap%importItems, is%wrap%exportItems, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg="Problem ingesting hconfig.", & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + endif - endsubroutine SetServices + end subroutine SetServices !----------------------------------------------------------------------------- - subroutine Advertise(xdata, rc) - ! arguments - type(ESMF_GridComp) :: xdata - integer, intent(out) :: rc + subroutine IngestFromHConfig(hconfig, timeKeeping, geoms, imports, exports, & + rc) + type(ESMF_HConfig), intent(in) :: hconfig + character(len=:), allocatable, intent(out) :: timeKeeping + type(GeomItem), allocatable, intent(out) :: geoms(:) + type(ImportItem), allocatable, intent(out) :: imports(:) + type(ExportItem), allocatable, intent(out) :: exports(:) + integer, intent(out) :: rc + ! local variables - integer :: stat - type(xstate_wrap) :: is - type(ESMF_State) :: importState, exportState - type(xdata_state), pointer :: xstate - type(xdata_field), pointer :: xfield => null() + character(len=:), allocatable :: tempString + logical :: isFlag + type(ESMF_HConfig) :: hconfigNode + type(ESMF_HConfigIter) :: hconfigIt, hconfigItBegin, hconfigItEnd + integer :: itemCount, item - rc = ESMF_SUCCESS + rc=ESMF_SUCCESS - ! query component for internal state - nullify(is%ptr) - call ESMF_GridCompGetInternalState(xdata, is, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xstate => is%ptr - if (.not. associated(xstate)) then - call ESMF_LogSetError(ESMF_RC_PTR_NOTALLOC, & - msg='XDATA: xstate has not been associated', & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif + ! handle timeKeeping + tempString = ESMF_HConfigAsString(hconfig, keyString="timeKeeping", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg="Must specify 'timeKeeping'!", & + line=__LINE__, file=__FILE__)) return ! bail out - ! get configuration information - call x_comp_get_config(xdata, xstate, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + timeKeeping = ESMF_UtilStringUpperCase(tempString, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg="Must specify 'timeKeeping'!", & + line=__LINE__, file=__FILE__)) return ! bail out - ! query component for information - call NUOPC_CompGet(xdata, name=xstate%cname, & - verbosity=xstate%verbosity, diagnostic=xstate%diagnostic, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + if (timeKeeping /= "MODEL" .and. timeKeeping /= "MEDIATOR") then + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="An invalid setting was found for 'timeKeeping' "// & + "(maybe a typo?): "//tempString, & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif - ! query for importState and exportState - call NUOPC_ModelGet(xdata, importState=importState, & - exportState=exportState, rc=rc) + ! handle geometries + isFlag = ESMF_HConfigIsDefined(hconfig, keyString="geometries", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + line=__LINE__, file=__FILE__)) return ! bail out - ! advertise import fields - xfield => xstate%imp_flds_head - do while (associated(xfield)) - call NUOPC_Advertise(importState, xfield%stdn, rc=rc) + if (isFlag) then + ! ingest geometries + hconfigNode = ESMF_HConfigCreateAt(hconfig, keyString="geometries", & + rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xfield => xfield%nfld - enddo - - ! advertise export fields - xfield => xstate%exp_flds_head - do while (associated(xfield)) - call NUOPC_Advertise(exportState, xfield%stdn, rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + itemCount = ESMF_HConfigGetSize(hconfigNode, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xfield => xfield%nfld - enddo - endsubroutine Advertise + line=__LINE__, file=__FILE__)) return ! bail out - !----------------------------------------------------------------------------- + if (itemCount>0) then + allocate(geoms(itemCount)) - subroutine Realize(xdata, rc) - ! arguments - type(ESMF_GridComp) :: xdata - integer, intent(out) :: rc - ! local variables - integer :: stat - type(xstate_wrap) :: is - type(ESMF_State) :: importState, exportState - type(xdata_state), pointer :: xstate - type(xdata_field), pointer :: xfield + hconfigItBegin = ESMF_HConfigIterBegin(hconfigNode, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - rc = ESMF_SUCCESS + hconfigItEnd = ESMF_HConfigIterEnd(hconfigNode, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - ! query component for internal state - nullify(is%ptr) - call ESMF_GridCompGetInternalState(xdata, is, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xstate => is%ptr - if (.not. associated(xstate)) then - call ESMF_LogSetError(ESMF_RC_PTR_NOTALLOC, & - msg='XDATA: xstate has not been associated', & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif + item = 0 + hconfigIt = hconfigItBegin + do while (ESMF_HConfigIterLoop(hconfigIt, hconfigItBegin, & + hconfigItEnd, rc=rc)) + ! error check ESMF_HConfigIterLoop() + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + item = item+1 - ! query component for information - call NUOPC_CompGet(xdata, name=xstate%cname, & - verbosity=xstate%verbosity, diagnostic=xstate%diagnostic, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + geoms(item)%geom = GeomCreateFromHConfig(hconfigIt, & + name=geoms(item)%name, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - ! query for importState and exportState - call NUOPC_ModelGet(xdata, importState=importState, & - exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + enddo + ! error check ESMF_HConfigIterLoop() + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - ! create grid - xstate%grid = ESMF_GridCreateNoPeriDimUfrm( & - name=trim(xstate%cname)//"_grid", & - minIndex=(/1, 1/), maxIndex=(/xstate%nx, xstate%ny/), & - minCornerCoord=(/xstate%minx,xstate%miny/), & - maxCornerCoord=(/xstate%maxx,xstate%maxy/), & - staggerLocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), & - coordSys=xstate%coordSys, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + endif - ! write grid to NetCDF file - if (btest(xstate%diagnostic,16)) then - call x_comp_grid_diag(xstate, trim(xstate%cname)//"_grid.nc", rc=rc) + call ESMF_HConfigDestroy(hconfigNode, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + line=__LINE__, file=__FILE__)) return ! bail out + endif - ! realize import fields - xfield => xstate%imp_flds_head - do while (associated(xfield)) - call x_comp_realize_field(xstate, xfield, importState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xfield => xfield%nfld - enddo + ! handle importFields + isFlag = ESMF_HConfigIsDefined(hconfig, keyString="importFields", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - ! realize export fields - xfield => xstate%exp_flds_head - do while (associated(xfield)) - call x_comp_realize_field(xstate, xfield, exportState, rc=rc) + if (isFlag) then + ! ingest importFields + hconfigNode = ESMF_HConfigCreateAt(hconfig, keyString="importFields", & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + itemCount = ESMF_HConfigGetSize(hconfigNode, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xfield => xfield%nfld - enddo - endsubroutine Realize + line=__LINE__, file=__FILE__)) return ! bail out - !----------------------------------------------------------------------------- + if (itemCount>0) then + allocate(imports(itemCount)) - subroutine DataInitialize(xdata, rc) - ! arguments - type(ESMF_GridComp) :: xdata - integer, intent(out) :: rc - ! local variables - integer :: stat - type(xstate_wrap) :: is - type(xdata_state), pointer :: xstate - type(xdata_field), pointer :: xfield - type(ESMF_State) :: importState - type(ESMF_State) :: exportState + hconfigItBegin = ESMF_HConfigIterBegin(hconfigNode, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - rc = ESMF_SUCCESS + hconfigItEnd = ESMF_HConfigIterEnd(hconfigNode, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - ! query component for internal state - nullify(is%ptr) - call ESMF_GridCompGetInternalState(xdata, is, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xstate => is%ptr - if (.not. associated(xstate)) then - call ESMF_LogSetError(ESMF_RC_PTR_NOTALLOC, & - msg='XDATA: xstate has not been associated', & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif + item = 0 + hconfigIt = hconfigItBegin + do while (ESMF_HConfigIterLoop(hconfigIt, hconfigItBegin, & + hconfigItEnd, rc=rc)) + ! error check ESMF_HConfigIterLoop() + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + item = item+1 + + imports(item)%field = FieldCreateFromHConfig(hconfigIt, geoms=geoms, & + dataDiagnose=imports(item)%dataDiagnose, & + dataValidate=imports(item)%dataValidate, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, & + msg="Problem creating import field.", & + line=__LINE__, file=__FILE__)) return ! bail out + + enddo + ! error check ESMF_HConfigIterLoop() + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - ! query component for information - call NUOPC_CompGet(xdata, name=xstate%cname, & - verbosity=xstate%verbosity, diagnostic=xstate%diagnostic, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + endif - ! query component for import and export states - call NUOPC_ModelGet(xdata, importState=importState, & - exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + call ESMF_HConfigDestroy(hconfigNode, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - ! reset import fields - xfield => xstate%imp_flds_head - do while (associated(xfield)) - if (xfield%rlze) then - call ESMF_FieldFill(xfield%efld, dataFillScheme="const", & - const1=xfield%dflt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - endif - xfield => xfield%nfld - enddo - - ! reset export fields - xfield => xstate%exp_flds_head - do while (associated(xfield)) - if (xfield%rlze) then - call ESMF_FieldFill(xfield%efld, dataFillScheme="const", & - const1=xfield%dflt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call NUOPC_SetAttribute(xfield%efld, & - name="Updated", value="true", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - endif - xfield => xfield%nfld - enddo + endif - call NUOPC_CompAttributeSet(xdata, & - name="InitializeDataComplete", value="true", rc=rc) + ! handle exportFields + isFlag = ESMF_HConfigIsDefined(hconfig, keyString="exportFields", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + line=__LINE__, file=__FILE__)) return ! bail out - endsubroutine DataInitialize + if (isFlag) then + ! ingest exportFields + hconfigNode = ESMF_HConfigCreateAt(hconfig, keyString="exportFields", & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + itemCount = ESMF_HConfigGetSize(hconfigNode, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - !----------------------------------------------------------------------------- + if (itemCount>0) then + allocate(exports(itemCount)) - subroutine CheckImport(xdata, rc) - ! arguments - type(ESMF_GridComp) :: xdata - integer,intent(out) :: rc - ! local variables - integer :: stat - type(xstate_wrap) :: is - type(xdata_state), pointer :: xstate - type(ESMF_Clock) :: modelClock - type(ESMF_Time) :: modelCurrTime - type(ESMF_State) :: importState - logical :: allCurrTime + hconfigItBegin = ESMF_HConfigIterBegin(hconfigNode, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - rc = ESMF_SUCCESS + hconfigItEnd = ESMF_HConfigIterEnd(hconfigNode, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - ! query component for internal State - nullify(is%ptr) - call ESMF_GridCompGetInternalState(xdata, is, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xstate => is%ptr - if (.not. associated(xstate)) then - call ESMF_LogSetError(ESMF_RC_PTR_NOTALLOC, & - msg='XDATA: xstate has not been associated', & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif + item = 0 + hconfigIt = hconfigItBegin + do while (ESMF_HConfigIterLoop(hconfigIt, hconfigItBegin, & + hconfigItEnd, rc=rc)) + ! error check ESMF_HConfigIterLoop() + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + item = item+1 + + exports(item)%field = FieldCreateFromHConfig(hconfigIt, geoms=geoms, & + dataDiagnose=exports(item)%dataDiagnose, & + dataValidate=exports(item)%dataValidate, & + dataAdvance=exports(item)%dataAdvance, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, & + msg="Problem creating export field.", & + line=__LINE__, file=__FILE__)) return ! bail out + + enddo + ! error check ESMF_HConfigIterLoop() + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - ! query component for information - call NUOPC_CompGet(xdata, name=xstate%cname, & - verbosity=xstate%verbosity, diagnostic=xstate%diagnostic, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + endif - ! query the component for its clock and import state - call NUOPC_ModelGet(xdata, modelClock=modelClock, & - importState=importState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + call ESMF_HConfigDestroy(hconfigNode, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - ! get the stop time out of the clock - call ESMF_ClockGet(modelClock, currTime=modelCurrTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - allCurrTime = NUOPC_IsAtTime(importState, modelCurrTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - if (.NOT.allCurrTime) then - call ESMF_LogWrite(trim(xstate%cname)//": "// & - "NUOPC INCOMPATIBILITY DETECTED: Import Fields not at current time", & - ESMF_LOGMSG_WARNING) endif - endsubroutine CheckImport - - !----------------------------------------------------------------------------- - subroutine ModelAdvance(xdata, rc) - ! arguments - type(ESMF_GridComp) :: xdata - integer, intent(out) :: rc - ! local variables - integer :: stat - type(xstate_wrap) :: is - type(xdata_state), pointer :: xstate - type(xdata_field), pointer :: xfield - type(ESMF_Clock) :: modelClock - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - character(len=160) :: clockString - integer :: errCount + end subroutine IngestFromHConfig - rc = ESMF_SUCCESS + !----------------------------------------------------------------------------- - ! query component for internal state - nullify(is%ptr) - call ESMF_GridCompGetInternalState(xdata, is, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xstate => is%ptr - if (.not. associated(xstate)) then - call ESMF_LogSetError(ESMF_RC_PTR_NOTALLOC, & - msg='XDATA: xstate has not been associated', & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif + function FieldCreateFromHConfig(hconfig, geoms, dataDiagnose, dataValidate, & + dataAdvance, rc) + type(ESMF_Field) :: FieldCreateFromHConfig + type(ESMF_HConfigIter), intent(in) :: hconfig + type(GeomItem), intent(in) :: geoms(:) + logical, intent(out) :: dataDiagnose + character(len=:), allocatable, intent(out) :: dataValidate + character(len=:), allocatable, intent(out), optional :: dataAdvance + integer, intent(out) :: rc - ! query component for information - call NUOPC_CompGet(xdata, name=xstate%cname, & - verbosity=xstate%verbosity, diagnostic=xstate%diagnostic, rc=rc) + ! local variables + logical :: isFlag + type(ESMF_HConfig) :: hconfigMap + character(:), allocatable :: geometry, name, badkey, string + type(ESMF_Grid) :: grid + integer :: item + type(ESMF_TypeKind_Flag) :: typekind + integer, allocatable :: gridToFieldMap(:) + integer, allocatable :: ungriddedLBound(:) + integer, allocatable :: ungriddedUBound(:) + type(ESMF_Info) :: info + integer(ESMF_KIND_I4) :: valueI4 + integer(ESMF_KIND_I8) :: valueI8 + real(ESMF_KIND_R4) :: valueR4 + real(ESMF_KIND_R8) :: valueR8 + character(len=20), allocatable:: vocabulary(:) + + rc=ESMF_SUCCESS + + name = ESMF_HConfigAsStringMapKey(hconfig, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + line=__LINE__, file=__FILE__)) return ! bail out - ! query component for import and export states - call NUOPC_ModelGet(xdata, modelClock=modelClock, & - importState=importState, exportState=exportState, rc=rc) + ! assert this to be a map element + hconfigMap = ESMF_HConfigCreateAtMapVal(hconfig, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_ClockPrint(modelClock, options="currTime", & - unit=clockString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + line=__LINE__, file=__FILE__)) return ! bail out - ! write to standard out - if (xstate%myid .eq. xstate%outid) then - write(*,'(A,1X,A)') trim(xstate%cname)//": Model Advance",trim(clockString) - endif + isFlag = ESMF_HConfigIsMap(hconfigMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - ! sum import data from all PETs - xfield => xstate%imp_flds_head - errCount = 0 - if (xstate%myid .eq. xstate%outid) then - write(*,'(A)') trim(xstate%cname)//": Import Fields" - write(*,'(A,1X,A25,1X,A9,3(1X,A9),1X,A4)') & - trim(xstate%cname)//":", "FIELD", & - "COUNT", "MEAN", & - "MIN", "MAX", & - "OKAY" - endif - do while (associated(xfield)) - call x_comp_check_field(xstate, xfield, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - if (xstate%myid .eq. xstate%outid) then - write(*,'(A,1X,A25,1X,I9,3(1X,E9.2),1X,L4)') & - trim(xstate%cname)//":", trim(xfield%stdn), & - int(xfield%gsum(2)), xfield%gavg, & - xfield%gmin(1), xfield%gmax(1), & - xfield%okay - if (.not. xfield%okay) errCount = errCount + 1 - endif - xfield => xfield%nfld - enddo - - ! sum export data from all PETs - xfield => xstate%exp_flds_head - if (xstate%myid .eq. xstate%outid) then - write(*,'(A)') trim(xstate%cname)//": Export Fields" - write(*,'(A,1X,A25,1X,A9,3(1X,A9))') & - trim(xstate%cname)//":", "FIELD", & - "COUNT", "MEAN", & - "MIN", "MAX" - endif - do while (associated(xfield)) - call x_comp_check_field(xstate, xfield, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - if (xstate%myid .eq. xstate%outid) then - write(*,'(A,1X,A25,1X,I9,3(1X,E9.2))') & - trim(xstate%cname)//":", trim(xfield%stdn), & - int(xfield%gsum(2)), xfield%gavg, & - xfield%gmin(1), xfield%gmax(1) + if (isFlag) then + ! validate keys in map + if (present(dataAdvance)) then + vocabulary=["geometry ", & + "gridToFieldMap ", & + "ungriddedLBound", & + "ungriddedUBound", & + "dataInit ", & + "dataMask ", & + "dataMin ", & + "dataMax ", & + "typekind ", & + "dataDiagnose ", & + "dataValidate ", & + "dataAdvance " ] + else + vocabulary=["geometry ", & + "gridToFieldMap ", & + "ungriddedLBound", & + "ungriddedUBound", & + "dataInit ", & + "dataMask ", & + "dataMin ", & + "dataMax ", & + "typekind ", & + "dataDiagnose ", & + "dataValidate " ] + end if + isFlag = ESMF_HConfigValidateMapKeys(hconfigMap, vocabulary=vocabulary, & + badKey=badKey, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (.not.isFlag) then + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="An invalid key was found for field '"//trim(name)//"' "// & + "(maybe a typo?): "//badKey, & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out endif - xfield => xfield%nfld - enddo - - ! check for errors - if (errCount .gt. 0) then - write(*,'(A)') trim(xstate%cname)//": ERROR - check import fields" - call ESMF_LogSetError(ESMF_RC_VAL_OUTOFRANGE, & - msg=trim(xstate%cname)//": import field error, check output", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - endsubroutine ModelAdvance - - !----------------------------------------------------------------------------- - - subroutine ModelFinalize(xdata, rc) - ! arguments - type(ESMF_GridComp) :: xdata - integer, intent(out) :: rc - ! local variables - integer :: stat - type(xstate_wrap) :: is - type(xdata_state), pointer :: xstate - type(xdata_field), pointer :: xfield - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - integer :: fc - type(ESMF_Field), pointer :: fl(:) - type(ESMF_FieldBundle) :: fb - character(ESMF_MAXSTR) :: fieldName - - rc = ESMF_SUCCESS - - ! query component for internal state - nullify(is%ptr) - call ESMF_GridCompGetInternalState(xdata, is, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xstate => is%ptr - if (.not. associated(xstate)) then - call ESMF_LogSetError(ESMF_RC_PTR_NOTALLOC, & - msg='XDATA: xstate has not been associated', & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif + ! handle geometry (required) + isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="geometry", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest + geometry = ESMF_HConfigAsString(hconfigMap, keyString="geometry", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else + ! error + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="The 'geometry' key is required, but missing for field '"//& + name//"'!", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif - ! query component for information - call NUOPC_CompGet(xdata, name=xstate%cname, & - verbosity=xstate%verbosity, diagnostic=xstate%diagnostic, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + ! search for match in geoms list + do item=1, size(geoms) + if (geoms(item)%name == geometry) exit + enddo - ! access import- and exportState - call NUOPC_ModelGet(xdata, importState=importState, & - exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + if (item == size(geoms)+1) then + ! error condition + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="Unknown geometry for field '"//trim(name)//"': "//geometry, & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif - ! write final import and export states - if (xstate%write_final) then - call NUOPC_GetStateMemberCount(importState, fieldCount=fc, rc=rc) + ! handle typekind (required) + isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="typekind", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - if (fc .gt. 0) then - nullify(fl) - call NUOPC_GetStateMemberLists(importState, fieldList=fl, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - fb = ESMF_FieldBundleCreate(fieldList=fl, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_FieldBundleWrite(fb, & - fileName=trim(xstate%cname)//"_final_import.nc", & - overwrite=.true., rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest + string = ESMF_HConfigAsString(hconfigMap, keyString="typekind", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_FieldBundleDestroy(fb, rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + string = ESMF_UtilStringUpperCase(string, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - deallocate(fl) + line=__LINE__, file=__FILE__)) return ! bail out + select case (string) + case ("I4") + typekind = ESMF_TYPEKIND_I4 + case ("I8") + typekind = ESMF_TYPEKIND_I8 + case ("R4") + typekind = ESMF_TYPEKIND_R4 + case ("R8") + typekind = ESMF_TYPEKIND_R8 + case default + call ESMF_LogSetError(ESMF_RC_ARG_VALUE, & + msg="Invalid value for typekind: "//string, & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + end select + else + ! error + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="The 'typekind' key is required, but missing for field '"//& + name//"'!", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out endif - call NUOPC_GetStateMemberCount(exportState, fieldCount=fc, rc=rc) + + ! handle gridToFieldMap (optional) + isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="gridToFieldMap", & + rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - if (fc .gt. 0) then - nullify(fl) - call NUOPC_GetStateMemberLists(exportState, fieldList=fl, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - fb = ESMF_FieldBundleCreate(fieldList=fl, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_FieldBundleWrite(fb, & - fileName=trim(xstate%cname)//"_final_export.nc", & - overwrite=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_FieldBundleDestroy(fb, rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest + gridToFieldMap = ESMF_HConfigAsI4Seq(hconfigMap, & + keyString="gridToFieldMap", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - deallocate(fl) + line=__LINE__, file=__FILE__)) return ! bail out endif - endif - - ! remove import fields from importState and destroy - do while (associated(xstate%imp_flds_head)) - xfield => xstate%imp_flds_head - xstate%imp_flds_head => xfield%nfld - call ESMF_FieldGet(xfield%efld, name=fieldName, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_StateRemove(importState, (/fieldName/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_FieldDestroy(xfield%efld, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - deallocate(xfield, stat=stat) - if (ESMF_LogFoundDeallocError(statusToCheck=stat, & - msg=trim(xstate%cname)//': Memory deallocation failed.', & - line=__LINE__, & - file=__FILE__, & - rcToReturn=rc)) return - nullify(xfield) - enddo - xstate%imp_flds_tail => null() - - ! remove export fields from exportState and destroy - do while (associated(xstate%exp_flds_head)) - xfield => xstate%exp_flds_head - xstate%exp_flds_head => xfield%nfld - call ESMF_FieldGet(xfield%efld, name=fieldName, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_StateRemove(exportState, (/fieldName/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_FieldDestroy(xfield%efld, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - deallocate(xfield, stat=stat) - if (ESMF_LogFoundDeallocError(statusToCheck=stat, & - msg=trim(xstate%cname)//': Memory deallocation failed.', & - line=__LINE__, & - file=__FILE__, & - rcToReturn=rc)) return - nullify(xfield) - enddo - xstate%exp_flds_tail => null() - - ! destroy grid - call ESMF_GridDestroy(xstate%grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - - deallocate(xstate, stat=stat) - if (ESMF_LogFoundDeallocError(statusToCheck=stat, & - msg='XDATA: Memory deallocation failed.', & - line=__LINE__, & - file=__FILE__, & - rcToReturn=rc)) return - endsubroutine ModelFinalize - !----------------------------------------------------------------------------- - ! X Comp Internal Subroutines - !----------------------------------------------------------------------------- + ! handle ungriddedLBound (optional) + isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="ungriddedLBound", & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest + ungriddedLBound = ESMF_HConfigAsI4Seq(hconfigMap, & + keyString="ungriddedLBound", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + endif - subroutine x_comp_get_config(xdata, xstate, rc) - ! arguments - type(ESMF_GridComp) :: xdata - type(xdata_state), pointer, intent(inout) :: xstate - integer, intent(out) :: rc - ! local variables - logical :: isPresent - integer :: stat - logical :: check - type(ESMF_HConfig) :: hconfig - type(ESMF_HConfig) :: xdatacfg + ! handle ungriddedUBound (optional) + isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="ungriddedUBound", & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest + ungriddedUBound = ESMF_HConfigAsI4Seq(hconfigMap, & + keyString="ungriddedUBound", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + endif - rc = ESMF_SUCCESS + ! create the field + FieldCreateFromHConfig = ESMF_FieldCreate(geoms(item)%geom, & + typekind=typekind, gridToFieldMap=gridToFieldMap, & + ungriddedLBound=ungriddedLBound, ungriddedUBound=ungriddedUBound, & + name=name, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - if (.not. associated(xstate)) then - call ESMF_LogSetError(ESMF_RC_PTR_NOTALLOC, & - msg='XDATA: xstate has not been associated', & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif + ! access the info object + call ESMF_InfoGetFromHost(FieldCreateFromHConfig, info=info, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_GridCompGet(xdata, configIsPresent=isPresent, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - if (isPresent) then - ! get hconfig from component - call ESMF_GridCompGet(xdata, hconfig=hconfig, rc=rc) + ! handle dataInit (optional) + isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="dataInit", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - isPresent = ESMF_HConfigIsDefined(hconfig, & - keyString=xstate%cname, rc=rc) - if (isPresent) then - ! access xdatacfg - xdatacfg = ESMF_HConfigCreateAt(hconfig, & - keyString=xstate%cname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call x_comp_read_output(xdatacfg, xstate, rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest key and set as field info metadata + call InfoIngestFromHConfig(info, hconfigMap, key="dataInit", & + typekind=typekind, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call x_comp_read_geom(xdatacfg, xstate, rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + ! for now call FieldFill() right here... this may move into realize + ! always use valueR8, because that is what FieldFill() takes for const + if (typekind == ESMF_TYPEKIND_I4) then + call ESMF_InfoGet(info, key="dataInit", value=valueI4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + valueR8 = real(valueI4,ESMF_KIND_R8) + else if (typekind == ESMF_TYPEKIND_I8) then + call ESMF_InfoGet(info, key="dataInit", value=valueI8, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + valueR8 = real(valueI8,ESMF_KIND_R8) + else if (typekind == ESMF_TYPEKIND_R4) then + call ESMF_InfoGet(info, key="dataInit", value=valueR4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + valueR8 = real(valueR4,ESMF_KIND_R8) + else if (typekind == ESMF_TYPEKIND_R8) then + call ESMF_InfoGet(info, key="dataInit", value=valueR8, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + endif + call ESMF_FieldFill(FieldCreateFromHConfig, dataFillScheme="const", & + const1=valueR8, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call x_comp_read_fields(xdatacfg, xstate, rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + endif + + ! handle dataMask (optional) + isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="dataMask", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest key and set as field info metadata + call InfoIngestFromHConfig(info, hconfigMap, key="dataMask", & + typekind=typekind, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_HConfigDestroy(xdatacfg, rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + endif + + ! handle dataMin (optional) + isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="dataMin", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest key and set as field info metadata + call InfoIngestFromHConfig(info, hconfigMap, key="dataMin", & + typekind=typekind, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - endif ! xdatacfg - endif ! config + line=__LINE__, file=__FILE__)) return ! bail out + endif - endsubroutine x_comp_get_config + ! handle dataMax (optional) + isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="dataMax", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest key and set as field info metadata + call InfoIngestFromHConfig(info, hconfigMap, key="dataMax", & + typekind=typekind, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + endif - !----------------------------------------------------------------------------- + ! handle dataDiagnose (optional) + isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="dataDiagnose", & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! dataDiagnose key provided -> read value + dataDiagnose = ESMF_HConfigAsLogical(hconfigMap, & + keyString="dataDiagnose", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else + ! dataDiagnose key not provided, default + dataDiagnose = .false. + endif - subroutine x_comp_read_output(xdatacfg, xstate, rc) - ! arguments - type(ESMF_HConfig) :: xdatacfg - type(xdata_state), pointer, intent(inout) :: xstate - integer, intent(out) :: rc - ! local variables - logical :: isPresent - integer :: stat - logical :: check - type(ESMF_HConfig) :: outcfg - character(:), allocatable :: cfgval - character(:), allocatable :: badKey + ! handle dataValidate (optional) + isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="dataValidate", & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! dataValidate key provided -> read value string + dataValidate = ESMF_HConfigAsString(hconfigMap, & + keyString="dataValidate", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + dataValidate = ESMF_UtilStringUpperCase(dataValidate, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else + ! dataValidate key not provided, default + dataValidate = "NO" + endif - rc = ESMF_SUCCESS + ! handle dataAdvance (optional) + if (present(dataAdvance)) then + isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="dataAdvance", & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! dataAdvance key provided -> read value string + dataAdvance = ESMF_HConfigAsString(hconfigMap, & + keyString="dataAdvance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else + ! dataAdvance key not provided, default + dataAdvance = "" ! NOOP + endif + endif - if (.not. associated(xstate)) then - call ESMF_LogSetError(ESMF_RC_PTR_NOTALLOC, & - msg='XDATA: xstate has not been associated', & + else + ! not a map -> error condition + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="The value associated with key '"//trim(name)//"' "// & + "under 'geometries' must be a map!", & line=__LINE__, file=__FILE__, rcToReturn=rc) - return + return ! bail out endif - ! read output configuration - isPresent = ESMF_HConfigIsDefined(xdatacfg, & - keyString="output", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - if (isPresent) then - ! access output - outcfg = ESMF_HConfigCreateAt(xdatacfg, & - keyString="output", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - check = ESMF_HConfigValidateMapKeys(outcfg, & - vocabulary=["write_final"], badKey=badKey, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - if (.not. check) then - call ESMF_LogSetError(ESMF_RC_NOT_VALID, & - msg=trim(xstate%cname)//": unknown output option key - "//badKey, & - line=__LINE__,file=__FILE__, rcToReturn=rc) - return - endif - ! options - xstate%write_final = x_comp_hconfig_logical(outcfg, "write_final", & - defaultValue=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_HConfigDestroy(outcfg, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - endif ! outcfg + call ESMF_HConfigDestroy(hconfigMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - endsubroutine x_comp_read_output + end function !----------------------------------------------------------------------------- - subroutine x_comp_read_geom(xdatacfg, xstate, rc) - ! arguments - type(ESMF_HConfig) :: xdatacfg - type(xdata_state), pointer, intent(inout) :: xstate - integer, intent(out) :: rc - ! local variables - logical :: isPresent - integer :: stat - logical :: check - type(ESMF_HConfig) :: geomcfg - character(len=64) :: cfgval - character(:), allocatable :: badKey + subroutine InfoIngestFromHConfig(info, hconfig, key, typekind, rc) + type(ESMF_Info), intent(inout) :: info + type(ESMF_HConfig), intent(in) :: hconfig + character(*), intent(in) :: key + type(ESMF_TypeKind_Flag), intent(in) :: typekind + integer, intent(out) :: rc - rc = ESMF_SUCCESS + ! local variables + integer(ESMF_KIND_I4) :: valueI4 + integer(ESMF_KIND_I8) :: valueI8 + real(ESMF_KIND_R4) :: valueR4 + real(ESMF_KIND_R8) :: valueR8 - if (.not. associated(xstate)) then - call ESMF_LogSetError(ESMF_RC_PTR_NOTALLOC, & - msg='XDATA: xstate has not been associated', & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif + rc=ESMF_SUCCESS - ! read geom configuration - isPresent = ESMF_HConfigIsDefined(xdatacfg, & - keyString="geom", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - if (isPresent) then - ! access geom - geomcfg = ESMF_HConfigCreateAt(xdatacfg, & - keyString="geom", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - check = ESMF_HConfigValidateMapKeys(geomcfg, & - vocabulary=["nx ", & - "ny ", & - "nz ", & - "coordSys", & - "minx ", & - "maxx ", & - "miny ", & - "maxy " & - ], badKey=badKey, rc=rc) + if (typekind == ESMF_TYPEKIND_I4) then + valueI4 = ESMF_HConfigAsI4(hconfig, keyString=key, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - if (.not. check) then - call ESMF_LogSetError(ESMF_RC_NOT_VALID, & - msg=trim(xstate%cname)//": unknown geom option key - "//badKey, & - line=__LINE__,file=__FILE__, rcToReturn=rc) - return - endif - ! dimensions - xstate%nx = x_comp_hconfig_i4(geomcfg, "nx", & - defaultValue=64, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xstate%ny = x_comp_hconfig_i4(geomcfg, "ny", & - defaultValue=32, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xstate%nz = x_comp_hconfig_i4(geomcfg, "nz", & - defaultValue=4, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - ! coordinate system - cfgval = x_comp_hconfig_str(geomcfg, "coordSys", & - defaultValue="ESMF_COORDSYS_SPH_DEG", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - cfgval = ESMF_UtilStringUpperCase(cfgval, rc=rc) - select case (cfgval) - case ("ESMF_COORDSYS_CART") - xstate%coordSys = ESMF_COORDSYS_CART - case ("ESMF_COORDSYS_SPH_DEG") - xstate%coordSys = ESMF_COORDSYS_SPH_DEG - case ("ESMF_COORDSYS_SPH_RAD") - xstate%coordSys = ESMF_COORDSYS_SPH_RAD - case default - call ESMF_LogSetError(ESMF_RC_ARG_VALUE, & - msg=trim(xstate%cname)//': invalid value - coordSys', & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endselect - ! coordinates - xstate%minx = x_comp_hconfig_r8(geomcfg, "minx", & - defaultValue=-126.0_ESMF_KIND_R8, rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_InfoSet(info, key=key, value=valueI4, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xstate%maxx = x_comp_hconfig_r8(geomcfg, "maxx", & - defaultValue=-64.0_ESMF_KIND_R8, rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + else if (typekind == ESMF_TYPEKIND_I8) then + valueI8 = ESMF_HConfigAsI8(hconfig, keyString=key, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xstate%miny = x_comp_hconfig_r8(geomcfg, "miny", & - defaultValue=22.0_ESMF_KIND_R8, rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_InfoSet(info, key=key, value=valueI8, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xstate%maxy = x_comp_hconfig_r8(geomcfg, "maxy", & - defaultValue=50.0_ESMF_KIND_R8, rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + else if (typekind == ESMF_TYPEKIND_R4) then + valueR4 = ESMF_HConfigAsR4(hconfig, keyString=key, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_HConfigDestroy(geomcfg, rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_InfoSet(info, key=key, value=valueR4, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - endif ! geomcfg - - endsubroutine x_comp_read_geom - - !----------------------------------------------------------------------------- - - subroutine x_comp_read_fields(xdatacfg, xstate, rc) - ! arguments - type(ESMF_HConfig) :: xdatacfg - type(xdata_state), pointer, intent(inout) :: xstate - integer, intent(out) :: rc - ! local variables - logical :: isPresent - integer :: stat - logical :: check - type(ESMF_HConfig) :: flistcfg - type(ESMF_HConfig) :: fieldcfg - type(ESMF_HConfigIter) :: flistcur - type(ESMF_HConfigIter) :: flistbeg - type(ESMF_HConfigIter) :: flistend - character(:), allocatable :: fname - type(xdata_field), pointer :: xfield - character(:), allocatable :: badKey - - rc = ESMF_SUCCESS - - if (.not. associated(xstate)) then - call ESMF_LogSetError(ESMF_RC_PTR_NOTALLOC, & - msg='XDATA: xstate has not been associated', & + line=__LINE__, file=__FILE__)) return ! bail out + else if (typekind == ESMF_TYPEKIND_R8) then + valueR8 = ESMF_HConfigAsR8(hconfig, keyString=key, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_InfoSet(info, key=key, value=valueR8, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else + call ESMF_LogSetError(ESMF_RC_ARG_VALUE, & + msg="Unsupported typekind setting!", & line=__LINE__, file=__FILE__, rcToReturn=rc) - return + return ! bail out endif - ! read import field configuration - isPresent = ESMF_HConfigIsDefined(xdatacfg, & - keyString="importFields", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - if (isPresent) then - ! access flistcfg(import) - flistcfg = ESMF_HConfigCreateAt(xdatacfg, & - keyString="importFields", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - flistbeg = ESMF_HConfigIterBegin(flistcfg, rc=rc) - flistend = ESMF_HConfigIterEnd(flistcfg, rc=rc) - flistcur = flistbeg - do while (ESMF_HConfigIterLoop(flistcur, flistbeg, flistend, rc=rc)) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - fname = ESMF_HConfigAsStringMapKey(flistcur, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - ! access fieldcfg - fieldcfg = ESMF_HConfigCreateAt(flistcfg, keyString=fname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - check = ESMF_HConfigValidateMapKeys(fieldcfg, & - vocabulary=["dim", & - "min", & - "max" & - ], badKey=badKey, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - if (.not. check) then - call ESMF_LogSetError(ESMF_RC_NOT_VALID, & - msg=trim(xstate%cname)//": ("//fname//")"// & - " unknown importFields option key - "//badKey, & - line=__LINE__,file=__FILE__, rcToReturn=rc) - return - endif - nullify(xfield) - allocate(xfield, stat=stat) - if (ESMF_LogFoundAllocError(statusToCheck=stat, & - msg=trim(xstate%cname)//': Memory allocation failed.', & - line=__LINE__, & - file=__FILE__, & - rcToReturn=rc)) return - xfield%stdn = fname - xfield%fdim = x_comp_hconfig_i4(fieldcfg, "dim", & - defaultValue=2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xfield%okay = .false. - xfield%lsum = (/filv, 0.0_ESMF_KIND_R8/) - xfield%lmin = filv - xfield%lmax = filv - xfield%gsum = (/filv, 0.0_ESMF_KIND_R8/) - xfield%gmin = filv - xfield%gmax = filv - xfield%gavg = filv - xfield%minv = x_comp_hconfig_r8(fieldcfg, "min", & - defaultValue=0.0_ESMF_KIND_R8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xfield%maxv = x_comp_hconfig_r8(fieldcfg, "max", & - defaultValue=0.0_ESMF_KIND_R8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xfield%dflt = filv - xfield%nfld => null() - if (.not. associated(xstate%imp_flds_head)) then - xstate%imp_flds_head => xfield - xstate%imp_flds_tail => xfield - else - xstate%imp_flds_tail%nfld => xfield - xstate%imp_flds_tail => xfield - endif - call ESMF_HConfigDestroy(fieldcfg, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - enddo ! fieldcfg - call ESMF_HConfigDestroy(flistcfg, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - endif ! flistcfg - - ! read export field configuration - isPresent = ESMF_HConfigIsDefined(xdatacfg, & - keyString="exportFields", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - if (isPresent) then - ! access flistcfg(export) - flistcfg = ESMF_HConfigCreateAt(xdatacfg, & - keyString="exportFields", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - flistbeg = ESMF_HConfigIterBegin(flistcfg, rc=rc) - flistend = ESMF_HConfigIterEnd(flistcfg, rc=rc) - flistcur = flistbeg - do while (ESMF_HConfigIterLoop(flistcur, flistbeg, flistend, rc=rc)) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - fname = ESMF_HConfigAsStringMapKey(flistcur, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - ! access fieldcfg - fieldcfg = ESMF_HConfigCreateAt(flistcfg, keyString=fname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - check = ESMF_HConfigValidateMapKeys(fieldcfg, & - vocabulary=["dim", & - "val" & - ], badKey=badKey, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - if (.not. check) then - call ESMF_LogSetError(ESMF_RC_NOT_VALID, & - msg=trim(xstate%cname)//": ("//fname//")"// & - " unknown exportFields option key - "//badKey, & - line=__LINE__,file=__FILE__, rcToReturn=rc) - return - endif - nullify(xfield) - allocate(xfield, stat=stat) - if (ESMF_LogFoundAllocError(statusToCheck=stat, & - msg=trim(xstate%cname)//': Memory allocation failed.', & - line=__LINE__, & - file=__FILE__, & - rcToReturn=rc)) return - xfield%stdn = fname - xfield%fdim = x_comp_hconfig_i4(fieldcfg, "dim", & - defaultValue=2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xfield%okay = .false. - xfield%lsum = (/filv, 0.0_ESMF_KIND_R8/) - xfield%lmin = filv - xfield%lmax = filv - xfield%gsum = (/filv, 0.0_ESMF_KIND_R8/) - xfield%gmin = filv - xfield%gmax = filv - xfield%gavg = filv - xfield%minv = 0.0_ESMF_KIND_R8 - xfield%maxv = 0.0_ESMF_KIND_R8 - xfield%dflt = x_comp_hconfig_r8(fieldcfg, "val", & - defaultValue=0.0_ESMF_KIND_R8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xfield%nfld => null() - if (.not. associated(xstate%exp_flds_head)) then - xstate%exp_flds_head => xfield - xstate%exp_flds_tail => xfield - else - xstate%exp_flds_tail%nfld => xfield - xstate%exp_flds_tail => xfield - endif - call ESMF_HConfigDestroy(fieldcfg, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - enddo ! fieldcfg - call ESMF_HConfigDestroy(flistcfg, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - endif ! flistcfg - - endsubroutine x_comp_read_fields + end subroutine !----------------------------------------------------------------------------- - subroutine x_comp_grid_diag(xstate, fileName, overwrite, status, timeslice, & - iofmt, relaxedflag, rc) - ! arguments - type(xdata_state), pointer, intent(in) :: xstate - character(len=*), intent(in), optional :: fileName - logical, intent(in), optional :: overwrite - type(ESMF_FileStatus_Flag), intent(in), optional :: status - integer, intent(in), optional :: timeslice - type(ESMF_IOFmt_Flag), intent(in), optional :: iofmt - logical, intent(in), optional :: relaxedflag - integer, intent(out) :: rc - ! local variables - logical :: ioCapable - logical :: doItFlag - character(len=64) :: lfileName - character(len=64) :: gridName - type(ESMF_Array) :: array - type(ESMF_ArrayBundle) :: arraybundle - logical :: isPresent - integer :: dimCount - integer :: dimIndex - integer,allocatable :: coordDimCount(:) - integer :: coordDimMax - integer :: stat - logical :: hasCorners + function GeomCreateFromHConfig(hconfig, name, rc) + type(ESMF_Geom) :: GeomCreateFromHConfig + type(ESMF_HConfigIter), intent(in) :: hconfig + character(:), allocatable, intent(out) :: name + integer, intent(out) :: rc - rc = ESMF_SUCCESS + ! local variables + logical :: isFlag + type(ESMF_HConfig) :: hconfigMap + character(:), allocatable :: geom + type(ESMF_Grid) :: grid + type(ESMF_StaggerLoc) :: staggerLoc - if (.not. associated(xstate)) then - call ESMF_LogSetError(ESMF_RC_PTR_NOTALLOC, & - msg='XDATA: xstate has not been associated', & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif + rc=ESMF_SUCCESS - ioCapable = (ESMF_IO_PIO_PRESENT .and. & - (ESMF_IO_NETCDF_PRESENT .or. ESMF_IO_PNETCDF_PRESENT)) + name = ESMF_HConfigAsStringMapKey(hconfig, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - doItFlag = .true. ! default - if (present(relaxedFlag)) then - doItFlag = .not.relaxedflag .or. (relaxedflag.and.ioCapable) - endif + ! assert this to be a map element + hconfigMap = ESMF_HConfigCreateAtMapVal(hconfig, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - if (doItFlag) then + isFlag = ESMF_HConfigIsMap(hconfigMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - if (present(fileName)) then - lfileName = trim(fileName) - else - call ESMF_GridGet(xstate%grid, name=gridName, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - lfileName = trim(gridName)//".nc" - endif + if (isFlag) then + ! look for the geom key to determine the kind of geometry - arraybundle = ESMF_ArrayBundleCreate(rc=rc) + geom = ESMF_HConfigAsString(hconfigMap, keyString="geom", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - - ! -- centers -- + line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_GridGetCoord(xstate%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(xstate%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 ESMF_ArrayBundleAdd(arraybundle,(/array/),rc=rc) + if (geom == "grid1PeriDim") then + grid = Grid1PeriDimFromHConfig(hconfigMap, name=name, & + staggerLoc=staggerLoc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_GridGetCoord(xstate%grid, coordDim=2, & - staggerLoc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + GeomCreateFromHConfig = ESMF_GeomCreate(grid, staggerLoc=staggerLoc, & + 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) + line=__LINE__, file=__FILE__)) return ! bail out + else if (geom == "gridNoPeriDim") then + grid = GridNoPeriDimFromHConfig(hconfigMap, name=name, & + staggerLoc=staggerLoc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_ArrayBundleAdd(arraybundle,(/array/),rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + GeomCreateFromHConfig = ESMF_GeomCreate(grid, staggerLoc=staggerLoc, & + rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + line=__LINE__, file=__FILE__)) return ! bail out +! else if (geom == "mesh") then + else + ! error condition + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="Unknown geom for '"//trim(name)//"': "//geom, & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out endif - ! -- corners -- + else + ! not a map -> error condition + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="The value associated with key '"//trim(name)//"' "// & + "under 'geometries' must be a map!", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif - call ESMF_GridGetCoord(xstate%grid, staggerLoc=ESMF_STAGGERLOC_CORNER, & - isPresent=hasCorners, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - if (hasCorners) then - call ESMF_GridGetCoord(xstate%grid, coordDim=1, & - staggerLoc=ESMF_STAGGERLOC_CORNER, array=array, rc=rc) - if (.not. ESMF_LogFoundError(rcToCheck=rc)) 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 ESMF_ArrayBundleAdd(arraybundle,(/array/),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - endif - call ESMF_GridGetCoord(xstate%grid, coordDim=2, & - staggerLoc=ESMF_STAGGERLOC_CORNER, array=array, rc=rc) - if (.not. ESMF_LogFoundError(rcToCheck=rc)) 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 ESMF_ArrayBundleAdd(arraybundle,(/array/),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - endif - endif + call ESMF_HConfigDestroy(hconfigMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - ! -- mask -- + end function - call ESMF_GridGetItem(xstate%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(xstate%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 ESMF_ArrayBundleAdd(arraybundle,(/array/),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - endif + !----------------------------------------------------------------------------- - ! -- area -- + function Grid1PeriDimFromHConfig(hconfig, name, staggerLoc, rc) + type(ESMF_Grid) :: Grid1PeriDimFromHConfig + type(ESMF_HConfig), intent(in) :: hconfig + character(*), intent(in) :: name + type(ESMF_StaggerLoc), intent(out) :: staggerLoc + integer, intent(out) :: rc - call ESMF_GridGetItem(xstate%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(xstate%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 ESMF_ArrayBundleAdd(arraybundle,(/array/),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - endif + ! local variables + logical :: isFlag + character(:), allocatable :: badKey, string + integer, allocatable :: minIndex(:), maxIndex(:) + real(ESMF_KIND_R8), allocatable :: minCornerCoord(:), maxCornerCoord(:) + integer :: rank + type(ESMF_CoordSys_Flag), allocatable :: coordSys + logical, allocatable :: ignoreNonPeriCoord + + ! validate keys in map + isFlag = ESMF_HConfigValidateMapKeys(hconfig, & + vocabulary=["geom ", & + "minIndex ", & + "maxIndex ", & + "minCornerCoord ", & + "maxCornerCoord ", & + "coordSys ", & + "staggerLoc ", & + "ignoreNonPeriCoord " & + ], badKey=badKey, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (.not.isFlag) then + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="An invalid key was found for grid '"//trim(name)//"' "// & + "(maybe a typo?): "//badKey, & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif - call ESMF_ArrayBundleWrite(arraybundle, & - fileName=trim(lfileName),rc=rc) + ! handle maxIndex (required) + isFlag = ESMF_HConfigIsDefined(hconfig, keyString="maxIndex", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest + maxIndex = ESMF_HConfigAsI4Seq(hconfig, keyString="maxIndex", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + line=__LINE__, file=__FILE__)) return ! bail out + rank = size(maxIndex) + else + ! error + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="The 'maxIndex' key is required for '"//trim(name)//"'!", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif - call ESMF_ArrayBundleDestroy(arraybundle,rc=rc) + ! handle minIndex (optional) + isFlag = ESMF_HConfigIsDefined(hconfig, keyString="minIndex", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest + minIndex = ESMF_HConfigAsI4Seq(hconfig, keyString="minIndex", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + line=__LINE__, file=__FILE__)) return ! bail out endif - endsubroutine x_comp_grid_diag - - !----------------------------------------------------------------------------- - - subroutine x_comp_realize_field(xstate, xfield, state, rc) - ! arguments - type(xdata_state), pointer, intent(inout) :: xstate - type(xdata_field), pointer, intent(inout) :: xfield - type(ESMF_State), intent(inout) :: state - integer, intent(out) :: rc - ! local variables - integer :: stat - rc = ESMF_SUCCESS - - if (.not. associated(xstate)) then - call ESMF_LogSetError(ESMF_RC_PTR_NOTALLOC, & - msg='XDATA: xstate has not been associated', & + ! handle minCornerCoord (required) + isFlag = ESMF_HConfigIsDefined(hconfig, keyString="minCornerCoord", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest + minCornerCoord = ESMF_HConfigAsR8Seq(hconfig, & + keyString="minCornerCoord", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else + ! error + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="The 'minCornerCoord' key is required for '"//trim(name)//"'!", & line=__LINE__, file=__FILE__, rcToReturn=rc) - return + return ! bail out endif - if (.not. associated(xfield)) then - call ESMF_LogSetError(ESMF_RC_MEM_ALLOCATE, & - msg=trim(xstate%cname)//": xfield error", & - line=__LINE__, & - file=__FILE__, & - rcToReturn=rc) - return - endif - - if (associated(xfield%efld)) then - call ESMF_LogSetError(ESMF_RC_MEM_ALLOCATE, & - msg=trim(xstate%cname)//": ESMF_Field error - "//trim(xfield%stdn), & - line=__LINE__, & - file=__FILE__, & - rcToReturn=rc) - return + ! handle maxCornerCoord (required) + isFlag = ESMF_HConfigIsDefined(hconfig, keyString="maxCornerCoord", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest + maxCornerCoord = ESMF_HConfigAsR8Seq(hconfig, & + keyString="maxCornerCoord", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else + ! error + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="The 'maxCornerCoord' key is required for '"//trim(name)//"'!", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out endif - allocate(xfield%efld, stat=stat) - if (ESMF_LogFoundAllocError(statusToCheck=stat, & - msg=trim(xstate%cname)//': Memory allocation failed.', & - line=__LINE__, & - file=__FILE__, & - rcToReturn=rc)) return - if (xfield%fdim .eq. 3) then - xfield%efld = ESMF_FieldCreate(name=trim(xfield%stdn), grid=xstate%grid, & - typekind=ESMF_TYPEKIND_R8, gridToFieldMap=(/1,3/), & - ungriddedLBound=(/1/), ungriddedUBound=(/xstate%nz/), rc=rc) + ! handle coordSys (optional) + isFlag = ESMF_HConfigIsDefined(hconfig, keyString="coordSys", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest + string = ESMF_HConfigAsString(hconfig, keyString="coordSys", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_FieldGet(xfield%efld, farrayPtr=xfield%ptr3, rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + string = ESMF_UtilStringUpperCase(string, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - elseif (xfield%fdim .eq. 2) then - xfield%efld = ESMF_FieldCreate(name=trim(xfield%stdn), grid=xstate%grid, & - typekind=ESMF_TYPEKIND_R8, rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + allocate(coordSys) + select case (string) + case ("CART") + coordSys = ESMF_COORDSYS_CART + case ("SPH_DEG") + coordSys = ESMF_COORDSYS_SPH_DEG + case ("SPH_RAD") + coordSys = ESMF_COORDSYS_SPH_RAD + case default + call ESMF_LogSetError(ESMF_RC_ARG_VALUE, & + msg="Invalid value for coordSys: "//string, & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + end select + endif + + ! handle staggerLoc (optional) + isFlag = ESMF_HConfigIsDefined(hconfig, keyString="staggerLoc", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest + string = ESMF_HConfigAsString(hconfig, keyString="staggerLoc", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_FieldGet(xfield%efld, farrayPtr=xfield%ptr2, rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + string = ESMF_UtilStringUpperCase(string, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + line=__LINE__, file=__FILE__)) return ! bail out + select case (string) + case ("CENTER") + staggerLoc = ESMF_STAGGERLOC_CENTER + case ("CORNER") + staggerLoc = ESMF_STAGGERLOC_CORNER + case ("EDGE1") + staggerLoc = ESMF_STAGGERLOC_EDGE1 + case ("EDGE2") + staggerLoc = ESMF_STAGGERLOC_EDGE2 + case default + call ESMF_LogSetError(ESMF_RC_ARG_VALUE, & + msg="Invalid value for staggerLoc: "//string, & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + end select else - call ESMF_LogSetError(ESMF_RC_NOT_IMPL, & - msg=trim(xstate%cname)//": field dimension - "//trim(xfield%stdn), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return + ! default + staggerLoc = ESMF_STAGGERLOC_CENTER endif - call NUOPC_Realize(state, field=xfield%efld, rc=rc) + ! handle ignoreNonPeriCoord (optional) + isFlag = ESMF_HConfigIsDefined(hconfig, keyString="ignoreNonPeriCoord", & + rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_FieldFill(xfield%efld, dataFillScheme="const", & - const1=0.0_ESMF_KIND_R8, rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest + allocate(ignoreNonPeriCoord) + ignoreNonPeriCoord = ESMF_HConfigAsLogical(hconfig, & + keyString="ignoreNonPeriCoord", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + endif + + ! create the grid + Grid1PeriDimFromHConfig = ESMF_GridCreate1PeriDimUfrm(name=name, & + minIndex=minIndex, maxIndex=maxIndex, & + minCornerCoord=minCornerCoord, maxCornerCoord=maxCornerCoord, & + coordSys=coordSys, staggerLocList=[staggerLoc], & + ignoreNonPeriCoord=ignoreNonPeriCoord, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xfield%rlze = .true. - endsubroutine x_comp_realize_field + line=__LINE__, file=__FILE__)) return ! bail out - !----------------------------------------------------------------------------- + end function - subroutine x_comp_check_field(xstate, xfield, rc) - ! arguments - type(xdata_state), pointer, intent(in) :: xstate - type(xdata_field), pointer, intent(inout) :: xfield - integer, intent(out) :: rc - ! local variables + !----------------------------------------------------------------------------- - rc = ESMF_SUCCESS + function GridNoPeriDimFromHConfig(hconfig, name, staggerLoc, rc) + type(ESMF_Grid) :: GridNoPeriDimFromHConfig + type(ESMF_HConfig), intent(in) :: hconfig + character(*), intent(in) :: name + type(ESMF_StaggerLoc), intent(out) :: staggerLoc + integer, intent(out) :: rc - if (.not. associated(xstate)) then - call ESMF_LogSetError(ESMF_RC_PTR_NOTALLOC, & - msg='XDATA: xstate has not been associated', & + ! local variables + logical :: isFlag + character(:), allocatable :: badKey, string + integer, allocatable :: minIndex(:), maxIndex(:) + real(ESMF_KIND_R8), allocatable :: minCornerCoord(:), maxCornerCoord(:) + integer :: rank + type(ESMF_CoordSys_Flag), allocatable :: coordSys + + ! validate keys in map + isFlag = ESMF_HConfigValidateMapKeys(hconfig, & + vocabulary=["geom ", & + "minIndex ", & + "maxIndex ", & + "minCornerCoord ", & + "maxCornerCoord ", & + "coordSys ", & + "staggerLoc " & + ], badKey=badKey, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (.not.isFlag) then + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="An invalid key was found for grid '"//trim(name)//"' "// & + "(maybe a typo?): "//badKey, & line=__LINE__, file=__FILE__, rcToReturn=rc) - return + return ! bail out endif - if (xfield%rlze) then - if(xfield%fdim .eq. 3) then - xfield%lsum(1)=sum(xfield%ptr3,xfield%ptr3.ne.filv) - xfield%lsum(2)=count(xfield%ptr3.ne.filv) - xfield%lmin(1)=minval(xfield%ptr3,xfield%ptr3.ne.filv) - xfield%lmax(1)=maxval(xfield%ptr3,xfield%ptr3.ne.filv) - elseif(xfield%fdim .eq. 2) then - xfield%lsum(1)=sum(xfield%ptr2,xfield%ptr2.ne.filv) - xfield%lsum(2)=count(xfield%ptr2.ne.filv) - xfield%lmin(1)=minval(xfield%ptr2,xfield%ptr2.ne.filv) - xfield%lmax(1)=maxval(xfield%ptr2,xfield%ptr2.ne.filv) - else - call ESMF_LogSetError(ESMF_RC_NOT_IMPL, & - msg=trim(xstate%cname)//": field dimension - "//trim(xfield%stdn), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - call ESMF_VMReduce(vm=xstate%vm, sendData=xfield%lsum, & - recvData=xfield%gsum, count=2, & - reduceflag=ESMF_REDUCE_SUM, rootPet=xstate%outid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_VMReduce(vm=xstate%vm, sendData=xfield%lmin, & - recvData=xfield%gmin, count=1, & - reduceflag=ESMF_REDUCE_MIN, rootPet=xstate%outid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_VMReduce(vm=xstate%vm, sendData=xfield%lmax, & - recvData=xfield%gmax, count=1, & - reduceflag=ESMF_REDUCE_MAX, rootPet=xstate%outid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - if (xstate%myid .eq. xstate%outid) then - ! calculate average - if(xfield%gsum(2) .lt. 1) then - xfield%gavg = 0.0_ESMF_KIND_R8 - else - xfield%gavg = xfield%gsum(1) / xfield%gsum(2) - endif - ! check - if((xfield%gmin(1) .lt. xfield%minv) .or. & - (xfield%gmax(1) .gt. xfield%maxv)) then - xfield%okay = .false. - else - xfield%okay = .true. - endif - endif + ! handle maxIndex (required) + isFlag = ESMF_HConfigIsDefined(hconfig, keyString="maxIndex", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest + maxIndex = ESMF_HConfigAsI4Seq(hconfig, keyString="maxIndex", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + rank = size(maxIndex) else - xfield%gsum = (/filv, 0.0_ESMF_KIND_R8/) - xfield%gmin = filv - xfield%gmax = filv - xfield%gavg = 0.0_ESMF_KIND_R8 - xfield%okay = .false. + ! error + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="The 'maxIndex' key is required for '"//trim(name)//"'!", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out endif - endsubroutine x_comp_check_field - - !----------------------------------------------------------------------------- - - function x_comp_hconfig_i4(hconfig, key, defaultValue, rc) - ! return value - integer(ESMF_KIND_I4) :: x_comp_hconfig_i4 - ! arguments - type(ESMF_HConfig), intent(in) :: hconfig - character(*), intent(in) :: key - integer(ESMF_KIND_I4), intent(in), optional :: defaultValue - integer, intent(out) :: rc - ! local variables - logical :: isPresent - logical :: check - - rc = ESMF_SUCCESS - x_comp_hconfig_i4 = 0 - isPresent = ESMF_HConfigIsDefined(hconfig, keyString=key, rc=rc) + ! handle minIndex (optional) + isFlag = ESMF_HConfigIsDefined(hconfig, keyString="minIndex", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest + minIndex = ESMF_HConfigAsI4Seq(hconfig, keyString="minIndex", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + endif - if (isPresent) then - x_comp_hconfig_i4 = ESMF_HConfigAsI4(hconfig, keyString=key, & - asOkay=check, rc=rc) + ! handle minCornerCoord (required) + isFlag = ESMF_HConfigIsDefined(hconfig, keyString="minCornerCoord", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest + minCornerCoord = ESMF_HConfigAsR8Seq(hconfig, & + keyString="minCornerCoord", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - if (.not.check) then - call ESMF_LogSetError(ESMF_RC_NOT_VALID, & - msg="XDATA: Value cannot be converted to I4 - "//trim(key), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - elseif (present(defaultValue)) then - x_comp_hconfig_i4 = defaultValue + line=__LINE__, file=__FILE__)) return ! bail out else - call ESMF_LogSetError(ESMF_RC_NOT_FOUND, & - msg="XDATA: Key not found - "//trim(key), & + ! error + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="The 'minCornerCoord' key is required for '"//trim(name)//"'!", & line=__LINE__, file=__FILE__, rcToReturn=rc) - return + return ! bail out endif - endfunction x_comp_hconfig_i4 - - !----------------------------------------------------------------------------- - - function x_comp_hconfig_r8(hconfig, key, defaultValue, rc) - ! return value - real(ESMF_KIND_R8) :: x_comp_hconfig_r8 - ! arguments - type(ESMF_HConfig), intent(in) :: hconfig - character(*), intent(in) :: key - real(ESMF_KIND_R8), intent(in), optional :: defaultValue - integer, intent(out) :: rc - ! local variables - logical :: isPresent - logical :: check - rc = ESMF_SUCCESS - x_comp_hconfig_r8 = 0.0_ESMF_KIND_R8 - - isPresent = ESMF_HConfigIsDefined(hconfig, keyString=key, rc=rc) + ! handle maxCornerCoord (required) + isFlag = ESMF_HConfigIsDefined(hconfig, keyString="maxCornerCoord", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - - if (isPresent) then - x_comp_hconfig_r8 = ESMF_HConfigAsR8(hconfig, keyString=key, & - asOkay=check, rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest + maxCornerCoord = ESMF_HConfigAsR8Seq(hconfig, & + keyString="maxCornerCoord", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - if (.not.check) then - call ESMF_LogSetError(ESMF_RC_NOT_VALID, & - msg="XDATA: Value cannot be converted to R8 - "//trim(key), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - elseif (present(defaultValue)) then - x_comp_hconfig_r8 = defaultValue + line=__LINE__, file=__FILE__)) return ! bail out else - call ESMF_LogSetError(ESMF_RC_NOT_FOUND, & - msg="XDATA: Key not found - "//trim(key), & + ! error + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="The 'maxCornerCoord' key is required for '"//trim(name)//"'!", & line=__LINE__, file=__FILE__, rcToReturn=rc) - return + return ! bail out endif - endfunction x_comp_hconfig_r8 + + ! handle coordSys (optional) + isFlag = ESMF_HConfigIsDefined(hconfig, keyString="coordSys", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest + string = ESMF_HConfigAsString(hconfig, keyString="coordSys", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + string = ESMF_UtilStringUpperCase(string, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + allocate(coordSys) + select case (string) + case ("CART") + coordSys = ESMF_COORDSYS_CART + case ("SPH_DEG") + coordSys = ESMF_COORDSYS_SPH_DEG + case ("SPH_RAD") + coordSys = ESMF_COORDSYS_SPH_RAD + case default + call ESMF_LogSetError(ESMF_RC_ARG_VALUE, & + msg="Invalid value for coordSys: "//string, & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + end select + endif + + ! handle staggerLoc (optional) + isFlag = ESMF_HConfigIsDefined(hconfig, keyString="staggerLoc", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest + string = ESMF_HConfigAsString(hconfig, keyString="staggerLoc", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + string = ESMF_UtilStringUpperCase(string, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + select case (string) + case ("CENTER") + staggerLoc = ESMF_STAGGERLOC_CENTER + case ("CORNER") + staggerLoc = ESMF_STAGGERLOC_CORNER + case ("EDGE1") + staggerLoc = ESMF_STAGGERLOC_EDGE1 + case ("EDGE2") + staggerLoc = ESMF_STAGGERLOC_EDGE2 + case default + call ESMF_LogSetError(ESMF_RC_ARG_VALUE, & + msg="Invalid value for staggerLoc: "//string, & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + end select + else + ! default + staggerLoc = ESMF_STAGGERLOC_CENTER + endif + + ! create the grid + GridNoPeriDimFromHConfig = ESMF_GridCreateNoPeriDimUfrm(name=name, & + minIndex=minIndex, maxIndex=maxIndex, & + minCornerCoord=minCornerCoord, maxCornerCoord=maxCornerCoord, & + coordSys=coordSys, staggerLocList=[staggerLoc], rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + + end function + + !----------------------------------------------------------------------------- + + subroutine Advertise(xdata, rc) + ! arguments + type(ESMF_GridComp) :: xdata + integer, intent(out) :: rc + ! local variables + character(ESMF_MAXSTR) :: name, fieldName + integer :: stat, i + type(ESMF_State) :: importState, exportState + type(InternalState) :: is + + rc = ESMF_SUCCESS + + ! query the component for info + call NUOPC_CompGet(xdata, name=name, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + + ! query component for internal state + nullify(is%wrap) + call ESMF_InternalStateGet(xdata, internalState=is, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + + ! query for importState and exportState + call NUOPC_ModelBaseGet(xdata, importState=importState, & + exportState=exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + + ! advertise import fields + if (allocated(is%wrap%importItems)) then + do i=1, size(is%wrap%importItems) + call ESMF_FieldGet(is%wrap%importItems(i)%field, name=fieldName, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + call NUOPC_Advertise(importState, StandardName=fieldName, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + enddo + endif + + ! advertise export fields + if (allocated(is%wrap%exportItems)) then + do i=1, size(is%wrap%exportItems) + call ESMF_FieldGet(is%wrap%exportItems(i)%field, name=fieldName, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + call NUOPC_Advertise(exportState, StandardName=fieldName, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + enddo + endif + + end subroutine Advertise + + !----------------------------------------------------------------------------- + + subroutine Realize(xdata, rc) + ! arguments + type(ESMF_GridComp) :: xdata + integer, intent(out) :: rc + ! local variables + character(ESMF_MAXSTR) :: name + integer :: stat, i + type(ESMF_State) :: importState, exportState + type(InternalState) :: is + + rc = ESMF_SUCCESS + + ! query the component for info + call NUOPC_CompGet(xdata, name=name, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + + ! query component for internal state + nullify(is%wrap) + call ESMF_InternalStateGet(xdata, internalState=is, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + + ! query for importState and exportState + call NUOPC_ModelBaseGet(xdata, importState=importState, & + exportState=exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + + ! realize import fields + if (allocated(is%wrap%importItems)) then + do i=1, size(is%wrap%importItems) + call NUOPC_Realize(importState, is%wrap%importItems(i)%field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + enddo + endif + + ! realize export fields + if (allocated(is%wrap%exportItems)) then + do i=1, size(is%wrap%exportItems) + call NUOPC_Realize(exportState, is%wrap%exportItems(i)%field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + enddo + endif + + end subroutine Realize + + !----------------------------------------------------------------------------- + + subroutine DataInitialize(xdata, rc) + ! arguments + type(ESMF_GridComp) :: xdata + integer, intent(out) :: rc + ! local variables + character(ESMF_MAXSTR) :: name + integer :: diagnostic + integer :: stat, i + type(ESMF_Time) :: time + type(ESMF_Clock) :: clock + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(InternalState) :: is + logical :: neededCurrent + + rc = ESMF_SUCCESS + + ! query the component for info + call NUOPC_CompGet(xdata, name=name, diagnostic=diagnostic, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + + ! query component for internal state + nullify(is%wrap) + call ESMF_InternalStateGet(xdata, internalState=is, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + + ! query component for clock, import, and export states + call NUOPC_ModelBaseGet(xdata, clock=clock, & + importState=importState, exportState=exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + + ! see if all the fields in the importState are at current time + call ESMF_ClockGet(clock, currTime=time, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + neededCurrent = NUOPC_IsAtTime(importState, time=time, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (neededCurrent) then + ! indicate that data initialization is complete (breaking out of init-loop) + call NUOPC_CompAttributeSet(xdata, & + name="InitializeDataComplete", value="true", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + endif + + ! set all of the fields in the exportState as Updated + if (allocated(is%wrap%exportItems)) then + do i=1, size(is%wrap%exportItems) + call NUOPC_SetAttribute(is%wrap%exportItems(i)%field, & + name="Updated", value="true", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + enddo + endif + + ! Advance the data in export fields + call DataAdvance(importState, is%wrap%exportItems, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + + if (btest(diagnostic,17)) then + ! write fields of the importState + call NUOPC_Write(importState, & + fileNamePrefix="field_"//trim(name)//"_import_data_initialize_", & + status=ESMF_FILESTATUS_REPLACE, relaxedFlag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + ! write fields of the exportState + call NUOPC_Write(exportState, & + fileNamePrefix="field_"//trim(name)//"_export_data_initialize_", & + status=ESMF_FILESTATUS_REPLACE, relaxedFlag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + endif + + end subroutine DataInitialize !----------------------------------------------------------------------------- - function x_comp_hconfig_str(hconfig, key, defaultValue, rc) - ! return value - character(:), allocatable :: x_comp_hconfig_str + subroutine Advance(xdata, rc) ! arguments - type(ESMF_HConfig), intent(in) :: hconfig - character(*), intent(in) :: key - character(*), intent(in), optional :: defaultValue - integer, intent(out) :: rc + type(ESMF_GridComp) :: xdata + integer, intent(out) :: rc ! local variables - logical :: isPresent - logical :: check + character(ESMF_MAXSTR) :: name, fieldName + integer :: diagnostic + type(ESMF_Clock) :: clock + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + character(len=160) :: clockString + integer :: i, localPet + type(ESMF_FileStatus_Flag) :: filestatus + integer, save :: step=1 + type(InternalState) :: is + integer :: statsCount, warnCount, errCount + real(ESMF_KIND_R8) :: statsMean, statsMin, statsMax + logical :: statsOkay, headerPrinted rc = ESMF_SUCCESS - x_comp_hconfig_str = ' ' - isPresent = ESMF_HConfigIsDefined(hconfig, keyString=key, rc=rc) + ! query the component for info + call NUOPC_CompGet(xdata, name=name, diagnostic=diagnostic, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + + call ESMF_GridCompGet(xdata, localPet=localPet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + + ! query component for internal state + nullify(is%wrap) + call ESMF_InternalStateGet(xdata, internalState=is, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + + ! query component for import and export states + call NUOPC_ModelBaseGet(xdata, clock=clock, & + importState=importState, exportState=exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + call ESMF_ClockPrint(clock, options="currTime", & + unit=clockString, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + + if (btest(diagnostic,17)) then + ! write fields of the importState + filestatus=ESMF_FILESTATUS_OLD + if (step==1) filestatus=ESMF_FILESTATUS_REPLACE + call NUOPC_Write(importState, & + fileNamePrefix="field_"//trim(name)//"_import_advance_", & + timeslice=step, status=filestatus, relaxedFlag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + endif + + ! write to standard out + if (localPet == 0) then + write(*,'(A,1X,A)') trim(name)//": Model Advance at: ",trim(clockString) + endif + + ! reset counters + warnCount = 0 + errCount = 0 + + ! diagnose and check import fields + if (allocated(is%wrap%importItems)) then + headerPrinted = .false. + do i=1, size(is%wrap%importItems) + if (.not.is%wrap%importItems(i)%dataDiagnose .and. & + is%wrap%importItems(i)%dataValidate /= "WARN" .and. & + is%wrap%importItems(i)%dataValidate /= "ERR") cycle + call FieldStats(is%wrap%importItems(i)%field, statsCount=statsCount, & + statsMean=statsMean, statsMin=statsMin, statsMax=statsMax, & + statsOkay=statsOkay, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (is%wrap%importItems(i)%dataDiagnose .or. .not.statsOkay) then + if (localPet == 0) then + if (.not.headerPrinted) then + headerPrinted = .true. + write(*,'(A)') trim(name)//": Import Fields" + write(*,'(A,1X,A25,1X,A9,3(1X,A9),1X,A4)') & + trim(name)//":", "FIELD", "COUNT", "MEAN", "MIN", "MAX", "OKAY" + endif + call ESMF_FieldGet(is%wrap%importItems(i)%field, name=fieldName, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + write(*,'(A,1X,A25,1X,I9,3(1X,E9.2),1X,L4)') & + trim(name)//":", trim(fieldName), & + statsCount, statsMean, statsMin, statsMax, statsOkay + endif + endif + if (.not.statsOkay) then + if (is%wrap%importItems(i)%dataValidate == "WARN") & + warnCount = warnCount + 1 + if (is%wrap%importItems(i)%dataValidate == "ERR") & + errCount = errCount + 1 + endif + enddo + endif + + ! Advance the data in export fields + call DataAdvance(importState, is%wrap%exportItems, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + + ! diagnose and check export fields + if (allocated(is%wrap%exportItems)) then + headerPrinted = .false. + do i=1, size(is%wrap%exportItems) + if (.not.is%wrap%exportItems(i)%dataDiagnose .and. & + is%wrap%exportItems(i)%dataValidate /= "WARN" .and. & + is%wrap%exportItems(i)%dataValidate /= "ERR") cycle + call FieldStats(is%wrap%exportItems(i)%field, statsCount=statsCount, & + statsMean=statsMean, statsMin=statsMin, statsMax=statsMax, & + statsOkay=statsOkay, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + if (is%wrap%importItems(i)%dataDiagnose .or. .not.statsOkay) then + if (localPet == 0) then + if (.not.headerPrinted) then + headerPrinted = .true. + write(*,'(A)') trim(name)//": Export Fields" + write(*,'(A,1X,A25,1X,A9,3(1X,A9),1X,A4)') & + trim(name)//":", "FIELD", "COUNT", "MEAN", "MIN", "MAX", "OKAY" + endif + call ESMF_FieldGet(is%wrap%exportItems(i)%field, name=fieldName, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + write(*,'(A,1X,A25,1X,I9,3(1X,E9.2),1X,L4)') & + trim(name)//":", trim(fieldName), & + statsCount, statsMean, statsMin, statsMax, statsOkay + endif + endif + if (.not.statsOkay) then + if (is%wrap%exportItems(i)%dataValidate == "WARN") & + warnCount = warnCount + 1 + if (is%wrap%exportItems(i)%dataValidate == "ERR") & + errCount = errCount + 1 + endif + enddo + endif - if (isPresent) then - x_comp_hconfig_str = ESMF_HConfigAsString(hconfig, keyString=key, & - asOkay=check, rc=rc) + if (btest(diagnostic,17)) then + ! write fields of the exportState + filestatus=ESMF_FILESTATUS_OLD + if (step==1) filestatus=ESMF_FILESTATUS_REPLACE + call NUOPC_Write(exportState, & + fileNamePrefix="field_"//trim(name)//"_export_advance_", & + timeslice=step, status=filestatus, relaxedFlag=.true., rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - if (.not.check) then - call ESMF_LogSetError(ESMF_RC_NOT_VALID, & - msg="XDATA: Value cannot be converted to String - "//trim(key), & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + endif + + ! handle warnCount + if (warnCount > 0) then + call ESMF_LogWrite( & + msg="Found fields with value outside valid [min,max] range!", & + logmsgFlag=ESMF_LOGMSG_WARNING, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + endif + + ! handle errCount + if (errCount > 0) then + call ESMF_LogSetError(ESMF_RC_VAL_WRONG, & + msg="Found fields with value outside valid [min,max] range!", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + + ! increment step counter + step=step+1 + + end subroutine Advance + + !----------------------------------------------------------------------------- + + subroutine FieldStats(field, statsCount, statsMean, statsMin, statsMax, & + statsOkay, rc) + ! arguments + type(ESMF_Field) :: field + integer, intent(out) :: statsCount + real(ESMF_KIND_R8), intent(out) :: statsMean, statsMin, statsMax + logical, intent(out) :: statsOkay + integer, intent(out) :: rc + ! local variables + logical :: isFlag + type(ESMF_VM) :: vm + type(ESMF_TypeKind_Flag) :: typekind + integer :: rank + integer :: lcount(1), gcount(1) + real(ESMF_KIND_R8) :: lsum(1), lmin(1), lmax(1) + real(ESMF_KIND_R8) :: gsum(1), gmin(1), gmax(1) + real(ESMF_KIND_R8) :: dataMin, dataMax + logical :: dataMinSet, dataMaxSet + type(ESMF_Info) :: info + + 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 + + call ESMF_FieldGet(field, typekind=typekind, rank=rank, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_InfoGetFromHost(field, info=info, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + + if (rank == 2) then + if (typekind == ESMF_TYPEKIND_I4) then + block + integer(ESMF_KIND_I4), pointer :: fptr(:,:) + integer(ESMF_KIND_I4) :: dataMask, value + call ESMF_FieldGet(field, farrayPtr=fptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + isFlag = ESMF_InfoIsPresent(info, key="dataMask", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + call ESMF_InfoGet(info, key="dataMask", value=dataMask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + lcount(1) = count(fptr/=dataMask) + lsum(1) = sum(fptr, fptr/=dataMask) + lmin(1) = minval(fptr, fptr/=dataMask) + lmax(1) = maxval(fptr, fptr/=dataMask) + else + lcount(1) = size(fptr) + lsum(1) = sum(fptr) + lmin(1) = minval(fptr) + lmax(1) = maxval(fptr) + endif + dataMinSet = ESMF_InfoIsPresent(info, key="dataMin", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (dataMinSet) then + call ESMF_InfoGet(info, key="dataMin", value=value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + dataMin = real(value, ESMF_KIND_R8) + endif + dataMaxSet = ESMF_InfoIsPresent(info, key="dataMax", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (dataMaxSet) then + call ESMF_InfoGet(info, key="dataMax", value=value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + dataMax = real(value, ESMF_KIND_R8) + endif + end block + else if (typekind == ESMF_TYPEKIND_I8) then + block + integer(ESMF_KIND_I8), pointer :: fptr(:,:) + integer(ESMF_KIND_I8) :: dataMask, value + call ESMF_FieldGet(field, farrayPtr=fptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + isFlag = ESMF_InfoIsPresent(info, key="dataMask", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + call ESMF_InfoGet(info, key="dataMask", value=dataMask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + lcount(1) = count(fptr/=dataMask) + lsum(1) = sum(fptr, fptr/=dataMask) + lmin(1) = minval(fptr, fptr/=dataMask) + lmax(1) = maxval(fptr, fptr/=dataMask) + else + lcount(1) = size(fptr) + lsum(1) = sum(fptr) + lmin(1) = minval(fptr) + lmax(1) = maxval(fptr) + endif + dataMinSet = ESMF_InfoIsPresent(info, key="dataMin", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (dataMinSet) then + call ESMF_InfoGet(info, key="dataMin", value=value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + dataMin = real(value, ESMF_KIND_R8) + endif + dataMaxSet = ESMF_InfoIsPresent(info, key="dataMax", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (dataMaxSet) then + call ESMF_InfoGet(info, key="dataMax", value=value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + dataMax = real(value, ESMF_KIND_R8) + endif + end block + else if (typekind == ESMF_TYPEKIND_R4) then + block + real(ESMF_KIND_R4), pointer :: fptr(:,:) + real(ESMF_KIND_R4) :: dataMask, value + call ESMF_FieldGet(field, farrayPtr=fptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + isFlag = ESMF_InfoIsPresent(info, key="dataMask", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + call ESMF_InfoGet(info, key="dataMask", value=dataMask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + lcount(1) = count(fptr/=dataMask) + lsum(1) = sum(fptr, fptr/=dataMask) + lmin(1) = minval(fptr, fptr/=dataMask) + lmax(1) = maxval(fptr, fptr/=dataMask) + else + lcount(1) = size(fptr) + lsum(1) = sum(fptr) + lmin(1) = minval(fptr) + lmax(1) = maxval(fptr) + endif + dataMinSet = ESMF_InfoIsPresent(info, key="dataMin", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (dataMinSet) then + call ESMF_InfoGet(info, key="dataMin", value=value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + dataMin = real(value, ESMF_KIND_R8) + endif + dataMaxSet = ESMF_InfoIsPresent(info, key="dataMax", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (dataMaxSet) then + call ESMF_InfoGet(info, key="dataMax", value=value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + dataMax = real(value, ESMF_KIND_R8) + endif + end block + else if (typekind == ESMF_TYPEKIND_R8) then + block + real(ESMF_KIND_R8), pointer :: fptr(:,:) + real(ESMF_KIND_R8) :: dataMask, value + call ESMF_FieldGet(field, farrayPtr=fptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + isFlag = ESMF_InfoIsPresent(info, key="dataMask", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + call ESMF_InfoGet(info, key="dataMask", value=dataMask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + lcount(1) = count(fptr/=dataMask) + lsum(1) = sum(fptr, fptr/=dataMask) + lmin(1) = minval(fptr, fptr/=dataMask) + lmax(1) = maxval(fptr, fptr/=dataMask) + else + lcount(1) = size(fptr) + lsum(1) = sum(fptr) + lmin(1) = minval(fptr) + lmax(1) = maxval(fptr) + endif + dataMinSet = ESMF_InfoIsPresent(info, key="dataMin", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (dataMinSet) then + call ESMF_InfoGet(info, key="dataMin", value=value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + dataMin = real(value, ESMF_KIND_R8) + endif + dataMaxSet = ESMF_InfoIsPresent(info, key="dataMax", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (dataMaxSet) then + call ESMF_InfoGet(info, key="dataMax", value=value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + dataMax = real(value, ESMF_KIND_R8) + endif + end block + else + ! error condition: unsupported typekind + call ESMF_LogSetError(ESMF_RC_NOT_IMPL, & + msg="Unsupported typekind!", & line=__LINE__, file=__FILE__, rcToReturn=rc) - return + return ! bail out + endif + else if (rank == 3) then + if (typekind == ESMF_TYPEKIND_I4) then + block + integer(ESMF_KIND_I4), pointer :: fptr(:,:,:) + integer(ESMF_KIND_I4) :: dataMask, value + call ESMF_FieldGet(field, farrayPtr=fptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + isFlag = ESMF_InfoIsPresent(info, key="dataMask", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + call ESMF_InfoGet(info, key="dataMask", value=dataMask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + lcount(1) = count(fptr/=dataMask) + lsum(1) = sum(fptr, fptr/=dataMask) + lmin(1) = minval(fptr, fptr/=dataMask) + lmax(1) = maxval(fptr, fptr/=dataMask) + else + lcount(1) = size(fptr) + lsum(1) = sum(fptr) + lmin(1) = minval(fptr) + lmax(1) = maxval(fptr) + endif + dataMinSet = ESMF_InfoIsPresent(info, key="dataMin", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (dataMinSet) then + call ESMF_InfoGet(info, key="dataMin", value=value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + dataMin = real(value, ESMF_KIND_R8) + endif + dataMaxSet = ESMF_InfoIsPresent(info, key="dataMax", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (dataMaxSet) then + call ESMF_InfoGet(info, key="dataMax", value=value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + dataMax = real(value, ESMF_KIND_R8) + endif + end block + else if (typekind == ESMF_TYPEKIND_I8) then + block + integer(ESMF_KIND_I8), pointer :: fptr(:,:,:) + integer(ESMF_KIND_I8) :: dataMask, value + call ESMF_FieldGet(field, farrayPtr=fptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + isFlag = ESMF_InfoIsPresent(info, key="dataMask", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + call ESMF_InfoGet(info, key="dataMask", value=dataMask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + lcount(1) = count(fptr/=dataMask) + lsum(1) = sum(fptr, fptr/=dataMask) + lmin(1) = minval(fptr, fptr/=dataMask) + lmax(1) = maxval(fptr, fptr/=dataMask) + else + lcount(1) = size(fptr) + lsum(1) = sum(fptr) + lmin(1) = minval(fptr) + lmax(1) = maxval(fptr) + endif + dataMinSet = ESMF_InfoIsPresent(info, key="dataMin", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (dataMinSet) then + call ESMF_InfoGet(info, key="dataMin", value=value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + dataMin = real(value, ESMF_KIND_R8) + endif + dataMaxSet = ESMF_InfoIsPresent(info, key="dataMax", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (dataMaxSet) then + call ESMF_InfoGet(info, key="dataMax", value=value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + dataMax = real(value, ESMF_KIND_R8) + endif + end block + else if (typekind == ESMF_TYPEKIND_R4) then + block + real(ESMF_KIND_R4), pointer :: fptr(:,:,:) + real(ESMF_KIND_R4) :: dataMask, value + call ESMF_FieldGet(field, farrayPtr=fptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + isFlag = ESMF_InfoIsPresent(info, key="dataMask", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + call ESMF_InfoGet(info, key="dataMask", value=dataMask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + lcount(1) = count(fptr/=dataMask) + lsum(1) = sum(fptr, fptr/=dataMask) + lmin(1) = minval(fptr, fptr/=dataMask) + lmax(1) = maxval(fptr, fptr/=dataMask) + else + lcount(1) = size(fptr) + lsum(1) = sum(fptr) + lmin(1) = minval(fptr) + lmax(1) = maxval(fptr) + endif + dataMinSet = ESMF_InfoIsPresent(info, key="dataMin", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (dataMinSet) then + call ESMF_InfoGet(info, key="dataMin", value=value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + dataMin = real(value, ESMF_KIND_R8) + endif + dataMaxSet = ESMF_InfoIsPresent(info, key="dataMax", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (dataMaxSet) then + call ESMF_InfoGet(info, key="dataMax", value=value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + dataMax = real(value, ESMF_KIND_R8) + endif + end block + else if (typekind == ESMF_TYPEKIND_R8) then + block + real(ESMF_KIND_R8), pointer :: fptr(:,:,:) + real(ESMF_KIND_R8) :: dataMask, value + call ESMF_FieldGet(field, farrayPtr=fptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + isFlag = ESMF_InfoIsPresent(info, key="dataMask", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + call ESMF_InfoGet(info, key="dataMask", value=dataMask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + lcount(1) = count(fptr/=dataMask) + lsum(1) = sum(fptr, fptr/=dataMask) + lmin(1) = minval(fptr, fptr/=dataMask) + lmax(1) = maxval(fptr, fptr/=dataMask) + else + lcount(1) = size(fptr) + lsum(1) = sum(fptr) + lmin(1) = minval(fptr) + lmax(1) = maxval(fptr) + endif + dataMinSet = ESMF_InfoIsPresent(info, key="dataMin", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (dataMinSet) then + call ESMF_InfoGet(info, key="dataMin", value=value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + dataMin = real(value, ESMF_KIND_R8) + endif + dataMaxSet = ESMF_InfoIsPresent(info, key="dataMax", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (dataMaxSet) then + call ESMF_InfoGet(info, key="dataMax", value=value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + dataMax = real(value, ESMF_KIND_R8) + endif + end block + else + ! error condition: unsupported typekind + call ESMF_LogSetError(ESMF_RC_NOT_IMPL, & + msg="Unsupported typekind!", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out endif - elseif (present(defaultValue)) then - x_comp_hconfig_str = defaultValue else - call ESMF_LogSetError(ESMF_RC_NOT_FOUND, & - msg="XDATA: Key not found - "//trim(key), & + ! error condition: unsupported rank + call ESMF_LogSetError(ESMF_RC_NOT_IMPL, & + msg="Unsupported rank!", & line=__LINE__, file=__FILE__, rcToReturn=rc) - return + return ! bail out + endif + + call ESMF_VMAllReduce(vm, sendData=lcount, & + recvData=gcount, count=1, reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + statsCount = gcount(1) + + call ESMF_VMAllReduce(vm, sendData=lsum, & + recvData=gsum, count=1, reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (statsCount > 0) then + statsMean = gsum(1)/statsCount + else + statsMean = 0._ESMF_KIND_R8 + endif + + call ESMF_VMAllReduce(vm, sendData=lmin, & + recvData=gmin, count=1, reduceflag=ESMF_REDUCE_MIN, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + statsMin = gmin(1) + + call ESMF_VMAllReduce(vm, sendData=lmax, & + recvData=gmax, count=1, reduceflag=ESMF_REDUCE_MAX, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + statsMax = gmax(1) + + statsOkay = .true. ! initialize to .true. then see if not so + + if (dataMinSet) then + if (statsMin < dataMin) statsOkay = .false. ! found values below min + endif + + if (dataMaxSet) then + if (statsMax > dataMax) statsOkay = .false. ! found values above max endif - endfunction x_comp_hconfig_str + + end subroutine !----------------------------------------------------------------------------- - function x_comp_hconfig_logical(hconfig, key, defaultValue, rc) - ! return value - logical :: x_comp_hconfig_logical + subroutine DataAdvance(importState, exportItems, rc) + type(ESMF_State) :: importState + type(ExportItem) :: exportItems(:) + integer, intent(out) :: rc + + type(ESMF_Field) :: importField + integer(ESMF_KIND_I4), pointer, contiguous :: fPtrImportI4(:), fPtrExportI4(:) + integer(ESMF_KIND_I8), pointer, contiguous :: fPtrImportI8(:), fPtrExportI8(:) + real(ESMF_KIND_R4), pointer, contiguous :: fPtrImportR4(:), fPtrExportR4(:) + real(ESMF_KIND_R8), pointer, contiguous :: fPtrImportR8(:), fPtrExportR8(:) + real(ESMF_KIND_R8) :: value + character(len=:), allocatable :: infix_expression, rpn_expression, token + integer :: i, count, cur, top, depth + type(ESMF_TYPEKIND_Flag) :: tkImport, tkExport + + ! R8 workspace stack, last dimension is stack level + real(ESMF_KIND_R8), allocatable :: stack(:,:) + + rc = ESMF_SUCCESS + + do i=1, size(exportItems) + if (exportItems(i)%dataAdvance == "") cycle ! NOOP + + ! Normalize the incoming infix string with single white space deliminators + call normalize_infix(exportItems(i)%dataAdvance, infix_expression) + + ! Convert standard infix notation to reverse polish notation + call infix_to_rpn(infix_expression, rpn_expression) + + ! Determine the required stack depth for RPN processing + depth = compute_rpn_depth(rpn_expression) + + ! Setup export pointer + call ESMF_FieldGet(exportItems(i)%field, typekind=tkExport, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (tkExport == ESMF_TYPEKIND_I4) then + call access_data_i4(exportItems(i)%field, fPtrExportI4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + count = size(fPtrExportI4) + else if (tkExport == ESMF_TYPEKIND_I8) then + call access_data_i8(exportItems(i)%field, fPtrExportI8, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + count = size(fPtrExportI8) + else if (tkExport == ESMF_TYPEKIND_R4) then + call access_data_r4(exportItems(i)%field, fPtrExportR4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + count = size(fPtrExportR4) + else if (tkExport == ESMF_TYPEKIND_R8) then + call access_data_r8(exportItems(i)%field, fPtrExportR8, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + count = size(fPtrExportR8) + else + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="DataAdvance() only supports I4, I8, R4, and R8.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + end if + + ! Setup workspace stack + allocate(stack(count, depth)) + + ! Evaluate RPN + top = 0 + cur = 1 + do while (cur <= len_trim(rpn_expression)) + call get_next_token(rpn_expression, cur, token) + if (token == "") exit + + select case (token) + case ("+") + stack(:,top-1) = stack(:,top-1) + stack(:,top) + top = top - 1 + case ("-") + stack(:,top-1) = stack(:,top-1) - stack(:,top) + top = top - 1 + case ("*") + stack(:,top-1) = stack(:,top-1) * stack(:,top) + top = top - 1 + case ("/") + stack(:,top-1) = stack(:,top-1) / stack(:,top) + top = top - 1 + case default + top = top + 1 + if (try_parse(token, value)) then + ! Numerical value + stack(:,top) = value + else + ! Variable Name: Pull from importState + call ESMF_StateGet(importState, itemName=token, field=importField, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_FieldGet(importField, typekind=tkImport, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (tkImport == ESMF_TYPEKIND_I4) then + call access_data_i4(importField, fPtrImportI4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + stack(:,top) = fPtrImportI4 + else if (tkImport == ESMF_TYPEKIND_I8) then + call access_data_i8(importField, fPtrImportI8, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + stack(:,top) = fPtrImportI8 + else if (tkImport == ESMF_TYPEKIND_R4) then + call access_data_r4(importField, fPtrImportR4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + stack(:,top) = fPtrImportR4 + else if (tkImport == ESMF_TYPEKIND_R8) then + call access_data_r8(importField, fPtrImportR8, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + stack(:,top) = fPtrImportR8 + else + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="DataAdvance() only supports I4, I8, R4, and R8.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + end if + end if + end select + end do + + ! Stored final result in the export field + if (tkExport == ESMF_TYPEKIND_I4) then + fPtrExportI4 = stack(:,1) + else if (tkExport == ESMF_TYPEKIND_I8) then + fPtrExportI8 = stack(:,1) + else if (tkExport == ESMF_TYPEKIND_R4) then + fPtrExportR4 = stack(:,1) + else if (tkExport == ESMF_TYPEKIND_R8) then + fPtrExportR8 = stack(:,1) + end if + + ! clean-up workspace stack + deallocate(stack) + + end do + + end subroutine + + subroutine access_data_i4(field, fPtr, rc) + ! Access field data as 1D contigous data array + type(ESMF_Field), intent(in) :: field + integer(ESMF_KIND_I4), pointer, contiguous, intent(out) :: fPtr(:) + integer, intent(out) :: rc + + integer :: rank + integer(ESMF_KIND_I4), pointer, contiguous :: fPtr2D(:,:) + integer(ESMF_KIND_I4), pointer, contiguous :: fPtr3D(:,:,:) + integer(ESMF_KIND_I4), pointer, contiguous :: fPtr4D(:,:,:,:) + integer(ESMF_KIND_I4), pointer, contiguous :: fPtr5D(:,:,:,:,:) + integer(ESMF_KIND_I4), pointer, contiguous :: fPtr6D(:,:,:,:,:,:) + integer(ESMF_KIND_I4), pointer, contiguous :: fPtr7D(:,:,:,:,:,:,:) + + call ESMF_FieldGet(field, rank=rank, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + + if (rank == 1) then + call ESMF_FieldGet(field, farrayPtr=fPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else if (rank == 2) then + call ESMF_FieldGet(field, farrayPtr=fPtr2D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr2D)) => fPtr2D(:, :) + else if (rank == 3) then + call ESMF_FieldGet(field, farrayPtr=fPtr3D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr3D)) => fPtr3D(:, :,:) + else if (rank == 4) then + call ESMF_FieldGet(field, farrayPtr=fPtr4D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr4D)) => fPtr4D(:, :,:,:) + else if (rank == 5) then + call ESMF_FieldGet(field, farrayPtr=fPtr5D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr5D)) => fPtr5D(:, :,:,:,:) + else if (rank == 6) then + call ESMF_FieldGet(field, farrayPtr=fPtr6D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr6D)) => fPtr6D(:, :,:,:,:,:) + else if (rank == 7) then + call ESMF_FieldGet(field, farrayPtr=fPtr7D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr7D)) => fPtr7D(:, :,:,:,:,:,:) + end if + end subroutine + + subroutine access_data_i8(field, fPtr, rc) + ! Access field data as 1D contigous data array + type(ESMF_Field), intent(in) :: field + integer(ESMF_KIND_I8), pointer, contiguous, intent(out) :: fPtr(:) + integer, intent(out) :: rc + + integer :: rank + integer(ESMF_KIND_I8), pointer, contiguous :: fPtr2D(:,:) + integer(ESMF_KIND_I8), pointer, contiguous :: fPtr3D(:,:,:) + integer(ESMF_KIND_I8), pointer, contiguous :: fPtr4D(:,:,:,:) + integer(ESMF_KIND_I8), pointer, contiguous :: fPtr5D(:,:,:,:,:) + integer(ESMF_KIND_I8), pointer, contiguous :: fPtr6D(:,:,:,:,:,:) + integer(ESMF_KIND_I8), pointer, contiguous :: fPtr7D(:,:,:,:,:,:,:) + + call ESMF_FieldGet(field, rank=rank, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + + if (rank == 1) then + call ESMF_FieldGet(field, farrayPtr=fPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else if (rank == 2) then + call ESMF_FieldGet(field, farrayPtr=fPtr2D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr2D)) => fPtr2D(:, :) + else if (rank == 3) then + call ESMF_FieldGet(field, farrayPtr=fPtr3D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr3D)) => fPtr3D(:, :,:) + else if (rank == 4) then + call ESMF_FieldGet(field, farrayPtr=fPtr4D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr4D)) => fPtr4D(:, :,:,:) + else if (rank == 5) then + call ESMF_FieldGet(field, farrayPtr=fPtr5D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr5D)) => fPtr5D(:, :,:,:,:) + else if (rank == 6) then + call ESMF_FieldGet(field, farrayPtr=fPtr6D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr6D)) => fPtr6D(:, :,:,:,:,:) + else if (rank == 7) then + call ESMF_FieldGet(field, farrayPtr=fPtr7D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr7D)) => fPtr7D(:, :,:,:,:,:,:) + end if + end subroutine + + subroutine access_data_r4(field, fPtr, rc) + ! Access field data as 1D contigous data array + type(ESMF_Field), intent(in) :: field + real(ESMF_KIND_R4), pointer, contiguous, intent(out) :: fPtr(:) + integer, intent(out) :: rc + + integer :: rank + real(ESMF_KIND_R4), pointer, contiguous :: fPtr2D(:,:) + real(ESMF_KIND_R4), pointer, contiguous :: fPtr3D(:,:,:) + real(ESMF_KIND_R4), pointer, contiguous :: fPtr4D(:,:,:,:) + real(ESMF_KIND_R4), pointer, contiguous :: fPtr5D(:,:,:,:,:) + real(ESMF_KIND_R4), pointer, contiguous :: fPtr6D(:,:,:,:,:,:) + real(ESMF_KIND_R4), pointer, contiguous :: fPtr7D(:,:,:,:,:,:,:) + + call ESMF_FieldGet(field, rank=rank, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + + if (rank == 1) then + call ESMF_FieldGet(field, farrayPtr=fPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else if (rank == 2) then + call ESMF_FieldGet(field, farrayPtr=fPtr2D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr2D)) => fPtr2D(:, :) + else if (rank == 3) then + call ESMF_FieldGet(field, farrayPtr=fPtr3D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr3D)) => fPtr3D(:, :,:) + else if (rank == 4) then + call ESMF_FieldGet(field, farrayPtr=fPtr4D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr4D)) => fPtr4D(:, :,:,:) + else if (rank == 5) then + call ESMF_FieldGet(field, farrayPtr=fPtr5D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr5D)) => fPtr5D(:, :,:,:,:) + else if (rank == 6) then + call ESMF_FieldGet(field, farrayPtr=fPtr6D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr6D)) => fPtr6D(:, :,:,:,:,:) + else if (rank == 7) then + call ESMF_FieldGet(field, farrayPtr=fPtr7D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr7D)) => fPtr7D(:, :,:,:,:,:,:) + end if + end subroutine + + subroutine access_data_r8(field, fPtr, rc) + ! Access field data as 1D contigous data array + type(ESMF_Field), intent(in) :: field + real(ESMF_KIND_R8), pointer, contiguous, intent(out) :: fPtr(:) + integer, intent(out) :: rc + + integer :: rank + real(ESMF_KIND_R8), pointer, contiguous :: fPtr2D(:,:) + real(ESMF_KIND_R8), pointer, contiguous :: fPtr3D(:,:,:) + real(ESMF_KIND_R8), pointer, contiguous :: fPtr4D(:,:,:,:) + real(ESMF_KIND_R8), pointer, contiguous :: fPtr5D(:,:,:,:,:) + real(ESMF_KIND_R8), pointer, contiguous :: fPtr6D(:,:,:,:,:,:) + real(ESMF_KIND_R8), pointer, contiguous :: fPtr7D(:,:,:,:,:,:,:) + + call ESMF_FieldGet(field, rank=rank, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + + if (rank == 1) then + call ESMF_FieldGet(field, farrayPtr=fPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else if (rank == 2) then + call ESMF_FieldGet(field, farrayPtr=fPtr2D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr2D)) => fPtr2D(:, :) + else if (rank == 3) then + call ESMF_FieldGet(field, farrayPtr=fPtr3D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr3D)) => fPtr3D(:, :,:) + else if (rank == 4) then + call ESMF_FieldGet(field, farrayPtr=fPtr4D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr4D)) => fPtr4D(:, :,:,:) + else if (rank == 5) then + call ESMF_FieldGet(field, farrayPtr=fPtr5D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr5D)) => fPtr5D(:, :,:,:,:) + else if (rank == 6) then + call ESMF_FieldGet(field, farrayPtr=fPtr6D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr6D)) => fPtr6D(:, :,:,:,:,:) + else if (rank == 7) then + call ESMF_FieldGet(field, farrayPtr=fPtr7D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr7D)) => fPtr7D(:, :,:,:,:,:,:) + end if + end subroutine + + subroutine normalize_infix(input, output) + ! Normalize the incoming infix string with single white space deliminators + character(len=*), intent(in) :: input + character(len=:), allocatable, intent(out) :: output + character :: c + integer :: i + logical :: needs_leading_zero, in_operand + + output = "" + needs_leading_zero = .true. + in_operand = .false. + + do i = 1, len_trim(input) + c = input(i:i) ! current character + + if (c == " ") then + if (in_operand) then + ! finish operand by adding trailing space + output = output // " " + in_operand = .false. + end if + cycle + end if + + if (is_boundary(c)) then + if (in_operand) then + ! finish operand by adding trailing space + output = output // " " + in_operand = .false. + end if + ! Handle Unary Plus and Minus + if ((c == "-" .or. c == "+") .and. needs_leading_zero) then + ! insert the leading zero with space + output = output // "0 " + end if + ! Add operator and trailing space + output = output // c // " " + ! Update the flag for next iteration according to operator + needs_leading_zero = (c /= ")") + else + ! Inside operand + in_operand = .true. + output = output // c + needs_leading_zero = .false. + end if + end do + + ! Remove trailing space + output = trim(output) + + end subroutine + + logical function is_boundary(ch) + ! Look for boundary character + character, intent(in) :: ch + select case (ch) + case ("+", "-", "*", "/", "(", ")") + is_boundary = .true. + case default + is_boundary = .false. + end select + end function + + subroutine infix_to_rpn(infix, rpn) + ! Convert standard infix notation to reverse polish notation + character(len=*), intent(in) :: infix + character(len=:), allocatable, intent(out) :: rpn + character(len=128):: op_stack(20) ! Stack for operators + integer :: stack_ptr + character(len=:), allocatable :: token + integer :: cur, i + + rpn = "" + stack_ptr = 0 + cur = 1 + + do while (cur <= len_trim(infix)) + ! Extract next space-separated token + call get_next_token(infix, cur, token) + if (len(token) == 0) exit + + if (is_operator(token)) then + ! Handle Operators + do while (stack_ptr > 0) + if (op_stack(stack_ptr) /= "(" .and. & + precedence(op_stack(stack_ptr)) >= precedence(token)) then + rpn = rpn // trim(op_stack(stack_ptr)) // " " + stack_ptr = stack_ptr - 1 + else + exit + end if + end do + stack_ptr = stack_ptr + 1 + op_stack(stack_ptr) = token + + else if (token == "(") then + ! Handle Left Parenthesis + stack_ptr = stack_ptr + 1 + op_stack(stack_ptr) = "(" + + else if (token == ")") then + ! Handle Right Parenthesis + do while (stack_ptr > 0 .and. op_stack(stack_ptr) /= "(") + rpn = rpn // trim(op_stack(stack_ptr)) // " " + stack_ptr = stack_ptr - 1 + end do + if (stack_ptr > 0) stack_ptr = stack_ptr - 1 ! Pop the "(" + + else + ! Number or field name - send straight to output + rpn = rpn // token // " " + end if + end do + + ! Pop remaining operators from stack + do i = stack_ptr, 1, -1 + rpn = rpn // trim(op_stack(i)) // " " + end do + + ! Remove trailing space + rpn = trim(rpn) + + end subroutine + + integer function compute_rpn_depth(rpn) + ! Find high-water mark for a dryrun RPN execution + character(len=*), intent(in) :: rpn + character(len=:), allocatable :: token + integer :: cur, current_depth, max_depth + + max_depth = 0 + current_depth = 0 + cur = 1 + + do while (cur <= len_trim(rpn)) + ! Extract next token from the RPN string + call get_next_token(rpn, cur, token) + if (token == "") exit + + if (is_operator(token)) then + ! Binary operators (+, -, *, /) pop two operands and push one result. + ! This results in a net change of -1 to the stack height. + current_depth = current_depth - 1 + else + ! Field names or numeric constants are pushed onto the stack. + ! This results in a net change of +1. + current_depth = current_depth + 1 + end if + + ! Update the "high-water mark" + if (current_depth > max_depth) max_depth = current_depth + end do + + compute_rpn_depth = max_depth + + end function + + subroutine get_next_token(str, cur, token) + ! Look for the next token in a white space separated string + character(len=*), intent(in) :: str + integer, intent(inout) :: cur + character(len=:), allocatable, intent(out) :: token + + integer :: next_s + + if (cur > len(str)) then + token = ""; return + end if + + next_s = index(str(cur:), " ") + + if (next_s == 0) then + token = str(cur:) + cur = len(str) + 1 + else + token = str(cur : cur + next_s - 2) + cur = cur + next_s + end if + + end subroutine + + logical function try_parse(token, value) + ! Try to parse the token as a numerical constant + character(len=*), intent(in) :: token + real(ESMF_KIND_R8), intent(out) :: value + character(len=128) :: buffer + integer :: ios + + buffer = adjustl(token) ! use fixed size buffer for read + read(buffer, *, iostat=ios) value + try_parse = (ios == 0) + end function try_parse + + integer function precedence(op) + ! Operator precendece + character(len=*), intent(in) :: op + select case (trim(op)) + case ("+", "-") ; precedence = 2 + case ("*", "/") ; precedence = 3 + case default ; precedence = 0 + end select + end function + + logical function is_operator(token) + ! Identify token as operator + character(len=*), intent(in) :: token + select case (trim(token)) + case ("+", "-", "*", "/") ; is_operator = .true. + case default ; is_operator = .false. + end select + end function + + !----------------------------------------------------------------------------- + + subroutine TimestampExport(xdata, rc) ! arguments - type(ESMF_HConfig), intent(in) :: hconfig - character(*), intent(in) :: key - logical, intent(in), optional :: defaultValue - integer, intent(out) :: rc + type(ESMF_GridComp) :: xdata + integer, intent(out) :: rc ! local variables - logical :: isPresent - logical :: check + character(ESMF_MAXSTR) :: name + type(ESMF_Clock) :: clock + type(type_InternalState) :: modelBaseIs + type(InternalState) :: is rc = ESMF_SUCCESS - x_comp_hconfig_logical = .false. - isPresent = ESMF_HConfigIsDefined(hconfig, keyString=key, rc=rc) + ! query the component for info + call NUOPC_CompGet(xdata, name=name, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + + ! query component for modelBase internal state + nullify(modelBaseIs%wrap) +#ifdef ESMF_NO_F2018ASSUMEDTYPE + call ESMF_UserCompGetInternalState(xdata, label_InternalState, & + modelBaseIs, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out +#else + call ESMF_UserCompGetInternalState(xdata, label_InternalState, & + modelBaseIs, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out +#endif + + ! query component for internal state + nullify(is%wrap) + call ESMF_InternalStateGet(xdata, internalState=is, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - if (isPresent) then - x_comp_hconfig_logical = ESMF_HConfigAsLogical(hconfig, keyString=key, & - asOkay=check, rc=rc) + ! use correct timeKeeping + if (is%wrap%timeKeeping == "MODEL") then + ! Model style timeKeeping -> timestamp exports with post-Advance time + + ! query component for clock + call NUOPC_ModelBaseGet(xdata, clock=clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - if (.not.check) then - call ESMF_LogSetError(ESMF_RC_NOT_VALID, & - msg="XDATA: Value cannot be converted to Logical - "//trim(key), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + + ! update timestamp on export Fields + if (associated(modelBaseIs%wrap%cachedExportFieldList)) then + call NUOPC_SetTimestamp(modelBaseIs%wrap%cachedExportFieldList, & + clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out endif - elseif (present(defaultValue)) then - x_comp_hconfig_logical = defaultValue + else - call ESMF_LogSetError(ESMF_RC_NOT_FOUND, & - msg="XDATA: Key not found - "//trim(key), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return + ! Mediator style timeKeeping -> timestamp exports with pre-Advance time + + ! update timestamp on export Fields + if (associated(modelBaseIs%wrap%cachedExportFieldList)) then + call NUOPC_SetTimestamp(modelBaseIs%wrap%cachedExportFieldList, & + modelBaseIs%wrap%preAdvanceCurrTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + endif + endif - endfunction x_comp_hconfig_logical + + end subroutine !----------------------------------------------------------------------------- + subroutine Finalize(xdata, rc) + ! arguments + type(ESMF_GridComp) :: xdata + integer, intent(out) :: rc + ! local variables + character(ESMF_MAXSTR) :: name + integer :: i, stat + type(InternalState) :: is + + rc = ESMF_SUCCESS + + ! query the component for info + call NUOPC_CompGet(xdata, name=name, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + + ! query component for internal state + nullify(is%wrap) + call ESMF_InternalStateGet(xdata, internalState=is, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + + ! destroy importItems + if (allocated(is%wrap%importItems)) then + do i=1, size(is%wrap%importItems) + call ESMF_FieldDestroy(is%wrap%importItems(i)%field, noGarbage=.true., & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + deallocate(is%wrap%importItems(i)%dataValidate) + enddo + deallocate(is%wrap%importItems) + endif + + ! destroy exportItems + if (allocated(is%wrap%exportItems)) then + do i=1, size(is%wrap%exportItems) + call ESMF_FieldDestroy(is%wrap%exportItems(i)%field, noGarbage=.true., & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + deallocate(is%wrap%exportItems(i)%dataValidate) + deallocate(is%wrap%exportItems(i)%dataAdvance) + enddo + deallocate(is%wrap%exportItems) + endif + + ! destroy geomItems + if (allocated(is%wrap%geomItems)) then + do i=1, size(is%wrap%geomItems) + call ESMF_GeomDestroy(is%wrap%geomItems(i)%geom, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + enddo + deallocate(is%wrap%geomItems) + endif + + ! deallocate the internal state + deallocate(is%wrap, stat=stat) + if (ESMF_LogFoundDeallocError(statusToCheck=stat, & + msg="Internal State memory deallocation failed.", & + line=__LINE__, file=trim(name)//":"//__FILE__, & + rcToReturn=rc)) return ! bail out + + end subroutine Finalize + + !----------------------------------------------------------------------------- -endmodule esmx_data +end module ESMX_Data diff --git a/src/addon/ESMX/Comps/ESMX_Data/README.md b/src/addon/ESMX/Comps/ESMX_Data/README.md index 4c3f327b30..9ab45d677b 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/README.md +++ b/src/addon/ESMX/Comps/ESMX_Data/README.md @@ -1,10 +1,10 @@ # ESMX Data Component -The ESMX Data component is a lightweight testing component that derives from `NUOPC_Model`. Each ESMX Data component provides a custom list of export fields with prescribed values and a custom list of import fields with value ranges for testing validity. Multiple ESMX Data components can be used in the same application for testing complex sets of connected components. +ESMX Data is a lightweight data component designed for use in basic technical testing. Each instance of ESMX Data is run-time configured with a custom list of import and export fields. Each field references a specific geometry, typekind, and optionally init, min, and max values. Multiple geometries can be defined per `ESMX_Data` instance. ## ESMX Data Build Configuration -The ESMX Data component is included in all ESMX applications unless it is disabled in the ESMX_BUILD_FILE, see the following example. +The ESMX Data component is built into ESMX applications by default, unless it is explicitly disabled in the ESMX_BUILD_FILE via the `disable_comps` option. ``` application: @@ -12,96 +12,127 @@ application: disable_comps: ESMX_Data ``` -The ESMX Data component may be replaced in the ESMX_BUILD_FILE, see the following example. - +The default ESMX Data implementation that comes with ESMF can be overridden with a custom version under the `components` section of the ESMX_BUILD_FILE. For example, for a custom version that is located under the `MyCustomDataComponent` source directory: ``` components: ESMX_Data: - source_dir: MyDataComponent + source_dir: MyCustomDataComponent ``` ## ESMX Data Run Configuration -Each ESMX Data component is configured using [YAML](https://yaml.org/) format, providing settings such as output, geom, import fields, and export fields. - +Each ESMX Data instance is configured under its component label section in `esmxRun.yaml` using [YAML](https://yaml.org/) format. The available configuration keys are listed below. -### Output -Output options are configured under the `output` key. If no key/value pair is provided then the default will be used. +### `timeKeeping` -| Option key | Description / Value options | Default | -| ------------------- | ------------------------------------------------------ | --------- | -| `write_final` | write import and export state to NetCDF during Finaize | true | +The `timeKeeping` key is ***required***. It must either be set to `Model` or `Mediator`: +- Use the `Model` setting to timestamp the export fields according to the time at the *end* of the Advance step of the `ESMX_Data` component instance. +- Use the `Mediator` setting to timestamp the export fields according to the time at the *beginning* of the Advance step of the `ESMX_Data` component instance. -For an example, see the following configuration snippet. +For an example, see the following configuration snippet for `ESMX_Data` instance named `DAT`. ``` -ATM: - output: - write_final: true +DAT: + timeKeeping: Mediator ``` -### Geom +### `geometries` -Geometry options are configured under the `geom` key. If no key/value pair is provided then the default will be used. +The `geometries` key must be associated with a map of key/value pairs. Each key specifies the name by which the geometry can be referenced from a field in `importFields` or `exportFields` (defined further down). The value once again is a map with key/values as per the following table. -| Option key | Description / Value options | Default | -| ---------- | ---------------------------------------------------------------------- | ----------------------- | -| `nx` | number of cells along the x-axis, typically longitude | 64 | -| `ny` | number of cells along the y-axis, typically latitude | 32 | -| `nz` | number of cells along the z-axis, ungridded dimension for layers | 4 | -| `coordSys` | `ESMF_COORDSYS_CART`, `ESMF_COORDSYS_SPH_DEG`, `ESMF_COORDSYS_SPH_RAD` | `ESMF_COORDSYS_SPH_DEG` | -| `minx` | minimum coordinate for the x-axis, typically longitude | -126.0 | -| `miny` | minimum coordinate for the y-axis, typically latitude | 22.0 | -| `maxx` | maximum coordinate for the x-axis, typically longitude | -64.0 | -| `maxy` | maximum coordinate for the y-axis, typically latitude | 50.0 | +| Option key | Description / Value options | Default | +| --------------- | ---------------------------------------------------------------- | ----------------- | +| `geom` | ESMF geometry shorthand: `grid1PeriDim`, `gridNoPeriDim`. | ***required*** | +| `minIndex` | The lower corner of the global index space. | [1,1] or [1,1,1] depending on rank | +| `maxIndex` | The upper corner of the global index space. | ***required*** | +| `minCornerCoord`| The coordinate of the lower corner. | ***required*** | +| `maxCornerCoord`| The coordinate of the upper corner. | ***required*** | +| `coordSys` | ESMF coordSys shorthand: `CART`, `SPH_DEG`, `SPH_RAD`. | `SPH_DEG` | +| `staggerLoc` | ESMF staggerLoc shorthand: `CENTER`, `CORNER`, `EDGE1`, `EDGE2`. | `CENTER` | -For an example, see the following configuration snippet. +For an example, see the following configuration snippet for `ESMX_Data` instance named `DAT`. ``` -ATM: - geom: - nx: 64 - ny: 32 - minx: -126.0 - miny: 22.0 - maxx: -64.0 - maxy: 50.0 +DAT: + geometries: + global: + geom: grid1PeriDim + minCornerCoord: [-180, -89] + maxCornerCoord: [+180, +89] + maxIndex: [ 200, 100] + staggerLoc: center ``` -### Import Fields +This defines a geometry called `global`, which is instantiated as 2D `ESMF_Grid` object where the first dimension is periodic. There are 200 elements along the first dimension, and 100 elements along the second dimension. Default spherical degrees are used for the coordinates. The longitudes (first dimension) run from `-180` to `+180` degrees. The latitudes (second dimension) run from `-89` to `+89` degrees. The values of any field defined on `global` are located on the `center` stagger location. + +### `importFields` -Import field list is configured under the `importFields` key. See the following table for valid field configuration options. +The `importFields` key must be associated with a map of key/value pairs. Each key specifies the standard name of a field in the import state of the ESMX Data instance. The value once again is a map with key/values as per the following table. -| Option key | Description / Value options | Default | -| ---------- | ----------------------------------- | ---------- | -| `dim` | number of dimensions | 2 | -| `min` | minimum valid field value | 0 | -| `max` | maximum valid field value | 0 | +| Option key | Description / Value options | Default | +| ---------------- | ------------------------------------------------------------------------------------ | ----------------- | +| `geometry` | The name of a geometry defined under `geometries`. | ***required*** | +| `typekind` | One of the valid type kinds: `i4`, `i8`, `r4`, `r8`. | ***required*** | +| `gridToFieldMap` | The mapping of grid to field dimension. For details see ESMF documentation. | `[1,2]` or `[1,2,3]` depending on rank | +| `ungriddedLBound`| The lower bound of the ungridded dimension(s). For details see ESMF documentation. | *none* | +| `ungriddedUBound`| The upper bound of the ungridded dimension(s). For details see ESMF documentation. | *none* | +| `dataInit` | The numerical value used to fill field data during initialization. | *none* | +| `dataMask` | The numerical value ignored during field statistics and validation check. | *none* | +| `dataMin` | The minimum numerical value allowed in the field data to pass validation check. | *none* | +| `dataMax` | The maximum numerical value allowed in the field data to pass validation check. | *none* | +| `dataDiagnose` | Enable/disable output of field data diagnostics: `yes` or `no`. | `no` | +| `dataValidate` | The level of field data validation against the provided `dataMin` and `dataMax`: `no` - no validation, `warn` - issue warning if data found outside value range, `err` - return with error if data found outside value range. | `no` | -For an example, see the following configuration snippet. +For an example, see the following configuration snippet for `ESMX_Data` instance named `DAT`. ``` -ATM: +DAT: importFields: - sea_surface_temperature: {dim: 2, min: 260, max: 280} + sea_surface_temperature: {geometry: global, typekind: r8, dataDiagnose: yes} + density: + geometry: global + typekind: r4 + ungriddedLBound: [1] + ungriddedUBound: [104] + dataMin: 1e-05 + dataDiagnose: yes + dataValidate: err ``` -### Export Fields +This configuration defines two fields within the `DAT` import state. The first, standard-named `sea_surface_temperature`, is defined on the `global` geometry using double-precision (`r8`) data. As there are no ungridded dimensions, `sea_surface_temperature` functions as a 2D surface field. Because no `*Value` keys are specified, the field is neither locally initialized nor restricted by global min/max data bounds. While `dataDiagnose: yes` enables global diagnostic output to `stdout`, data validation remains inactive. + +The second field, standard-named `density`, is defined on the `global` geometry using single-precision (`r4`) data. It features a single ungridded dimension spanning indices `1` to `104`, representing 104 levels. A `dataMin` of `1e-05` is established to monitor the field during each Advance step. With data diagnostics enabled, the system will output field status to `stdout`; furthermore, the `dataValidate: err` setting ensures an error is triggered if any `density` value falls below the defined minimum. + +### `exportFields` -Export field list is configured under the `exportFields` key. See the following table for valid field configuration options. +The `exportFields` key must be associated with a map of key/value pairs. Each key specifies the standard name of a field in the export state of the ESMX Data instance. The value once again is a map with key/values as per the following table. -| Option key | Description / Value options | Default | -| ---------- | ---------------------------------------------------------- | ---------- | -| `dim` | number of dimensions, 2 or 3, third dimension is ungridded | 2 | -| `val` | prescribed value used to fill field | 0 | +| Option key | Description / Value options | Default | +| ---------------- | ------------------------------------------------------------------------------------ | ----------------- | +| `geometry` | The name of a geometry defined under `geometries`. | ***required*** | +| `typekind` | One of the valid type kinds: `i4`, `i8`, `r4`, `r8`. | ***required*** | +| `gridToFieldMap` | The mapping of grid to field dimension. For details see ESMF documentation. | `[1,2]` or `[1,2,3]` depending on rank | +| `ungriddedLBound`| The lower bound of the ungridded dimension(s). For details see ESMF documentation. | *none* | +| `ungriddedUBound`| The upper bound of the ungridded dimension(s). For details see ESMF documentation. | *none* | +| `dataInit` | The numerical value used to fill field data during initialization. | *none* | +| `dataMask` | The numerical value ignored during field statistics and validation check. | *none* | +| `dataMin` | The minimum numerical value allowed in the field data to pass validation check. | *none* | +| `dataMax` | The maximum numerical value allowed in the field data to pass validation check. | *none* | +| `dataDiagnose` | Enable/disable output of field data diagnostics: `yes` or `no`. | `no` | +| `dataValidate` | The level of field data validation against the provided `dataMin` and `dataMax`: `no` - no validation, `warn` - issue warning if data found outside value range, `err` - return with error if data found outside value range. | `no` | +| `dataAdvance` | Simple arithmetic expression that supports numbers and standard names of import fields as operands, and +, -, *, / as operators. Parentheses are supported. The expression is used to update the data of export fields during the Advance step. | *none* | -For an example, see the following configuration snippet. +For an example, see the following configuration snippet for `ESMX_Data` instance named `DAT`. ``` -ATM: +DAT: exportFields: - sea_surface_temperature: {dim: 2, val: 273} + sea_surface_temperature: + geometry: global + typekind: r8 + dataAdvance: 1.1 * sea_surface_temperature ``` +This configuration defines a single field, `sea_surface_temperature`, in the `DAT` export state. It is defined on the `global` geometry using double-precision (`r8`) values. With no ungridded dimensions, the field is treated as a 2D surface. The omission of `*Value` keys indicates that the field is not locally initialized and incoming values are not validated against global extrema. During each `Advance` step, the `dataAdvance` expression exports the field at 110% of its current imported value; if `sea_surface_temperature` is missing from the `importState`, an error is triggered. From 8769187322baf8bf61633e4b653dc5b2d8339a3c Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 8 May 2026 12:25:33 -0700 Subject: [PATCH 02/16] Make safe for case without export fields. --- src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 b/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 index 64a369bc32..9219375dcb 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 +++ b/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 @@ -2022,7 +2022,7 @@ subroutine FieldStats(field, statsCount, statsMean, statsMin, statsMax, & subroutine DataAdvance(importState, exportItems, rc) type(ESMF_State) :: importState - type(ExportItem) :: exportItems(:) + type(ExportItem), allocatable :: exportItems(:) integer, intent(out) :: rc type(ESMF_Field) :: importField @@ -2040,6 +2040,9 @@ subroutine DataAdvance(importState, exportItems, rc) rc = ESMF_SUCCESS + ! Early return if there is nothing to be done + if (.not.allocated(exportItems)) return + do i=1, size(exportItems) if (exportItems(i)%dataAdvance == "") cycle ! NOOP From e0b603256a5805de631a1f3d4c42adf408f31643 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 8 May 2026 13:17:41 -0700 Subject: [PATCH 03/16] Make Advance() routine completely multi-instance safe. --- src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 b/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 index 9219375dcb..c7231b9d51 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 +++ b/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 @@ -38,6 +38,7 @@ module ESMX_Data type(GeomItem), allocatable :: geomItems(:) type(ImportItem), allocatable :: importItems(:) type(ExportItem), allocatable :: exportItems(:) + integer :: stepCounter end type type InternalState @@ -85,6 +86,9 @@ subroutine SetServices(xdata, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + ! initialize the stepCounter inside the internal state + is%wrap%stepCounter = 0 + ! specialize model call NUOPC_CompSpecialize(xdata, specLabel=label_Advertise, & specRoutine=Advertise, rc=rc) @@ -1407,7 +1411,6 @@ subroutine Advance(xdata, rc) character(len=160) :: clockString integer :: i, localPet type(ESMF_FileStatus_Flag) :: filestatus - integer, save :: step=1 type(InternalState) :: is integer :: statsCount, warnCount, errCount real(ESMF_KIND_R8) :: statsMean, statsMin, statsMax @@ -1430,6 +1433,9 @@ subroutine Advance(xdata, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + associate(stepCounter => is%wrap%stepCounter) + stepCounter=stepCounter+1 + ! query component for import and export states call NUOPC_ModelBaseGet(xdata, clock=clock, & importState=importState, exportState=exportState, rc=rc) @@ -1443,10 +1449,10 @@ subroutine Advance(xdata, rc) if (btest(diagnostic,17)) then ! write fields of the importState filestatus=ESMF_FILESTATUS_OLD - if (step==1) filestatus=ESMF_FILESTATUS_REPLACE + if (stepCounter==1) filestatus=ESMF_FILESTATUS_REPLACE call NUOPC_Write(importState, & fileNamePrefix="field_"//trim(name)//"_import_advance_", & - timeslice=step, status=filestatus, relaxedFlag=.true., rc=rc) + timeslice=stepCounter, status=filestatus, relaxedFlag=.true., rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out endif @@ -1544,10 +1550,10 @@ subroutine Advance(xdata, rc) if (btest(diagnostic,17)) then ! write fields of the exportState filestatus=ESMF_FILESTATUS_OLD - if (step==1) filestatus=ESMF_FILESTATUS_REPLACE + if (stepCounter==1) filestatus=ESMF_FILESTATUS_REPLACE call NUOPC_Write(exportState, & fileNamePrefix="field_"//trim(name)//"_export_advance_", & - timeslice=step, status=filestatus, relaxedFlag=.true., rc=rc) + timeslice=stepCounter, status=filestatus, relaxedFlag=.true., rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out endif @@ -1569,8 +1575,7 @@ subroutine Advance(xdata, rc) return ! bail out endif - ! increment step counter - step=step+1 + end associate end subroutine Advance From d53f71b01cb0e1194efdab233f59d0ebdd26839d Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Mon, 11 May 2026 10:52:11 -0700 Subject: [PATCH 04/16] Refactor the data processing routines into their own module. --- src/addon/ESMX/Comps/ESMX_Data/CMakeLists.txt | 2 +- src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 | 567 +--------------- .../ESMX/Comps/ESMX_Data/dataProcess.F90 | 620 ++++++++++++++++++ 3 files changed, 626 insertions(+), 563 deletions(-) create mode 100644 src/addon/ESMX/Comps/ESMX_Data/dataProcess.F90 diff --git a/src/addon/ESMX/Comps/ESMX_Data/CMakeLists.txt b/src/addon/ESMX/Comps/ESMX_Data/CMakeLists.txt index 9db5223dc1..83b2264a6a 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/CMakeLists.txt +++ b/src/addon/ESMX/Comps/ESMX_Data/CMakeLists.txt @@ -44,7 +44,7 @@ elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "NVHPC") set(CMAKE_Fortran_FLAGS_DEBUG "-g -traceback -O0") endif() -add_library(ESMX_Data ESMX_Data.F90) +add_library(ESMX_Data ESMX_Data.F90 dataProcess.F90) target_include_directories(ESMX_Data INTERFACE $ $ diff --git a/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 b/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 index c7231b9d51..fa767cb6a8 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 +++ b/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 @@ -9,6 +9,8 @@ module ESMX_Data use NUOPC_ModelBase, & modelBaseSS => SetServices + use dataProcess + implicit none private @@ -2030,18 +2032,7 @@ subroutine DataAdvance(importState, exportItems, rc) type(ExportItem), allocatable :: exportItems(:) integer, intent(out) :: rc - type(ESMF_Field) :: importField - integer(ESMF_KIND_I4), pointer, contiguous :: fPtrImportI4(:), fPtrExportI4(:) - integer(ESMF_KIND_I8), pointer, contiguous :: fPtrImportI8(:), fPtrExportI8(:) - real(ESMF_KIND_R4), pointer, contiguous :: fPtrImportR4(:), fPtrExportR4(:) - real(ESMF_KIND_R8), pointer, contiguous :: fPtrImportR8(:), fPtrExportR8(:) - real(ESMF_KIND_R8) :: value - character(len=:), allocatable :: infix_expression, rpn_expression, token - integer :: i, count, cur, top, depth - type(ESMF_TYPEKIND_Flag) :: tkImport, tkExport - - ! R8 workspace stack, last dimension is stack level - real(ESMF_KIND_R8), allocatable :: stack(:,:) + integer :: i rc = ESMF_SUCCESS @@ -2051,563 +2042,15 @@ subroutine DataAdvance(importState, exportItems, rc) do i=1, size(exportItems) if (exportItems(i)%dataAdvance == "") cycle ! NOOP - ! Normalize the incoming infix string with single white space deliminators - call normalize_infix(exportItems(i)%dataAdvance, infix_expression) - - ! Convert standard infix notation to reverse polish notation - call infix_to_rpn(infix_expression, rpn_expression) - - ! Determine the required stack depth for RPN processing - depth = compute_rpn_depth(rpn_expression) - - ! Setup export pointer - call ESMF_FieldGet(exportItems(i)%field, typekind=tkExport, rc=rc) + call process(exportItems(i)%field, exportItems(i)%dataAdvance, & + importState, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out - if (tkExport == ESMF_TYPEKIND_I4) then - call access_data_i4(exportItems(i)%field, fPtrExportI4, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - count = size(fPtrExportI4) - else if (tkExport == ESMF_TYPEKIND_I8) then - call access_data_i8(exportItems(i)%field, fPtrExportI8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - count = size(fPtrExportI8) - else if (tkExport == ESMF_TYPEKIND_R4) then - call access_data_r4(exportItems(i)%field, fPtrExportR4, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - count = size(fPtrExportR4) - else if (tkExport == ESMF_TYPEKIND_R8) then - call access_data_r8(exportItems(i)%field, fPtrExportR8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - count = size(fPtrExportR8) - else - call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & - msg="DataAdvance() only supports I4, I8, R4, and R8.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - end if - - ! Setup workspace stack - allocate(stack(count, depth)) - - ! Evaluate RPN - top = 0 - cur = 1 - do while (cur <= len_trim(rpn_expression)) - call get_next_token(rpn_expression, cur, token) - if (token == "") exit - - select case (token) - case ("+") - stack(:,top-1) = stack(:,top-1) + stack(:,top) - top = top - 1 - case ("-") - stack(:,top-1) = stack(:,top-1) - stack(:,top) - top = top - 1 - case ("*") - stack(:,top-1) = stack(:,top-1) * stack(:,top) - top = top - 1 - case ("/") - stack(:,top-1) = stack(:,top-1) / stack(:,top) - top = top - 1 - case default - top = top + 1 - if (try_parse(token, value)) then - ! Numerical value - stack(:,top) = value - else - ! Variable Name: Pull from importState - call ESMF_StateGet(importState, itemName=token, field=importField, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldGet(importField, typekind=tkImport, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (tkImport == ESMF_TYPEKIND_I4) then - call access_data_i4(importField, fPtrImportI4, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - stack(:,top) = fPtrImportI4 - else if (tkImport == ESMF_TYPEKIND_I8) then - call access_data_i8(importField, fPtrImportI8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - stack(:,top) = fPtrImportI8 - else if (tkImport == ESMF_TYPEKIND_R4) then - call access_data_r4(importField, fPtrImportR4, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - stack(:,top) = fPtrImportR4 - else if (tkImport == ESMF_TYPEKIND_R8) then - call access_data_r8(importField, fPtrImportR8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - stack(:,top) = fPtrImportR8 - else - call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & - msg="DataAdvance() only supports I4, I8, R4, and R8.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - end if - end if - end select - end do - - ! Stored final result in the export field - if (tkExport == ESMF_TYPEKIND_I4) then - fPtrExportI4 = stack(:,1) - else if (tkExport == ESMF_TYPEKIND_I8) then - fPtrExportI8 = stack(:,1) - else if (tkExport == ESMF_TYPEKIND_R4) then - fPtrExportR4 = stack(:,1) - else if (tkExport == ESMF_TYPEKIND_R8) then - fPtrExportR8 = stack(:,1) - end if - - ! clean-up workspace stack - deallocate(stack) end do end subroutine - subroutine access_data_i4(field, fPtr, rc) - ! Access field data as 1D contigous data array - type(ESMF_Field), intent(in) :: field - integer(ESMF_KIND_I4), pointer, contiguous, intent(out) :: fPtr(:) - integer, intent(out) :: rc - - integer :: rank - integer(ESMF_KIND_I4), pointer, contiguous :: fPtr2D(:,:) - integer(ESMF_KIND_I4), pointer, contiguous :: fPtr3D(:,:,:) - integer(ESMF_KIND_I4), pointer, contiguous :: fPtr4D(:,:,:,:) - integer(ESMF_KIND_I4), pointer, contiguous :: fPtr5D(:,:,:,:,:) - integer(ESMF_KIND_I4), pointer, contiguous :: fPtr6D(:,:,:,:,:,:) - integer(ESMF_KIND_I4), pointer, contiguous :: fPtr7D(:,:,:,:,:,:,:) - - call ESMF_FieldGet(field, rank=rank, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (rank == 1) then - call ESMF_FieldGet(field, farrayPtr=fPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - else if (rank == 2) then - call ESMF_FieldGet(field, farrayPtr=fPtr2D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr2D)) => fPtr2D(:, :) - else if (rank == 3) then - call ESMF_FieldGet(field, farrayPtr=fPtr3D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr3D)) => fPtr3D(:, :,:) - else if (rank == 4) then - call ESMF_FieldGet(field, farrayPtr=fPtr4D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr4D)) => fPtr4D(:, :,:,:) - else if (rank == 5) then - call ESMF_FieldGet(field, farrayPtr=fPtr5D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr5D)) => fPtr5D(:, :,:,:,:) - else if (rank == 6) then - call ESMF_FieldGet(field, farrayPtr=fPtr6D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr6D)) => fPtr6D(:, :,:,:,:,:) - else if (rank == 7) then - call ESMF_FieldGet(field, farrayPtr=fPtr7D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr7D)) => fPtr7D(:, :,:,:,:,:,:) - end if - end subroutine - - subroutine access_data_i8(field, fPtr, rc) - ! Access field data as 1D contigous data array - type(ESMF_Field), intent(in) :: field - integer(ESMF_KIND_I8), pointer, contiguous, intent(out) :: fPtr(:) - integer, intent(out) :: rc - - integer :: rank - integer(ESMF_KIND_I8), pointer, contiguous :: fPtr2D(:,:) - integer(ESMF_KIND_I8), pointer, contiguous :: fPtr3D(:,:,:) - integer(ESMF_KIND_I8), pointer, contiguous :: fPtr4D(:,:,:,:) - integer(ESMF_KIND_I8), pointer, contiguous :: fPtr5D(:,:,:,:,:) - integer(ESMF_KIND_I8), pointer, contiguous :: fPtr6D(:,:,:,:,:,:) - integer(ESMF_KIND_I8), pointer, contiguous :: fPtr7D(:,:,:,:,:,:,:) - - call ESMF_FieldGet(field, rank=rank, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (rank == 1) then - call ESMF_FieldGet(field, farrayPtr=fPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - else if (rank == 2) then - call ESMF_FieldGet(field, farrayPtr=fPtr2D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr2D)) => fPtr2D(:, :) - else if (rank == 3) then - call ESMF_FieldGet(field, farrayPtr=fPtr3D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr3D)) => fPtr3D(:, :,:) - else if (rank == 4) then - call ESMF_FieldGet(field, farrayPtr=fPtr4D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr4D)) => fPtr4D(:, :,:,:) - else if (rank == 5) then - call ESMF_FieldGet(field, farrayPtr=fPtr5D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr5D)) => fPtr5D(:, :,:,:,:) - else if (rank == 6) then - call ESMF_FieldGet(field, farrayPtr=fPtr6D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr6D)) => fPtr6D(:, :,:,:,:,:) - else if (rank == 7) then - call ESMF_FieldGet(field, farrayPtr=fPtr7D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr7D)) => fPtr7D(:, :,:,:,:,:,:) - end if - end subroutine - - subroutine access_data_r4(field, fPtr, rc) - ! Access field data as 1D contigous data array - type(ESMF_Field), intent(in) :: field - real(ESMF_KIND_R4), pointer, contiguous, intent(out) :: fPtr(:) - integer, intent(out) :: rc - - integer :: rank - real(ESMF_KIND_R4), pointer, contiguous :: fPtr2D(:,:) - real(ESMF_KIND_R4), pointer, contiguous :: fPtr3D(:,:,:) - real(ESMF_KIND_R4), pointer, contiguous :: fPtr4D(:,:,:,:) - real(ESMF_KIND_R4), pointer, contiguous :: fPtr5D(:,:,:,:,:) - real(ESMF_KIND_R4), pointer, contiguous :: fPtr6D(:,:,:,:,:,:) - real(ESMF_KIND_R4), pointer, contiguous :: fPtr7D(:,:,:,:,:,:,:) - - call ESMF_FieldGet(field, rank=rank, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (rank == 1) then - call ESMF_FieldGet(field, farrayPtr=fPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - else if (rank == 2) then - call ESMF_FieldGet(field, farrayPtr=fPtr2D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr2D)) => fPtr2D(:, :) - else if (rank == 3) then - call ESMF_FieldGet(field, farrayPtr=fPtr3D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr3D)) => fPtr3D(:, :,:) - else if (rank == 4) then - call ESMF_FieldGet(field, farrayPtr=fPtr4D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr4D)) => fPtr4D(:, :,:,:) - else if (rank == 5) then - call ESMF_FieldGet(field, farrayPtr=fPtr5D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr5D)) => fPtr5D(:, :,:,:,:) - else if (rank == 6) then - call ESMF_FieldGet(field, farrayPtr=fPtr6D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr6D)) => fPtr6D(:, :,:,:,:,:) - else if (rank == 7) then - call ESMF_FieldGet(field, farrayPtr=fPtr7D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr7D)) => fPtr7D(:, :,:,:,:,:,:) - end if - end subroutine - - subroutine access_data_r8(field, fPtr, rc) - ! Access field data as 1D contigous data array - type(ESMF_Field), intent(in) :: field - real(ESMF_KIND_R8), pointer, contiguous, intent(out) :: fPtr(:) - integer, intent(out) :: rc - - integer :: rank - real(ESMF_KIND_R8), pointer, contiguous :: fPtr2D(:,:) - real(ESMF_KIND_R8), pointer, contiguous :: fPtr3D(:,:,:) - real(ESMF_KIND_R8), pointer, contiguous :: fPtr4D(:,:,:,:) - real(ESMF_KIND_R8), pointer, contiguous :: fPtr5D(:,:,:,:,:) - real(ESMF_KIND_R8), pointer, contiguous :: fPtr6D(:,:,:,:,:,:) - real(ESMF_KIND_R8), pointer, contiguous :: fPtr7D(:,:,:,:,:,:,:) - - call ESMF_FieldGet(field, rank=rank, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - if (rank == 1) then - call ESMF_FieldGet(field, farrayPtr=fPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - else if (rank == 2) then - call ESMF_FieldGet(field, farrayPtr=fPtr2D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr2D)) => fPtr2D(:, :) - else if (rank == 3) then - call ESMF_FieldGet(field, farrayPtr=fPtr3D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr3D)) => fPtr3D(:, :,:) - else if (rank == 4) then - call ESMF_FieldGet(field, farrayPtr=fPtr4D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr4D)) => fPtr4D(:, :,:,:) - else if (rank == 5) then - call ESMF_FieldGet(field, farrayPtr=fPtr5D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr5D)) => fPtr5D(:, :,:,:,:) - else if (rank == 6) then - call ESMF_FieldGet(field, farrayPtr=fPtr6D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr6D)) => fPtr6D(:, :,:,:,:,:) - else if (rank == 7) then - call ESMF_FieldGet(field, farrayPtr=fPtr7D, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - fPtr(1:size(fPtr7D)) => fPtr7D(:, :,:,:,:,:,:) - end if - end subroutine - - subroutine normalize_infix(input, output) - ! Normalize the incoming infix string with single white space deliminators - character(len=*), intent(in) :: input - character(len=:), allocatable, intent(out) :: output - character :: c - integer :: i - logical :: needs_leading_zero, in_operand - - output = "" - needs_leading_zero = .true. - in_operand = .false. - - do i = 1, len_trim(input) - c = input(i:i) ! current character - - if (c == " ") then - if (in_operand) then - ! finish operand by adding trailing space - output = output // " " - in_operand = .false. - end if - cycle - end if - - if (is_boundary(c)) then - if (in_operand) then - ! finish operand by adding trailing space - output = output // " " - in_operand = .false. - end if - ! Handle Unary Plus and Minus - if ((c == "-" .or. c == "+") .and. needs_leading_zero) then - ! insert the leading zero with space - output = output // "0 " - end if - ! Add operator and trailing space - output = output // c // " " - ! Update the flag for next iteration according to operator - needs_leading_zero = (c /= ")") - else - ! Inside operand - in_operand = .true. - output = output // c - needs_leading_zero = .false. - end if - end do - - ! Remove trailing space - output = trim(output) - - end subroutine - - logical function is_boundary(ch) - ! Look for boundary character - character, intent(in) :: ch - select case (ch) - case ("+", "-", "*", "/", "(", ")") - is_boundary = .true. - case default - is_boundary = .false. - end select - end function - - subroutine infix_to_rpn(infix, rpn) - ! Convert standard infix notation to reverse polish notation - character(len=*), intent(in) :: infix - character(len=:), allocatable, intent(out) :: rpn - character(len=128):: op_stack(20) ! Stack for operators - integer :: stack_ptr - character(len=:), allocatable :: token - integer :: cur, i - - rpn = "" - stack_ptr = 0 - cur = 1 - - do while (cur <= len_trim(infix)) - ! Extract next space-separated token - call get_next_token(infix, cur, token) - if (len(token) == 0) exit - - if (is_operator(token)) then - ! Handle Operators - do while (stack_ptr > 0) - if (op_stack(stack_ptr) /= "(" .and. & - precedence(op_stack(stack_ptr)) >= precedence(token)) then - rpn = rpn // trim(op_stack(stack_ptr)) // " " - stack_ptr = stack_ptr - 1 - else - exit - end if - end do - stack_ptr = stack_ptr + 1 - op_stack(stack_ptr) = token - - else if (token == "(") then - ! Handle Left Parenthesis - stack_ptr = stack_ptr + 1 - op_stack(stack_ptr) = "(" - - else if (token == ")") then - ! Handle Right Parenthesis - do while (stack_ptr > 0 .and. op_stack(stack_ptr) /= "(") - rpn = rpn // trim(op_stack(stack_ptr)) // " " - stack_ptr = stack_ptr - 1 - end do - if (stack_ptr > 0) stack_ptr = stack_ptr - 1 ! Pop the "(" - - else - ! Number or field name - send straight to output - rpn = rpn // token // " " - end if - end do - - ! Pop remaining operators from stack - do i = stack_ptr, 1, -1 - rpn = rpn // trim(op_stack(i)) // " " - end do - - ! Remove trailing space - rpn = trim(rpn) - - end subroutine - - integer function compute_rpn_depth(rpn) - ! Find high-water mark for a dryrun RPN execution - character(len=*), intent(in) :: rpn - character(len=:), allocatable :: token - integer :: cur, current_depth, max_depth - - max_depth = 0 - current_depth = 0 - cur = 1 - - do while (cur <= len_trim(rpn)) - ! Extract next token from the RPN string - call get_next_token(rpn, cur, token) - if (token == "") exit - - if (is_operator(token)) then - ! Binary operators (+, -, *, /) pop two operands and push one result. - ! This results in a net change of -1 to the stack height. - current_depth = current_depth - 1 - else - ! Field names or numeric constants are pushed onto the stack. - ! This results in a net change of +1. - current_depth = current_depth + 1 - end if - - ! Update the "high-water mark" - if (current_depth > max_depth) max_depth = current_depth - end do - - compute_rpn_depth = max_depth - - end function - - subroutine get_next_token(str, cur, token) - ! Look for the next token in a white space separated string - character(len=*), intent(in) :: str - integer, intent(inout) :: cur - character(len=:), allocatable, intent(out) :: token - - integer :: next_s - - if (cur > len(str)) then - token = ""; return - end if - - next_s = index(str(cur:), " ") - - if (next_s == 0) then - token = str(cur:) - cur = len(str) + 1 - else - token = str(cur : cur + next_s - 2) - cur = cur + next_s - end if - - end subroutine - - logical function try_parse(token, value) - ! Try to parse the token as a numerical constant - character(len=*), intent(in) :: token - real(ESMF_KIND_R8), intent(out) :: value - character(len=128) :: buffer - integer :: ios - - buffer = adjustl(token) ! use fixed size buffer for read - read(buffer, *, iostat=ios) value - try_parse = (ios == 0) - end function try_parse - - integer function precedence(op) - ! Operator precendece - character(len=*), intent(in) :: op - select case (trim(op)) - case ("+", "-") ; precedence = 2 - case ("*", "/") ; precedence = 3 - case default ; precedence = 0 - end select - end function - - logical function is_operator(token) - ! Identify token as operator - character(len=*), intent(in) :: token - select case (trim(token)) - case ("+", "-", "*", "/") ; is_operator = .true. - case default ; is_operator = .false. - end select - end function - !----------------------------------------------------------------------------- subroutine TimestampExport(xdata, rc) diff --git a/src/addon/ESMX/Comps/ESMX_Data/dataProcess.F90 b/src/addon/ESMX/Comps/ESMX_Data/dataProcess.F90 new file mode 100644 index 0000000000..6138b79947 --- /dev/null +++ b/src/addon/ESMX/Comps/ESMX_Data/dataProcess.F90 @@ -0,0 +1,620 @@ +module dataProcess + + !----------------------------------------------------------------------------- + ! Data Processing + !----------------------------------------------------------------------------- + + use ESMF + + implicit none + + private + + public process + + !----------------------------------------------------------------------------- + + contains + + !----------------------------------------------------------------------------- + + subroutine process(exportField, dataAdvance, importState, rc) + + type(ESMF_Field), intent(inout) :: exportField + character(len=*), intent(in) :: dataAdvance + type(ESMF_State), intent(in) :: importState + integer, intent(out) :: rc + + type(ESMF_Field) :: importField + integer(ESMF_KIND_I4), pointer, contiguous :: fPtrImportI4(:) + integer(ESMF_KIND_I4), pointer, contiguous :: fPtrExportI4(:) + integer(ESMF_KIND_I8), pointer, contiguous :: fPtrImportI8(:) + integer(ESMF_KIND_I8), pointer, contiguous :: fPtrExportI8(:) + real(ESMF_KIND_R4), pointer, contiguous :: fPtrImportR4(:) + real(ESMF_KIND_R4), pointer, contiguous :: fPtrExportR4(:) + real(ESMF_KIND_R8), pointer, contiguous :: fPtrImportR8(:) + real(ESMF_KIND_R8), pointer, contiguous :: fPtrExportR8(:) + real(ESMF_KIND_R8) :: value + character(len=:), allocatable :: infix_expression, rpn_expression, token + integer :: count, cur, top, depth + type(ESMF_TYPEKIND_Flag) :: tkImport, tkExport + real(ESMF_KIND_R8), allocatable :: stack(:,:) + + rc = ESMF_SUCCESS + + ! Normalize the incoming infix string with single white space deliminators + call normalize_infix(dataAdvance, infix_expression) + + ! Convert standard infix notation to reverse polish notation + call infix_to_rpn(infix_expression, rpn_expression) + + ! Determine the required stack depth for RPN processing + depth = compute_rpn_depth(rpn_expression) + + ! Setup export pointer + call ESMF_FieldGet(exportField, typekind=tkExport, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (tkExport == ESMF_TYPEKIND_I4) then + call access_data_i4(exportField, fPtrExportI4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + count = size(fPtrExportI4) + else if (tkExport == ESMF_TYPEKIND_I8) then + call access_data_i8(exportField, fPtrExportI8, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + count = size(fPtrExportI8) + else if (tkExport == ESMF_TYPEKIND_R4) then + call access_data_r4(exportField, fPtrExportR4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + count = size(fPtrExportR4) + else if (tkExport == ESMF_TYPEKIND_R8) then + call access_data_r8(exportField, fPtrExportR8, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + count = size(fPtrExportR8) + else + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="DataAdvance() only supports I4, I8, R4, and R8.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + end if + + ! Setup workspace stack + allocate(stack(count, depth)) + + ! Evaluate RPN + top = 0 + cur = 1 + do while (cur <= len_trim(rpn_expression)) + call get_next_token(rpn_expression, cur, token) + if (token == "") exit + + select case (token) + case ("+") + stack(:,top-1) = stack(:,top-1) + stack(:,top) + top = top - 1 + case ("-") + stack(:,top-1) = stack(:,top-1) - stack(:,top) + top = top - 1 + case ("*") + stack(:,top-1) = stack(:,top-1) * stack(:,top) + top = top - 1 + case ("/") + stack(:,top-1) = stack(:,top-1) / stack(:,top) + top = top - 1 + case default + top = top + 1 + if (try_parse(token, value)) then + ! Numerical value + stack(:,top) = value + else + ! Variable Name: Pull from importState + call ESMF_StateGet(importState, itemName=token, field=importField, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_FieldGet(importField, typekind=tkImport, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (tkImport == ESMF_TYPEKIND_I4) then + call access_data_i4(importField, fPtrImportI4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + stack(:,top) = fPtrImportI4 + else if (tkImport == ESMF_TYPEKIND_I8) then + call access_data_i8(importField, fPtrImportI8, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + stack(:,top) = fPtrImportI8 + else if (tkImport == ESMF_TYPEKIND_R4) then + call access_data_r4(importField, fPtrImportR4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + stack(:,top) = fPtrImportR4 + else if (tkImport == ESMF_TYPEKIND_R8) then + call access_data_r8(importField, fPtrImportR8, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + stack(:,top) = fPtrImportR8 + else + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="DataAdvance() only supports I4, I8, R4, and R8.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + end if + end if + end select + end do + + ! Stored final result in the export field + if (tkExport == ESMF_TYPEKIND_I4) then + fPtrExportI4 = stack(:,1) + else if (tkExport == ESMF_TYPEKIND_I8) then + fPtrExportI8 = stack(:,1) + else if (tkExport == ESMF_TYPEKIND_R4) then + fPtrExportR4 = stack(:,1) + else if (tkExport == ESMF_TYPEKIND_R8) then + fPtrExportR8 = stack(:,1) + end if + + ! clean-up workspace stack + deallocate(stack) + + end subroutine + + !----------------------------------------------------------------------------- + + subroutine normalize_infix(input, output) + ! Normalize the incoming infix string with single white space deliminators + character(len=*), intent(in) :: input + character(len=:), allocatable, intent(out) :: output + character :: c + integer :: i + logical :: needs_leading_zero, in_operand + + output = "" + needs_leading_zero = .true. + in_operand = .false. + + do i = 1, len_trim(input) + c = input(i:i) ! current character + + if (c == " ") then + if (in_operand) then + ! finish operand by adding trailing space + output = output // " " + in_operand = .false. + end if + cycle + end if + + if (is_boundary(c)) then + if (in_operand) then + ! finish operand by adding trailing space + output = output // " " + in_operand = .false. + end if + ! Handle Unary Plus and Minus + if ((c == "-" .or. c == "+") .and. needs_leading_zero) then + ! insert the leading zero with space + output = output // "0 " + end if + ! Add operator and trailing space + output = output // c // " " + ! Update the flag for next iteration according to operator + needs_leading_zero = (c /= ")") + else + ! Inside operand + in_operand = .true. + output = output // c + needs_leading_zero = .false. + end if + end do + + ! Remove trailing space + output = trim(output) + + end subroutine + + !----------------------------------------------------------------------------- + + logical function is_boundary(ch) + ! Look for boundary character + character, intent(in) :: ch + select case (ch) + case ("+", "-", "*", "/", "(", ")") + is_boundary = .true. + case default + is_boundary = .false. + end select + end function + + !----------------------------------------------------------------------------- + + subroutine infix_to_rpn(infix, rpn) + ! Convert standard infix notation to reverse polish notation + character(len=*), intent(in) :: infix + character(len=:), allocatable, intent(out) :: rpn + character(len=128):: op_stack(20) ! Stack for operators + integer :: stack_ptr + character(len=:), allocatable :: token + integer :: cur, i + + rpn = "" + stack_ptr = 0 + cur = 1 + + do while (cur <= len_trim(infix)) + ! Extract next space-separated token + call get_next_token(infix, cur, token) + if (len(token) == 0) exit + + if (is_operator(token)) then + ! Handle Operators + do while (stack_ptr > 0) + if (op_stack(stack_ptr) /= "(" .and. & + precedence(op_stack(stack_ptr)) >= precedence(token)) then + rpn = rpn // trim(op_stack(stack_ptr)) // " " + stack_ptr = stack_ptr - 1 + else + exit + end if + end do + stack_ptr = stack_ptr + 1 + op_stack(stack_ptr) = token + + else if (token == "(") then + ! Handle Left Parenthesis + stack_ptr = stack_ptr + 1 + op_stack(stack_ptr) = "(" + + else if (token == ")") then + ! Handle Right Parenthesis + do while (stack_ptr > 0 .and. op_stack(stack_ptr) /= "(") + rpn = rpn // trim(op_stack(stack_ptr)) // " " + stack_ptr = stack_ptr - 1 + end do + if (stack_ptr > 0) stack_ptr = stack_ptr - 1 ! Pop the "(" + + else + ! Number or field name - send straight to output + rpn = rpn // token // " " + end if + end do + + ! Pop remaining operators from stack + do i = stack_ptr, 1, -1 + rpn = rpn // trim(op_stack(i)) // " " + end do + + ! Remove trailing space + rpn = trim(rpn) + + end subroutine + + !----------------------------------------------------------------------------- + + integer function compute_rpn_depth(rpn) + ! Find high-water mark for a dryrun RPN execution + character(len=*), intent(in) :: rpn + character(len=:), allocatable :: token + integer :: cur, current_depth, max_depth + + max_depth = 0 + current_depth = 0 + cur = 1 + + do while (cur <= len_trim(rpn)) + ! Extract next token from the RPN string + call get_next_token(rpn, cur, token) + if (token == "") exit + + if (is_operator(token)) then + ! Binary operators (+, -, *, /) pop two operands and push one result. + ! This results in a net change of -1 to the stack height. + current_depth = current_depth - 1 + else + ! Field names or numeric constants are pushed onto the stack. + ! This results in a net change of +1. + current_depth = current_depth + 1 + end if + + ! Update the "high-water mark" + if (current_depth > max_depth) max_depth = current_depth + end do + + compute_rpn_depth = max_depth + + end function + + !----------------------------------------------------------------------------- + + subroutine get_next_token(str, cur, token) + ! Look for the next token in a white space separated string + character(len=*), intent(in) :: str + integer, intent(inout) :: cur + character(len=:), allocatable, intent(out) :: token + + integer :: next_s + + if (cur > len(str)) then + token = ""; return + end if + + next_s = index(str(cur:), " ") + + if (next_s == 0) then + token = str(cur:) + cur = len(str) + 1 + else + token = str(cur : cur + next_s - 2) + cur = cur + next_s + end if + + end subroutine + + !----------------------------------------------------------------------------- + + logical function try_parse(token, value) + ! Try to parse the token as a numerical constant + character(len=*), intent(in) :: token + real(ESMF_KIND_R8), intent(out) :: value + character(len=128) :: buffer + integer :: ios + + buffer = adjustl(token) ! use fixed size buffer for read + read(buffer, *, iostat=ios) value + try_parse = (ios == 0) + end function try_parse + + !----------------------------------------------------------------------------- + + integer function precedence(op) + ! Operator precendece + character(len=*), intent(in) :: op + select case (trim(op)) + case ("+", "-") ; precedence = 2 + case ("*", "/") ; precedence = 3 + case default ; precedence = 0 + end select + end function + + !----------------------------------------------------------------------------- + + logical function is_operator(token) + ! Identify token as operator + character(len=*), intent(in) :: token + select case (trim(token)) + case ("+", "-", "*", "/") ; is_operator = .true. + case default ; is_operator = .false. + end select + end function + + !----------------------------------------------------------------------------- + + subroutine access_data_i4(field, fPtr, rc) + ! Access field data as 1D contigous data array + type(ESMF_Field), intent(in) :: field + integer(ESMF_KIND_I4), pointer, contiguous, intent(out) :: fPtr(:) + integer, intent(out) :: rc + + integer :: rank + integer(ESMF_KIND_I4), pointer, contiguous :: fPtr2D(:,:) + integer(ESMF_KIND_I4), pointer, contiguous :: fPtr3D(:,:,:) + integer(ESMF_KIND_I4), pointer, contiguous :: fPtr4D(:,:,:,:) + integer(ESMF_KIND_I4), pointer, contiguous :: fPtr5D(:,:,:,:,:) + integer(ESMF_KIND_I4), pointer, contiguous :: fPtr6D(:,:,:,:,:,:) + integer(ESMF_KIND_I4), pointer, contiguous :: fPtr7D(:,:,:,:,:,:,:) + + call ESMF_FieldGet(field, rank=rank, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + + if (rank == 1) then + call ESMF_FieldGet(field, farrayPtr=fPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else if (rank == 2) then + call ESMF_FieldGet(field, farrayPtr=fPtr2D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr2D)) => fPtr2D(:, :) + else if (rank == 3) then + call ESMF_FieldGet(field, farrayPtr=fPtr3D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr3D)) => fPtr3D(:, :,:) + else if (rank == 4) then + call ESMF_FieldGet(field, farrayPtr=fPtr4D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr4D)) => fPtr4D(:, :,:,:) + else if (rank == 5) then + call ESMF_FieldGet(field, farrayPtr=fPtr5D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr5D)) => fPtr5D(:, :,:,:,:) + else if (rank == 6) then + call ESMF_FieldGet(field, farrayPtr=fPtr6D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr6D)) => fPtr6D(:, :,:,:,:,:) + else if (rank == 7) then + call ESMF_FieldGet(field, farrayPtr=fPtr7D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr7D)) => fPtr7D(:, :,:,:,:,:,:) + end if + end subroutine + + subroutine access_data_i8(field, fPtr, rc) + ! Access field data as 1D contigous data array + type(ESMF_Field), intent(in) :: field + integer(ESMF_KIND_I8), pointer, contiguous, intent(out) :: fPtr(:) + integer, intent(out) :: rc + + integer :: rank + integer(ESMF_KIND_I8), pointer, contiguous :: fPtr2D(:,:) + integer(ESMF_KIND_I8), pointer, contiguous :: fPtr3D(:,:,:) + integer(ESMF_KIND_I8), pointer, contiguous :: fPtr4D(:,:,:,:) + integer(ESMF_KIND_I8), pointer, contiguous :: fPtr5D(:,:,:,:,:) + integer(ESMF_KIND_I8), pointer, contiguous :: fPtr6D(:,:,:,:,:,:) + integer(ESMF_KIND_I8), pointer, contiguous :: fPtr7D(:,:,:,:,:,:,:) + + call ESMF_FieldGet(field, rank=rank, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + + if (rank == 1) then + call ESMF_FieldGet(field, farrayPtr=fPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else if (rank == 2) then + call ESMF_FieldGet(field, farrayPtr=fPtr2D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr2D)) => fPtr2D(:, :) + else if (rank == 3) then + call ESMF_FieldGet(field, farrayPtr=fPtr3D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr3D)) => fPtr3D(:, :,:) + else if (rank == 4) then + call ESMF_FieldGet(field, farrayPtr=fPtr4D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr4D)) => fPtr4D(:, :,:,:) + else if (rank == 5) then + call ESMF_FieldGet(field, farrayPtr=fPtr5D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr5D)) => fPtr5D(:, :,:,:,:) + else if (rank == 6) then + call ESMF_FieldGet(field, farrayPtr=fPtr6D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr6D)) => fPtr6D(:, :,:,:,:,:) + else if (rank == 7) then + call ESMF_FieldGet(field, farrayPtr=fPtr7D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr7D)) => fPtr7D(:, :,:,:,:,:,:) + end if + end subroutine + + subroutine access_data_r4(field, fPtr, rc) + ! Access field data as 1D contigous data array + type(ESMF_Field), intent(in) :: field + real(ESMF_KIND_R4), pointer, contiguous, intent(out) :: fPtr(:) + integer, intent(out) :: rc + + integer :: rank + real(ESMF_KIND_R4), pointer, contiguous :: fPtr2D(:,:) + real(ESMF_KIND_R4), pointer, contiguous :: fPtr3D(:,:,:) + real(ESMF_KIND_R4), pointer, contiguous :: fPtr4D(:,:,:,:) + real(ESMF_KIND_R4), pointer, contiguous :: fPtr5D(:,:,:,:,:) + real(ESMF_KIND_R4), pointer, contiguous :: fPtr6D(:,:,:,:,:,:) + real(ESMF_KIND_R4), pointer, contiguous :: fPtr7D(:,:,:,:,:,:,:) + + call ESMF_FieldGet(field, rank=rank, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + + if (rank == 1) then + call ESMF_FieldGet(field, farrayPtr=fPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else if (rank == 2) then + call ESMF_FieldGet(field, farrayPtr=fPtr2D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr2D)) => fPtr2D(:, :) + else if (rank == 3) then + call ESMF_FieldGet(field, farrayPtr=fPtr3D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr3D)) => fPtr3D(:, :,:) + else if (rank == 4) then + call ESMF_FieldGet(field, farrayPtr=fPtr4D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr4D)) => fPtr4D(:, :,:,:) + else if (rank == 5) then + call ESMF_FieldGet(field, farrayPtr=fPtr5D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr5D)) => fPtr5D(:, :,:,:,:) + else if (rank == 6) then + call ESMF_FieldGet(field, farrayPtr=fPtr6D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr6D)) => fPtr6D(:, :,:,:,:,:) + else if (rank == 7) then + call ESMF_FieldGet(field, farrayPtr=fPtr7D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr7D)) => fPtr7D(:, :,:,:,:,:,:) + end if + end subroutine + + subroutine access_data_r8(field, fPtr, rc) + ! Access field data as 1D contigous data array + type(ESMF_Field), intent(in) :: field + real(ESMF_KIND_R8), pointer, contiguous, intent(out) :: fPtr(:) + integer, intent(out) :: rc + + integer :: rank + real(ESMF_KIND_R8), pointer, contiguous :: fPtr2D(:,:) + real(ESMF_KIND_R8), pointer, contiguous :: fPtr3D(:,:,:) + real(ESMF_KIND_R8), pointer, contiguous :: fPtr4D(:,:,:,:) + real(ESMF_KIND_R8), pointer, contiguous :: fPtr5D(:,:,:,:,:) + real(ESMF_KIND_R8), pointer, contiguous :: fPtr6D(:,:,:,:,:,:) + real(ESMF_KIND_R8), pointer, contiguous :: fPtr7D(:,:,:,:,:,:,:) + + call ESMF_FieldGet(field, rank=rank, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + + if (rank == 1) then + call ESMF_FieldGet(field, farrayPtr=fPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else if (rank == 2) then + call ESMF_FieldGet(field, farrayPtr=fPtr2D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr2D)) => fPtr2D(:, :) + else if (rank == 3) then + call ESMF_FieldGet(field, farrayPtr=fPtr3D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr3D)) => fPtr3D(:, :,:) + else if (rank == 4) then + call ESMF_FieldGet(field, farrayPtr=fPtr4D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr4D)) => fPtr4D(:, :,:,:) + else if (rank == 5) then + call ESMF_FieldGet(field, farrayPtr=fPtr5D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr5D)) => fPtr5D(:, :,:,:,:) + else if (rank == 6) then + call ESMF_FieldGet(field, farrayPtr=fPtr6D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr6D)) => fPtr6D(:, :,:,:,:,:) + else if (rank == 7) then + call ESMF_FieldGet(field, farrayPtr=fPtr7D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + fPtr(1:size(fPtr7D)) => fPtr7D(:, :,:,:,:,:,:) + end if + end subroutine + + !----------------------------------------------------------------------------- + +end module dataProcess From ccda1f4839ee6426165f50c7a2250d57bfc714f7 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Mon, 11 May 2026 16:20:17 -0700 Subject: [PATCH 05/16] Implement special variable handling _step and _coordX. Also align dataInit better with dataAdvance. --- src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 | 93 +++++---- .../ESMX/Comps/ESMX_Data/dataProcess.F90 | 183 +++++++++++++++++- 2 files changed, 220 insertions(+), 56 deletions(-) diff --git a/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 b/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 index fa767cb6a8..a18ce97b7e 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 +++ b/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 @@ -26,12 +26,14 @@ module ESMX_Data type(ESMF_Field) :: field logical :: dataDiagnose character(len=:), allocatable :: dataValidate + character(len=:), allocatable :: dataInit end type type ExportItem type(ESMF_Field) :: field logical :: dataDiagnose character(len=:), allocatable :: dataValidate + character(len=:), allocatable :: dataInit character(len=:), allocatable :: dataAdvance end type @@ -292,7 +294,8 @@ subroutine IngestFromHConfig(hconfig, timeKeeping, geoms, imports, exports, & imports(item)%field = FieldCreateFromHConfig(hconfigIt, geoms=geoms, & dataDiagnose=imports(item)%dataDiagnose, & - dataValidate=imports(item)%dataValidate, rc=rc) + dataValidate=imports(item)%dataValidate, & + dataInit=imports(item)%dataInit, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, & msg="Problem creating import field.", & line=__LINE__, file=__FILE__)) return ! bail out @@ -348,6 +351,7 @@ subroutine IngestFromHConfig(hconfig, timeKeeping, geoms, imports, exports, & exports(item)%field = FieldCreateFromHConfig(hconfigIt, geoms=geoms, & dataDiagnose=exports(item)%dataDiagnose, & dataValidate=exports(item)%dataValidate, & + dataInit=exports(item)%dataInit, & dataAdvance=exports(item)%dataAdvance, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, & msg="Problem creating export field.", & @@ -371,12 +375,13 @@ end subroutine IngestFromHConfig !----------------------------------------------------------------------------- function FieldCreateFromHConfig(hconfig, geoms, dataDiagnose, dataValidate, & - dataAdvance, rc) + dataInit, dataAdvance, rc) type(ESMF_Field) :: FieldCreateFromHConfig type(ESMF_HConfigIter), intent(in) :: hconfig type(GeomItem), intent(in) :: geoms(:) logical, intent(out) :: dataDiagnose character(len=:), allocatable, intent(out) :: dataValidate + character(len=:), allocatable, intent(out), optional :: dataInit character(len=:), allocatable, intent(out), optional :: dataAdvance integer, intent(out) :: rc @@ -571,44 +576,6 @@ function FieldCreateFromHConfig(hconfig, geoms, dataDiagnose, dataValidate, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out - ! handle dataInit (optional) - isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="dataInit", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (isFlag) then - ! ingest key and set as field info metadata - call InfoIngestFromHConfig(info, hconfigMap, key="dataInit", & - typekind=typekind, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - ! for now call FieldFill() right here... this may move into realize - ! always use valueR8, because that is what FieldFill() takes for const - if (typekind == ESMF_TYPEKIND_I4) then - call ESMF_InfoGet(info, key="dataInit", value=valueI4, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - valueR8 = real(valueI4,ESMF_KIND_R8) - else if (typekind == ESMF_TYPEKIND_I8) then - call ESMF_InfoGet(info, key="dataInit", value=valueI8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - valueR8 = real(valueI8,ESMF_KIND_R8) - else if (typekind == ESMF_TYPEKIND_R4) then - call ESMF_InfoGet(info, key="dataInit", value=valueR4, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - valueR8 = real(valueR4,ESMF_KIND_R8) - else if (typekind == ESMF_TYPEKIND_R8) then - call ESMF_InfoGet(info, key="dataInit", value=valueR8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - call ESMF_FieldFill(FieldCreateFromHConfig, dataFillScheme="const", & - const1=valueR8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - ! handle dataMask (optional) isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="dataMask", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -680,6 +647,24 @@ function FieldCreateFromHConfig(hconfig, geoms, dataDiagnose, dataValidate, & dataValidate = "NO" endif + ! handle dataInit (optional) + if (present(dataInit)) then + isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="dataInit", & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! dataInit key provided -> read value string + dataInit = ESMF_HConfigAsString(hconfigMap, & + keyString="dataInit", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else + ! dataInit key not provided, default + dataInit = "" ! NOOP + endif + endif + ! handle dataAdvance (optional) if (present(dataAdvance)) then isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="dataAdvance", & @@ -1376,8 +1361,9 @@ subroutine DataInitialize(xdata, rc) enddo endif - ! Advance the data in export fields - call DataAdvance(importState, is%wrap%exportItems, rc=rc) + ! Initialize the data in export fields + call DataHandling(importState, is%wrap%exportItems, is%wrap%stepCounter, & + rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out @@ -1507,7 +1493,8 @@ subroutine Advance(xdata, rc) endif ! Advance the data in export fields - call DataAdvance(importState, is%wrap%exportItems, rc=rc) + call DataHandling(importState, is%wrap%exportItems, is%wrap%stepCounter, & + rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out @@ -2027,12 +2014,14 @@ subroutine FieldStats(field, statsCount, statsMean, statsMin, statsMax, & !----------------------------------------------------------------------------- - subroutine DataAdvance(importState, exportItems, rc) + subroutine DataHandling(importState, exportItems, step, rc) type(ESMF_State) :: importState type(ExportItem), allocatable :: exportItems(:) - integer, intent(out) :: rc + integer, intent(in) :: step + integer, intent(out) :: rc integer :: i + character(len=:), allocatable :: expression rc = ESMF_SUCCESS @@ -2040,10 +2029,16 @@ subroutine DataAdvance(importState, exportItems, rc) if (.not.allocated(exportItems)) return do i=1, size(exportItems) - if (exportItems(i)%dataAdvance == "") cycle ! NOOP - call process(exportItems(i)%field, exportItems(i)%dataAdvance, & - importState, rc=rc) + if (step==0) then + expression = exportItems(i)%dataInit + else + expression = exportItems(i)%dataAdvance + endif + + if (expression == "") cycle ! NOOP + + call process(importState, expression, exportItems(i)%field, step, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out @@ -2154,6 +2149,7 @@ subroutine Finalize(xdata, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out deallocate(is%wrap%importItems(i)%dataValidate) + deallocate(is%wrap%importItems(i)%dataInit) enddo deallocate(is%wrap%importItems) endif @@ -2166,6 +2162,7 @@ subroutine Finalize(xdata, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out deallocate(is%wrap%exportItems(i)%dataValidate) + deallocate(is%wrap%exportItems(i)%dataInit) deallocate(is%wrap%exportItems(i)%dataAdvance) enddo deallocate(is%wrap%exportItems) diff --git a/src/addon/ESMX/Comps/ESMX_Data/dataProcess.F90 b/src/addon/ESMX/Comps/ESMX_Data/dataProcess.F90 index 6138b79947..7aca6e76a2 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/dataProcess.F90 +++ b/src/addon/ESMX/Comps/ESMX_Data/dataProcess.F90 @@ -18,11 +18,13 @@ module dataProcess !----------------------------------------------------------------------------- - subroutine process(exportField, dataAdvance, importState, rc) + subroutine process(importState, expression, exportField, step, rc) + ! Process according to the expression infix string and store in exportField - type(ESMF_Field), intent(inout) :: exportField - character(len=*), intent(in) :: dataAdvance type(ESMF_State), intent(in) :: importState + character(len=*), intent(in) :: expression + type(ESMF_Field), intent(inout) :: exportField + integer, intent(in) :: step integer, intent(out) :: rc type(ESMF_Field) :: importField @@ -35,7 +37,8 @@ subroutine process(exportField, dataAdvance, importState, rc) real(ESMF_KIND_R8), pointer, contiguous :: fPtrImportR8(:) real(ESMF_KIND_R8), pointer, contiguous :: fPtrExportR8(:) real(ESMF_KIND_R8) :: value - character(len=:), allocatable :: infix_expression, rpn_expression, token + character(len=:), allocatable :: infix_expression, rpn_expression + character(len=:), allocatable :: token, tempString integer :: count, cur, top, depth type(ESMF_TYPEKIND_Flag) :: tkImport, tkExport real(ESMF_KIND_R8), allocatable :: stack(:,:) @@ -43,7 +46,7 @@ subroutine process(exportField, dataAdvance, importState, rc) rc = ESMF_SUCCESS ! Normalize the incoming infix string with single white space deliminators - call normalize_infix(dataAdvance, infix_expression) + call normalize_infix(expression, infix_expression) ! Convert standard infix notation to reverse polish notation call infix_to_rpn(infix_expression, rpn_expression) @@ -77,7 +80,7 @@ subroutine process(exportField, dataAdvance, importState, rc) count = size(fPtrExportR8) else call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & - msg="DataAdvance() only supports I4, I8, R4, and R8.", & + msg="process() only supports I4, I8, R4, and R8.", & line=__LINE__, file=__FILE__, rcToReturn=rc) return ! bail out end if @@ -110,8 +113,27 @@ subroutine process(exportField, dataAdvance, importState, rc) if (try_parse(token, value)) then ! Numerical value stack(:,top) = value + else if (token(1:1) == "_") then + ! Special variable + tempString = ESMF_UtilStringUpperCase(token, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (tempString == "_STEP") then + ! Step + stack(:,top) = real(step, ESMF_KIND_R8) + else if (tempString(1:6) == "_COORD") then + ! Coordinate + call push_coord(exportField, token, stack(:,top), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + else + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg="Unknown special variable: "//token, & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + end if else - ! Variable Name: Pull from importState + ! Field in importState call ESMF_StateGet(importState, itemName=token, field=importField, & rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -141,7 +163,7 @@ subroutine process(exportField, dataAdvance, importState, rc) stack(:,top) = fPtrImportR8 else call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & - msg="DataAdvance() only supports I4, I8, R4, and R8.", & + msg="process() only supports I4, I8, R4, and R8.", & line=__LINE__, file=__FILE__, rcToReturn=rc) return ! bail out end if @@ -167,6 +189,151 @@ subroutine process(exportField, dataAdvance, importState, rc) !----------------------------------------------------------------------------- + subroutine push_coord(field, token, stackColumn, rc) + type(ESMF_Field), intent(in) :: field + character(len=*), intent(in) :: token + real(ESMF_KIND_R8), intent(out) :: stackColumn(:) + integer, intent(out) :: rc + + integer :: coordDim + type(ESMF_Grid) :: grid + type(ESMF_Mesh) :: mesh + type(ESMF_GeomType_Flag) :: geomtype + type(ESMF_StaggerLoc) :: staggerloc + type(ESMF_MeshLoc) :: meshloc + integer :: dimCount, m, i, j, k, idx + integer :: inner_repeat, outer_replicate + integer, allocatable :: coordDimCount(:), exclusiveCount(:) + integer :: numOwnedPoints + real(ESMF_KIND_R8), pointer, contiguous :: fPtr(:) + real(ESMF_KIND_R8), pointer, contiguous :: fPtr1D(:) + real(ESMF_KIND_R8), pointer, contiguous :: fPtr2D(:,:) + real(ESMF_KIND_R8), pointer, contiguous :: fPtr3D(:,:,:) + + rc = ESMF_SUCCESS + + ! Extract digit from "_coordX" + read(token(7:), *, iostat=rc) coordDim + + call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + + if (geomtype==ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(field, grid=grid, staggerloc=staggerloc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_GridGet(grid, dimCount=dimCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + allocate(coordDimCount(dimCount)) + call ESMF_GridGet(grid, coordDimCount=coordDimCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (coordDimCount(coordDim)==1) then + allocate(exclusiveCount(dimCount)) + call ESMF_GridGet(grid, staggerloc=staggerloc, localDE=0, & + exclusiveCount=exclusiveCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_GridGetCoord(grid, coordDim=coordDim, staggerloc=staggerloc, & + farrayPtr=fPtr1D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + m = size(fPtr1D) + inner_repeat = product(exclusiveCount(1:coordDim-1)) + outer_replicate = product(exclusiveCount(coordDim+1:dimCount)) + ! Populate stackColumn with replicated fPtr1D data + idx = 1 + do k = 1, outer_replicate + do j = 1, m + do i = 1, inner_repeat + stackColumn(idx) = fPtr1D(lbound(fPtr1D,1)-1+j) + idx = idx + 1 + end do + end do + end do + else if (coordDimCount(coordDim)==2) then + call ESMF_GridGetCoord(grid, coordDim=coordDim, staggerloc=staggerloc, & + farrayPtr=fPtr2D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + ! Reinterpret + fPtr(1:size(fPtr2D)) => fPtr2D(:, :) + ! Copy into stackColumn + stackColumn(:) = fPtr + else if (coordDimCount(coordDim)==3) then + call ESMF_GridGetCoord(grid, coordDim=coordDim, staggerloc=staggerloc, & + farrayPtr=fPtr3D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + ! Reinterpret + fPtr(1:size(fPtr3D)) => fPtr3D(:, :, :) + ! Copy into stackColumn + stackColumn(:) = fPtr + else + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg="Unsupported coordDimCount detected.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + elseif (geomtype==ESMF_GEOMTYPE_MESH) then + call ESMF_FieldGet(field, mesh=mesh, meshloc=meshloc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (meshloc==ESMF_MESHLOC_ELEMENT) then + call ESMF_MeshGet(mesh, spatialDim=dimCount, & + numOwnedElements=numOwnedPoints, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + elseif (meshloc==ESMF_MESHLOC_NODE) then + call ESMF_MeshGet(mesh, spatialDim=dimCount, & + numOwnedNodes=numOwnedPoints, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg="Unsupported MESHLOC detected.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + if (dimCount==1) then + ! Directly fill stackColumn + if (meshloc==ESMF_MESHLOC_ELEMENT) then + call ESMF_MeshGet(mesh, ownedElemCoords=stackColumn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else + call ESMF_MeshGet(mesh, ownedNodeCoords=stackColumn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + endif + else + ! Require temporary fPtr1D + allocate(fPtr1D(dimCount*numOwnedPoints)) + if (meshloc==ESMF_MESHLOC_ELEMENT) then + call ESMF_MeshGet(mesh, ownedElemCoords=fPtr1D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else + call ESMF_MeshGet(mesh, ownedNodeCoords=fPtr1D, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + endif + stackColumn = fPtr1D(coordDim::dimCount) ! copy the coorDim entries + deallocate(fPtr1D) + endif + else + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg="Unsupported geomtype detected.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + + end subroutine + + !----------------------------------------------------------------------------- + subroutine normalize_infix(input, output) ! Normalize the incoming infix string with single white space deliminators character(len=*), intent(in) :: input From c3ccd3d1908cb46621fd6304f25277b0f65ecd97 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 12 May 2026 09:33:11 -0700 Subject: [PATCH 06/16] Fix a typo and move any output to stdout under the dataDiagnose logic. --- src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 | 23 +++++++++++--------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 b/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 index a18ce97b7e..8497f5d407 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 +++ b/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 @@ -1429,10 +1429,6 @@ subroutine Advance(xdata, rc) importState=importState, exportState=exportState, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - call ESMF_ClockPrint(clock, options="currTime", & - unit=clockString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out if (btest(diagnostic,17)) then ! write fields of the importState @@ -1445,11 +1441,6 @@ subroutine Advance(xdata, rc) line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out endif - ! write to standard out - if (localPet == 0) then - write(*,'(A,1X,A)') trim(name)//": Model Advance at: ",trim(clockString) - endif - ! reset counters warnCount = 0 errCount = 0 @@ -1470,6 +1461,12 @@ subroutine Advance(xdata, rc) if (localPet == 0) then if (.not.headerPrinted) then headerPrinted = .true. + call ESMF_ClockPrint(clock, options="currTime", & + unit=clockString, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail + write(*,'(A,1X,A)') trim(name)//": Model Advance at: ", & + trim(clockString) write(*,'(A)') trim(name)//": Import Fields" write(*,'(A,1X,A25,1X,A9,3(1X,A9),1X,A4)') & trim(name)//":", "FIELD", "COUNT", "MEAN", "MIN", "MAX", "OKAY" @@ -1510,10 +1507,16 @@ subroutine Advance(xdata, rc) statsOkay=statsOkay, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - if (is%wrap%importItems(i)%dataDiagnose .or. .not.statsOkay) then + if (is%wrap%exportItems(i)%dataDiagnose .or. .not.statsOkay) then if (localPet == 0) then if (.not.headerPrinted) then headerPrinted = .true. + call ESMF_ClockPrint(clock, options="currTime", & + unit=clockString, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail + write(*,'(A,1X,A)') trim(name)//": Model Advance at: ", & + trim(clockString) write(*,'(A)') trim(name)//": Export Fields" write(*,'(A,1X,A25,1X,A9,3(1X,A9),1X,A4)') & trim(name)//":", "FIELD", "COUNT", "MEAN", "MIN", "MAX", "OKAY" From 78b97123c0720f2d3521af2c277d8ae911faa826 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 12 May 2026 10:51:29 -0700 Subject: [PATCH 07/16] Implement support for unary elemental conversion and mathematical functions. --- .../ESMX/Comps/ESMX_Data/dataProcess.F90 | 176 ++++++++++++++---- 1 file changed, 144 insertions(+), 32 deletions(-) diff --git a/src/addon/ESMX/Comps/ESMX_Data/dataProcess.F90 b/src/addon/ESMX/Comps/ESMX_Data/dataProcess.F90 index 7aca6e76a2..e2fe18bc40 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/dataProcess.F90 +++ b/src/addon/ESMX/Comps/ESMX_Data/dataProcess.F90 @@ -42,6 +42,7 @@ subroutine process(importState, expression, exportField, step, rc) integer :: count, cur, top, depth type(ESMF_TYPEKIND_Flag) :: tkImport, tkExport real(ESMF_KIND_R8), allocatable :: stack(:,:) + real(ESMF_KIND_R8), parameter :: pi = acos(-1.0_ESMF_KIND_R8) rc = ESMF_SUCCESS @@ -96,18 +97,74 @@ subroutine process(importState, expression, exportField, step, rc) if (token == "") exit select case (token) - case ("+") - stack(:,top-1) = stack(:,top-1) + stack(:,top) - top = top - 1 - case ("-") - stack(:,top-1) = stack(:,top-1) - stack(:,top) - top = top - 1 + case ("ABS") + stack(:,top) = abs(stack(:,top)) + case ("AINT") + stack(:,top) = aint(stack(:,top)) + case ("ANINT") + stack(:,top) = anint(stack(:,top)) + case ("CEILING") + stack(:,top) = ceiling(stack(:,top)) + case ("FLOOR") + stack(:,top) = floor(stack(:,top)) + case ("DEG2RAD") + stack(:,top) = (stack(:,top))/180.0*PI + case ("RAD2DEG") + stack(:,top) = (stack(:,top))/PI*180.0 + case ("ACOS") + stack(:,top) = acos(stack(:,top)) + case ("ACOSH") + stack(:,top) = acosh(stack(:,top)) + case ("ASIN") + stack(:,top) = asin(stack(:,top)) + case ("ASINH") + stack(:,top) = asinh(stack(:,top)) + case ("ATAN") + stack(:,top) = atan(stack(:,top)) + case ("ATANH") + stack(:,top) = atanh(stack(:,top)) + case ("COS") + stack(:,top) = cos(stack(:,top)) + case ("COSH") + stack(:,top) = cosh(stack(:,top)) + case ("ERF") + stack(:,top) = erf(stack(:,top)) + case ("ERFC") + stack(:,top) = erfc(stack(:,top)) + case ("ERFC_SCALED") + stack(:,top) = erfc_scaled(stack(:,top)) + case ("EXP") + stack(:,top) = exp(stack(:,top)) + case ("GAMMA") + stack(:,top) = gamma(stack(:,top)) + case ("LOG") + stack(:,top) = log(stack(:,top)) + case ("LOG_GAMMA") + stack(:,top) = log_gamma(stack(:,top)) + case ("LOG10") + stack(:,top) = log10(stack(:,top)) + case ("SIN") + stack(:,top) = sin(stack(:,top)) + case ("SINH") + stack(:,top) = sinh(stack(:,top)) + case ("SQRT") + stack(:,top) = sqrt(stack(:,top)) + case ("TAN") + stack(:,top) = tan(stack(:,top)) + case ("TANH") + stack(:,top) = tanh(stack(:,top)) case ("*") stack(:,top-1) = stack(:,top-1) * stack(:,top) top = top - 1 case ("/") stack(:,top-1) = stack(:,top-1) / stack(:,top) top = top - 1 + case ("+") + stack(:,top-1) = stack(:,top-1) + stack(:,top) + top = top - 1 + case ("-") + stack(:,top-1) = stack(:,top-1) - stack(:,top) + top = top - 1 case default top = top + 1 if (try_parse(token, value)) then @@ -118,7 +175,10 @@ subroutine process(importState, expression, exportField, step, rc) tempString = ESMF_UtilStringUpperCase(token, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out - if (tempString == "_STEP") then + if (tempString == "_PI") then + ! PI + stack(:,top) = PI + else if (tempString == "_STEP") then ! Step stack(:,top) = real(step, ESMF_KIND_R8) else if (tempString(1:6) == "_COORD") then @@ -201,7 +261,7 @@ subroutine push_coord(field, token, stackColumn, rc) type(ESMF_GeomType_Flag) :: geomtype type(ESMF_StaggerLoc) :: staggerloc type(ESMF_MeshLoc) :: meshloc - integer :: dimCount, m, i, j, k, idx + integer :: dimCount, m, i, j, k, idx, off integer :: inner_repeat, outer_replicate integer, allocatable :: coordDimCount(:), exclusiveCount(:) integer :: numOwnedPoints @@ -243,12 +303,14 @@ subroutine push_coord(field, token, stackColumn, rc) m = size(fPtr1D) inner_repeat = product(exclusiveCount(1:coordDim-1)) outer_replicate = product(exclusiveCount(coordDim+1:dimCount)) + deallocate(exclusiveCount) ! Populate stackColumn with replicated fPtr1D data + off = lbound(fPtr1D,1)-1 idx = 1 do k = 1, outer_replicate do j = 1, m do i = 1, inner_repeat - stackColumn(idx) = fPtr1D(lbound(fPtr1D,1)-1+j) + stackColumn(idx) = fPtr1D(off+j) idx = idx + 1 end do end do @@ -277,6 +339,7 @@ subroutine push_coord(field, token, stackColumn, rc) line=__LINE__, file=__FILE__, rcToReturn=rc) return ! bail out endif + deallocate(coordDimCount) elseif (geomtype==ESMF_GEOMTYPE_MESH) then call ESMF_FieldGet(field, mesh=mesh, meshloc=meshloc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -405,10 +468,14 @@ subroutine infix_to_rpn(infix, rpn) ! Convert standard infix notation to reverse polish notation character(len=*), intent(in) :: infix character(len=:), allocatable, intent(out) :: rpn - character(len=128):: op_stack(20) ! Stack for operators - integer :: stack_ptr - character(len=:), allocatable :: token - integer :: cur, i + + character(len=128), allocatable :: op_stack(:) + integer :: stack_ptr + character(len=:), allocatable :: token + integer :: cur, i + + ! Allocate the stack based on the length of the input string + allocate(op_stack(len(infix))) rpn = "" stack_ptr = 0 @@ -421,14 +488,13 @@ subroutine infix_to_rpn(infix, rpn) if (is_operator(token)) then ! Handle Operators - do while (stack_ptr > 0) - if (op_stack(stack_ptr) /= "(" .and. & - precedence(op_stack(stack_ptr)) >= precedence(token)) then - rpn = rpn // trim(op_stack(stack_ptr)) // " " - stack_ptr = stack_ptr - 1 - else - exit - end if + do + if (stack_ptr <= 0) exit + if (op_stack(stack_ptr) == "(") exit + if (precedence(op_stack(stack_ptr)) < precedence(token)) exit + + rpn = rpn // trim(op_stack(stack_ptr)) // " " + stack_ptr = stack_ptr - 1 end do stack_ptr = stack_ptr + 1 op_stack(stack_ptr) = token @@ -440,11 +506,24 @@ subroutine infix_to_rpn(infix, rpn) else if (token == ")") then ! Handle Right Parenthesis - do while (stack_ptr > 0 .and. op_stack(stack_ptr) /= "(") + do + if (stack_ptr <= 0) exit + if (op_stack(stack_ptr) == "(") exit rpn = rpn // trim(op_stack(stack_ptr)) // " " stack_ptr = stack_ptr - 1 end do - if (stack_ptr > 0) stack_ptr = stack_ptr - 1 ! Pop the "(" + + if (stack_ptr > 0) then + stack_ptr = stack_ptr - 1 ! Pop the "(" + + ! Check if a function was associated with this parenthesis pair + if (stack_ptr > 0) then + if (is_function(op_stack(stack_ptr))) then + rpn = rpn // trim(op_stack(stack_ptr)) // " " + stack_ptr = stack_ptr - 1 + end if + end if + end if else ! Number or field name - send straight to output @@ -454,9 +533,14 @@ subroutine infix_to_rpn(infix, rpn) ! Pop remaining operators from stack do i = stack_ptr, 1, -1 - rpn = rpn // trim(op_stack(i)) // " " + if (op_stack(i) /= "(") then + rpn = rpn // trim(op_stack(i)) // " " + end if end do + ! Deallocate the stack + deallocate(op_stack) + ! Remove trailing space rpn = trim(rpn) @@ -479,7 +563,10 @@ integer function compute_rpn_depth(rpn) call get_next_token(rpn, cur, token) if (token == "") exit - if (is_operator(token)) then + if (is_function(token)) then + ! Unary functions (sin, cos, ...) pop one and push one: net change 0 + current_depth = current_depth + else if (is_operator(token)) then ! Binary operators (+, -, *, /) pop two operands and push one result. ! This results in a net change of -1 to the stack height. current_depth = current_depth - 1 @@ -521,6 +608,11 @@ subroutine get_next_token(str, cur, token) cur = cur + next_s end if + if (is_function(token)) then + ! For functions return token as upper case + token = ESMF_UtilStringUpperCase(token) + endif + end subroutine !----------------------------------------------------------------------------- @@ -542,11 +634,15 @@ end function try_parse integer function precedence(op) ! Operator precendece character(len=*), intent(in) :: op - select case (trim(op)) - case ("+", "-") ; precedence = 2 - case ("*", "/") ; precedence = 3 - case default ; precedence = 0 - end select + if (is_function(op)) then + precedence = 4 + else + select case (trim(op)) + case ("*", "/") ; precedence = 3 + case ("+", "-") ; precedence = 2 + case default ; precedence = 0 + end select + end if end function !----------------------------------------------------------------------------- @@ -554,9 +650,25 @@ integer function precedence(op) logical function is_operator(token) ! Identify token as operator character(len=*), intent(in) :: token - select case (trim(token)) + select case (token) case ("+", "-", "*", "/") ; is_operator = .true. - case default ; is_operator = .false. + case default ; is_operator = is_function(token) + end select + end function + + !----------------------------------------------------------------------------- + + logical function is_function(token) + ! Identify token as unary function + character(len=*), intent(in) :: token + select case (ESMF_UtilStringUpperCase(token)) + case ("ABS", "AINT", "ANINT", "CEILING", "FLOOR", "DEG2RAD", "RAD2DEG", & + "ACOS", "ACOSH", "ASIN", "ASINH", "ATAN", "ATANH", "COS", "COSH", & + "ERF", "ERFC", "ERFC_SCALED", "EXP", "GAMMA", "LOG", "LOG_GAMMA", & + "LOG10", "SIN", "SINH", "SQRT", "TAN", "TANH") + is_function = .true. + case default + is_function = .false. end select end function From 85363e89c5a35f65144ea4cbdcbae0c3abf07996 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 12 May 2026 11:23:05 -0700 Subject: [PATCH 08/16] Add the "Dynamic arithmetic expressions" section. --- src/addon/ESMX/Comps/ESMX_Data/README.md | 67 ++++++++++++++++++++++-- 1 file changed, 64 insertions(+), 3 deletions(-) diff --git a/src/addon/ESMX/Comps/ESMX_Data/README.md b/src/addon/ESMX/Comps/ESMX_Data/README.md index 9ab45d677b..942b0aaa1b 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/README.md +++ b/src/addon/ESMX/Comps/ESMX_Data/README.md @@ -78,7 +78,7 @@ The `importFields` key must be associated with a map of key/value pairs. Each ke | `gridToFieldMap` | The mapping of grid to field dimension. For details see ESMF documentation. | `[1,2]` or `[1,2,3]` depending on rank | | `ungriddedLBound`| The lower bound of the ungridded dimension(s). For details see ESMF documentation. | *none* | | `ungriddedUBound`| The upper bound of the ungridded dimension(s). For details see ESMF documentation. | *none* | -| `dataInit` | The numerical value used to fill field data during initialization. | *none* | +| `dataInit` | [Dynamic arithmetic expression](#dynamic-arithmetic-expressions) used to initialze field data during DataInitialize. | *none* | | `dataMask` | The numerical value ignored during field statistics and validation check. | *none* | | `dataMin` | The minimum numerical value allowed in the field data to pass validation check. | *none* | | `dataMax` | The maximum numerical value allowed in the field data to pass validation check. | *none* | @@ -116,13 +116,13 @@ The `exportFields` key must be associated with a map of key/value pairs. Each ke | `gridToFieldMap` | The mapping of grid to field dimension. For details see ESMF documentation. | `[1,2]` or `[1,2,3]` depending on rank | | `ungriddedLBound`| The lower bound of the ungridded dimension(s). For details see ESMF documentation. | *none* | | `ungriddedUBound`| The upper bound of the ungridded dimension(s). For details see ESMF documentation. | *none* | -| `dataInit` | The numerical value used to fill field data during initialization. | *none* | +| `dataInit` | [Dynamic arithmetic expression](#dynamic-arithmetic-expressions) used to initialze field data during DataInitialize. | *none* | | `dataMask` | The numerical value ignored during field statistics and validation check. | *none* | | `dataMin` | The minimum numerical value allowed in the field data to pass validation check. | *none* | | `dataMax` | The maximum numerical value allowed in the field data to pass validation check. | *none* | | `dataDiagnose` | Enable/disable output of field data diagnostics: `yes` or `no`. | `no` | | `dataValidate` | The level of field data validation against the provided `dataMin` and `dataMax`: `no` - no validation, `warn` - issue warning if data found outside value range, `err` - return with error if data found outside value range. | `no` | -| `dataAdvance` | Simple arithmetic expression that supports numbers and standard names of import fields as operands, and +, -, *, / as operators. Parentheses are supported. The expression is used to update the data of export fields during the Advance step. | *none* | +| `dataAdvance` | [Dynamic arithmetic expression](#dynamic-arithmetic-expressions) used to update field data during Advance. | *none* | For an example, see the following configuration snippet for `ESMX_Data` instance named `DAT`. @@ -136,3 +136,64 @@ DAT: ``` This configuration defines a single field, `sea_surface_temperature`, in the `DAT` export state. It is defined on the `global` geometry using double-precision (`r8`) values. With no ungridded dimensions, the field is treated as a 2D surface. The omission of `*Value` keys indicates that the field is not locally initialized and incoming values are not validated against global extrema. During each `Advance` step, the `dataAdvance` expression exports the field at 110% of its current imported value; if `sea_surface_temperature` is missing from the `importState`, an error is triggered. + +### Dynamic arithmetic expressions + +Support for dynamic arithmetic expressions allows users to define mathematical transformations for field data using standard **infix notation**. These expressions are evaluated element-wise across the entire spatial domain of the involved fields. + +#### 1. Supported Operators +Expressions support standard arithmetic operators following traditional mathematical precedence. + +| Operator | Description | Precedence | Example | +| :--- | :--- | :--- | :--- | +| `*` | Multiplication | high | `field_a * 10.0` | +| `/` | Division | high | `field_b / 2.0` | +| `+` | Addition (including Unary Plus) | low | `field_a + field_b` | +| `-` | Subtraction (including Unary Minus) | low | `-field_c + 5.0` | + +> **Note**: Parentheses `()` can be used to override default precedence and group operations. + +--- + +#### 2. Mathematical Functions +Functions are case-insensitive and apply a transformation to each point in the data field. Most of these functions are implemented directly using their standard Fortran intrinsic equivalents. + +##### Trigonometric & Hyperbolic +* **Trigonometry**: `SIN`, `COS`, `TAN`, `ASIN`, `ACOS`, `ATAN` +* **Hyperbolic**: `SINH`, `COSH`, `TANH`, `ASINH`, `ACOSH`, `ATANH` +* **Angular Conversion**: `DEG2RAD` (Degrees to Radians), `RAD2DEG` (Radians to Degrees) + +##### Basic & Advanced Math +* **Logarithmic/Power**: `EXP`, `LOG` (Natural), `LOG10`, `SQRT` +* **Rounding/Truncation**: `ABS`, `AINT`, `ANINT`, `CEILING`, `FLOOR` +* **Special Functions**: `ERF`, `ERFC`, `ERFC_SCALED`, `GAMMA`, `LOG_GAMMA` + +--- + +#### 3. Operands and Variables +The system recognizes three types of values within an expression: + +##### Input Fields +Any alphanumeric name (e.g., `sea_surface_temperature`) is treated as a field name. The system will attempt to retrieve this field from the model's **Import State**. Supported data types include: +* 4-byte and 8-byte Integers (`I4`, `I8`) +* 4-byte and 8-byte Real numbers (`R4`, `R8`) + +##### Special Context Variables +Variables prefixed with an underscore provide metadata about the current simulation state: +* `_PI`: The mathematical constant PI. +* `_STEP`: The current model time step index. +* `_COORDx`: The spatial coordinate for dimension `x` (e.g., `_COORD1` typically represents Longitude/X). + +##### Numeric Constants +Standard numerical values (e.g., `2.5`, `100`, `1.0E-4`) are interpreted as double-precision floating-point numbers. + +--- + +#### 4. Usage Examples + +* **Unit Conversion (Celsius to Kelvin)**: + `temperature_c + 273.15` +* **Applying a Spatial Mask**: + `field_a * SIN(_COORD1 * DEG2RAD)` +* **Complex Scaling**: + `ABS(primary_field - secondary_field) / SQRT(_STEP * 1.0)` From e9d52fd6613a5d3e919cac58370f9df9754190c9 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 12 May 2026 13:19:16 -0700 Subject: [PATCH 09/16] Restructure how validation is sepcified. --- src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 | 560 ++++++------------- 1 file changed, 184 insertions(+), 376 deletions(-) diff --git a/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 b/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 index 8497f5d407..de0b824ee2 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 +++ b/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 @@ -22,17 +22,22 @@ module ESMX_Data type(ESMF_Geom) :: geom end type + type Validate + real(ESMF_KIND_R8) :: min, max, mask + logical :: minGuard, maxGuard, maskGuard + logical :: diagnose + character(len=:), allocatable :: action + end type + type ImportItem type(ESMF_Field) :: field - logical :: dataDiagnose - character(len=:), allocatable :: dataValidate + type(Validate) :: dataValidate character(len=:), allocatable :: dataInit end type type ExportItem type(ESMF_Field) :: field - logical :: dataDiagnose - character(len=:), allocatable :: dataValidate + type(Validate) :: dataValidate character(len=:), allocatable :: dataInit character(len=:), allocatable :: dataAdvance end type @@ -293,7 +298,6 @@ subroutine IngestFromHConfig(hconfig, timeKeeping, geoms, imports, exports, & item = item+1 imports(item)%field = FieldCreateFromHConfig(hconfigIt, geoms=geoms, & - dataDiagnose=imports(item)%dataDiagnose, & dataValidate=imports(item)%dataValidate, & dataInit=imports(item)%dataInit, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, & @@ -349,7 +353,6 @@ subroutine IngestFromHConfig(hconfig, timeKeeping, geoms, imports, exports, & item = item+1 exports(item)%field = FieldCreateFromHConfig(hconfigIt, geoms=geoms, & - dataDiagnose=exports(item)%dataDiagnose, & dataValidate=exports(item)%dataValidate, & dataInit=exports(item)%dataInit, & dataAdvance=exports(item)%dataAdvance, rc=rc) @@ -374,20 +377,19 @@ end subroutine IngestFromHConfig !----------------------------------------------------------------------------- - function FieldCreateFromHConfig(hconfig, geoms, dataDiagnose, dataValidate, & + function FieldCreateFromHConfig(hconfig, geoms, dataValidate, & dataInit, dataAdvance, rc) type(ESMF_Field) :: FieldCreateFromHConfig type(ESMF_HConfigIter), intent(in) :: hconfig type(GeomItem), intent(in) :: geoms(:) - logical, intent(out) :: dataDiagnose - character(len=:), allocatable, intent(out) :: dataValidate + type(Validate), intent(out) :: dataValidate character(len=:), allocatable, intent(out), optional :: dataInit character(len=:), allocatable, intent(out), optional :: dataAdvance integer, intent(out) :: rc ! local variables logical :: isFlag - type(ESMF_HConfig) :: hconfigMap + type(ESMF_HConfig) :: hconfigMap, hconfigMap2 character(:), allocatable :: geometry, name, badkey, string type(ESMF_Grid) :: grid integer :: item @@ -395,7 +397,6 @@ function FieldCreateFromHConfig(hconfig, geoms, dataDiagnose, dataValidate, & integer, allocatable :: gridToFieldMap(:) integer, allocatable :: ungriddedLBound(:) integer, allocatable :: ungriddedUBound(:) - type(ESMF_Info) :: info integer(ESMF_KIND_I4) :: valueI4 integer(ESMF_KIND_I8) :: valueI8 real(ESMF_KIND_R4) :: valueR4 @@ -424,31 +425,24 @@ function FieldCreateFromHConfig(hconfig, geoms, dataDiagnose, dataValidate, & "gridToFieldMap ", & "ungriddedLBound", & "ungriddedUBound", & - "dataInit ", & - "dataMask ", & - "dataMin ", & - "dataMax ", & "typekind ", & - "dataDiagnose ", & "dataValidate ", & + "dataInit ", & "dataAdvance " ] else vocabulary=["geometry ", & "gridToFieldMap ", & "ungriddedLBound", & "ungriddedUBound", & - "dataInit ", & - "dataMask ", & - "dataMin ", & - "dataMax ", & "typekind ", & - "dataDiagnose ", & - "dataValidate " ] + "dataValidate ", & + "dataInit " ] end if isFlag = ESMF_HConfigValidateMapKeys(hconfigMap, vocabulary=vocabulary, & badKey=badKey, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out + deallocate(vocabulary) if (.not.isFlag) then call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & msg="An invalid key was found for field '"//trim(name)//"' "// & @@ -571,82 +565,142 @@ function FieldCreateFromHConfig(hconfig, geoms, dataDiagnose, dataValidate, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out - ! access the info object - call ESMF_InfoGetFromHost(FieldCreateFromHConfig, info=info, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - - ! handle dataMask (optional) - isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="dataMask", rc=rc) + ! handle dataValidate (optional) + isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="dataValidate", & + rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out if (isFlag) then - ! ingest key and set as field info metadata - call InfoIngestFromHConfig(info, hconfigMap, key="dataMask", & - typekind=typekind, rc=rc) + ! assert this to be a map element + hconfigMap2 = ESMF_HConfigCreateAt(hconfigMap, & + keyString="dataValidate", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out - endif - ! handle dataMin (optional) - isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="dataMin", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (isFlag) then - ! ingest key and set as field info metadata - call InfoIngestFromHConfig(info, hconfigMap, key="dataMin", & - typekind=typekind, rc=rc) + isFlag = ESMF_HConfigIsMap(hconfigMap2, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out - endif - ! handle dataMax (optional) - isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="dataMax", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (isFlag) then - ! ingest key and set as field info metadata - call InfoIngestFromHConfig(info, hconfigMap, key="dataMax", & - typekind=typekind, rc=rc) + if (isFlag) then + ! dataValidate key provided -> ingest + vocabulary=["min ", & + "max ", & + "mask ", & + "diagnose ", & + "action " ] + isFlag = ESMF_HConfigValidateMapKeys(hconfigMap2, & + vocabulary=vocabulary, badKey=badKey, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + deallocate(vocabulary) + if (.not.isFlag) then + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="An invalid key was found in 'dataValidate' for field "// & + "'"//trim(name)//"' "// "(maybe a typo?): "//badKey, & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + else + ! not a map -> error condition + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="The value associated with key 'dataValidate' for field "// & + "'"//trim(name)//"' must be a map!", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + + ! handle min (optional) + isFlag = ESMF_HConfigIsDefined(hconfigMap2, keyString="min", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out - endif + if (isFlag) then + ! ingest and set guard variable + dataValidate%min = ESMF_HConfigAsR8(hconfigMap2, & + keyString="min", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + dataValidate%minGuard = .true. + else + ! default + dataValidate%minGuard = .false. + endif - ! handle dataDiagnose (optional) - isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="dataDiagnose", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (isFlag) then - ! dataDiagnose key provided -> read value - dataDiagnose = ESMF_HConfigAsLogical(hconfigMap, & - keyString="dataDiagnose", rc=rc) + ! handle max (optional) + isFlag = ESMF_HConfigIsDefined(hconfigMap2, keyString="max", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out - else - ! dataDiagnose key not provided, default - dataDiagnose = .false. - endif + if (isFlag) then + ! ingest and set guard variable + dataValidate%max = ESMF_HConfigAsR8(hconfigMap2, & + keyString="max", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + dataValidate%maxGuard = .true. + else + ! default + dataValidate%maxGuard = .false. + endif - ! handle dataValidate (optional) - isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="dataValidate", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (isFlag) then - ! dataValidate key provided -> read value string - dataValidate = ESMF_HConfigAsString(hconfigMap, & - keyString="dataValidate", rc=rc) + ! handle mask (optional) + isFlag = ESMF_HConfigIsDefined(hconfigMap2, keyString="mask", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest and set guard variable + dataValidate%mask = ESMF_HConfigAsR8(hconfigMap2, & + keyString="mask", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + dataValidate%maskGuard = .true. + else + ! default + dataValidate%maskGuard = .false. + endif + + ! handle diagnose (optional) + isFlag = ESMF_HConfigIsDefined(hconfigMap2, keyString="diagnose", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out - dataValidate = ESMF_UtilStringUpperCase(dataValidate, rc=rc) + if (isFlag) then + ! ingest and set guard variable + dataValidate%diagnose = ESMF_HConfigAsLogical(hconfigMap2, & + keyString="diagnose", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else + ! default + dataValidate%diagnose = .false. + endif + + ! handle action (optional) + isFlag = ESMF_HConfigIsDefined(hconfigMap2, keyString="action", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out + if (isFlag) then + ! ingest and set guard variable + dataValidate%action = ESMF_HConfigAsString(hconfigMap2, & + keyString="action", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else + ! default + dataValidate%action = "none" + endif + else - ! dataValidate key not provided, default - dataValidate = "NO" + ! dataValidate key not provided, default all members + dataValidate%minGuard = .false. + dataValidate%maxGuard = .false. + dataValidate%maskGuard = .false. + dataValidate%diagnose = .false. + dataValidate%action = "none" endif + ! upper case to be case insensitive + dataValidate%action = ESMF_UtilStringUpperCase(dataValidate%action, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + ! handle dataInit (optional) if (present(dataInit)) then isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="dataInit", & @@ -687,7 +741,7 @@ function FieldCreateFromHConfig(hconfig, geoms, dataDiagnose, dataValidate, & ! not a map -> error condition call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & msg="The value associated with key '"//trim(name)//"' "// & - "under 'geometries' must be a map!", & + "under 'importFields' or 'exportFields' must be a map!", & line=__LINE__, file=__FILE__, rcToReturn=rc) return ! bail out endif @@ -700,60 +754,6 @@ function FieldCreateFromHConfig(hconfig, geoms, dataDiagnose, dataValidate, & !----------------------------------------------------------------------------- - subroutine InfoIngestFromHConfig(info, hconfig, key, typekind, rc) - type(ESMF_Info), intent(inout) :: info - type(ESMF_HConfig), intent(in) :: hconfig - character(*), intent(in) :: key - type(ESMF_TypeKind_Flag), intent(in) :: typekind - integer, intent(out) :: rc - - ! local variables - integer(ESMF_KIND_I4) :: valueI4 - integer(ESMF_KIND_I8) :: valueI8 - real(ESMF_KIND_R4) :: valueR4 - real(ESMF_KIND_R8) :: valueR8 - - rc=ESMF_SUCCESS - - if (typekind == ESMF_TYPEKIND_I4) then - valueI4 = ESMF_HConfigAsI4(hconfig, keyString=key, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_InfoSet(info, key=key, value=valueI4, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - else if (typekind == ESMF_TYPEKIND_I8) then - valueI8 = ESMF_HConfigAsI8(hconfig, keyString=key, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_InfoSet(info, key=key, value=valueI8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - else if (typekind == ESMF_TYPEKIND_R4) then - valueR4 = ESMF_HConfigAsR4(hconfig, keyString=key, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_InfoSet(info, key=key, value=valueR4, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - else if (typekind == ESMF_TYPEKIND_R8) then - valueR8 = ESMF_HConfigAsR8(hconfig, keyString=key, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_InfoSet(info, key=key, value=valueR8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - else - call ESMF_LogSetError(ESMF_RC_ARG_VALUE, & - msg="Unsupported typekind setting!", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - - end subroutine - - !----------------------------------------------------------------------------- - function GeomCreateFromHConfig(hconfig, name, rc) type(ESMF_Geom) :: GeomCreateFromHConfig type(ESMF_HConfigIter), intent(in) :: hconfig @@ -1449,15 +1449,16 @@ subroutine Advance(xdata, rc) if (allocated(is%wrap%importItems)) then headerPrinted = .false. do i=1, size(is%wrap%importItems) - if (.not.is%wrap%importItems(i)%dataDiagnose .and. & - is%wrap%importItems(i)%dataValidate /= "WARN" .and. & - is%wrap%importItems(i)%dataValidate /= "ERR") cycle - call FieldStats(is%wrap%importItems(i)%field, statsCount=statsCount, & - statsMean=statsMean, statsMin=statsMin, statsMax=statsMax, & - statsOkay=statsOkay, rc=rc) + associate(dataValidate => is%wrap%importItems(i)%dataValidate) + if (.not.dataValidate%diagnose .and. & + dataValidate%action /= "WARNING" .and. & + dataValidate%action /= "ERROR") cycle + call FieldStats(is%wrap%importItems(i)%field, dataValidate, & + statsCount=statsCount, statsMean=statsMean, statsMin=statsMin, & + statsMax=statsMax, statsOkay=statsOkay, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - if (is%wrap%importItems(i)%dataDiagnose .or. .not.statsOkay) then + if (dataValidate%diagnose .or. .not.statsOkay) then if (localPet == 0) then if (.not.headerPrinted) then headerPrinted = .true. @@ -1481,11 +1482,10 @@ subroutine Advance(xdata, rc) endif endif if (.not.statsOkay) then - if (is%wrap%importItems(i)%dataValidate == "WARN") & - warnCount = warnCount + 1 - if (is%wrap%importItems(i)%dataValidate == "ERR") & - errCount = errCount + 1 + if (dataValidate%action == "WARNING") warnCount = warnCount + 1 + if (dataValidate%action == "ERROR") errCount = errCount + 1 endif + end associate enddo endif @@ -1499,15 +1499,16 @@ subroutine Advance(xdata, rc) if (allocated(is%wrap%exportItems)) then headerPrinted = .false. do i=1, size(is%wrap%exportItems) - if (.not.is%wrap%exportItems(i)%dataDiagnose .and. & - is%wrap%exportItems(i)%dataValidate /= "WARN" .and. & - is%wrap%exportItems(i)%dataValidate /= "ERR") cycle - call FieldStats(is%wrap%exportItems(i)%field, statsCount=statsCount, & - statsMean=statsMean, statsMin=statsMin, statsMax=statsMax, & - statsOkay=statsOkay, rc=rc) + associate(dataValidate => is%wrap%exportItems(i)%dataValidate) + if (.not.dataValidate%diagnose .and. & + dataValidate%action /= "WARNING" .and. & + dataValidate%action /= "ERROR") cycle + call FieldStats(is%wrap%exportItems(i)%field, dataValidate, & + statsCount=statsCount, statsMean=statsMean, statsMin=statsMin, & + statsMax=statsMax, statsOkay=statsOkay, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - if (is%wrap%exportItems(i)%dataDiagnose .or. .not.statsOkay) then + if (dataValidate%diagnose .or. .not.statsOkay) then if (localPet == 0) then if (.not.headerPrinted) then headerPrinted = .true. @@ -1531,11 +1532,10 @@ subroutine Advance(xdata, rc) endif endif if (.not.statsOkay) then - if (is%wrap%exportItems(i)%dataValidate == "WARN") & - warnCount = warnCount + 1 - if (is%wrap%exportItems(i)%dataValidate == "ERR") & - errCount = errCount + 1 + if (dataValidate%action == "WARNING") warnCount = warnCount + 1 + if (dataValidate%action == "ERROR") errCount = errCount + 1 endif + end associate enddo endif @@ -1573,16 +1573,16 @@ end subroutine Advance !----------------------------------------------------------------------------- - subroutine FieldStats(field, statsCount, statsMean, statsMin, statsMax, & - statsOkay, rc) + subroutine FieldStats(field, dataValidate, statsCount, statsMean, statsMin, & + statsMax, statsOkay, rc) ! arguments type(ESMF_Field) :: field + type(Validate) :: dataValidate integer, intent(out) :: statsCount real(ESMF_KIND_R8), intent(out) :: statsMean, statsMin, statsMax logical, intent(out) :: statsOkay integer, intent(out) :: rc ! local variables - logical :: isFlag type(ESMF_VM) :: vm type(ESMF_TypeKind_Flag) :: typekind integer :: rank @@ -1590,8 +1590,6 @@ subroutine FieldStats(field, statsCount, statsMean, statsMin, statsMax, & real(ESMF_KIND_R8) :: lsum(1), lmin(1), lmax(1) real(ESMF_KIND_R8) :: gsum(1), gmin(1), gmax(1) real(ESMF_KIND_R8) :: dataMin, dataMax - logical :: dataMinSet, dataMaxSet - type(ESMF_Info) :: info rc = ESMF_SUCCESS @@ -1603,25 +1601,16 @@ subroutine FieldStats(field, statsCount, statsMean, statsMin, statsMax, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_InfoGetFromHost(field, info=info, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (rank == 2) then if (typekind == ESMF_TYPEKIND_I4) then block integer(ESMF_KIND_I4), pointer :: fptr(:,:) - integer(ESMF_KIND_I4) :: dataMask, value + integer(ESMF_KIND_I4) :: dataMask call ESMF_FieldGet(field, farrayPtr=fptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out - isFlag = ESMF_InfoIsPresent(info, key="dataMask", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (isFlag) then - call ESMF_InfoGet(info, key="dataMask", value=dataMask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (dataValidate%maskGuard) then + dataMask = dataValidate%mask lcount(1) = count(fptr/=dataMask) lsum(1) = sum(fptr, fptr/=dataMask) lmin(1) = minval(fptr, fptr/=dataMask) @@ -1632,39 +1621,16 @@ subroutine FieldStats(field, statsCount, statsMean, statsMin, statsMax, & lmin(1) = minval(fptr) lmax(1) = maxval(fptr) endif - dataMinSet = ESMF_InfoIsPresent(info, key="dataMin", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dataMinSet) then - call ESMF_InfoGet(info, key="dataMin", value=value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dataMin = real(value, ESMF_KIND_R8) - endif - dataMaxSet = ESMF_InfoIsPresent(info, key="dataMax", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dataMaxSet) then - call ESMF_InfoGet(info, key="dataMax", value=value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dataMax = real(value, ESMF_KIND_R8) - endif end block else if (typekind == ESMF_TYPEKIND_I8) then block integer(ESMF_KIND_I8), pointer :: fptr(:,:) - integer(ESMF_KIND_I8) :: dataMask, value + integer(ESMF_KIND_I8) :: dataMask call ESMF_FieldGet(field, farrayPtr=fptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out - isFlag = ESMF_InfoIsPresent(info, key="dataMask", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (isFlag) then - call ESMF_InfoGet(info, key="dataMask", value=dataMask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (dataValidate%maskGuard) then + dataMask = dataValidate%mask lcount(1) = count(fptr/=dataMask) lsum(1) = sum(fptr, fptr/=dataMask) lmin(1) = minval(fptr, fptr/=dataMask) @@ -1675,39 +1641,16 @@ subroutine FieldStats(field, statsCount, statsMean, statsMin, statsMax, & lmin(1) = minval(fptr) lmax(1) = maxval(fptr) endif - dataMinSet = ESMF_InfoIsPresent(info, key="dataMin", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dataMinSet) then - call ESMF_InfoGet(info, key="dataMin", value=value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dataMin = real(value, ESMF_KIND_R8) - endif - dataMaxSet = ESMF_InfoIsPresent(info, key="dataMax", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dataMaxSet) then - call ESMF_InfoGet(info, key="dataMax", value=value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dataMax = real(value, ESMF_KIND_R8) - endif end block else if (typekind == ESMF_TYPEKIND_R4) then block real(ESMF_KIND_R4), pointer :: fptr(:,:) - real(ESMF_KIND_R4) :: dataMask, value + real(ESMF_KIND_R4) :: dataMask call ESMF_FieldGet(field, farrayPtr=fptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out - isFlag = ESMF_InfoIsPresent(info, key="dataMask", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (isFlag) then - call ESMF_InfoGet(info, key="dataMask", value=dataMask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (dataValidate%maskGuard) then + dataMask = dataValidate%mask lcount(1) = count(fptr/=dataMask) lsum(1) = sum(fptr, fptr/=dataMask) lmin(1) = minval(fptr, fptr/=dataMask) @@ -1718,39 +1661,16 @@ subroutine FieldStats(field, statsCount, statsMean, statsMin, statsMax, & lmin(1) = minval(fptr) lmax(1) = maxval(fptr) endif - dataMinSet = ESMF_InfoIsPresent(info, key="dataMin", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dataMinSet) then - call ESMF_InfoGet(info, key="dataMin", value=value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dataMin = real(value, ESMF_KIND_R8) - endif - dataMaxSet = ESMF_InfoIsPresent(info, key="dataMax", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dataMaxSet) then - call ESMF_InfoGet(info, key="dataMax", value=value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dataMax = real(value, ESMF_KIND_R8) - endif end block else if (typekind == ESMF_TYPEKIND_R8) then block real(ESMF_KIND_R8), pointer :: fptr(:,:) - real(ESMF_KIND_R8) :: dataMask, value + real(ESMF_KIND_R8) :: dataMask call ESMF_FieldGet(field, farrayPtr=fptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out - isFlag = ESMF_InfoIsPresent(info, key="dataMask", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (isFlag) then - call ESMF_InfoGet(info, key="dataMask", value=dataMask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (dataValidate%maskGuard) then + dataMask = dataValidate%mask lcount(1) = count(fptr/=dataMask) lsum(1) = sum(fptr, fptr/=dataMask) lmin(1) = minval(fptr, fptr/=dataMask) @@ -1761,24 +1681,6 @@ subroutine FieldStats(field, statsCount, statsMean, statsMin, statsMax, & lmin(1) = minval(fptr) lmax(1) = maxval(fptr) endif - dataMinSet = ESMF_InfoIsPresent(info, key="dataMin", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dataMinSet) then - call ESMF_InfoGet(info, key="dataMin", value=value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dataMin = real(value, ESMF_KIND_R8) - endif - dataMaxSet = ESMF_InfoIsPresent(info, key="dataMax", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dataMaxSet) then - call ESMF_InfoGet(info, key="dataMax", value=value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dataMax = real(value, ESMF_KIND_R8) - endif end block else ! error condition: unsupported typekind @@ -1791,17 +1693,12 @@ subroutine FieldStats(field, statsCount, statsMean, statsMin, statsMax, & if (typekind == ESMF_TYPEKIND_I4) then block integer(ESMF_KIND_I4), pointer :: fptr(:,:,:) - integer(ESMF_KIND_I4) :: dataMask, value + integer(ESMF_KIND_I4) :: dataMask call ESMF_FieldGet(field, farrayPtr=fptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out - isFlag = ESMF_InfoIsPresent(info, key="dataMask", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (isFlag) then - call ESMF_InfoGet(info, key="dataMask", value=dataMask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (dataValidate%maskGuard) then + dataMask = dataValidate%mask lcount(1) = count(fptr/=dataMask) lsum(1) = sum(fptr, fptr/=dataMask) lmin(1) = minval(fptr, fptr/=dataMask) @@ -1812,39 +1709,16 @@ subroutine FieldStats(field, statsCount, statsMean, statsMin, statsMax, & lmin(1) = minval(fptr) lmax(1) = maxval(fptr) endif - dataMinSet = ESMF_InfoIsPresent(info, key="dataMin", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dataMinSet) then - call ESMF_InfoGet(info, key="dataMin", value=value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dataMin = real(value, ESMF_KIND_R8) - endif - dataMaxSet = ESMF_InfoIsPresent(info, key="dataMax", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dataMaxSet) then - call ESMF_InfoGet(info, key="dataMax", value=value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dataMax = real(value, ESMF_KIND_R8) - endif end block else if (typekind == ESMF_TYPEKIND_I8) then block integer(ESMF_KIND_I8), pointer :: fptr(:,:,:) - integer(ESMF_KIND_I8) :: dataMask, value + integer(ESMF_KIND_I8) :: dataMask call ESMF_FieldGet(field, farrayPtr=fptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out - isFlag = ESMF_InfoIsPresent(info, key="dataMask", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (isFlag) then - call ESMF_InfoGet(info, key="dataMask", value=dataMask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (dataValidate%maskGuard) then + dataMask = dataValidate%mask lcount(1) = count(fptr/=dataMask) lsum(1) = sum(fptr, fptr/=dataMask) lmin(1) = minval(fptr, fptr/=dataMask) @@ -1855,39 +1729,16 @@ subroutine FieldStats(field, statsCount, statsMean, statsMin, statsMax, & lmin(1) = minval(fptr) lmax(1) = maxval(fptr) endif - dataMinSet = ESMF_InfoIsPresent(info, key="dataMin", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dataMinSet) then - call ESMF_InfoGet(info, key="dataMin", value=value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dataMin = real(value, ESMF_KIND_R8) - endif - dataMaxSet = ESMF_InfoIsPresent(info, key="dataMax", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dataMaxSet) then - call ESMF_InfoGet(info, key="dataMax", value=value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dataMax = real(value, ESMF_KIND_R8) - endif end block else if (typekind == ESMF_TYPEKIND_R4) then block real(ESMF_KIND_R4), pointer :: fptr(:,:,:) - real(ESMF_KIND_R4) :: dataMask, value + real(ESMF_KIND_R4) :: dataMask call ESMF_FieldGet(field, farrayPtr=fptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out - isFlag = ESMF_InfoIsPresent(info, key="dataMask", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (isFlag) then - call ESMF_InfoGet(info, key="dataMask", value=dataMask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (dataValidate%maskGuard) then + dataMask = dataValidate%mask lcount(1) = count(fptr/=dataMask) lsum(1) = sum(fptr, fptr/=dataMask) lmin(1) = minval(fptr, fptr/=dataMask) @@ -1898,39 +1749,16 @@ subroutine FieldStats(field, statsCount, statsMean, statsMin, statsMax, & lmin(1) = minval(fptr) lmax(1) = maxval(fptr) endif - dataMinSet = ESMF_InfoIsPresent(info, key="dataMin", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dataMinSet) then - call ESMF_InfoGet(info, key="dataMin", value=value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dataMin = real(value, ESMF_KIND_R8) - endif - dataMaxSet = ESMF_InfoIsPresent(info, key="dataMax", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dataMaxSet) then - call ESMF_InfoGet(info, key="dataMax", value=value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dataMax = real(value, ESMF_KIND_R8) - endif end block else if (typekind == ESMF_TYPEKIND_R8) then block real(ESMF_KIND_R8), pointer :: fptr(:,:,:) - real(ESMF_KIND_R8) :: dataMask, value + real(ESMF_KIND_R8) :: dataMask call ESMF_FieldGet(field, farrayPtr=fptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out - isFlag = ESMF_InfoIsPresent(info, key="dataMask", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (isFlag) then - call ESMF_InfoGet(info, key="dataMask", value=dataMask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (dataValidate%maskGuard) then + dataMask = dataValidate%mask lcount(1) = count(fptr/=dataMask) lsum(1) = sum(fptr, fptr/=dataMask) lmin(1) = minval(fptr, fptr/=dataMask) @@ -1941,24 +1769,6 @@ subroutine FieldStats(field, statsCount, statsMean, statsMin, statsMax, & lmin(1) = minval(fptr) lmax(1) = maxval(fptr) endif - dataMinSet = ESMF_InfoIsPresent(info, key="dataMin", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dataMinSet) then - call ESMF_InfoGet(info, key="dataMin", value=value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dataMin = real(value, ESMF_KIND_R8) - endif - dataMaxSet = ESMF_InfoIsPresent(info, key="dataMax", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (dataMaxSet) then - call ESMF_InfoGet(info, key="dataMax", value=value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - dataMax = real(value, ESMF_KIND_R8) - endif end block else ! error condition: unsupported typekind @@ -2005,12 +1815,12 @@ subroutine FieldStats(field, statsCount, statsMean, statsMin, statsMax, & statsOkay = .true. ! initialize to .true. then see if not so - if (dataMinSet) then - if (statsMin < dataMin) statsOkay = .false. ! found values below min + if (dataValidate%minGuard) then + if (statsMin < dataValidate%min) statsOkay = .false. ! values below min endif - if (dataMaxSet) then - if (statsMax > dataMax) statsOkay = .false. ! found values above max + if (dataValidate%maxGuard) then + if (statsMax > dataValidate%max) statsOkay = .false. ! values above max endif end subroutine @@ -2151,7 +1961,6 @@ subroutine Finalize(xdata, rc) rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - deallocate(is%wrap%importItems(i)%dataValidate) deallocate(is%wrap%importItems(i)%dataInit) enddo deallocate(is%wrap%importItems) @@ -2164,7 +1973,6 @@ subroutine Finalize(xdata, rc) rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - deallocate(is%wrap%exportItems(i)%dataValidate) deallocate(is%wrap%exportItems(i)%dataInit) deallocate(is%wrap%exportItems(i)%dataAdvance) enddo From 583db1bdebb9563550bafcd1e22d5c1cb74dcd82 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 12 May 2026 13:48:41 -0700 Subject: [PATCH 10/16] Update documentation to match latest changes with respect to field data validation. --- src/addon/ESMX/Comps/ESMX_Data/README.md | 41 +++++++++++++----------- 1 file changed, 22 insertions(+), 19 deletions(-) diff --git a/src/addon/ESMX/Comps/ESMX_Data/README.md b/src/addon/ESMX/Comps/ESMX_Data/README.md index 942b0aaa1b..60e10e7cdd 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/README.md +++ b/src/addon/ESMX/Comps/ESMX_Data/README.md @@ -79,31 +79,25 @@ The `importFields` key must be associated with a map of key/value pairs. Each ke | `ungriddedLBound`| The lower bound of the ungridded dimension(s). For details see ESMF documentation. | *none* | | `ungriddedUBound`| The upper bound of the ungridded dimension(s). For details see ESMF documentation. | *none* | | `dataInit` | [Dynamic arithmetic expression](#dynamic-arithmetic-expressions) used to initialze field data during DataInitialize. | *none* | -| `dataMask` | The numerical value ignored during field statistics and validation check. | *none* | -| `dataMin` | The minimum numerical value allowed in the field data to pass validation check. | *none* | -| `dataMax` | The maximum numerical value allowed in the field data to pass validation check. | *none* | -| `dataDiagnose` | Enable/disable output of field data diagnostics: `yes` or `no`. | `no` | -| `dataValidate` | The level of field data validation against the provided `dataMin` and `dataMax`: `no` - no validation, `warn` - issue warning if data found outside value range, `err` - return with error if data found outside value range. | `no` | +| `dataValidate` | [Data validation](#data-validation) applied to the field. | *none* | For an example, see the following configuration snippet for `ESMX_Data` instance named `DAT`. ``` DAT: importFields: - sea_surface_temperature: {geometry: global, typekind: r8, dataDiagnose: yes} + sea_surface_temperature: {geometry: global, typekind: r8, dataValidate: {diagnose: yes} } density: geometry: global typekind: r4 ungriddedLBound: [1] ungriddedUBound: [104] - dataMin: 1e-05 - dataDiagnose: yes - dataValidate: err + dataValidate: {min: 1e-05, diagnose: yes, action: error} ``` -This configuration defines two fields within the `DAT` import state. The first, standard-named `sea_surface_temperature`, is defined on the `global` geometry using double-precision (`r8`) data. As there are no ungridded dimensions, `sea_surface_temperature` functions as a 2D surface field. Because no `*Value` keys are specified, the field is neither locally initialized nor restricted by global min/max data bounds. While `dataDiagnose: yes` enables global diagnostic output to `stdout`, data validation remains inactive. +This configuration defines two fields within the `DAT` import state. The first, standard-named `sea_surface_temperature`, is defined on the `global` geometry using double-precision (`r8`) data. As there are no ungridded dimensions, `sea_surface_temperature` functions as a 2D surface field. The field is neither locally initialized nor restricted by global min/max data bounds. However `dataValidate: {diagnose: yes}` enables global diagnostic output to `stdout`. -The second field, standard-named `density`, is defined on the `global` geometry using single-precision (`r4`) data. It features a single ungridded dimension spanning indices `1` to `104`, representing 104 levels. A `dataMin` of `1e-05` is established to monitor the field during each Advance step. With data diagnostics enabled, the system will output field status to `stdout`; furthermore, the `dataValidate: err` setting ensures an error is triggered if any `density` value falls below the defined minimum. +The second field, standard-named `density`, is defined on the `global` geometry using single-precision (`r4`) data. It features a single ungridded dimension spanning indices `1` to `104`, representing 104 levels. Data validation is established with `min` of `1e-05` to monitor the field during each Advance step. Diagnostic output to `stdout` is enabled; furthermore, the `action: error` setting ensures an error is triggered if any `density` value falls below the specified minimum. ### `exportFields` @@ -117,12 +111,8 @@ The `exportFields` key must be associated with a map of key/value pairs. Each ke | `ungriddedLBound`| The lower bound of the ungridded dimension(s). For details see ESMF documentation. | *none* | | `ungriddedUBound`| The upper bound of the ungridded dimension(s). For details see ESMF documentation. | *none* | | `dataInit` | [Dynamic arithmetic expression](#dynamic-arithmetic-expressions) used to initialze field data during DataInitialize. | *none* | -| `dataMask` | The numerical value ignored during field statistics and validation check. | *none* | -| `dataMin` | The minimum numerical value allowed in the field data to pass validation check. | *none* | -| `dataMax` | The maximum numerical value allowed in the field data to pass validation check. | *none* | -| `dataDiagnose` | Enable/disable output of field data diagnostics: `yes` or `no`. | `no` | -| `dataValidate` | The level of field data validation against the provided `dataMin` and `dataMax`: `no` - no validation, `warn` - issue warning if data found outside value range, `err` - return with error if data found outside value range. | `no` | -| `dataAdvance` | [Dynamic arithmetic expression](#dynamic-arithmetic-expressions) used to update field data during Advance. | *none* | +| `dataAdvance` | [Dynamic arithmetic expression](#dynamic-arithmetic-expressions) used to update field data during Advance. | *none* | +| `dataValidate` | [Data validation](#data-validation) applied to the field. | *none* | For an example, see the following configuration snippet for `ESMX_Data` instance named `DAT`. @@ -132,14 +122,27 @@ DAT: sea_surface_temperature: geometry: global typekind: r8 + dataInit: sea_surface_temperature dataAdvance: 1.1 * sea_surface_temperature ``` -This configuration defines a single field, `sea_surface_temperature`, in the `DAT` export state. It is defined on the `global` geometry using double-precision (`r8`) values. With no ungridded dimensions, the field is treated as a 2D surface. The omission of `*Value` keys indicates that the field is not locally initialized and incoming values are not validated against global extrema. During each `Advance` step, the `dataAdvance` expression exports the field at 110% of its current imported value; if `sea_surface_temperature` is missing from the `importState`, an error is triggered. +This configuration defines a single field, `sea_surface_temperature`, in the `DAT` export state. It is defined on the `global` geometry using double-precision (`r8`) values. With no ungridded dimensions, the field is treated as a 2D surface. The field data is initialized via `dataInit` to match that of the imported `sea_surface_temperature` field. During each `Advance` step, the `dataAdvance` expression exports the field at 110% of its current imported value; if `sea_surface_temperature` is missing from the `importState`, an error is triggered. + +### Data validation + +The `dataValidate` option, if specified, must be associated with a map of key/value pairs. All pairs are optional with default values as per the following table. + +| Option key | Description / Value options | Default | +| ---------------- | ------------------------------------------------------------------------------------ | ----------------- | +| `min` | The minimum numerical value allowed in the field data to pass validation. | *no minimum* | +| `max` | The maximum numerical value allowed in the field data to pass validation. | *no maximum* | +| `mask` | The numerical value ignored during field diagnostic and validation. | *no mask* | +| `diagnose` | Enable/disable field data diagnostic output to stdout: `yes` or `no`. | `no` | +| `action` | Action to be taken when field data validation fails: `none`, `warning`, `error` | `none` | ### Dynamic arithmetic expressions -Support for dynamic arithmetic expressions allows users to define mathematical transformations for field data using standard **infix notation**. These expressions are evaluated element-wise across the entire spatial domain of the involved fields. +The `dataInit` and `dataAdvance` options support dynamic arithmetic expressions that allow users to define mathematical transformations for field data using standard **infix notation**. These expressions are evaluated element-wise across the entire spatial domain of the involved fields. #### 1. Supported Operators Expressions support standard arithmetic operators following traditional mathematical precedence. From 30f71bc510c54713f7222d07e7e242067f2d6151 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 12 May 2026 15:34:28 -0700 Subject: [PATCH 11/16] Explicit cast for integer functions to real. --- src/addon/ESMX/Comps/ESMX_Data/dataProcess.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/addon/ESMX/Comps/ESMX_Data/dataProcess.F90 b/src/addon/ESMX/Comps/ESMX_Data/dataProcess.F90 index e2fe18bc40..481edd693c 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/dataProcess.F90 +++ b/src/addon/ESMX/Comps/ESMX_Data/dataProcess.F90 @@ -104,9 +104,9 @@ subroutine process(importState, expression, exportField, step, rc) case ("ANINT") stack(:,top) = anint(stack(:,top)) case ("CEILING") - stack(:,top) = ceiling(stack(:,top)) + stack(:,top) = real(ceiling(stack(:,top)),ESMF_KIND_R8) case ("FLOOR") - stack(:,top) = floor(stack(:,top)) + stack(:,top) = real(floor(stack(:,top)),ESMF_KIND_R8) case ("DEG2RAD") stack(:,top) = (stack(:,top))/180.0*PI case ("RAD2DEG") From fd3b1eb608dfa8ad1ef49a5270489f833b36d09a Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 12 May 2026 15:35:11 -0700 Subject: [PATCH 12/16] Remove dataInit from importFields, which was actually never used. --- src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 b/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 index de0b824ee2..dbf03c9658 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 +++ b/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 @@ -32,7 +32,6 @@ module ESMX_Data type ImportItem type(ESMF_Field) :: field type(Validate) :: dataValidate - character(len=:), allocatable :: dataInit end type type ExportItem @@ -298,8 +297,7 @@ subroutine IngestFromHConfig(hconfig, timeKeeping, geoms, imports, exports, & item = item+1 imports(item)%field = FieldCreateFromHConfig(hconfigIt, geoms=geoms, & - dataValidate=imports(item)%dataValidate, & - dataInit=imports(item)%dataInit, rc=rc) + dataValidate=imports(item)%dataValidate, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, & msg="Problem creating import field.", & line=__LINE__, file=__FILE__)) return ! bail out @@ -1961,7 +1959,6 @@ subroutine Finalize(xdata, rc) rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out - deallocate(is%wrap%importItems(i)%dataInit) enddo deallocate(is%wrap%importItems) endif From c11bca4e8680b0fd0e8c5b4e291c0d8c5fd2ae11 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 12 May 2026 15:58:12 -0700 Subject: [PATCH 13/16] Some more documentation polish. --- src/addon/ESMX/Comps/ESMX_Data/README.md | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/src/addon/ESMX/Comps/ESMX_Data/README.md b/src/addon/ESMX/Comps/ESMX_Data/README.md index 60e10e7cdd..b53e91a4ad 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/README.md +++ b/src/addon/ESMX/Comps/ESMX_Data/README.md @@ -1,10 +1,14 @@ # ESMX Data Component -ESMX Data is a lightweight data component designed for use in basic technical testing. Each instance of ESMX Data is run-time configured with a custom list of import and export fields. Each field references a specific geometry, typekind, and optionally init, min, and max values. Multiple geometries can be defined per `ESMX_Data` instance. +`ESMX_Data` is a lightweight data component designed for basic technical testing of NUOPC compliant components and applications. Each instance of ESMX Data is run-time configured with a custom list of import and export fields. Each field references a specific geometry, typekind, and implements optional data validation. Multiple geometries can be defined per ESMX Data instance. + +The component functions as a programmable transformation layer that can be used as a "synthetic data generator", "data feedback component", and/or "diagnostic processor". During the execution phase, it ingests fields from its import state and applies user-defined mathematical expressions element-wise across the spatial grid. This allows for the dynamic derivation of new data or the modification of existing fields. To provide physical context, the system can inject simulation metadata into these calculations, such as spatial coordinates, the current time step index, or physical constants like Pi. Standard mathematical functions, such as sin(), cos(), etc., are supported. + +Once the transformation is complete, the data undergoes an optional validation stage where it is checked against user-defined guards to ensure numerical stability and prevent the propagation of invalid values. The final processed fields are then timestamped according to the component's time keeping configuration and made available to connected components through its export state. ## ESMX Data Build Configuration -The ESMX Data component is built into ESMX applications by default, unless it is explicitly disabled in the ESMX_BUILD_FILE via the `disable_comps` option. +The ESMX Data component is built into ESMX applications by default. It can be disabled by explicitly setting the `disable_comps` option in the ESMX_BUILD_FILE. ``` application: @@ -12,7 +16,7 @@ application: disable_comps: ESMX_Data ``` -The default ESMX Data implementation that comes with ESMF can be overridden with a custom version under the `components` section of the ESMX_BUILD_FILE. For example, for a custom version that is located under the `MyCustomDataComponent` source directory: +Furthermore, the default ESMX Data implementation that comes with ESMF can be overridden with a custom version under the `components` section of the ESMX_BUILD_FILE. For example, the following uses a custom ESMX Data version that is located under the `MyCustomDataComponent` source directory: ``` components: @@ -22,7 +26,7 @@ components: ## ESMX Data Run Configuration -Each ESMX Data instance is configured under its component label section in `esmxRun.yaml` using [YAML](https://yaml.org/) format. The available configuration keys are listed below. +Each ESMX Data instance is configured under its component label section in `esmxRun.yaml`. The available configuration keys are documented below. ### `timeKeeping` @@ -69,7 +73,7 @@ This defines a geometry called `global`, which is instantiated as 2D `ESMF_Grid` ### `importFields` -The `importFields` key must be associated with a map of key/value pairs. Each key specifies the standard name of a field in the import state of the ESMX Data instance. The value once again is a map with key/values as per the following table. +The `importFields` key must be associated with a map of key/value pairs. Each key specifies the standard name of a field in the import state of the ESMX Data instance. The value once again is a map with key/value pairs as per the following table. | Option key | Description / Value options | Default | | ---------------- | ------------------------------------------------------------------------------------ | ----------------- | @@ -78,8 +82,9 @@ The `importFields` key must be associated with a map of key/value pairs. Each ke | `gridToFieldMap` | The mapping of grid to field dimension. For details see ESMF documentation. | `[1,2]` or `[1,2,3]` depending on rank | | `ungriddedLBound`| The lower bound of the ungridded dimension(s). For details see ESMF documentation. | *none* | | `ungriddedUBound`| The upper bound of the ungridded dimension(s). For details see ESMF documentation. | *none* | -| `dataInit` | [Dynamic arithmetic expression](#dynamic-arithmetic-expressions) used to initialze field data during DataInitialize. | *none* | -| `dataValidate` | [Data validation](#data-validation) applied to the field. | *none* | +| `dataValidate` | [Data validation](#data-validation) applied to the import fields *before* the Advance step. | *none* | + +ESMF_Data uses the standard NUOPC data-dependencies during initialize approach to initialize the data in all of the import fields. For an example, see the following configuration snippet for `ESMX_Data` instance named `DAT`. @@ -112,7 +117,7 @@ The `exportFields` key must be associated with a map of key/value pairs. Each ke | `ungriddedUBound`| The upper bound of the ungridded dimension(s). For details see ESMF documentation. | *none* | | `dataInit` | [Dynamic arithmetic expression](#dynamic-arithmetic-expressions) used to initialze field data during DataInitialize. | *none* | | `dataAdvance` | [Dynamic arithmetic expression](#dynamic-arithmetic-expressions) used to update field data during Advance. | *none* | -| `dataValidate` | [Data validation](#data-validation) applied to the field. | *none* | +| `dataValidate` | [Data validation](#data-validation) applied to the export fields *after* the Advance step. | *none* | For an example, see the following configuration snippet for `ESMX_Data` instance named `DAT`. @@ -128,6 +133,8 @@ DAT: This configuration defines a single field, `sea_surface_temperature`, in the `DAT` export state. It is defined on the `global` geometry using double-precision (`r8`) values. With no ungridded dimensions, the field is treated as a 2D surface. The field data is initialized via `dataInit` to match that of the imported `sea_surface_temperature` field. During each `Advance` step, the `dataAdvance` expression exports the field at 110% of its current imported value; if `sea_surface_temperature` is missing from the `importState`, an error is triggered. +--- + ### Data validation The `dataValidate` option, if specified, must be associated with a map of key/value pairs. All pairs are optional with default values as per the following table. From 90d5c3338bf3152a2ee036cffe4807f50ad5ae11 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 12 May 2026 16:21:30 -0700 Subject: [PATCH 14/16] More relevant usage examples. --- src/addon/ESMX/Comps/ESMX_Data/README.md | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/src/addon/ESMX/Comps/ESMX_Data/README.md b/src/addon/ESMX/Comps/ESMX_Data/README.md index b53e91a4ad..68d655650f 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/README.md +++ b/src/addon/ESMX/Comps/ESMX_Data/README.md @@ -201,9 +201,15 @@ Standard numerical values (e.g., `2.5`, `100`, `1.0E-4`) are interpreted as doub #### 4. Usage Examples -* **Unit Conversion (Celsius to Kelvin)**: - `temperature_c + 273.15` -* **Applying a Spatial Mask**: - `field_a * SIN(_COORD1 * DEG2RAD)` -* **Complex Scaling**: - `ABS(primary_field - secondary_field) / SQRT(_STEP * 1.0)` +* **Synthetic data generation (Temperature field with 10 Kelvin variablity around 270 Kelvin mean)**:
+ `10 * (sin(_coord1) * cos(_coord2)) + 270` + +* **Data feedback (Return a temperature field that is 10% hotter than the incoming field)**:
+ `1.1 * temperature` + +* **Unit Conversion (Kelvin to Celsius)**:
+ `temperature - 273.15` + +* **Applying a spatial mask**:
+ `field_a * sin(_coord1)` + From 54504a632f28e49a2d88a8719ec9b7212d31253e Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 14 May 2026 10:52:37 -0700 Subject: [PATCH 15/16] Fix a couple of details about import fields. --- src/addon/ESMX/Comps/ESMX_Data/README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/addon/ESMX/Comps/ESMX_Data/README.md b/src/addon/ESMX/Comps/ESMX_Data/README.md index 68d655650f..60c0b78704 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/README.md +++ b/src/addon/ESMX/Comps/ESMX_Data/README.md @@ -84,7 +84,7 @@ The `importFields` key must be associated with a map of key/value pairs. Each ke | `ungriddedUBound`| The upper bound of the ungridded dimension(s). For details see ESMF documentation. | *none* | | `dataValidate` | [Data validation](#data-validation) applied to the import fields *before* the Advance step. | *none* | -ESMF_Data uses the standard NUOPC data-dependencies during initialize approach to initialize the data in all of the import fields. +ESMF_Data uses the standard NUOPC data-dependencies during initialize protocol to initialize the data in all of the import fields. As per standard NUOPC rules, any import fields that are not connected will trigger an error, causing the application to abort. For an example, see the following configuration snippet for `ESMX_Data` instance named `DAT`. @@ -100,7 +100,7 @@ DAT: dataValidate: {min: 1e-05, diagnose: yes, action: error} ``` -This configuration defines two fields within the `DAT` import state. The first, standard-named `sea_surface_temperature`, is defined on the `global` geometry using double-precision (`r8`) data. As there are no ungridded dimensions, `sea_surface_temperature` functions as a 2D surface field. The field is neither locally initialized nor restricted by global min/max data bounds. However `dataValidate: {diagnose: yes}` enables global diagnostic output to `stdout`. +This configuration defines two fields within the `DAT` import state. The first, standard-named `sea_surface_temperature`, is defined on the `global` geometry using double-precision (`r8`) data. As there are no ungridded dimensions, `sea_surface_temperature` functions as a 2D surface field. The field is not restricted by global min/max data bounds. However `dataValidate: {diagnose: yes}` enables global diagnostic output to `stdout`. The second field, standard-named `density`, is defined on the `global` geometry using single-precision (`r4`) data. It features a single ungridded dimension spanning indices `1` to `104`, representing 104 levels. Data validation is established with `min` of `1e-05` to monitor the field during each Advance step. Diagnostic output to `stdout` is enabled; furthermore, the `action: error` setting ensures an error is triggered if any `density` value falls below the specified minimum. From 599de3965450c04694f8bf63af59d61c27a0362e Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 14 May 2026 11:27:05 -0700 Subject: [PATCH 16/16] Include documentation of standard NUOPC attributes as they relate to ESMX_Data. Other small doc improvements. --- src/addon/ESMX/Comps/ESMX_Data/README.md | 36 ++++++++++++++++++++---- 1 file changed, 30 insertions(+), 6 deletions(-) diff --git a/src/addon/ESMX/Comps/ESMX_Data/README.md b/src/addon/ESMX/Comps/ESMX_Data/README.md index 60c0b78704..10286a264d 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/README.md +++ b/src/addon/ESMX/Comps/ESMX_Data/README.md @@ -26,7 +26,27 @@ components: ## ESMX Data Run Configuration -Each ESMX Data instance is configured under its component label section in `esmxRun.yaml`. The available configuration keys are documented below. +Each ESMX Data instance is configured under its component label section in `esmxRun.yaml`. It supports the standard NUOPC Model/Mediator attributes + +- Verbosity +- Profiling +- Diagnostic + +with the lower 16 bits of each variable reserved for standard [NUOPC Metadata](https://earthsystemmodeling.org/docs/nightly/develop/NUOPC_refdoc/node3.html#SECTION00033000000000000000) compliance. + +Bit 17 of the `Diagnostic` attribute controls custom output to NetCDF. When set, data of the import fields are written to file at the beginning and data of export fields are written to file at the end of each Advance step. + +The following shows an `ESMX_Data` instance named `DAT`, with `Verbosity` and `Dignostic` attributes set. + +``` +DAT: + model: ESMX_Data + attributes: + Verbosity: high + Diagnostic: 131072 # bit-17 (writes netcdf field output) +``` + +In addition to the standard NUOPC component attributes listed above, `ESMX_Data` implements the following custom configuration keys. ### `timeKeeping` @@ -35,10 +55,11 @@ The `timeKeeping` key is ***required***. It must either be set to `Model` or `Me - Use the `Model` setting to timestamp the export fields according to the time at the *end* of the Advance step of the `ESMX_Data` component instance. - Use the `Mediator` setting to timestamp the export fields according to the time at the *beginning* of the Advance step of the `ESMX_Data` component instance. -For an example, see the following configuration snippet for `ESMX_Data` instance named `DAT`. +The following example sets `Mediator` style time keeping in the `DAT` instance: ``` DAT: + ... timeKeeping: Mediator ``` @@ -60,6 +81,7 @@ For an example, see the following configuration snippet for `ESMX_Data` instance ``` DAT: + ... geometries: global: geom: grid1PeriDim @@ -90,6 +112,7 @@ For an example, see the following configuration snippet for `ESMX_Data` instance ``` DAT: + ... importFields: sea_surface_temperature: {geometry: global, typekind: r8, dataValidate: {diagnose: yes} } density: @@ -123,6 +146,7 @@ For an example, see the following configuration snippet for `ESMX_Data` instance ``` DAT: + ... exportFields: sea_surface_temperature: geometry: global @@ -202,14 +226,14 @@ Standard numerical values (e.g., `2.5`, `100`, `1.0E-4`) are interpreted as doub #### 4. Usage Examples * **Synthetic data generation (Temperature field with 10 Kelvin variablity around 270 Kelvin mean)**:
- `10 * (sin(_coord1) * cos(_coord2)) + 270` + `dataAdvance: 10 * (sin(_coord1) * cos(_coord2)) + 270` * **Data feedback (Return a temperature field that is 10% hotter than the incoming field)**:
- `1.1 * temperature` + `dataAdvance: 1.1 * temperature` * **Unit Conversion (Kelvin to Celsius)**:
- `temperature - 273.15` + `dataAdvance: temperature - 273.15` * **Applying a spatial mask**:
- `field_a * sin(_coord1)` + `dataAdvance: field_a * sin(_coord1)`