AtHeartEngineer/kaiju
1
0
Fork 0
mirror of https://github.com/JHUAPL/kaiju.git synced 2026-01-09 15:17:56 -05:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'mftake2' into raijuport

Browse Source
This commit is contained in:
Anthony M. Sciola
2024-09-16 08:06:25 -07:00
parent 7e9e4e198e 3d61482627
commit 3823745e8b
357 changed files with 10394 additions and 43937 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
tests/CMakeLists.txt
View File

@@ -30,7 +30,7 @@ add_dependencies(voltTests ${voltTestLibs})
file(GLOB rcmTestFiles "${CMAKE_CURRENT_SOURCE_DIR}/rcm/*.pf")
set(rcmTestLibs baselib gamlib voltlib remixlib rcmlib tgiclib)
add_pfunit_ctest(rcmTests TEST_SOURCES ${rcmTestFiles} OTHER_SOURCES ${helperFiles} LINK_LIBRARIES ${rcmTestLibs} MAX_PES 1)
add_pfunit_ctest(rcmTests TEST_SOURCES ${rcmTestFiles} OTHER_SOURCES ${helperFiles} LINK_LIBRARIES ${rcmTestLibs})
add_dependencies(rcmTests ${rcmTestLibs})
file(GLOB shgrTestFiles "${CMAKE_CURRENT_SOURCE_DIR}/shellgrid/*.pf")
@@ -98,15 +98,15 @@ endif()
# all tests in one
if(ENABLE_MPI)
# include MPI tests
set(allTestFiles ${caseTestFiles} ${gamTestFiles} ${mixTestFiles} ${voltTestFiles} ${caseMpiTestFiles} ${baseMpiTestFiles} ${gamMpiTestFiles} ${voltMpiTestFiles})
set(allTestLibs baselib gamlib remixlib voltlib basempilib gammpilib voltmpilib tgiclib)
set(allTestBins caseTests gamTests mixTests voltTests gamMpiTests baseMpiTests caseMpiTests voltMpiTests)
set(allTestFiles ${caseTestFiles} ${gamTestFiles} ${mixTestFiles} ${voltTestFiles} ${rcmTestFiles} ${shgrTestFiles} ${caseMpiTestFiles} ${baseMpiTestFiles} ${gamMpiTestFiles} ${voltMpiTestFiles})
set(allTestLibs baselib gamlib remixlib voltlib rcmlib basempilib gammpilib voltmpilib tgiclib)
set(allTestBins caseTests gamTests mixTests voltTests rcmTests shgrTests gamMpiTests baseMpiTests caseMpiTests voltMpiTests)
add_pfunit_ctest (allTests TEST_SOURCES ${allTestFiles} OTHER_SOURCES ${helperFiles} ${helperFilesMpi} LINK_LIBRARIES ${allTestLibs} MAX_PES 64)
else()
# exclude MPI tests
set(allTestFiles ${caseTestFiles} ${gamTestFiles} ${mixTestFiles} ${voltTestFiles} ${rcmTestFiles})
set(allTestLibs baselib gamlib remixlib voltlib tgiclib)
set(allTestBins caseTests gamTests mixTests voltTests)
set(allTestFiles ${caseTestFiles} ${gamTestFiles} ${mixTestFiles} ${voltTestFiles} ${rcmTestFiles} ${shgrTestFiles})
set(allTestLibs baselib gamlib remixlib voltlib rcmlib tgiclib)
set(allTestBins caseTests gamTests mixTests voltTests rcmTests shgrTests)
add_pfunit_ctest (allTests TEST_SOURCES ${allTestFiles} OTHER_SOURCES ${helperFiles} LINK_LIBRARIES ${allTestLibs})
endif()
add_dependencies(allTests CopyInputs CopyGrids ${allTestBins} ${allTestLibs})

6
tests/genTestData.pbs → tests/_obsolete/genTestData.pbs
View File

@@ -1,6 +1,6 @@
#!/bin/bash
#PBS -N testResGen
#PBS -A UJHB0019
#PBS -A P28100045
#PBS -l walltime=00:30:00
#PBS -q main
#PBS -l select=4:ncpus=128:mpiprocs=2:ompthreads=64+1:ncpus=128:mpiprocs=1:ompthreads=128
@@ -12,7 +12,7 @@
# KAIJUROOTDIR and MODULE_LIST must be set as transferred environment
# variables on the qsub command line.
# Example qsub command:
# qsub -A UJHB0019 -v $HOME/kaiju,MODULE_LIST='module1 module2 ...'
# qsub -A P28100045 -v $HOME/kaiju,MODULE_LIST='module1 module2 ...'
echo "Job $PBS_JOBID started at `date` on `hostname` in directory `pwd`."
@@ -34,6 +34,6 @@ echo 'The active environment variables are:'
printenv
echo 'Generating data for testing.'
$MPICOMMAND ./voltron_mpi.x geo_mpi.xml > geo_mpi.out
$MPICOMMAND ./voltron_mpi.x cmiD_deep_8_genRes.xml > cmiD_deep_8_genRes.out
echo "Job $PBS_JOBID ended at `date` on `hostname` in directory `pwd`."

4
tests/runCaseTests.pbs → tests/_obsolete/runCaseTests.pbs
View File

@@ -1,6 +1,6 @@
#!/bin/bash
#PBS -N caseTests
#PBS -A UJHB0019
#PBS -A P28100045
#PBS -l walltime=12:00:00
#PBS -q main
#PBS -l select=1:ncpus=128:mpiprocs=8:ompthreads=16
@@ -12,7 +12,7 @@
# KAIJUROOTDIR and MODULE_LIST must be set as transferred environment
# variables on the qsub command line.
# Example qsub command:
# qsub -A UJHB0019 -v $HOME/kaiju,MODULE_LIST='module1 module2 ...'
# qsub -A P28100045 -v $HOME/kaiju,MODULE_LIST='module1 module2 ...'
echo "Job $PBS_JOBID started at `date` on `hostname` in directory `pwd`."

18
tests/runNonCaseTests1.pbs → tests/_obsolete/runNonCaseTests1.pbs
View File

@@ -1,6 +1,6 @@
#!/bin/bash
#PBS -N nonCaseTests1
#PBS -A UJHB0019
#PBS -A P28100045
#PBS -l walltime=12:00:00
#PBS -q main
#PBS -l select=1:ncpus=128:mpiprocs=64:ompthreads=128
@@ -12,7 +12,7 @@
# KAIJUROOTDIR and MODULE_LIST must be set as transferred environment
# variables on the qsub command line.
# Example qsub command:
# qsub -A UJHB0019 -v $HOME/kaiju,MODULE_LIST='module1 module2 ...'
# qsub -A P28100045 -v $HOME/kaiju,MODULE_LIST='module1 module2 ...'
echo "Job $PBS_JOBID started at `date` on `hostname` in directory `pwd`."
@@ -47,6 +47,20 @@ date
echo 'REMIX tests complete.'
echo | tail -n 3 ./mixTests.out
echo 'Running RCM tests.'
date
./rcmTests > rcmTests.out
date
echo 'RCM tests complete.'
echo | tail -n 3 ./rcmTests.out
echo 'Running SHELLGRID tests.'
date
./shgrTests > shgrTests.out
date
echo 'SHELLGRID tests complete.'
echo | tail -n 3 ./shgrTests.out
echo 'Running VOLTRON tests.'
date
./voltTests > voltTests.out

32
tests/runNonCaseTests2.pbs → tests/_obsolete/runNonCaseTests2.pbs
View File

@@ -1,32 +1,27 @@
#!/bin/bash
#PBS -N nonCaseTests2
#PBS -A UJHB0019
#PBS -l walltime=12:00:00
#PBS -q main
#PBS -N {{ job_name }}
#PBS -A {{ account }}
#PBS -q {{ queue }}
#PBS -l job_priority={{ job_priority }}
#PBS -l walltime={{ walltime }}
#PBS -l select=2:ncpus=128:mpiprocs=9:ompthreads=128
#PBS -j oe
#PBS -m abe
# NOTE: The user account must be specified on the qsub command line with the
# -A option,
# KAIJUROOTDIR and MODULE_LIST must be set as transferred environment
# variables on the qsub command line.
# Example qsub command:
# qsub -A UJHB0019 -v $HOME/kaiju,MODULE_LIST='module1 module2 ...'
echo "Job $PBS_JOBID started at `date` on `hostname` in directory `pwd`."
echo 'Setting up MAGE environment.'
source $KAIJUROOTDIR/scripts/setupEnvironment.sh
echo 'Loading modules.'
module --force purge
module load $MODULE_LIST
echo 'The following modules are loaded:'
{%- for module in modules %}
module load {{ module }}
{%- endfor %}
module list
echo 'Setting up MAGE environment.'
source {{ kaijuhome }}/scripts/setupEnvironment.sh
echo 'Setting environment variables.'
MPICOMMAND="mpiexec $KAIJUHOME/scripts/preproc/pinCpuCores.sh"
export OMP_NUM_THREADS=128
export MPI_TYPE_DEPTH=32
export KMP_STACKSIZE=128M
@@ -34,9 +29,8 @@ echo 'The active environment variables are:'
printenv
echo 'Running VOLTRON MPI tests.'
date
MPICOMMAND="mpiexec $KAIJUHOME/scripts/preproc/pinCpuCores.sh"
${MPICOMMAND} ./voltMpiTests > voltMpiTests.out
date
echo 'VOLTRON MPI tests complete.'
echo | tail -n 3 ./voltMpiTests.out

51
tests/_obsolete/unitTestReport.pbs Normal file
View File

@@ -0,0 +1,51 @@
#!/bin/bash
#PBS -N unitTestReport
#PBS -A P28100045
#PBS -l walltime=00:10:00
#PBS -q main
#PBS -l select=1:ncpus=128
#PBS -j oe
#PBS -m abe
echo "Job $PBS_JOBID started at `date` on `hostname` in directory `pwd`."
echo 'Setting up MAGE environment.'
source $KAIJUROOTDIR/scripts/setupEnvironment.sh
echo 'Loading modules.'
module --force purge
module load $MODULE_LIST
echo 'The following modules are loaded:'
module list
# Set up conda.
export MAGE_TEST_ROOT='/glade/work/ewinter/mage_testing/derecho'
# MAGE_TEST_SET_ROOT, DERECHO_TESTING_ACCOUNT, and SLACK_BOT_TOKEN must be
# passed in on command line as environment variables.
export CONDARC="${MAGE_TEST_ROOT}/condarc"
export CONDA_ENVS_PATH="${MAGE_TEST_ROOT}/conda"
mage_miniconda3="${MAGE_TEST_ROOT}/miniconda3"
mage_conda="${mage_miniconda3}/bin/conda"
__conda_setup="$($mage_conda 'shell.bash' 'hook' 2> /dev/null)"
if [ $? -eq 0 ]; then
eval "$__conda_setup"
else
if [ -f "$mage_miniconda3/etc/profile.d/conda.sh" ]; then
. "$mage_miniconda3/etc/profile.d/conda.sh"
else
export PATH="$mage_miniconda3/bin:$PATH"
fi
fi
unset __conda_setup
conda_testing_environment='kaiju-3.8-testing'
conda activate $conda_testing_environment
export PYTHONUNBUFFERED=TRUE
echo 'Setting environment variables.'
echo 'The active environment variables are:'
printenv
echo 'Generating unit test report.'
python $KAIJUHOME/testingScripts/unitTestReport.py -lv
echo "Job $PBS_JOBID ended at `date` on `hostname` in directory `pwd`."

43
tests/cases/testCases.pf
View File

@@ -17,6 +17,18 @@ contains
subroutine lastSerial()
end subroutine lastSerial
subroutine caseTestInit(gameraApp, caseFile)
class(gamApp_T), intent(inout) :: gameraApp
character(len=*), intent(in) :: caseFile
type(XML_Input_T) :: xmlInp
gameraApp%gOptions%userInitFunc => initUser
xmlInp = New_XML_Input(trim(caseFile),'Kaiju',.true.)
call gameraApp%InitModel(xmlInp)
end subroutine
@test
subroutine testLoop2D()
! a magnetic field should be moved along by the fluid
@@ -24,7 +36,7 @@ contains
real(rp), dimension(:,:,:), allocatable :: initialMagneticField
real(rp) :: totalError, initialTotalMagneticField, finalTotalMagneticField
call initGamera(gameraApp, initUser, 'loop2d.xml')
call caseTestInit(gameraApp,'loop2d.xml')
! save initial magnetic field
allocate(initialMagneticField(gameraApp%Grid%isg:gameraApp%Grid%ieg+1,gameraApp%Grid%jsg:gameraApp%Grid%jeg+1,gameraApp%Grid%ksg:gameraApp%Grid%keg+1))
@@ -52,7 +64,7 @@ contains
real(rp), dimension(:,:,:), allocatable :: initialGasDensity
real(rp) :: totalError, initialTotalDensity, finalTotalDensity
call initGamera(gameraApp, initUser, 'adv2d.xml')
call caseTestInit(gameraApp, 'adv2d.xml')
! save initial density
allocate(initialGasDensity(gameraApp%Grid%isg:gameraApp%Grid%ieg,gameraApp%Grid%jsg:gameraApp%Grid%jeg,gameraApp%Grid%ksg:gameraApp%Grid%keg))
@@ -79,7 +91,7 @@ contains
real(rp), dimension(:,:,:), allocatable :: initialMagneticField
real(rp) :: totalError, initialTotalMagneticField, finalTotalMagneticField
call initGamera(gameraApp, initUser, 'alfven.xml')
call caseTestInit(gameraApp, 'alfven.xml')
! save initial magnetic field
allocate(initialMagneticField(gameraApp%Grid%isg:gameraApp%Grid%ieg+1,gameraApp%Grid%jsg:gameraApp%Grid%jeg+1,gameraApp%Grid%ksg:gameraApp%Grid%keg+1))
@@ -107,7 +119,7 @@ contains
L2Tol = 7.0e-3
call initGamera(gameraApp, initUser, 'adv1d.xml')
call caseTestInit(gameraApp, 'adv1d.xml')
associate(Gr=>gameraApp%Grid,Gas=>gameraApp%State%Gas)
!Allocate arrays
@@ -141,7 +153,7 @@ contains
L2Tol = 7.0e-3
call initGamera(gameraApp, initUser, 'adv1d_8cent.xml')
call caseTestInit(gameraApp, 'adv1d_8cent.xml')
associate(Gr=>gameraApp%Grid,Gas=>gameraApp%State%Gas)
!Allocate arrays
@@ -176,7 +188,8 @@ contains
real(rp) :: dG
real(rp), dimension(NVAR) :: Gij,Gijp
call initGamera(gameraApp, initUser, 'ot2d.xml')
call caseTestInit(gameraApp, 'ot2d.xml')
!Now advance for period of time specified in XML
do while ( (gameraApp%Model%t < gameraApp%Model%tFin) )
call stepGamera(gameraApp)
@@ -213,24 +226,16 @@ contains
@test
subroutine testRemix()
type(gamApp_T) :: gameraApp
type(voltApp_T) :: voltronApp
character(len=strLen) :: caseInput = 'cmiD.xml'
call initGamera(gameraApp, initUser, caseInput)
call initVoltron(voltronApp, gameraApp, caseInput)
voltronApp%vOptions%gamUserInitFunc => initUser
call initVoltron(voltronApp, caseInput)
! Manually running for just 1 second of simulation time
do while ((1.0 - gameraApp%Model%t*gameraApp%Model%Units%gT0) > 1e-15)
call stepGamera(gameraApp)
! run for one coupling interval
call stepVoltron(voltronApp, voltronApp%DeepDT)
if (gameraApp%Model%t >= voltronApp%DeepT) then
call convertGameraToRemix(voltronApp%mhd2mix, gameraApp, voltronApp%remixApp)
call runRemix(voltronApp)
call convertRemixToGamera(voltronApp%mix2mhd, voltronApp%remixApp, gameraApp)
endif
end do
write(*,*) 'End time = ', gameraApp%Model%t
write(*,*) 'End time = ', voltronApp%gApp%Model%t
end subroutine testRemix

8
tests/cases_mpi/testCasesMpi.pf
View File

@@ -25,15 +25,19 @@ contains
class (MpiTestMethod), intent(inout) :: this
type(gamAppMpi_T) :: gameraAppMpi
type(XML_Input_T) :: xmlInp
call setMpiReal()
call initGamera_mpi(gameraAppMpi, initUser, getMpiF08Communicator(this), 'blast3d_large.xml')
gameraAppMpi%gOptions%userInitFunc => initUser
gameraAppMpi%gOptionsMpi%gamComm = getMpiF08Communicator(this)
xmlInp = New_XML_Input('blast3d_large.xml','Kaiju',.true.)
call gameraAppMpi%InitModel(xmlInp)
do while ((gameraAppMpi%Model%tFin - gameraAppMpi%Model%t) > 1e-15)
call stepGamera_mpi(gameraAppMpi)
if (gameraAppMpi%Model%IO%doConsole(gameraAppMpi%Model%ts)) then
if (gameraAppMpi%Model%IO%doConsole(gameraAppMpi%Model%t)) then
call consoleOutput(gameraAppMpi%Model,gameraAppMpi%Grid,gameraAppMpi%State)
endif

28
tests/gamera/testfields.pf
View File

@@ -5,35 +5,33 @@ module testFields
implicit none
type(gamApp_T), allocatable :: gApp
procedure(StateIC_T), pointer :: userInitFunc => initUser
type(gamApp_T), pointer :: gApp
contains
@before
subroutine setup()
allocate(gApp)
type(XML_Input_T) :: xmlInp
call initGamera(gApp,userInitFunc,'lfmbw.xml')
! create instance of gamera app, and perform any needed configuration
allocate(gApp)
gApp%gOptions%userInitFunc => initUser
do while (gApp%Model%t < gApp%Model%tFin)
call stepGamera(gApp)
! run the gamera app
xmlInp = New_XML_Input('lfmbw.xml','Kaiju',.true.)
call gApp%InitModel(xmlInp)
call gApp%InitIO(xmlInp)
if (gApp%Model%IO%doConsole(gApp%Model%ts)) then
call consoleOutput(gApp%Model,gApp%Grid,gApp%State)
endif
if (gApp%Model%IO%doOutput(gApp%Model%t)) then
call fOutput(gApp%Model,gApp%Grid,gApp%State)
endif
end do
do while (gApp%Model%t < gApp%Model%tFin)
call gApp%AdvanceModel(0.0_rp)
end do
end subroutine setup
@after
subroutine teardown()
deallocate(gApp)
gApp => null()
end subroutine teardown
subroutine verifyFaces4(var,varName,is,ie,js,je,ks,ke)

15
tests/gamera_mpi/testmpi.pf
View File

@@ -13,13 +13,22 @@ contains
subroutine setup(this)
class (MpiTestMethod), intent(inout) :: this
character(len=strLen) :: caseFile
type(XML_Input_T) :: xmlInp
! basic initialization
call setMpiReal()
write(caseFile,'(A,I0,A)') 'blast3d_', this%getNumProcesses(), '.xml'
call initClocks()
allocate(gamAppMpi)
call initGamera_mpi(gamAppMpi, initUser, getMpiF08Communicator(this), caseFile, .false.)
gamAppMpi%gOptions%userInitFunc => initUser
gamAppMpi%gOptionsMpi%gamComm = getMpiF08Communicator(this)
gamAppMpi%gOptionsMpi%doIO = .false.
write(caseFile,'(A,I0,A)') 'blast3d_', this%getNumProcesses(), '.xml'
xmlInp = New_XML_Input(caseFile,'Kaiju',.true.)
call initGamera_mpi(gamAppMpi, xmlInp)
end subroutine setup

131
tests/gamera_mpi/testmpibc.pf
View File

