ESMF_ArraySMMUTest Program

Variables

Type Attributes Name Initial
character(len=*), parameter :: version = '$Id$'
character(len=ESMF_MAXSTR) :: failMsg
character(len=ESMF_MAXSTR) :: name
integer :: i
integer :: petCount
integer, allocatable :: petList(:)
integer :: rc
integer :: result = 0
type(ESMF_GridComp) :: gcomp
type(ESMF_VM) :: vm

Source Code

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