subroutine test_regridMeshToMeshCenter(rc)
integer, intent(out) :: rc
logical :: correct
integer :: localrc
type(ESMF_Mesh) :: dstMesh
type(ESMF_Mesh) :: srcMesh
type(ESMF_Field) :: srcField
type(ESMF_Field) :: dstField
type(ESMF_Field) :: xdstField
type(ESMF_Array) :: dstArray
type(ESMF_Array) :: lonArrayA
type(ESMF_Array) :: srcArrayA
type(ESMF_RouteHandle) :: routeHandle
type(ESMF_ArraySpec) :: arrayspec
type(ESMF_VM) :: vm
real(ESMF_KIND_R8), pointer :: farrayPtr1D(:)
real(ESMF_KIND_R8), pointer :: xfarrayPtr1D(:)
integer :: i1,i2,i3, index(2)
integer :: lDE, localDECount
real(ESMF_KIND_R8) :: relErr
character(len=ESMF_MAXSTR) :: string
real(ESMF_KIND_R8) :: dx,dy
real(ESMF_KIND_R8) :: x,y
integer :: spherical_grid
integer, pointer :: larrayList(:)
integer :: localPet, petCount
integer, pointer :: nodeIds(:),nodeOwners(:)
real(ESMF_KIND_R8), pointer :: nodeCoords(:)
real(ESMF_KIND_R8), pointer :: elemCoords(:)
integer, pointer :: elemIds(:),elemTypes(:),elemConn(:)
integer, pointer :: elemMasks(:)
integer :: numNodes, numElems
integer :: numElemConns, numTriElems, numQuadElems
! result code
integer :: finalrc
! init success flag
correct=.true.
rc=ESMF_SUCCESS
! get pet info
call ESMF_VMGetGlobal(vm, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_VMGet(vm, petCount=petCount, localPet=localpet, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! If we don't have 1 or 4 PETS then exit successfully
if ((petCount .ne. 1) .and. (petCount .ne. 4)) then
print*,'ERROR: test must be run using exactly 1 or 4 PETS - detected ',petCount
rc=ESMF_FAILURE
return
endif
!!!! Create Src Mesh !!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Creates the following mesh on
! 1 or 4 PETs. Returns an error
! if run on other than 1 or 4 PETs
!
! Mesh Ids
!
! 3.0 13 ------ 14 ------- 15 ------- 16
! | | | 10 / |
! | 7 | 8 | / |
! | | | / 9 |
! 2.0 9 ------- 10 ------- 11 ------- 12
! | | | |
! | 4 | 5 | 6 |
! | | | |
! 1.0 5 ------- 6 -------- 7 -------- 8
! | | | |
! | 1 | 2 | 3 |
! | | | |
! 0.0 1 ------- 2 -------- 3 -------- 4
!
! 0.0 1.0 2.0 3.0
!
! Node Ids at corners
! Element Ids in centers
!
!!!!!
!
! The owners for 1 PET are all Pet 0.
! The owners for 4 PETs are as follows:
!
! Mesh Owners
!
! 3.0 2 ------- 2 -------- 3 -------- 3
! | | | 3 / |
! | 2 | 2 | / |
! | | | / 3 |
! 2.0 2 ------- 2 -------- 3 -------- 3
! | | | |
! | 2 | 2 | 3 |
! | | | |
! 1.0 0 ------- 0 -------- 1 -------- 1
! | | | |
! | 0 | 1 | 1 |
! | | | |
! 0.0 0 ------- 0 -------- 1 -------- 1
!
! 0.0 1.0 2.0 3.0
!
! Node Owners at corners
! Element Owners in centers
!
! Setup mesh info depending on the
! number of PETs
if (petCount .eq. 1) then
! Fill in node data
numNodes=16
!! node ids
allocate(nodeIds(numNodes))
nodeIds=(/1,2,3,4,5,6,7,8, &
9,10,11,12,13,14,&
15,16/)
!! node Coords
allocate(nodeCoords(numNodes*2))
nodeCoords=(/0.0,0.0, & ! 1
1.0,0.0, & ! 2
2.0,0.0, & ! 3
3.0,0.0, & ! 4
0.0,1.0, & ! 5
1.0,1.0, & ! 6
2.0,1.0, & ! 7
3.0,1.0, & ! 8
0.0,2.0, & ! 9
1.0,2.0, & ! 10
2.0,2.0, & ! 11
3.0,2.0, & ! 12
0.0,3.0, & ! 13
1.0,3.0, & ! 14
2.0,3.0, & ! 15
3.0,3.0 /) ! 16
!! node owners
allocate(nodeOwners(numNodes))
nodeOwners=0 ! everything on proc 0
! Fill in elem data
numTriElems=2
numQuadElems=8
numElems=numTriElems+numQuadElems
numElemConns=3*numTriElems+4*numQuadElems
!! elem ids
allocate(elemIds(numElems))
elemIds=(/1,2,3,4,5,6,7,8,9,10/)
!! Masking
allocate(elemMasks(numElems))
elemMasks=(/1,0,0,0,0,0,0,0,0,0/)
!! elem types
allocate(elemTypes(numElems))
elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 1
ESMF_MESHELEMTYPE_QUAD, & ! 2
ESMF_MESHELEMTYPE_QUAD, & ! 3
ESMF_MESHELEMTYPE_QUAD, & ! 4
ESMF_MESHELEMTYPE_QUAD, & ! 5
ESMF_MESHELEMTYPE_QUAD, & ! 6
ESMF_MESHELEMTYPE_QUAD, & ! 7
ESMF_MESHELEMTYPE_QUAD, & ! 8
ESMF_MESHELEMTYPE_TRI, & ! 9
ESMF_MESHELEMTYPE_TRI/) ! 10
!! elem coords
allocate(elemCoords(2*numElems))
elemCoords=(/0.5,0.5, & ! 1
1.5,0.5, & ! 2
2.5,0.5, & ! 3
0.5,1.5, & ! 4
1.5,1.5, & ! 5
2.5,1.5, & ! 6
0.5,2.5, & ! 7
1.5,2.5, & ! 8
2.75,2.25,& ! 9
2.25,2.75/) ! 10
!! elem conn
allocate(elemConn(numElemConns))
elemConn=(/1,2,6,5, & ! 1
2,3,7,6, & ! 2
3,4,8,7, & ! 3
5,6,10,9, & ! 4
6,7,11,10, & ! 5
7,8,12,11, & ! 6
9,10,14,13, & ! 7
10,11,15,14, & ! 8
11,12,16, & ! 9
11,16,15/) ! 10
else if (petCount .eq. 4) then
! Setup mesh data depending on PET
if (localPet .eq. 0) then
! Fill in node data
numNodes=4
!! node ids
allocate(nodeIds(numNodes))
nodeIds=(/1,2,5,6/)
!! node Coords
allocate(nodeCoords(numNodes*2))
nodeCoords=(/0.0,0.0, & ! 1
1.0,0.0, & ! 2
0.0,1.0, & ! 5
1.0,1.0 /) ! 6
!! node owners
allocate(nodeOwners(numNodes))
nodeOwners=0 ! everything on proc 0
! Fill in elem data
numTriElems=0
numQuadElems=1
numElems=numTriElems+numQuadElems
numElemConns=3*numTriElems+4*numQuadElems
!! elem ids
allocate(elemIds(numElems))
elemIds=(/1/)
!! elem masking
allocate(elemMasks(numElems))
elemMasks=(/1/)
!! elem types
allocate(elemTypes(numElems))
elemTypes=(/ESMF_MESHELEMTYPE_QUAD/) ! 1
!! elem coords
allocate(elemCoords(2*numElems))
elemCoords=(/0.5,0.5/) ! 1
!! elem conn
allocate(elemConn(numElemConns))
elemConn=(/1,2,4,3/) ! 1
else if (localPet .eq. 1) then
! Fill in node data
numNodes=6
!! node ids
allocate(nodeIds(numNodes))
nodeIds=(/2,3,4,6,7,8/)
!! node Coords
allocate(nodeCoords(numNodes*2))
nodeCoords=(/1.0,0.0, & ! 2
2.0,0.0, & ! 3
3.0,0.0, & ! 4
1.0,1.0, & ! 6
2.0,1.0, & ! 7
3.0,1.0 /) ! 8
!! node owners
allocate(nodeOwners(numNodes))
nodeOwners=(/0, & ! 2
1, & ! 3
1, & ! 4
0, & ! 6
1, & ! 7
1/) ! 8
! Fill in elem data
numTriElems=0
numQuadElems=2
numElems=numTriElems+numQuadElems
numElemConns=3*numTriElems+4*numQuadElems
!! elem ids
allocate(elemIds(numElems))
elemIds=(/2,3/)
!! elem Masks
allocate(elemMasks(numElems))
elemMasks=(/0,0/)
!! elem types
allocate(elemTypes(numElems))
elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 2
ESMF_MESHELEMTYPE_QUAD/) ! 3
!! elem coords
allocate(elemCoords(2*numElems))
elemCoords=(/1.5,0.5, & ! 2
2.5,0.5/) ! 3
!! elem conn
allocate(elemConn(numElemConns))
elemConn=(/1,2,5,4, & ! 2
2,3,6,5/) ! 3
else if (localPet .eq. 2) then
! Fill in node data
numNodes=9
!! node ids
allocate(nodeIds(numNodes))
nodeIds=(/5,6,7, &
9,10,11, &
13,14,15/)
!! node Coords
allocate(nodeCoords(numNodes*2))
nodeCoords=(/0.0,1.0, & ! 5
1.0,1.0, & ! 6
2.0,1.0, & ! 7
0.0,2.0, & ! 9
1.0,2.0, & ! 10
2.0,2.0, & ! 11
0.0,3.0, & ! 13
1.0,3.0, & ! 14
2.0,3.0/) ! 15
!! node owners
allocate(nodeOwners(numNodes))
nodeOwners=(/0, & ! 5
0, & ! 6
1, & ! 7
2, & ! 9
2, & ! 10
3, & ! 11
2, & ! 13
2, & ! 14
3/) ! 15
! Fill in elem data
numTriElems=0
numQuadElems=4
numElems=numTriElems+numQuadElems
numElemConns=3*numTriElems+4*numQuadElems
!! elem ids
allocate(elemIds(numElems))
elemIds=(/4,5,7,8/)
!! elem masks
allocate(elemMasks(numElems))
elemMasks=(/0,0,0,0/)
!! elem types
allocate(elemTypes(numElems))
elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 4
ESMF_MESHELEMTYPE_QUAD, & ! 5
ESMF_MESHELEMTYPE_QUAD, & ! 7
ESMF_MESHELEMTYPE_QUAD/) ! 8
!! elem coords
allocate(elemCoords(2*numElems))
elemCoords=(/0.5,1.5, & ! 4
1.5,1.5, & ! 5
0.5,2.5, & ! 7
1.5,2.5/) ! 8
!! elem conn
allocate(elemConn(numElemConns))
elemConn=(/1,2,5,4, & ! 4
2,3,6,5, & ! 5
4,5,8,7, & ! 7
5,6,9,8/) ! 8
else if (localPet .eq. 3) then
! Fill in node data
numNodes=6
!! node ids
allocate(nodeIds(numNodes))
nodeIds=(/7,8,11,12,15,16/)
!! node Coords
allocate(nodeCoords(numNodes*2))
nodeCoords=(/2.0,1.0, & ! 7
3.0,1.0, & ! 8
2.0,2.0, & ! 11
3.0,2.0, & ! 12
2.0,3.0, & ! 15
3.0,3.0 /) ! 16
!! node owners
allocate(nodeOwners(numNodes))
nodeOwners=(/1, & ! 7
1, & ! 8
3, & ! 11
3, & ! 12
3, & ! 15
3/) ! 16
! Fill in elem data
numTriElems=2
numQuadElems=1
numElems=numTriElems+numQuadElems
numElemConns=3*numTriElems+4*numQuadElems
!! elem ids
allocate(elemIds(numElems))
elemIds=(/6,9,10/)
!! elem Masks
allocate(elemMasks(numElems))
elemMasks=(/0,0,0/)
!! elem types
allocate(elemTypes(numElems))
elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 6
ESMF_MESHELEMTYPE_TRI, & ! 9
ESMF_MESHELEMTYPE_TRI/) ! 10
!! elem coords
allocate(elemCoords(2*numElems))
elemCoords=(/2.5,1.5, & ! 6
2.75,2.25,& ! 9
2.25,2.75/) ! 10
!! elem conn
allocate(elemConn(numElemConns))
elemConn=(/1,2,4,3, & ! 6
3,4,6, & ! 9
3,6,5/) ! 10
endif
endif
! Create Mesh structure in 1 step
srcMesh=ESMF_MeshCreate(parametricDim=2,spatialDim=2, &
coordSys=ESMF_COORDSYS_CART, &
nodeIds=nodeIds, nodeCoords=nodeCoords, &
nodeOwners=nodeOwners, elementIds=elemIds,&
elementTypes=elemTypes, elementConn=elemConn, &
elementCoords=elemCoords, elementMask=elemMasks, &
rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
! Create source field
call ESMF_ArraySpecSet(arrayspec, 1, ESMF_TYPEKIND_R8, rc=rc)
srcField = ESMF_FieldCreate(srcMesh, arrayspec, meshloc=ESMF_MESHLOC_ELEMENT, &
name="source", rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
! Load test data into the source Field
! Should only be 1 localDE
call ESMF_FieldGet(srcField, 0, farrayPtr1D, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
! set interpolated function
do i1=1,numElems
! Get coordinates
x=elemCoords(2*i1-1)
y=elemCoords(2*i1)
! Set source function
farrayPtr1D(i1) = 20.0+x+y
!write(*,*) localPet,":: Src=",farrayPtr1D(i1)
! if masked make a bad value
if (elemMasks(i1) .eq. 1) then
farrayPtr1D(i1) = 10000.0
endif
enddo
! deallocate node data
deallocate(nodeIds)
deallocate(nodeCoords)
deallocate(nodeOwners)
! deallocate elem data
deallocate(elemIds)
deallocate(elemTypes)
deallocate(elemCoords)
deallocate(elemMasks)
deallocate(elemConn)
!!!! Create Dest Mesh !!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Creates the following mesh on
! 1 or 4 PETs. Returns an error
! if run on other than 1 or 4 PETs
!
! Mesh Ids
!
! 3.0 13 ------ 14 ------- 15 ------- 16
! | | | 10 / |
! 2.5 | 7 | 8 | / |
! | | | / 9 |
! 2.0 9 ------- 10 ------- 11 ------- 12
! | | | |
! 1.5 | 4 | 5 | 6 |
! | | | |
! 1.0 5 ------- 6 -------- 7 -------- 8
! | | | |
! 0.5 | 1 | 2 | 3 |
! | | | |
! 0.0 1 ------- 2 -------- 3 -------- 4
!
! 0.0 0.5 1.0 1.5 2.0 2.5 3.0
!
! Node Ids at corners
! Element Ids in centers
!
!!!!!
!
! The owners for 1 PET are all Pet 0.
! The owners for 4 PETs are as follows:
!
! Mesh Owners
!
! 3.0 2 ------- 2 -------- 3 -------- 3
! | | | 3 / |
! | 2 | 2 | / |
! | | | / 3 |
! 2.0 2 ------- 2 -------- 3 -------- 3
! | | | |
! | 2 | 2 | 3 |
! | | | |
! 1.0 0 ------- 0 -------- 1 -------- 1
! | | | |
! | 0 | 1 | 1 |
! | | | |
! 0.0 0 ------- 0 -------- 1 -------- 1
!
! 0.0 1.0 2.0 3.0
!
! Node Owners at corners
! Element Owners in centers
!
! Setup mesh info depending on the
! number of PETs
if (petCount .eq. 1) then
! Fill in node data
numNodes=16
!! node ids
allocate(nodeIds(numNodes))
nodeIds=(/1,2,3,4,5,6,7,8, &
9,10,11,12,13,14,&
15,16/)
!! node Coords
allocate(nodeCoords(numNodes*2))
nodeCoords=(/0.0,0.0, & ! 1
1.0,0.0, & ! 2
2.0,0.0, & ! 3
3.0,0.0, & ! 4
0.0,1.0, & ! 5
1.0,1.0, & ! 6
2.0,1.0, & ! 7
3.0,1.0, & ! 8
0.0,2.0, & ! 9
1.0,2.0, & ! 10
2.0,2.0, & ! 11
3.0,2.0, & ! 12
0.0,3.0, & ! 13
1.0,3.0, & ! 14
2.0,3.0, & ! 15
3.0,3.0 /) ! 16
!! node owners
allocate(nodeOwners(numNodes))
nodeOwners=0 ! everything on proc 0
! Fill in elem data
numTriElems=2
numQuadElems=8
numElems=numTriElems+numQuadElems
numElemConns=3*numTriElems+4*numQuadElems
!! elem ids
allocate(elemIds(numElems))
elemIds=(/1,2,3,4,5,6,7,8,9,10/)
!! Masking
allocate(elemMasks(numElems))
elemMasks=(/1,0,0,0,0,0,0,0,0,0/)
!! elem types
allocate(elemTypes(numElems))
elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 1
ESMF_MESHELEMTYPE_QUAD, & ! 2
ESMF_MESHELEMTYPE_QUAD, & ! 3
ESMF_MESHELEMTYPE_QUAD, & ! 4
ESMF_MESHELEMTYPE_QUAD, & ! 5
ESMF_MESHELEMTYPE_QUAD, & ! 6
ESMF_MESHELEMTYPE_QUAD, & ! 7
ESMF_MESHELEMTYPE_QUAD, & ! 8
ESMF_MESHELEMTYPE_TRI, & ! 9
ESMF_MESHELEMTYPE_TRI/) ! 10
!! elem coords
allocate(elemCoords(2*numElems))
elemCoords=(/0.5,0.5, & ! 1
1.5,0.5, & ! 2
2.5,0.5, & ! 3
0.5,1.5, & ! 4
1.5,1.5, & ! 5
2.5,1.5, & ! 6
0.5,2.5, & ! 7
1.5,2.5, & ! 8
2.75,2.25,& ! 9
2.25,2.75/) ! 10
!! elem conn
allocate(elemConn(numElemConns))
elemConn=(/1,2,6,5, & ! 1
2,3,7,6, & ! 2
3,4,8,7, & ! 3
5,6,10,9, & ! 4
6,7,11,10, & ! 5
7,8,12,11, & ! 6
9,10,14,13, & ! 7
10,11,15,14, & ! 8
11,12,16, & ! 9
11,16,15/) ! 10
else if (petCount .eq. 4) then
! Setup mesh data depending on PET
if (localPet .eq. 0) then
! Fill in node data
numNodes=4
!! node ids
allocate(nodeIds(numNodes))
nodeIds=(/1,2,5,6/)
!! node Coords
allocate(nodeCoords(numNodes*2))
nodeCoords=(/0.0,0.0, & ! 1
1.0,0.0, & ! 2
0.0,1.0, & ! 5
1.0,1.0 /) ! 6
!! node owners
allocate(nodeOwners(numNodes))
nodeOwners=0 ! everything on proc 0
! Fill in elem data
numTriElems=0
numQuadElems=1
numElems=numTriElems+numQuadElems
numElemConns=3*numTriElems+4*numQuadElems
!! elem ids
allocate(elemIds(numElems))
elemIds=(/1/)
!! elem masks
allocate(elemMasks(numElems))
elemMasks=(/1/)
!! elem types
allocate(elemTypes(numElems))
elemTypes=(/ESMF_MESHELEMTYPE_QUAD/) ! 1
!! elem coords
allocate(elemCoords(2*numElems))
elemCoords=(/0.5,0.5/) ! 1
!! elem conn
allocate(elemConn(numElemConns))
elemConn=(/1,2,4,3/) ! 1
else if (localPet .eq. 1) then
! Fill in node data
numNodes=6
!! node ids
allocate(nodeIds(numNodes))
nodeIds=(/2,3,4,6,7,8/)
!! node Coords
allocate(nodeCoords(numNodes*2))
nodeCoords=(/1.0,0.0, & ! 2
2.0,0.0, & ! 3
3.0,0.0, & ! 4
1.0,1.0, & ! 6
2.0,1.0, & ! 7
3.0,1.0 /) ! 8
!! node owners
allocate(nodeOwners(numNodes))
nodeOwners=(/0, & ! 2
1, & ! 3
1, & ! 4
0, & ! 6
1, & ! 7
1/) ! 8
! Fill in elem data
numTriElems=0
numQuadElems=2
numElems=numTriElems+numQuadElems
numElemConns=3*numTriElems+4*numQuadElems
!! elem ids
allocate(elemIds(numElems))
elemIds=(/2,3/)
!! elem masking
allocate(elemMasks(numElems))
elemMasks=(/0,0/)
!! elem types
allocate(elemTypes(numElems))
elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 2
ESMF_MESHELEMTYPE_QUAD/) ! 3
!! elem coords
allocate(elemCoords(2*numElems))
elemCoords=(/1.5,0.5, & ! 2
2.5,0.5/) ! 3
!! elem conn
allocate(elemConn(numElemConns))
elemConn=(/1,2,5,4, & ! 2
2,3,6,5/) ! 3
else if (localPet .eq. 2) then
! Fill in node data
numNodes=9
!! node ids
allocate(nodeIds(numNodes))
nodeIds=(/5,6,7, &
9,10,11, &
13,14,15/)
!! node Coords
allocate(nodeCoords(numNodes*2))
nodeCoords=(/0.0,1.0, & ! 5
1.0,1.0, & ! 6
2.0,1.0, & ! 7
0.0,2.0, & ! 9
1.0,2.0, & ! 10
2.0,2.0, & ! 11
0.0,3.0, & ! 13
1.0,3.0, & ! 14
2.0,3.0/) ! 15
!! node owners
allocate(nodeOwners(numNodes))
nodeOwners=(/0, & ! 5
0, & ! 6
1, & ! 7
2, & ! 9
2, & ! 10
3, & ! 11
2, & ! 13
2, & ! 14
3/) ! 15
! Fill in elem data
numTriElems=0
numQuadElems=4
numElems=numTriElems+numQuadElems
numElemConns=3*numTriElems+4*numQuadElems
!! elem ids
allocate(elemIds(numElems))
elemIds=(/4,5,7,8/)
!! elem masks
allocate(elemMasks(numElems))
elemMasks=(/0,0,0,0/)
!! elem types
allocate(elemTypes(numElems))
elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 4
ESMF_MESHELEMTYPE_QUAD, & ! 5
ESMF_MESHELEMTYPE_QUAD, & ! 7
ESMF_MESHELEMTYPE_QUAD/) ! 8
!! elem coords
allocate(elemCoords(2*numElems))
elemCoords=(/0.5,1.5, & ! 4
1.5,1.5, & ! 5
0.5,2.5, & ! 7
1.5,2.5/) ! 8
!! elem conn
allocate(elemConn(numElemConns))
elemConn=(/1,2,5,4, & ! 4
2,3,6,5, & ! 5
4,5,8,7, & ! 7
5,6,9,8/) ! 8
else if (localPet .eq. 3) then
! Fill in node data
numNodes=6
!! node ids
allocate(nodeIds(numNodes))
nodeIds=(/7,8,11,12,15,16/)
!! node Coords
allocate(nodeCoords(numNodes*2))
nodeCoords=(/2.0,1.0, & ! 7
3.0,1.0, & ! 8
2.0,2.0, & ! 11
3.0,2.0, & ! 12
2.0,3.0, & ! 15
3.0,3.0 /) ! 16
!! node owners
allocate(nodeOwners(numNodes))
nodeOwners=(/1, & ! 7
1, & ! 8
3, & ! 11
3, & ! 12
3, & ! 15
3/) ! 16
! Fill in elem data
numTriElems=2
numQuadElems=1
numElems=numTriElems+numQuadElems
numElemConns=3*numTriElems+4*numQuadElems
!! elem ids
allocate(elemIds(numElems))
elemIds=(/6,9,10/)
!! elem ids
allocate(elemMasks(numElems))
elemMasks=(/0,0,0/)
!! elem types
allocate(elemTypes(numElems))
elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 6
ESMF_MESHELEMTYPE_TRI, & ! 9
ESMF_MESHELEMTYPE_TRI/) ! 10
!! elem coords
allocate(elemCoords(2*numElems))
elemCoords=(/2.5,1.5, & ! 6
2.75,2.25,& ! 9
2.25,2.75/) ! 10
!! elem conn
allocate(elemConn(numElemConns))
elemConn=(/1,2,4,3, & ! 6
3,4,6, & ! 9
3,6,5/) ! 10
endif
endif
! Create Mesh structure in 1 step
dstMesh=ESMF_MeshCreate(parametricDim=2,spatialDim=2, &
nodeIds=nodeIds, nodeCoords=nodeCoords, &
coordSys=ESMF_COORDSYS_CART, &
nodeOwners=nodeOwners, elementIds=elemIds,&
elementTypes=elemTypes, elementConn=elemConn, &
elementCoords=elemCoords, elementMask=elemMasks, &
rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
! Create dest field
call ESMF_ArraySpecSet(arrayspec, 1, ESMF_TYPEKIND_R8, rc=rc)
dstField = ESMF_FieldCreate(dstMesh, arrayspec, meshloc=ESMF_MESHLOC_ELEMENT, &
name="dst", rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
! clear destination Field
! Should only be 1 localDE
call ESMF_FieldGet(dstField, 0, farrayPtr1D, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
farrayPtr1D=0.0
! Exact dest field
xdstField = ESMF_FieldCreate(dstMesh, arrayspec, meshloc=ESMF_MESHLOC_ELEMENT, &
name="dst", rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
! Should only be 1 localDE
call ESMF_FieldGet(xdstField, 0, xfarrayPtr1D, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
! set interpolated function
do i1=1,numElems
! Get coordinates
x=elemCoords(2*i1-1)
y=elemCoords(2*i1)
! Set source function
xfarrayPtr1D(i1) = 20.0+x+y
!write(*,*) localPet,":: XDst=",xfarrayPtr1D(i1)
! If masked then will remain 0.0
if (elemMasks(i1) .eq. 1) then
xfarrayPtr1D(i1) = 0.0
endif
enddo
! deallocate node data
deallocate(nodeIds)
deallocate(nodeCoords)
deallocate(nodeOwners)
! deallocate elem data
deallocate(elemIds)
deallocate(elemTypes)
deallocate(elemCoords)
deallocate(elemMasks)
deallocate(elemConn)
#if 0
call ESMF_MeshWrite(srcMesh, "srcmesh")
call ESMF_MeshWrite(dstMesh, "dstmesh")
#endif
!!! Regrid forward from the A grid to the B grid
! Regrid store
call ESMF_FieldRegridStore( &
srcField, &
srcMaskValues=(/1/), &
dstField=dstField, &
dstMaskValues=(/1/), &
routeHandle=routeHandle, &
regridmethod=ESMF_REGRIDMETHOD_BILINEAR, &
rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
! Do regrid
call ESMF_FieldRegrid(srcField, dstField, routeHandle, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
call ESMF_FieldRegridRelease(routeHandle, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
! Check destination field
! Should only be 1 localDE
call ESMF_FieldGet(dstField, 0, farrayPtr1D, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
! Should only be 1 localDE
call ESMF_FieldGet(xdstField, 0, xfarrayPtr1D, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
! loop through nodes and make sure interpolated values are reasonable
do i1=1,numElems
!! Calculate error
if (xfarrayPtr1D(i1) .ne. 0.0) then
relErr=abs(farrayPtr1D(i1)-xfarrayPtr1D(i1))/xfarrayPtr1D(i1)
else
relErr=abs(farrayPtr1D(i1)-xfarrayPtr1D(i1))
endif
!! if error is too big report an error
if (relErr > 0.0001) then
correct=.false.
! write(*,*) localPet,"::",i1,farrayPtr1D(i1),xfarrayPtr1D(i1)
endif
enddo
! Destroy the Fields
call ESMF_FieldDestroy(srcField, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
call ESMF_FieldDestroy(dstField, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
! Free the grids
call ESMF_MeshDestroy(dstMesh, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
call ESMF_MeshDestroy(srcMesh, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
! return answer based on correct flag
if (correct) then
rc=ESMF_SUCCESS
else
rc=ESMF_FAILURE
endif
end subroutine test_regridMeshToMeshCenter