@@ -12,14 +12,17 @@ contains
@before
subroutine setup(this)
class (MpiTestMethod), intent(inout) :: this
character(len=strLen) :: caseFile
! basic initialization
call setMpiReal()
write(caseFile,'(A,I0,A)') 'blast3d_bc_', this%getNumProcesses(), '.xml'
call initClocks()
allocate(gamAppMpi)
gamAppMpi%gOptions%userInitFunc => initUser
gamAppMpi%gOptionsMpi%gamComm = getMpiF08Communicator(this)
gamAppMpi%gOptionsMpi%doIO = .false.
end subroutine setup
@after
@@ -399,9 +402,11 @@ contains
@test(npes=[1])
subroutine testHalo111FFF(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this), &
'blast3d_bc_111_FFF.xml',.false.)
xmlInp = New_XML_Input('blast3d_bc_111_FFF.xml','Kaiju',.true.)
call initGamera_mpi(gamAppMpi,xmlInp)
call setPreHaloData(.false.,.false.,.false.)
@@ -415,9 +420,11 @@ contains
@test(npes=[1])
subroutine testHalo111TFF(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this), &
'blast3d_bc_111_TFF.xml',.false.)
xmlInp = New_XML_Input('blast3d_bc_111_TFF.xml','Kaiju',.true.)
call initGamera_mpi(gamAppMpi,xmlInp)
call setPreHaloData(.true.,.false.,.false.)
@@ -431,9 +438,11 @@ contains
@test(npes=[1])
subroutine testHalo111TTF(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this), &
'blast3d_bc_111_TTF.xml',.false.)
xmlInp = New_XML_Input('blast3d_bc_111_TTF.xml','Kaiju',.true.)
call initGamera_mpi(gamAppMpi,xmlInp)
call setPreHaloData(.true.,.true.,.false.)
@@ -447,10 +456,12 @@ contains
@test(npes=[1])
subroutine testHalo111TTT(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
xmlInp = New_XML_Input('blast3d_bc_111_TTT.xml','Kaiju',.true.)
call initGamera_mpi(gamAppMpi,xmlInp)
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this), &
'blast3d_bc_111_TTT.xml',.false.)
call setPreHaloData(.true.,.true.,.true.)
call haloUpdate(gamAppMpi, gamAppMpi%State)
@@ -463,9 +474,11 @@ contains
@test(npes=[4])
subroutine testHalo411FFF(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this), &
'blast3d_bc_411_FFF.xml',.false.)
xmlInp = New_XML_Input('blast3d_bc_411_FFF.xml','Kaiju',.true.)
call initGamera_mpi(gamAppMpi,xmlInp)
call setPreHaloData(.false.,.false.,.false.)
@@ -479,9 +492,11 @@ contains
@test(npes=[4])
subroutine testHalo411TFF(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this), &
'blast3d_bc_411_TFF.xml',.false.)
xmlInp = New_XML_Input('blast3d_bc_411_TFF.xml','Kaiju',.true.)
call initGamera_mpi(gamAppMpi,xmlInp)
call setPreHaloData(.true.,.false.,.false.)
@@ -495,9 +510,11 @@ contains
@test(npes=[4])
subroutine testHalo411FTF(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this), &
'blast3d_bc_411_FTF.xml',.false.)
xmlInp = New_XML_Input('blast3d_bc_411_FTF.xml','Kaiju',.true.)
call initGamera_mpi(gamAppMpi,xmlInp)
call setPreHaloData(.false.,.true.,.false.)
@@ -511,9 +528,11 @@ contains
@test(npes=[4])
subroutine testHalo411TTF(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this), &
'blast3d_bc_411_TTF.xml',.false.)
xmlInp = New_XML_Input('blast3d_bc_411_TTF.xml','Kaiju',.true.)
call initGamera_mpi(gamAppMpi,xmlInp)
call setPreHaloData(.true.,.true.,.false.)
@@ -527,9 +546,11 @@ contains
@test(npes=[4])
subroutine testHalo411FTT(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this), &
'blast3d_bc_411_FTT.xml',.false.)
xmlInp = New_XML_Input('blast3d_bc_411_FTT.xml','Kaiju',.true.)
call initGamera_mpi(gamAppMpi,xmlInp)
call setPreHaloData(.false.,.true.,.true.)
@@ -543,9 +564,11 @@ contains
@test(npes=[4])
subroutine testHalo411TTT(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this), &
'blast3d_bc_411_TTT.xml',.false.)
xmlInp = New_XML_Input('blast3d_bc_411_TTT.xml','Kaiju',.true.)
call initGamera_mpi(gamAppMpi,xmlInp)
call setPreHaloData(.true.,.true.,.true.)
@@ -559,9 +582,11 @@ contains
@test(npes=[16])
subroutine testHalo441FFF(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this), &
'blast3d_bc_441_FFF.xml',.false.)
xmlInp = New_XML_Input('blast3d_bc_441_FFF.xml','Kaiju',.true.)
call initGamera_mpi(gamAppMpi,xmlInp)
call setPreHaloData(.false.,.false.,.false.)
@@ -575,9 +600,11 @@ contains
@test(npes=[16])
subroutine testHalo441TFF(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this), &
'blast3d_bc_441_TFF.xml',.false.)
xmlInp = New_XML_Input('blast3d_bc_441_TFF.xml','Kaiju',.true.)
call initGamera_mpi(gamAppMpi,xmlInp)
call setPreHaloData(.true.,.false.,.false.)
@@ -591,9 +618,11 @@ contains
@test(npes=[16])
subroutine testHalo441FFT(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this), &
'blast3d_bc_441_FFT.xml',.false.)
xmlInp = New_XML_Input('blast3d_bc_441_FFT.xml','Kaiju',.true.)
call initGamera_mpi(gamAppMpi,xmlInp)
call setPreHaloData(.false.,.false.,.true.)
@@ -607,9 +636,11 @@ contains
@test(npes=[16])
subroutine testHalo441TTF(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this), &
'blast3d_bc_441_TTF.xml',.false.)
xmlInp = New_XML_Input('blast3d_bc_441_TTF.xml','Kaiju',.true.)
call initGamera_mpi(gamAppMpi,xmlInp)
call setPreHaloData(.true.,.true.,.false.)
@@ -623,9 +654,11 @@ contains
@test(npes=[16])
subroutine testHalo441TFT(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this), &
'blast3d_bc_441_TFT.xml',.false.)
xmlInp = New_XML_Input('blast3d_bc_441_TFT.xml','Kaiju',.true.)
call initGamera_mpi(gamAppMpi,xmlInp)
call setPreHaloData(.true.,.false.,.true.)
@@ -639,9 +672,11 @@ contains
@test(npes=[16])
subroutine testHalo441TTT(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this), &
'blast3d_bc_441_TTT.xml',.false.)
xmlInp = New_XML_Input('blast3d_bc_441_TTT.xml','Kaiju',.true.)
call initGamera_mpi(gamAppMpi,xmlInp)
call setPreHaloData(.true.,.true.,.true.)
@@ -655,9 +690,11 @@ contains
@test(npes=[64])
subroutine testHalo444FFF(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this), &
'blast3d_bc_444_FFF.xml',.false.)
xmlInp = New_XML_Input('blast3d_bc_444_FFF.xml','Kaiju',.true.)
call initGamera_mpi(gamAppMpi,xmlInp)
call setPreHaloData(.false.,.false.,.false.)
@@ -671,9 +708,11 @@ contains
@test(npes=[64])
subroutine testHalo444TFF(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this), &
'blast3d_bc_444_TFF.xml',.false.)
xmlInp = New_XML_Input('blast3d_bc_444_TFF.xml','Kaiju',.true.)
call initGamera_mpi(gamAppMpi,xmlInp)
call setPreHaloData(.true.,.false.,.false.)
@@ -687,9 +726,11 @@ contains
@test(npes=[64])
subroutine testHalo444TTF(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this), &
'blast3d_bc_444_TTF.xml',.false.)
xmlInp = New_XML_Input('blast3d_bc_444_TTF.xml','Kaiju',.true.)
call initGamera_mpi(gamAppMpi,xmlInp)
call setPreHaloData(.true.,.true.,.false.)
@@ -703,9 +744,11 @@ contains
@test(npes=[64])
subroutine testHalo444TTT(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this), &
'blast3d_bc_444_TTT.xml',.false.)
xmlInp = New_XML_Input('blast3d_bc_444_TTT.xml','Kaiju',.true.)
call initGamera_mpi(gamAppMpi,xmlInp)
call setPreHaloData(.true.,.true.,.true.)

97
tests/gamera_mpi/testmpifields.pf
View File

@@ -13,15 +13,25 @@ contains
subroutine setup(this)
class (MpiTestMethod), intent(inout) :: this
type(XML_Input_T) :: xmlInp
call setMpiReal()
allocate(gamAppMpi)
call initGamera_mpi(gamAppMpi,initUser,getMpiF08Communicator(this),'lfmbw_241.xml',.false.)
! set options for gamera app
gamAppMpi%gOptions%userInitFunc => initUser
gamAppMpi%gOptionsMpi%gamComm = getMpiF08Communicator(this)
gamAppMpi%gOptionsMpi%doIO = .false.
do while ((gamAppMpi%Model%tFin - gamAppMpi%Model%t) > 1e-15)
call stepGamera_mpi(gamAppMpi)
enddo
! run the gamera app
xmlInp = New_XML_Input('lfmbw_241.xml','Kaiju',.true.)
call gamAppMpi%InitModel(xmlInp)
call gamAppMpi%InitIO(xmlInp)
do while (gamAppMpi%Model%t < gamAppMpi%Model%tFin)
call gamAppMpi%AdvanceModel(0.0_rp)
end do
end subroutine setup
@@ -30,6 +40,7 @@ contains
class (MpiTestMethod), intent(inout) :: this
deallocate(gamAppMpi)
end subroutine teardown
subroutine copyFaces4(var,is,ie,js,je,ks,ke)
@@ -90,21 +101,28 @@ contains
end subroutine copyFaces4
subroutine verifyFaces4(var,varName,is,ie,js,je,ks,ke)
subroutine verifyFaces4(var,varName,is,ie,js,je,ks,ke,thresholdO)
integer, intent(in) :: is,ie,js,je,ks,ke
real(rp), intent(in) :: var(is:ie,js:je,ks:ke,NDIM)
character(len=*), intent(in) :: varName
real(rp), intent(in), optional :: thresholdO
integer :: i,j,k
character(len=strLen) :: checkMessage
real(rp) :: checkValue
real(rp) :: checkValue, threshold
if(present(thresholdO)) then
threshold = thresholdO
else
threshold = 0.0_rp
endif
! min/max K faces
do i=gamAppMpi%Grid%is,gamAppMpi%Grid%ie
do j=gamAppMpi%Grid%js,gamAppMpi%Grid%je
write (checkMessage,'(A,A,A,I0,A,I0,A,I0,A)') 'Bad K face value in ',trim(varName),' at (',i,',',j,',',gamAppMpi%Grid%ks,')'
checkValue = abs(var(i,j,gamAppMpi%Grid%ks,KDIR) - var(i,j,gamAppMpi%Grid%ke+1,KDIR))
@assertLessThanOrEqual(checkValue, 0.0_rp,trim(checkMessage))
@assertLessThanOrEqual(checkValue, threshold, trim(checkMessage))
enddo
enddo
@@ -114,7 +132,7 @@ contains
do k=gamAppMpi%Grid%ks,gamAppMpi%Grid%ke
write (checkMessage,'(A,A,A,I0,A,I0,A,I0,A)') 'Bad I face value in ',trim(varName),' at (',gamAppMpi%Grid%is,',',j,',',k,')'
checkValue = abs(var(gamAppMpi%Grid%ie+1,j,k,IDIR)-var(gamAppMpi%Grid%is,j,k,IDIR))
@assertLessThanOrEqual(checkValue, 0.0_rp,trim(checkMessage))
@assertLessThanOrEqual(checkValue, threshold, trim(checkMessage))
enddo
enddo
endif
@@ -125,7 +143,7 @@ contains
do k=gamAppMpi%Grid%ks,gamAppMpi%Grid%ke
write (checkMessage,'(A,A,A,I0,A,I0,A,I0,A)') 'Bad J face value in ',trim(varName),' at (',i,',',gamAppMpi%Grid%js,',',k,')'
checkValue = abs(var(i,gamAppMpi%Grid%je+1,k,JDIR)-var(i,gamAppMpi%grid%js,k,JDIR))
@assertLessThanOrEqual(checkValue, 0.0_rp,trim(checkMessage))
@assertLessThanOrEqual(checkValue, threshold, trim(checkMessage))
enddo
enddo
endif
@@ -191,21 +209,29 @@ contains
end subroutine copyFaces5
subroutine verifyFaces5(var,varName,is,ie,js,je,ks,ke,dn)
subroutine verifyFaces5(var,varName,is,ie,js,je,ks,ke,dn,thresholdO)
integer, intent(in) :: is,ie,js,je,ks,ke,dn
real(rp), intent(in) :: var(is:ie,js:je,ks:ke,dn,NDIM)
character(len=*), intent(in) :: varName
real(rp), intent(in), optional :: thresholdO
integer :: i,j,k
character(len=strLen) :: checkMessage
real(rp) :: checkValue
real(rp) :: checkValue, threshold
if(present(thresholdO)) then
threshold = thresholdO
else
threshold = 0.0_rp
endif
! min/max K faces
do i=gamAppMpi%Grid%is,gamAppMpi%Grid%ie
do j=gamAppMpi%Grid%js,gamAppMpi%Grid%je
write (checkMessage,'(A,A,A,I0,A,I0,A,I0,A)') 'Bad K face value in ',trim(varName),' at (',i,',',j,',',gamAppMpi%Grid%ks,')'
checkValue = sum(abs(var(i,j,gamAppMpi%Grid%ks,:,KDIR) - var(i,j,gamAppMpi%Grid%ke+1,:,KDIR)))
@assertLessThanOrEqual(checkValue, 0.0_rp,trim(checkMessage))
@assertLessThanOrEqual(checkValue, threshold, trim(checkMessage))
enddo
enddo
@@ -215,7 +241,7 @@ contains
do k=gamAppMpi%Grid%ks,gamAppMpi%Grid%ke
write (checkMessage,'(A,A,A,I0,A,I0,A,I0,A)') 'Bad I face value in ',trim(varName),' at (',gamAppMpi%Grid%is,',',j,',',k,')'
checkValue = sum(abs(var(gamAppMpi%Grid%ie+1,j,k,:,IDIR)-var(gamAppMpi%Grid%is,j,k,:,IDIR)))
@assertLessThanOrEqual(checkValue, 0.0_rp,trim(checkMessage))
@assertLessThanOrEqual(checkValue, threshold, trim(checkMessage))
enddo
enddo
endif
@@ -226,7 +252,7 @@ contains
do k=gamAppMpi%Grid%ks,gamAppMpi%Grid%ke
write (checkMessage,'(A,A,A,I0,A,I0,A,I0,A)') 'Bad J face value in ',trim(varName),' at (',i,',',gamAppMpi%Grid%js,',',k,')'
checkValue = sum(abs(var(i,gamAppMpi%Grid%je+1,k,:,JDIR)-var(i,gamAppMpi%grid%js,k,:,JDIR)))
@assertLessThanOrEqual(checkValue, 0.0_rp,trim(checkMessage))
@assertLessThanOrEqual(checkValue, threshold, trim(checkMessage))
enddo
enddo
endif
@@ -321,21 +347,29 @@ contains
end subroutine copyEdges4
subroutine verifyEdges4(var,varName,is,ie,js,je,ks,ke)
subroutine verifyEdges4(var,varName,is,ie,js,je,ks,ke,thresholdO)
integer, intent(in) :: is,ie,js,je,ks,ke
real(rp), intent(in) :: var(is:ie,js:je,ks:ke,NDIM)
character(len=*), intent(in) :: varName
real(rp), intent(in), optional :: thresholdO
integer :: i,j,k
character(len=strLen) :: checkMessage
real(rp) :: checkValue
real(rp) :: checkValue, threshold
if(present(thresholdO)) then
threshold = thresholdO
else
threshold = 0.0_rp
endif
! I edges
do i=gamAppMpi%Grid%is,gamAppMpi%Grid%ie
do j=gamAppMpi%Grid%js,gamAppMpi%Grid%je+1
write (checkMessage,'(A,A,A,I0,A,I0,A,I0,A)') 'Bad I edge value in ',trim(varName),' at (',i,',',j,',',gamAppMpi%Grid%ks,')'
checkValue = abs(var(i,j,gamAppMpi%Grid%ks,IDIR) - var(i,j,gamAppMpi%Grid%ke+1,IDIR))
@assertLessThanOrEqual(checkValue, 0.0_rp,trim(checkMessage))
@assertLessThanOrEqual(checkValue, threshold, trim(checkMessage))
enddo
enddo
@@ -344,7 +378,7 @@ contains
do j=gamAppMpi%Grid%js,gamAppMpi%Grid%je
write (checkMessage,'(A,A,A,I0,A,I0,A,I0,A)') 'Bad J edge value in ',trim(varName),' at (',i,',',j,',',gamAppMpi%Grid%ks,')'
checkValue = abs(var(i,j,gamAppMpi%Grid%ks,JDIR) - var(i,j,gamAppMpi%Grid%ke+1,JDIR))
@assertLessThanOrEqual(checkValue, 0.0_rp,trim(checkMessage))
@assertLessThanOrEqual(checkValue, threshold, trim(checkMessage))
enddo
enddo
@@ -355,7 +389,7 @@ contains
do j=gamAppMpi%Grid%js,gamAppMpi%Grid%je
write (checkMessage,'(A,A,A,I0,A,I0,A,I0,A)') 'Bad J edge value in ',trim(varName),' at (',gamAppMpi%Grid%is,',',j,',',k,')'
checkValue = abs(var(gamAppMpi%Grid%is,j,k,JDIR) - var(gamAppMpi%Grid%ie+1,j,k,JDIR))
@assertLessThanOrEqual(checkValue, 0.0_rp,trim(checkMessage))
@assertLessThanOrEqual(checkValue, threshold, trim(checkMessage))
enddo
enddo
! K edges
@@ -363,7 +397,7 @@ contains
do j=gamAppMpi%Grid%js,gamAppMpi%Grid%je+1
write (checkMessage,'(A,A,A,I0,A,I0,A,I0,A)') 'Bad K edge value in ',trim(varName),' at (',gamAppMpi%Grid%is,',',j,',',k,')'
checkValue = abs(var(gamAppMpi%Grid%is,j,k,KDIR) - var(gamAppMpi%Grid%ie+1,j,k,KDIR))
@assertLessThanOrEqual(checkValue, 0.0_rp,trim(checkMessage))
@assertLessThanOrEqual(checkValue, threshold, trim(checkMessage))
enddo
enddo
endif
@@ -375,7 +409,7 @@ contains
do i=gamAppMpi%Grid%is,gamAppMpi%Grid%ie
write (checkMessage,'(A,A,A,I0,A,I0,A,I0,A)') 'Bad I edge value in ',trim(varName),' at (',i,',',gamAppMpi%Grid%js,',',k,')'
checkValue = abs(var(i,gamAppMpi%Grid%js,k,IDIR) - var(i,gamAppMpi%Grid%je+1,k,IDIR))
@assertLessThanOrEqual(checkValue, 0.0_rp,trim(checkMessage))
@assertLessThanOrEqual(checkValue, threshold, trim(checkMessage))
enddo
enddo
! K edges
@@ -383,7 +417,7 @@ contains
do i=gamAppMpi%Grid%js,gamAppMpi%Grid%ie+1
write (checkMessage,'(A,A,A,I0,A,I0,A,I0,A)') 'Bad K edge value in ',trim(varName),' at (',i,',',gamAppMpi%Grid%js,',',k,')'
checkValue = abs(var(i,gamAppMpi%Grid%js,k,KDIR) - var(i,gamAppMpi%Grid%je+1,k,KDIR))
@assertLessThanOrEqual(checkValue, 0.0_rp,trim(checkMessage))
@assertLessThanOrEqual(checkValue, threshold, trim(checkMessage))
enddo
enddo
endif
@@ -478,21 +512,22 @@ contains
end subroutine copyEdges5
subroutine verifyEdges5(var,varName,is,ie,js,je,ks,ke,dn)
subroutine verifyEdges5(var,varName,is,ie,js,je,ks,ke,dn,thresholdO)
integer, intent(in) :: is,ie,js,je,ks,ke,dn
real(rp), intent(in) :: var(is:ie,js:je,ks:ke,dn,NDIM)
character(len=*), intent(in) :: varName
real(rp), intent(in), optional :: thresholdO
integer :: i,j,k
character(len=strLen) :: checkMessage
real(rp) :: checkValue
real(rp) :: checkValue, threshold
! I edges
do i=gamAppMpi%Grid%is,gamAppMpi%Grid%ie
do j=gamAppMpi%Grid%js,gamAppMpi%Grid%je+1
write (checkMessage,'(A,A,A,I0,A,I0,A,I0,A)') 'Bad I edge value in ',trim(varName),' at (',i,',',j,',',gamAppMpi%Grid%ks,')'
checkValue = sum(abs(var(i,j,gamAppMpi%Grid%ks,:,IDIR) - var(i,j,gamAppMpi%Grid%ke+1,:,IDIR)))
@assertLessThanOrEqual(checkValue, 0.0_rp,trim(checkMessage))
@assertLessThanOrEqual(checkValue, threshold, trim(checkMessage))
enddo
enddo
@@ -501,7 +536,7 @@ contains
do j=gamAppMpi%Grid%js,gamAppMpi%Grid%je
write (checkMessage,'(A,A,A,I0,A,I0,A,I0,A)') 'Bad J edge value in ',trim(varName),' at (',i,',',j,',',gamAppMpi%Grid%ks,')'
checkValue = sum(abs(var(i,j,gamAppMpi%Grid%ks,:,JDIR) - var(i,j,gamAppMpi%Grid%ke+1,:,JDIR)))
@assertLessThanOrEqual(checkValue, 0.0_rp,trim(checkMessage))
@assertLessThanOrEqual(checkValue, threshold,trim(checkMessage))
enddo
enddo
@@ -512,7 +547,7 @@ contains
do j=gamAppMpi%Grid%js,gamAppMpi%Grid%je
write (checkMessage,'(A,A,A,I0,A,I0,A,I0,A)') 'Bad J edge value in ',trim(varName),' at (',gamAppMpi%Grid%is,',',j,',',k,')'
checkValue = sum(abs(var(gamAppMpi%Grid%is,j,k,:,JDIR) - var(gamAppMpi%Grid%ie+1,j,k,:,JDIR)))
@assertLessThanOrEqual(checkValue, 0.0_rp,trim(checkMessage))
@assertLessThanOrEqual(checkValue, threshold, trim(checkMessage))
enddo
enddo
! K edges
@@ -520,7 +555,7 @@ contains
do j=gamAppMpi%Grid%js,gamAppMpi%Grid%je+1
write (checkMessage,'(A,A,A,I0,A,I0,A,I0,A)') 'Bad K edge value in ',trim(varName),' at (',gamAppMpi%Grid%is,',',j,',',k,')'
checkValue = sum(abs(var(gamAppMpi%Grid%is,j,k,:,KDIR) - var(gamAppMpi%Grid%ie+1,j,k,:,KDIR)))
@assertLessThanOrEqual(checkValue, 0.0_rp,trim(checkMessage))
@assertLessThanOrEqual(checkValue, threshold, trim(checkMessage))
enddo
enddo
endif
@@ -532,7 +567,7 @@ contains
do i=gamAppMpi%Grid%is,gamAppMpi%Grid%ie
write (checkMessage,'(A,A,A,I0,A,I0,A,I0,A)') 'Bad I edge value in ',trim(varName),' at (',i,',',gamAppMpi%Grid%js,',',k,')'
checkValue = sum(abs(var(i,gamAppMpi%Grid%js,k,:,IDIR) - var(i,gamAppMpi%Grid%je+1,k,:,IDIR)))
@assertLessThanOrEqual(checkValue, 0.0_rp,trim(checkMessage))
@assertLessThanOrEqual(checkValue, threshold, trim(checkMessage))
enddo
enddo
! K edges
@@ -540,7 +575,7 @@ contains
do i=gamAppMpi%Grid%js,gamAppMpi%Grid%ie+1
write (checkMessage,'(A,A,A,I0,A,I0,A,I0,A)') 'Bad K edge value in ',trim(varName),' at (',i,',',gamAppMpi%Grid%js,',',k,')'
checkValue = sum(abs(var(i,gamAppMpi%Grid%js,k,:,KDIR) - var(i,gamAppMpi%Grid%je+1,k,:,KDIR)))
@assertLessThanOrEqual(checkValue, 0.0_rp,trim(checkMessage))
@assertLessThanOrEqual(checkValue, threshold, trim(checkMessage))
enddo
enddo
endif
@@ -628,7 +663,7 @@ contains
call verifyEdges4(gamAppMpi%State%Efld,'Efld',&
gamAppMpi%Grid%isg,gamAppMpi%Grid%ieg,&
gamAppMpi%Grid%jsg,gamAppMpi%Grid%jeg,&
gamAppMpi%Grid%ksg,gamAPpMpi%Grid%keg) ! g,g,g,NDIM
gamAppMpi%Grid%ksg,gamAPpMpi%Grid%keg,1e-14_rp) ! g,g,g,NDIM
end subroutine testEdgeDataFields
end module testMpiFields

