diff --git a/CHANGELOG.md b/CHANGELOG.md index c8e980c155d3..44c9727038ff 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,11 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +- Updated ESMF required version to 8.6.0 +- Allocate gridded fields to use the pinflag option needed for the Single System Image (SSI) capability. +- Made changes to allocate fields to use farray instead of farrayPtr. This allows explicit specification of indexflag required by the new MAPL field split functionality. This functionality allows a clean way to create a new field from an exiting field where the new field is a 'slice' of the existing field with the slicing index being that of the trailing ungiridded dim of the existing field. +- Replaced RC=STATUS plus `_VERIFY(RC)` in `Base_Base_implementation.F90` with just `_RC` in line with our new convention. + ### Fixed ### Removed diff --git a/CMakeLists.txt b/CMakeLists.txt index 371040a11279..ff4269295cd7 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -148,7 +148,7 @@ if (NOT Baselibs_FOUND) endif() if (NOT TARGET esmf) - find_package(ESMF 8.5.0 MODULE REQUIRED) + find_package(ESMF 8.6.0 MODULE REQUIRED) # ESMF as used in MAPL requires MPI # NOTE: This looks odd because some versions of FindESMF.cmake out in the @@ -167,8 +167,8 @@ else () # This is an ESMF version test when using Baselibs which doesn't use the # same find_package internally in ESMA_cmake as used above (with a version # number) so this lets us at least trap use of old Baselibs here. - if (ESMF_VERSION VERSION_LESS 8.5.0) - message(FATAL_ERROR "ESMF must be at least 8.5.0") + if (ESMF_VERSION VERSION_LESS 8.6.0) + message(FATAL_ERROR "ESMF must be at least 8.6.0") endif () endif () diff --git a/base/Base/Base_Base_implementation.F90 b/base/Base/Base_Base_implementation.F90 index 151616a5ffd6..839c8674eda1 100644 --- a/base/Base/Base_Base_implementation.F90 +++ b/base/Base/Base_Base_implementation.F90 @@ -54,56 +54,41 @@ module subroutine MAPL_AllocateCoupling(field, rc) logical :: defaultProvided real :: default_value - call ESMF_FieldGet(field, status=fieldStatus, rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(field, status=fieldStatus, _RC) if (fieldStatus /= ESMF_FIELDSTATUS_COMPLETE) then !ALT: if the attributeGet calls fail, this would very likely indicate ! that the field was NOT created by MAPL (or something terrible happened) ! For now we just abort - call ESMF_AttributeGet(FIELD, NAME='DIMS', VALUE=DIMS, RC=STATUS) - _VERIFY(STATUS) - call ESMF_AttributeGet(FIELD, NAME='VLOCATION', VALUE=LOCATION, RC=STATUS) - _VERIFY(STATUS) - call ESMF_AttributeGet(FIELD, NAME='HALOWIDTH', VALUE=HW, RC=STATUS) - _VERIFY(STATUS) - call ESMF_AttributeGet(FIELD, NAME='PRECISION', VALUE=KND, RC=STATUS) - _VERIFY(STATUS) - call ESMF_AttributeGet(FIELD, NAME='DEFAULT_PROVIDED', value=defaultProvided, RC=STATUS) - _VERIFY(STATUS) + call ESMF_AttributeGet(FIELD, NAME='DIMS', VALUE=DIMS, _RC) + call ESMF_AttributeGet(FIELD, NAME='VLOCATION', VALUE=LOCATION, _RC) + call ESMF_AttributeGet(FIELD, NAME='HALOWIDTH', VALUE=HW, _RC) + call ESMF_AttributeGet(FIELD, NAME='PRECISION', VALUE=KND, _RC) + call ESMF_AttributeGet(FIELD, NAME='DEFAULT_PROVIDED', value=defaultProvided, _RC) if(defaultProvided) then - call ESMF_AttributeGet(FIELD, NAME='DEFAULT_VALUE', value=default_value, RC=STATUS) - _VERIFY(STATUS) + call ESMF_AttributeGet(FIELD, NAME='DEFAULT_VALUE', value=default_value, _RC) end if - call ESMF_AttributeGet(FIELD, NAME='UNGRIDDED_DIMS', isPresent=has_ungrd, RC=STATUS) - _VERIFY(STATUS) + call ESMF_AttributeGet(FIELD, NAME='UNGRIDDED_DIMS', isPresent=has_ungrd, _RC) if (has_ungrd) then - call ESMF_AttributeGet(FIELD, NAME='UNGRIDDED_DIMS', itemcount=UNGRD_CNT, RC=STATUS) - _VERIFY(STATUS) - allocate(ungrd(UNGRD_CNT), stat=status) - _VERIFY(STATUS) - call ESMF_AttributeGet(FIELD, NAME='UNGRIDDED_DIMS', valueList=UNGRD, RC=STATUS) - _VERIFY(STATUS) + call ESMF_AttributeGet(FIELD, NAME='UNGRIDDED_DIMS', itemcount=UNGRD_CNT, _RC) + allocate(ungrd(UNGRD_CNT), _STAT) + call ESMF_AttributeGet(FIELD, NAME='UNGRIDDED_DIMS', valueList=UNGRD, _RC) if (defaultProvided) then call MAPL_FieldAllocCommit(field, dims=dims, location=location, typekind=knd, & - hw=hw, ungrid=ungrd, default_value=default_value, rc=status) - _VERIFY(STATUS) + hw=hw, ungrid=ungrd, default_value=default_value, _RC) else call MAPL_FieldAllocCommit(field, dims=dims, location=location, typekind=knd, & - hw=hw, ungrid=ungrd, rc=status) - _VERIFY(STATUS) + hw=hw, ungrid=ungrd, _RC) end if else if (defaultProvided) then call MAPL_FieldAllocCommit(field, dims=dims, location=location, typekind=knd, & - hw=hw, default_value=default_value, rc=status) - _VERIFY(STATUS) + hw=hw, default_value=default_value, _RC) else call MAPL_FieldAllocCommit(field, dims=dims, location=location, typekind=knd, & - hw=hw, rc=status) - _VERIFY(STATUS) + hw=hw, _RC) end if end if @@ -146,23 +131,25 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & integer :: lb1, lb2, lb3 integer :: ub1, ub2, ub3 - call ESMF_FieldGet(field, grid=GRID, RC=STATUS) - _VERIFY(STATUS) - call MAPL_GridGet(GRID, localCellCountPerDim=COUNTS, RC=STATUS) - _VERIFY(STATUS) - call ESMF_GridGet(GRID, dimCount=gridRank, rc=status) - _VERIFY(STATUS) +! SSI + character(len=ESMF_MAXSTR) :: name + type(ESMF_Pin_Flag) :: pinflag + type(ESMF_VM) :: vm + logical :: ssiSharedMemoryEnabled +! SSI + + call ESMF_FieldGet(field, grid=GRID, _RC) + call MAPL_GridGet(GRID, localCellCountPerDim=COUNTS, _RC) + call ESMF_GridGet(GRID, dimCount=gridRank, _RC) _ASSERT(gridRank <= 3,' MAPL restriction - only 2 and 3d are supported') - allocate(gridToFieldMap(gridRank), stat=status) - _VERIFY(STATUS) + allocate(gridToFieldMap(gridRank), _STAT) gridToFieldMap = 0 do I = 1, gridRank gridToFieldMap(I) = I end do ! ALT: the next allocation should have been griddedDims, ! but this compilcates the code unnecessery - allocate(haloWidth(gridRank), stat=status) - _VERIFY(STATUS) + allocate(haloWidth(gridRank), _STAT) haloWidth = (/HW,HW,0/) if(present(default_value)) then @@ -176,6 +163,15 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & szungrd = size(UNGRID) end if +! SSI + call ESMF_VMGetCurrent(vm, _RC) + + call ESMF_VMGet(vm, ssiSharedMemoryEnabledFlag=ssiSharedMemoryEnabled, _RC) + + _ASSERT(ssiSharedMemoryEnabled, 'SSI shared memory is NOT supported') + pinflag=ESMF_PIN_DE_TO_SSI_CONTIG ! requires support for SSI shared memory +! SSI + Dimensionality: select case(DIMS) ! Horizontal and vertical @@ -189,13 +185,15 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & if (typekind == ESMF_KIND_R4) then select case (rank) case (1) - allocate(VAR_1D(UNGRID(1)), STAT=STATUS) - _VERIFY(STATUS) + allocate(VAR_1D(UNGRID(1)), _STAT) VAR_1D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=VAR_1D, & + call ESMF_FieldEmptyComplete(FIELD, farray=VAR_1D, & + indexflag=ESMF_INDEX_DELOCAL, & datacopyFlag = ESMF_DATACOPY_REFERENCE, & gridToFieldMap=gridToFieldMap, & - rc = status) + ungriddedLBound=[1],& + ungriddedUBound=[ungrid(1)], & + _RC) case default _FAIL( 'unsupported rank > 1') end select @@ -203,19 +201,20 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & else select case (rank) case (1) - allocate(VR8_1D(UNGRID(1)), STAT=STATUS) - _VERIFY(STATUS) + allocate(VR8_1D(UNGRID(1)), _STAT) VR8_1D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=VR8_1D, & + call ESMF_FieldEmptyComplete(FIELD, farray=VR8_1D, & + indexflag=ESMF_INDEX_DELOCAL, & datacopyFlag = ESMF_DATACOPY_REFERENCE, & gridToFieldMap=gridToFieldMap, & - rc = status) + ungriddedLBound=[1],& + ungriddedUBound=[ungrid(1)], & + _RC) case default _FAIL( 'unsupported rank > 1') end select endif - _VERIFY(STATUS) ! Vertical only ! ------------- @@ -238,23 +237,27 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & end select if (typekind == ESMF_KIND_R4) then - allocate(VAR_1D(lb1:ub1), STAT=STATUS) - _VERIFY(STATUS) + allocate(VAR_1D(lb1:ub1), _STAT) VAR_1D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=var_1d, & + call ESMF_FieldEmptyComplete(FIELD, farray=var_1d, & + indexflag=ESMF_INDEX_DELOCAL, & + datacopyFlag = ESMF_DATACOPY_REFERENCE, & gridToFieldMap=gridToFieldMap, & - RC=status) - _VERIFY(STATUS) + ungriddedLBound=[lb1],& + ungriddedUBound=[ub1], & + _RC) else - allocate(VR8_1D(lb1:ub1), STAT=STATUS) - _VERIFY(STATUS) + allocate(VR8_1D(lb1:ub1), _STAT) VR8_1D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=vr8_1d, & + call ESMF_FieldEmptyComplete(FIELD, farray=vr8_1d, & + indexflag=ESMF_INDEX_DELOCAL, & + datacopyFlag = ESMF_DATACOPY_REFERENCE, & gridToFieldMap=gridToFieldMap, & - RC=status) - _VERIFY(STATUS) + ungriddedLBound=[lb1],& + ungriddedUBound=[ub1], & + _RC) end if ! Horizontal only @@ -274,77 +277,68 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & if (typekind == ESMF_KIND_R4) then RankCase2d: select case (rank) case (2) - allocate(VAR_2D(lb1:ub1, lb2:ub2), STAT=STATUS) - _VERIFY(STATUS) - VAR_2D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=VAR_2D, & - datacopyFlag = ESMF_DATACOPY_REFERENCE, & + call ESMF_FieldEmptyComplete(FIELD, typekind=ESMF_TYPEKIND_R4, & gridToFieldMap=gridToFieldMap, & totalLWidth=haloWidth(1:griddedDims), & totalUWidth=haloWidth(1:griddedDims), & - rc = status) + pinflag=pinflag, _RC) + call ESMF_FieldGet(FIELD, farrayPtr=VAR_2D, _RC) + VAR_2D = INIT_VALUE case (3) - allocate(VAR_3D(lb1:ub1, lb2:ub2, UNGRID(1)), STAT=STATUS) - _VERIFY(STATUS) - VAR_3D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=VAR_3D, & - datacopyFlag = ESMF_DATACOPY_REFERENCE, & + call ESMF_FieldEmptyComplete(FIELD, typekind=ESMF_TYPEKIND_R4, & gridToFieldMap=gridToFieldMap, & totalLWidth=haloWidth(1:griddedDims), & totalUWidth=haloWidth(1:griddedDims), & - rc = status) + ungriddedLBound=(/1/), ungriddedUBound=(/UNGRID(1)/), & + pinflag=pinflag,_RC) + call ESMF_FieldGet(FIELD, farrayPtr=VAR_3D, _RC) + VAR_3D = INIT_VALUE case (4) - allocate(VAR_4D(lb1:ub1, lb2:ub2, UNGRID(1), UNGRID(2)), STAT=STATUS) - _VERIFY(STATUS) - VAR_4D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=VAR_4D, & - datacopyFlag = ESMF_DATACOPY_REFERENCE, & + call ESMF_FieldEmptyComplete(FIELD, typekind=ESMF_TYPEKIND_R4, & gridToFieldMap=gridToFieldMap, & totalLWidth=haloWidth(1:griddedDims), & totalUWidth=haloWidth(1:griddedDims), & - rc = status) + ungriddedLBound=(/1,1/), ungriddedUBound=(/UNGRID(1),UNGRID(2)/), & + pinflag=pinflag, _RC) + call ESMF_FieldGet(FIELD, farrayPtr=VAR_4D, _RC) + VAR_4D = INIT_VALUE case default - _FAIL( 'only up to 4D are supported') + _ASSERT(.false., 'only up to 4D are supported') end select RankCase2d else select case (rank) case (2) - allocate(VR8_2D(lb1:ub1, lb2:ub2), STAT=STATUS) - _VERIFY(STATUS) - VR8_2D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=VR8_2D, & - datacopyFlag = ESMF_DATACOPY_REFERENCE, & - gridToFieldMap=gridToFieldMap, & - totalLWidth=haloWidth(1:griddedDims), & - totalUWidth=haloWidth(1:griddedDims), & - rc = status) + call ESMF_FieldEmptyComplete(FIELD, typekind=ESMF_TYPEKIND_R8, & + gridToFieldMap=gridToFieldMap, & + totalLWidth=haloWidth(1:griddedDims), & + totalUWidth=haloWidth(1:griddedDims), & + pinflag=pinflag, _RC) + call ESMF_FieldGet(FIELD, farrayPtr=VR8_2D, _RC) + VR8_2D = INIT_VALUE case (3) - allocate(VR8_3D(lb1:ub1, lb2:ub2, UNGRID(1)), STAT=STATUS) - _VERIFY(STATUS) - VR8_3D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=VR8_3D, & - datacopyFlag = ESMF_DATACOPY_REFERENCE, & - gridToFieldMap=gridToFieldMap, & - totalLWidth=haloWidth(1:griddedDims), & - totalUWidth=haloWidth(1:griddedDims), & - rc = status) + call ESMF_FieldEmptyComplete(FIELD, typekind=ESMF_TYPEKIND_R8, & + gridToFieldMap=gridToFieldMap, & + totalLWidth=haloWidth(1:griddedDims), & + totalUWidth=haloWidth(1:griddedDims), & + ungriddedLBound=(/1/), ungriddedUBound=(/UNGRID(1)/), & + pinflag=pinflag, _RC) + call ESMF_FieldGet(FIELD, farrayPtr=VR8_3D, _RC) + VR8_3D = INIT_VALUE case (4) - allocate(VR8_4D(lb1:ub1, lb2:ub2, UNGRID(1), UNGRID(2)), STAT=STATUS) - _VERIFY(STATUS) - VR8_4D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=VR8_4D, & - datacopyFlag = ESMF_DATACOPY_REFERENCE, & - gridToFieldMap=gridToFieldMap, & - totalLWidth=haloWidth(1:griddedDims), & - totalUWidth=haloWidth(1:griddedDims), & - rc = status) + call ESMF_FieldEmptyComplete(FIELD, typekind=ESMF_TYPEKIND_R8, & + gridToFieldMap=gridToFieldMap, & + totalLWidth=haloWidth(1:griddedDims), & + totalUWidth=haloWidth(1:griddedDims), & + ungriddedLBound=(/1,1/), ungriddedUBound=(/UNGRID(1),UNGRID(2)/), & + pinflag=pinflag, _RC) + call ESMF_FieldGet(FIELD, farrayPtr=VR8_4D, _RC) + VR8_4D = INIT_VALUE case default - _FAIL( 'only up to 4D are supported') + _ASSERT(.false., 'only up to 4D are supported') end select end if - _VERIFY(STATUS) - ! Horz + Vert + ! Horz + Vert ! ----------- case(MAPL_DimsHorzVert) lb1 = 1-HW @@ -371,55 +365,45 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & RankCase3d: select case(rank) case (3) if (typekind == ESMF_KIND_R4) then - NULLIFY(VAR_3D) - allocate(VAR_3D(lb1:ub1, lb2:ub2, lb3:ub3), STAT=status) - _VERIFY(STATUS) - VAR_3D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=VAR_3D, & - datacopyFlag = ESMF_DATACOPY_REFERENCE, & + call ESMF_FieldEmptyComplete(FIELD, typekind=ESMF_TYPEKIND_R4, & gridToFieldMap=gridToFieldMap, & totalLWidth=haloWidth(1:griddedDims), & totalUWidth=haloWidth(1:griddedDims), & - rc = status) + ungriddedLBound=(/lb3/), ungriddedUBound=(/ub3/), & + pinflag=pinflag, _RC) + call ESMF_FieldGet(FIELD, farrayPtr=VAR_3D, _RC) + VAR_3D = INIT_VALUE else - NULLIFY(VR8_3D) - allocate(VR8_3D(lb1:ub1, lb2:ub2, lb3:ub3), STAT=status) - _VERIFY(STATUS) - VR8_3D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=VR8_3D, & - datacopyFlag = ESMF_DATACOPY_REFERENCE, & + call ESMF_FieldEmptyComplete(FIELD, typekind=ESMF_TYPEKIND_R8, & gridToFieldMap=gridToFieldMap, & totalLWidth=haloWidth(1:griddedDims), & totalUWidth=haloWidth(1:griddedDims), & - rc = status) + ungriddedLBound=(/lb3/), ungriddedUBound=(/ub3/), & + pinflag=pinflag, _RC) + call ESMF_FieldGet(FIELD, farrayPtr=VR8_3D, _RC) + VR8_3D = INIT_VALUE endif - _VERIFY(STATUS) case (4) if (typekind == ESMF_KIND_R4) then - NULLIFY(VAR_4D) - allocate(VAR_4D(lb1:ub1, lb2:ub2, lb3:ub3, ungrid(1)), STAT=status) - _VERIFY(STATUS) - VAR_4D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=VAR_4D, & - datacopyFlag = ESMF_DATACOPY_REFERENCE, & + call ESMF_FieldEmptyComplete(FIELD, typekind=ESMF_TYPEKIND_R4, & gridToFieldMap=gridToFieldMap, & totalLWidth=haloWidth(1:griddedDims), & totalUWidth=haloWidth(1:griddedDims), & - rc = status) + ungriddedLBound=(/lb3,1/), ungriddedUBound=(/ub3,ungrid(1)/), & + pinflag=pinflag, _RC) + call ESMF_FieldGet(FIELD, farrayPtr=VAR_4D, _RC) + VAR_4D = INIT_VALUE else - NULLIFY(VR8_4D) - allocate(VR8_4D(lb1:ub1, lb2:ub2, lb3:ub3, ungrid(1)), STAT=status) - _VERIFY(STATUS) - VR8_4D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=VR8_4D, & - datacopyFlag = ESMF_DATACOPY_REFERENCE, & + call ESMF_FieldEmptyComplete(FIELD, typekind=ESMF_TYPEKIND_R8, & gridToFieldMap=gridToFieldMap, & totalLWidth=haloWidth(1:griddedDims), & totalUWidth=haloWidth(1:griddedDims), & - rc = status) + ungriddedLBound=(/lb3,1/), ungriddedUBound=(/ub3,ungrid(1)/), & + pinflag=pinflag, _RC) + call ESMF_FieldGet(FIELD, farrayPtr=VR8_4D, _RC) + VR8_4D = INIT_VALUE endif - _VERIFY(STATUS) case default _RETURN(ESMF_FAILURE) @@ -434,29 +418,28 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & if (typekind == ESMF_KIND_R4) then select case (rank) case (1) - allocate(VAR_1D(COUNTS(1)), STAT=STATUS) - _VERIFY(STATUS) + allocate(VAR_1D(COUNTS(1)), _STAT) VAR_1D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=VAR_1D, & + call ESMF_FieldEmptyComplete(FIELD, farray=VAR_1D, & + indexflag=ESMF_INDEX_DELOCAL, & datacopyFlag = ESMF_DATACOPY_REFERENCE, & - rc = status) + _RC) case (2) - allocate(VAR_2D(COUNTS(1),UNGRID(1)), STAT=STATUS) - _VERIFY(STATUS) + allocate(VAR_2D(COUNTS(1),UNGRID(1)), _STAT) VAR_2D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=VAR_2D, & + call ESMF_FieldEmptyComplete(FIELD, farray=VAR_2D, & + indexflag=ESMF_INDEX_DELOCAL, & gridToFieldMap=gridToFieldMap, & datacopyFlag = ESMF_DATACOPY_REFERENCE, & - rc = status) + _RC) case (3) - allocate(VAR_3D(COUNTS(1), UNGRID(1), UNGRID(2)), & - STAT=STATUS) - _VERIFY(STATUS) + allocate(VAR_3D(COUNTS(1), UNGRID(1), UNGRID(2)), _STAT) VAR_3D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=VAR_3D, & + call ESMF_FieldEmptyComplete(FIELD, farray=VAR_3D, & + indexflag=ESMF_INDEX_DELOCAL, & gridToFieldMap=gridToFieldMap, & datacopyFlag = ESMF_DATACOPY_REFERENCE, & - rc = status) + _RC) case default _FAIL( 'only 2D and 3D are supported') end select @@ -464,60 +447,57 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & else select case (rank) case (1) - allocate(VR8_1D(COUNTS(1)), STAT=STATUS) - _VERIFY(STATUS) + allocate(VR8_1D(COUNTS(1)), _STAT) VR8_1D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=VR8_1D, & - datacopyFlag = ESMF_DATACOPY_REFERENCE, & - rc = status) + call ESMF_FieldEmptyComplete(FIELD, farray=VR8_1D, & + indexflag=ESMF_INDEX_DELOCAL, & + datacopyFlag = ESMF_DATACOPY_REFERENCE, & + _RC) case (2) - allocate(VR8_2D(COUNTS(1),UNGRID(1)), STAT=STATUS) - _VERIFY(STATUS) + allocate(VR8_2D(COUNTS(1),UNGRID(1)), _STAT) VR8_2D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=VR8_2D, & + call ESMF_FieldEmptyComplete(FIELD, farray=VR8_2D, & + indexflag=ESMF_INDEX_DELOCAL, & gridToFieldMap=gridToFieldMap, & datacopyFlag = ESMF_DATACOPY_REFERENCE, & - rc = status) + _RC) case (3) - allocate(VR8_3D(COUNTS(1), UNGRID(1), UNGRID(2)), & - STAT=STATUS) - _VERIFY(STATUS) + allocate(VR8_3D(COUNTS(1), UNGRID(1), UNGRID(2)), _STAT) VR8_3D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=VR8_3D, & + call ESMF_FieldEmptyComplete(FIELD, farray=VR8_3D, & + indexflag=ESMF_INDEX_DELOCAL, & gridToFieldMap=gridToFieldMap, & datacopyFlag = ESMF_DATACOPY_REFERENCE, & - rc = status) + _RC) case default _FAIL( 'only 2D and 3D are supported') end select endif - _VERIFY(STATUS) case(MAPL_DimsTileTile) rank=2 _ASSERT(gridRank == 1, 'gridRank /= 1') if (typekind == ESMF_KIND_R4) then - allocate(VAR_2D(COUNTS(1), COUNTS(2)), STAT=STATUS) - _VERIFY(STATUS) + allocate(VAR_2D(COUNTS(1), COUNTS(2)), _STAT) VAR_2D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=VAR_2D, & + call ESMF_FieldEmptyComplete(FIELD, farray=VAR_2D, & + indexflag=ESMF_INDEX_DELOCAL, & datacopyFlag = ESMF_DATACOPY_REFERENCE, & ! ungriddedLBound = (/1/), & ! ungriddedUBound = (/counts(2)/), & - rc = status) + _RC) else - allocate(VR8_2D(COUNTS(1), COUNTS(2)), STAT=STATUS) - _VERIFY(STATUS) + allocate(VR8_2D(COUNTS(1), COUNTS(2)), _STAT) VR8_2D = INIT_VALUE - call ESMF_FieldEmptyComplete(FIELD, farrayPtr=VR8_2D, & + call ESMF_FieldEmptyComplete(FIELD, farray=VR8_2D, & + indexflag=ESMF_INDEX_DELOCAL, & datacopyFlag = ESMF_DATACOPY_REFERENCE, & ! ungriddedLBound = (/1/), & ! ungriddedUBound = (/counts(2)/), & - rc = status) + _RC) endif - _VERIFY(STATUS) ! Invalid dimensionality ! ---------------------- @@ -526,12 +506,10 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & _RETURN(ESMF_FAILURE) end select Dimensionality - _VERIFY(STATUS) if (present(default_value)) then call MAPL_AttributeSet(field, NAME="MAPL_InitStatus", & - VALUE=MAPL_InitialDefault, RC=STATUS) - _VERIFY(STATUS) + VALUE=MAPL_InitialDefault, _RC) end if ! Clean up @@ -557,26 +535,20 @@ module subroutine MAPL_FieldF90Deallocate(field, rc) integer :: rank type(ESMF_TypeKind_Flag) :: tk - call ESMF_FieldGet(field, status=fieldStatus, rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(field, status=fieldStatus, _RC) if (fieldStatus == ESMF_FIELDSTATUS_COMPLETE) then - call ESMF_FieldGet(field, Array=array, rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(field, Array=array, _RC) - call ESMF_ArrayGet(array, localDeCount=localDeCount, rc=status) - _VERIFY(STATUS) + call ESMF_ArrayGet(array, localDeCount=localDeCount, _RC) _ASSERT(localDeCount == 1, 'currently MAPL supports only 1 local array') - call ESMF_ArrayGet(array, localarrayList=larrayList, rc=status) - _VERIFY(STATUS) + call ESMF_ArrayGet(array, localarrayList=larrayList, _RC) larray => lArrayList(1) ! alias call ESMF_LocalArrayGet(larray, rank=rank, typekind=tk, & - rc=status) - _VERIFY(STATUS) + _RC) - call ESMF_LocalArrayF90Deallocate(larray, typekind=tk, rank=rank, rc=status) - _VERIFY(STATUS) + call ESMF_LocalArrayF90Deallocate(larray, typekind=tk, rank=rank, _RC) end if _RETURN(ESMF_SUCCESS) @@ -609,32 +581,24 @@ module subroutine MAPL_SetPointer2DR4(state, ptr, name, rc) loc = index(name,';;') if(loc/=0) then - call ESMF_StateGet(state, name(:loc-1), Bundle, rc=status) - _VERIFY(STATUS) - call ESMF_StateGet(state, name(loc+2:), Field, rc=status) - _VERIFY(STATUS) + call ESMF_StateGet(state, name(:loc-1), Bundle, _RC) + call ESMF_StateGet(state, name(loc+2:), Field, _RC) else - call ESMF_StateGet(state, name, Field, rc=status) - _VERIFY(STATUS) + call ESMF_StateGet(state, name, Field, _RC) end if - call ESMF_FieldGet(field, status=fieldStatus, rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(field, status=fieldStatus, _RC) _ASSERT(fieldStatus /= ESMF_FIELDSTATUS_COMPLETE, 'fieldStatus == ESMF_FIELDSTATUS_COMPLETE') - call ESMF_FieldGet(field, grid=GRID, RC=STATUS) - _VERIFY(STATUS) - call MAPL_GridGet(GRID, localCellCountPerDim=COUNTS, RC=STATUS) - _VERIFY(STATUS) + call ESMF_FieldGet(field, grid=GRID, _RC) + call MAPL_GridGet(GRID, localCellCountPerDim=COUNTS, _RC) _ASSERT(size(ptr,1) == COUNTS(1), 'shape mismatch dim=1') _ASSERT(size(ptr,2) == COUNTS(2), 'shape mismatch dim=2') - call ESMF_GridGet(GRID, dimCount=gridRank, rc=status) - _VERIFY(STATUS) + call ESMF_GridGet(GRID, dimCount=gridRank, _RC) ! MAPL restriction (actually only the first 2 dims are distributted) _ASSERT(gridRank <= 3, 'gridRank > 3 not supported') - allocate(gridToFieldMap(gridRank), stat=status) - _VERIFY(STATUS) + allocate(gridToFieldMap(gridRank), _STAT) do I = 1, gridRank gridToFieldMap(I) = I end do @@ -645,8 +609,7 @@ module subroutine MAPL_SetPointer2DR4(state, ptr, name, rc) call ESMF_FieldEmptyComplete(FIELD, farrayPtr=ptr, & datacopyFlag = ESMF_DATACOPY_REFERENCE, & gridToFieldMap=gridToFieldMap, & - rc = status) - _VERIFY(STATUS) + _RC) ! Clean up deallocate(gridToFieldMap) @@ -682,32 +645,24 @@ module subroutine MAPL_SetPointer3DR4(state, ptr, name, rc) loc = index(name,';;') if(loc/=0) then - call ESMF_StateGet(state, name(:loc-1), Bundle, rc=status) - _VERIFY(STATUS) - call ESMF_StateGet(state, name(loc+2:), Field, rc=status) - _VERIFY(STATUS) + call ESMF_StateGet(state, name(:loc-1), Bundle, _RC) + call ESMF_StateGet(state, name(loc+2:), Field, _RC) else - call ESMF_StateGet(state, name, Field, rc=status) - _VERIFY(STATUS) + call ESMF_StateGet(state, name, Field, _RC) end if - call ESMF_FieldGet(field, status=fieldStatus, rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(field, status=fieldStatus, _RC) _ASSERT(fieldStatus /= ESMF_FIELDSTATUS_COMPLETE, 'fieldStatus == ESMF_FIELDSTATUS_COMPLETE') - call ESMF_FieldGet(field, grid=GRID, RC=STATUS) - _VERIFY(STATUS) - call MAPL_GridGet(GRID, localCellCountPerDim=COUNTS, RC=STATUS) - _VERIFY(STATUS) + call ESMF_FieldGet(field, grid=GRID, _RC) + call MAPL_GridGet(GRID, localCellCountPerDim=COUNTS, _RC) _ASSERT(size(ptr,1) == COUNTS(1), 'shape mismatch dim=1') _ASSERT(size(ptr,2) == COUNTS(2), 'shape mismatch dim=2') - call ESMF_GridGet(GRID, dimCount=gridRank, rc=status) - _VERIFY(STATUS) + call ESMF_GridGet(GRID, dimCount=gridRank, _RC) ! MAPL restriction (actually only the first 2 dims are distributted) _ASSERT(gridRank <= 3, 'gridRank > 3 not supported') - allocate(gridToFieldMap(gridRank), stat=status) - _VERIFY(STATUS) + allocate(gridToFieldMap(gridRank), _STAT) do I = 1, gridRank gridToFieldMap(I) = I end do @@ -715,8 +670,7 @@ module subroutine MAPL_SetPointer3DR4(state, ptr, name, rc) call ESMF_FieldEmptyComplete(FIELD, farrayPtr=ptr, & datacopyFlag = ESMF_DATACOPY_REFERENCE, & gridToFieldMap=gridToFieldMap, & - rc = status) - _VERIFY(STATUS) + _RC) ! Clean up deallocate(gridToFieldMap) @@ -853,10 +807,8 @@ module subroutine MAPL_MakeDecomposition(nx, ny, unusable, reduceFactor, rc) _UNUSED_DUMMY(unusable) - call ESMF_VMGetCurrent(vm, rc=status) - _VERIFY(status) - call ESMF_VMGet(vm, petCount=pet_count, rc=status) - _VERIFY(status) + call ESMF_VMGetCurrent(vm, _RC) + call ESMF_VMGet(vm, petCount=pet_count, _RC) if (present(reduceFactor)) pet_count=pet_count/reduceFactor ! count down from sqrt(n) @@ -940,32 +892,24 @@ module subroutine MAPL_ClimInterpFac (CLOCK,I1,I2,FAC, RC) type (ESMF_TimeInterval) :: oneMonth type (ESMF_Calendar) :: cal - call ESMF_ClockGet ( CLOCK, CurrTime=CurrTime, calendar=cal, rc=STATUS ) - _VERIFY(STATUS) - call ESMF_TimeGet ( CurrTime, midMonth=midMonth, rc=STATUS ) - _VERIFY(STATUS) - call ESMF_TimeIntervalSet( oneMonth, MM = 1, calendar=cal, rc=status ) - _VERIFY(STATUS) + call ESMF_ClockGet ( CLOCK, CurrTime=CurrTime, calendar=cal, _RC ) + call ESMF_TimeGet ( CurrTime, midMonth=midMonth, _RC ) + call ESMF_TimeIntervalSet( oneMonth, MM = 1, calendar=cal, _RC ) if( CURRTIME < midMonth ) then AFTER = midMonth midMonth = midMonth - oneMonth - call ESMF_TimeGet (midMonth, midMonth=BEFORE, rc=STATUS ) - _VERIFY(STATUS) + call ESMF_TimeGet (midMonth, midMonth=BEFORE, _RC ) else BEFORE = midMonth midMonth = midMonth + oneMonth - call ESMF_TimeGet (midMonth, midMonth=AFTER , rc=STATUS ) - _VERIFY(STATUS) + call ESMF_TimeGet (midMonth, midMonth=AFTER , _RC ) endif - call MAPL_Interp_Fac( CURRTIME, BEFORE, AFTER, FAC, RC=STATUS) - _VERIFY(STATUS) + call MAPL_Interp_Fac( CURRTIME, BEFORE, AFTER, FAC, _RC) - call ESMF_TimeGet (BEFORE, MM=I1, rc=STATUS ) - _VERIFY(STATUS) - call ESMF_TimeGet (AFTER , MM=I2, rc=STATUS ) - _VERIFY(STATUS) + call ESMF_TimeGet (BEFORE, MM=I1, _RC ) + call ESMF_TimeGet (AFTER , MM=I2, _RC ) _RETURN(ESMF_SUCCESS) @@ -1181,21 +1125,17 @@ module subroutine MAPL_GetFieldTimeFromField ( FIELD, TIME, RC ) character(len=ESMF_MAXSTR) :: TIMESTAMP logical :: isPresent - call ESMF_AttributeGet(FIELD, NAME="TimeStamp", isPresent=isPresent, RC=STATUS) - _VERIFY(STATUS) + call ESMF_AttributeGet(FIELD, NAME="TimeStamp", isPresent=isPresent, _RC) if(.not. isPresent) then - call ESMF_TimeSet (TIME, YY=0, RC=STATUS) + call ESMF_TimeSet (TIME, YY=0, _RC) else - call ESMF_AttributeGet(FIELD, NAME="TimeStamp", VALUE=TIMESTAMP, RC=STATUS) - _VERIFY(STATUS) + call ESMF_AttributeGet(FIELD, NAME="TimeStamp", VALUE=TIMESTAMP, _RC) call MAPL_TimeStringGet (TIMESTAMP, YY=YEAR, MM=MONTH, DD=DAY, & H =HOUR, M =MINUTE, S =SCND ) - _VERIFY(STATUS) call ESMF_TimeSet (TIME, YY=YEAR, MM=MONTH, DD=DAY, & H =HOUR, M =MINUTE, S =SCND, & - RC=STATUS) - _VERIFY(STATUS) + _RC) end if _RETURN(ESMF_SUCCESS) @@ -1213,10 +1153,8 @@ module subroutine MAPL_SetFieldTimeFromField (FIELD, TIME, RC ) character(len=ESMF_MAXSTR) :: TIMESTAMP - call ESMF_TimeGet (TIME, timeString=TIMESTAMP, RC=STATUS) - _VERIFY(STATUS) - call ESMF_AttributeSet(FIELD, NAME="TimeStamp", VALUE=TIMESTAMP, RC=STATUS) - _VERIFY(STATUS) + call ESMF_TimeGet (TIME, timeString=TIMESTAMP, _RC) + call ESMF_AttributeSet(FIELD, NAME="TimeStamp", VALUE=TIMESTAMP, _RC) _RETURN(ESMF_SUCCESS) end subroutine MAPL_SetFieldTimeFromField @@ -1233,10 +1171,8 @@ module subroutine MAPL_GetFieldTimeFromState ( STATE, Fieldname, TIME, RC ) type(ESMF_FIELD) :: FIELD - call ESMF_StateGet (STATE, FIELDNAME, FIELD, RC=STATUS ) - _VERIFY(STATUS) - call MAPL_FieldGetTime (FIELD, TIME, RC=STATUS) - _VERIFY(STATUS) + call ESMF_StateGet (STATE, FIELDNAME, FIELD, _RC ) + call MAPL_FieldGetTime (FIELD, TIME, _RC) _RETURN(ESMF_SUCCESS) end subroutine MAPL_GetFieldTimeFromState @@ -1254,10 +1190,8 @@ module subroutine MAPL_SetFieldTimeFromState ( STATE, Fieldname, TIME, RC ) type(ESMF_FIELD) :: FIELD - call ESMF_StateGet (STATE, FIELDNAME, FIELD, RC=STATUS) - _VERIFY(STATUS) - call MAPL_FieldSetTime (FIELD, TIME, RC=STATUS) - _VERIFY(STATUS) + call ESMF_StateGet (STATE, FIELDNAME, FIELD, _RC) + call MAPL_FieldSetTime (FIELD, TIME, _RC) _RETURN(ESMF_SUCCESS) end subroutine MAPL_SetFieldTimeFromState @@ -1275,142 +1209,25 @@ module function MAPL_FieldCreateRename(FIELD, NAME, DoCopy, RC) RESULT(F) ! are the SAME as the one in the original Field, if DoCopy flag is present ! and set to true we create a new array and copy the data, not just reference it - type(ESMF_Grid) :: grid - character(len=ESMF_MAXSTR) :: fieldName - integer, allocatable :: gridToFieldMap(:) - integer :: gridRank - integer :: fieldRank integer :: status - integer :: unGridDims character(len=ESMF_MAXSTR), parameter :: Iam='MAPL_FieldCreateRename' - logical :: hasUngridDims - integer :: notGridded logical :: DoCopy_ type(ESMF_DataCopy_Flag):: datacopy - real, pointer :: var_1d(:) - real, pointer :: var_2d(:,:) - real, pointer :: var_3d(:,:,:) - real, pointer :: var_4d(:,:,:,:) - real(kind=REAL64), pointer :: vr8_1d(:) - real(kind=REAL64), pointer :: vr8_2d(:,:) - real(kind=REAL64), pointer :: vr8_3d(:,:,:) - real(kind=REAL64), pointer :: vr8_4d(:,:,:,:) - type(ESMF_TypeKind_Flag) :: tk DoCopy_ = .false. if (present(DoCopy) ) then DoCopy_ = DoCopy end if - call ESMF_FieldGet(FIELD, grid=GRID, dimCount=fieldRank, & - name=fieldName, RC=STATUS) - _VERIFY(STATUS) - call ESMF_GridGet(GRID, dimCount=gridRank, rc=status) - _VERIFY(STATUS) - allocate(gridToFieldMap(gridRank), stat=status) - _VERIFY(STATUS) - call ESMF_FieldGet(FIELD, gridToFieldMap=gridToFieldMap, typekind=tk, RC=STATUS) - _VERIFY(STATUS) - - hasUngridDims = .false. - notGridded = count(gridToFieldMap==0) - unGridDims = fieldRank - gridRank + notGridded - - if (unGridDims > 0) then - hasUngridDims = .true. - endif - if (doCopy_) then datacopy = ESMF_DATACOPY_VALUE else datacopy = ESMF_DATACOPY_REFERENCE end if - f = MAPL_FieldCreateEmpty(name=NAME, grid=grid, rc=status) - _VERIFY(STATUS) - - if (tk == ESMF_TypeKind_R4) then - select case (fieldRank) - case (1) - call ESMF_FieldGet(field, farrayPtr=var_1d, rc=status) - _VERIFY(STATUS) - call ESMF_FieldEmptyComplete(F, farrayPtr=VAR_1D, & - gridToFieldMap=gridToFieldMap, & - datacopyFlag = datacopy, & - rc = status) - _VERIFY(STATUS) - case (2) - call ESMF_FieldGet(field, farrayPtr=var_2d, rc=status) - _VERIFY(STATUS) - call ESMF_FieldEmptyComplete(F, farrayPtr=VAR_2D, & - gridToFieldMap=gridToFieldMap, & - datacopyFlag = datacopy, & - rc = status) - _VERIFY(STATUS) - case (3) - call ESMF_FieldGet(field, farrayPtr=var_3d, rc=status) - _VERIFY(STATUS) - call ESMF_FieldEmptyComplete(F, farrayPtr=VAR_3D, & - gridToFieldMap=gridToFieldMap, & - datacopyFlag = datacopy, & - rc = status) - _VERIFY(STATUS) - case (4) - call ESMF_FieldGet(field, farrayPtr=var_4d, rc=status) - _VERIFY(STATUS) - call ESMF_FieldEmptyComplete(F, farrayPtr=VAR_4D, & - gridToFieldMap=gridToFieldMap, & - datacopyFlag = datacopy, & - rc = status) - _VERIFY(STATUS) - case default - _FAIL( 'only upto 4D are supported') - end select - else if (tk == ESMF_TypeKind_R8) then - select case (fieldRank) - case (1) - call ESMF_FieldGet(field, farrayPtr=vr8_1d, rc=status) - _VERIFY(STATUS) - call ESMF_FieldEmptyComplete(F, farrayPtr=VR8_1D, & - gridToFieldMap=gridToFieldMap, & - datacopyFlag = datacopy, & - rc = status) - _VERIFY(STATUS) - case (2) - call ESMF_FieldGet(field, farrayPtr=vr8_2d, rc=status) - _VERIFY(STATUS) - call ESMF_FieldEmptyComplete(F, farrayPtr=VR8_2D, & - gridToFieldMap=gridToFieldMap, & - datacopyFlag = datacopy, & - rc = status) - _VERIFY(STATUS) - case (3) - call ESMF_FieldGet(field, farrayPtr=vr8_3d, rc=status) - _VERIFY(STATUS) - call ESMF_FieldEmptyComplete(F, farrayPtr=VR8_3D, & - gridToFieldMap=gridToFieldMap, & - datacopyFlag = datacopy, & - rc = status) - _VERIFY(STATUS) - case (4) - call ESMF_FieldGet(field, farrayPtr=vr8_4d, rc=status) - _VERIFY(STATUS) - call ESMF_FieldEmptyComplete(F, farrayPtr=VR8_4D, & - gridToFieldMap=gridToFieldMap, & - datacopyFlag = datacopy, & - rc = status) - _VERIFY(STATUS) - case default - _FAIL( 'only 2D and 3D are supported') - end select - else - _FAIL( 'unsupported typekind') - endif - - deallocate(gridToFieldMap) + f = ESMF_FieldCreate(field, datacopyflag=datacopy, name=NAME, _RC) - call MAPL_FieldCopyAttributes(FIELD_IN=field, FIELD_OUT=f, RC=status) - _VERIFY(STATUS) + call MAPL_FieldCopyAttributes(FIELD_IN=field, FIELD_OUT=f, _RC) _RETURN(ESMF_SUCCESS) end function MAPL_FieldCreateRename @@ -1453,43 +1270,32 @@ module function MAPL_FieldCreateNewgrid(FIELD, GRID, LM, NEWNAME, RC) RESULT(F) character(len=ESMF_MAXSTR) :: newName_ character(len=ESMF_MAXSTR), parameter :: Iam='MAPL_FieldCreateNewgrid' - call ESMF_FieldGet(FIELD, grid=fgrid, RC=STATUS) - _VERIFY(STATUS) + call ESMF_FieldGet(FIELD, grid=fgrid, _RC) - call ESMF_GridGet(fGRID, dimCount=fgridRank, rc=status) - _VERIFY(STATUS) - allocate(gridToFieldMap(fgridRank), stat=status) - _VERIFY(STATUS) + call ESMF_GridGet(fGRID, dimCount=fgridRank, _RC) + allocate(gridToFieldMap(fgridRank), _STAT) call ESMF_FieldGet(FIELD, Array=Array, name=name, & - gridToFieldMap=gridToFieldMap, RC=STATUS) - _VERIFY(STATUS) + gridToFieldMap=gridToFieldMap, _RC) griddedDims = fgridRank - count(gridToFieldMap == 0) - call ESMF_GridGet(GRID, dimCount=gridRank, rc=status) - _VERIFY(STATUS) + call ESMF_GridGet(GRID, dimCount=gridRank, _RC) - call ESMF_ArrayGet(array, rank=rank, rc=status) - _VERIFY(STATUS) + call ESMF_ArrayGet(array, rank=rank, _RC) ungriddedDims = rank - griddedDims - call MAPL_GridGet(GRID, localCellCountPerDim=COUNTS, RC=STATUS) - _VERIFY(STATUS) + call MAPL_GridGet(GRID, localCellCountPerDim=COUNTS, _RC) - call ESMF_ArrayGet(array, localDeCount=localDeCount, rc=status) - _VERIFY(STATUS) + call ESMF_ArrayGet(array, localDeCount=localDeCount, _RC) _ASSERT(localDeCount == 1, 'MAPL supports only 1 local array') - call ESMF_ArrayGet(array, localarrayList=larrayList, rc=status) - _VERIFY(STATUS) + call ESMF_ArrayGet(array, localarrayList=larrayList, _RC) larray => lArrayList(1) ! alias - call ESMF_LocalArrayGet(larray, totalLBound=lbnds, totalUBound=ubnds, rc=status) - _VERIFY(STATUS) + call ESMF_LocalArrayGet(larray, totalLBound=lbnds, totalUBound=ubnds, _RC) newRank = rank if (griddedDims == 1 .and. gridRank > 1) then deallocate(gridToFieldMap) - allocate(gridToFieldMap(gridRank), stat=status) - _VERIFY(STATUS) + allocate(gridToFieldMap(gridRank), _STAT) gridToFieldMap = 0 do I = 1, 2 gridToFieldMap(I) = I @@ -1506,8 +1312,7 @@ module function MAPL_FieldCreateNewgrid(FIELD, GRID, LM, NEWNAME, RC) RESULT(F) if (newRank == 2) then F = ESMF_FieldCreate(GRID, typekind=ESMF_TYPEKIND_R4, & indexflag=ESMF_INDEX_DELOCAL, & - name=newName_, gridToFieldMap=gridToFieldMap, RC=STATUS ) - _VERIFY(STATUS) + name=newName_, gridToFieldMap=gridToFieldMap, _RC ) DIMS = MAPL_DimsHorzOnly else if (newRank == 3) then @@ -1521,7 +1326,7 @@ module function MAPL_FieldCreateNewgrid(FIELD, GRID, LM, NEWNAME, RC) RESULT(F) F = ESMF_FieldCreate(GRID, typekind=ESMF_TYPEKIND_R4, & indexflag=ESMF_INDEX_DELOCAL, & name=newName_, gridToFieldMap=gridToFieldMap, & - ungriddedLBound=[lb],ungriddedUBound=[ub],RC=STATUS ) + ungriddedLBound=[lb],ungriddedUBound=[ub],_RC ) if (ungriddedDims > 0) then DIMS = MAPL_DimsHorzOnly else @@ -1532,7 +1337,7 @@ module function MAPL_FieldCreateNewgrid(FIELD, GRID, LM, NEWNAME, RC) RESULT(F) indexflag=ESMF_INDEX_DELOCAL, & name=newName_, gridToFieldMap=gridToFieldMap, & ungriddedLBound=[lbnds(griddedDims+1),lbnds(griddedDims+2)], & - ungriddedUBound=[ubnds(griddedDims+1),ubnds(griddedDims+2)],RC=STATUS ) + ungriddedUBound=[ubnds(griddedDims+1),ubnds(griddedDims+2)],_RC ) if (ungriddedDims > 0) then DIMS = MAPL_DimsHorzOnly else @@ -1544,12 +1349,10 @@ module function MAPL_FieldCreateNewgrid(FIELD, GRID, LM, NEWNAME, RC) RESULT(F) deallocate(gridToFieldMap) - call MAPL_FieldCopyAttributes(FIELD_IN=field, FIELD_OUT=f, RC=status) - _VERIFY(STATUS) + call MAPL_FieldCopyAttributes(FIELD_IN=field, FIELD_OUT=f, _RC) ! we are saving DIMS attribute in case the FIELD did not contain one ! otherwise we will overwrite it - call ESMF_AttributeSet(F, NAME='DIMS', VALUE=DIMS, RC=STATUS) - _VERIFY(STATUS) + call ESMF_AttributeSet(F, NAME='DIMS', VALUE=DIMS, _RC) _RETURN(ESMF_SUCCESS) end function MAPL_FieldCreateNewgrid @@ -1581,71 +1384,54 @@ module function MAPL_FieldCreateR4(FIELD, RC) RESULT(F) type(ESMF_TypeKind_Flag) :: tk call ESMF_FieldGet(FIELD, grid=GRID, dimCount=fieldRank, & - name=fieldName, typekind=tk, RC=STATUS) - _VERIFY(STATUS) + name=fieldName, typekind=tk, _RC) _ASSERT(tk == ESMF_TypeKind_R8, 'tk /= ESMF_TypeKind_R8') - call ESMF_GridGet(GRID, dimCount=gridRank, rc=status) - _VERIFY(STATUS) - allocate(gridToFieldMap(gridRank), stat=status) - _VERIFY(STATUS) - call ESMF_FieldGet(FIELD, gridToFieldMap=gridToFieldMap, RC=STATUS) - _VERIFY(STATUS) + call ESMF_GridGet(GRID, dimCount=gridRank, _RC) + allocate(gridToFieldMap(gridRank), _STAT) + call ESMF_FieldGet(FIELD, gridToFieldMap=gridToFieldMap, _RC) datacopy = ESMF_DATACOPY_REFERENCE select case (fieldRank) case (1) - call ESMF_FieldGet(field, farrayPtr=vr8_1d, rc=status) - _VERIFY(STATUS) - allocate(var_1d(lbound(vr8_1d,1):ubound(vr8_1d,1)), stat=status) - _VERIFY(STATUS) + call ESMF_FieldGet(field, farrayPtr=vr8_1d, _RC) + allocate(var_1d(lbound(vr8_1d,1):ubound(vr8_1d,1)), _STAT) var_1d=vr8_1d - f = MAPL_FieldCreateEmpty(name=fieldNAME, grid=grid, rc=status) - _VERIFY(STATUS) + f = MAPL_FieldCreateEmpty(name=fieldNAME, grid=grid, _RC) call ESMF_FieldEmptyComplete(F, farrayPtr=VAR_1D, & gridToFieldMap=gridToFieldMap, & datacopyFlag = datacopy, & - rc = status) - _VERIFY(STATUS) + _RC) case (2) - call ESMF_FieldGet(field, farrayPtr=vr8_2d, rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(field, farrayPtr=vr8_2d, _RC) allocate(var_2d(lbound(vr8_2d,1):ubound(vr8_2d,1), & lbound(vr8_2d,2):ubound(vr8_2d,2)), & - stat=status) - _VERIFY(STATUS) + _STAT) var_2d=vr8_2d - f = MAPL_FieldCreateEmpty(name=fieldNAME, grid=grid, rc=status) - _VERIFY(STATUS) + f = MAPL_FieldCreateEmpty(name=fieldNAME, grid=grid, _RC) call ESMF_FieldEmptyComplete(F, farrayPtr=VAR_2D, & gridToFieldMap=gridToFieldMap, & datacopyFlag = datacopy, & - rc = status) - _VERIFY(STATUS) + _RC) case (3) - call ESMF_FieldGet(field, farrayPtr=vr8_3d, rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(field, farrayPtr=vr8_3d, _RC) allocate(var_3d(lbound(vr8_3d,1):ubound(vr8_3d,1), & lbound(vr8_3d,2):ubound(vr8_3d,2), & lbound(vr8_3d,3):ubound(vr8_3d,3)), & - stat=status) - _VERIFY(STATUS) + _STAT) var_3d=vr8_3d - f = MAPL_FieldCreateEmpty(name=fieldNAME, grid=grid, rc=status) - _VERIFY(STATUS) + f = MAPL_FieldCreateEmpty(name=fieldNAME, grid=grid, _RC) call ESMF_FieldEmptyComplete(F, farrayPtr=VAR_3D, & gridToFieldMap=gridToFieldMap, & datacopyFlag = datacopy, & - rc = status) - _VERIFY(STATUS) + _RC) case default _FAIL( 'only 2D and 3D are supported') end select deallocate(gridToFieldMap) - call MAPL_FieldCopyAttributes(FIELD_IN=field, FIELD_OUT=f, RC=status) - _VERIFY(STATUS) + call MAPL_FieldCopyAttributes(FIELD_IN=field, FIELD_OUT=f, _RC) _RETURN(ESMF_SUCCESS) end function MAPL_FieldCreateR4 @@ -1659,14 +1445,12 @@ module function MAPL_FieldCreateEmpty(NAME, GRID, RC) RESULT(FIELD) character(len=ESMF_MAXSTR),parameter :: IAm=" MAPL_FieldCreateEmpty" integer :: STATUS - FIELD = ESMF_FieldEmptyCreate(name=name, rc=status) - _VERIFY(STATUS) + FIELD = ESMF_FieldEmptyCreate(name=name, _RC) call ESMF_FieldEmptySet(FIELD, & grid=GRID, & staggerloc = ESMF_STAGGERLOC_CENTER, & - rc = status) - _VERIFY(STATUS) + _RC) _RETURN(ESMF_SUCCESS) @@ -1678,8 +1462,7 @@ module subroutine MAPL_FieldCopyAttributes(FIELD_IN, FIELD_OUT, RC) integer, optional, intent( OUT) :: RC integer :: status - call ESMF_AttributeCopy(field_in, field_out, attcopy=ESMF_ATTCOPY_VALUE, rc=status) - _VERIFY(status) + call ESMF_AttributeCopy(field_in, field_out, attcopy=ESMF_ATTCOPY_VALUE, _RC) _RETURN(ESMF_SUCCESS) end subroutine MAPL_FieldCopyAttributes @@ -1705,40 +1488,30 @@ module subroutine MAPL_FieldCopy(from, to, RC) type(ESMF_TypeKind_Flag) :: tk call ESMF_FieldGet(from, dimCount=fieldRank, & - typekind=tk, RC=STATUS) - _VERIFY(STATUS) + typekind=tk, _RC) _ASSERT(tk == ESMF_TypeKind_R8, 'inconsistent typekind (should be ESMF_TypeKind_R8)') select case (fieldRank) case (1) - call ESMF_FieldGet(from, farrayPtr=vr8_1d, rc=status) - _VERIFY(STATUS) - call ESMF_FieldGet(to, dimCount=fieldRank, typekind=tk, RC=STATUS) - _VERIFY(STATUS) + call ESMF_FieldGet(from, farrayPtr=vr8_1d, _RC) + call ESMF_FieldGet(to, dimCount=fieldRank, typekind=tk, _RC) _ASSERT(tk == ESMF_TypeKind_R4, 'inconsistent typekind (should be ESMF_TypeKind_R4)') _ASSERT(fieldRank==1, 'inconsistent fieldrank (should be 1)') - call ESMF_FieldGet(to, farrayPtr=var_1d, rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(to, farrayPtr=var_1d, _RC) var_1d = vr8_1d case (2) - call ESMF_FieldGet(from, farrayPtr=vr8_2d, rc=status) - _VERIFY(STATUS) - call ESMF_FieldGet(to, dimCount=fieldRank, typekind=tk, RC=STATUS) - _VERIFY(STATUS) + call ESMF_FieldGet(from, farrayPtr=vr8_2d, _RC) + call ESMF_FieldGet(to, dimCount=fieldRank, typekind=tk, _RC) _ASSERT(tk == ESMF_TypeKind_R4, 'inconsistent typekind (should be ESMF_TypeKind_R4)') _ASSERT(fieldRank==2, 'inconsistent fieldRank (should be 2)') - call ESMF_FieldGet(to, farrayPtr=var_2d, rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(to, farrayPtr=var_2d, _RC) var_2d = vr8_2d case (3) - call ESMF_FieldGet(from, farrayPtr=vr8_3d, rc=status) - _VERIFY(STATUS) - call ESMF_FieldGet(to, dimCount=fieldRank, typekind=tk, RC=STATUS) - _VERIFY(STATUS) + call ESMF_FieldGet(from, farrayPtr=vr8_3d, _RC) + call ESMF_FieldGet(to, dimCount=fieldRank, typekind=tk, _RC) _ASSERT(tk == ESMF_TypeKind_R4, 'inconsistent typekind (should be ESMF_TypeKind_R4)') _ASSERT(fieldRank==3,'inconsistent fieldRank (should be 3)') - call ESMF_FieldGet(to, farrayPtr=var_3d, rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(to, farrayPtr=var_3d, _RC) var_3d = vr8_3d case default _FAIL( 'unsupported fieldRank (> 3)') @@ -1782,24 +1555,25 @@ module subroutine MAPL_GRID_INTERIOR(GRID,I1,IN,J1,JN) integer :: deId integer :: gridRank integer, allocatable :: localDeToDeMap(:) + integer :: rc i1=-1 j1=-1 in=-1 jn=-1 - call ESMF_GridGet (GRID, dimCount=gridRank, distGrid=distGrid, rc=STATUS) - call ESMF_DistGridGet(distGRID, delayout=layout, rc=STATUS) - call ESMF_DELayoutGet(layout, deCount = nDEs, localDeCount=localDeCount,rc=status) + call ESMF_GridGet (GRID, dimCount=gridRank, distGrid=distGrid, _RC) + call ESMF_DistGridGet(distGRID, delayout=layout, _RC) + call ESMF_DELayoutGet(layout, deCount = nDEs, localDeCount=localDeCount,_RC) if (localDeCount > 0) then - allocate(localDeToDeMap(localDeCount),stat=status) - call ESMF_DELayoutGet(layout, localDEtoDeMap=localDeToDeMap,rc=status) + allocate(localDeToDeMap(localDeCount),_STAT) + call ESMF_DELayoutGet(layout, localDEtoDeMap=localDeToDeMap,_RC) deId=localDeToDeMap(1) - allocate (AL(gridRank,0:nDEs-1), stat=status) - allocate (AU(gridRank,0:nDEs-1), stat=status) + allocate (AL(gridRank,0:nDEs-1), _STAT) + allocate (AU(gridRank,0:nDEs-1), _STAT) call MAPl_DistGridGet(distgrid, & - minIndex=AL, maxIndex=AU, rc=status) + minIndex=AL, maxIndex=AU, _RC) I1 = AL(1, deId) IN = AU(1, deId) @@ -1995,10 +1769,8 @@ module function MAPL_LatLonGridCreate (Name, vm, & if ( present(vm) ) then vm_ => vm else - allocate(vm_, stat=STATUS) - _VERIFY(STATUS) - call ESMF_VMGetCurrent(vm_, rc=STATUS) - _VERIFY(STATUS) + allocate(vm_, _STAT) + call ESMF_VMGetCurrent(vm_, _RC) end if ! Grid info via resources @@ -2008,17 +1780,13 @@ module function MAPL_LatLonGridCreate (Name, vm, & ! Either use supplied Config or load resource file ! ------------------------------------------------ if ( present(ConfigFile) ) then - allocate(Config_,stat=STATUS) - _VERIFY(STATUS) - Config_ = ESMF_ConfigCreate (rc=STATUS ) - _VERIFY(STATUS) - call ESMF_ConfigLoadFile (Config_, ConfigFile, rc=STATUS ) - _VERIFY(STATUS) + allocate(Config_,_STAT) + Config_ = ESMF_ConfigCreate (_RC ) + call ESMF_ConfigLoadFile (Config_, ConfigFile, _RC ) else if ( present(Config) ) then Config_ => Config else STATUS = 100 - _VERIFY(STATUS) end if ! Get relevant parameters from Config @@ -2052,7 +1820,6 @@ module function MAPL_LatLonGridCreate (Name, vm, & else STATUS = 300 - _VERIFY(STATUS) end if @@ -2060,7 +1827,6 @@ module function MAPL_LatLonGridCreate (Name, vm, & ! ------------ if ( IM_World_ < 1 .OR. JM_World_ < 1 ) then STATUS = 400 - _VERIFY(STATUS) end if if ( DelLon_ < 0.0 ) then ! convention for global grids if ( IM_World_ == 1 ) then @@ -2079,8 +1845,7 @@ module function MAPL_LatLonGridCreate (Name, vm, & ! Give the IMs, JMs and LMs the MAPL default distribution ! ------------------------------------------------------- - allocate( IMs(0:Nx_-1), JMs(0:Ny_-1), LMs(0:Nz_-1), stat=STATUS) - _VERIFY(STATUS) + allocate( IMs(0:Nx_-1), JMs(0:Ny_-1), LMs(0:Nz_-1), _STAT) call MAPL_DecomposeDim ( IM_World_, IMs, Nx_ ) call MAPL_DecomposeDim ( JM_World_, JMs, Ny_ ) call MAPL_DecomposeDim ( LM_World_, LMs, Nz_ ) @@ -2105,8 +1870,7 @@ module function MAPL_LatLonGridCreate (Name, vm, & coordDep3 = (/3/), & gridEdgeLWidth = (/0,0,0/), & gridEdgeUWidth = (/0,0,0/), & - rc=STATUS) - _VERIFY(STATUS) + _RC) #else Grid = ESMF_GridCreate( & name=Name, & @@ -2117,11 +1881,9 @@ module function MAPL_LatLonGridCreate (Name, vm, & gridEdgeUWidth = (/0,0/), & coordDep1 = (/1,2/), & coordDep2 = (/1,2/), & - rc=status) - _VERIFY(STATUS) + _RC) - call ESMF_AttributeSet(grid, name='GRID_LM', value=LM_World, rc=status) - _VERIFY(STATUS) + call ESMF_AttributeSet(grid, name='GRID_LM', value=LM_World, _RC) #endif @@ -2136,15 +1898,13 @@ module function MAPL_LatLonGridCreate (Name, vm, & coordDep2 = (/1,2/), & gridEdgeLWidth = (/0,0/), & gridEdgeUWidth = (/0,0/), & - rc=STATUS) - _VERIFY(STATUS) + _RC) ! Other possibilities not implemented yet ! --------------------------------------- else STATUS = 300 - _VERIFY(STATUS) endif @@ -2156,8 +1916,7 @@ module function MAPL_LatLonGridCreate (Name, vm, & ! Allocate coords at default stagger location ! ------------------------------------------- - call ESMF_GridAddCoord(Grid, rc=status) - _VERIFY(STATUS) + call ESMF_GridAddCoord(Grid, _RC) ! Compute the coordinates (the corner/center is for backward compatibility) ! ------------------------------------------------------------------------- @@ -2166,8 +1925,7 @@ module function MAPL_LatLonGridCreate (Name, vm, & minCoord(1) = MAPL_DEGREES_TO_RADIANS_R8 * BegLon_ - deltaX/2 minCoord(2) = MAPL_DEGREES_TO_RADIANS_R8 * BegLat_ - deltaY/2 - allocate(cornerX(IM_World_+1),cornerY(JM_World_+1), stat=STATUS) - _VERIFY(STATUS) + allocate(cornerX(IM_World_+1),cornerY(JM_World_+1), _STAT) cornerX(1) = minCoord(1) do i = 1,IM_World_ @@ -2183,13 +1941,11 @@ module function MAPL_LatLonGridCreate (Name, vm, & ! ------------------------------------------- call ESMF_GridGetCoord (Grid, coordDim=1, localDE=0, & staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=centerX, rc=status) - _VERIFY(STATUS) + farrayPtr=centerX, _RC) call ESMF_GridGetCoord (Grid, coordDim=2, localDE=0, & staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=centerY, rc=status) - _VERIFY(STATUS) + farrayPtr=centerY, _RC) FirstOut(1)=BegLon_ FirstOut(2)=-90. @@ -2221,8 +1977,7 @@ module function MAPL_LatLonGridCreate (Name, vm, & ! Make sure we've got it right ! ---------------------------- - call ESMF_GridValidate(Grid,rc=status) - _VERIFY(STATUS) + call ESMF_GridValidate(Grid,_RC) ! Clean up ! -------- @@ -2242,7 +1997,6 @@ subroutine parseConfig_() ! Internal routine to parse the ESMF_Config. ! STATUS = 200 ! not implemented yet - _VERIFY(STATUS) end subroutine parseConfig_ @@ -2267,32 +2021,25 @@ module subroutine MAPL_GridGetCorners(grid,gridCornerLons, gridCornerLats, RC) real(ESMF_KIND_R8), allocatable :: r8ptr(:),lons1d(:),lats1d(:) type(ESMF_CoordSys_Flag) :: coordSys - call MAPL_GridGet(grid,localCellCountPerDim=counts,rc=status) - _VERIFY(status) + call MAPL_GridGet(grid,localCellCountPerDim=counts,_RC) im=counts(1) jm=counts(2) ! check if we have corners call ESMF_AttributeGet(grid, NAME='GridCornerLons:', & - isPresent=hasLons, RC=STATUS) - _VERIFY(status) + isPresent=hasLons, _RC) call ESMF_AttributeGet(grid, NAME='GridCornerLats:', & - isPresent=hasLats, RC=STATUS) - _VERIFY(status) + isPresent=hasLats, _RC) if (hasLons .and. hasLats) then call ESMF_AttributeGet(grid, NAME='GridCornerLons:', & - itemcount=lsz, RC=STATUS) - _VERIFY(STATUS) + itemcount=lsz, _RC) _ASSERT(size(gridCornerLons,1)*size(gridCornerLons,2)==lsz,"stored corner sizes to not match grid") call ESMF_AttributeGet(grid, NAME='GridCornerLats:', & - itemcount=lsz, RC=STATUS) - _VERIFY(STATUS) + itemcount=lsz, _RC) _ASSERT(size(gridCornerLats,1)*size(gridCornerLats,2)==lsz,"stored corner sizes to not match grid") - allocate(r8ptr(lsz),stat=status) - _VERIFY(status) + allocate(r8ptr(lsz),_STAT) call ESMF_AttributeGet(grid, NAME='GridCornerLons:', & - VALUELIST=r8ptr, RC=STATUS) - _VERIFY(STATUS) + VALUELIST=r8ptr, _RC) idx = 0 do j = 1, size(gridCornerLons,2) @@ -2303,8 +2050,7 @@ module subroutine MAPL_GridGetCorners(grid,gridCornerLons, gridCornerLats, RC) end do call ESMF_AttributeGet(grid, NAME='GridCornerLats:', & - VALUELIST=r8ptr, RC=STATUS) - _VERIFY(STATUS) + VALUELIST=r8ptr, _RC) idx = 0 do j = 1, size(gridCornerLons,2) @@ -2317,47 +2063,36 @@ module subroutine MAPL_GridGetCorners(grid,gridCornerLons, gridCornerLats, RC) else call ESMF_GridGetCoord(grid,localDE=0,coordDim=1,staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=corner, rc=status) + farrayPtr=corner, _RC) imc=size(corner,1) jmc=size(corner,2) - allocate(ptr(0:imc+1,0:jmc+1),source=0.0d0,stat=status) - _VERIFY(status) - field = ESMF_FieldCreate(grid,ptr,staggerLoc=ESMF_STAGGERLOC_CORNER,totalLWidth=[1,1],totalUWidth=[1,1],rc=status) - _VERIFY(status) - call ESMF_FieldHaloStore(field,rh,rc=status) - _VERIFY(status) + allocate(ptr(0:imc+1,0:jmc+1),source=0.0d0,_STAT) + field = ESMF_FieldCreate(grid,ptr,staggerLoc=ESMF_STAGGERLOC_CORNER,totalLWidth=[1,1],totalUWidth=[1,1],_RC) + call ESMF_FieldHaloStore(field,rh,_RC) ptr(1:imc,1:jmc)=corner - call ESMF_FieldHalo(field,rh,rc=status) - _VERIFY(status) + call ESMF_FieldHalo(field,rh,_RC) gridCornerLons=ptr(1:im+1,1:jm+1) call ESMF_GridGetCoord(grid,localDE=0,coordDim=2,staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=corner, rc=status) - _VERIFY(status) + farrayPtr=corner, _RC) ptr(1:imc,1:jmc)=corner - call ESMF_FieldHalo(field,rh,rc=status) - _VERIFY(status) + call ESMF_FieldHalo(field,rh,_RC) gridCornerLats=ptr(1:im+1,1:jm+1) deallocate(ptr) - call ESMF_FieldDestroy(field,rc=status) - _VERIFY(status) - call ESMF_FieldHaloRelease(rh,rc=status) - _VERIFY(status) + call ESMF_FieldDestroy(field,_RC) + call ESMF_FieldHaloRelease(rh,_RC) - call ESMF_GridGet(grid,coordSys=coordSys,rc=status) - _VERIFY(status) + call ESMF_GridGet(grid,coordSys=coordSys,_RC) if (coordSys==ESMF_COORDSYS_SPH_DEG) then gridCornerLons=gridCornerLons*MAPL_DEGREES_TO_RADIANS_R8 gridCornerLats=gridCornerLats*MAPL_DEGREES_TO_RADIANS_R8 else if (coordSys==ESMF_COORDSYS_CART) then _FAIL('Unsupported coordinate system: ESMF_COORDSYS_CART') end if - allocate(lons1d(size(gridCornerLons,1)*size(gridCornerLons,2)),stat=status) - _VERIFY(status) - allocate(lats1d(size(gridCornerLons,1)*size(gridCornerLons,2)),stat=status) - _VERIFY(status) + allocate(lons1d(size(gridCornerLons,1)*size(gridCornerLons,2)),_STAT) + allocate(lats1d(size(gridCornerLons,1)*size(gridCornerLons,2)),_STAT) idx = 0 do j=1,size(gridCornerLons,2) do i=1,size(gridCornerLons,1) @@ -2367,11 +2102,9 @@ module subroutine MAPL_GridGetCorners(grid,gridCornerLons, gridCornerLats, RC) enddo enddo call ESMF_AttributeSet(grid, name='GridCornerLons:', & - itemCount = idx, valueList=lons1d, rc=status) - _VERIFY(STATUS) + itemCount = idx, valueList=lons1d, _RC) call ESMF_AttributeSet(grid, name='GridCornerLats:', & - itemCount = idx, valueList=lats1d, rc=status) - _VERIFY(STATUS) + itemCount = idx, valueList=lats1d, _RC) deallocate(lons1d,lats1d) end if @@ -2402,17 +2135,18 @@ module subroutine MAPL_GridGetInterior(GRID,I1,IN,J1,JN) integer :: nDEs integer :: deId integer :: gridRank + integer :: rc - call ESMF_GridGet (GRID, dimCount=gridRank, distGrid=distGrid, rc=STATUS) - call ESMF_DistGridGet(distGRID, delayout=layout, rc=STATUS) - call ESMF_DELayoutGet(layout, vm=vm, rc=status) - call ESMF_VmGet(vm, localPet=deId, petCount=nDEs, rc=status) + call ESMF_GridGet (GRID, dimCount=gridRank, distGrid=distGrid, _RC) + call ESMF_DistGridGet(distGRID, delayout=layout, _RC) + call ESMF_DELayoutGet(layout, vm=vm, _RC) + call ESMF_VmGet(vm, localPet=deId, petCount=nDEs, _RC) - allocate (AL(gridRank,0:nDEs-1), stat=status) - allocate (AU(gridRank,0:nDEs-1), stat=status) + allocate (AL(gridRank,0:nDEs-1), _STAT) + allocate (AU(gridRank,0:nDEs-1), _STAT) call MAPL_DistGridGet(distgrid, & - minIndex=AL, maxIndex=AU, rc=status) + minIndex=AL, maxIndex=AU, _RC) I1 = AL(1, deId) IN = AU(1, deId) @@ -2508,37 +2242,26 @@ recursive module subroutine MAPL_StateAttSetI4(STATE, NAME, VALUE, RC) integer :: ITEMCOUNT integer :: I - call ESMF_AttributeSet(STATE, NAME, VALUE, RC=status) - _VERIFY(STATUS) + call ESMF_AttributeSet(STATE, NAME, VALUE, _RC) - call ESMF_StateGet(STATE,ITEMCOUNT=ITEMCOUNT,RC=STATUS) - _VERIFY(STATUS) + call ESMF_StateGet(STATE,ITEMCOUNT=ITEMCOUNT,_RC) IF (ITEMCOUNT>0) then - allocate(ITEMNAMES(ITEMCOUNT),STAT=STATUS) - _VERIFY(STATUS) - allocate(ITEMTYPES(ITEMCOUNT),STAT=STATUS) - _VERIFY(STATUS) + allocate(ITEMNAMES(ITEMCOUNT),_STAT) + allocate(ITEMTYPES(ITEMCOUNT),_STAT) call ESMF_StateGet(STATE, ITEMNAMELIST=ITEMNAMES, & - ITEMTYPELIST=ITEMTYPES, RC=STATUS) - _VERIFY(STATUS) + ITEMTYPELIST=ITEMTYPES, _RC) do I = 1, ITEMCOUNT if(itemtypes(I)==ESMF_StateItem_State) then - call ESMF_StateGet(STATE, itemNames(I), nestedState, RC=STATUS) - _VERIFY(STATUS) - call MAPL_AttributeSet(nestedState, NAME, VALUE, RC=status) - _VERIFY(STATUS) + call ESMF_StateGet(STATE, itemNames(I), nestedState, _RC) + call MAPL_AttributeSet(nestedState, NAME, VALUE, _RC) else if(itemtypes(I)==ESMF_StateItem_FieldBundle) then - call ESMF_StateGet(STATE, itemNames(I), BUNDLE, RC=STATUS) - _VERIFY(STATUS) - call MAPL_AttributeSet(BUNDLE, NAME, VALUE, RC=status) - _VERIFY(STATUS) + call ESMF_StateGet(STATE, itemNames(I), BUNDLE, _RC) + call MAPL_AttributeSet(BUNDLE, NAME, VALUE, _RC) else if(itemtypes(I)==ESMF_StateItem_Field) then - call ESMF_StateGet(STATE, itemNames(I), FIELD, RC=STATUS) - _VERIFY(STATUS) - call MAPL_AttributeSet(FIELD, NAME, VALUE, RC=status) - _VERIFY(STATUS) + call ESMF_StateGet(STATE, itemNames(I), FIELD, _RC) + call MAPL_AttributeSet(FIELD, NAME, VALUE, _RC) end if end do @@ -2563,17 +2286,13 @@ module subroutine MAPL_BundleAttSetI4(BUNDLE, NAME, VALUE, RC) integer :: FIELDCOUNT integer :: I - call ESMF_AttributeSet(BUNDLE, NAME, VALUE, RC=status) - _VERIFY(STATUS) + call ESMF_AttributeSet(BUNDLE, NAME, VALUE, _RC) - call ESMF_FieldBundleGet(BUNDLE, FieldCount=FIELDCOUNT, RC=STATUS) - _VERIFY(STATUS) + call ESMF_FieldBundleGet(BUNDLE, FieldCount=FIELDCOUNT, _RC) do I = 1, FIELDCOUNT - call ESMF_FieldBundleGet(BUNDLE, I, FIELD, RC=STATUS) - _VERIFY(STATUS) - call ESMF_AttributeSet(FIELD, NAME, VALUE, RC=status) - _VERIFY(STATUS) + call ESMF_FieldBundleGet(BUNDLE, I, FIELD, _RC) + call ESMF_AttributeSet(FIELD, NAME, VALUE, _RC) end do _RETURN(ESMF_SUCCESS) @@ -2593,17 +2312,13 @@ module subroutine MAPL_FieldAttSetI4(FIELD, NAME, VALUE, RC) type(ESMF_FieldStatus_Flag) :: fieldStatus - call ESMF_AttributeSet(FIELD, NAME, VALUE, RC=status) - _VERIFY(STATUS) + call ESMF_AttributeSet(FIELD, NAME, VALUE, _RC) - call ESMF_FieldGet(field, status=fieldStatus, rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(field, status=fieldStatus, _RC) if(fieldStatus == ESMF_FIELDSTATUS_COMPLETE) then - call ESMF_FieldGet(field, Array=array, rc=status) - _VERIFY(STATUS) - call ESMF_AttributeSet(array, NAME, VALUE, RC=status) - _VERIFY(STATUS) + call ESMF_FieldGet(field, Array=array, _RC) + call ESMF_AttributeSet(array, NAME, VALUE, _RC) end if _RETURN(ESMF_SUCCESS) @@ -2623,17 +2338,13 @@ module subroutine MAPL_FieldBundleDestroy(Bundle,RC) integer :: STATUS - isCreated = ESMF_FieldBundleIsCreated(bundle,rc=status) - _VERIFY(STATUS) + isCreated = ESMF_FieldBundleIsCreated(bundle,_RC) if(isCreated) then - call ESMF_FieldBundleGet(BUNDLE, FieldCount=FIELDCOUNT, RC=STATUS) - _VERIFY(STATUS) + call ESMF_FieldBundleGet(BUNDLE, FieldCount=FIELDCOUNT, _RC) do I = 1, FIELDCOUNT - call ESMF_FieldBundleGet(BUNDLE, I, FIELD, RC=STATUS) - _VERIFY(STATUS) - call MAPL_FieldDestroy(FIELD, RC=status) - _VERIFY(STATUS) + call ESMF_FieldBundleGet(BUNDLE, I, FIELD, _RC) + call MAPL_FieldDestroy(FIELD, _RC) end do end if @@ -2661,49 +2372,40 @@ module subroutine MAPL_StateAddField(State, Field, RC) logical :: haveAttr fields(1) = field - call ESMF_StateAdd(state, fields, RC=status) - _VERIFY(STATUS) + call ESMF_StateAdd(state, fields, _RC) !================= !!!ALT Example to add one field at the time (not used anymore) !!! call ESMF_StateAdd(STATE, FIELD, proxyflag=.false., & -!!! addflag=.true., replaceflag=.false., RC=STATUS ) +!!! addflag=.true., replaceflag=.false., _RC ) !================= ! check for attribute - call ESMF_AttributeGet(state, NAME=attrName, isPresent=haveAttr, RC=STATUS) - _VERIFY(STATUS) + call ESMF_AttributeGet(state, NAME=attrName, isPresent=haveAttr, _RC) if (haveAttr) then - call ESMF_AttributeGet(state, NAME=attrName, itemcount=natt, RC=STATUS) - _VERIFY(STATUS) + call ESMF_AttributeGet(state, NAME=attrName, itemcount=natt, _RC) else natt = 0 end if - allocate(currList(natt), stat=status) - _VERIFY(STATUS) + allocate(currList(natt), _STAT) if (natt > 0) then ! get the current list - call ESMF_AttributeGet(state, NAME=attrName, VALUELIST=currList, rc=status) - _VERIFY(STATUS) + call ESMF_AttributeGet(state, NAME=attrName, VALUELIST=currList, _RC) !ALT delete/destroy this attribute to prevent memory leaks - call ESMF_AttributeRemove(state, NAME=attrName, rc=status) - _VERIFY(STATUS) + call ESMF_AttributeRemove(state, NAME=attrName, _RC) end if na = natt+1 - allocate(thisList(na), stat=status) - _VERIFY(STATUS) + allocate(thisList(na), _STAT) thisList(1:natt) = currList - call ESMF_FieldGet(field, name=name, rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(field, name=name, _RC) thisList(na) = name - call ESMF_AttributeSet(state, NAME=attrName, itemcount=na, VALUELIST=thisList, rc=status) - _VERIFY(STATUS) + call ESMF_AttributeSet(state, NAME=attrName, itemcount=na, VALUELIST=thisList, _RC) deallocate(thisList) deallocate(currList) @@ -2732,44 +2434,35 @@ module subroutine MAPL_StateAddBundle(State, Bundle, RC) logical :: haveAttr bundles(1) = bundle - call ESMF_StateAdd(state, Bundles, RC=status) - _VERIFY(STATUS) + call ESMF_StateAdd(state, Bundles, _RC) ! check for attribute - call ESMF_AttributeGet(state, NAME=attrName, isPresent=haveAttr, RC=STATUS) - _VERIFY(STATUS) + call ESMF_AttributeGet(state, NAME=attrName, isPresent=haveAttr, _RC) if (haveAttr) then - call ESMF_AttributeGet(state, NAME=attrName, itemcount=natt, RC=STATUS) - _VERIFY(STATUS) + call ESMF_AttributeGet(state, NAME=attrName, itemcount=natt, _RC) else natt = 0 end if - allocate(currList(natt), stat=status) - _VERIFY(STATUS) + allocate(currList(natt), _STAT) if (natt > 0) then ! get the current list - call ESMF_AttributeGet(state, NAME=attrName, VALUELIST=currList, rc=status) - _VERIFY(STATUS) + call ESMF_AttributeGet(state, NAME=attrName, VALUELIST=currList, _RC) !ALT delete/destroy this attribute to prevent memory leaks - call ESMF_AttributeRemove(state, NAME=attrName, rc=status) - _VERIFY(STATUS) + call ESMF_AttributeRemove(state, NAME=attrName, _RC) end if na = natt+1 - allocate(thisList(na), stat=status) - _VERIFY(STATUS) + allocate(thisList(na), _STAT) thisList(1:natt) = currList - call ESMF_FieldBundleGet(bundle, name=name, rc=status) - _VERIFY(STATUS) + call ESMF_FieldBundleGet(bundle, name=name, _RC) thisList(na) = name - call ESMF_AttributeSet(state, NAME=attrName, itemcount=na, VALUELIST=thisList, rc=status) - _VERIFY(STATUS) + call ESMF_AttributeSet(state, NAME=attrName, itemcount=na, VALUELIST=thisList, _RC) deallocate(thisList) deallocate(currList) @@ -2799,44 +2492,35 @@ module subroutine MAPL_FieldBundleAddField(Bundle, Field, multiflag, RC) fields(1) = field - call ESMF_FieldBundleAdd(Bundle, fields, multiflag=multiflag, RC=status) - _VERIFY(STATUS) + call ESMF_FieldBundleAdd(Bundle, fields, multiflag=multiflag, _RC) ! check for attribute - call ESMF_AttributeGet(Bundle, NAME=attrName, isPresent=haveAttr, RC=STATUS) - _VERIFY(STATUS) + call ESMF_AttributeGet(Bundle, NAME=attrName, isPresent=haveAttr, _RC) if (haveAttr) then - call ESMF_AttributeGet(Bundle, NAME=attrName, itemcount=natt, RC=STATUS) - _VERIFY(STATUS) + call ESMF_AttributeGet(Bundle, NAME=attrName, itemcount=natt, _RC) else natt = 0 end if - allocate(currList(natt), stat=status) - _VERIFY(STATUS) + allocate(currList(natt), _STAT) if (natt > 0) then ! get the current list - call ESMF_AttributeGet(Bundle, NAME=attrName, VALUELIST=currList, rc=status) - _VERIFY(STATUS) + call ESMF_AttributeGet(Bundle, NAME=attrName, VALUELIST=currList, _RC) !ALT delete/destroy this attribute to prevent memory leaks - call ESMF_AttributeRemove(bundle, NAME=attrName, rc=status) - _VERIFY(STATUS) + call ESMF_AttributeRemove(bundle, NAME=attrName, _RC) end if na = natt+1 - allocate(thisList(na), stat=status) - _VERIFY(STATUS) + allocate(thisList(na), _STAT) thisList(1:natt) = currList - call ESMF_FieldGet(field, name=name, rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(field, name=name, _RC) thisList(na) = name - call ESMF_AttributeSet(bundle, NAME=attrName, itemcount=na, VALUELIST=thisList, rc=status) - _VERIFY(STATUS) + call ESMF_AttributeSet(bundle, NAME=attrName, itemcount=na, VALUELIST=thisList, _RC) deallocate(thisList) deallocate(currList) @@ -2863,18 +2547,14 @@ module subroutine MAPL_FieldBundleGetByIndex(Bundle, fieldIndex, Field, RC) ! check for attribute - call ESMF_AttributeGet(Bundle, NAME=attrName, itemcount=natt, RC=STATUS) - _VERIFY(STATUS) - allocate(currList(natt), stat=status) - _VERIFY(STATUS) + call ESMF_AttributeGet(Bundle, NAME=attrName, itemcount=natt, _RC) + allocate(currList(natt), _STAT) ! get the current list - call ESMF_AttributeGet(Bundle, NAME=attrName, VALUELIST=currList, rc=status) - _VERIFY(STATUS) + call ESMF_AttributeGet(Bundle, NAME=attrName, VALUELIST=currList, _RC) name = currList(fieldIndex) - call ESMF_FieldBundleGet(Bundle, fieldName = name, field=field, rc=status) - _VERIFY(STATUS) + call ESMF_FieldBundleGet(Bundle, fieldName = name, field=field, _RC) deallocate(currList) @@ -2926,8 +2606,7 @@ module subroutine MAPL_GetHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, rc) ! pass in the the dimensions of the grid and we must compute them ! and assume search on the global domain if (present(Grid)) then - call MAPL_GridGet(grid, localCellCountPerDim=counts,globalCellCountPerDim=dims,rc=status) - _VERIFY(STATUS) + call MAPL_GridGet(grid, localCellCountPerDim=counts,globalCellCountPerDim=dims,_RC) IM_World = dims(1) JM_World = dims(2) IM = counts(1) @@ -2951,13 +2630,10 @@ module subroutine MAPL_GetHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, rc) call ESMF_AttributeGet(grid, name='GridType', value=grid_type, _RC) if(trim(grid_type) == "Cubed-Sphere") then call ESMF_GridGetCoord(grid,coordDim=1, localDe=0, & - staggerloc=ESMF_STAGGERLOC_CENTER, fArrayPtr = lons, rc=status) - _VERIFY(STATUS) + staggerloc=ESMF_STAGGERLOC_CENTER, fArrayPtr = lons, _RC) call ESMF_GridGetCoord(grid,coordDim=2, localDe=0, & - staggerloc=ESMF_STAGGERLOC_CENTER, fArrayPtr = lats, rc=status) - _VERIFY(STATUS) - call ESMF_GridGet(grid,coordSys=coordSys,rc=status) - _VERIFY(STATUS) + staggerloc=ESMF_STAGGERLOC_CENTER, fArrayPtr = lats, _RC) + call ESMF_GridGet(grid,coordSys=coordSys,_RC) allocate(corner_lons(im+1,jm+1)) allocate(corner_lats(im+1,jm+1)) allocate(center_lons(im,jm),center_lats(im,jm)) @@ -2971,11 +2647,10 @@ module subroutine MAPL_GetHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, rc) else if (coordSys==ESMF_COORDSYS_CART) then _FAIL('Unsupported coordinate system: ESMF_COORDSYS_CART') end if - call MAPL_GridGetCorners(Grid,corner_lons,corner_lats,rc=status) + call MAPL_GridGetCorners(Grid,corner_lons,corner_lats,_RC) ii=-1 jj=-1 - call get_points_in_spherical_domain(center_lons,center_lats,corner_lons,corner_lats,target_lons,target_lats,ii,jj,rc=status) - _VERIFY(status) + call get_points_in_spherical_domain(center_lons,center_lats,corner_lons,corner_lats,target_lons,target_lats,ii,jj,_RC) deallocate(corner_lons,corner_lats, center_lons,center_lats) else if (localSearch) then @@ -2986,12 +2661,9 @@ module subroutine MAPL_GetHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, rc) else _FAIL('if not isCubed, localSearch must be .true.') end if - allocate(elons(im+1),stat=status) - _VERIFY(STATUS) - allocate(elats(jm+1),stat=status) - _VERIFY(STATUS) - call ESMF_GridGet(grid,coordSys=coordSys,rc=status) - _VERIFY(STATUS) + allocate(elons(im+1),_STAT) + allocate(elats(jm+1),_STAT) + call ESMF_GridGet(grid,coordSys=coordSys,_RC) elons = lons(:,1) elats = lats(1,:) if (coordSys==ESMF_COORDSYS_SPH_DEG) then @@ -3106,8 +2778,7 @@ module subroutine MAPL_GetGlobalHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, if ( .not. present(grid)) then _ASSERT(.false., "need a cubed-sphere grid") endif - call MAPL_GridGet(grid, globalCellCountPerDim=dims,rc=status) - _VERIFY(STATUS) + call MAPL_GridGet(grid, globalCellCountPerDim=dims,_RC) IM_World = dims(1) JM_World = dims(2) _ASSERT( IM_WORLD*6 == JM_WORLD, "It only works for cubed-sphere grid") @@ -3210,7 +2881,7 @@ function grid_is_ok(grid) result(OK) type(ESMF_Grid), intent(inout) :: grid logical :: OK integer :: I1, I2, J1, J2, j - real(ESMF_KIND_R8), pointer :: corner_lons(:,:), corner_lats(:,:) + real(ESMF_KIND_R8), allocatable :: corner_lons(:,:), corner_lats(:,:) real(ESMF_KIND_R8) :: accurate_lat, accurate_lon real :: tolerance @@ -3218,11 +2889,9 @@ function grid_is_ok(grid) result(OK) call MAPL_GridGetInterior(grid,I1,I2,J1,J2) OK = .true. ! check the edge of face 1 along longitude - call ESMF_GridGetCoord(grid,localDE=0,coordDim=1,staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=corner_lons, rc=status) - call ESMF_GridGetCoord(grid,localDE=0,coordDim=2,staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=corner_lats, rc=status) - + allocate(corner_lons(I2-I1+2, J2-J1+2)) + allocate(corner_lats(I2-I1+2, J2-J1+2)) + call MAPL_GridGetCorners(Grid,corner_lons,corner_lats) if ( I1 ==1 .and. J2<=IM_WORLD ) then if (J1 == 1) then accurate_lon = 1.750d0*MAPL_PI_R8 - shift @@ -3235,7 +2904,7 @@ function grid_is_ok(grid) result(OK) endif endif - do j = J1+1, J2 + do j = J1, J2+1 accurate_lat = -alpha + (j-1)*dalpha if ( abs(accurate_lat - corner_lats(1,j-J1+1)) > 5.0*tolerance) then print*, "accurate_lat: ", accurate_lat @@ -3432,16 +3101,14 @@ module function MAPL_BundleCreate(name,grid,fieldNames,is2D,isEdge,long_names,un integer :: gridRank type(ESMF_Field) :: field - allocate(localIs2D(size(fieldNames)),stat=status) - _VERIFY(STATUS) + allocate(localIs2D(size(fieldNames)),_STAT) if (present(is2D)) then _ASSERT(size(fieldNames) == size(is2D),'inconsistent size of is2D array') localIs2D = is2D else localIs2D = .false. end if - allocate(localIsEdge(size(fieldNames)),stat=status) - _VERIFY(STATUS) + allocate(localIsEdge(size(fieldNames)),_STAT) if (present(isEdge)) then _ASSERT(size(fieldNames) == size(isEdge), 'inconsistent size of isEdge array') localIsEdge = isEdge @@ -3455,23 +3122,17 @@ module function MAPL_BundleCreate(name,grid,fieldNames,is2D,isEdge,long_names,un _ASSERT(size(fieldNames) == size(units), 'inconsistent size of units array') end if - B = ESMF_FieldBundleCreate ( name=name, rc=STATUS ) - _VERIFY(STATUS) - call ESMF_FieldBundleSet ( B, grid=GRID, rc=STATUS ) - _VERIFY(STATUS) + B = ESMF_FieldBundleCreate ( name=name, _RC ) + call ESMF_FieldBundleSet ( B, grid=GRID, _RC ) call MAPL_GridGet(GRID, globalCellCountPerDim=COUNTS, & - localCellCountPerDim=DIMS, RC=STATUS) - _VERIFY(STATUS) + localCellCountPerDim=DIMS, _RC) do i=1,size(fieldnames) if (localIs2D(i)) then - allocate(PTR2(DIMS(1),DIMS(2)),stat=STATUS) - _VERIFY(STATUS) + allocate(PTR2(DIMS(1),DIMS(2)),_STAT) PTR2 = 0.0 - call ESMF_GridGet(GRID, dimCount=gridRank, rc=status) - _VERIFY(STATUS) - allocate(gridToFieldMap(gridRank), stat=status) - _VERIFY(STATUS) + call ESMF_GridGet(GRID, dimCount=gridRank, _RC) + allocate(gridToFieldMap(gridRank), _STAT) if(gridRank == 2) then gridToFieldMap(1) = 1 gridToFieldMap(2) = 2 @@ -3485,53 +3146,40 @@ module function MAPL_BundleCreate(name,grid,fieldNames,is2D,isEdge,long_names,un FIELD = ESMF_FieldCreate(grid=GRID, & datacopyFlag = ESMF_DATACOPY_REFERENCE, & farrayPtr=PTR2, gridToFieldMap=gridToFieldMap, & - name=fieldNames(i), RC=STATUS) - _VERIFY(STATUS) + name=fieldNames(i), _RC) deallocate(gridToFieldMap) - call ESMF_AttributeSet(FIELD, NAME='DIMS', VALUE=MAPL_DimsHorzOnly, RC=STATUS) - _VERIFY(STATUS) - call ESMF_AttributeSet(FIELD, NAME='VLOCATION', VALUE=MAPL_VLocationNone, RC=STATUS) - _VERIFY(STATUS) + call ESMF_AttributeSet(FIELD, NAME='DIMS', VALUE=MAPL_DimsHorzOnly, _RC) + call ESMF_AttributeSet(FIELD, NAME='VLOCATION', VALUE=MAPL_VLocationNone, _RC) else if (localIsEdge(i)) then - allocate(PTR3(Dims(1),Dims(2),0:counts(3)),stat=status) - _VERIFY(STATUS) + allocate(PTR3(Dims(1),Dims(2),0:counts(3)),_STAT) else - allocate(PTR3(Dims(1),Dims(2),counts(3)),stat=status) - _VERIFY(STATUS) + allocate(PTR3(Dims(1),Dims(2),counts(3)),_STAT) end if PTR3 = 0.0 FIELD = ESMF_FieldCreate(grid=GRID, & datacopyFlag = ESMF_DATACOPY_REFERENCE, & - farrayPtr=PTR3, name=fieldNames(i), RC=STATUS) - call ESMF_AttributeSet(FIELD, NAME='DIMS', VALUE=MAPL_DimsHorzVert, RC=STATUS) - _VERIFY(STATUS) + farrayPtr=PTR3, name=fieldNames(i), _RC) + call ESMF_AttributeSet(FIELD, NAME='DIMS', VALUE=MAPL_DimsHorzVert, _RC) if (localIsEdge(i)) then - call ESMF_AttributeSet(FIELD, NAME='VLOCATION', VALUE=MAPL_VLocationEdge, RC=STATUS) - _VERIFY(STATUS) + call ESMF_AttributeSet(FIELD, NAME='VLOCATION', VALUE=MAPL_VLocationEdge, _RC) else - call ESMF_AttributeSet(FIELD, NAME='VLOCATION', VALUE=MAPL_VLocationCenter, RC=STATUS) - _VERIFY(STATUS) + call ESMF_AttributeSet(FIELD, NAME='VLOCATION', VALUE=MAPL_VLocationCenter, _RC) end if end if if (present(long_names)) then - call ESMF_AttributeSet(FIELD, NAME='LONG_NAME', VALUE=long_names(i), RC=STATUS) - _VERIFY(STATUS) + call ESMF_AttributeSet(FIELD, NAME='LONG_NAME', VALUE=long_names(i), _RC) else - call ESMF_AttributeSet(FIELD, NAME='LONG_NAME', VALUE="UNKNOWN", RC=STATUS) - _VERIFY(STATUS) + call ESMF_AttributeSet(FIELD, NAME='LONG_NAME', VALUE="UNKNOWN", _RC) end if if (present(units)) then - call ESMF_AttributeSet(FIELD, NAME='LONG_NAME', VALUE=units(i), RC=STATUS) - _VERIFY(STATUS) + call ESMF_AttributeSet(FIELD, NAME='LONG_NAME', VALUE=units(i), _RC) else - call ESMF_AttributeSet(FIELD, NAME='LONG_NAME', VALUE="UNKNOWN", RC=STATUS) - _VERIFY(STATUS) + call ESMF_AttributeSet(FIELD, NAME='LONG_NAME', VALUE="UNKNOWN", _RC) end if - call MAPL_FieldBundleAdd(B, FIELD, RC=STATUS) - _VERIFY(STATUS) + call MAPL_FieldBundleAdd(B, FIELD, _RC) enddo deallocate(localIs2D) @@ -3551,11 +3199,9 @@ module function MAPL_TrimString(istring,rc) result(ostring) strlen = len_trim(istring) if (istring(strlen:strlen)==char(0)) then - allocate(ostring,source=istring(1:strlen-1),stat=status) - _VERIFY(status) + allocate(ostring,source=istring(1:strlen-1),_STAT) else - allocate(ostring,source=istring(1:strlen),stat=status) - _VERIFY(status) + allocate(ostring,source=istring(1:strlen),_STAT) end if _RETURN(_SUCCESS) end function MAPL_TrimString @@ -3570,160 +3216,67 @@ module subroutine MAPL_FieldSplit(field, fields, aliasName, rc) integer :: status integer :: k, n integer :: k1,k2,kk - integer :: gridRank - logical :: has_ungrd integer :: ungrd_cnt integer :: fieldRank - integer, allocatable :: gridToFieldMap(:) integer, allocatable :: ungrd(:) - real, pointer :: ptr4d(:,:,:,:) => null() - real, pointer :: ptr3d(:,:,:) => null() - real, pointer :: ptr2d(:,:) => null() + integer, allocatable :: localMinIndex(:), localMaxIndex(:) type(ESMF_Field) :: f, fld - type(ESMF_Grid) :: grid - type(ESMF_TypeKind_Flag) :: tk character(len=ESMF_MAXSTR) :: name character(len=ESMF_MAXSTR) :: splitName character(len=ESMF_MAXSTR), allocatable :: splitNameArray(:) character(len=ESMF_MAXSTR) :: longName - ! get ptr - ! loop over 3-d or 4-d dim - ! create 2d or 3d field - ! put in state/bundle - ! end-of-loop - call ESMF_FieldGet(field, name=name, grid=grid, typekind=tk, rc=status) - _VERIFY(STATUS) - - call ESMF_GridGet(GRID, dimCount=gridRank, rc=status) - _VERIFY(STATUS) - allocate(gridToFieldMap(gridRank), stat=status) - _VERIFY(STATUS) - call ESMF_FieldGet(field, gridToFieldMap=gridToFieldMap, rc=status) - _VERIFY(STATUS) - - if (tk == ESMF_TYPEKIND_R4) then - call ESMF_FieldGet(FIELD, dimCount=fieldRank, rc=status) - _VERIFY(STATUS) - if (fieldRank == 4) then - - !ALT: assumes 1 DE per PET - call ESMF_FieldGet(Field,0,ptr4D,rc=status) - _VERIFY(STATUS) - n = size(ptr4d,4) - allocate(fields(n), stat=status) - _VERIFY(STATUS) - n = 0 - k1=lbound(ptr4d,4) - k2=ubound(ptr4d,4) - kk = k2-k1+1 - call genAlias(name, kk, splitNameArray, aliasName=aliasName,rc=status) - _VERIFY(STATUS) - - do k=k1,k2 - n = n+1 - ptr3d => ptr4d(:,:,:,k) - ! create a new field - splitName = splitNameArray(n) - f = MAPL_FieldCreateEmpty(name=splitName, grid=grid, rc=status) - _VERIFY(STATUS) - call ESMF_FieldEmptyComplete(F, farrayPtr=ptr3D, & - datacopyFlag = ESMF_DATACOPY_REFERENCE, & - gridToFieldMap=gridToFieldMap, & - rc = status) - _VERIFY(STATUS) - ! copy attributes and adjust as necessary - fld = field ! shallow copy to get around intent(in/out) - call MAPL_FieldCopyAttributes(FIELD_IN=fld, FIELD_OUT=f, RC=status) - _VERIFY(STATUS) - - ! adjust ungridded dims attribute (if any) - call ESMF_AttributeGet(FIELD, NAME='UNGRIDDED_DIMS', isPresent=has_ungrd, RC=STATUS) - _VERIFY(STATUS) - if (has_ungrd) then - call ESMF_AttributeGet(F, NAME='UNGRIDDED_DIMS', itemcount=UNGRD_CNT, RC=STATUS) - _VERIFY(STATUS) - allocate(ungrd(UNGRD_CNT), stat=status) - _VERIFY(STATUS) - call ESMF_AttributeGet(F, NAME='UNGRIDDED_DIMS', valueList=UNGRD, RC=STATUS) - _VERIFY(STATUS) - call ESMF_AttributeRemove(F, NAME='UNGRIDDED_DIMS', RC=STATUS) - _VERIFY(STATUS) - if (ungrd_cnt > 1) then - ungrd_cnt = ungrd_cnt - 1 - call ESMF_AttributeSet(F, NAME='UNGRIDDED_DIMS', & - valueList=UNGRD(1:ungrd_cnt), RC=STATUS) - _VERIFY(STATUS) - else - has_ungrd = .false. - end if - deallocate(ungrd) - end if + call ESMF_FieldGet(field, name=name, _RC) - fields(n) = f - end do - else if (fieldRank == 3) then - !ALT: assumes 1 DE per PET - call ESMF_FieldGet(Field,0,ptr3D,rc=status) - _VERIFY(STATUS) - n = size(ptr3d,3) - allocate(fields(n), stat=status) - _VERIFY(STATUS) - n = 0 - k1=lbound(ptr3d,3) - k2=ubound(ptr3d,3) - kk = k2-k1+1 - call genAlias(name, kk, splitNameArray, aliasName=aliasName,rc=status) - _VERIFY(STATUS) - do k=k1,k2 - n = n+1 - ptr2d => ptr3d(:,:,k) - ! create a new field - splitName = splitNameArray(n) - f = MAPL_FieldCreateEmpty(name=splitName, grid=grid, rc=status) - _VERIFY(STATUS) - call ESMF_FieldEmptyComplete(F, farrayPtr=ptr2D, & - datacopyFlag = ESMF_DATACOPY_REFERENCE, & - gridToFieldMap=gridToFieldMap, & - rc = status) - _VERIFY(STATUS) - ! copy attributes and adjust as necessary - fld = field ! shallow copy to get around intent(in/out) - call MAPL_FieldCopyAttributes(FIELD_IN=fld, FIELD_OUT=f, RC=status) - _VERIFY(STATUS) - - ! adjust ungridded dims attribute (if any) - call ESMF_AttributeGet(FIELD, NAME='UNGRIDDED_DIMS', isPresent=has_ungrd, RC=STATUS) - _VERIFY(STATUS) - if (has_ungrd) then - call ESMF_AttributeGet(F, NAME='UNGRIDDED_DIMS', itemcount=UNGRD_CNT, RC=STATUS) - _VERIFY(STATUS) - allocate(ungrd(UNGRD_CNT), stat=status) - _VERIFY(STATUS) - call ESMF_AttributeGet(F, NAME='UNGRIDDED_DIMS', valueList=UNGRD, RC=STATUS) - _VERIFY(STATUS) - call ESMF_AttributeRemove(F, NAME='UNGRIDDED_DIMS', RC=STATUS) - _VERIFY(STATUS) - if (ungrd_cnt > 1) then - ungrd_cnt = ungrd_cnt - 1 - call ESMF_AttributeSet(F, NAME='UNGRIDDED_DIMS', & - valueList=UNGRD(1:ungrd_cnt), RC=STATUS) - _VERIFY(STATUS) - else - has_ungrd = .false. - end if - deallocate(ungrd) - end if + call ESMF_FieldGet(FIELD, dimCount=fieldRank, _RC) - fields(n) = f - end do + allocate(localMinIndex(fieldRank),localMaxIndex(fieldRank), _STAT) + call ESMF_FieldGet(Field, & + localMinIndex=localMinIndex, localMaxIndex=localMaxIndex, _RC) + + k1 = localMinIndex(fieldRank) + k2 = localMaxIndex(fieldRank) + deallocate(localMinIndex,localMaxIndex) + + n = k2 - k1 + 1 + + allocate(fields(n), _STAT) + + call genAlias(name, n, splitNameArray, aliasName=aliasName,_RC) + + n = 0 + do k=k1,k2 + n = n+1 + splitName = splitNameArray(n) + f = ESMF_FieldCreate(field, & + datacopyflag=ESMF_DATACOPY_REFERENCE, & + trailingUngridSlice=[k], name=splitName, _RC) + + ! copy attributes and adjust as necessary + fld = field ! shallow copy to get around intent(in/out) + call MAPL_FieldCopyAttributes(FIELD_IN=fld, FIELD_OUT=f, _RC) + + ! adjust ungridded dims attribute (if any) + call ESMF_AttributeGet(FIELD, NAME='UNGRIDDED_DIMS', isPresent=has_ungrd, _RC) + if (has_ungrd) then + call ESMF_AttributeGet(F, NAME='UNGRIDDED_DIMS', itemcount=UNGRD_CNT, _RC) + allocate(ungrd(UNGRD_CNT), _STAT) + call ESMF_AttributeGet(F, NAME='UNGRIDDED_DIMS', valueList=UNGRD, _RC) + call ESMF_AttributeRemove(F, NAME='UNGRIDDED_DIMS', _RC) + if (ungrd_cnt > 1) then + ungrd_cnt = ungrd_cnt - 1 + call ESMF_AttributeSet(F, NAME='UNGRIDDED_DIMS', & + valueList=UNGRD(1:ungrd_cnt), _RC) + else + has_ungrd = .false. + end if + deallocate(ungrd) end if - else if (tk == ESMF_TYPEKIND_R8) then - _FAIL( "R8 overload not implemented yet") - end if - deallocate(gridToFieldMap) + fields(n) = f + end do + deallocate(splitNameArray) ! fields SHOULD be deallocated by the caller!!! @@ -3785,8 +3338,7 @@ subroutine genAlias(name, n, splitNameArray, aliasName, rc) aliasName_ = name end if - allocate(splitNameArray(n), stat=status) - _VERIFY(status) + allocate(splitNameArray(n), _STAT) ! parse the aliasName ! count the separators (";") in aliasName @@ -3836,8 +3388,7 @@ module function MAPL_GetCorrectedPhase(gc,rc) result(phase) integer :: status - call ESMF_GridCompGet(gc,currentPhase=phase,rc=status) - _VERIFY(status) + call ESMF_GridCompGet(gc,currentPhase=phase,_RC) if (phase>10) phase=phase-10 _RETURN(_SUCCESS) end function MAPL_GetCorrectedPhase diff --git a/gridcomps/Cap/MAPL_Cap.F90 b/gridcomps/Cap/MAPL_Cap.F90 index dbb2640df122..3b23c8a5c92d 100644 --- a/gridcomps/Cap/MAPL_Cap.F90 +++ b/gridcomps/Cap/MAPL_Cap.F90 @@ -435,21 +435,22 @@ subroutine initialize_mpi(this, unusable, rc) class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc - integer :: ierror + integer :: ierror, status integer :: provided integer :: npes_world _UNUSED_DUMMY(unusable) - call MPI_Initialized(this%mpi_already_initialized, ierror) - _VERIFY(ierror) + !call MPI_Initialized(this%mpi_already_initialized, ierror) + !_VERIFY(ierror) + call ESMF_InitializePreMPI(_RC) if (.not. this%mpi_already_initialized) then -!!$ call MPI_Init_thread(MPI_THREAD_MULTIPLE, provided, ierror) -!!$ _ASSERT(provided == MPI_THREAD_MULTIPLE, 'MPI_THREAD_MULTIPLE not supporte by this MPI.') - call MPI_Init_thread(MPI_THREAD_SINGLE, provided, ierror) - _VERIFY(ierror) - _ASSERT(provided == MPI_THREAD_SINGLE, "MPI_THREAD_SINGLE not supported by this MPI.") + call MPI_Init_thread(MPI_THREAD_MULTIPLE, provided, ierror) + _ASSERT(provided == MPI_THREAD_MULTIPLE, 'MPI_THREAD_MULTIPLE not supported by this MPI.') +! call MPI_Init_thread(MPI_THREAD_SINGLE, provided, ierror) +! _VERIFY(ierror) +! _ASSERT(provided == MPI_THREAD_SINGLE, "MPI_THREAD_SINGLE not supported by this MPI.") end if call MPI_Comm_rank(this%comm_world, this%rank, ierror); _VERIFY(ierror)