mirror of
https://github.com/JHUAPL/kaiju.git
synced 2026-01-08 22:58:05 -05:00
266 lines
9.2 KiB
Plaintext
266 lines
9.2 KiB
Plaintext
module testHelpers
|
|
use testHelperMpi
|
|
use voltapp_mpi
|
|
use gamCouple_mpi_G2V
|
|
use uservoltic
|
|
use ioH5
|
|
|
|
implicit none
|
|
|
|
type(gamCouplerMpi_gam_T), allocatable :: gamCplMpi
|
|
type(voltAppMpi_T), allocatable :: voltAppMpi
|
|
|
|
contains
|
|
|
|
@before
|
|
subroutine emptySetup(this)
|
|
class (MpiTestMethod), intent(inout) :: this
|
|
! does nothing, fighting with pfunit
|
|
end subroutine
|
|
|
|
subroutine manualSetup(this, caseFile)
|
|
class (MpiTestMethod), intent(inout) :: this
|
|
character(len=*), intent(in) :: caseFile
|
|
|
|
integer :: ierror
|
|
type(MPI_Comm) :: gamComm, voltComm
|
|
type(XML_Input_T) :: xmlInp
|
|
|
|
call setMpiReal()
|
|
|
|
! hard-coded for 4 gamera ranks for these tests right now
|
|
if(this%getProcessRank() < 4) then
|
|
allocate(gamCplMpi)
|
|
|
|
! make gamera-only mpi communicator
|
|
call MPI_Comm_Split(getMpiF08Communicator(this), gamId, this%getProcessRank(), gamCplMpi%gOptionsMpi%gamComm, ierror)
|
|
|
|
gamCplMpi%gOptionsCplMpiG%allComm = getMpiF08Communicator(this)
|
|
gamCplMpi%gOptions%userInitFunc => initUser
|
|
gamCplMpi%gOptionsMpi%doIO = .false.
|
|
xmlInp = New_XML_Input(trim(caseFile),'Kaiju',.true.)
|
|
call gamCplMpi%InitModel(xmlInp)
|
|
else
|
|
allocate(voltAppMpi)
|
|
|
|
! make gamera-only mpi communicator
|
|
call MPI_Comm_Split(getMpiF08Communicator(this), voltId, this%getProcessRank(), voltComm, ierror)
|
|
|
|
voltAppMpi%vOptions%gamUserInitFunc => initUser
|
|
voltAppMpi%vOptionsMpi%allComm = getMpiF08Communicator(this)
|
|
voltAppMpi%vOptionsMpi%allVoltComm = voltComm
|
|
call initVoltron_mpi(voltAppMpi, trim(caseFile))
|
|
endif
|
|
|
|
end subroutine manualSetup
|
|
|
|
@after
|
|
subroutine teardown(this)
|
|
class (MpiTestMethod), intent(inout) :: this
|
|
|
|
if(allocated(voltAppMpi)) then
|
|
call endVoltronWaits(voltAppMpi)
|
|
deallocate(voltAppMpi)
|
|
endif
|
|
if(allocated(gamCplMpi)) deallocate(gamCplMpi)
|
|
|
|
end subroutine teardown
|
|
|
|
subroutine runApplication()
|
|
logical :: helperQuit
|
|
|
|
if(allocated(gamCplMpi)) then
|
|
! adjust tFin time to gamera units
|
|
call gamCplMpi%AdvanceModel(gamCplMpi%Model%tFin - gamCplMpi%Model%t)
|
|
else
|
|
if(voltAppMpi%amHelper) then
|
|
helperQuit = .false.
|
|
do while(.not. helperQuit)
|
|
call helpVoltron(voltAppMpi, helperQuit)
|
|
end do
|
|
else
|
|
do while (voltAppMpi%time < voltAppMpi%tFin)
|
|
call stepVoltron_mpi(voltAppMpi)
|
|
end do
|
|
if(voltAppMpi%useHelpers) call vhReqHelperQuit(voltAppMpi)
|
|
endif
|
|
endif
|
|
|
|
end subroutine runApplication
|
|
|
|
@test(npes=[8])
|
|
subroutine testHelpTimestepping(this)
|
|
class (MpiTestMethod), intent(inout) :: this
|
|
|
|
write (*,'(a,I0)') 'Testing HelpTimestepping ',this%getNumProcesses()
|
|
|
|
call manualSetup(this, 'testHelpersStep_4.xml')
|
|
|
|
call runApplication()
|
|
|
|
end subroutine
|
|
|
|
@test(npes=[8])
|
|
subroutine testHelpSquish(this)
|
|
class (MpiTestMethod), intent(inout) :: this
|
|
|
|
real(rp), dimension(:,:,:,:), allocatable :: distSquish
|
|
real(rp), dimension(2) :: posErr
|
|
real(rp) :: sqErr, maxSqErr
|
|
integer :: i,j,k
|
|
logical :: helperQuit
|
|
|
|
! debugging
|
|
!type(IOVAR_T), dimension(12) :: IOVars
|
|
|
|
write (*,'(a,I0)') 'Testing HelpSquish ',this%getNumProcesses()
|
|
|
|
call manualSetup(this, 'testHelpersSquish_4.xml')
|
|
|
|
call runApplication()
|
|
|
|
! Now compare distributed squish results to local-only squish results
|
|
if(allocated(voltAppMpi)) then
|
|
if(.not. voltAppMpi%amHelper) then
|
|
|
|
! call doImag once to update rTrc and nTrc before doing any squishing
|
|
call PreDeep(voltAppMpi, voltAppMpi%gApp)
|
|
call DoImag(voltAppMpi)
|
|
|
|
! calculate distributed squish from most recent results
|
|
call startDeep(voltAppMpi)
|
|
do while(deepInProgress(voltAppMpi))
|
|
call doDeepBlock(voltAppMpi)
|
|
enddo
|
|
call vhReqHelperQuit(voltAppMpi) ! tell the helpers they're done
|
|
allocate(distSquish, MOLD=voltAppMpi%chmp2mhd%xyzSquish)
|
|
distSquish = voltAppMpi%chmp2mhd%xyzSquish
|
|
|
|
! now calculate local-only squish
|
|
voltAppMpi%ebTrcApp%ebSquish%myNumBlocks = -1 ! I do all blocks
|
|
voltAppMpi%ebTrcApp%ebSquish%myFirstBlock = 1 ! ensure I start with the first block
|
|
call DeepUpdate(voltAppMpi, voltAppMpi%gApp)
|
|
|
|
sqErr = 0
|
|
maxSqErr = 0
|
|
do i=voltAppMpi%ebTrcApp%ebState%ebGr%is,voltAppMpi%iDeep+1
|
|
do j=voltAppMpi%ebTrcApp%ebState%ebGr%js,voltAppMpi%ebTrcApp%ebState%ebGr%je+1
|
|
do k=voltAppMpi%ebTrcApp%ebState%ebGr%ks,voltAppMpi%ebTrcApp%ebState%ebGr%ke+1
|
|
posErr = abs(distSquish(i,j,k,:) - voltAppMpi%chmp2mhd%xyzSquish(i,j,k,:))
|
|
if(posErr(2) > PI) posErr(2) = 2*PI - posErr(2)
|
|
sqErr = sqErr + NORM2(posErr)
|
|
maxSqErr = MAX(maxSqErr, NORM2(posErr))
|
|
enddo
|
|
enddo
|
|
enddo
|
|
|
|
! debugging...
|
|
!call ClearIO(IOVars)
|
|
!call AddOutVar(IOVars,"distSquish",distSquish)
|
|
!call AddOutVar(IOVars,"localSquish",voltAppMpi%chmp2mhd%xyzSquish)
|
|
!call WriteVars(IOVars,.false.,"SquishTestData.h5")
|
|
! ...debugging
|
|
|
|
deallocate(distSquish)
|
|
|
|
! Floating point error rounding
|
|
@assertLessThan(sqErr, 1.0e-15_rp, trim("Total Distributed Squish Error Too Large"))
|
|
@assertLessThan(maxSqErr, 1.0e-15_rp, trim("Per Cell Distributed Squish Error Too Large"))
|
|
|
|
else
|
|
! helpers
|
|
helperQuit = .false.
|
|
do while(.not. helperQuit)
|
|
call helpVoltron(voltAppMpi, helperQuit)
|
|
end do
|
|
endif
|
|
endif
|
|
|
|
end subroutine
|
|
|
|
@test(npes=[8])
|
|
subroutine testHelpSquishDip(this)
|
|
class (MpiTestMethod), intent(inout) :: this
|
|
|
|
real(rp), dimension(:,:,:,:), allocatable :: distSquish
|
|
real(rp), dimension(2) :: posErr
|
|
real(rp) :: sqErr, maxSqErr
|
|
integer :: i,j,k
|
|
logical :: helperQuit
|
|
|
|
! debugging
|
|
!type(IOVAR_T), dimension(12) :: IOVars
|
|
|
|
write (*,'(a,I0)') 'Testing HelpSquish ',this%getNumProcesses()
|
|
|
|
call manualSetup(this, 'testHelpersSquish_4.xml')
|
|
|
|
if(allocated(gamCplMpi)) then
|
|
call runApplication()
|
|
else
|
|
voltAppMpi%ebTrcApp%ebModel%doDip = .true.
|
|
call runApplication()
|
|
endif
|
|
|
|
! Now compare distributed squish results to local-only squish results
|
|
if(allocated(voltAppMpi)) then
|
|
if(.not. voltAppMpi%amHelper) then
|
|
|
|
! call doImag once to update rTrc and nTrc before doing any squishing
|
|
call PreDeep(voltAppMpi, voltAppMpi%gApp)
|
|
call DoImag(voltAppMpi)
|
|
|
|
! calculate distributed squish from most recent results
|
|
call startDeep(voltAppMpi)
|
|
do while(deepInProgress(voltAppMpi))
|
|
call doDeepBlock(voltAppMpi)
|
|
enddo
|
|
call vhReqHelperQuit(voltAppMpi) ! tell the helpers they're done
|
|
allocate(distSquish, MOLD=voltAppMpi%chmp2mhd%xyzSquish)
|
|
distSquish = voltAppMpi%chmp2mhd%xyzSquish
|
|
|
|
! now calculate local-only squish
|
|
voltAppMpi%ebTrcApp%ebSquish%myNumBlocks = -1 ! I do all blocks
|
|
voltAppMpi%ebTrcApp%ebSquish%myFirstBlock = 1 ! ensure I start with the first block
|
|
call DeepUpdate(voltAppMpi, voltAppMpi%gApp)
|
|
|
|
sqErr = 0
|
|
maxSqErr = 0
|
|
do i=voltAppMpi%ebTrcApp%ebState%ebGr%is,voltAppMpi%iDeep+1
|
|
do j=voltAppMpi%ebTrcApp%ebState%ebGr%js,voltAppMpi%ebTrcApp%ebState%ebGr%je+1
|
|
do k=voltAppMpi%ebTrcApp%ebState%ebGr%ks,voltAppMpi%ebTrcApp%ebState%ebGr%ke+1
|
|
posErr = abs(distSquish(i,j,k,:) - voltAppMpi%chmp2mhd%xyzSquish(i,j,k,:))
|
|
if(posErr(2) > PI) posErr(2) = 2*PI - posErr(2)
|
|
sqErr = sqErr + NORM2(posErr)
|
|
maxSqErr = MAX(maxSqErr, NORM2(posErr))
|
|
enddo
|
|
enddo
|
|
enddo
|
|
|
|
! debugging...
|
|
!call ClearIO(IOVars)
|
|
!call AddOutVar(IOVars,"distSquish",distSquish)
|
|
!call AddOutVar(IOVars,"localSquish",voltAppMpi%chmp2mhd%xyzSquish)
|
|
!call WriteVars(IOVars,.false.,"SquishTestData.h5")
|
|
! ...debugging
|
|
|
|
deallocate(distSquish)
|
|
|
|
! Floating point error rounding
|
|
@assertLessThan(sqErr, 1.0e-15_rp, trim("Total Distributed Squish Error Too Large"))
|
|
@assertLessThan(maxSqErr, 1.0e-15_rp, trim("Per Cell Distributed Squish Error Too Large"))
|
|
|
|
else
|
|
! helpers
|
|
helperQuit = .false.
|
|
do while(.not. helperQuit)
|
|
call helpVoltron(voltAppMpi, helperQuit)
|
|
end do
|
|
endif
|
|
endif
|
|
|
|
end subroutine
|
|
|
|
end module testHelpers
|
|
|