15
tests/gamera_mpi/testmpimhd.pf
View File

@@ -13,13 +13,22 @@ contains
subroutine setup(this)
class (MpiTestMethod), intent(inout) :: this
character(len=strLen) :: caseFile
type(XML_Input_T) :: xmlInp
! basic initialization
call setMpiReal()
write(caseFile,'(A,I0,A)') 'blast3d_mhd_', this%getNumProcesses(), '.xml'
call initClocks()
allocate(gamAppMpi)
call initGamera_mpi(gamAppMpi, initUser, getMpiF08Communicator(this), caseFile, .false.)
gamAppMpi%gOptions%userInitFunc => initUser
gamAppMpi%gOptionsMpi%gamComm = getMpiF08Communicator(this)
gamAppMpi%gOptionsMpi%doIO = .false.
write(caseFile,'(A,I0,A)') 'blast3d_mhd_', this%getNumProcesses(), '.xml'
xmlInp = New_XML_Input(caseFile,'Kaiju',.true.)
call initGamera_mpi(gamAppMpi, xmlInp)
end subroutine setup

35
tests/genTestData-template.pbs Normal file
View File

@@ -0,0 +1,35 @@
#!/bin/bash
#PBS -N {{ job_name }}
#PBS -A {{ account }}
#PBS -q {{ queue }}
#PBS -l job_priority={{ job_priority }}
#PBS -l walltime={{ walltime }}
#PBS -l select=4:ncpus=128:mpiprocs=2:ompthreads=64+1:ncpus=128:mpiprocs=1:ompthreads=128
#PBS -j oe
#PBS -m abe
echo "Job $PBS_JOBID started at `date` on `hostname` in directory `pwd`."
echo 'Loading modules.'
module --force purge
{%- for module in modules %}
module load {{ module }}
{%- endfor %}
module list
echo 'Setting up MAGE environment.'
source {{ kaijuhome }}/scripts/setupEnvironment.sh
echo 'Setting environment variables.'
export OMP_NUM_THREADS=128
export MPI_TYPE_DEPTH=32
export KMP_STACKSIZE=128M
echo 'The active environment variables are:'
printenv
echo 'Generating data for testing.'
MPICOMMAND="mpiexec $KAIJUHOME/scripts/preproc/pinCpuCores.sh"
$MPICOMMAND ./voltron_mpi.x cmiD_deep_8_genRes.xml >& cmiD_deep_8_genRes.out
echo "Job $PBS_JOBID ended at `date` on `hostname` in directory `pwd`."

32
tests/rcm/cmriD.xml Normal file
View File

@@ -0,0 +1,32 @@
<!-- Example XML file for coupled SST+Gamera+ReMIX+CHIMP -->
<?xml version="1.0"?>
<!-- Magnetosphere params, Voltron times in seconds -->
<Kaiju>
<VOLTRON>
<time tFin="36000.0"/>
<spinup doSpin="T" tSpin="60.0" tIO="0.0"/>
<output dtOut="60.0" tsOut="100" doTimer="F"/>
<restart dtRes="1800.0"/>
<coupling dtCouple="5.0" rDeep="8.0" imType="RCM"/>
</VOLTRON>
<Gamera>
<sim runid="msphere" doH5g="T" H5Grid="lfmD.h5" icType="user" pdmb="1.0" pFloor="1.0e-8" dFloor="1.0e-6" rmeth="7UP"/>
<restart doRes="F" resFile="XXXXX.h5"/>
<physics doMHD="T" doBoris="T" Ca="10.0"/>
<prob Rho0="0.2" P0="0.001"/>
<ring gid="lfm" doRing="T" Nr="4" Nc1="8" Nc2="16" Nc3="32" Nc4="32"/>
<wind tsfile="bcwind.h5"/>
<source doSource="T"/>
</Gamera>
<!-- Remix params -->
<REMIX>
<grid Np="360" Nt="45" LowLatBoundary="45.0"/>
<conductance pedmin="2.0" hallmin="1.0" sigma_ratio="3.0" const_sigma="True" ped0="5.0"/>
</REMIX>
<!-- EB-Tracer (CHIMP) params -->
<CHIMP>
<units uid="EARTHCODE"/>
<fields grType="LFM"/>
<domain dtype="SPH" rmin="2.0" rmax="25.0"/>
</CHIMP>
</Kaiju>

29
tests/remix/testmixmain.pf
View File

@@ -24,16 +24,14 @@ contains
subroutine testZeroInput()
! testing that an input of all zeroes gets output of all zeroes
type(voltApp_T) :: voltronApp
type(gamApp_T) :: gameraApp
real(rp) :: curTilt
character(len=strLen) :: caseInput = 'cmiD.xml'
write(*,*) 'Doing testZeroInput ...'
call initGamera(gameraApp, initUser, caseInput)
voltronApp%vOptions%gamUserInitFunc => initUser
call initVoltron(voltronApp, caseInput)
call initVoltron(voltronApp, gameraApp, caseInput)
call convertGameraToRemix(voltronApp%mhd2mix, gameraApp, voltronApp%remixApp)
call convertGameraToRemix(voltronApp%mhd2mix, voltronApp%gApp, voltronApp%remixApp)
call mapGameraToRemix(voltronApp%mhd2mix, voltronApp%remixApp)
@@ -53,8 +51,7 @@ contains
write(*,*) 'Min/Max of potential (NORTH) = ', minval(voltronApp%remixApp%ion(NORTH)%S%Solution), maxval(voltronApp%remixApp%ion(NORTH)%S%Solution)
write(*,*) 'Min/Max of potential (SOUTH) = ', minval(voltronApp%remixApp%ion(SOUTH)%S%Solution), maxval(voltronApp%remixApp%ion(SOUTH)%S%Solution)
call mapRemixToGamera(voltronApp%mix2mhd, voltronApp%remixApp)
call CouplePotentialToMhd(voltronApp)
end subroutine testZeroInput
@@ -62,18 +59,16 @@ contains
subroutine testConstantSolution()
! testing that an input of all zeroes gets output of all zeroes
type(voltApp_T) :: voltronApp
type(gamApp_T) :: gameraApp
real(rp) :: curTilt
real(rp) :: testValue = 240.19
character(len=strLen) :: caseInput = 'cmiD.xml'
write(*,*) 'Doing testConstantSolution ...'
call initGamera(gameraApp, initUser, caseInput)
voltronApp%vOptions%gamUserInitFunc => initUser
call initVoltron(voltronApp, caseInput)
call initVoltron(voltronApp, gameraApp, caseInput)
call convertGameraToRemix(voltronApp%mhd2mix, gameraApp, voltronApp%remixApp)
call convertGameraToRemix(voltronApp%mhd2mix, voltronApp%gApp, voltronApp%remixApp)
call mapGameraToRemix(voltronApp%mhd2mix, voltronApp%remixApp)
@@ -100,7 +95,6 @@ contains
subroutine testAzimuthallyDependentFAC()
! testing that an input of all zeroes gets output of all zeroes
type(voltApp_T) :: voltronApp
type(gamApp_T) :: gameraApp
real(rp) :: curTilt
character(len=strLen) :: caseInput = 'cmiD.xml'
@@ -108,11 +102,10 @@ contains
real(rp) :: thetaMin, thetaDelta
write(*,*) 'Doing testAzimuthallyDependentFAC ...'
call initGamera(gameraApp, initUser, caseInput)
voltronApp%vOptions%gamUserInitFunc => initUser
call initVoltron(voltronApp, caseInput)
call initVoltron(voltronApp, gameraApp, caseInput)
call convertGameraToRemix(voltronApp%mhd2mix, gameraApp, voltronApp%remixApp)
call convertGameraToRemix(voltronApp%mhd2mix, voltronApp%gApp, voltronApp%remixApp)
call mapGameraToRemix(voltronApp%mhd2mix, voltronApp%remixApp)
@@ -136,7 +129,7 @@ contains
call run_mix(voltronApp%remixApp%ion, curTilt)
! potential in remixApp%ion(h)%St%Vars(:,:,POT)
call mapRemixToGamera(voltronApp%mix2mhd, voltronApp%remixApp)
call CouplePotentialToMhd(voltronApp)
end subroutine testAzimuthallyDependentFAC

42
tests/runCaseTests-template.pbs Normal file
View File

@@ -0,0 +1,42 @@
#!/bin/bash
#PBS -N {{ job_name }}
#PBS -A {{ account }}
#PBS -q {{ queue }}
#PBS -l job_priority={{ job_priority }}
#PBS -l walltime={{ walltime }}
#PBS -l select=1:ncpus=128:mpiprocs=8:ompthreads=16
#PBS -j oe
#PBS -m abe
echo "Job $PBS_JOBID started at `date` on `hostname` in directory `pwd`."
echo 'Loading modules.'
module --force purge
{%- for module in modules %}
module load {{ module }}
{%- endfor %}
module list
echo 'Setting up MAGE environment.'
source {{ kaijuhome }}/scripts/setupEnvironment.sh
echo 'Setting environment variables.'
export OMP_NUM_THREADS=128
export MPI_TYPE_DEPTH=32
export KMP_STACKSIZE=128M
echo 'The active environment variables are:'
printenv
echo 'Running non-MPI test cases.'
./caseTests >& caseTests.out
echo 'Non-MPI test cases complete.'
echo | tail -n 3 ./caseTests.out
echo 'Running MPI test cases.'
MPICOMMAND="mpiexec $KAIJUHOME/scripts/preproc/pinCpuCores.sh"
${MPICOMMAND} ./caseMpiTests >& caseMpiTests.out
echo 'MPI test cases complete.'
echo | tail -n 3 ./caseMpiTests.out
echo "Job $PBS_JOBID ended at `date` on `hostname` in directory `pwd`."

81
tests/runNonCaseTests1-template.pbs Normal file
View File

@@ -0,0 +1,81 @@
#!/bin/bash
#PBS -N {{ job_name }}
#PBS -A {{ account }}
#PBS -q {{ queue }}
#PBS -l job_priority={{ job_priority }}
#PBS -l walltime={{ walltime }}
#PBS -l select=1:ncpus=128:mpiprocs=64:ompthreads=128
#PBS -j oe
#PBS -m abe
echo "Job $PBS_JOBID started at `date` on `hostname` in directory `pwd`."
echo 'Loading modules.'
module --force purge
{%- for module in modules %}
module load {{ module }}
{%- endfor %}
module list
echo 'Setting up MAGE environment.'
source {{ kaijuhome }}/scripts/setupEnvironment.sh
echo 'Setting environment variables.'
export OMP_NUM_THREADS=128
export MPI_TYPE_DEPTH=32
export KMP_STACKSIZE=128M
echo 'The active environment variables are:'
printenv
echo 'Running GAMERA tests.'
date
./gamTests >& gamTests.out
date
echo 'GAMERA tests complete.'
echo | tail -n 3 ./gamTests.out
echo 'Running REMIX tests.'
date
./mixTests >& mixTests.out
date
echo 'REMIX tests complete.'
echo | tail -n 3 ./mixTests.out
echo 'Running RCM tests.'
date
./rcmTests >& rcmTests.out
date
echo 'RCM tests complete.'
echo | tail -n 3 ./rcmTests.out
echo 'Running SHELLGRID tests.'
date
./shgrTests >& shgrTests.out
date
echo 'SHELLGRID tests complete.'
echo | tail -n 3 ./shgrTests.out
echo 'Running VOLTRON tests.'
date
./voltTests >& voltTests.out
date
echo 'VOLTRON tests complete.'
echo | tail -n 3 ./voltTests.out
echo 'Running base MPI tests.'
MPICOMMAND="mpiexec $KAIJUHOME/scripts/preproc/pinCpuCores.sh"
date
${MPICOMMAND} ./baseMpiTests >& baseMpiTests.out
date
echo 'Base MPI tests complete.'
echo | tail -n 3 ./baseMpiTests.out
echo 'Running GAMERA MPI tests.'
date
${MPICOMMAND} ./gamMpiTests >& gamMpiTests.out
date
echo 'GAMERA MPI tests complete.'
echo | tail -n 3 ./gamMpiTests.out
echo "Job $PBS_JOBID ended at `date` on `hostname` in directory `pwd`."

39
tests/runNonCaseTests2-template.pbs Normal file
View File

@@ -0,0 +1,39 @@
#!/bin/bash
#PBS -N {{ job_name }}
#PBS -A {{ account }}
#PBS -q {{ queue }}
#PBS -l job_priority={{ job_priority }}
#PBS -l walltime={{ walltime }}
#PBS -l select=2:ncpus=128:mpiprocs=9:ompthreads=36
#PBS -j oe
#PBS -m abe
echo "Job $PBS_JOBID started at `date` on `hostname` in directory `pwd`."
echo 'Loading modules.'
module --force purge
{%- for module in modules %}
module load {{ module }}
{%- endfor %}
module list
echo 'Setting up MAGE environment.'
source {{ kaijuhome }}/scripts/setupEnvironment.sh
echo 'Setting environment variables.'
# export OMP_NUM_THREADS=128
export MPI_TYPE_DEPTH=32
export KMP_STACKSIZE=128M
echo 'The active environment variables are:'
printenv
echo 'Running VOLTRON MPI tests.'
date
MPICOMMAND="mpiexec $KAIJUHOME/scripts/preproc/pinCpuCores.sh"
${MPICOMMAND} ./voltMpiTests >& voltMpiTests.out
date
echo 'VOLTRON MPI tests complete.'
echo | tail -n 3 ./voltMpiTests.out
echo "Job $PBS_JOBID ended at `date` on `hostname` in directory `pwd`."

2
tests/shellgrid/testSGIO.pf
View File

@@ -19,7 +19,7 @@ module testSGIO
subroutine setup()
real(rp), dimension(Npnt) :: thetas, phis
real(rp) :: dth, dph
real(rp) :: thetaL = 0.0 *PI/180.0
real(rp) :: thetaL = 0.0*PI/180.0
integer :: i,j
dth = (0.5*PI - thetaL) / (Npnt-1)

53
tests/unitTestReport-template.pbs Normal file
View File

@@ -0,0 +1,53 @@
#!/bin/bash
#PBS -N {{ job_name }}
#PBS -A {{ account }}
#PBS -q {{ queue }}
#PBS -l job_priority={{ job_priority }}
#PBS -l walltime={{ walltime }}
#PBS -l select=1:ncpus=128
#PBS -j oe
#PBS -m abe
echo "Job $PBS_JOBID started at `date` on `hostname` in directory `pwd`."
echo 'Loading modules.'
module --force purge
{%- for module in modules %}
module load {{ module }}
{%- endfor %}
module list
echo 'Loading python environment.'
mage_test_root='{{ mage_test_root }}'
export CONDARC="${mage_test_root}/condarc"
export CONDA_ENVS_PATH="${mage_test_root}/conda"
mage_miniconda3="${mage_test_root}/miniconda3"
mage_conda="${mage_miniconda3}/bin/conda"
__conda_setup="$($mage_conda 'shell.bash' 'hook' 2> /dev/null)"
if [ $? -eq 0 ]; then
eval "$__conda_setup"
else
if [ -f "$mage_miniconda3/etc/profile.d/conda.sh" ]; then
. "$mage_miniconda3/etc/profile.d/conda.sh"
else
export PATH="$mage_miniconda3/bin:$PATH"
fi
fi
unset __conda_setup
conda activate kaiju-3.8-testing
echo 'Setting up MAGE environment.'
source {{ kaijuhome }}/scripts/setupEnvironment.sh
echo 'Setting environment variables.'
export MAGE_TEST_SET_ROOT={{ mage_test_set_root }}
export SLACK_BOT_TOKEN={{ slack_bot_token }}
export BRANCH_OR_COMMIT={{ branch_or_commit }}
echo 'The active environment variables are:'
printenv
echo 'Generating unit test report.'
python $KAIJUHOME/testingScripts/unitTestReport.py {{ report_options }} >& unitTestReport.out
echo "Job $PBS_JOBID ended at `date` on `hostname` in directory `pwd`."

2
tests/voltron/cmriD_Earth.xml
View File

@@ -31,7 +31,7 @@
</CHIMP>
<REMIX>
<conductance doStarlight="T" doRamp="F" doMR="F"/>
<precipitation aurora_model_type="RCMONO" alpha="0.2" beta="0.4" doAuroralSmooth="F"/>
<precipitation aurora_model_type="LINMRG" alpha="0.2" beta="0.4" doAuroralSmooth="F"/>
</REMIX>
<RCM>
<ellipse xSun="12.5" yDD="15.0" xTail="-15.0" isDynamic="T"/>

2
tests/voltron/cmriD_Jupiter.xml
View File

@@ -31,7 +31,7 @@
</CHIMP>
<REMIX>
<conductance doStarlight="T" doRamp="F" doMR="F"/>
<precipitation aurora_model_type="RCMONO" alpha="0.2" beta="0.4" doAuroralSmooth="F"/>
<precipitation aurora_model_type="LINMRG" alpha="0.2" beta="0.4" doAuroralSmooth="F"/>
</REMIX>
<RCM>
<ellipse xSun="12.5" yDD="15.0" xTail="-15.0" isDynamic="T"/>

2
tests/voltron/cmriD_NewPlanet.xml
View File

@@ -31,7 +31,7 @@
</CHIMP>
<REMIX>
<conductance doStarlight="T" doRamp="F" doMR="F"/>
<precipitation aurora_model_type="RCMONO" alpha="0.2" beta="0.4" doAuroralSmooth="F"/>
<precipitation aurora_model_type="LINMRG" alpha="0.2" beta="0.4" doAuroralSmooth="F"/>
</REMIX>
<RCM>
<ellipse xSun="12.5" yDD="15.0" xTail="-15.0" isDynamic="T"/>

48
tests/voltron/testebsquish.pf
View File

@@ -127,5 +127,53 @@ contains
end subroutine
@test
subroutine testSquishDipole()
! testing that fake projection produces appropriate squish results
type(voltApp_T) :: voltronApp
character(len=strLen) :: caseInput = 'cmriD.xml'
real(rp) :: xyz(3), invlat, invlon
character(len=strLen) :: checkMessage
type(XML_Input_T) :: xmlInp
integer :: i,j,k
voltronApp%vOptions%gamUserInitFunc => initUser
call initVoltron(voltronApp, caseInput)
associate(ebGr=>voltronApp%ebTrcApp%ebState%ebGr)
! enable debug projection for testing
voltronApp%ebTrcApp%ebModel%doDip = .true.
! advance to T=0seconds and perform a squish
voltronApp%time = 0
call SquishStart(voltronApp)
call Squish(voltronApp)
call SquishEnd(voltronApp)
@assertEqual(COUNT(norm2(ebGr%xyz(ebGr%is:voltronApp%iDeep+1,ebGr%js:ebGr%je+1,ebGr%ks:ebGr%ke+1,:),4) <= voltronApp%rTrc),COUNT(voltronApp%chmp2mhd%isGood),'Squish Fake Projection Good Count is wrong. Check Squish Processing and Output.')
do k=ebGr%ks,ebGr%ke+1
do j=ebGr%js+1,ebGr%je ! js and je+1 are smoothed singularities, not checked
do i=ebGr%is,voltronApp%iDeep+1
if(voltronApp%chmp2mhd%isGood(i,j,k)) then
xyz = ebGr%xyz(i,j,k,XDIR:ZDIR)
invlat = InvLatitude(xyz)
invlon = katan2(xyz(YDIR),xyz(XDIR))
write (checkMessage,'(A,I0,A,I0,A,I0,A)'), 'Squish Fake Projection Latitude is wrong at (',i,',',j,',',k,'). Check Squish Processing and Output.'
@assertEqual(invlat,voltronApp%chmp2mhd%xyzSquish(i,j,k,1),1e-17_rp,trim(checkMessage))
write (checkMessage,'(A,I0,A,I0,A,I0,A)'), 'Squish Fake Projection Longitude is wrong at (',i,',',j,',',k,'). Check Squish Processing and Output.'
@assertEqual(invlon,voltronApp%chmp2mhd%xyzSquish(i,j,k,2),1e-17_rp,trim(checkMessage))
endif
enddo
enddo
enddo
end associate
end subroutine
end module testebsquish

