subroutine test4(rc)
integer, intent(out) :: rc
integer :: localrc, i, npet, lpet
type(ESMF_XGrid) :: xgrid
type(ESMF_Grid) :: sideA(2), sideB(1)
type(ESMF_VM) :: vm
real(ESMF_KIND_R8) :: xgrid_area(12), B_area(2,2)
type(ESMF_RouteHandle) :: rh_src2xgrid(2), rh_xgrid2dst(1)
type(ESMF_Mesh) :: mesh
type(ESMF_Field) :: srcField(3), dstField(3)
type(ESMF_RouteHandle) :: rh
rc = ESMF_SUCCESS
localrc = ESMF_SUCCESS
call ESMF_VMGetCurrent(vm=vm, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_VMGet(vm, localpet=lpet, petcount=npet, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Global identical Grids in index space
xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid(4,8,1.,1.,0.,0.,rc=localrc)/), &
sideBGrid=(/make_grid(4,8,0.7,0.7,0.,0.,rc=localrc)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_XGridDestroy(xgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Global identical Grids
xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid(4,8,1.,1.,0.,0.,rc=localrc)/), &
sideBGrid=(/make_grid(4,8,1.0,1.0,0.,0.,rc=localrc)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_XGridDestroy(xgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Sew mesh
! right, left
xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid(4,2,1.,1.,0.,0.,rc=localrc), &
make_grid(4,2,0.5,1.,4.,0.,rc=localrc)/), &
sideBGrid=(/make_grid(8,8,0.7,0.7,0.,0.,rc=localrc)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_XGridDestroy(xgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Bigger Grids
xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid(4,4,1.,1.,0.,0.,rc=localrc), &
make_grid(4,4,0.5,1.,4.,0.,rc=localrc)/), &
sideBGrid=(/make_grid(8,8,1.,1.,0.,0.,rc=localrc)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_XGridDestroy(xgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! right, left
xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid(4,4,0.5,1.,4.,0.,rc=localrc), &
make_grid(4,4,1.,1.,0.,0.,rc=localrc)/), &
sideBGrid=(/make_grid(8,8,1.,1.,0.,0.,rc=localrc)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_XGridDestroy(xgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! down, up
xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid(4,4,0.5,1.,0.,-4.,rc=localrc), &
make_grid(4,4,1.,1.,0.,0.,rc=localrc)/), &
sideBGrid=(/make_grid(8,8,1.,1.,0.,-4.,rc=localrc)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_XGridDestroy(xgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! up, down
xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid(4,4,0.5,1.,0.,0.,rc=localrc), &
make_grid(4,4,1.,1.,0.,-4.,rc=localrc)/), &
sideBGrid=(/make_grid(8,8,1.,1.,0.,-4.,rc=localrc)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_XGridDestroy(xgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! partially overlap
xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid(4,4,1.,1.,0.,0.,field=srcField(1),rc=localrc), &
make_grid(4,4,0.5,1.,3.5,3.5,field=srcField(2),rc=localrc)/), &
sideBGrid=(/make_grid(32,32,0.25,0.25,0.,0.,field=dstField(1),rc=localrc)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call flux_exchange(xgrid, srcField(1:2), dstField(1:1), rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid(4,4,1.,1.,0.,0.,field=srcField(1),rc=localrc), &
make_grid(4,4,0.5,1.,3.5,3.5,field=srcField(2),rc=localrc)/), &
sideBGrid=(/make_grid(16,16,0.5,0.5,0.,0.,field=dstField(1),rc=localrc)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call flux_exchange(xgrid, srcField(1:2), dstField(1:1), rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid(4,4,1.,1.,0.,0.,field=srcField(1),rc=localrc), &
make_grid(4,4,0.5,1.,3.5,3.5,field=srcField(2),rc=localrc)/), &
sideBGrid=(/make_grid(8,8,1.,1.,0.,0.,field=dstField(1),rc=localrc)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call flux_exchange(xgrid, srcField(1:2), dstField(1:1), rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! partially overlap
xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid(4,4,1.,1.,0.,0.,field=srcField(1),rc=localrc), &
make_grid(4,4,0.5,1.,3.3,3.4,field=srcField(2),rc=localrc)/), &
sideBGrid=(/make_grid(8,8,1.,1.,0.,0.,field=dstField(1),rc=localrc)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call flux_exchange(xgrid, srcField(1:2), dstField(1:1), rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! partially overlap
xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid(4,4,1.,1.,0.,0., field=srcField(1),rc=localrc), &
make_grid(4,4,0.5,1.,3.3,2.4,field=srcField(2),rc=localrc)/), &
sideBGrid=(/make_grid(30,30,0.3,0.3,0.,0.,field=dstField(1),rc=localrc)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call flux_exchange(xgrid, srcField(1:2), dstField(1:1), rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! partially overlap
xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid(4,4,1.,1.,0.,0., field=srcField(1),rc=localrc), &
make_grid(4,4,0.5,1.,3.3,2.4,field=srcField(2),rc=localrc)/), &
sideBGrid=(/make_grid(8,8,1.,1.,0.,0.,field=dstField(1),rc=localrc)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call flux_exchange(xgrid, srcField(1:2), dstField(1:1), rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! partially overlap subject smaller cell
xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid(4,4,1.,1.,0.,0.,rc=localrc), &
make_grid(4,4,0.5,1.,2.8,1.4,rc=localrc)/), &
sideBGrid=(/make_grid(30,30,0.3,0.3,0.,0.,rc=localrc)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_XGridDestroy(xgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! partially overlap subject bigger cell
! although identical to previous test, the next 2 tests seem to trigger a strange condition on bluefire in 32g mode
!xgrid = ESMF_XGridCreate((/ &
! make_grid(4,4,0.5,1.,2.8,1.4,rc=localrc), &
! make_grid(4,4,1.,1.,0.,0.,rc=localrc) &
! /), &
! (/ &
! make_grid(30,30,0.3,0.3,0.,0.,rc=localrc) &
! /), &
! rc=localrc)
!if (ESMF_LogFoundError(localrc, &
! ESMF_ERR_PASSTHRU, &
! ESMF_CONTEXT, rcToReturn=rc)) return
!xgrid = ESMF_XGridCreate( &
! (/ &
! make_grid(30,30,0.3,0.3,0.,0.,rc=localrc) &
! /), &
! (/ &
! make_grid(4,4,0.5,1.,2.8,1.4,rc=localrc), &
! make_grid(4,4,1.,1.,0.,0.,rc=localrc) &
! /), &
! rc=localrc)
!if (ESMF_LogFoundError(localrc, &
! ESMF_ERR_PASSTHRU, &
! ESMF_CONTEXT, rcToReturn=rc)) return
if(npet == 1) then
xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid(2,2,1.,1.,0.,0.,field=srcField(1),rc=localrc), &
make_grid(2,2,0.5,1.,1.5,1.5,field=srcField(2),rc=localrc)/), &
sideBGrid=(/make_grid(3,3,1.,1.,0.,0.,field=dstField(1),rc=localrc)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call flux_exchange(xgrid, srcField(1:2), dstField(1:1), rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! complicated merging, these triggers a condition in rend mesh that currently does not support two distant Grids
! for multi-pet
xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid(4,2,1.,1.,0.,0.,rc=localrc), &
make_grid(4,2,0.5,1.,4.,0.,rc=localrc), &
make_grid(4,2,1.,1.,6.,0.,rc=localrc)/), &
sideBGrid=(/make_grid(8,8,0.7,0.7,0.,0.,rc=localrc), &
make_grid(8,8,0.7,0.7,0.,5.6,rc=localrc)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_XGridDestroy(xgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid(4,2,1.,1.,0.,0.,rc=localrc), &
make_grid(4,2,0.5,1.,3.,0.3,rc=localrc), &
make_grid(4,4,1.,1.,-2.,-2.,rc=localrc)/), &
sideBGrid=(/make_grid(8,8,0.7,0.7,0.,0.,rc=localrc), &
make_grid(8,8,0.7,0.7,0.,5.6,rc=localrc)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_XGridDestroy(xgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
xgrid = ESMF_XGridCreate(&
sideAGrid=(/make_grid(8,8,0.7,0.7,0.,0.,rc=localrc), &
make_grid(8,8,0.7,0.7,0.,5.6,rc=localrc)/), &
sideBGrid=(/make_grid(4,2,1.,1.,0.,0.,rc=localrc), &
make_grid(4,2,0.5,1.,3.,0.3,rc=localrc), &
make_grid(4,4,1.,1.,-2.,-2.,rc=localrc)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_XGridDestroy(xgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid(4,2,1.,1.,0.,0.,rc=localrc), &
make_grid(4,2,0.5,1.,3.,0.3,rc=localrc), &
make_grid(4,4,1.,1.,-2.,-2.,rc=localrc)/), &
sideBGrid=(/make_grid(8,8,0.7,0.7,0.,0.,rc=localrc), &
make_grid(8,8,0.5,0.7,0.9,3.6,rc=localrc)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_XGridDestroy(xgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
end subroutine test4