diff --git a/src/addon/ESMX/Comps/ESMX_Data/CMakeLists.txt b/src/addon/ESMX/Comps/ESMX_Data/CMakeLists.txt index 63cdaf3ed3..82f3abba55 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/CMakeLists.txt +++ b/src/addon/ESMX/Comps/ESMX_Data/CMakeLists.txt @@ -36,7 +36,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 f862315f6b..dbf03c9658 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 +++ b/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 @@ -1,13 +1,15 @@ -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 + + use dataProcess implicit none @@ -15,65 +17,46 @@ 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 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 + type(Validate) :: dataValidate + end type + + type ExportItem + type(ESMF_Field) :: field + type(Validate) :: dataValidate + character(len=:), allocatable :: dataInit + 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(:) + integer :: stepCounter + end type + + type InternalState + type(InternalStateStruct), pointer :: wrap + end type + + !----------------------------------------------------------------------------- contains - !----------------------------------------------------------------------------- - ! X Component Specialization !----------------------------------------------------------------------------- subroutine SetServices(xdata, rc) @@ -81,1560 +64,1937 @@ 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 + + ! initialize the stepCounter inside the internal state + is%wrap%stepCounter = 0 ! 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 - xfield => xfield%nfld - enddo - endsubroutine Realize - - !----------------------------------------------------------------------------- + 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 - 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 + if (itemCount>0) then + allocate(imports(itemCount)) - rc = ESMF_SUCCESS + hconfigItBegin = ESMF_HConfigIterBegin(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 + 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 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 + 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 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 + imports(item)%field = FieldCreateFromHConfig(hconfigIt, geoms=geoms, & + dataValidate=imports(item)%dataValidate, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, & + msg="Problem creating import field.", & + 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) + enddo + ! error check ESMF_HConfigIterLoop() if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + line=__LINE__, file=__FILE__)) return ! bail out + endif - xfield => xfield%nfld - enddo - call NUOPC_CompAttributeSet(xdata, & - name="InitializeDataComplete", value="true", rc=rc) + call ESMF_HConfigDestroy(hconfigNode, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + + endif + + ! 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, & + dataValidate=exports(item)%dataValidate, & + dataInit=exports(item)%dataInit, & + 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, dataValidate, & + dataInit, dataAdvance, rc) + type(ESMF_Field) :: FieldCreateFromHConfig + type(ESMF_HConfigIter), intent(in) :: hconfig + type(GeomItem), intent(in) :: geoms(:) + type(Validate), intent(out) :: dataValidate + character(len=:), allocatable, intent(out), optional :: dataInit + 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, hconfigMap2 + 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(:) + 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 (isFlag) then + ! validate keys in map + if (present(dataAdvance)) then + vocabulary=["geometry ", & + "gridToFieldMap ", & + "ungriddedLBound", & + "ungriddedUBound", & + "typekind ", & + "dataValidate ", & + "dataInit ", & + "dataAdvance " ] + else + vocabulary=["geometry ", & + "gridToFieldMap ", & + "ungriddedLBound", & + "ungriddedUBound", & + "typekind ", & + "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 - 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 + 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)//"' "// & + "(maybe a typo?): "//badKey, & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out 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) + + ! 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 - 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) + 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 - 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 - ! 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) + ! 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 - 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 - !----------------------------------------------------------------------------- - - 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 + 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 - rc = ESMF_SUCCESS + ! 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 - 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 + ! 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 - 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 dataValidate (optional) + isFlag = ESMF_HConfigIsDefined(hconfigMap, keyString="dataValidate", & + 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 + ! 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 - call x_comp_read_geom(xdatacfg, xstate, rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + + isFlag = ESMF_HConfigIsMap(hconfigMap2, 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 + + 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 - call ESMF_HConfigDestroy(xdatacfg, rc=rc) + line=__LINE__, file=__FILE__)) return ! bail out + 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 max (optional) + isFlag = ESMF_HConfigIsDefined(hconfigMap2, keyString="max", 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 + 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 - endsubroutine x_comp_get_config + ! 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 + 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 - 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 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 - rc = ESMF_SUCCESS + else + ! 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 - if (.not. associated(xstate)) then - call ESMF_LogSetError(ESMF_RC_PTR_NOTALLOC, & - msg='XDATA: xstate has not been associated', & + ! 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", & + 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 + + else + ! not a map -> error condition + call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & + msg="The value associated with key '"//trim(name)//"' "// & + "under 'importFields' or 'exportFields' 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) + call ESMF_HConfigDestroy(hconfigMap, 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 + 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 + function GeomCreateFromHConfig(hconfig, name, rc) + type(ESMF_Geom) :: GeomCreateFromHConfig + type(ESMF_HConfigIter), intent(in) :: hconfig + character(:), allocatable, intent(out) :: name + integer, intent(out) :: rc + ! local variables - logical :: isPresent - integer :: stat - logical :: check - type(ESMF_HConfig) :: geomcfg - character(len=64) :: cfgval - character(:), allocatable :: badKey + logical :: isFlag + type(ESMF_HConfig) :: hconfigMap + character(:), allocatable :: geom + type(ESMF_Grid) :: grid + type(ESMF_StaggerLoc) :: staggerLoc - rc = ESMF_SUCCESS + rc=ESMF_SUCCESS - if (.not. associated(xstate)) then - call ESMF_LogSetError(ESMF_RC_PTR_NOTALLOC, & - msg='XDATA: xstate has not been associated', & + name = ESMF_HConfigAsStringMapKey(hconfig, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + + ! 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 + + isFlag = ESMF_HConfigIsMap(hconfigMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + + if (isFlag) then + ! look for the geom key to determine the kind of geometry + + geom = ESMF_HConfigAsString(hconfigMap, keyString="geom", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + + 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 ! bail out + GeomCreateFromHConfig = ESMF_GeomCreate(grid, staggerLoc=staggerLoc, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + 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 ! bail out + GeomCreateFromHConfig = ESMF_GeomCreate(grid, staggerLoc=staggerLoc, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + 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 + + 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 geom configuration - isPresent = ESMF_HConfigIsDefined(xdatacfg, & - keyString="geom", rc=rc) + call ESMF_HConfigDestroy(hconfigMap, 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) + line=__LINE__, file=__FILE__)) return ! bail out + + end function + + !----------------------------------------------------------------------------- + + 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 + + ! 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 + + ! 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 - check = ESMF_HConfigValidateMapKeys(geomcfg, & - vocabulary=["nx ", & - "ny ", & - "nz ", & - "coordSys", & - "minx ", & - "maxx ", & - "miny ", & - "maxy " & - ], badKey=badKey, rc=rc) + 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 + + ! 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 - 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) + line=__LINE__, file=__FILE__)) return ! bail out + endif + + ! 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 - xstate%ny = x_comp_hconfig_i4(geomcfg, "ny", & - defaultValue=32, rc=rc) + 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 ! bail out + endif + + ! 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 - xstate%nz = x_comp_hconfig_i4(geomcfg, "nz", & - defaultValue=4, rc=rc) + 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 + + ! 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 - ! coordinate system - cfgval = x_comp_hconfig_str(geomcfg, "coordSys", & - defaultValue="ESMF_COORDSYS_SPH_DEG", 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 - 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 + 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=trim(xstate%cname)//': invalid value - coordSys', & + msg="Invalid value for coordSys: "//string, & 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) - 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) - 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) + 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 - xstate%maxy = x_comp_hconfig_r8(geomcfg, "maxy", & - defaultValue=50.0_ESMF_KIND_R8, 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 - call ESMF_HConfigDestroy(geomcfg, rc=rc) + 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 + + ! 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 ! 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 - endif ! geomcfg + 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 ! bail out - endsubroutine x_comp_read_geom + end function !----------------------------------------------------------------------------- - subroutine x_comp_read_fields(xdatacfg, xstate, rc) - ! arguments - type(ESMF_HConfig) :: xdatacfg - type(xdata_state), pointer, intent(inout) :: xstate - integer, intent(out) :: rc + 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 + ! 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 + 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 ! bail out + endif - rc = ESMF_SUCCESS + ! 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 + ! 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 - if (.not. associated(xstate)) then - call ESMF_LogSetError(ESMF_RC_PTR_NOTALLOC, & - msg='XDATA: xstate has not been associated', & + ! 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 ! bail out + endif + + ! 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 - ! read import field configuration - isPresent = ESMF_HConfigIsDefined(xdatacfg, & - keyString="importFields", 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 - ! access flistcfg(import) - flistcfg = ESMF_HConfigCreateAt(xdatacfg, & - keyString="importFields", 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 - 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) + 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 + + ! 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 - 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) + 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 - 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) + 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 - endif ! flistcfg + 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 - endsubroutine x_comp_read_fields + ! 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 x_comp_grid_diag(xstate, fileName, overwrite, status, timeslice, & - iofmt, relaxedflag, rc) + subroutine Advertise(xdata, 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 + type(ESMF_GridComp) :: xdata + 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 + character(ESMF_MAXSTR) :: name, fieldName + integer :: stat, i + type(ESMF_State) :: importState, exportState + type(InternalState) :: is 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__, rcToReturn=rc) - return - endif + ! 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 - ioCapable = (ESMF_IO_PIO_PRESENT .and. & - (ESMF_IO_NETCDF_PRESENT .or. ESMF_IO_PNETCDF_PRESENT)) + ! 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 - doItFlag = .true. ! default - if (present(relaxedFlag)) then - doItFlag = .not.relaxedflag .or. (relaxedflag.and.ioCapable) - endif + ! 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 - if (doItFlag) then + ! 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 - if (present(fileName)) then - lfileName = trim(fileName) - else - call ESMF_GridGet(xstate%grid, name=gridName, rc=rc) + ! 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=__FILE__)) return - lfileName = trim(gridName)//".nc" - endif + 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 - arraybundle = ESMF_ArrayBundleCreate(rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + end subroutine Advertise - ! -- centers -- + !----------------------------------------------------------------------------- - 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 (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) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_ArraySet(array, name="lat_center", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_ArrayBundleAdd(arraybundle,(/array/),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - endif + 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 - ! -- corners -- + rc = ESMF_SUCCESS - 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 + ! 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 - ! -- mask -- + ! 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 - 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) + ! 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=__FILE__)) return - call ESMF_ArrayBundleAdd(arraybundle,(/array/),rc=rc) + 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=__FILE__)) return - endif + 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 - ! -- area -- + 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 - call ESMF_GridGetItem(xstate%grid, itemflag=ESMF_GRIDITEM_AREA, & - staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresent, rc=rc) + ! 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=__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) + 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=__FILE__)) return - endif + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out + enddo + endif - call ESMF_ArrayBundleWrite(arraybundle, & - fileName=trim(lfileName),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + ! 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 - call ESMF_ArrayBundleDestroy(arraybundle,rc=rc) + 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=__FILE__)) return + line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out endif - endsubroutine x_comp_grid_diag + + end subroutine DataInitialize !----------------------------------------------------------------------------- - subroutine x_comp_realize_field(xstate, xfield, state, rc) + subroutine Advance(xdata, 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 + type(ESMF_GridComp) :: xdata + integer, intent(out) :: rc ! local variables - integer :: stat + 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 + type(InternalState) :: is + integer :: statsCount, warnCount, errCount + real(ESMF_KIND_R8) :: statsMean, statsMin, statsMax + logical :: statsOkay, headerPrinted 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__, rcToReturn=rc) - return + ! 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 + + 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) + 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 (stepCounter==1) filestatus=ESMF_FILESTATUS_REPLACE + call NUOPC_Write(importState, & + fileNamePrefix="field_"//trim(name)//"_import_advance_", & + 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 - 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 + ! 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) + 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 (dataValidate%diagnose .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)//": 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 (dataValidate%action == "WARNING") warnCount = warnCount + 1 + if (dataValidate%action == "ERROR") errCount = errCount + 1 + endif + end associate + enddo 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 + ! Advance 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 + + ! diagnose and check export fields + if (allocated(is%wrap%exportItems)) then + headerPrinted = .false. + do i=1, size(is%wrap%exportItems) + 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 (dataValidate%diagnose .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" + 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 (dataValidate%action == "WARNING") warnCount = warnCount + 1 + if (dataValidate%action == "ERROR") errCount = errCount + 1 + endif + end associate + enddo 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) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - call ESMF_FieldGet(xfield%efld, farrayPtr=xfield%ptr3, 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) + + if (btest(diagnostic,17)) then + ! write fields of the exportState + filestatus=ESMF_FILESTATUS_OLD + if (stepCounter==1) filestatus=ESMF_FILESTATUS_REPLACE + call NUOPC_Write(exportState, & + fileNamePrefix="field_"//trim(name)//"_export_advance_", & + timeslice=stepCounter, status=filestatus, relaxedFlag=.true., 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=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=__FILE__)) return - else - call ESMF_LogSetError(ESMF_RC_NOT_IMPL, & - msg=trim(xstate%cname)//": field dimension - "//trim(xfield%stdn), & + 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 + return ! bail out endif - call NUOPC_Realize(state, field=xfield%efld, 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) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - xfield%rlze = .true. - endsubroutine x_comp_realize_field + end associate + + end subroutine Advance !----------------------------------------------------------------------------- - subroutine x_comp_check_field(xstate, xfield, rc) + subroutine FieldStats(field, dataValidate, statsCount, statsMean, statsMin, & + statsMax, statsOkay, rc) ! arguments - type(xdata_state), pointer, intent(in) :: xstate - type(xdata_field), pointer, intent(inout) :: xfield - integer, intent(out) :: rc + 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 + 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 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__, rcToReturn=rc) - return - endif + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out - 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) + 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 + + if (rank == 2) then + if (typekind == ESMF_TYPEKIND_I4) then + block + integer(ESMF_KIND_I4), pointer :: fptr(:,:) + 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 + if (dataValidate%maskGuard) then + dataMask = dataValidate%mask + 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 + end block + else if (typekind == ESMF_TYPEKIND_I8) then + block + integer(ESMF_KIND_I8), pointer :: fptr(:,:) + 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 + if (dataValidate%maskGuard) then + dataMask = dataValidate%mask + 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 + end block + else if (typekind == ESMF_TYPEKIND_R4) then + block + real(ESMF_KIND_R4), pointer :: fptr(:,:) + 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 + if (dataValidate%maskGuard) then + dataMask = dataValidate%mask + 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 + end block + else if (typekind == ESMF_TYPEKIND_R8) then + block + real(ESMF_KIND_R8), pointer :: fptr(:,:) + 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 + if (dataValidate%maskGuard) then + dataMask = dataValidate%mask + 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 + end block else + ! error condition: unsupported typekind call ESMF_LogSetError(ESMF_RC_NOT_IMPL, & - msg=trim(xstate%cname)//": field dimension - "//trim(xfield%stdn), & + msg="Unsupported typekind!", & line=__LINE__, file=__FILE__, rcToReturn=rc) - return + return ! bail out 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 + else if (rank == 3) then + if (typekind == ESMF_TYPEKIND_I4) then + block + integer(ESMF_KIND_I4), pointer :: fptr(:,:,:) + 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 + if (dataValidate%maskGuard) then + dataMask = dataValidate%mask + 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 + end block + else if (typekind == ESMF_TYPEKIND_I8) then + block + integer(ESMF_KIND_I8), pointer :: fptr(:,:,:) + 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 + if (dataValidate%maskGuard) then + dataMask = dataValidate%mask + 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 + end block + else if (typekind == ESMF_TYPEKIND_R4) then + block + real(ESMF_KIND_R4), pointer :: fptr(:,:,:) + 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 + if (dataValidate%maskGuard) then + dataMask = dataValidate%mask + 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 + end block + else if (typekind == ESMF_TYPEKIND_R8) then + block + real(ESMF_KIND_R8), pointer :: fptr(:,:,:) + 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 + if (dataValidate%maskGuard) then + dataMask = dataValidate%mask + 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 + 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 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 condition: unsupported rank + call ESMF_LogSetError(ESMF_RC_NOT_IMPL, & + msg="Unsupported rank!", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out endif - endsubroutine x_comp_check_field - !----------------------------------------------------------------------------- + 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) - 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 + 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 - rc = ESMF_SUCCESS - x_comp_hconfig_i4 = 0 + 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) - isPresent = ESMF_HConfigIsDefined(hconfig, keyString=key, rc=rc) + 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 + line=__LINE__, file=__FILE__)) return ! bail out + statsMax = gmax(1) - if (isPresent) then - x_comp_hconfig_i4 = ESMF_HConfigAsI4(hconfig, keyString=key, & - asOkay=check, 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 - else - call ESMF_LogSetError(ESMF_RC_NOT_FOUND, & - msg="XDATA: Key not found - "//trim(key), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return + statsOkay = .true. ! initialize to .true. then see if not so + + if (dataValidate%minGuard) then + if (statsMin < dataValidate%min) statsOkay = .false. ! values below min + endif + + if (dataValidate%maxGuard) then + if (statsMax > dataValidate%max) statsOkay = .false. ! values above max endif - endfunction x_comp_hconfig_i4 + + end subroutine !----------------------------------------------------------------------------- - 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 + subroutine DataHandling(importState, exportItems, step, rc) + type(ESMF_State) :: importState + type(ExportItem), allocatable :: exportItems(:) + integer, intent(in) :: step + integer, intent(out) :: rc + + integer :: i + character(len=:), allocatable :: expression rc = ESMF_SUCCESS - x_comp_hconfig_r8 = 0.0_ESMF_KIND_R8 - isPresent = ESMF_HConfigIsDefined(hconfig, keyString=key, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + ! Early return if there is nothing to be done + if (.not.allocated(exportItems)) return - if (isPresent) then - x_comp_hconfig_r8 = ESMF_HConfigAsR8(hconfig, keyString=key, & - asOkay=check, 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 + do i=1, size(exportItems) + + if (step==0) then + expression = exportItems(i)%dataInit + else + expression = exportItems(i)%dataAdvance endif - elseif (present(defaultValue)) then - x_comp_hconfig_r8 = defaultValue - else - call ESMF_LogSetError(ESMF_RC_NOT_FOUND, & - msg="XDATA: Key not found - "//trim(key), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - endfunction x_comp_hconfig_r8 + + 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 + + end do + + end subroutine !----------------------------------------------------------------------------- - function x_comp_hconfig_str(hconfig, key, defaultValue, rc) - ! return value - character(:), allocatable :: x_comp_hconfig_str + subroutine TimestampExport(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 + type(ESMF_Clock) :: clock + type(type_InternalState) :: modelBaseIs + type(InternalState) :: is 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, 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=__FILE__)) return + 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=trim(name)//":"//__FILE__)) return ! bail out - if (isPresent) then - x_comp_hconfig_str = ESMF_HConfigAsString(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 String - "//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_str = 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_str + + end subroutine !----------------------------------------------------------------------------- - function x_comp_hconfig_logical(hconfig, key, defaultValue, rc) - ! return value - logical :: x_comp_hconfig_logical + subroutine Finalize(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 + integer :: i, stat + 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=__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) - 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 - 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 + ! 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 + enddo + deallocate(is%wrap%importItems) endif - endfunction x_comp_hconfig_logical - !----------------------------------------------------------------------------- + ! 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)%dataInit) + 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..10286a264d 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 -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 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 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. It can be disabled by explicitly setting the `disable_comps` option in the ESMX_BUILD_FILE. ``` application: @@ -12,96 +16,224 @@ application: disable_comps: ESMX_Data ``` -The ESMX Data component may be replaced in the ESMX_BUILD_FILE, see the following example. - +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: 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`. 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. -### 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. +The following example sets `Mediator` style time keeping in the `DAT` instance: ``` -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. -Import field list is configured under the `importFields` key. See the following table for valid field configuration options. +### `importFields` -| Option key | Description / Value options | Default | -| ---------- | ----------------------------------- | ---------- | -| `dim` | number of dimensions | 2 | -| `min` | minimum valid field value | 0 | -| `max` | maximum valid field value | 0 | +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. -For an example, see the following configuration snippet. +| 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* | +| `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 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`. ``` -ATM: +DAT: + ... importFields: - sea_surface_temperature: {dim: 2, min: 260, max: 280} + sea_surface_temperature: {geometry: global, typekind: r8, dataValidate: {diagnose: yes} } + density: + geometry: global + typekind: r4 + ungriddedLBound: [1] + ungriddedUBound: [104] + dataValidate: {min: 1e-05, diagnose: yes, action: error} ``` -### 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. 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. -Export field list is configured under the `exportFields` key. See the following table for valid field configuration options. +### `exportFields` -| 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 | +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. -For an example, see the following configuration snippet. +| 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` | [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 export fields *after* the Advance step. | *none* | + +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 + 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 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 + +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. + +| 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 + +* **Synthetic data generation (Temperature field with 10 Kelvin variablity around 270 Kelvin mean)**:
+ `dataAdvance: 10 * (sin(_coord1) * cos(_coord2)) + 270` + +* **Data feedback (Return a temperature field that is 10% hotter than the incoming field)**:
+ `dataAdvance: 1.1 * temperature` + +* **Unit Conversion (Kelvin to Celsius)**:
+ `dataAdvance: temperature - 273.15` + +* **Applying a spatial mask**:
+ `dataAdvance: field_a * sin(_coord1)` + 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..481edd693c --- /dev/null +++ b/src/addon/ESMX/Comps/ESMX_Data/dataProcess.F90 @@ -0,0 +1,899 @@ +module dataProcess + + !----------------------------------------------------------------------------- + ! Data Processing + !----------------------------------------------------------------------------- + + use ESMF + + implicit none + + private + + public process + + !----------------------------------------------------------------------------- + + contains + + !----------------------------------------------------------------------------- + + subroutine process(importState, expression, exportField, step, rc) + ! Process according to the expression infix string and store in exportField + + 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 + 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 + character(len=:), allocatable :: token, tempString + 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 + + ! Normalize the incoming infix string with single white space deliminators + call normalize_infix(expression, 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="process() 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 ("ABS") + stack(:,top) = abs(stack(:,top)) + case ("AINT") + stack(:,top) = aint(stack(:,top)) + case ("ANINT") + stack(:,top) = anint(stack(:,top)) + case ("CEILING") + stack(:,top) = real(ceiling(stack(:,top)),ESMF_KIND_R8) + case ("FLOOR") + stack(:,top) = real(floor(stack(:,top)),ESMF_KIND_R8) + 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 + ! 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 == "_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 + ! 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 + ! Field in 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="process() 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 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, off + 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)) + 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(off+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 + 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, & + 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 + 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), 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 + 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 + 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 + + else if (token == "(") then + ! Handle Left Parenthesis + stack_ptr = stack_ptr + 1 + op_stack(stack_ptr) = "(" + + else if (token == ")") then + ! Handle Right Parenthesis + 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) 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 + rpn = rpn // token // " " + end if + end do + + ! Pop remaining operators from stack + do i = stack_ptr, 1, -1 + 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) + + 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_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 + 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 + + if (is_function(token)) then + ! For functions return token as upper case + token = ESMF_UtilStringUpperCase(token) + endif + + 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 + 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 + + !----------------------------------------------------------------------------- + + logical function is_operator(token) + ! Identify token as operator + character(len=*), intent(in) :: token + select case (token) + case ("+", "-", "*", "/") ; is_operator = .true. + 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 + + !----------------------------------------------------------------------------- + + 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