9
tests/voltron/testmhd2mix.pf
View File

@@ -20,15 +20,16 @@ contains
subroutine dipoleTest()
! testing that a dipole field from gamera results in 0 FAC in remix
type(voltApp_T) :: voltronApp
type(gamApp_T) :: gameraApp
procedure(VectorField_T), pointer :: Axyz
character(len=strLen) :: caseInput = 'cmiD.xml'
real(rp) testValue
type(XML_Input_T) :: xmlInp
call initGamera(gameraApp, initUser, caseInput)
voltronApp%vOptions%gamUserInitFunc => initUser
call initVoltron(voltronApp, caseInput)
call initVoltron(voltronApp, gameraApp, caseInput)
associate(gameraApp=>voltronApp%gApp)
! create a dipole field in Gamera. This code is copied from prob.F90
Axyz => VP_Dipole
@@ -45,6 +46,8 @@ contains
@assertLessThanOrEqual(testValue, 1e-1_rp, 'Remix did not get all 0 FAC from an input dipole field')
end associate
contains
! modified to hard-code M2 constant to 1.0 (therefore removed)

46
tests/voltron/testmix2mhd.pf
View File

@@ -3,7 +3,6 @@ module testmix2mhd
use voltapp
use gamapp
use uservoltic
use mix2mhd_interface
use ioH5
implicit none
@@ -22,13 +21,13 @@ contains
subroutine corotationTest()
! testing that a corotation potential from remix results in a corotation field in gamera
type(voltApp_T) :: voltronApp
type(gamApp_T) :: gameraApp
character(len=strLen) :: caseInput = 'cmiD.xml'
real(rp), dimension(NDIM) :: rHatP,eHat,xyz,Exyz,ccEijk
real(rp) :: deltaSum,lambda,rval,xc,yc,zc
real(rp) :: Psi0,RIn,errorThresh
integer :: h,ip,it,k,j,jp,kp,n,np,i,ig
type(XML_Input_T) :: xmlInp
!type(IOVAR_T), dimension(MAXMIXIOVAR) :: debugHDF
@@ -37,9 +36,8 @@ contains
RIn = 1.0
Psi0 = 10.0
call initGamera(gameraApp, initUser, caseInput)
call initVoltron(voltronApp, gameraApp, caseInput)
voltronApp%vOptions%gamUserInitFunc => initUser
call initVoltron(voltronApp, caseInput)
associate(rApp=>voltronApp%remixApp)
do h=1,2
@@ -55,29 +53,27 @@ contains
end associate
!Can add a test of the interpolation to Gamera shells here?
call mapRemixToGamera(voltronApp%mix2mhd, voltronApp%remixApp)
call convertRemixToGamera(voltronApp%mix2mhd, voltronApp%remixApp, gameraApp, .false.) !Don't add corotation potential
call CouplePotentialToMhd(voltronApp)
! find the remix BC to verify the resulting Gamera data
SELECT type(iiBC=>gameraApp%Grid%externalBCs(INI)%p)
SELECT type(iiBC=>voltronApp%gApp%Grid%externalBCs(INI)%p)
TYPE IS (IonInnerBC_T)
! verify that the gamera field (iiBC%inEijk, iiBC%inExyz, or both) have the expected values here
! inExyz should be pointed exactly radially at all locations
deltaSum = 0.0_rp
!Only loop over active cells
do k=gameraApp%Grid%ks,gameraApp%Grid%ke
do j=gameraApp%Grid%js,gameraApp%Grid%je
do k=voltronApp%gApp%Grid%ks,voltronApp%gApp%Grid%ke
do j=voltronApp%gApp%Grid%js,voltronApp%gApp%Grid%je
!Map to active ip,jp,kp (i=Grid%is => ip=Grid%is)
call lfmIJKcc(gameraApp%Model,gameraApp%Grid,gameraApp%Grid%is,j,k,ip,jp,kp)
call lfmIJKcc(voltronApp%gApp%Model,voltronApp%gApp%Grid,voltronApp%gApp%Grid%is,j,k,ip,jp,kp)
do n=1,gameraApp%Model%Ng
ig = gameraApp%Grid%is-n
np = gameraApp%Model%nG-n+1
do n=1,voltronApp%gApp%Model%Ng
ig = voltronApp%gApp%Grid%is-n
np = voltronApp%gApp%Model%nG-n+1
call cellCenter(gameraApp%Grid, ig,j,k,xc,yc,zc)
call cellCenter(voltronApp%gApp%Grid, ig,j,k,xc,yc,zc)
rHatP = normVec([xc,yc,zc])
eHat = normVec(iiBC%inExyz(np,jp,kp,:))
@@ -90,25 +86,25 @@ contains
end do
! remix doesn't go below a certain lat, causing discontinuity. high error
errorThresh = 2*(1+gameraApp%Grid%ke-gameraApp%Grid%ks)*(1+gameraApp%Grid%je-gameraApp%Grid%js)*gameraApp%Model%Ng
errorThresh = 2*(1+voltronApp%gApp%Grid%ke-voltronApp%gApp%Grid%ks)*(1+voltronApp%gApp%Grid%je-voltronApp%gApp%Grid%js)*voltronApp%gApp%Model%Ng
@assertLessThanOrEqual(deltaSum, errorThresh, 'Magnetic field from remix was not pointing radially')
!Now test Eijk fields
deltaSum = 0.0
!Only loop over active cells
do k=gameraApp%Grid%ks,gameraApp%Grid%ke
do j=gameraApp%Grid%js,gameraApp%Grid%je
do k=voltronApp%gApp%Grid%ks,voltronApp%gApp%Grid%ke
do j=voltronApp%gApp%Grid%js,voltronApp%gApp%Grid%je
!Map to active ip,jp,kp (i=Grid%is => ip=Grid%is)
call lfmIJKcc(gameraApp%Model,gameraApp%Grid,gameraApp%Grid%is,j,k,ip,jp,kp)
do n=1,gameraApp%Model%Ng
ig = gameraApp%Grid%is-n
np = gameraApp%Model%nG-n+1
call lfmIJKcc(voltronApp%gApp%Model,voltronApp%gApp%Grid,voltronapp%gApp%Grid%is,j,k,ip,jp,kp)
do n=1,voltronApp%gApp%Model%Ng
ig = voltronApp%gApp%Grid%is-n
np = voltronApp%gApp%Model%nG-n+1
!Convert Eijk (edges) to cc-Eijk
ccEijk(IDIR) = 0.25*(iiBC%inEijk(np,j,k,IDIR)+iiBC%inEijk(np,j,k+1,IDIR)+iiBC%inEijk(np,j+1,k,IDIR)+iiBC%inEijk(np,j+1,k+1,IDIR))
ccEijk(JDIR) = 0.25*(iiBC%inEijk(np,j,k,JDIR)+iiBC%inEijk(np,j,k+1,JDIR)+iiBC%inEijk(np+1,j,k,JDIR)+iiBC%inEijk(np+1,j,k+1,JDIR))
ccEijk(KDIR) = 0.25*(iiBC%inEijk(np,j,k,KDIR)+iiBC%inEijk(np+1,j,k,KDIR)+iiBC%inEijk(np,j+1,k,KDIR)+iiBC%inEijk(np+1,j+1,k,KDIR))
!Now convert cc-Eijk to Exyz
Exyz = ccEijk2Exyz(gameraApp%Model,gameraApp%Grid,ccEijk,ig,j,k)
Exyz = ccEijk2Exyz(voltronApp%gApp%Model,voltronApp%gApp%Grid,ccEijk,ig,j,k)
!Exyz above is approximation to inExyz, ie testing whether or not Eijk and Exyz are consistent
deltaSum = deltaSum + norm2(Exyz-iiBC%inExyz(np,jp,kp,:))
enddo
@@ -116,7 +112,7 @@ contains
enddo
! remix doesn't go below a certain lat, causing discontinuity. high error
errorThresh = 2e-2*(1+gameraApp%Grid%ke-gameraApp%Grid%ks)*(1+gameraApp%Grid%je-gameraApp%Grid%js)*gameraApp%Model%Ng
errorThresh = 2e-2*(1+voltronApp%gApp%Grid%ke-voltronApp%gApp%Grid%ks)*(1+voltronApp%gApp%Grid%je-voltronApp%gApp%Grid%js)*voltronApp%gApp%Model%Ng
@assertLessThanOrEqual(deltaSum, errorThresh, 'inEijk values did not match inExyz values')
CLASS DEFAULT

31
tests/voltron/testplanetunits.pf
View File

@@ -39,7 +39,7 @@ contains
subroutine checkGamera(vApp, gApp)
type(voltApp_T), intent(in) :: vApp
type(gamApp_T), intent(in) :: gApp
class(gamApp_T), intent(in) :: gApp
! Gam units
real(rp) :: gv0, gT0, gB0, gP0, M0, GM0_t
@@ -89,15 +89,14 @@ contains
@test
subroutine testEarth()
type(voltApp_T) :: vApp
type(gamApp_T) :: gApp
character(len=strLen) :: xmlName = 'cmriD_Earth.xml'
call initGamera(gApp, initUser, xmlName)
call initVoltron(vApp, gApp, xmlName)
vApp%vOptions%gamUserInitFunc => initUser
call initVoltron(vApp, xmlName)
! Run tests
call checkVoltron(vApp, REarth, RionE*1E6_rp, 9.807_rp, EarthM0g, EarthPsi0, .true.)
call checkGamera(vApp, gApp)
call checkGamera(vApp, vApp%gApp)
call checkRCM(vApp)
!Does REMIX need to be checked? Only relies on msphutil's RadIonosphere() (2021/10/12)
call checkChimp(vApp)
@@ -107,15 +106,16 @@ contains
@test
subroutine testJupiter()
type(voltApp_T) :: vApp
type(gamApp_T) :: gApp
character(len=strLen) :: xmlName = 'cmriD_Jupiter.xml'
real(rp) :: jupCorot = -2.5*1702.9*92.0
call initGamera(gApp, initUser, xmlName)
call initVoltron(vApp, gApp, xmlName)
real(rp) :: jupCorot
jupCorot = -2.5*1702.9*92.0
vApp%vOptions%gamUserInitFunc => initUser
call initVoltron(vApp, xmlName)
! Run tests
call checkVoltron(vApp, RJupiterXE*REarth, 1.01*RJupiterXE*REarth, 24.79_rp, JupiterM0g, jupCorot, .true.)
call checkGamera(vApp, gApp)
call checkGamera(vApp, vApp%gApp)
call checkRCM(vApp)
!Does REMIX need to be checked? Only relies on msphutil's RadIonosphere() (2021/10/12)
call checkChimp(vApp)
@@ -125,13 +125,12 @@ contains
@test
subroutine testNewPlanet() ! Arbitrary, not real planet
type(voltApp_T) :: vApp
type(gamApp_T) :: gApp
character(len=strLen) :: xmlName = 'cmriD_NewPlanet.xml'
type(XML_Input_T) :: inpXML
real(rp) :: corotXML
call initGamera(gApp, initUser, xmlName)
call initVoltron(vApp, gApp, xmlName)
vApp%vOptions%gamUserInitFunc => initUser
call initVoltron(vApp, xmlName)
! For this test, we should get corot potential right from xml cause we don't have a real pre-set value for a fake planet.
! This does check if Voltron and Gamera are getting the right potential from xml
@@ -142,11 +141,11 @@ contains
! Run tests
call checkVoltron(vApp, 1.3*REarth, 1.01*1.3*REarth, 12.0_rp, 0.3*EarthM0g, corotXML, .true.)
call checkGamera(vApp, gApp)
call checkGamera(vApp, vApp%gApp)
call checkRCM(vApp)
!Does REMIX need to be checked? Only relies on msphutil's RadIonosphere() (2021/10/12)
call checkChimp(vApp)
end subroutine testNewPlanet
end module testplanetunits
end module testplanetunits

59
tests/voltron/testrcm.pf Normal file
View File

@@ -0,0 +1,59 @@
module testrcm
use testHelper
use voltapp
use gamapp
use uservoltic
implicit none
contains
@before
subroutine firstSerial()
end subroutine firstSerial
@after
subroutine lastSerial()
end subroutine lastSerial
@test
subroutine testRcmFakeTubes()
! testing that rcm produces expected output when debug tubes is enabled
type(voltApp_T) :: voltronApp
character(len=strLen) :: caseInput = 'cmriD.xml'
type(XML_Input_T) :: xmlInp
integer :: i,j
character(len=strLen) :: checkMessage
voltronApp%vOptions%gamUserInitFunc => initUser
call initVoltron(voltronApp, caseInput)
! enable debug tubes for testing
select type(rcmApp=>voltronApp%imagApp)
type is (rcmIMAG_T)
rcmApp%doFakeTube = .true.
class default
@assertTrue(.false., 'IMAG type must be RCM for the RCM test')
end select
! advance to T=0seconds and perform an rcm update
voltronApp%time = 0
call DoImag(voltronApp)
select type(rcmApp=>voltronApp%imagApp)
type is (rcmIMAG_T)
do j=1,rcmApp%rcmCpl%nLon_ion
do i=1,rcmApp%rcmCpl%nLat_ion
write (checkMessage,'(A,I0,A,I0,A)'), 'RCM Fake Tubes Latitude is wrong at (', i, ', ', j, '). Check RCM Processing and Output.'
@assertEqual(rcmApp%rcmCpl%latc(i,j),-(PI/2.0_rp - rcmApp%rcmCpl%gcolat(i)),1e-17_rp,trim(checkMessage))
write (checkMessage,'(A,I0,A,I0,A)'), 'RCM Fake Tubes Longitude is wrong at (', i, ', ', j, '). Check RCM Processing and Output.'
@assertEqual(rcmApp%rcmCpl%lonc(i,j),rcmapp%rcmCpl%glong(j),1e-17_rp,trim(checkMessage))
enddo
enddo
end select
end subroutine
end module testrcm

9
tests/voltron/testring.pf
View File

@@ -20,17 +20,18 @@ contains
subroutine ringAvgConservationTest()
! testing that gas and mag quantities are conserved during ring averaging
type(voltApp_T) :: voltronApp
type(gamApp_T) :: gameraApp
character(len=strLen) :: caseInput = 'cmiD.xml'
real(rp), dimension(:,:), allocatable :: denSum, momSumX, momSumY, momSumZ
real(rp) :: temp, totalDiv
integer :: i,j,k,r
character(len=strLen) :: checkMessage
type(XML_Input_T) :: xmlInp
call initGamera(gameraApp, initUser, caseInput)
voltronApp%vOptions%gamUserInitFunc => initUser
call initVoltron(voltronApp, caseInput)
call initVoltron(voltronApp, gameraApp, caseInput)
associate(gameraApp=>voltronApp%gApp)
! set specific values to gas and magFlux
do k=gameraApp%Grid%ks,gameraApp%Grid%ke
@@ -131,6 +132,8 @@ contains
deallocate(momSumY)
deallocate(momSumZ)
end associate
end subroutine
end module testring

1
tests/voltron_mpi/cmiD_4.xml
View File

@@ -17,6 +17,7 @@
<prob Rho0="0.1" P0="0.001" rCut="16.0" lCut="8.0"/>
<ring gid="lfm" doRing="T" Nr="3" Nc1="8" Nc2="16" Nc3="32"/>
<wind tsfile="bcwind.h5"/>
<coupling blockHalo="T"/>
</Gamera>
<!-- Remix -->
<REMIX>

1
tests/voltron_mpi/cmiD_8.xml
View File

@@ -17,6 +17,7 @@
<prob Rho0="0.1" P0="0.001" rCut="16.0" lCut="8.0"/>
<ring gid="lfm" doRing="T" Nr="3" Nc1="8" Nc2="16" Nc3="32"/>
<wind tsfile="bcwind.h5"/>
<coupling blockHalo="T"/>
</Gamera>
<!-- Remix -->
<REMIX>

4
tests/voltron_mpi/cmiD_deep_1.xml
View File

@@ -23,13 +23,13 @@
<ringknobs doVClean="T"/>
<wind tsfile="bcwind.h5"/>
<source doSource="T" doBounceDT="T"/>
<threading NumTh="18"/>
<threading NumTh="14"/>
</Gamera>
<!-- Remix -->
<REMIX>
<grid Np="360" Nt="55" LowLatBoundary="55.0"/>
<conductance doStarlight="T" doRamp="F" doMR="T"/>
<precipitation aurora_model_type="RCMONO" alpha="0.2" beta="0.4" doAuroralSmooth="T"/>
<precipitation aurora_model_type="LINMRG" alpha="0.2" beta="0.4" doAuroralSmooth="T"/>
</REMIX>
<CHIMP>
<units uid="EARTHCODE"/>

5
tests/voltron_mpi/cmiD_deep_4.xml
View File

@@ -23,13 +23,14 @@
<ringknobs doVClean="T"/>
<wind tsfile="bcwind.h5"/>
<source doSource="T" doBounceDT="T"/>
<threading NumTh="18"/>
<threading NumTh="14"/>
<coupling blockHalo="T"/>
</Gamera>
<!-- Remix -->
<REMIX>
<grid Np="360" Nt="55" LowLatBoundary="55.0"/>
<conductance doStarlight="T" doRamp="F" doMR="T"/>
<precipitation aurora_model_type="RCMONO" alpha="0.2" beta="0.4" doAuroralSmooth="T"/>
<precipitation aurora_model_type="LINMRG" alpha="0.2" beta="0.4" doAuroralSmooth="T"/>
</REMIX>
<CHIMP>
<units uid="EARTHCODE"/>

5
tests/voltron_mpi/cmiD_deep_8.xml
View File

@@ -23,13 +23,14 @@
<ringknobs doVClean="T"/>
<wind tsfile="bcwind.h5"/>
<source doSource="T" doBounceDT="T"/>
<threading NumTh="18"/>
<threading NumTh="14"/>
<coupling blockHalo="T"/>
</Gamera>
<!-- Remix -->
<REMIX>
<grid Np="360" Nt="55" LowLatBoundary="55.0"/>
<conductance doStarlight="T" doRamp="F" doMR="T"/>
<precipitation aurora_model_type="RCMONO" alpha="0.2" beta="0.4" doAuroralSmooth="T"/>
<precipitation aurora_model_type="LINMRG" alpha="0.2" beta="0.4" doAuroralSmooth="T"/>
</REMIX>
<CHIMP>
<units uid="EARTHCODE"/>

5
tests/voltron_mpi/cmiD_deep_8_genRes.xml
View File

@@ -23,13 +23,14 @@
<ringknobs doVClean="T"/>
<wind tsfile="bcwind.h5"/>
<source doSource="T" doBounceDT="T"/>
<threading NumTh="18"/>
<threading NumTh="14"/>
<coupling blockHalo="T"/>
</Gamera>
<!-- Remix -->
<REMIX>
<grid Np="360" Nt="55" LowLatBoundary="55.0"/>
<conductance doStarlight="T" doRamp="F" doMR="T"/>
<precipitation aurora_model_type="RCMONO" alpha="0.2" beta="0.4" doAuroralSmooth="T"/>
<precipitation aurora_model_type="LINMRG" alpha="0.2" beta="0.4" doAuroralSmooth="T"/>
</REMIX>
<CHIMP>
<units uid="EARTHCODE"/>

5
tests/voltron_mpi/cmiD_deep_8_res0.xml
View File

@@ -23,13 +23,14 @@
<ringknobs doVClean="T"/>
<wind tsfile="bcwind.h5"/>
<source doSource="T" doBounceDT="T"/>
<threading NumTh="18"/>
<threading NumTh="14"/>
<coupling blockHalo="T"/>
</Gamera>
<!-- Remix -->
<REMIX>
<grid Np="360" Nt="55" LowLatBoundary="55.0"/>
<conductance doStarlight="T" doRamp="F" doMR="T"/>
<precipitation aurora_model_type="RCMONO" alpha="0.2" beta="0.4" doAuroralSmooth="T"/>
<precipitation aurora_model_type="LINMRG" alpha="0.2" beta="0.4" doAuroralSmooth="T"/>
</REMIX>
<CHIMP>
<units uid="EARTHCODE"/>

5
tests/voltron_mpi/cmiD_deep_8_res60.xml
View File

