! $Id: ESMF_GridArbitraryUTest.F90,v 1.36 2011/07/13 04:11:03 rokuingh Exp $ ! ! Earth System Modeling Framework ! Copyright 2002-2011, University Corporation for Atmospheric Research, ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics ! Laboratory, University of Michigan, National Centers for Environmental ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, ! NASA Goddard Space Flight Center. ! Licensed under the University of Illinois-NCSA License. ! !============================================================================== ! program ESMF_GridArbitraryUTest !------------------------------------------------------------------------------ #include !============================================================================== !BOP ! !PROGRAM: ESMF_GridArbitraryTest - Check Arbitrary Grid Create Routines ! ! !DESCRIPTION: ! ! The code in this file drives F90 Grid Create unit tests. ! !----------------------------------------------------------------------------- ! !USES: use ESMF_TestMod ! test methods use ESMF implicit none !------------------------------------------------------------------------------ ! The following line turns the CVS identifier string into a printable variable. character(*), parameter :: version = & '$Id: ESMF_GridArbitraryUTest.F90,v 1.36 2011/07/13 04:11:03 rokuingh Exp $' !------------------------------------------------------------------------------ ! cumulative result: count failures; no failures equals "all pass" integer :: result = 0 integer :: localrc, rc, petCount, myPet, halfPets logical :: correct type(ESMF_TypeKind_Flag) :: typekind ! individual test failure message character(ESMF_MAXSTR) :: failMsg character(ESMF_MAXSTR) :: name type(ESMF_Grid) :: grid type(ESMF_DELayout) :: delayout type(ESMF_VM) :: vm type(ESMF_DistGrid) :: distgrid type(ESMF_ArraySpec) :: arrayspec1D, arrayspec2D integer :: ind1d, xdim, ydim, zdim, total, x, y integer :: i, j, remain integer :: localCount, localCount1 integer, allocatable :: localIndices(:,:) integer, allocatable :: localIndices1(:,:) integer, allocatable :: local1DIndices(:) type(ESMF_Array) :: array1D, array1, array2D, array2 type(ESMF_Array) :: array1D_1,array1D_2 integer :: coordDimMap(3,3), dimCount, distdimCount integer :: undistLBound(2), undistUBound(2) integer :: elementCounts(4) integer :: lowbound(3), upbound(3) type(ESMF_Index_Flag) :: indexflag integer :: distgridToGridMap(3), coordDimCount(3), distDim(2) integer :: distgridToArrayMap(2) real(ESMF_KIND_R8), pointer :: farrayPtr2D(:,:) integer :: localCount2(1), deList(1), deCount integer, allocatable:: minIndex1(:), maxIndex1(:), localCount3(:) integer, allocatable:: minIndex(:,:), maxIndex(:,:) integer, allocatable:: indexArray(:,:) integer :: index(2), index3(3) integer :: index1(2), index2(2) integer :: rank, arbDimCount integer :: cu(2),cl(2),i1,i2 type(ESMF_GridDecompType) :: decompType REAL(ESMF_KIND_R8), pointer :: dimarray(:), farrayPtr1D(:) type(ESMF_Array) :: myarray type(ESMF_LocalArray) :: larray REAL(ESMF_KIND_R8) :: coord3(3) integer :: badcount !----------------------------------------------------------------------------- call ESMF_TestStart(ESMF_SRCLINE, rc=rc) !----------------------------------------------------------------------------- ! get global VM call ESMF_VMGetGlobal(vm, rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_VMGet(vm, petCount=petCount, localPet=myPet, rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) ! grid dimension: xdim and ydim are arbitrarily distributed xdim = 100 ydim = 200 zdim = 4 ! calculate the localcount and the local indices based on the total number of PETS total = xdim*ydim halfPets = petCount/2 ! let's make the first half pet twice of the cells of the second half localCount = total/(petCount+halfPets) remain = total-localCount*(petCount+halfPets) if (myPet < halfPets) localCount = localCount*2 if (myPet == petCount-1) localCount = localCount+remain ! car deal the cells with the first half of the Pets gets two each time ! the remaining cells are given to the last Pet allocate(localIndices(localCount,2)) if (myPet < halfPets) then ind1d = myPet*2 do i=1,localCount,2 y = mod(ind1d,ydim)+1 x = ind1d/ydim+1 localIndices(i,1)=y localIndices(i,2)=x if (y 0) print *, "PE", myPET, "index mismatch", badcount call ESMF_Test(((rc.eq.ESMF_SUCCESS) .and. correct), name, failMsg, result, ESMF_SRCLINE) call ESMF_GridDestroy(grid, rc=localrc) if (localrc .ne. ESMF_SUCCESS) correct=.false. !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- ! Fifth Grid: Use GridEmptyCreate() and GridEmptyComplete() to create grid with undistributed dimension !----------------------------------------------------------------------------- !NEX_UTest write(name, *) "Create an empty grid then set the values with undistributed dimension and non-default distdim" write(failMsg, *) "Did not return ESMF_SUCCESS" correct=.true. rc=ESMF_SUCCESS grid = ESMF_GridEmptyCreate(rc=localrc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridEmptyComplete(grid, name="arbgrid", coordTypeKind=ESMF_TYPEKIND_R8, & minIndex=(/1,1,1/), maxIndex=(/xdim, zdim, ydim/), & arbIndexList=localIndices,arbIndexCount=localCount, & distDim=(/1,3/), coordDep2=(/ESMF_DIM_ARB, 2/), rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) ! get info back from grid call ESMF_GridGet(grid, distgrid=distgrid, & distgridToGridMap = distgridToGridMap, rc=localrc) if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE ! check that output is as expected if ((distgridToGridMap(1) .ne. 1) .or. (distgridToGridMap(2) .ne. 3)) correct = .false. call ESMF_Test(((rc.eq.ESMF_SUCCESS) .and. correct), name, failMsg, result, ESMF_SRCLINE) !----------------------------------------------------------------------------- ! set the coord for the undistributed dim !NEX_UTest write(name, *) "Setting the gridCoord for the undistributed dimension" write(failMsg, *) "Did not return ESMF_SUCCESS" correct=.true. rc=ESMF_SUCCESS ! Set the array for the undistributed dimension call ESMF_ArraySpecSet(arrayspec2D, rank=2, typekind=ESMF_TYPEKIND_R8, rc=localrc) if (localrc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) array2D = ESMF_ArrayCreate(distgrid, arrayspec2D, indexflag=ESMF_INDEX_DELOCAL, & rc=localrc) ! get the dimension of the array call ESMF_ArrayGet(array2D, localDE=0, localarray=larray, rc=localrc) call ESMF_LocalArrayGet(larray, totalLBound=lowbound, totalUBound=upbound, & rc=localrc) if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE ! set coordinate array for the undistributed dimension call ESMF_ArrayGet(array2D, localDE=0, farrayptr=farrayPtr2D, rc=localrc) if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE ! regular z levels do i=lowbound(1),upbound(1) do j=lowbound(2),upbound(2) farrayPtr2D(i,j)=j*100 enddo enddo ! Create temporary arrays for the other two coordinate dimensions ! set arrayspec call ESMF_ArraySpecSet(arrayspec1D, rank=1, typekind=ESMF_TYPEKIND_R8, rc=localrc) if (localrc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) array1D_1 = ESMF_ArrayCreate(distgrid, arrayspec1D, indexflag=ESMF_INDEX_DELOCAL, & distgridToArrayMap=(/1,0/), rc=localrc); array1D_2 = ESMF_ArrayCreate(distgrid, arrayspec1D, indexflag=ESMF_INDEX_DELOCAL, & distgridToArrayMap=(/1,0/), rc=localrc); ! Set coordinate Arrays call ESMF_GridSetCoord(grid,coordDim=1, & staggerloc=ESMF_STAGGERLOC_CENTER, array=array1D_1, rc=localrc) if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE call ESMF_GridSetCoord(grid,coordDim=2, & staggerloc=ESMF_STAGGERLOC_CENTER, array=array2D, rc=localrc) if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE call ESMF_GridSetCoord(grid,coordDim=3, & staggerloc=ESMF_STAGGERLOC_CENTER, array=array1D_2, rc=localrc) if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE ! Get Coord From Array call ESMF_GridGetCoord(grid,coordDim=2,& staggerloc=ESMF_STAGGERLOC_CENTER, array=array1, rc=localrc) if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE ! Get info to do a partial sanity check that the array is the same call ESMF_ArrayGet(array1, rank=rank, typekind=typekind, rc=localrc) ! Check that array info is as expected if (rank .ne. 2) correct=.false. if (typekind .ne. ESMF_TYPEKIND_R8) correct=.false. ! Check coordinate array values index3(1)=localIndices(1,1) index3(2)=2 index3(3)=localIndices(1,2) call ESMF_GridGetCoord(grid, localDE=0,index=index3, coord=coord3, rc=localrc) !print *,"PET", myPet, "index:", index3, "coord", coord3 if (coord3(2) .ne. 200) correct = .false. !! Check that validate returns true call ESMF_GridValidate(grid,rc=localrc) if (localrc .ne. ESMF_SUCCESS) correct=.false. ! destroy grid call ESMF_GridDestroy(grid,rc=localrc) if (localrc .ne. ESMF_SUCCESS) correct=.false. ! destroy arrays call ESMF_ArrayDestroy(array1D_1,rc=localrc) if (localrc .ne. ESMF_SUCCESS) correct=.false. call ESMF_ArrayDestroy(array2D,rc=localrc) if (localrc .ne. ESMF_SUCCESS) correct=.false. call ESMF_ArrayDestroy(array1D_2,rc=localrc) if (localrc .ne. ESMF_SUCCESS) correct=.false. call ESMF_Test(((rc.eq.ESMF_SUCCESS) .and. correct), name, failMsg, result, ESMF_SRCLINE) !----------------------------------------------------------------------------- ! Seventh grid, Create a Grid from a Dist Grid with one undistributed dimension !------------------------------------------------------------------------------ !NEX_UTest write(name, *) "Test ESMF_GridCreate()" write(failMsg, *) "Did not return ESMF_SUCCESS" correct=.true. rc=ESMF_SUCCESS distgrid = ESMF_DistGridCreate(local1Dindices, 1, minIndexPTile=(/1/), maxIndexPTile=(/zdim/), rc=localrc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) ! bugs in ESMF_DistGrid.F90, need to pass localcount as work around allocate(indexArray(2,3)) indexArray(1,:)=1 indexArray(2,1)=xdim indexArray(2,2)=ydim indexArray(2,3)=zdim grid = ESMF_GridCreate(distgrid=distgrid, indexArray=indexArray, & rc=localrc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !! Check that validate returns true call ESMF_GridValidate(grid,rc=localrc) if (localrc .ne. ESMF_SUCCESS) correct=.false. call ESMF_GridDestroy(grid, rc=localrc) if (localrc .ne. ESMF_SUCCESS) correct=.false. call ESMF_DistGridDestroy(distgrid, rc=localrc) if (localrc .ne. ESMF_SUCCESS) correct=.false. call ESMF_Test(((rc.eq.ESMF_SUCCESS) .and. correct), name, failMsg, result, ESMF_SRCLINE) !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- ! Seventh grid, Create a Grid from a Dist Grid with one undistributed dimension and non-default distDim !------------------------------------------------------------------------------ ! Create grid using ESMF_GridCreate() !NEX_UTest write(name, *) "Test ESMF_GridCreate() with distgridtogridmap" write(failMsg, *) "Did not return ESMF_SUCCESS" correct=.true. rc=ESMF_SUCCESS distgrid = ESMF_DistGridCreate(local1Dindices, 1, minIndexPTile=(/1/), maxIndexPTile=(/zdim/), rc=localrc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) distDim(1)=1 distDim(2)=3 indexArray(2,1)=xdim indexArray(2,2)=zdim indexArray(2,3)=ydim ! bugs in ESMF_DistGrid.F90, need to pass localcount as work around grid = ESMF_GridCreate(distgrid=distgrid, indexArray=indexArray, & distDim=distDim, & rc=localrc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !! Check that validate returns true call ESMF_GridValidate(grid,rc=localrc) if (localrc .ne. ESMF_SUCCESS) correct=.false. call ESMF_GridDestroy(grid, rc=localrc) if (localrc .ne. ESMF_SUCCESS) correct=.false. call ESMF_DistGridDestroy(distgrid, rc=localrc) if (localrc .ne. ESMF_SUCCESS) correct=.false. deallocate(indexArray) call ESMF_Test(((rc.eq.ESMF_SUCCESS) .and. correct), name, failMsg, result, ESMF_SRCLINE) !----------------------------------------------------------------------------- !----------------------------------------------------------------------------= ! Test Set 8: 2D Arbitrary Grid with one PET arbIndexCount = 0 !----------------------------------------------------------------------------- if (myPet .eq. petCount-1) then localCount = 0 deallocate(localIndices) allocate(localIndices(localCount,2)) endif grid = ESMF_GridCreateNoPeriDim(coordTypeKind=ESMF_TYPEKIND_R8, & minIndex=(/1,1/), maxIndex=(/xdim, ydim/), & arbIndexList=localIndices,arbIndexCount=localCount, & name="arbgrid", rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !----------------------------------------------------------------------------- !NEX_UTest write(name, *) "2D Arb Grid: Testing Grid Validate" write(failMsg, *) "Did not return ESMF_SUCCESS" ! initialize check variables correct=.true. rc=ESMF_SUCCESS !! Check that validate returns true call ESMF_GridValidate(grid,rc=localrc) if (localrc .ne. ESMF_SUCCESS) correct=.false. !! Destroy grid call ESMF_GridDestroy(grid, rc=localrc) if (localrc .ne. ESMF_SUCCESS) correct=.false. call ESMF_Test(((rc.eq.ESMF_SUCCESS) .and. correct), name, failMsg, result, ESMF_SRCLINE) !----------------------------------------------------------------------------- ! Test set 9: Use GridEmptyCreate() and GridEmptyComplete() to create grid with undistributed dimension ! with one PET with 0 elements !----------------------------------------------------------------------------- !NEX_UTest write(name, *) "Create an empty grid then set the values with undistributed dimension and non-default distdim" write(failMsg, *) "Did not return ESMF_SUCCESS" correct=.true. rc=ESMF_SUCCESS grid = ESMF_GridEmptyCreate(rc=localrc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridEmptyComplete(grid, name="arbgrid", coordTypeKind=ESMF_TYPEKIND_R8, & minIndex=(/1,1,1/), maxIndex=(/xdim, zdim, ydim/), & arbIndexList=localIndices,arbIndexCount=localCount, & distDim=(/1,3/), coordDep2=(/ESMF_DIM_ARB, 2/), rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) ! get info back from grid call ESMF_GridGet(grid, distgrid=distgrid, & distgridToGridMap = distgridToGridMap, rc=localrc) if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE ! check that output is as expected if ((distgridToGridMap(1) .ne. 1) .or. (distgridToGridMap(2) .ne. 3)) correct = .false. !! Destroy grid call ESMF_GridDestroy(grid, rc=localrc) if (localrc .ne. ESMF_SUCCESS) correct=.false. call ESMF_Test(((rc.eq.ESMF_SUCCESS) .and. correct), name, failMsg, result, ESMF_SRCLINE) deallocate(localIndices) !----------------------------------------------------------------------------- call ESMF_TestEnd(result, ESMF_SRCLINE) !----------------------------------------------------------------------------- end program ESMF_GridArbitraryUTest