! $Id$ ! ! Earth System Modeling Framework ! Copyright (c) 2002-2023, 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. ! !============================================================================== #define FILENAME "src/Infrastructure/Array/tests/ESMF_ArraySMMUTest.F90" #include "ESMF_Macros.inc" #include "ESMF.h" module ESMF_ArraySMMUTest_comp_mod ! modules use ESMF_TestMod ! test methods use ESMF implicit none private public setvm, setservices, test_smm contains !-------------------------------------------------------------------- subroutine setvm(gcomp, rc) ! arguments type(ESMF_GridComp):: gcomp integer, intent(out):: rc #ifdef ESMF_TESTWITHTHREADS type(ESMF_VM) :: vm logical :: pthreadsEnabled #endif ! Initialize rc = ESMF_SUCCESS #ifdef ESMF_TESTWITHTHREADS ! The following call will turn on ESMF-threading (single threaded) ! for this component. If you are using this file as a template for ! your own code development you probably don't want to include the ! following call unless you are interested in exploring ESMF's ! threading features. ! First test whether ESMF-threading is supported on this machine call ESMF_VMGetGlobal(vm, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_VMGet(vm, pthreadsEnabledFlag=pthreadsEnabled, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out if (pthreadsEnabled) then !TODO: use the following call to change the VM threading level + comm sets call ESMF_GridCompSetVMMinThreads(gcomp, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out endif #endif end subroutine !-------------------------------------------------------------- recursive subroutine setservices(gcomp, rc) ! arguments type(ESMF_GridComp):: gcomp integer, intent(out):: rc ! Initialize rc = ESMF_SUCCESS ! register RUN method call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_RUN, userRoutine=run, & rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out end subroutine !-------------------------------------------------------------- recursive subroutine run(gcomp, istate, estate, clock, rc) ! arguments type(ESMF_GridComp):: gcomp type(ESMF_State):: istate, estate type(ESMF_Clock):: clock integer, intent(out):: rc ! local variables character(ESMF_MAXSTR) :: failMsg character(ESMF_MAXSTR) :: name integer :: petCount, i, result integer, allocatable :: petList(:) #if 0 type(ESMF_VM) :: vm #endif ! Initialize rc = ESMF_SUCCESS result = 0 call ESMF_GridCompGet(gcomp, petCount=petCount, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out #if 0 call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_VMPrint(vm, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out #endif #if 1 !------------------------------------------------------------------------ !NEX_UTest write(name, *) "ComponentizedSMMSuite: src 1 DE/PET -> dst default 4DEs ASMM Test" write(failMsg, *) "Did not return ESMF_SUCCESS" call test_smm(srcRegDecomp=(/1,petCount/), rc=rc) call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) ! must bail out to prevent possible hanging due to communications if (rc /= ESMF_SUCCESS) return ! bail out !------------------------------------------------------------------------ #endif end subroutine !-------------------------------------------------------------- recursive subroutine test_smm(srcRegDecomp, dstPetList, vectorLength, & srcTermProcessing, pipelineDepth, termorderflag, testUnmatched, rc) integer :: srcRegDecomp(:) integer, optional :: dstPetList(:) integer, optional :: vectorLength integer, optional :: srcTermProcessing integer, optional :: pipelineDepth type(ESMF_TermOrder_Flag), optional :: termorderflag logical, optional :: testUnmatched integer :: rc ! Local variables type(ESMF_VM) :: vm type(ESMF_DELayout) :: delayout type(ESMF_DistGrid) :: srcDistgrid, dstDistgrid type(ESMF_Array) :: srcArray, dstArray integer :: i, j, petCount, localPet, localDeCount integer, allocatable :: localDeToDeMap(:) integer, pointer :: farrayPtr(:), farrayPtrV(:,:) integer, target :: seedV(4,6,10), resultV(4,6,10), validationV(4,6,10) integer, pointer :: seed(:,:), result(:,:), validation(:,:) integer :: factorList(19), factorIndexList(2,19), value type(ESMF_RouteHandle):: rh, trh integer :: vectorLengthOpt logical :: testUnmatchedOpt character(len=160) :: msg rc = ESMF_SUCCESS !--------------------------------------------------------------------------- ! deal with optional arguments vectorLengthOpt = 0 ! default if (present(vectorLength)) vectorLengthOpt = vectorLength testUnmatchedOpt = .false. ! default if (present(testUnmatched)) testUnmatchedOpt = testUnmatched !--------------------------------------------------------------------------- ! checking for invalid input if (vectorLengthOpt < 0 .or. vectorLengthOpt > 10) then call ESMF_LogSetError(ESMF_RC_ARG_OUTOFRANGE, & msg="vectorLengh out of range", & line=__LINE__, & file=FILENAME, rcToReturn=rc) return ! bail out endif !--------------------------------------------------------------------------- ! get current VM and pet info call ESMF_VMGetCurrent(vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out !--------------------------------------------------------------------------- ! set up srcArray srcDistGrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/4,6/), & regDecomp=srcRegDecomp, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out if (vectorLengthOpt>0) then srcArray = ESMF_ArrayCreate(srcDistGrid, ESMF_TYPEKIND_I4, & undistLBound=(/1/), undistUBound=(/vectorLengthOpt/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out else srcArray = ESMF_ArrayCreate(srcDistGrid, ESMF_TYPEKIND_I4, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out endif !--------------------------------------------------------------------------- ! initialize seed on PET 0 and scatter into srcArray seed => seedV(:,:,1) if (localPet==0) then value = 1 ! initialize start value do j=1, 6 do i=1, 4 seed(i,j) = value value = value + 1 enddo enddo endif if (vectorLengthOpt>0) then call ESMF_ArrayScatter(srcArray, seedV(:,:,1:vectorLengthOpt), & rootPet=0, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out else call ESMF_ArrayScatter(srcArray, seed, rootPet=0, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out endif !--------------------------------------------------------------------------- ! set up array for transpose validation validation => validationV(:,:,1) if (localPet==0) then validation(1,1) = -120 validation(2,1) = -459 validation(3,1) = -528 validation(4,1) = 2496 validation(1,2) = -24 validation(2,2) = 1728 validation(3,2) = 3072 validation(4,2) = 1920 validation(1,3) = -1344 validation(2,3) = 1122 validation(3,3) = 384 validation(4,3) = -1683 validation(1,4) = 2295 validation(2,4) = 36 validation(3,4) = 132 validation(4,4) = -330 validation(1,5) = 0 validation(2,5) = 0 validation(3,5) = 0 validation(4,5) = 0 validation(1,6) = 0 validation(2,6) = 0 validation(3,6) = 0 validation(4,6) = 0 endif !--------------------------------------------------------------------------- ! set up dstArray delayout = ESMF_DELayoutCreate(deCount=4, petList=dstPetList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out dstDistGrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/4/), & delayout=delayout, rc=rc) ! One data point on each of the 4 DEs if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out if (vectorLengthOpt>0) then dstArray = ESMF_ArrayCreate(dstDistGrid, ESMF_TYPEKIND_I4, & undistLBound=(/1/), undistUBound=(/vectorLengthOpt/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out else dstArray = ESMF_ArrayCreate(dstDistGrid, ESMF_TYPEKIND_I4, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out endif !--------------------------------------------------------------------------- ! initialize factorIndexList and factorList (but only on PET 0) if (localPet == 0) then factorIndexList(1,1) = 3 factorIndexList(2,1) = 1 factorList(1) = 8 factorIndexList(1,2) = 10 factorIndexList(2,2) = 1 factorList(2) = -17 factorIndexList(1,3) = 16 factorIndexList(2,3) = 1 factorList(3) = 5 factorIndexList(1,4) = 12 factorIndexList(2,4) = 2 factorList(4) = -11 factorIndexList(1,5) = 13 factorIndexList(2,5) = 2 factorList(5) = 15 factorIndexList(1,6) = 2 factorIndexList(2,6) = 2 factorList(6) = -3 factorIndexList(1,7) = 8 factorIndexList(2,7) = 2 factorList(7) = 12 factorIndexList(1,8) = 15 factorIndexList(2,8) = 3 factorList(8) = 10 factorIndexList(1,9) = 8 factorIndexList(2,9) = 3 factorList(9) = -14 factorIndexList(1,10) = 14 factorIndexList(2,10) = 3 factorList(10) = -6 factorIndexList(1,11) = 5 factorIndexList(2,11) = 3 factorList(11) = 4 factorIndexList(1,12) = 1 factorIndexList(2,12) = 3 factorList(12) = 20 factorIndexList(1,13) = 11 factorIndexList(2,13) = 4 factorList(13) = 2 factorIndexList(1,14) = 7 factorIndexList(2,14) = 4 factorList(14) = 16 factorIndexList(1,15) = 9 factorIndexList(2,15) = 4 factorList(15) = -7 factorIndexList(1,16) = 4 factorIndexList(2,16) = 4 factorList(16) = 13 factorIndexList(1,17) = 15 factorIndexList(2,17) = 4 factorList(17) = 1 factorIndexList(1,18) = 6 factorIndexList(2,18) = 4 factorList(18) = 9 if (testUnmatchedOpt) then factorIndexList(1,19) = 15 ! valid src sequence index factorIndexList(2,19) = 40 ! invalid dst sequence index factorList(19) = 100 ! will never be used else factorIndexList(1,19) = 1 ! inside factorIndexList(2,19) = 1 ! inside factorList(19) = 0 ! does not change anything endif endif !--------------------------------------------------------------------------- ! ASMMStore if (localPet == 0) then call ESMF_ArraySMMStore(srcArray, dstArray, factorList=factorList, & factorIndexList=factorIndexList, routehandle=rh, & ignoreUnmatchedIndices=testUnmatchedOpt, & srcTermProcessing=srcTermProcessing, pipelineDepth=pipelineDepth, & transposeRoutehandle=trh, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out else call ESMF_ArraySMMStore(srcArray, dstArray, routehandle=rh, & ignoreUnmatchedIndices=testUnmatchedOpt, & srcTermProcessing=srcTermProcessing, pipelineDepth=pipelineDepth, & transposeRoutehandle=trh, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out endif !--------------------------------------------------------------------------- ! Re-set the data in srcArray, because it will have been modified due to ! the transposeRoutehandle option in ESMF_ArraySMMStore() if (vectorLengthOpt>0) then call ESMF_ArrayScatter(srcArray, seedV(:,:,1:vectorLengthOpt), & rootPet=0, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out else call ESMF_ArrayScatter(srcArray, seed, rootPet=0, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out endif !--------------------------------------------------------------------------- ! ASMM call ESMF_ArraySMM(srcArray, dstArray, termorderflag=termorderflag, & routehandle=rh, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out !--------------------------------------------------------------------------- ! ASMMRelease call ESMF_ArraySMMRelease(routehandle=rh, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out !--------------------------------------------------------------------------- ! Verification dstArray call ESMF_ArrayGet(dstArray, localDeCount=localDeCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out allocate(localDeToDeMap(0:localDeCount-1)) call ESMF_ArrayGet(dstArray, localDeToDeMap=localDeToDeMap, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out do i=0, localDeCount-1 if (vectorLengthOpt>0) then call ESMF_ArrayGet(dstArray, localDe=i, farrayPtr=farrayPtrV, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out value = farrayPtrV(1,1) else call ESMF_ArrayGet(dstArray, localDe=i, farrayPtr=farrayPtr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out value = farrayPtr(1) endif select case (localDeToDeMap(i)) case (0) if (value == -66) then call ESMF_LogWrite("Correct result verified in dstArray on DE 0", & ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out else call ESMF_LogSetError(rcToCheck=ESMF_RC_VAL_WRONG, & msg = "Incorrect result detected in dstArray on DE 0", & line=__LINE__, & file=FILENAME, & rcToReturn=rc) return ! bail out endif case (1) if (value == 153) then call ESMF_LogWrite("Correct result verified in dstArray on DE 1", & ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out else call ESMF_LogSetError(rcToCheck=ESMF_RC_VAL_WRONG, & msg = "Incorrect result detected in dstArray on DE 1", & line=__LINE__, & file=FILENAME, & rcToReturn=rc) return ! bail out endif case (2) if (value == -6) then call ESMF_LogWrite("Correct result verified in dstArray on DE 2", & ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out else call ESMF_LogSetError(rcToCheck=ESMF_RC_VAL_WRONG, & msg = "Incorrect result detected in dstArray on DE 2", & line=__LINE__, & file=FILENAME, & rcToReturn=rc) return ! bail out endif case (3) if (value == 192) then call ESMF_LogWrite("Correct result verified in dstArray on DE 3", & ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out else call ESMF_LogSetError(rcToCheck=ESMF_RC_VAL_WRONG, & msg = "Incorrect result detected in dstArray on DE 3", & line=__LINE__, & file=FILENAME, & rcToReturn=rc) return ! bail out endif end select enddo deallocate(localDeToDeMap) !--------------------------------------------------------------------------- ! ASMM transpose call ESMF_ArraySMM(dstArray, srcArray, termorderflag=termorderflag, & routehandle=trh, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out !--------------------------------------------------------------------------- ! ASMMRelease transpose call ESMF_ArraySMMRelease(routehandle=trh, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out !--------------------------------------------------------------------------- ! Verification transpose result => resultV(:,:,1) if (vectorLengthOpt>0) then call ESMF_ArrayGather(srcArray, resultV(:,:,1:vectorLengthOpt), & rootPet=0, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out else call ESMF_ArrayGather(srcArray, result, rootPet=0, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out endif if (localPet==0) then do j=1, 6 do i=1, 4 if (result(i,j)==validation(i,j)) then write(msg,*) "Correct transpose results verified in result(",i,",",j,")." call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out else write(msg,*) "Incorrect transpose results detected in result(",i,",",j,")"//& ": ", result(i,j), "/=", validation(i,j) call ESMF_LogSetError(rcToCheck=ESMF_RC_VAL_WRONG, & msg = msg, & line=__LINE__, & file=FILENAME, & rcToReturn=rc) return ! bail out endif enddo enddo endif !--------------------------------------------------------------------------- ! Clean-up call ESMF_ArrayDestroy(srcArray, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out call ESMF_DistGridDestroy(srcDistGrid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out call ESMF_ArrayDestroy(dstArray, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out call ESMF_DistGridDestroy(dstDistGrid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out call ESMF_DELayoutDestroy(delayout, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME)) & return ! bail out end subroutine end module !============================================================================== !============================================================================== !============================================================================== program ESMF_ArraySMMUTest !============================================================================== !BOP ! !PROGRAM: ESMF_ArraySMMUTest - Tests ArraySMM() ! ! !DESCRIPTION: ! !----------------------------------------------------------------------------- ! !USES: use ESMF_TestMod ! test methods use ESMF use ESMF_ArraySMMUTest_comp_mod, only: setvm, setservices, test_smm implicit none !------------------------------------------------------------------------------ ! The following line turns the CVS identifier string into a printable variable. character(*), parameter :: version = & '$Id$' !------------------------------------------------------------------------------ !------------------------------------------------------------------------- !========================================================================= ! individual test failure message character(ESMF_MAXSTR) :: failMsg character(ESMF_MAXSTR) :: name integer :: rc, petCount, i integer, allocatable :: petList(:) type(ESMF_VM) :: vm type(ESMF_GridComp) :: gcomp ! cumulative result: count failures; no failures equals "all pass" integer :: result = 0 !------------------------------------------------------------------------------- ! The unit tests are divided into Sanity and Exhaustive. The Sanity tests are ! always run. When the environment variable, EXHAUSTIVE, is set to ON then ! the EXHAUSTIVE and sanity tests both run. If the EXHAUSTIVE variable is set ! to OFF, then only the sanity unit tests. ! Special strings (Non-exhaustive and exhaustive) have been ! added to allow a script to count the number and types of unit tests. !------------------------------------------------------------------------------- !------------------------------------------------------------------------ call ESMF_TestStart(ESMF_SRCLINE, rc=rc) ! calls ESMF_Initialize() internally if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ call ESMF_VMGetGlobal(vm, rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_VMGet(vm, petCount=petCount, rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ !NEX_UTest write(name, *) "src 1 DE/PET -> dst default 4DEs ASMM Test" write(failMsg, *) "Did not return ESMF_SUCCESS" call test_smm(srcRegDecomp=(/1,petCount/), rc=rc) call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) ! must abort to prevent possible hanging due to communications if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ !------------------------------------------------------------------------ !NEX_UTest write(name, *) "src 1 DE/PET -> dst default 4DEs, vectorLength=4 ASMM Test" write(failMsg, *) "Did not return ESMF_SUCCESS" call test_smm(srcRegDecomp=(/1,petCount/), vectorLength=4, rc=rc) call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) ! must abort to prevent possible hanging due to communications if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ !------------------------------------------------------------------------ !NEX_UTest write(name, *) "src 1 DE/PET -> dst default 4DEs, ESMF_TERMORDER_SRCSEQ ASMM Test" write(failMsg, *) "Did not return ESMF_SUCCESS" call test_smm(srcRegDecomp=(/1,petCount/), & termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) ! must abort to prevent possible hanging due to communications if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ !------------------------------------------------------------------------ !NEX_UTest write(name, *) "src 1 DE/PET -> dst default 4DEs, vectorLength=4, ESMF_TERMORDER_SRCSEQ ASMM Test" write(failMsg, *) "Did not return ESMF_SUCCESS" call test_smm(srcRegDecomp=(/1,petCount/), vectorLength=4, & srcTermProcessing=1, termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) ! must abort to prevent possible hanging due to communications if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ !------------------------------------------------------------------------ !NEX_UTest write(name, *) "src 1 DE/PET -> dst default 4DEs, vectorLength=4, ESMF_TERMORDER_SRCSEQ ASMM Test" write(failMsg, *) "Did not return ESMF_SUCCESS" call test_smm(srcRegDecomp=(/1,petCount/), vectorLength=4, & srcTermProcessing=0, termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) ! must abort to prevent possible hanging due to communications if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ !------------------------------------------------------------------------ !NEX_UTest write(name, *) "src 1 DE/PET -> dst default 4DEs, testUnmatched ASMM Test" write(failMsg, *) "Did not return ESMF_SUCCESS" call test_smm(srcRegDecomp=(/1,petCount/), testUnmatched=.true., rc=rc) call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) ! must abort to prevent possible hanging due to communications if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ !------------------------------------------------------------------------ !NEX_UTest write(name, *) "src 1 DE/PET -> dst default 4DEs ASMM Test w/ tuning parameters" write(failMsg, *) "Did not return ESMF_SUCCESS" call test_smm(srcRegDecomp=(/1,petCount/), srcTermProcessing=10, & pipelineDepth=4, rc=rc) call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) ! must abort to prevent possible hanging due to communications if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ !------------------------------------------------------------------------ !NEX_UTest write(name, *) "src 1 DE/PET -> dst default 4DEs ASMM Test w/ tuning parameters, testUnmatched" write(failMsg, *) "Did not return ESMF_SUCCESS" call test_smm(srcRegDecomp=(/1,petCount/), srcTermProcessing=10, & pipelineDepth=4, testUnmatched=.true., rc=rc) call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) ! must abort to prevent possible hanging due to communications if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ !------------------------------------------------------------------------ !NEX_UTest write(name, *) "src 1 DE/PET -> dst all 4 DEs on PET 0 ASMM Test" write(failMsg, *) "Did not return ESMF_SUCCESS" call test_smm(srcRegDecomp=(/1,petCount/), dstPetList=(/0/), rc=rc) call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) ! must abort to prevent possible hanging due to communications if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ !------------------------------------------------------------------------ !NEX_UTest write(name, *) "src 2 DEs/PET -> dst default 4DEs ASMM Test" write(failMsg, *) "Did not return ESMF_SUCCESS" call test_smm(srcRegDecomp=(/2,petCount/), rc=rc) call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) ! must abort to prevent possible hanging due to communications if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ !------------------------------------------------------------------------ !NEX_UTest write(name, *) "src 2 DEs/PET -> dst default 4DEs, testUnmatched ASMM Test" write(failMsg, *) "Did not return ESMF_SUCCESS" call test_smm(srcRegDecomp=(/2,petCount/), testUnmatched=.true., rc=rc) call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) ! must abort to prevent possible hanging due to communications if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ allocate(petList(0:petCount/2-1)) do i=0, petCount/2-1 petList(i) = i*2 enddo !------------------------------------------------------------------------ !NEX_UTest write(name, *) "src 2 DEs/PET -> dst skipping PETs ASMM Test" write(failMsg, *) "Did not return ESMF_SUCCESS" call test_smm(srcRegDecomp=(/2,petCount/), dstPetList=petList, rc=rc) call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) ! must abort to prevent possible hanging due to communications if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ !------------------------------------------------------------------------ !NEX_UTest write(name, *) "src more than one DE/PET (irregular) -> dst default 4DEs ASMM Test" write(failMsg, *) "Did not return ESMF_SUCCESS" call test_smm(srcRegDecomp=(/2,4/), rc=rc) call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) ! must abort to prevent possible hanging due to communications if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ !------------------------------------------------------------------------ !NEX_UTest write(name, *) "src more than one DE/PET (irregular) -> dst all 4 DEs on PET 0 ASMM Test" write(failMsg, *) "Did not return ESMF_SUCCESS" call test_smm(srcRegDecomp=(/2,4/), dstPetList=(/0/), rc=rc) call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) ! must abort to prevent possible hanging due to communications if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ !------------------------------------------------------------------------ !NEX_UTest write(name, *) "src some PETs with 0 DEs -> dst default 4DEs ASMM Test" write(failMsg, *) "Did not return ESMF_SUCCESS" call test_smm(srcRegDecomp=(/2,2/), rc=rc) call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) ! must abort to prevent possible hanging due to communications if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ !------------------------------------------------------------------------ !NEX_UTest write(name, *) "src some PETs with 0 DEs -> dst skipping PETs ASMM Test" write(failMsg, *) "Did not return ESMF_SUCCESS" call test_smm(srcRegDecomp=(/2,2/), dstPetList=petList, rc=rc) call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) ! must abort to prevent possible hanging due to communications if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ !------------------------------------------------------------------------ !NEX_UTest write(name, *) "src some PETs with 0 DEs -> dst skipping PETs w/ tuning parameters ASMM Test" write(failMsg, *) "Did not return ESMF_SUCCESS" call test_smm(srcRegDecomp=(/2,2/), dstPetList=petList, srcTermProcessing=10,& pipelineDepth=4, rc=rc) call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) ! must abort to prevent possible hanging due to communications if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ deallocate(petlist) !------------------------------------------------------------------------ !------------------------------------------------------------------------ ! Run the componentized SMM test suite gcomp = ESMF_GridCompCreate(rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridCompSetVM(gcomp, userRoutine=setvm, rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridCompSetServices(gcomp, userRoutine=setservices, rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridCompRun(gcomp, rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ !------------------------------------------------------------------------ !------------------------------------------------------------------------ call ESMF_TestEnd(ESMF_SRCLINE) ! calls ESMF_Finalize() internally !------------------------------------------------------------------------ end program ESMF_ArraySMMUTest