@@ -23,13 +23,14 @@
<ringknobs doVClean="T"/>
<wind tsfile="bcwind.h5"/>
<source doSource="T" doBounceDT="T"/>
<threading NumTh="18"/>
<threading NumTh="14"/>
<coupling blockHalo="T"/>
</Gamera>
<!-- Remix -->
<REMIX>
<grid Np="360" Nt="55" LowLatBoundary="55.0"/>
<conductance doStarlight="T" doRamp="F" doMR="T"/>
<precipitation aurora_model_type="RCMONO" alpha="0.2" beta="0.4" doAuroralSmooth="T"/>
<precipitation aurora_model_type="LINMRG" alpha="0.2" beta="0.4" doAuroralSmooth="T"/>
</REMIX>
<CHIMP>
<units uid="EARTHCODE"/>

5
tests/voltron_mpi/cmiD_deep_8_res600.xml
View File

@@ -23,13 +23,14 @@
<ringknobs doVClean="T"/>
<wind tsfile="bcwind.h5"/>
<source doSource="T" doBounceDT="T"/>
<threading NumTh="18"/>
<threading NumTh="14"/>
<coupling blockHalo="T"/>
</Gamera>
<!-- Remix -->
<REMIX>
<grid Np="360" Nt="55" LowLatBoundary="55.0"/>
<conductance doStarlight="T" doRamp="F" doMR="T"/>
<precipitation aurora_model_type="RCMONO" alpha="0.2" beta="0.4" doAuroralSmooth="T"/>
<precipitation aurora_model_type="LINMRG" alpha="0.2" beta="0.4" doAuroralSmooth="T"/>
</REMIX>
<CHIMP>
<units uid="EARTHCODE"/>

4
tests/voltron_mpi/geo_mpi.xml
View File

@@ -21,10 +21,10 @@
<ebsquish epsSquish="0.05" />
</VOLTRON>
<Gamera>
<sim H5Grid="lfmD.h5" doH5g="T" icType="user" pdmb="1.0" rmeth="7UP" runid="geo_mpi" />
<sim H5Grid="lfmD.h5" doH5g="T" icType="user" pdmb="1.0" rmeth="7UP" runid="msphereRes" />
<floors dFloor="1.0e-4" pFloor="1.0e-6" />
<timestep doCPR="T" limCPR="0.25" />
<restart doRes="F" nRes="-1" resID="msphere" />
<restart doRes="F" nRes="-1" resID="msphereRes" />
<physics Ca="10.0" doBoris="T" doMHD="T" />
<ring doRing="T" gid="lfm" />
<ringknobs doVClean="T" />

7
tests/voltron_mpi/testHelpersSquish_4.xml
View File

@@ -2,9 +2,9 @@
<!-- Gamera Magnetosphere -->
<Kaiju>
<voltron>
<time tFin="20.0"/>
<time tFin="21.0"/>
<spinup doSpin="T" tSpin="20.0" tIO="0.0"/>
<coupling dtCouple="5.0" rTrc="40.0" imType="RCM" doQkSquish="F" doDynDT="F" doAsyncCoupling="T"/>
<coupling dtCouple="5.0" rTrc="40.0" imType="RCM" doQkSquish="F" doDynDT="F" doAsyncCoupling="F"/>
<restart dtRes="1800.0"/>
<imag doInit="T"/>
<ebsquish epsSquish="0.05"/>
@@ -25,12 +25,13 @@
<wind tsfile="bcwind.h5"/>
<source doSource="T" doBounceDT="T"/>
<threading NumTh="18"/>
<coupling blockHalo="T"/>
</Gamera>
<!-- Remix -->
<REMIX>
<grid Np="360" Nt="55" LowLatBoundary="55.0"/>
<conductance doStarlight="T" doRamp="F" doMR="T"/>
<precipitation aurora_model_type="RCMONO" alpha="0.2" beta="0.4" doAuroralSmooth="T"/>
<precipitation aurora_model_type="LINMRG" alpha="0.2" beta="0.4" doAuroralSmooth="T"/>
</REMIX>
<CHIMP>
<units uid="EARTHCODE"/>

7
tests/voltron_mpi/testHelpersStep_4.xml
View File

@@ -2,9 +2,9 @@
<!-- Gamera Magnetosphere -->
<Kaiju>
<voltron>
<time tFin="20.0"/>
<time tFin="21.0"/>
<spinup doSpin="T" tSpin="20.0" tIO="0.0"/>
<coupling dtCouple="5.0" rTrc="40.0" imType="RCM" doQkSquish="F" doDynDT="F" doAsyncCoupling="T"/>
<coupling dtCouple="5.0" rTrc="40.0" imType="RCM" doQkSquish="F" doDynDT="F" doAsyncCoupling="F"/>
<restart dtRes="1800.0"/>
<imag doInit="T"/>
<ebsquish epsSquish="0.05"/>
@@ -25,12 +25,13 @@
<wind tsfile="bcwind.h5"/>
<source doSource="T" doBounceDT="T"/>
<threading NumTh="18"/>
<coupling blockHalo="T"/>
</Gamera>
<!-- Remix -->
<REMIX>
<grid Np="360" Nt="55" LowLatBoundary="55.0"/>
<conductance doStarlight="T" doRamp="F" doMR="T"/>
<precipitation aurora_model_type="RCMONO" alpha="0.2" beta="0.4" doAuroralSmooth="T"/>
<precipitation aurora_model_type="LINMRG" alpha="0.2" beta="0.4" doAuroralSmooth="T"/>
</REMIX>
<CHIMP>
<units uid="EARTHCODE"/>

285
tests/voltron_mpi/testcoupling.pf
View File

@@ -1,17 +1,14 @@
module testCoupling
use testHelperMpi
use gamapp_mpi
use voltapp_mpi
use gam2voltcomm_mpi
use gamCouple_mpi_G2V
use uservoltic
use ioH5
implicit none
logical :: isGamera = .false.
type(gamAppMpi_T), allocatable :: gamAppMpi
type(gamCouplerMpi_gam_T), allocatable :: gamCplMpi
type(voltAppMpi_T), allocatable :: voltAppMpi
type(gam2voltCommMpi_T), allocatable :: g2vCommMpi
contains
@@ -31,11 +28,7 @@ contains
call endVoltronWaits(voltAppMpi)
deallocate(voltAppMpi)
endif
if(allocated(g2vCommMpi)) then
call endGam2VoltWaits(g2vCommMpi, gamAppMpi)
deallocate(g2vCommMpi)
endif
if(allocated(gamAppMpi)) deallocate(gamAppMpi)
if(allocated(gamCplMpi)) deallocate(gamCplMpi)
end subroutine teardown
@@ -44,26 +37,30 @@ contains
character(len=*), intent(in) :: caseFile
integer :: ierror
type(MPI_Comm) :: gamComm, voltComm
type(MPI_Comm) :: voltComm
type(XML_Input_T) :: xmlInp
if(this%getProcessRank() < (this%getNumProcesses()-1)) then
isGamera = .true.
allocate(gamAppMpi)
allocate(g2vCommMpi)
allocate(gamCplMpi)
! make gamera-only mpi communicator
call MPI_Comm_Split(getMpiF08Communicator(this), 0, this%getProcessRank(), gamComm, ierror)
call MPI_Comm_Split(getMpiF08Communicator(this), gamId, this%getProcessRank(), gamCplMpi%gOptionsMpi%gamComm, ierror)
call initGamera_mpi(gamAppMpi, initUser, gamComm, trim(caseFile), .false.)
call initGam2Volt(g2vCommMpi, gamAppMpi, getMpiF08Communicator(this), trim(caseFile))
gamCplMpi%gOptionsCplMpiG%couplingPoolComm = getMpiF08Communicator(this)
gamCplMpi%gOptions%userInitFunc => initUser
gamCplMpi%gOptionsMpi%doIO = .false.
xmlInp = New_XML_Input(trim(caseFile),'Kaiju',.true.)
call gamCplMpi%InitModel(xmlInp)
else
isGamera = .false.
allocate(voltAppMpi)
! make gamera-only mpi communicator
call MPI_Comm_Split(getMpiF08Communicator(this), 1, this%getProcessRank(), voltComm, ierror)
call MPI_Comm_Split(getMpiF08Communicator(this), voltId, this%getProcessRank(), voltComm, ierror)
call initVoltron_mpi(voltAppMpi, initUser, voltComm, getMpiF08Communicator(this), trim(caseFile))
voltAppMpi%vOptions%gamUserInitFunc => initUser
allocate(voltAppMpi%vOptionsMpi%couplingPoolComm)
voltAppMpi%vOptionsMpi%couplingPoolComm = getMpiF08Communicator(this)
call initVoltron_mpi(voltAppMpi, trim(caseFile))
endif
end subroutine
@@ -71,32 +68,13 @@ contains
subroutine runApplication(tFin)
real(rp), intent(in) :: tFin
if(isGamera) then
do while (g2vCommMpi%time < tFin)
call stepGamera_mpi(gamAppMpi)
call localStepVoltronTime(g2vCommMpi, gamAppMpi)
if( (g2vCommMpi%time >= g2vCommMpi%DeepT .and. g2vCommMpi%doDeep) .or. &
(g2vCommMpi%time >= tFin)) then
call performStepVoltron(g2vCommMpi,gamAppMpi)
if ( g2vCommMpi%time >= g2vCommMpi%DeepT .and. g2vCommMpi%doDeep ) then
call performDeepUpdate(g2vCommMpi, gamAppMpi)
endif
endif
end do
if(allocated(gamCplMpi)) then
! adjust tFin time to gamera units
call gamCplMpi%AdvanceModel(tFin/gamCplMpi%Model%Units%gT0 - gamCplMpi%Model%t)
else
do while (voltAppMpi%time < tFin)
if(gameraStepReady(voltAppMpi)) then
call stepVoltron_mpi(voltAppMpi)
write (*,'(a,f8.3)') ' Time = ',voltAppMpi%time
if (voltAppMpi%time >= voltAppMpi%DeepT .and. voltAppMpi%doDeep ) then
call DeepUpdate_mpi(voltAppMpi, voltAppMpi%time)
endif
elseif(deepInProgress(voltAppMpi)) then
call doDeepBlock(voltAppMpi)
else
call waitForGameraStep(voltAppMpi)
endif
end do
call stepVoltron_mpi(voltAppMpi, tFin - voltAppMpi%time)
end do
endif
end subroutine runApplication
@@ -109,27 +87,24 @@ contains
write(caseFile,'(A,I0,A)') 'cmiD_deep_', this%getNumProcesses()-1, '_res60.xml'
call initializeWithCaseXml(this, caseFile)
if(isGamera) then
! adjust coupling parameters
call endGam2VoltWaits(g2vCommMpi, gamAppMpi)
g2vCommMpi%doSerialVoltron = .true.
g2vCommMpi%doAsyncCoupling = .false.
g2vCommMpi%firstDeepUpdate = .true.
! run case for 20 additional seconds
call runApplication(80.0_rp)
if(allocated(gamCplMpi)) then
! run case for 20 seconds past restart
call runApplication(81.0_rp)
else
write (*,'(a,I0)') 'Testing Serial ',this%getNumProcesses()
!adjust coupling parameters
call endVoltronWaits(voltAppMpi)
voltAppMpi%doSerialVoltron = .true.
voltAppMpi%doAsyncCoupling = .false.
voltAppMpi%firstDeepUpdate = .true.
voltAppMpi%firstStepUpdate = .true.
!adjust coupling parameters, must be MPI Gamera Coupler
SELECT type(cpl=>voltAppMpi%gApp)
TYPE IS (gamCouplerMpi_volt_T)
call endVoltronWaits(voltAppMpi)
voltAppMPi%doSerialMHD = .true.
cpl%doAsyncCoupling = .false.
CLASS DEFAULT
@assertTrue(.false., "Voltron Allocated non-mpi Gamera coupler for MPI Voltron Coupling Test. Failure")
ENDSELECT
! run case for 20 additional seconds
call runApplication(80.0_rp)
! run case for 20 seconds past restart
call runApplication(81.0_rp)
endif
end subroutine testSerialCoupling
@@ -142,30 +117,29 @@ contains
write(caseFile,'(A,I0,A)') 'cmiD_deep_', this%getNumProcesses()-1, '_res60.xml'
call initializeWithCaseXml(this, caseFile)
if(isGamera) then
call endGam2VoltWaits(g2vCommMpi, gamAppMpi)
g2vCommMpi%doSerialVoltron = .false.
g2vCommMpi%doAsyncCoupling = .false.
g2vCommMpi%firstDeepUpdate = .true.
! run case for 20 additional seconds
call runApplication(80.0_rp)
if(allocated(gamCplMpi)) then
! run case for 20 seconds past restart
call runApplication(81.0_rp)
else
write (*,'(a,I0)') 'Testing Concurrent ',this%getNumProcesses()
call endVoltronWaits(voltAppMpi)
voltAppMpi%doSerialVoltron = .false.
voltAppMpi%doAsyncCoupling = .false.
voltAppMpi%firstDeepUpdate = .true.
voltAppMpi%firstStepUpdate = .true.
!adjust coupling parameters, must be MPI Gamera Coupler
SELECT type(cpl=>voltAppMpi%gApp)
TYPE IS (gamCouplerMpi_volt_T)
call endVoltronWaits(voltAppMpi)
voltAppMpi%doSerialMHD = .false.
cpl%doAsyncCoupling = .false.
CLASS DEFAULT
@assertTrue(.false., "Voltron Allocated non-mpi Gamera coupler for MPI Voltron Coupling Test. Failure")
ENDSELECT
! run case for 20 additional seconds
call runApplication(80.0_rp)
! run case for 20 seconds past restart
call runApplication(81.0_rp)
endif
end subroutine testConcCoupling
@test(npes=[9])
! @test(npes=[9])
subroutine testAsyncCoupling(this)
class (MpiTestMethod), intent(inout) :: this
@@ -173,30 +147,30 @@ contains
write(caseFile,'(A,I0,A)') 'cmiD_deep_', this%getNumProcesses()-1, '_res60.xml'
call initializeWithCaseXml(this, caseFile)
if(isGamera) then
call endGam2VoltWaits(g2vCommMpi, gamAppMpi)
g2vCommMpi%doSerialVoltron = .false.
g2vCommMpi%doAsyncCoupling = .true.
g2vCommMpi%firstDeepUpdate = .true.
! run case for 20 additional seconds
call runApplication(80.0_rp)
if(allocated(gamCplMpi)) then
! run case for 20 seconds past restart
call runApplication(81.0_rp)
else
write (*,'(a,I0)') 'Testing Async ',this%getNumProcesses()
call endVoltronWaits(voltAppMpi)
voltAppMpi%doSerialVoltron = .false.
voltAppMpi%doAsyncCoupling = .true.
voltAppMpi%firstDeepUpdate = .true.
voltAppMpi%firstStepUpdate = .true.
!adjust coupling parameters, must be MPI Gamera Coupler
SELECT type(cpl=>voltAppMpi%gApp)
TYPE IS (gamCouplerMpi_volt_T)
call endVoltronWaits(voltAppMpi)
voltAppMpi%doSerialMHD = .false.
cpl%doAsyncCoupling = .true.
CLASS DEFAULT
@assertTrue(.false., "Voltron Allocated non-mpi Gamera coupler for MPI Voltron Coupling Test. Failure")
ENDSELECT
! run case for 20 additional seconds
call runApplication(80.0_rp)
! run case for 20 seconds past restart
call runApplication(81.0_rp)
endif
end subroutine testAsyncCoupling
@test(npes=[9])
!Temporary disabled
!@test(npes=[9])
subroutine testAdjustDeepCoupling(this)
class (MpiTestMethod), intent(inout) :: this
@@ -204,44 +178,34 @@ contains
write(caseFile,'(A,I0,A)') 'cmiD_deep_', this%getNumProcesses()-1, '_res0.xml'
call initializeWithCaseXml(this, caseFile)
if(isGamera) then
call endGam2VoltWaits(g2vCommMpi, gamAppMpi)
g2vCommMpi%doSerialVoltron = .false.
g2vCommMpi%doAsyncCoupling = .true.
g2vCommMpi%firstDeepUpdate = .true.
! couple three times and check DT
call performDeepUpdate(g2vCommMpi,gamAppMpi)
call performDeepUpdate(g2vCommMpi,gamAppMpi)
call performDeepUpdate(g2vCommMpi,gamAppMpi)
! couple three more times and check DT again
call performDeepUpdate(g2vCommMpi,gamAppMpi)
call performDeepUpdate(g2vCommMpi,gamAppMpi)
call performDeepUpdate(g2vCommMpi,gamAppMpi)
if(allocated(gamCplMpi)) then
! run case for 20 seconds past restart
call runApplication(80.0_rp)
else
write (*,'(a,I0)') 'Testing DynDT Deep ',this%getNumProcesses()
write (*,'(a,I0)') 'Testing DenDT Deep ',this%getNumProcesses()
call endVoltronWaits(voltAppMpi)
voltAppMpi%doSerialVoltron = .false.
voltAppMpi%doAsyncCoupling = .true.
voltAppMpi%firstDeepUpdate = .true.
voltAppMpi%firstStepUpdate = .true.
voltAppMpi%DeepDT = 10.0
voltAppMpi%TargetDeepDT = 10.0
!adjust coupling parameters, must be MPI Gamera Coupler
SELECT type(cpl=>voltAppMpi%gApp)
TYPE IS (gamCouplerMpi_volt_T)
call endVoltronWaits(voltAppMpi)
voltAppMpi%doSerialMHD = .false.
cpl%doAsyncCoupling = .true.
CLASS DEFAULT
@assertTrue(.false., "Voltron Allocated non-mpi Gamera coupler for MPI Voltron Coupling Test. Failure")
ENDSELECT
! couple three times and check DT
call DeepUpdate_mpi(voltAppMpi, voltAppMpi%time)
call DeepUpdate_mpi(voltAppMpi, voltAppMpi%time)
call DeepUpdate_mpi(voltAppMpi, voltAppMpi%time)
@assertEqual(10.0_rp, voltAppMpi%DeepDT, trim("Voltron DeepDT not 10.0 after first couplings"))
! run case for 10 seconds past restart with low DeepDT
voltAppMpi%DeepDT = 5.0_rp
call runApplication(70.0_rp)
@assertEqual(5.0_rp, voltAppMpi%DeepDT, trim("Voltron DeepDT not 5.0 after first couplings"))
! now run the case until 20 seconds past restart with high DeepDT
call resetDeepCoupling(voltAppMpi, 10.0_rp)
voltAppMpi%DeepDT = 10.0_rp
call runApplication(80.0_rp)
@assertEqual(10.0_rp, voltAppMpi%DeepDT, trim("Voltron DeepDT not 10.0 after second couplings"))
! couple three more times and check DT again
call resetDeepCoupling(voltAppMpi, 20.0_rp)
call DeepUpdate_mpi(voltAppMpi, voltAppMpi%time)
call DeepUpdate_mpi(voltAppMpi, voltAppMpi%time)
call DeepUpdate_mpi(voltAppMpi, voltAppMpi%time)
@assertEqual(20.0_rp, voltAppMpi%DeepDT, trim("Voltron DeepDT not 20.0 after second couplings"))
endif
end subroutine testAdjustDeepCoupling
@@ -256,28 +220,18 @@ contains
write(caseFile,'(A,I0,A)') 'cmiD_deep_', this%getNumProcesses()-1, '_res0.xml'
call initializeWithCaseXml(this, caseFile)
if(isGamera) then
call endGam2VoltWaits(g2vCommMpi, gamAppMpi)
g2vCommMpi%doSerialVoltron = .false.
g2vCommMpi%doAsyncCoupling = .true.
g2vCommMpi%firstDeepUpdate = .true.
! explicitly deeo couple once to update deep data
call performDeepUpdate(g2vCommMpi,gamAppMpi)
if(allocated(gamCplMpi)) then
! run case for 10 seconds past spinup
call runApplication(11.0_rp)
else
write (*,'(a,I0)') 'Testing Quick Squish ',this%getNumProcesses()
call endVoltronWaits(voltAppMpi)
voltAppMpi%doSerialVoltron = .false.
voltAppMpi%doAsyncCoupling = .true.
voltAppMpi%firstDeepUpdate = .true.
voltAppMpi%firstStepUpdate = .true.
! explicitly deep couple once to update deep data
call DeepUpdate_mpi(voltAppMpi, voltAppMpi%time)
! run case for 10 seconds past spinup
call runApplication(11.0_rp)
! now check the quick squish erroers
call CheckQuickSquishError(voltAppMpi, voltAppMpi%gAppLocal, Nbase, Nx2, Nx4, x2Err, x4Err)
call CheckQuickSquishError(voltAppMpi, voltAppMpi%gApp, Nbase, Nx2, Nx4, x2Err, x4Err)
! Ensure that the number of valid cells decreases as quick squish interpolation increases
@assertTrue(Nx2 <= Nbase, trim("X2 Quick Squish has more valid cells than normal squish. This should not be possible."))
@@ -286,20 +240,21 @@ contains
! Per cell error metric
@assertLessThanOrEqual(x2Err, 5e-3_rp, trim("X2 Quick Squish Error per cell is too large"))
@assertLessThanOrEqual(x4Err, 2e-2_rp, trim("X4 Quick Squish Error per cell is too large"))
@assertLessThanOrEqual(x4Err, 5e-2_rp, trim("X4 Quick Squish Error per cell is too large"))
! Approximate how many i layers of actual data there are if the data were spherical
approxShells = Nbase
approxShells = approxShells / (voltAppMpi%ebTrcApp%ebState%ebGr%ke+2-voltAppMpi%ebTrcApp%ebState%ebGr%ks)
approxShells = approxShells / (voltAppMpi%ebTrcApp%ebState%ebGr%je+2-voltAppMpi%ebTrcApp%ebState%ebGr%js)
! If the data were spherical, squish x2 would reduce it by half of a layer on average. It's not spherical, so increase the error margin by 5
! If the data were spherical, squish x2 would reduce it by half of a layer on average. It's not spherical, so increase the error margin by 10
Ndiv = Nbase-Nx2
@assertLessThanOrEqual(Ndiv/Nbase, 2.5_rp/approxShells, trim("X2 Quick Squish has too many cells missing values compared to normal squish."))
! If the data were spherical, squish x4 would reduce it by 1.5 of a layer on average. It's not spherical, so increase the error margin by 5
@assertLessThanOrEqual(Ndiv/Nbase, 5.0_rp/approxShells, trim("X2 Quick Squish has too many cells missing values compared to normal squish."))
! If the data were spherical, squish x4 would reduce it by 1.5 of a layer on average. It's not spherical, so increase the error margin by 10
Ndiv = Nbase-Nx4
@assertLessThanOrEqual(Ndiv/Nbase, 7.5_rp/approxShells, trim("X4 Quick Squish has too many cells missing values compared to normal squish."))
@assertLessThanOrEqual(Ndiv/Nbase, 15.0_rp/approxShells, trim("X4 Quick Squish has too many cells missing values compared to normal squish."))
endif
end subroutine testQuickSquish
@test(npes=[9])
@@ -312,28 +267,17 @@ contains
write(caseFile,'(A,I0,A)') 'cmiD_deep_', this%getNumProcesses()-1, '_res600.xml'
call initializeWithCaseXml(this, caseFile)
if(isGamera) then
call endGam2VoltWaits(g2vCommMpi, gamAppMpi)
g2vCommMpi%doSerialVoltron = .false.
g2vCommMpi%doAsyncCoupling = .true.
g2vCommMpi%firstDeepUpdate = .true.
! explicitly deeo couple once to update deep data
call performDeepUpdate(g2vCommMpi,gamAppMpi)
if(allocated(gamCplMpi)) then
! run case for 10 seconds past restart
call runApplication(611.0_rp)
else
write (*,'(a,I0)') 'Testing Quick Squish Storm ',this%getNumProcesses()
call endVoltronWaits(voltAppMpi)
voltAppMpi%doSerialVoltron = .false.
voltAppMpi%doAsyncCoupling = .true.
voltAppMpi%firstDeepUpdate = .true.
voltAppMpi%firstStepUpdate = .true.
! explicitly deep couple once to update deep data
call DeepUpdate_mpi(voltAppMpi, voltAppMpi%time)
! run case for 10 seconds past restart
call runApplication(611.0_rp)
! now check the quick squish erroers
call CheckQuickSquishError(voltAppMpi, voltAppMpi%gAppLocal, Nbase, Nx2, Nx4, x2Err, x4Err)
call CheckQuickSquishError(voltAppMpi, voltAppMpi%gApp, Nbase, Nx2, Nx4, x2Err, x4Err)
! Ensure that the number of valid cells decreases as quick squish interpolation increases
@assertTrue(Nx2 <= Nbase, trim("X2 Quick Squish has more valid cells than normal squish. This should not be possible."))
@@ -342,20 +286,21 @@ contains
! Per cell error metric
@assertLessThanOrEqual(x2Err, 5e-3_rp, trim("X2 Quick Squish Error per cell is too large"))
@assertLessThanOrEqual(x4Err, 2e-2_rp, trim("X4 Quick Squish Error per cell is too large"))
@assertLessThanOrEqual(x4Err, 5e-2_rp, trim("X4 Quick Squish Error per cell is too large"))
! Approximate how many i layers of actual data there are if the data were spherical
approxShells = Nbase
approxShells = approxShells / (voltAppMpi%ebTrcApp%ebState%ebGr%ke+2-voltAppMpi%ebTrcApp%ebState%ebGr%ks)
approxShells = approxShells / (voltAppMpi%ebTrcApp%ebState%ebGr%je+2-voltAppMpi%ebTrcApp%ebState%ebGr%js)
! If the data were spherical, squish x2 would reduce it by half of a layer on average. It's not spherical, so increase the error margin by 5
! If the data were spherical, squish x2 would reduce it by half of a layer on average. It's not spherical, so increase the error margin by 10
Ndiv = Nbase-Nx2
@assertLessThanOrEqual(Ndiv/Nbase, 2.5_rp/approxShells, trim("X2 Quick Squish has too many cells missing values compared to normal squish."))
! If the data were spherical, squish x4 would reduce it by 1.5 of a layer on average. It's not spherical, so increase the error margin by 5
@assertLessThanOrEqual(Ndiv/Nbase, 5.0_rp/approxShells, trim("X2 Quick Squish has too many cells missing values compared to normal squish."))
! If the data were spherical, squish x4 would reduce it by 1.5 of a layer on average. It's not spherical, so increase the error margin by 10
Ndiv = Nbase-Nx4
@assertLessThanOrEqual(Ndiv/Nbase, 7.5_rp/approxShells, trim("X4 Quick Squish has too many cells missing values compared to normal squish."))
@assertLessThanOrEqual(Ndiv/Nbase, 15.0_rp/approxShells, trim("X4 Quick Squish has too many cells missing values compared to normal squish."))
endif
end subroutine testQuickSquishStorm
end module testCoupling

