subroutine IOCompUTestSetup(grid, fieldInp, fieldOut, igrid, rc)
type(ESMF_Grid), intent(inout) :: grid
type(ESMF_Field), dimension(:), intent(inout) :: fieldInp, fieldOut
integer, intent(in) :: igrid
integer, intent(out) :: rc
! local variables
integer :: i, j, k, staggerlocCount
integer :: de, deCount, dimCount, localDe, localDeCount, tile, tileCount
integer, dimension(2) :: lbnd, ubnd, ccnt
character(len=ESMF_MAXSTR) :: fieldName
integer, dimension(:), allocatable :: localDeToDeMap
integer, dimension(:,:), allocatable :: minIndexPDe, maxIndexPDe
integer(ESMF_KIND_I4), dimension(:,:), pointer :: fpOutI4
real(ESMF_KIND_R4), dimension(:,:), pointer :: fpOutR4
real(ESMF_KIND_R8), dimension(:,:), pointer :: fpOutR8
real(ESMF_KIND_R8), dimension(:,:), pointer :: plon, plat
type(ESMF_DistGrid) :: distgrid
type(ESMF_DELayout) :: delayout
!------------------------------------------------------------------------
! Preparations
!------------------------------------------------------------------------
select case (igrid)
case (1)
write(6,'(2x,"INFO Create Cubed Sphere Grid")')
grid = ESMF_GridCreateCubedSphere(tilesize=96, &
staggerlocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), &
name='fcst_grid', rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
case (2)
write(6,'("2x,INFO Create Regular Spherical Grid")')
grid = ESMF_GridCreate1PeriDim(maxIndex=(/360, 180/), &
coordSys=ESMF_COORDSYS_SPH_DEG, coordDep1=(/1,2/), coordDep2=(/1,2/), &
indexflag=ESMF_INDEX_GLOBAL, name='fcst_grid', rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
call ESMF_GridAddCoord(grid, staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
do k = 1, 2
call ESMF_GridGetCoord(grid, coordDim=k, localDE=0, &
staggerloc=ESMF_STAGGERLOC_CENTER, &
computationalLBound=lbnd, computationalUBound=ubnd, &
farrayPtr=plon, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
do j=lbnd(2), ubnd(2)
do i=lbnd(1), ubnd(1)
plon(i,j) = 1._ESMF_KIND_R8*(2-k)*(i-1) &
+ (1._ESMF_KIND_R8*(j-1) - 90._ESMF_KIND_R8)*(k-1)
end do
end do
end do
end select
! -- Test supported ESMF typekinds
! -- ESMF_TYPEKIND_I4
! -- test all stagger locations
call ESMF_GridGet(grid, staggerlocCount=staggerlocCount, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
do k = 1, staggerlocCount
fieldName = ""
write(fieldName,'("test_i4_sloc",i0)') k-1
fieldInp(k) = ESMF_FieldCreate(grid, ESMF_TYPEKIND_I4, &
staggerloc=ESMF_StaggerLoc(k-1), name=trim(fieldName), rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
fieldOut(k) = ESMF_FieldCreate(grid, ESMF_TYPEKIND_I4, &
staggerloc=ESMF_StaggerLoc(k-1), name=trim(fieldName), rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
end do
k = staggerlocCount + 1
! -- ESMF_TYPEKIND_R4
fieldInp(k) = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R4, name="test_r4", rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
fieldOut(k) = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R4, name="test_r4", rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
k = k + 1
! -- ESMF_TYPEKIND_R8
fieldInp(k) = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, name="test_r8", rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
fieldOut(k) = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, name="test_r8", rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
call ESMF_GridGet(grid, localDECount=localDeCount, dimCount=dimCount, &
tileCount=tileCount, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
! -- fill in Fields
do k = 1, staggerlocCount
! -- get domain decomposition
call ESMF_GridGet(grid, ESMF_StaggerLoc(k-1), distgrid=distgrid, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
call ESMF_DistGridGet(distgrid, deCount=deCount, dimCount=dimCount, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
allocate(minIndexPDe(dimCount, deCount), maxIndexPDe(dimCount, deCount), &
localDeToDeMap(localDeCount))
minIndexPDe = 0
maxIndexPDe = 0
localDeToDeMap = 0
call ESMF_DistGridGet(distgrid, delayout=delayout, &
minIndexPDe=minIndexPDe, maxIndexPDe=maxIndexPDe, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
call ESMF_DELayoutGet(delayout, localDeToDeMap=localDeToDeMap, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
do localDe = 0, localDeCount-1
call ESMF_FieldGet(fieldOut(k), localDE=localDe, farrayPtr=fpOutI4, &
computationalLBound=lbnd, computationalUBound=ubnd, &
computationalCount=ccnt, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
call ESMF_GridGet(grid, localDE=localDe, tile=tile, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
de = localDeToDeMap(localDe+1) + 1
do j = lbnd(2), ubnd(2)
do i = lbnd(1), ubnd(1)
fpOutI4(i,j) = i-lbnd(1)+minIndexPDe(1,de) &
+ j-lbnd(2)+minIndexPDe(2,de)
end do
end do
end do
deallocate(minIndexPDe, maxIndexPDe, localDeToDeMap)
end do
do localDe = 0, localDeCount-1
call ESMF_GridGetCoord(grid, coordDim=1, localDE=localDe, farrayPtr=plon, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
call ESMF_GridGetCoord(grid, coordDim=2, localDE=localDe, farrayPtr=plat, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
k = staggerlocCount + 1
! -- ESMF_TYPEKIND_R4
call ESMF_FieldGet(fieldOut(k), localDE=localDe, farrayPtr=fpOutR4, &
computationalLBound=lbnd, computationalUBound=ubnd, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
do j = lbnd(2), ubnd(2)
do i = lbnd(1), ubnd(1)
fpOutR4(i,j) = real(sin(plat(i,j)/ESMF_COORDSYS_RAD2DEG) &
*cos(plon(i,j)/ESMF_COORDSYS_RAD2DEG), kind=ESMF_KIND_R4)
end do
end do
k = k + 1
! -- ESMF_TYPEKIND_R4
call ESMF_FieldGet(fieldOut(k), localDE=localDe, farrayPtr=fpOutR8, &
computationalLBound=lbnd, computationalUBound=ubnd, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=__FILE__)) return
do j = lbnd(2), ubnd(2)
do i = lbnd(1), ubnd(1)
fpOutR8(i,j) = cos(plat(i,j)/ESMF_COORDSYS_RAD2DEG)*sin(plon(i,j)/ESMF_COORDSYS_RAD2DEG)
end do
end do
end do
end subroutine IOCompUTestSetup