178
tests/voltron_mpi/testebmpi.pf Normal file
View File

@@ -0,0 +1,178 @@
module testebmpi
use testHelperMpi
use voltapp_mpi
use gamCouple_mpi_G2V
use uservoltic
implicit none
type(gamCouplerMpi_gam_T), allocatable :: gamCplMpi
type(voltAppMpi_T), allocatable :: voltAppMpi
contains
@before
subroutine setup(this)
class (MpiTestMethod), intent(inout) :: this
character(len=strLen) :: caseFile
integer :: ierror
type(MPI_Comm) :: voltComm
type(XML_Input_T) :: xmlInp
call setMpiReal()
write(caseFile,'(A,I0,A)') 'cmiD_deep_', this%getNumProcesses()-1, '.xml'
if(this%getProcessRank() < (this%getNumProcesses()-1)) then
allocate(gamCplMpi)
! make gamera-only mpi communicator
call MPI_Comm_Split(getMpiF08Communicator(this), gamId, this%getProcessRank(), gamCplMpi%gOptionsMpi%gamComm, ierror)
gamCplMpi%gOptionsCplMpiG%couplingPoolComm = 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
allocate(voltAppMpi%vOptionsMpi%couplingPoolComm)
voltAppMpi%vOptionsMpi%couplingPoolComm = getMpiF08Communicator(this)
call initVoltron_mpi(voltAppMpi, trim(caseFile))
endif
end subroutine setup
@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
! helper subroutine to check squish data in Gas0
subroutine testGas0(Gr, locStr)
type(Grid_T), intent(in) :: Gr
character(len=*), intent(in) :: locStr
real(rp) :: Qs(8),xyz(NDIM), X1cc, X2cc
real(rp), allocatable :: SrcX12(:,:,:,:)
character(len=strLen) :: checkMessage
integer :: i,j,k,jmin,jmax
!Testing code to run on each gamera mpi rank
allocate(SrcX12(Gr%isg:Gr%ieg+1,Gr%jsg:Gr%jeg+1,Gr%ksg:Gr%keg+1,2))
!Calculate corner projections
do k=Gr%ksg,Gr%keg+1
do j=Gr%jsg,Gr%jeg+1
do i=Gr%isg,Gr%ieg+1
xyz = Gr%xyz(i,j,k,:) !Corner
SrcX12(i,j,k,1) = rad2deg*InvLatitude(xyz)
SrcX12(i,j,k,2) = rad2deg*katan2(xyz(YDIR),xyz(XDIR))
enddo
enddo
enddo
if(Gr%hasLowerBC(JDIR)) then
jMin = Gr%js+1
else
jMin = Gr%jsg
endif
if(Gr%hasUpperBC(JDIR)) then
jMax = Gr%je-1
else
jMax = Gr%jeg
endif
!Now check against each cell center Gas0 value
do k=Gr%ksg,Gr%keg
do j=jMin,jMax ! singularities get averaged, don't test them
do i=Gr%isg,Gr%ieg
!Define cell center value to be appropriate 8-point of corners
if(Gr%Gas0(i,j,k,IMDEN,BLK) /= 0 .or. Gr%Gas0(i,j,k,IMX1,BLK) /= 0 .or. &
Gr%Gas0(i,j,k,IMX2,BLK) /= 0 .or. Gr%Gas0(i,j,k,IMPR,BLK) /= 0) then
!Gas0 data is tasty/valid
call SquishCorners(SrcX12(i:i+1,j:j+1,k:k+1,1),Qs)
X1cc = ArithMean(Qs)
call SquishCorners(SrcX12(i:i+1,j:j+1,k:k+1,2),Qs)
X2cc = CircMeanDeg(Qs)
write (checkMessage,'(A,A,A,I0,A,I0,A,I0,A)'), 'Gas0 Latitude is wrong on ',trim(locStr),' at (',i,',',j,',',k,')'
@assertEqual(X1cc,Gr%Gas0(i,j,k,IMX1,BLK),1e-17_rp,trim(checkMessage))
write (checkMessage,'(A,A,A,I0,A,I0,A,I0,A)'), 'Gas0 Longitude is wrong on ',trim(locStr),' at (',i,',',j,',',k,')'
@assertEqual(X2cc,Gr%Gas0(i,j,k,IMX2,BLK),1e-17_rp,trim(checkMessage))
endif
enddo
enddo
enddo
deallocate(SrcX12)
end subroutine
@test(npes=[2,5,9])
subroutine VMPIsquishDipoleTest(this)
class (MpiTestMethod), intent(inout) :: this
character(len=strLen) :: locStr, checkMessage
integer :: i,j,k
if(allocated(gamCplMpi)) then
! receive data from voltron
call recvDeepCplDataMpi(gamCplMpi)
! check Gas0 data
write (locStr,'(A,I0,A,I0,A,I0,A)'), 'Gam(',gamCplMpi%Grid%Ri,',',gamCplMpi%Grid%Rj,',',gamCplMpi%Grid%Rk,')'
call testGas0(gamCplMpi%Grid, locStr)
else
! enable debug projection and tubes for testing
voltAppMpi%ebTrcApp%ebModel%doDip = .true.
select type(rcmApp=>voltAppMpi%imagApp)
type is (rcmIMAG_T)
rcmApp%doFakeTube = .true.
class default
@assertTrue(.false., 'IMAG type must be RCM for the MPI squish test')
end select
! disable quick squishing
voltAppMpi%qkSquishStride = 1
voltAppMpi%doQkSquish = .false.
@assertTrue(voltAppMpi%ebTrcApp%ebSquish%myNumBlocks < 0, 'Helpers must be disabled for MPI squish test')
! advance to T=0seconds and perform a deep coupling
voltAppMpi%time = 0
call DeepUpdate_mpi(voltAppMpi)
SELECT type(cpl=>voltAppMpi%gApp)
TYPE IS (gamCouplerMpi_volt_T)
! send the data to gamera
call sendDeepCplDataMpi(cpl)
CLASS DEFAULT
@assertTrue(.false., "Voltron Allocated non-mpi Gamera coupler for MPI squish test. Failure")
ENDSELECT
! check results on voltron side
call testGas0(voltAppMpi%gApp%Grid, 'Voltron')
endif
end subroutine VMPIsquishDipoleTest
end module testebmpi

116
tests/voltron_mpi/testhelpers.pf
View File

@@ -1,17 +1,15 @@
module testHelpers
use testHelperMpi
use gamapp_mpi
use voltapp_mpi
use gam2voltcomm_mpi
use gamCouple_mpi_G2V
use uservoltic
use ioH5
implicit none
logical :: isGamera = .false.
type(gamAppMpi_T), allocatable :: gamAppMpi
type(gamCouplerMpi_gam_T), allocatable :: gamCplMpi
type(voltAppMpi_T), allocatable :: voltAppMpi
type(gam2voltCommMpi_T), allocatable :: g2vCommMpi
logical :: amHelper = .false.
contains
@@ -27,28 +25,44 @@ contains
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
isGamera = .true.
allocate(gamAppMpi)
allocate(g2vCommMpi)
allocate(gamCplMpi)
! make gamera-only mpi communicator
call MPI_Comm_Split(getMpiF08Communicator(this), 0, this%getProcessRank(), gamComm, ierror)
call MPI_Comm_Split(getMpiF08Communicator(this), gamId, this%getProcessRank(), gamCplMpi%gOptionsMpi%gamComm, ierror)
call initGamera_mpi(gamAppMpi, initUser, gamComm, trim(caseFile), .false.)
call initGam2Volt(g2vCommMpi, gamAppMpi, getMpiF08Communicator(this), trim(caseFile))
else
isGamera = .false.
gamCplMpi%gOptionsCplMpiG%couplingPoolComm = getMpiF08Communicator(this)
gamCplMpi%gOptions%userInitFunc => initUser
gamCplMpi%gOptionsMpi%doIO = .false.
xmlInp = New_XML_Input(trim(caseFile),'Kaiju',.true.)
call gamCplMpi%InitModel(xmlInp)
elseif(this%getProcessRank() == 4) then
allocate(voltAppMpi)
amHelper = .false.
! make gamera-only mpi communicator
call MPI_Comm_Split(getMpiF08Communicator(this), 1, this%getProcessRank(), voltComm, ierror)
call MPI_Comm_Split(getMpiF08Communicator(this), voltId, this%getProcessRank(), voltComm, ierror)
call initVoltron_mpi(voltAppMpi, initUser, voltComm, getMpiF08Communicator(this), trim(caseFile))
voltAppMpi%vOptions%gamUserInitFunc => initUser
allocate(voltAppMpi%vOptionsMpi%couplingPoolComm)
voltAppMpi%vOptionsMpi%couplingPoolComm = getMpiF08Communicator(this)
call initVoltron_mpi(voltAppMpi, trim(caseFile))
else
allocate(voltAppMpi)
amHelper = .true.
! make gamera-only mpi communicator
call MPI_Comm_Split(getMpiF08Communicator(this), voltId, this%getProcessRank(), voltComm, ierror)
voltAppMpi%vOptions%gamUserInitFunc => initUser
allocate(voltAppMpi%vOptionsMpi%couplingPoolComm)
voltAppMpi%vOptionsMpi%couplingPoolComm = getMpiF08Communicator(this)
call initVoltronHelper_mpi(voltAppMpi, trim(caseFile))
endif
end subroutine manualSetup
@@ -61,56 +75,34 @@ contains
call endVoltronWaits(voltAppMpi)
deallocate(voltAppMpi)
endif
if(allocated(g2vCommMpi)) then
call endGam2VoltWaits(g2vCommMpi, gamAppMpi)
deallocate(g2vCommMpi)
endif
if(allocated(gamAppMpi)) deallocate(gamAppMpi)
if(allocated(gamCplMpi)) deallocate(gamCplMpi)
end subroutine teardown
subroutine runApplication()
logical :: helperQuit
if(isGamera) then
do while (g2vCommMpi%time < g2vCommMpi%tFin)
call stepGamera_mpi(gamAppMpi)
call localStepVoltronTime(g2vCommMpi, gamAppMpi)
if( (g2vCommMpi%time >= g2vCommMpi%DeepT .and. g2vCommMpi%doDeep) .or. &
(g2vCommMpi%time >= g2vCommMpi%tFin)) then
call performStepVoltron(g2vCommMpi,gamAppMpi)
if ( g2vCommMpi%time >= g2vCommMpi%DeepT .and. g2vCommMpi%doDeep ) then
call performDeepUpdate(g2vCommMpi, gamAppMpi)
endif
endif
end do
if(allocated(gamCplMpi)) then
! adjust tFin time to gamera units
call gamCplMpi%AdvanceModel(gamCplMpi%Model%tFin - gamCplMpi%Model%t)
else
if(voltAppMpi%amHelper) then
if(amHelper) then
helperQuit = .false.
do while(.not. helperQuit)
call helpVoltron(voltAppMpi, helperQuit)
end do
else
do while (voltAppMpi%time < voltAppMpi%tFin)
if(gameraStepReady(voltAppMpi)) then
call stepVoltron_mpi(voltAppMpi)
write (*,'(a,f8.3)') ' Time = ',voltAppMpi%time
if (voltAppMpi%time >= voltAppMpi%DeepT .and. voltAppMpi%doDeep ) then
call DeepUpdate_mpi(voltAppMpi, voltAppMpi%time)
endif
elseif(deepInProgress(voltAppMpi)) then
call doDeepBlock(voltAppMpi)
else
call waitForGameraStep(voltAppMpi)
endif
enddo
call stepVoltron_mpi(voltAppMpi, voltAppMpi%tFin-voltAppMpi%time)
end do
if(voltAppMpi%useHelpers) call vhReqHelperQuit(voltAppMpi)
endif
endif
end subroutine runApplication
@test(npes=[8])
! this test doesn't work with current layout, timestepping is tested as part of test below
!@test(npes=[8])
subroutine testHelpTimestepping(this)
class (MpiTestMethod), intent(inout) :: this
@@ -118,11 +110,7 @@ contains
call manualSetup(this, 'testHelpersStep_4.xml')
if(isGamera) then
call runApplication()
else
call runApplication()
endif
call runApplication()
end subroutine
@@ -143,18 +131,14 @@ contains
call manualSetup(this, 'testHelpersSquish_4.xml')
if(isGamera) then
call runApplication()
else
call runApplication()
endif
call runApplication()
! Now compare distributed squish results to local-only squish results
if(.not. isGamera) then
if(.not. voltAppMpi%amHelper) then
if(allocated(voltAppMpi)) then
if(.not. amHelper) then
! call doImag once to update rTrc and nTrc before doing any squishing
call PreDeep(voltAppMpi, voltAppMpi%gAppLocal)
call PreDeep(voltAppMpi, voltAppMpi%gApp)
call DoImag(voltAppMpi)
! calculate distributed squish from most recent results
@@ -169,7 +153,7 @@ contains
! 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%gAppLocal)
call DeepUpdate(voltAppMpi, voltAppMpi%gApp)
sqErr = 0
maxSqErr = 0
@@ -221,11 +205,11 @@ contains
! debugging
!type(IOVAR_T), dimension(12) :: IOVars
write (*,'(a,I0)') 'Testing HelpSquish ',this%getNumProcesses()
write (*,'(a,I0)') 'Testing HelpSquish Dip',this%getNumProcesses()
call manualSetup(this, 'testHelpersSquish_4.xml')
if(isGamera) then
if(allocated(gamCplMpi)) then
call runApplication()
else
voltAppMpi%ebTrcApp%ebModel%doDip = .true.
@@ -233,11 +217,11 @@ contains
endif
! Now compare distributed squish results to local-only squish results
if(.not. isGamera) then
if(.not. voltAppMpi%amHelper) then
if(allocated(voltAppMpi)) then
if(.not. amHelper) then
! call doImag once to update rTrc and nTrc before doing any squishing
call PreDeep(voltAppMpi, voltAppMpi%gAppLocal)
call PreDeep(voltAppMpi, voltAppMpi%gApp)
call DoImag(voltAppMpi)
! calculate distributed squish from most recent results
@@ -252,7 +236,7 @@ contains
! 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%gAppLocal)
call DeepUpdate(voltAppMpi, voltAppMpi%gApp)
sqErr = 0
maxSqErr = 0

292
tests/voltron_mpi/testvmpi.pf
View File

@@ -1,17 +1,14 @@
module testVMpi
use testHelperMpi
use gamapp_mpi
use voltapp_mpi
use gam2voltcomm_mpi
use gamCouple_mpi_G2V
use uservoltic
use ioH5
implicit none
logical :: isGamera = .false.
type(gamAppMpi_T), allocatable :: gamAppMpi
type(gamCouplerMpi_gam_T), allocatable :: gamCplMpi
type(voltAppMpi_T), allocatable :: voltAppMpi
type(gam2voltCommMpi_T), allocatable :: g2vCommMpi
contains
@@ -21,7 +18,8 @@ contains
character(len=strLen) :: caseFile
integer :: ierror
type(MPI_Comm) :: gamComm, voltComm
type(MPI_Comm) :: voltComm
type(XML_Input_T) :: xmlInp
call setMpiReal()
@@ -29,23 +27,26 @@ contains
if(this%getProcessRank() < (this%getNumProcesses()-1)) then
isGamera = .true.
allocate(gamAppMpi)
allocate(g2vCommMpi)
allocate(gamCplMpi)
! make gamera-only mpi communicator
call MPI_Comm_Split(getMpiF08Communicator(this), 0, this%getProcessRank(), gamComm, ierror)
call MPI_Comm_Split(getMpiF08Communicator(this), gamId, this%getProcessRank(), gamCplMpi%gOptionsMpi%gamComm, ierror)
call initGamera_mpi(gamAppMpi, initUser, gamComm, caseFile, .false.)
call initGam2Volt(g2vCommMpi, gamAppMpi, getMpiF08Communicator(this), caseFile)
gamCplMpi%gOptionsCplMpiG%couplingPoolComm = getMpiF08Communicator(this)
gamCplMpi%gOptions%userInitFunc => initUser
gamCplMpi%gOptionsMpi%doIO = .false.
xmlInp = New_XML_Input(trim(caseFile),'Kaiju',.true.)
call gamCplMpi%InitModel(xmlInp)
else
isGamera = .false.
allocate(voltAppMpi)
! make gamera-only mpi communicator
call MPI_Comm_Split(getMpiF08Communicator(this), 1, this%getProcessRank(), voltComm, ierror)
call MPI_Comm_Split(getMpiF08Communicator(this), voltId, this%getProcessRank(), voltComm, ierror)
call initVoltron_mpi(voltAppMpi, initUser, voltComm, getMpiF08Communicator(this), caseFile)
voltAppMpi%vOptions%gamUserInitFunc => initUser
allocate(voltAppMpi%vOptionsMpi%couplingPoolComm)
voltAppMpi%vOptionsMpi%couplingPoolComm = getMpiF08Communicator(this)
call initVoltron_mpi(voltAppMpi, trim(caseFile))
endif
end subroutine setup
@@ -58,56 +59,10 @@ contains
call endVoltronWaits(voltAppMpi)
deallocate(voltAppMpi)
endif
if(allocated(g2vCommMpi)) then
call endGam2VoltWaits(g2vCommMpi, gamAppMpi)
deallocate(g2vCommMpi)
endif
if(allocated(gamAppMpi)) deallocate(gamAppMpi)
if(allocated(gamCplMpi)) deallocate(gamCplMpi)
end subroutine teardown
@test(npes=[2,5,9])
subroutine testStepUpdate(this)
class (MpiTestMethod), intent(inout) :: this
character(len=strLen) :: checkMessage
if(isGamera) then
! setting fixed values to gamera to ensure updates occur
gamAppMpi%Model%t = 1.23
gamAppMpi%Model%ts = 178
g2vCommMpi%time = 0
g2vCommMpi%MJD = 0
g2vCommMpi%ts = 0
call localStepVoltronTime(g2vCommMpi, gamAppMpi)
call performStepVoltron(g2vCommMpi,gamAppMpi)
write (checkMessage,'(A,I0)') 'voltron time wrong on gamera rank ',this%getProcessRank()
@assertEqual(1.23*gamAppMpi%Model%Units%gT0, g2vCommMpi%time, trim(checkMessage))
write (checkMessage,'(A,I0)') 'MJD wrong on gamera rank ',this%getProcessRank()
@assertLessThanOrEqual(abs(gamAppMpi%Model%MJD0 + g2vCommMpi%time/(60.0*60.0*24.0) - g2vCommMpi%MJD), 1e-5_rp, trim(checkMessage))
write (checkMessage,'(A,I0)') 'voltron ts wrong on gamera rank ',this%getProcessRank()
@assertEqual(178, g2vCommMpi%ts, trim(checkMessage))
else
! setting fixed values to voltron to ensure updates occur
voltAppMpi%gAppLocal%Model%t = 0
voltAppMpi%gAppLocal%Model%ts = 0
voltAppMpi%time = 0
voltAppMpi%MJD = 0
voltAppMpi%ts = 0
call stepVoltron_mpi(voltAppMpi)
@assertEqual(1.23, voltAppMpi%gAppLocal%Model%t, 'gamera time value wrong on voltron')
@assertEqual(178, voltAppMpi%gAppLocal%Model%ts, 'gamera ts value wrong on voltron')
@assertEqual(1.23*voltAppMpi%gAppLocal%Model%Units%gT0, voltAppMpi%time, 'voltron time value wrong on voltron')
@assertLessThanOrEqual(abs(voltAppMpi%gAppLocal%Model%MJD0 + voltAppMpi%time/(60.0*60.0*24.0) - voltAppMpi%MJD), 1e-5_rp, 'MJD value wrong on voltron')
@assertEqual(178, voltAppMpi%ts, 'voltron ts value wrong on voltron')
endif
end subroutine testStepUpdate
@test(npes=[2,5,9])
subroutine testVolt2MhdShallowCopy(this)
class (MpiTestMethod), intent(inout) :: this
@@ -123,9 +78,9 @@ contains
kVal = 400
lVal = 8000
if(isGamera) then
if(gamAppMpi%Grid%hasLowerBC(IDIR)) then
SELECT type(iiBC=>gamAppMpi%Grid%externalBCs(INI)%p)
if(allocated(gamCplMpi)) then
if(gamCplMpi%Grid%hasLowerBC(IDIR)) then
SELECT type(iiBC=>gamCplMpi%Grid%externalBCs(INI)%p)
TYPE IS (IonInnerBC_T)
! clear all cells
@@ -133,17 +88,17 @@ contains
iiBC%inExyz(:,:,:,:) = 0
! receive the data from voltron
call recvShallowData(g2vCommMpi, gamAppMpi)
call recvShallowCplDataMpi(gamCplMpi)
! check inExyz values
do i=1,g2vCommMpi%PsiSh
do j=gamAppMpi%Grid%jsg,gamAppMpi%Grid%jeg
do k=gamAppMpi%Grid%ksg,gamAppMpi%Grid%keg
do i=1,PsiSh
do j=gamCplMpi%Grid%jsg,gamCplMpi%Grid%jeg
do k=gamCplMpi%Grid%ksg,gamCplMpi%Grid%keg
do l=1,NDIM
checkVal = lVal*l + &
kVal*(k+gamAppMpi%Grid%ijkShift(KDIR)) + &
jVal*(j+gamAppMpi%Grid%ijkShift(JDIR)) + &
iVal*(i+gamAppMpi%Grid%ijkShift(IDIR))
kVal*(k+gamCplMpi%Grid%ijkShift(KDIR)) + &
jVal*(j+gamCplMpi%Grid%ijkShift(JDIR)) + &
iVal*(i+gamCplMpi%Grid%ijkShift(IDIR))
write (checkMessage,'(A,I0,A,I0,A,I0,A,I0,A)') 'gamera inExyz wrong at (',i,',',j,',',k,',',l,')'
@assertEqual(checkVal, iiBC%inExyz(i,j,k,l), trim(checkMessage))
enddo
@@ -152,14 +107,14 @@ contains
enddo
! check inEijk values
do i=1,g2vCommMpi%PsiSh+1
do j=gamAppMpi%Grid%jsg,gamAppMpi%Grid%jeg+1
do k=gamAppMpi%Grid%ksg,gamAppMpi%Grid%keg+1
do i=1,PsiSh+1
do j=gamCplMpi%Grid%jsg,gamCplMpi%Grid%jeg+1
do k=gamCplMpi%Grid%ksg,gamCplMpi%Grid%keg+1
do l=1,NDIM
checkVal = lVal*l + &
kVal*(k+gamAppMpi%Grid%ijkShift(KDIR)) + &
jVal*(j+gamAppMpi%Grid%ijkShift(JDIR)) + &
iVal*(i+gamAppMpi%Grid%ijkShift(IDIR))
kVal*(k+gamCplMpi%Grid%ijkShift(KDIR)) + &
jVal*(j+gamCplMpi%Grid%ijkShift(JDIR)) + &
iVal*(i+gamCplMpi%Grid%ijkShift(IDIR))
write (checkMessage,'(A,I0,A,I0,A,I0,A,I0,A)') 'gamera inEijk wrong at (',i,',',j,',',k,',',l,')'
@assertEqual(checkVal, iiBC%inEijk(i,j,k,l), trim(checkMessage))
enddo
@@ -171,19 +126,19 @@ contains
END SELECT
else
! everyone has to call to receive the data from voltron
call recvShallowData(g2vCommMpi, gamAppMpi)
call recvShallowCplDataMpi(gamCplMpi)
endif
else
SELECT type(iiBC=>voltAppMpi%gAppLocal%Grid%externalBCs(INI)%p)
SELECT type(iiBC=>voltAppMpi%gApp%Grid%externalBCs(INI)%p)
TYPE IS (IonInnerBC_T)
! clear all cells
iiBC%inExyz(:,:,:,:) = 0
iiBC%inEijk(:,:,:,:) = 0
! set inExyz
do i=1,voltAppMpi%mix2mhd%PsiShells
do j=voltAppMpi%gAppLocal%Grid%jsg,voltAppMpi%gAppLocal%Grid%jeg
do k=voltAppMpi%gAppLocal%Grid%ksg,voltAppMpi%gAppLocal%Grid%keg
do i=1,PsiSh
do j=voltAppMpi%gApp%Grid%jsg,voltAppMpi%gApp%Grid%jeg
do k=voltAppMpi%gApp%Grid%ksg,voltAppMpi%gApp%Grid%keg
do l=1,NDIM
iiBC%inExyz(i,j,k,l) = lVal*l + &
iVal*i + &
@@ -195,9 +150,9 @@ contains
enddo
! set inEijk
do i=1,voltAppMpi%mix2mhd%PsiShells+1
do j=voltAppMpi%gAppLocal%Grid%jsg,voltAppMpi%gAppLocal%Grid%jeg+1
do k=voltAppMpi%gAppLocal%Grid%ksg,voltAppMpi%gAppLocal%Grid%keg+1
do i=1,PsiSh+1
do j=voltAppMpi%gApp%Grid%jsg,voltAppMpi%gApp%Grid%jeg+1
do k=voltAppMpi%gApp%Grid%ksg,voltAppMpi%gApp%Grid%keg+1
do l=1,NDIM
iiBC%inEijk(i,j,k,l) = lVal*l + &
iVal*i + &
@@ -208,15 +163,47 @@ contains
enddo
enddo
! send the data to gamera
call sendShallowData_mpi(voltAppMpi)
CLASS DEFAULT
@assertEqual(0,1,'No Remix BC on Voltron')
END SELECT
SELECT type(cpl=>voltAppMpi%gApp)
TYPE IS (gamCouplerMpi_volt_T)
! send the data to gamera
call sendShallowCplDataMpi(cpl)
CLASS DEFAULT
@assertTrue(.false., "Voltron Allocated non-mpi Gamera coupler for MPI Voltron Coupling Test. Failure")
ENDSELECT
endif
end subroutine testVolt2MhdShallowCopy
@test(npes=[9])
subroutine testVolt2MhdTimeCopy(this)
class (MpiTestMethod), intent(inout) :: this
real(rp) :: checkVal
character(len=strLen) :: checkMessage
checkVal = 123456.0_rp ! random value for testing with
if(allocated(gamCplMpi)) then
call recvCplTimeMpi(gamCplMpi)
@assertEqual(checkVal/gamCplMpi%Model%Units%gT0, gamCplMpi%DeepT, "Time value transmitted from Voltron to Gamera was wrong")
else
SELECT type(cpl=>voltAppMpi%gApp)
TYPE IS (gamCouplerMpi_volt_T)
! send the data to gamera
call sendCplTimeMpi(cpl, checkVal)
CLASS DEFAULT
@assertTrue(.false., "Voltron Allocated non-mpi Gamera coupler for MPI Voltron Coupling Test. Failure")
ENDSELECT
endif
end subroutine testVolt2MhdTimeCopy
@test(npes=[2,5,9])
subroutine VMPIcorotationTest(this)
class (MpiTestMethod), intent(inout) :: this
@@ -231,9 +218,9 @@ contains
RIn = 1.0
Psi0 = 10.0
if(isGamera) then
if(gamAppMpi%Grid%hasLowerBC(IDIR)) then
SELECT type(iiBC=>gamAppMpi%Grid%externalBCs(INI)%p)
if(allocated(gamCplMpi)) then
if(gamCplMpi%Grid%hasLowerBC(IDIR)) then
SELECT type(iiBC=>gamCplMpi%Grid%externalBCs(INI)%p)
TYPE IS (IonInnerBC_T)
! clear all cells
@@ -241,23 +228,23 @@ contains
iiBC%inExyz(:,:,:,:) = 0
! receive the data from voltron
call recvShallowData(g2vCommMpi, gamAppMpi)
call recvShallowCplDataMpi(gamCplMpi)
! verify that the gamera field (iiBC%inEijk, iiBC%inExyz, or both) have the expected values here
! inExyz should be pointed exactly radially at all locations
deltaSum = 0.0_rp
!Only loop over active cells
do k=gamAppMpi%Grid%ks,gamAppMpi%Grid%ke
do j=gamAppMpi%Grid%js,gamAppMpi%Grid%je
do k=gamCplMpi%Grid%ks,gamCplMpi%Grid%ke
do j=gamCplMpi%Grid%js,gamCplMpi%Grid%je
!Map to active ip,jp,kp (i=Grid%is => ip=Grid%is)
call lfmIJKcc(gamAppMpi%Model,gamAppMpi%Grid,gamAppMpi%Grid%is,j,k,ip,jp,kp)
call lfmIJKcc(gamCplMpi%Model,gamCplMpi%Grid,gamCplMpi%Grid%is,j,k,ip,jp,kp)
do n=1,gamAppMpi%Model%Ng
ig = gamAppMpi%Grid%is-n
np = gamAppMpi%Model%nG-n+1
do n=1,gamCplMpi%Model%Ng
ig = gamCplMpi%Grid%is-n
np = gamCplMpi%Model%nG-n+1
call cellCenter(gamAppMpi%Grid, ig,j,k,xc,yc,zc)
call cellCenter(gamCplMpi%Grid, ig,j,k,xc,yc,zc)
rHatP = normVec([xc,yc,zc])
eHat = normVec(iiBC%inExyz(np,jp,kp,:))
@@ -270,25 +257,25 @@ contains
end do
! remix doesn't go below a certain lat, causing discontinuity. high error
errorThresh = 2*(1+gamAppMpi%Grid%ke-gamAppMpi%Grid%ks)*(1+gamAppMpi%Grid%je-gamAppMpi%Grid%js)*gamAppMpi%Model%Ng
errorThresh = 2*(1+gamCplMpi%Grid%ke-gamCplMpi%Grid%ks)*(1+gamCplMpi%Grid%je-gamCplMpi%Grid%js)*gamCplMpi%Model%Ng
@assertLessThanOrEqual(deltaSum, errorThresh, 'Magnetic field from remix was not pointing radially')
!Now test Eijk fields
deltaSum = 0.0
!Only loop over active cells
do k=gamAppMpi%Grid%ks,gamAppMpi%Grid%ke
do j=gamAppMpi%Grid%js,gamAppMpi%Grid%je
do k=gamCplMpi%Grid%ks,gamCplMpi%Grid%ke
do j=gamCplMpi%Grid%js,gamCplMpi%Grid%je
!Map to active ip,jp,kp (i=Grid%is => ip=Grid%is)
call lfmIJKcc(gamAppMpi%Model,gamAppMpi%Grid,gamAppMpi%Grid%is,j,k,ip,jp,kp)
do n=1,gamAppMpi%Model%Ng
ig = gamAppMpi%Grid%is-n
np = gamAppMpi%Model%nG-n+1
call lfmIJKcc(gamCplMpi%Model,gamCplMpi%Grid,gamCplMpi%Grid%is,j,k,ip,jp,kp)
do n=1,gamCplMpi%Model%Ng
ig = gamCplMpi%Grid%is-n
np = gamCplMpi%Model%nG-n+1
!Convert Eijk (edges) to cc-Eijk
ccEijk(IDIR) = 0.25*(iiBC%inEijk(np,j,k,IDIR)+iiBC%inEijk(np,j,k+1,IDIR)+iiBC%inEijk(np,j+1,k,IDIR)+iiBC%inEijk(np,j+1,k+1,IDIR))
ccEijk(JDIR) = 0.25*(iiBC%inEijk(np,j,k,JDIR)+iiBC%inEijk(np,j,k+1,JDIR)+iiBC%inEijk(np+1,j,k,JDIR)+iiBC%inEijk(np+1,j,k+1,JDIR))
ccEijk(KDIR) = 0.25*(iiBC%inEijk(np,j,k,KDIR)+iiBC%inEijk(np+1,j,k,KDIR)+iiBC%inEijk(np,j+1,k,KDIR)+iiBC%inEijk(np+1,j+1,k,KDIR))
!Now convert cc-Eijk to Exyz
Exyz = ccEijk2Exyz(gamAppMpi%Model,gamAppMpi%Grid,ccEijk,ig,j,k)
Exyz = ccEijk2Exyz(gamCplMpi%Model,gamCplMpi%Grid,ccEijk,ig,j,k)
!Exyz above is approximation to inExyz, ie testing whether or not Eijk and Exyz are consistent
deltaSum = deltaSum + norm2(Exyz-iiBC%inExyz(np,jp,kp,:))
enddo
@@ -296,7 +283,7 @@ contains
enddo
! remix doesn't go below a certain lat, causing discontinuity. high error
errorThresh = 2.5e-2*(1+gamAppMpi%Grid%ke-gamAppMpi%Grid%ks)*(1+gamAppMpi%Grid%je-gamAppMpi%Grid%js)*gamAppMpi%Model%Ng
errorThresh = 2.5e-2*(1+gamCplMpi%Grid%ke-gamCplMpi%Grid%ks)*(1+gamCplMpi%Grid%je-gamCplMpi%Grid%js)*gamCplMpi%Model%Ng
@assertLessThanOrEqual(deltaSum, errorThresh, 'inEijk values did not match inExyz values')
CLASS DEFAULT
@@ -304,7 +291,7 @@ contains
END SELECT
else
! everyone has to call to receive the data from voltron
call recvShallowData(g2vCommMpi, gamAppMpi)
call recvShallowCplDataMpi(gamCplMpi)
endif
else
associate(rApp=>voltAppMpi%remixApp)
@@ -320,15 +307,20 @@ contains
enddo
end associate
!Can add a test of the interpolation to Gamera shells here?
call mapRemixToGamera(voltAppMpi%mix2mhd, voltAppMpi%remixApp)
SELECT type(cpl=>voltAppMpi%gApp)
TYPE IS (gamCouplerMpi_volt_T)
!Can add a test of the interpolation to Gamera shells here?
call mapRemixToGamera(cpl, voltAppMpi%remixApp)
call convertRemixToGamera(voltAppMpi%mix2mhd, voltAppMpi%remixApp, voltAppMpi%gAppLocal, .false.) !Don't add corotation potential
call convertRemixToGamera(cpl, voltAppMpi%remixApp, .false.) !Don't add corotation potential
! send the data to gamera
call sendShallowData_mpi(voltAppMpi)
! send the data to gamera
call sendShallowCplDataMpi(cpl)
CLASS DEFAULT
@assertTrue(.false., "Voltron Allocated non-mpi Gamera coupler for MPI Voltron Coupling Test. Failure")
ENDSELECT
SELECT type(iiBC=>voltAppMpi%gAppLocal%Grid%externalBCs(INI)%p)
SELECT type(iiBC=>voltAppMpi%gApp%Grid%externalBCs(INI)%p)
TYPE IS (IonInnerBC_T)
!call CheckAndKill('voltrontest.h5')
@@ -343,17 +335,17 @@ contains
! check that inExyz is pointed exactly radially at all locations
deltaSum = 0.0_rp
!Only loop over active cells
do k=voltAppMpi%gAppLocal%Grid%ks,voltAppMpi%gAppLocal%Grid%ke
do j=voltAppMpi%gAppLocal%Grid%js,voltAppMpi%gAppLocal%Grid%je
do k=voltAppMpi%gApp%Grid%ks,voltAppMpi%gApp%Grid%ke
do j=voltAppMpi%gApp%Grid%js,voltAppMpi%gApp%Grid%je
!Map to active ip,jp,kp (i=Grid%is => ip=Grid%is)
call lfmIJKcc(voltAppMpi%gAppLocal%Model,voltAppMpi%gAppLocal%Grid,voltAppMpi%gAppLocal%Grid%is,j,k,ip,jp,kp)
call lfmIJKcc(voltAppMpi%gApp%Model,voltAppMpi%gApp%Grid,voltAppMpi%gApp%Grid%is,j,k,ip,jp,kp)
do n=1,voltAppMpi%gAppLocal%Model%Ng
ig = voltAppMpi%gAppLocal%Grid%is-n
np = voltAppMpi%gAppLocal%Model%nG-n+1
do n=1,voltAppMpi%gApp%Model%Ng
ig = voltAppMpi%gApp%Grid%is-n
np = voltAppMpi%gApp%Model%nG-n+1
call cellCenter(voltAppMpi%gAppLocal%Grid, ig,j,k,xc,yc,zc)
call cellCenter(voltAppMpi%gApp%Grid, ig,j,k,xc,yc,zc)
rHatP = normVec([xc,yc,zc])
eHat = normVec(iiBC%inExyz(np,jp,kp,:))
@@ -366,25 +358,25 @@ contains
end do
! remix doesn't go below a certain lat, causing discontinuity. high error
errorThresh = 2*(1+voltAppMpi%gAppLocal%Grid%ke-voltAppMpi%gAppLocal%Grid%ks)*(1+voltAppMpi%gAppLocal%Grid%je-voltAppMpi%gAppLocal%Grid%js)*voltAppMpi%gAppLocal%Model%Ng
errorThresh = 2*(1+voltAppMpi%gApp%Grid%ke-voltAppMpi%gApp%Grid%ks)*(1+voltAppMpi%gApp%Grid%je-voltAppMpi%gApp%Grid%js)*voltAppMpi%gApp%Model%Ng
@assertLessThanOrEqual(deltaSum, errorThresh, 'VOLTRON Magnetic field from remix was not pointing radially')
!Now test Eijk fields
deltaSum = 0.0
!Only loop over active cells
do k=voltAppMpi%gAppLocal%Grid%ks,voltAppMpi%gAppLocal%Grid%ke
do j=voltAppMpi%gAppLocal%Grid%js,voltAppMpi%gAppLocal%Grid%je
do k=voltAppMpi%gApp%Grid%ks,voltAppMpi%gApp%Grid%ke
do j=voltAppMpi%gApp%Grid%js,voltAppMpi%gApp%Grid%je
!Map to active ip,jp,kp (i=Grid%is => ip=Grid%is)
call lfmIJKcc(voltAppMpi%gAppLocal%Model,voltAppMpi%gAppLocal%Grid,voltAppMpi%gAppLocal%Grid%is,j,k,ip,jp,kp)
do n=1,voltAppMpi%gAppLocal%Model%Ng
ig = voltAppMpi%gAppLocal%Grid%is-n
np = voltAppMpi%gAppLocal%Model%nG-n+1
call lfmIJKcc(voltAppMpi%gApp%Model,voltAppMpi%gApp%Grid,voltAppMpi%gApp%Grid%is,j,k,ip,jp,kp)
do n=1,voltAppMpi%gApp%Model%Ng
ig = voltAppMpi%gApp%Grid%is-n
np = voltAppMpi%gApp%Model%nG-n+1
!Convert Eijk (edges) to cc-Eijk
ccEijk(IDIR) = 0.25*(iiBC%inEijk(np,j,k,IDIR)+iiBC%inEijk(np,j,k+1,IDIR)+iiBC%inEijk(np,j+1,k,IDIR)+iiBC%inEijk(np,j+1,k+1,IDIR))
ccEijk(JDIR) = 0.25*(iiBC%inEijk(np,j,k,JDIR)+iiBC%inEijk(np,j,k+1,JDIR)+iiBC%inEijk(np+1,j,k,JDIR)+iiBC%inEijk(np+1,j,k+1,JDIR))
ccEijk(KDIR) = 0.25*(iiBC%inEijk(np,j,k,KDIR)+iiBC%inEijk(np+1,j,k,KDIR)+iiBC%inEijk(np,j+1,k,KDIR)+iiBC%inEijk(np+1,j+1,k,KDIR))
!Now convert cc-Eijk to Exyz
Exyz = ccEijk2Exyz(voltAppMpi%gAppLocal%Model,voltAppMpi%gAppLocal%Grid,ccEijk,ig,j,k)
Exyz = ccEijk2Exyz(voltAppMpi%gApp%Model,voltAppMpi%gApp%Grid,ccEijk,ig,j,k)
!Exyz above is approximation to inExyz, ie testing whether or not Eijk and Exyz are consistent
deltaSum = deltaSum + norm2(Exyz-iiBC%inExyz(np,jp,kp,:))
enddo
@@ -392,7 +384,7 @@ contains
enddo
! remix doesn't go below a certain lat, causing discontinuity. high error
errorThresh = 2.5e-2*(1+voltAppMpi%gAppLocal%Grid%ke-voltAppMpi%gAppLocal%Grid%ks)*(1+voltAppMpi%gAppLocal%Grid%je-voltAppMpi%gAppLocal%Grid%js)*voltAppMpi%gAppLocal%Model%Ng
errorThresh = 2.5e-2*(1+voltAppMpi%gApp%Grid%ke-voltAppMpi%gApp%Grid%ks)*(1+voltAppMpi%gApp%Grid%je-voltAppMpi%gApp%Grid%js)*voltAppMpi%gApp%Model%Ng
@assertLessThanOrEqual(deltaSum, errorThresh, 'VOLTRON inEijk values did not match inExyz values')
CLASS DEFAULT
@assertEqual(0,1,'No Remix BC on Voltron')
@@ -407,34 +399,24 @@ contains
real(rp) :: eijkSum, exyzSum
if(isGamera) then
if(allocated(gamCplMpi)) then
if(gamAppMpi%Grid%hasLowerBC(IDIR)) then
SELECT type(iiBC=>gamAppMpi%Grid%externalBCs(INI)%p)
if(gamCplMpi%Grid%hasLowerBC(IDIR)) then
SELECT type(iiBC=>gamCplMpi%Grid%externalBCs(INI)%p)
TYPE IS (IonInnerBC_T)
! confirm cells are non-zero now
eijkSum = sum(abs(iiBC%inEijk))
exyzSum = sum(abs(iiBC%inExyz))
@assertGreaterThan(eijkSum, 0.0_rp, 'inEijk is all zeroes at start')
@assertGreaterThan(exyzSum, 0.0_rp, 'inExyz is all zeroes at start')
!@assertGreaterThan(eijkSum, 0.0_rp, 'inEijk is all zeroes at start')
!@assertGreaterThan(exyzSum, 0.0_rp, 'inExyz is all zeroes at start')
END SELECT
endif
do while (g2vCommMpi%time < 30.0)
call stepGamera_mpi(gamAppMpi)
call localStepVoltronTime(g2vCommMpi, gamAppMpi)
if( (g2vCommMpi%time >= g2vCommMpi%DeepT) .or. &
(g2vCommMpi%time >= 30.0)) then
call performStepVoltron(g2vCommMpi,gamAppMpi)
if ( g2vCommMpi%time >= g2vCommMpi%DeepT) then
call performDeepUpdate(g2vCommMpi, gamAppMpi)
endif
endif
end do
call gamCplMpi%AdvanceModel(30.0/gamCplMpi%Model%Units%gT0 - gamCplMpi%Model%t)
if(gamAppMpi%Grid%hasLowerBC(IDIR)) then
SELECT type(iiBC=>gamAppMpi%Grid%externalBCs(INI)%p)
if(gamCplMpi%Grid%hasLowerBC(IDIR)) then
SELECT type(iiBC=>gamCplMpi%Grid%externalBCs(INI)%p)
TYPE IS (IonInnerBC_T)
! confirm cells have changed
@@ -444,17 +426,7 @@ contains
endif
else
do while (voltAppMpi%time < 30.0)
if(gameraStepReady(voltAppMpi)) then
call stepVoltron_mpi(voltAppMpi)
write (*,'(a,f8.3)') ' Time = ',voltAppMpi%time
if (voltAppMpi%time >= voltAppMpi%DeepT) then
call DeepUpdate_mpi(voltAppMpi, voltAppMpi%time)
endif
elseif(deepInProgress(voltAppMpi)) then
call doDeepBlock(voltAppMpi)
else
call waitForGameraStep(voltAppMpi)
endif
call stepVoltron_mpi(voltAppMpi, 30.0_rp - voltAppMpi%time)
end do
endif

167
tests/voltron_mpi/testvmpideep.pf
View File

@@ -1,17 +1,14 @@
module testVMpiDeep
use testHelperMpi
use gamapp_mpi
use voltapp_mpi
use gam2voltcomm_mpi
use gamCouple_mpi_G2V
use uservoltic
use ioH5
implicit none
logical :: isGamera = .false.
type(gamAppMpi_T), allocatable :: gamAppMpi
type(gamCouplerMpi_gam_T), allocatable :: gamCplMpi
type(voltAppMpi_T), allocatable :: voltAppMpi
type(gam2voltCommMpi_T), allocatable :: g2vCommMpi
contains
@@ -22,30 +19,33 @@ contains
integer :: ierror
type(MPI_Comm) :: gamComm, voltComm
type(XML_Input_T) :: xmlInp
call setMpiReal()
write(caseFile,'(A,I0,A)') 'cmiD_deep_', this%getNumProcesses()-1, '.xml'
if(this%getProcessRank() < (this%getNumProcesses()-1)) then
isGamera = .true.
allocate(gamAppMpi)
allocate(g2vCommMpi)
allocate(gamCplMpi)
! make gamera-only mpi communicator
call MPI_Comm_Split(getMpiF08Communicator(this), 0, this%getProcessRank(), gamComm, ierror)
call MPI_Comm_Split(getMpiF08Communicator(this), gamId, this%getProcessRank(), gamCplMpi%gOptionsMpi%gamComm, ierror)
call initGamera_mpi(gamAppMpi, initUser, gamComm, caseFile, .false.)
call initGam2Volt(g2vCommMpi, gamAppMpi, getMpiF08Communicator(this), caseFile)
gamCplMpi%gOptionsCplMpiG%couplingPoolComm = getMpiF08Communicator(this)
gamCplMpi%gOptions%userInitFunc => initUser
gamCplMpi%gOptionsMpi%doIO = .false.
xmlInp = New_XML_Input(trim(caseFile),'Kaiju',.true.)
call gamCplMpi%InitModel(xmlInp)
else
isGamera = .false.
allocate(voltAppMpi)
! make gamera-only mpi communicator
call MPI_Comm_Split(getMpiF08Communicator(this), 1, this%getProcessRank(), voltComm, ierror)
call MPI_Comm_Split(getMpiF08Communicator(this), voltId, this%getProcessRank(), voltComm, ierror)
call initVoltron_mpi(voltAppMpi, initUser, voltComm, getMpiF08Communicator(this), caseFile)
voltAppMpi%vOptions%gamUserInitFunc => initUser
allocate(voltAppMpi%vOptionsMpi%couplingPoolComm)
voltAppMpi%vOptionsMpi%couplingPoolComm = getMpiF08Communicator(this)
call initVoltron_mpi(voltAppMpi, trim(caseFile))
endif
end subroutine setup
@@ -58,11 +58,7 @@ contains
call endVoltronWaits(voltAppMpi)
deallocate(voltAppMpi)
endif
if(allocated(g2vCommMpi)) then
call endGam2VoltWaits(g2vCommMpi, gamAppMpi)
deallocate(g2vCommMpi)
endif
if(allocated(gamAppMpi)) deallocate(gamAppMpi)
if(allocated(gamCplMpi)) deallocate(gamCplMpi)
end subroutine teardown
@@ -82,23 +78,23 @@ contains
lVal = 8000
mVal = 160000
if(isGamera) then
if(allocated(gamCplMpi)) then
! clear all cells
gamAppMpi%State%Gas(:,:,:,:,:) = 0
gamAppMpi%State%Bxyz(:,:,:,:) = 0
gamCplMpi%State%Gas(:,:,:,:,:) = 0
gamCplMpi%State%Bxyz(:,:,:,:) = 0
! set values for gas
do i=gamAppMpi%Grid%is,gamAppMpi%Grid%ie
do j=gamAppMpi%Grid%js,gamAppMpi%Grid%je
do k=gamAppMpi%Grid%ks,gamAppMpi%Grid%ke
do i=gamCplMpi%Grid%is,gamCplMpi%Grid%ie
do j=gamCplMpi%Grid%js,gamCplMpi%Grid%je
do k=gamCplMpi%Grid%ks,gamCplMpi%Grid%ke
do l=1,NVAR
do m=0,gamAppMpi%Model%nSpc
gamAppMpi%State%Gas(i,j,k,l,m) = &
do m=0,gamCplMpi%Model%nSpc
gamCplMpi%State%Gas(i,j,k,l,m) = &
mVal*m + &
lVal*l + &
kVal*(k+gamAppMpi%Grid%ijkShift(KDIR)) + &
jVal*(j+gamAppMpi%Grid%ijkShift(JDIR)) + &
iVal*(i+gamAppMpi%Grid%ijkShift(IDIR))
kVal*(k+gamCplMpi%Grid%ijkShift(KDIR)) + &
jVal*(j+gamCplMpi%Grid%ijkShift(JDIR)) + &
iVal*(i+gamCplMpi%Grid%ijkShift(IDIR))
enddo
enddo
enddo
@@ -106,43 +102,48 @@ contains
enddo
! set values for bxyz
do i=gamAppMpi%Grid%is,gamAppMpi%Grid%ie
do j=gamAppMpi%Grid%js,gamAppMpi%Grid%je
do k=gamAppMpi%Grid%ks,gamAppMpi%Grid%ke
do i=gamCplMpi%Grid%is,gamCplMpi%Grid%ie
do j=gamCplMpi%Grid%js,gamCplMpi%Grid%je
do k=gamCplMpi%Grid%ks,gamCplMpi%Grid%ke
do l=1,NDIM
gamAppMpi%State%Bxyz(i,j,k,l) = &
gamCplMpi%State%Bxyz(i,j,k,l) = &
lVal*l + &
kVal*(k+gamAppMpi%Grid%ijkShift(KDIR)) + &
jVal*(j+gamAppMpi%Grid%ijkShift(JDIR)) + &
iVal*(i+gamAppMpi%Grid%ijkShift(IDIR))
kVal*(k+gamCplMpi%Grid%ijkShift(KDIR)) + &
jVal*(j+gamCplMpi%Grid%ijkShift(JDIR)) + &
iVal*(i+gamCplMpi%Grid%ijkShift(IDIR))
enddo
enddo
enddo
enddo
! send the data to voltron
call sendDeepData(g2vCommMpi, gamAppMpi)
call sendVoltronCplDataMpi(gamCplMpi)
else
! clear all cells
voltAppMpi%gAppLocal%State%Gas(:,:,:,:,:) = 0
voltAppMpi%gAppLocal%State%Bxyz(:,:,:,:) = 0
voltAppMpi%gApp%State%Gas(:,:,:,:,:) = 0
voltAppMpi%gApp%State%Bxyz(:,:,:,:) = 0
! receive the data from gamera
call recvDeepData_mpi(voltAppMpi)
SELECT type(cpl=>voltAppMpi%gApp)
TYPE IS (gamCouplerMpi_volt_T)
! receive the data from gamera
call recvGameraCplDataMpi(cpl)
CLASS DEFAULT
@assertTrue(.false., "Voltron Allocated non-mpi Gamera coupler for MPI Voltron Coupling Test. Failure")
ENDSELECT
! check gas values
do i=voltAppMpi%gAppLocal%Grid%is,voltAppMpi%gAppLocal%Grid%ie
do j=voltAppMpi%gAppLocal%Grid%js,voltAppMpi%gAppLocal%Grid%je
do k=voltAppMpi%gAppLocal%Grid%ks,voltAppMpi%gAppLocal%Grid%ke
do i=voltAppMpi%gApp%Grid%is,voltAppMpi%gApp%Grid%ie
do j=voltAppMpi%gApp%Grid%js,voltAppMpi%gApp%Grid%je
do k=voltAppMpi%gApp%Grid%ks,voltAppMpi%gApp%Grid%ke
do l=1,NVAR
do m=0,voltAppMpi%gAppLocal%Model%nSpc
do m=0,voltAppMpi%gApp%Model%nSpc
checkVal = mVal*m + &
lVal*l + &
iVal*i + &
jVal*j + &
kVal*k
write (checkMessage,'(A,I0,A,I0,A,I0,A,I0,A,I0,A)') 'voltron gas wrong at (',i,',',j,',',k,',',l,',',m,')'
@assertEqual(checkVal,voltAppMpi%gAppLocal%State%Gas(i,j,k,l,m), trim(checkMessage))
@assertEqual(checkVal,voltAppMpi%gApp%State%Gas(i,j,k,l,m), trim(checkMessage))
enddo
enddo
enddo
@@ -150,16 +151,16 @@ contains
enddo
! check bxyz values
do i=voltAppMpi%gAppLocal%Grid%is,voltAppMpi%gAppLocal%Grid%ie
do j=voltAppMpi%gAppLocal%Grid%js,voltAppMpi%gAppLocal%Grid%je
do k=voltAppMpi%gAppLocal%Grid%ks,voltAppMpi%gAppLocal%Grid%ke
do i=voltAppMpi%gApp%Grid%is,voltAppMpi%gApp%Grid%ie
do j=voltAppMpi%gApp%Grid%js,voltAppMpi%gApp%Grid%je
do k=voltAppMpi%gApp%Grid%ks,voltAppMpi%gApp%Grid%ke
do l=1,NDIM
checkVal = lVal*l + &
iVal*i + &
jVal*j + &
kVal*k
write (checkMessage,'(A,I0,A,I0,A,I0,A,I0,A)') 'voltron bxyz wrong at (',i,',',j,',',k,',',l,')'
@assertEqual(checkVal, voltAppMpi%gAppLocal%State%Bxyz(i,j,k,l), trim(checkMessage))
@assertEqual(checkVal, voltAppMpi%gApp%State%Bxyz(i,j,k,l), trim(checkMessage))
enddo
enddo
enddo
@@ -185,26 +186,26 @@ contains
lVal = 8000
mVal = 160000
if(isGamera) then
if(allocated(gamCplMpi)) then
! clear all cells
gamAppMpi%Grid%Gas0(:,:,:,:,:) = 0
gamCplMpi%Grid%Gas0(:,:,:,:,:) = 0
! receive the data from voltron
call recvDeepData(g2vCommMpi, gamAppMpi)
call recvDeepCplDataMpi(gamCplMpi)
! check gas0 values
do i=gamAppMpi%Grid%isg,gamAppMpi%Grid%ieg
do j=gamAppMpi%Grid%jsg,gamAppMpi%Grid%jeg
do k=gamAppMpi%Grid%ksg,gamAppMpi%Grid%keg
do i=gamCplMpi%Grid%isg,gamCplMpi%Grid%ieg
do j=gamCplMpi%Grid%jsg,gamCplMpi%Grid%jeg
do k=gamCplMpi%Grid%ksg,gamCplMpi%Grid%keg
do l=1,NVAR
do m=0,gamAppMpi%Model%nSpc
do m=0,gamCplMpi%Model%nSpc
checkVal = mVal*m + &
lVal*l + &
kVal*(k+gamAppMpi%Grid%ijkShift(KDIR)) + &
jVal*(j+gamAppMpi%Grid%ijkShift(JDIR)) + &
iVal*(i+gamAppMpi%Grid%ijkShift(IDIR))
kVal*(k+gamCplMpi%Grid%ijkShift(KDIR)) + &
jVal*(j+gamCplMpi%Grid%ijkShift(JDIR)) + &
iVal*(i+gamCplMpi%Grid%ijkShift(IDIR))
write (checkMessage,'(A,I0,A,I0,A,I0,A,I0,A,I0,A)') 'gamera gas0 wrong at (',i,',',j,',',k,',',l,',',m,')'
@assertEqual(checkVal,gamAppMpi%Grid%Gas0(i,j,k,l,m), trim(checkMessage))
@assertEqual(checkVal,gamCplMpi%Grid%Gas0(i,j,k,l,m), trim(checkMessage))
enddo
enddo
enddo
@@ -212,15 +213,15 @@ contains
enddo
else
! clear all cells
voltAppMpi%gAppLocal%Grid%Gas0(:,:,:,:,:) = 0
voltAppMpi%gApp%Grid%Gas0(:,:,:,:,:) = 0
! set gas0 values
do i=voltAppMpi%gAppLocal%Grid%isg,voltAppMpi%gAppLocal%Grid%ieg
do j=voltAppMpi%gAppLocal%Grid%jsg,voltAppMpi%gAppLocal%Grid%jeg
do k=voltAppMpi%gAppLocal%Grid%ksg,voltAppMpi%gAppLocal%Grid%keg
do i=voltAppMpi%gApp%Grid%isg,voltAppMpi%gApp%Grid%ieg
do j=voltAppMpi%gApp%Grid%jsg,voltAppMpi%gApp%Grid%jeg
do k=voltAppMpi%gApp%Grid%ksg,voltAppMpi%gApp%Grid%keg
do l=1,NVAR
do m=0,voltAppMpi%gAppLocal%Model%nSpc
voltAppMpi%gAppLocal%Grid%Gas0(i,j,k,l,m) = mVal*m + &
do m=0,voltAppMpi%gApp%Model%nSpc
voltAppMpi%gApp%Grid%Gas0(i,j,k,l,m) = mVal*m + &
lVal*l + &
iVal*i + &
jVal*j + &
@@ -231,8 +232,13 @@ contains
enddo
enddo
! send the data to gamera
call sendDeepData_mpi(voltAppMpi)
SELECT type(cpl=>voltAppMpi%gApp)
TYPE IS (gamCouplerMpi_volt_T)
! send the data to gamera
call sendDeepCplDataMpi(cpl)
CLASS DEFAULT
@assertTrue(.false., "Voltron Allocated non-mpi Gamera coupler for MPI Voltron Coupling Test. Failure")
ENDSELECT
endif
end subroutine testVolt2MhdDeepCopy
@@ -245,19 +251,26 @@ contains
procedure(VectorField_T), pointer :: Axyz
real(rp) testValue
if(isGamera) then
if(allocated(gamCplMpi)) then
! create a dipole field in Gamera. This code is copied from prob.F90
Axyz => VP_Dipole
call VectorPot2Flux(gamAppMpi%Model,gamAppMpi%Grid,gamAppMpi%State,Axyz)
call VectorPot2Flux(gamCplMpi%Model,gamCplMpi%Grid,gamCplMpi%State,Axyz)
call bFlux2Fld(gamAppMpi%Model, gamAppMpi%Grid, gamAppMpi%State%magFlux, gamAppMpi%State%Bxyz)
call bFlux2Fld(gamCplMpi%Model, gamCplMpi%Grid, gamCplMpi%State%magFlux, gamCplMpi%State%Bxyz)
call sendDeepData(g2vCommMpi, gamAppMpi)
! send the data to voltron
call sendVoltronCplDataMpi(gamCplMpi)
else
call recvDeepData_mpi(voltAppMpi)
SELECT type(cpl=>voltAppMpi%gApp)
TYPE IS (gamCouplerMpi_volt_T)
! receive the data from gamera
call recvGameraCplDataMpi(cpl)
CLASS DEFAULT
@assertTrue(.false., "Voltron Allocated non-mpi Gamera coupler for MPI Voltron Coupling Test. Failure")
ENDSELECT
call convertGameraToRemix(voltAppMpi%mhd2mix, voltAppMpi%gAppLocal, voltAppMpi%remixApp)
call convertGameraToRemix(voltAppMpi%mhd2mix, voltAppMpi%gApp, voltAppMpi%remixApp)
call mapGameraToRemix(voltAppMpi%mhd2mix, voltAppMpi%remixApp)