From 9ff270ae9c0b9cb142199ac8558fe1a4e32e6af1 Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Tue, 26 Nov 2024 02:32:18 +0000 Subject: [PATCH 1/5] Automatically enable domain decomposition when nranks>1 The domaindecomposition%mpienabled attribute is set to true when nranks>1 . In mesh generation and loading, this enables domain decomposition. --- .gitignore | 4 + src/SELF_DomainDecomposition_t.f90 | 429 ++--- src/SELF_Mesh_1D.f90 | 314 ++-- src/SELF_Mesh_2D_t.f90 | 1349 ++++++++------- src/SELF_Mesh_3D_t.f90 | 1445 ++++++++--------- test/advection_diffusion_2d_rk3_mpi.f90 | 132 +- .../advection_diffusion_2d_rk3_pickup_mpi.f90 | 128 +- test/advection_diffusion_3d_rk3_mpi.f90 | 166 +- .../advection_diffusion_3d_rk3_pickup_mpi.f90 | 162 +- test/mappedscalarbrgradient_2d_linear_mpi.f90 | 228 +-- test/mappedscalarbrgradient_3d_linear_mpi.f90 | 246 +-- ...mappedvectordgdivergence_2d_linear_mpi.f90 | 168 +- ...gdivergence_2d_linear_sideexchange_mpi.f90 | 236 +-- ...ivergence_2d_linear_structuredmesh_mpi.f90 | 236 +-- ...mappedvectordgdivergence_3d_linear_mpi.f90 | 194 +-- ...gdivergence_3d_linear_sideexchange_mpi.f90 | 240 +-- ...ivergence_3d_linear_structuredmesh_mpi.f90 | 258 +-- 17 files changed, 2968 insertions(+), 2967 deletions(-) diff --git a/.gitignore b/.gitignore index 57ac21eed..53cdf57bb 100644 --- a/.gitignore +++ b/.gitignore @@ -48,3 +48,7 @@ results.json results.stats.csv results.csv results.sysinfo.txt +*.mp4 +*.out +*.err +ext-examples/ diff --git a/src/SELF_DomainDecomposition_t.f90 b/src/SELF_DomainDecomposition_t.f90 index 9ef1bfab4..9361edc91 100644 --- a/src/SELF_DomainDecomposition_t.f90 +++ b/src/SELF_DomainDecomposition_t.f90 @@ -26,223 +26,238 @@ module SELF_DomainDecomposition_t - use SELF_Constants - use SELF_Lagrange - use SELF_SupportRoutines - use mpi - use iso_c_binding + use SELF_Constants + use SELF_Lagrange + use SELF_SupportRoutines + use mpi + use iso_c_binding - implicit none + implicit none - type DomainDecomposition_t - logical :: mpiEnabled = .false. - logical :: initialized = .false. - integer :: mpiComm - integer :: mpiPrec - integer :: rankId - integer :: nRanks - integer :: nElem - integer :: maxMsg - integer :: msgCount - integer,pointer,dimension(:) :: elemToRank - integer,pointer,dimension(:) :: offSetElem - integer,allocatable :: requests(:) - integer,allocatable :: stats(:,:) + type DomainDecomposition_t + logical :: mpiEnabled = .false. + logical :: initialized = .false. + integer :: mpiComm + integer :: mpiPrec + integer :: rankId + integer :: nRanks + integer :: nElem + integer :: maxMsg + integer :: msgCount + integer, pointer, dimension(:) :: elemToRank + integer, pointer, dimension(:) :: offSetElem + integer, allocatable :: requests(:) + integer, allocatable :: stats(:, :) - contains + contains - procedure :: Init => Init_DomainDecomposition_t - procedure :: Free => Free_DomainDecomposition_t + procedure :: Init => Init_DomainDecomposition_t + procedure :: Free => Free_DomainDecomposition_t - procedure :: GenerateDecomposition => GenerateDecomposition_DomainDecomposition_t - procedure :: SetElemToRank => SetElemToRank_DomainDecomposition_t + procedure :: GenerateDecomposition => GenerateDecomposition_DomainDecomposition_t + procedure :: SetElemToRank => SetElemToRank_DomainDecomposition_t - procedure,public :: FinalizeMPIExchangeAsync + procedure, public :: FinalizeMPIExchangeAsync - endtype DomainDecomposition_t + end type DomainDecomposition_t contains - subroutine Init_DomainDecomposition_t(this,enableMPI) -#undef __FUNC__ -#define __FUNC__ "Init_DomainDecomposition_t" - implicit none - class(DomainDecomposition_t),intent(inout) :: this - logical,intent(in) :: enableMPI - ! Local - integer :: ierror - - this%mpiComm = 0 - this%mpiPrec = prec - this%rankId = 0 - this%nRanks = 1 - this%nElem = 0 - this%mpiEnabled = enableMPI - - if(enableMPI) then - this%mpiComm = MPI_COMM_WORLD - print*,__FILE__," : Initializing MPI" - call mpi_init(ierror) - call mpi_comm_rank(this%mpiComm,this%rankId,ierror) - call mpi_comm_size(this%mpiComm,this%nRanks,ierror) - print*,__FILE__," : Rank ",this%rankId+1,"/",this%nRanks," checking in." - else - print*,__FILE__," : MPI not initialized. No domain decomposition used." - endif - - if(prec == real32) then - this%mpiPrec = MPI_FLOAT - else - this%mpiPrec = MPI_DOUBLE - endif - - allocate(this%offsetElem(1:this%nRanks+1)) - - this%initialized = .true. - - this%initialized = .true. + subroutine Init_DomainDecomposition_t(this) + implicit none + class(DomainDecomposition_t), intent(inout) :: this + ! Local + integer :: ierror - endsubroutine Init_DomainDecomposition_t + this%mpiComm = 0 + this%mpiPrec = prec + this%rankId = 0 + this%nRanks = 1 + this%nElem = 0 + this%mpiEnabled = .false. - subroutine Free_DomainDecomposition_t(this) - implicit none - class(DomainDecomposition_t),intent(inout) :: this - ! Local - integer :: ierror - - if(associated(this%offSetElem)) then - deallocate(this%offSetElem) - endif - if(associated(this%elemToRank)) then - deallocate(this%elemToRank) - endif - - if(allocated(this%requests)) deallocate(this%requests) - if(allocated(this%stats)) deallocate(this%stats) - - if(this%mpiEnabled) then - print*,__FILE__," : Rank ",this%rankId+1,"/",this%nRanks," checking out." + !if(enableMPI) then + this%mpiComm = MPI_COMM_WORLD + print *, __FILE__, " : Initializing MPI" + call mpi_init(ierror) + call mpi_comm_rank(this%mpiComm, this%rankId, ierror) + call mpi_comm_size(this%mpiComm, this%nRanks, ierror) + print *, __FILE__, " : Rank ", this%rankId + 1, "/", this%nRanks, " checking in." + + if (this%nRanks > 1) then + this%mpiEnabled = .true. + else + print *, __FILE__, " : No domain decomposition used." + end if + !else + ! print*,__FILE__," : MPI not initialized. No domain decomposition used." + !endif + + if (prec == real32) then + this%mpiPrec = MPI_FLOAT + else + this%mpiPrec = MPI_DOUBLE + end if + + allocate (this%offsetElem(1:this%nRanks + 1)) + + this%initialized = .true. + + this%initialized = .true. + + end subroutine Init_DomainDecomposition_t + + subroutine Free_DomainDecomposition_t(this) + implicit none + class(DomainDecomposition_t), intent(inout) :: this + ! Local + integer :: ierror + + if (associated(this%offSetElem)) then + deallocate (this%offSetElem) + end if + if (associated(this%elemToRank)) then + deallocate (this%elemToRank) + end if + + if (allocated(this%requests)) deallocate (this%requests) + if (allocated(this%stats)) deallocate (this%stats) + + !if(this%mpiEnabled) then + print *, __FILE__, " : Rank ", this%rankId + 1, "/", this%nRanks, " checking out." call MPI_FINALIZE(ierror) - endif - - endsubroutine Free_DomainDecomposition_t - - subroutine GenerateDecomposition_DomainDecomposition_t(this,nGlobalElem,maxMsg) - implicit none - class(DomainDecomposition_t),intent(inout) :: this - integer,intent(in) :: nGlobalElem - integer,intent(in) :: maxMsg - - call this%setElemToRank(nGlobalElem) - if(allocated(this%requests)) deallocate(this%requests) - if(allocated(this%stats)) deallocate(this%stats) - - allocate(this%requests(1:maxMsg)) - allocate(this%stats(MPI_STATUS_SIZE,1:maxMsg)) - this%maxMsg = maxMsg - - print*,__FILE__//" : Rank ",this%rankId+1," : n_elements = ", & - this%offSetElem(this%rankId+2)-this%offSetElem(this%rankId+1) - - endsubroutine GenerateDecomposition_DomainDecomposition_t - - subroutine SetElemToRank_DomainDecomposition_t(this,nElem) - implicit none - class(DomainDecomposition_t),intent(inout) :: this - integer,intent(in) :: nElem - ! Local - integer :: iel - - this%nElem = nElem - - allocate(this%elemToRank(1:nelem)) - - call DomainDecomp(nElem, & - this%nRanks, & - this%offSetElem) - - do iel = 1,nElem - call ElemToRank(this%nRanks, & - this%offSetElem, & - iel, & - this%elemToRank(iel)) - enddo - - endsubroutine SetElemToRank_DomainDecomposition_t - - subroutine DomainDecomp(nElems,nDomains,offSetElem) - ! From https://www.hopr-project.org/externals/Meshformat.pdf, Algorithm 4 - implicit none - integer,intent(in) :: nElems - integer,intent(in) :: nDomains - integer,intent(out) :: offsetElem(0:nDomains) - ! Local - integer :: nLocalElems - integer :: remainElems - integer :: iDom - - nLocalElems = nElems/nDomains - remainElems = nElems-nLocalElems*nDomains - do iDom = 0,nDomains-1 - offSetElem(iDom) = iDom*nLocalElems+min(iDom,remainElems) - enddo - offSetElem(nDomains) = nElems - - endsubroutine DomainDecomp - - subroutine ElemToRank(nDomains,offsetElem,elemID,domain) - ! From https://www.hopr-project.org/externals/Meshformat.pdf, Algorithm 7 - ! "Find domain containing element index" - ! - implicit none - integer,intent(in) :: nDomains - integer,intent(in) :: offsetElem(0:nDomains) - integer,intent(in) :: elemID - integer,intent(out) :: domain - ! Local - integer :: maxSteps - integer :: low,up,mid - integer :: i - - domain = 0 - maxSteps = int(log10(real(nDomains))/log10(2.0))+1 - low = 0 - up = nDomains-1 - - if(offsetElem(low) < elemID .and. elemID <= offsetElem(low+1)) then - domain = low - elseif(offsetElem(up) < elemID .and. elemID <= offsetElem(up+1)) then - domain = up - else - do i = 1,maxSteps - mid = (up-low)/2+low - if(offsetElem(mid) < elemID .and. elemID <= offsetElem(mid+1)) then - domain = mid - return - elseif(elemID > offsetElem(mid+1)) then - low = mid+1 - else - up = mid - endif - enddo - endif - - endsubroutine ElemToRank - - subroutine FinalizeMPIExchangeAsync(mpiHandler) - class(DomainDecomposition_t),intent(inout) :: mpiHandler - ! Local - integer :: ierror - integer :: msgCount - - if(mpiHandler%mpiEnabled) then - msgCount = mpiHandler%msgCount - call MPI_WaitAll(msgCount, & - mpiHandler%requests(1:msgCount), & - mpiHandler%stats(1:MPI_STATUS_SIZE,1:msgCount), & - iError) - endif - - endsubroutine FinalizeMPIExchangeAsync - -endmodule SELF_DomainDecomposition_t + !endif + + end subroutine Free_DomainDecomposition_t + + ! subroutine LaunchedWithMPI_DomainDecomposition_t(this) + ! !! This subroutine uses typical environment variables to determine if the + ! !! program was launched with MPI. If so, the `mpiEnabled` flag is set to + ! !! true. + ! implicit none + ! class(DomainDecomposition_t),intent(inout) :: this + ! ! Local + ! integer :: var_status + + ! this%mpiEnabled = .false. + ! call get_environment_variable("OMPI_COMM_WORLD_SIZE",this%nRanks,status=var_status) + + subroutine GenerateDecomposition_DomainDecomposition_t(this, nGlobalElem, maxMsg) + implicit none + class(DomainDecomposition_t), intent(inout) :: this + integer, intent(in) :: nGlobalElem + integer, intent(in) :: maxMsg + + call this%setElemToRank(nGlobalElem) + if (allocated(this%requests)) deallocate (this%requests) + if (allocated(this%stats)) deallocate (this%stats) + + allocate (this%requests(1:maxMsg)) + allocate (this%stats(MPI_STATUS_SIZE, 1:maxMsg)) + this%maxMsg = maxMsg + + print *, __FILE__//" : Rank ", this%rankId + 1, " : n_elements = ", & + this%offSetElem(this%rankId + 2) - this%offSetElem(this%rankId + 1) + + end subroutine GenerateDecomposition_DomainDecomposition_t + + subroutine SetElemToRank_DomainDecomposition_t(this, nElem) + implicit none + class(DomainDecomposition_t), intent(inout) :: this + integer, intent(in) :: nElem + ! Local + integer :: iel + + this%nElem = nElem + + allocate (this%elemToRank(1:nelem)) + + call DomainDecomp(nElem, & + this%nRanks, & + this%offSetElem) + + do iel = 1, nElem + call ElemToRank(this%nRanks, & + this%offSetElem, & + iel, & + this%elemToRank(iel)) + end do + + end subroutine SetElemToRank_DomainDecomposition_t + + subroutine DomainDecomp(nElems, nDomains, offSetElem) + ! From https://www.hopr-project.org/externals/Meshformat.pdf, Algorithm 4 + implicit none + integer, intent(in) :: nElems + integer, intent(in) :: nDomains + integer, intent(out) :: offsetElem(0:nDomains) + ! Local + integer :: nLocalElems + integer :: remainElems + integer :: iDom + + nLocalElems = nElems/nDomains + remainElems = nElems - nLocalElems*nDomains + do iDom = 0, nDomains - 1 + offSetElem(iDom) = iDom*nLocalElems + min(iDom, remainElems) + end do + offSetElem(nDomains) = nElems + + end subroutine DomainDecomp + + subroutine ElemToRank(nDomains, offsetElem, elemID, domain) + ! From https://www.hopr-project.org/externals/Meshformat.pdf, Algorithm 7 + ! "Find domain containing element index" + ! + implicit none + integer, intent(in) :: nDomains + integer, intent(in) :: offsetElem(0:nDomains) + integer, intent(in) :: elemID + integer, intent(out) :: domain + ! Local + integer :: maxSteps + integer :: low, up, mid + integer :: i + + domain = 0 + maxSteps = int(log10(real(nDomains))/log10(2.0)) + 1 + low = 0 + up = nDomains - 1 + + if (offsetElem(low) < elemID .and. elemID <= offsetElem(low + 1)) then + domain = low + elseif (offsetElem(up) < elemID .and. elemID <= offsetElem(up + 1)) then + domain = up + else + do i = 1, maxSteps + mid = (up - low)/2 + low + if (offsetElem(mid) < elemID .and. elemID <= offsetElem(mid + 1)) then + domain = mid + return + elseif (elemID > offsetElem(mid + 1)) then + low = mid + 1 + else + up = mid + end if + end do + end if + + end subroutine ElemToRank + + subroutine FinalizeMPIExchangeAsync(mpiHandler) + class(DomainDecomposition_t), intent(inout) :: mpiHandler + ! Local + integer :: ierror + integer :: msgCount + + if (mpiHandler%mpiEnabled) then + msgCount = mpiHandler%msgCount + call MPI_WaitAll(msgCount, & + mpiHandler%requests(1:msgCount), & + mpiHandler%stats(1:MPI_STATUS_SIZE, 1:msgCount), & + iError) + end if + + end subroutine FinalizeMPIExchangeAsync + +end module SELF_DomainDecomposition_t diff --git a/src/SELF_Mesh_1D.f90 b/src/SELF_Mesh_1D.f90 index 6b41d893a..4a3c80d0c 100644 --- a/src/SELF_Mesh_1D.f90 +++ b/src/SELF_Mesh_1D.f90 @@ -26,186 +26,186 @@ module SELF_Mesh_1D - use SELF_Constants - use SELF_Lagrange - use SELF_Data - use SELF_Scalar_1D - use SELF_SupportRoutines - use SELF_HDF5 - use SELF_Mesh + use SELF_Constants + use SELF_Lagrange + use SELF_Data + use SELF_Scalar_1D + use SELF_SupportRoutines + use SELF_HDF5 + use SELF_Mesh - ! External Libs ! - use HDF5 + ! External Libs ! + use HDF5 - use iso_c_binding + use iso_c_binding - implicit none + implicit none - type,extends(SEMMesh) :: Mesh1D - integer,pointer,dimension(:,:) :: elemInfo - real(prec),pointer,dimension(:) :: nodeCoords - integer,pointer,dimension(:) :: globalNodeIDs - integer,pointer,dimension(:,:) :: BCType - character(LEN=255),allocatable :: BCNames(:) - integer,dimension(2) :: bcid = 0 ! Boundary conditions for the left and right endpoints + type, extends(SEMMesh) :: Mesh1D + integer, pointer, dimension(:, :) :: elemInfo + real(prec), pointer, dimension(:) :: nodeCoords + integer, pointer, dimension(:) :: globalNodeIDs + integer, pointer, dimension(:, :) :: BCType + character(LEN=255), allocatable :: BCNames(:) + integer, dimension(2) :: bcid = 0 ! Boundary conditions for the left and right endpoints - contains - procedure,public :: Init => Init_Mesh1D - procedure,public :: Free => Free_Mesh1D - generic,public :: StructuredMesh => UniformBlockMesh_Mesh1D - procedure,private :: UniformBlockMesh_Mesh1D - procedure,public :: ResetBoundaryConditionType => ResetBoundaryConditionType_Mesh1D + contains + procedure, public :: Init => Init_Mesh1D + procedure, public :: Free => Free_Mesh1D + generic, public :: StructuredMesh => UniformBlockMesh_Mesh1D + procedure, private :: UniformBlockMesh_Mesh1D + procedure, public :: ResetBoundaryConditionType => ResetBoundaryConditionType_Mesh1D - procedure,public :: Write_Mesh => Write_Mesh1D + procedure, public :: Write_Mesh => Write_Mesh1D - endtype Mesh1D + end type Mesh1D contains - subroutine Init_Mesh1D(this,nElem,nNodes,nBCs) - implicit none - class(Mesh1D),intent(out) :: this - integer,intent(in) :: nElem - integer,intent(in) :: nNodes - integer,intent(in) :: nBCs - - this%nGeo = 1 - this%nElem = nElem - this%nGlobalElem = nElem - this%nNodes = nNodes - this%nCornerNodes = nElem*2 - this%nUniqueNodes = 0 - this%nBCs = nBCs - this%bcid = 0 - - allocate(this%elemInfo(1:4,1:nElem)) - allocate(this%nodeCoords(1:nNodes)) - allocate(this%globalNodeIDs(1:nNodes)) - allocate(this%BCType(1:4,1:nBCs)) - - allocate(this%BCNames(1:nBCs)) - call this%decomp%Init(.false.) - - endsubroutine Init_Mesh1D - - subroutine Free_Mesh1D(this) - implicit none - class(Mesh1D),intent(inout) :: this - - this%nElem = 0 - this%nNodes = 0 - this%nCornerNodes = 0 - this%nUniqueNodes = 0 - this%nBCs = 0 - deallocate(this%elemInfo) - deallocate(this%nodeCoords) - deallocate(this%globalNodeIDs) - deallocate(this%BCType) - deallocate(this%BCNames) - call this%decomp%Free() - - endsubroutine Free_Mesh1D - - subroutine UniformBlockMesh_Mesh1D(this,nElem,x) - implicit none - class(Mesh1D),intent(out) :: this - integer,intent(in) :: nElem - real(prec),intent(in) :: x(1:2) - ! Local - integer :: iel,ngeo - integer :: nid,nNodes - integer :: i - real(prec) :: xU(1:nElem+1) - type(Lagrange),target :: linearInterp - type(Lagrange),target :: nGeoInterp - type(Scalar1D) :: xLinear - type(Scalar1D) :: xGeo - - ngeo = 1 - - nNodes = nElem*(nGeo+1) - call this%Init(nElem,nNodes,2) - this%quadrature = GAUSS_LOBATTO - - ! Set the hopr_nodeCoords - xU = UniformPoints(x(1),x(2),1,nElem+1) - - call linearInterp%Init(1,GAUSS_LOBATTO, & - nGeo,GAUSS_LOBATTO) - - call nGeoInterp%Init(nGeo,GAUSS_LOBATTO, & - nGeo,GAUSS_LOBATTO) - - ! Create a linear interpolant to interpolate to nGeo grid - call xLinear%Init(linearInterp,1,nElem) - call xGeo%Init(nGeoInterp,1,nElem) - - do iel = 1,nElem - xLinear%interior(1:2,iel,1) = xU(iel:iel+1) - enddo - - call xLinear%GridInterp(xGeo%interior) - - ! Set the element information - nid = 1 - do iel = 1,nElem - this%elemInfo(1,iel) = selfLineLinear ! Element Type - this%elemInfo(2,iel) = 1 ! Element Zone - this%elemInfo(3,iel) = nid ! Node Index Start - do i = 1,nGeo+1 - this%nodeCoords(nid) = xGeo%interior(i,iel,1) - nid = nid+1 - enddo - this%elemInfo(4,iel) = nid-1 ! Node Index End - enddo - - call xLinear%Free() - call xGeo%Free() - call linearInterp%Free() - call nGeoInterp%Free() - - endsubroutine UniformBlockMesh_Mesh1D - - subroutine ResetBoundaryConditionType_Mesh1D(this,leftbc,rightbc) + subroutine Init_Mesh1D(this, nElem, nNodes, nBCs) + implicit none + class(Mesh1D), intent(out) :: this + integer, intent(in) :: nElem + integer, intent(in) :: nNodes + integer, intent(in) :: nBCs + + this%nGeo = 1 + this%nElem = nElem + this%nGlobalElem = nElem + this%nNodes = nNodes + this%nCornerNodes = nElem*2 + this%nUniqueNodes = 0 + this%nBCs = nBCs + this%bcid = 0 + + allocate (this%elemInfo(1:4, 1:nElem)) + allocate (this%nodeCoords(1:nNodes)) + allocate (this%globalNodeIDs(1:nNodes)) + allocate (this%BCType(1:4, 1:nBCs)) + + allocate (this%BCNames(1:nBCs)) + call this%decomp%Init() + + end subroutine Init_Mesh1D + + subroutine Free_Mesh1D(this) + implicit none + class(Mesh1D), intent(inout) :: this + + this%nElem = 0 + this%nNodes = 0 + this%nCornerNodes = 0 + this%nUniqueNodes = 0 + this%nBCs = 0 + deallocate (this%elemInfo) + deallocate (this%nodeCoords) + deallocate (this%globalNodeIDs) + deallocate (this%BCType) + deallocate (this%BCNames) + call this%decomp%Free() + + end subroutine Free_Mesh1D + + subroutine UniformBlockMesh_Mesh1D(this, nElem, x) + implicit none + class(Mesh1D), intent(out) :: this + integer, intent(in) :: nElem + real(prec), intent(in) :: x(1:2) + ! Local + integer :: iel, ngeo + integer :: nid, nNodes + integer :: i + real(prec) :: xU(1:nElem + 1) + type(Lagrange), target :: linearInterp + type(Lagrange), target :: nGeoInterp + type(Scalar1D) :: xLinear + type(Scalar1D) :: xGeo + + ngeo = 1 + + nNodes = nElem*(nGeo + 1) + call this%Init(nElem, nNodes, 2) + this%quadrature = GAUSS_LOBATTO + + ! Set the hopr_nodeCoords + xU = UniformPoints(x(1), x(2), 1, nElem + 1) + + call linearInterp%Init(1, GAUSS_LOBATTO, & + nGeo, GAUSS_LOBATTO) + + call nGeoInterp%Init(nGeo, GAUSS_LOBATTO, & + nGeo, GAUSS_LOBATTO) + + ! Create a linear interpolant to interpolate to nGeo grid + call xLinear%Init(linearInterp, 1, nElem) + call xGeo%Init(nGeoInterp, 1, nElem) + + do iel = 1, nElem + xLinear%interior(1:2, iel, 1) = xU(iel:iel + 1) + end do + + call xLinear%GridInterp(xGeo%interior) + + ! Set the element information + nid = 1 + do iel = 1, nElem + this%elemInfo(1, iel) = selfLineLinear ! Element Type + this%elemInfo(2, iel) = 1 ! Element Zone + this%elemInfo(3, iel) = nid ! Node Index Start + do i = 1, nGeo + 1 + this%nodeCoords(nid) = xGeo%interior(i, iel, 1) + nid = nid + 1 + end do + this%elemInfo(4, iel) = nid - 1 ! Node Index End + end do + + call xLinear%Free() + call xGeo%Free() + call linearInterp%Free() + call nGeoInterp%Free() + + end subroutine UniformBlockMesh_Mesh1D + + subroutine ResetBoundaryConditionType_Mesh1D(this, leftbc, rightbc) !! This method can be used to reset all of the boundary elements !! boundary condition type to the desired value. !! !! Note that ALL physical boundaries will be set to have this boundary !! condition - implicit none - class(Mesh1D),intent(inout) :: this - integer,intent(in) ::leftbc,rightbc + implicit none + class(Mesh1D), intent(inout) :: this + integer, intent(in) ::leftbc, rightbc - this%bcid(1) = leftbc - this%bcid(2) = rightbc + this%bcid(1) = leftbc + this%bcid(2) = rightbc - endsubroutine ResetBoundaryConditionType_Mesh1D + end subroutine ResetBoundaryConditionType_Mesh1D - subroutine Write_Mesh1D(this,meshFile) - ! Writes mesh output in HOPR format (serial IO only) - implicit none - class(Mesh1D),intent(inout) :: this - character(*),intent(in) :: meshFile - ! Local - integer(HID_T) :: fileId + subroutine Write_Mesh1D(this, meshFile) + ! Writes mesh output in HOPR format (serial IO only) + implicit none + class(Mesh1D), intent(inout) :: this + character(*), intent(in) :: meshFile + ! Local + integer(HID_T) :: fileId - call Open_HDF5(meshFile,H5F_ACC_RDWR_F,fileId) + call Open_HDF5(meshFile, H5F_ACC_RDWR_F, fileId) - call WriteAttribute_HDF5(fileId,'nElems',this%nElem) - call WriteAttribute_HDF5(fileId,'Ngeo',this%nGeo) - call WriteAttribute_HDF5(fileId,'nBCs',this%nBCs) + call WriteAttribute_HDF5(fileId, 'nElems', this%nElem) + call WriteAttribute_HDF5(fileId, 'Ngeo', this%nGeo) + call WriteAttribute_HDF5(fileId, 'nBCs', this%nBCs) - call WriteArray_HDF5(fileId,'BCType',this%bcType) + call WriteArray_HDF5(fileId, 'BCType', this%bcType) - ! Read local subarray of ElemInfo - call WriteArray_HDF5(fileId,'ElemInfo',this%elemInfo) + ! Read local subarray of ElemInfo + call WriteArray_HDF5(fileId, 'ElemInfo', this%elemInfo) - ! Read local subarray of NodeCoords and GlobalNodeIDs - call WriteArray_HDF5(fileId,'NodeCoords',this%nodeCoords) - call WriteArray_HDF5(fileId,'GlobalNodeIDs',this%globalNodeIDs) + ! Read local subarray of NodeCoords and GlobalNodeIDs + call WriteArray_HDF5(fileId, 'NodeCoords', this%nodeCoords) + call WriteArray_HDF5(fileId, 'GlobalNodeIDs', this%globalNodeIDs) - call Close_HDF5(fileID) + call Close_HDF5(fileID) - endsubroutine Write_Mesh1D + end subroutine Write_Mesh1D -endmodule SELF_Mesh_1D +end module SELF_Mesh_1D diff --git a/src/SELF_Mesh_2D_t.f90 b/src/SELF_Mesh_2D_t.f90 index 224dc4bc6..df80a8436 100644 --- a/src/SELF_Mesh_2D_t.f90 +++ b/src/SELF_Mesh_2D_t.f90 @@ -26,19 +26,19 @@ module SELF_Mesh_2D_t - use SELF_Constants - use SELF_Lagrange - use SELF_SupportRoutines - use SELF_HDF5 - use SELF_Mesh - use SELF_DomainDecomposition + use SELF_Constants + use SELF_Lagrange + use SELF_SupportRoutines + use SELF_HDF5 + use SELF_Mesh + use SELF_DomainDecomposition - ! External Libs ! - use HDF5 + ! External Libs ! + use HDF5 - use iso_c_binding + use iso_c_binding - implicit none + implicit none ! ========================================================================= ! ! Node, Edge, Face, Element and Connectivity Standard @@ -86,148 +86,148 @@ module SELF_Mesh_2D_t ! ! ========================================================================= ! - ! Side Ordering - integer,parameter :: selfSide2D_South = 1 - integer,parameter :: selfSide2D_East = 2 - integer,parameter :: selfSide2D_North = 3 - integer,parameter :: selfSide2D_West = 4 + ! Side Ordering + integer, parameter :: selfSide2D_South = 1 + integer, parameter :: selfSide2D_East = 2 + integer, parameter :: selfSide2D_North = 3 + integer, parameter :: selfSide2D_West = 4 - ! Mesh format is set up similar to the HOPr format - ! See https://hopr-project.org/externals/MeshFormat.pdf + ! Mesh format is set up similar to the HOPr format + ! See https://hopr-project.org/externals/MeshFormat.pdf - type,extends(SEMMesh) :: Mesh2D_t - integer,pointer,dimension(:,:,:) :: sideInfo - real(prec),pointer,dimension(:,:,:,:) :: nodeCoords - integer,pointer,dimension(:,:) :: elemInfo - integer,pointer,dimension(:,:,:) :: globalNodeIDs - integer,pointer,dimension(:,:) :: CGNSCornerMap - integer,pointer,dimension(:,:) :: CGNSSideMap - integer,pointer,dimension(:,:) :: BCType - character(LEN=255),allocatable :: BCNames(:) + type, extends(SEMMesh) :: Mesh2D_t + integer, pointer, dimension(:, :, :) :: sideInfo + real(prec), pointer, dimension(:, :, :, :) :: nodeCoords + integer, pointer, dimension(:, :) :: elemInfo + integer, pointer, dimension(:, :, :) :: globalNodeIDs + integer, pointer, dimension(:, :) :: CGNSCornerMap + integer, pointer, dimension(:, :) :: CGNSSideMap + integer, pointer, dimension(:, :) :: BCType + character(LEN=255), allocatable :: BCNames(:) - contains - procedure,public :: Init => Init_Mesh2D_t - procedure,public :: Free => Free_Mesh2D_t - procedure,public :: UpdateDevice => UpdateDevice_Mesh2D_t + contains + procedure, public :: Init => Init_Mesh2D_t + procedure, public :: Free => Free_Mesh2D_t + procedure, public :: UpdateDevice => UpdateDevice_Mesh2D_t - generic,public :: StructuredMesh => UniformStructuredMesh_Mesh2D_t - procedure,private :: UniformStructuredMesh_Mesh2D_t - procedure,public :: ResetBoundaryConditionType => ResetBoundaryConditionType_Mesh2D_t + generic, public :: StructuredMesh => UniformStructuredMesh_Mesh2D_t + procedure, private :: UniformStructuredMesh_Mesh2D_t + procedure, public :: ResetBoundaryConditionType => ResetBoundaryConditionType_Mesh2D_t - procedure,public :: Read_HOPr => Read_HOPr_Mesh2D_t + procedure, public :: Read_HOPr => Read_HOPr_Mesh2D_t - procedure,public :: Write_Mesh => Write_Mesh2D_t + procedure, public :: Write_Mesh => Write_Mesh2D_t - procedure,public :: RecalculateFlip => RecalculateFlip_Mesh2D_t + procedure, public :: RecalculateFlip => RecalculateFlip_Mesh2D_t - endtype Mesh2D_t + end type Mesh2D_t contains - subroutine Init_Mesh2D_t(this,nGeo,nElem,nSides,nNodes,nBCs) - implicit none - class(Mesh2D_t),intent(inout) :: this - integer,intent(in) :: nGeo - integer,intent(in) :: nElem - integer,intent(in) :: nSides - integer,intent(in) :: nNodes - integer,intent(in) :: nBCs - ! Local - integer :: i,j,l - - this%nGeo = nGeo - this%nElem = nElem - this%nGlobalElem = nElem - this%nNodes = nNodes - this%nSides = nSides - this%nCornerNodes = 0 - this%nUniqueNodes = 0 - this%nUniqueSides = 0 - this%nBCs = nBCs - - allocate(this%elemInfo(1:6,1:nElem)) - allocate(this%sideInfo(1:5,1:4,1:nElem)) - allocate(this%nodeCoords(1:2,1:nGeo+1,1:nGeo+1,1:nElem)) - allocate(this%globalNodeIDs(1:nGeo+1,1:nGeo+1,1:nElem)) - allocate(this%CGNSCornerMap(1:2,1:4)) - allocate(this%CGNSSideMap(1:2,1:4)) - allocate(this%BCType(1:4,1:nBCs)) - - allocate(this%BCNames(1:nBCs)) - - ! Create lookup tables to assist with connectivity generation - this%CGNSCornerMap(1:2,1) = (/1,1/) - this%CGNSCornerMap(1:2,2) = (/nGeo+1,1/) - this%CGNSCornerMap(1:2,3) = (/nGeo+1,nGeo+1/) - this%CGNSCornerMap(1:2,4) = (/1,nGeo+1/) - - ! Maps from local corner node id to CGNS side - this%CGNSSideMap(1:2,1) = (/1,2/) - this%CGNSSideMap(1:2,2) = (/2,3/) - this%CGNSSideMap(1:2,3) = (/4,3/) - this%CGNSSideMap(1:2,4) = (/1,4/) - - endsubroutine Init_Mesh2D_t - - subroutine Free_Mesh2D_t(this) - implicit none - class(Mesh2D_t),intent(inout) :: this - - this%nElem = 0 - this%nNodes = 0 - this%nSides = 0 - this%nCornerNodes = 0 - this%nUniqueSides = 0 - this%nUniqueNodes = 0 - this%nBCs = 0 - - deallocate(this%elemInfo) - deallocate(this%sideInfo) - deallocate(this%nodeCoords) - deallocate(this%globalNodeIDs) - deallocate(this%CGNSCornerMap) - deallocate(this%CGNSSideMap) - deallocate(this%BCType) - deallocate(this%BCNames) - call this%decomp%Free() - - endsubroutine Free_Mesh2D_t - - subroutine UpdateDevice_Mesh2D_t(this) - implicit none - class(Mesh2D_t),intent(inout) :: this - - return - - endsubroutine UpdateDevice_Mesh2D_t - - subroutine ResetBoundaryConditionType_Mesh2D_t(this,bcid) + subroutine Init_Mesh2D_t(this, nGeo, nElem, nSides, nNodes, nBCs) + implicit none + class(Mesh2D_t), intent(inout) :: this + integer, intent(in) :: nGeo + integer, intent(in) :: nElem + integer, intent(in) :: nSides + integer, intent(in) :: nNodes + integer, intent(in) :: nBCs + ! Local + integer :: i, j, l + + this%nGeo = nGeo + this%nElem = nElem + this%nGlobalElem = nElem + this%nNodes = nNodes + this%nSides = nSides + this%nCornerNodes = 0 + this%nUniqueNodes = 0 + this%nUniqueSides = 0 + this%nBCs = nBCs + + allocate (this%elemInfo(1:6, 1:nElem)) + allocate (this%sideInfo(1:5, 1:4, 1:nElem)) + allocate (this%nodeCoords(1:2, 1:nGeo + 1, 1:nGeo + 1, 1:nElem)) + allocate (this%globalNodeIDs(1:nGeo + 1, 1:nGeo + 1, 1:nElem)) + allocate (this%CGNSCornerMap(1:2, 1:4)) + allocate (this%CGNSSideMap(1:2, 1:4)) + allocate (this%BCType(1:4, 1:nBCs)) + + allocate (this%BCNames(1:nBCs)) + + ! Create lookup tables to assist with connectivity generation + this%CGNSCornerMap(1:2, 1) = (/1, 1/) + this%CGNSCornerMap(1:2, 2) = (/nGeo + 1, 1/) + this%CGNSCornerMap(1:2, 3) = (/nGeo + 1, nGeo + 1/) + this%CGNSCornerMap(1:2, 4) = (/1, nGeo + 1/) + + ! Maps from local corner node id to CGNS side + this%CGNSSideMap(1:2, 1) = (/1, 2/) + this%CGNSSideMap(1:2, 2) = (/2, 3/) + this%CGNSSideMap(1:2, 3) = (/4, 3/) + this%CGNSSideMap(1:2, 4) = (/1, 4/) + + end subroutine Init_Mesh2D_t + + subroutine Free_Mesh2D_t(this) + implicit none + class(Mesh2D_t), intent(inout) :: this + + this%nElem = 0 + this%nNodes = 0 + this%nSides = 0 + this%nCornerNodes = 0 + this%nUniqueSides = 0 + this%nUniqueNodes = 0 + this%nBCs = 0 + + deallocate (this%elemInfo) + deallocate (this%sideInfo) + deallocate (this%nodeCoords) + deallocate (this%globalNodeIDs) + deallocate (this%CGNSCornerMap) + deallocate (this%CGNSSideMap) + deallocate (this%BCType) + deallocate (this%BCNames) + call this%decomp%Free() + + end subroutine Free_Mesh2D_t + + subroutine UpdateDevice_Mesh2D_t(this) + implicit none + class(Mesh2D_t), intent(inout) :: this + + return + + end subroutine UpdateDevice_Mesh2D_t + + subroutine ResetBoundaryConditionType_Mesh2D_t(this, bcid) !! This method can be used to reset all of the boundary elements !! boundary condition type to the desired value. !! !! Note that ALL physical boundaries will be set to have this boundary !! condition - implicit none - class(Mesh2D_t),intent(inout) :: this - integer,intent(in) :: bcid - ! Local - integer :: iSide,iEl,e2 + implicit none + class(Mesh2D_t), intent(inout) :: this + integer, intent(in) :: bcid + ! Local + integer :: iSide, iEl, e2 - do iEl = 1,this%nElem - do iSide = 1,4 + do iEl = 1, this%nElem + do iSide = 1, 4 - e2 = this%sideInfo(3,iSide,iEl) + e2 = this%sideInfo(3, iSide, iEl) - if(e2 == 0) then - this%sideInfo(5,iSide,iEl) = bcid - endif + if (e2 == 0) then + this%sideInfo(5, iSide, iEl) = bcid + end if - enddo - enddo + end do + end do - endsubroutine ResetBoundaryConditionType_Mesh2D_t + end subroutine ResetBoundaryConditionType_Mesh2D_t - subroutine UniformStructuredMesh_Mesh2D_t(this,nxPerTile,nyPerTile,nTileX,nTileY,dx,dy,bcids,enableDomainDecomposition) + subroutine UniformStructuredMesh_Mesh2D_t(this, nxPerTile, nyPerTile, nTileX, nTileY, dx, dy, bcids) !! !! Create a structured mesh and store it in SELF's unstructured mesh format. !! The mesh is created in tiles of size (tnx,tny). Tiling is used to determine @@ -254,568 +254,559 @@ subroutine UniformStructuredMesh_Mesh2D_t(this,nxPerTile,nyPerTile,nTileX,nTileY !! Length of the domain in the x-direction is Lx = dx*nX !! Length of the domain in the y-direction is Ly = dy*nY !! - implicit none - class(Mesh2D_t),intent(out) :: this - integer,intent(in) :: nxPerTile - integer,intent(in) :: nyPerTile - integer,intent(in) :: nTileX - integer,intent(in) :: nTileY - real(prec),intent(in) :: dx - real(prec),intent(in) :: dy - integer,intent(in) :: bcids(1:4) - logical,optional,intent(in) :: enableDomainDecomposition - ! Local - integer :: nX,nY,nGeo,nBCs - integer :: nGlobalElem - integer :: nUniqueSides - integer :: nUniqueNodes - integer :: nLocalElems - integer :: nLocalSides - integer :: nLocalNodes - real(prec),allocatable :: nodeCoords(:,:,:,:) - integer,allocatable :: globalNodeIDs(:,:,:) - integer,allocatable :: sideInfo(:,:,:) - integer :: i,j,ti,tj - integer :: ix,iy,iel - integer :: ni,nj - integer :: e1,e2 - integer :: nedges - - if(present(enableDomainDecomposition)) then - call this%decomp%init(enableDomainDecomposition) - else - call this%decomp%init(.false.) - endif - nX = nTileX*nxPerTile - nY = nTileY*nyPerTile - nGeo = 1 ! Force the geometry to be linear - nBCs = 4 ! Force the number of boundary conditions to 4 - - nGlobalElem = nX*nY - nUniqueSides = (nX+1)*nY+(nY+1)*nX - nUniqueNodes = (nX+1)*(nY+1) - - allocate(nodeCoords(1:2,1:nGeo+1,1:nGeo+1,1:nGlobalElem)) - allocate(globalNodeIDs(1:nGeo+1,1:nGeo+1,1:nGlobalElem)) - allocate(sideInfo(1:5,1:4,1:nGlobalElem)) - - do tj = 1,nTileY - do ti = 1,nTileX - do j = 1,nyPerTile - iy = j+nyPerTile*(tj-1) - do i = 1,nxPerTile - iel = i+nxPerTile*(j-1+nyPerTile*(ti-1+nTilex*(tj-1))) - ix = i+nxPerTile*(ti-1) ! nxpertile + nxpertile*(nTileX-1) = nxperTile*nTilex = 1 - do nj = 1,nGeo+1 - do ni = 1,nGeo+1 - nodeCoords(1,ni,nj,iel) = real(ni-1+ix-1,prec)*dx - nodeCoords(2,ni,nj,iel) = real(nj-1+iy-1,prec)*dy - globalNodeIDs(ni,nj,iel) = ni-1+i+(nxPerTile+1)*( & - nj-1+j-1+(nyPerTile+1)*( & - ti-1+nTileX*(tj-1))) - enddo - enddo - enddo - enddo - enddo - enddo - - ! Fill in edge information - ! sideInfo(1:5,iSide,iEl) - ! 1 - Side Type (currently unused in SELF) - ! 2 - Global Side ID (Used for message passing. Don't need to change) - ! 3 - Neighbor Element ID (Can stay the same) - ! 4 - 10*( neighbor local side ) + flip (Need to recalculate flip) - ! 5 - Boundary Condition ID (Can stay the same) - nedges = 0 - do tj = 1,nTileY - do ti = 1,nTileX - do j = 1,nyPerTile - do i = 1,nxPerTile - iel = i+nxPerTile*(j-1+nyPerTile*(ti-1+nTilex*(tj-1))) - - ! south, iside=1 - ! Get the corner node ids for this edge - ! sideInfo(2,1,iel) = (nc1+nc2)*(nc1+nc2+1)/2 + nc2 - if(j == 1) then ! southern most part of the tile - if(tj == 1) then ! southern most tile - nedges = nedges+1 - sideinfo(2,1,iel) = nedges - sideinfo(3,1,iel) = 0 ! Neigbor element (null, boundary condition) - sideinfo(4,1,iel) = 0 ! Neighbor side id (null, boundary condition) - sideinfo(5,1,iel) = bcids(1) ! Boundary condition id; set from the user input - else ! interior tile, but souther most edge of the tile - e2 = i+nxPerTile*(nyPerTile-1+nyPerTile*(ti-1+nTilex*(tj-2))) ! Neigbor element, northernmost element, in tile to the south - sideinfo(2,1,iel) = sideInfo(2,3,e2) ! Copy the edge id from neighbor's north edge - sideinfo(3,1,iel) = e2 - sideinfo(4,1,iel) = 10*3 ! Neighbor side id - neighbor to the south, north side (3) - sideinfo(5,1,iel) = 0 ! Boundary condition id; (null, interior edge) - endif - else ! interior to the tile - e2 = i+nxPerTile*(j-2+nyPerTile*(ti-1+nTilex*(tj-1))) ! Neigbor element, inside same tile, to the south - sideinfo(2,1,iel) = sideInfo(2,3,e2) ! Copy the edge id from neighbor's north edge - sideinfo(3,1,iel) = e2 - sideinfo(4,1,iel) = 10*3 ! Neighbor side id - neighbor to the south, north side (3) - sideinfo(5,1,iel) = 0 ! Boundary condition id; (null, interior edge) - endif - - ! east, iside=2 - ! Get the corner node ids for this edge - ! East edges are always new edges, due to the way we are traversing the grid - nedges = nedges+1 - sideinfo(2,2,iel) = nedges - if(i == nxPerTile) then ! eastern most part of the tile - if(ti == nTileX) then ! eastern most tile - sideinfo(3,2,iel) = 0 ! Neigbor element (null, boundary condition) - sideinfo(4,2,iel) = 0 ! Neighbor side id (null, boundary condition) - sideinfo(5,2,iel) = bcids(2) ! Boundary condition id; eastern boundary set from the user input - else ! interior tile, but eastern most edge of the tile - sideinfo(3,2,iel) = 1+nxPerTile*(j-1+nyPerTile*(ti+nTilex*(tj-1))) ! Neigbor element, westernnmost element, in tile to the east - sideinfo(4,2,iel) = 10*4 ! Neighbor side id - neighbor to the east, west side (4) - sideinfo(5,2,iel) = 0 ! Boundary condition id; (null, interior edge) - endif - else ! interior to the tile - sideinfo(3,2,iel) = i+1+nxPerTile*(j-1+nyPerTile*(ti-1+nTilex*(tj-1))) ! Neigbor element, inside same tile, to the east - sideinfo(4,2,iel) = 10*4 ! Neighbor side id - neighbor to the east, west side (4) - sideinfo(5,2,iel) = 0 ! Boundary condition id; (null, interior edge) - endif - - ! north, iside=3 - ! Get the corner node ids for this edge - ! East edges are always new edges, due to the way we are traversing the grid - nedges = nedges+1 - sideinfo(2,3,iel) = nedges - if(j == nyPerTile) then ! northern most part of the tile - if(tj == nTileY) then ! northern most tile - sideinfo(3,3,iel) = 0 ! Neigbor element (null, boundary condition) - sideinfo(4,3,iel) = 0 ! Neighbor side id (null, boundary condition) - sideinfo(5,3,iel) = bcids(3) ! Boundary condition id; set from the user input - else ! interior tile, but northern most edge of the tile - sideinfo(3,3,iel) = i+nxPerTile*(nyPerTile*(ti-1+nTilex*(tj))) ! Neigbor element, southernmost element in tile to the north - sideinfo(4,3,iel) = 10*1 ! Neighbor side id - neighbor to the north, south side (1) - sideinfo(5,3,iel) = 0 ! Boundary condition id; (null, interior edge) - endif - else ! interior to the tile - sideinfo(3,3,iel) = i+nxPerTile*(j+nyPerTile*(ti-1+nTilex*(tj-1))) ! Neigbor element, inside same tile, to the north - sideinfo(4,3,iel) = 10*1 ! Neighbor side id - neighbor to the north, south side (1) - sideinfo(5,3,iel) = 0 ! Boundary condition id; (null, interior edge) - endif - - ! west, iside=4 - ! Get the corner node ids for this edge - ! n1 = globalNodeIds(this%CGNSCornerMap(1,1),this%CGNSCornerMap(2,1),iel) - ! n2 = globalNodeIds(this%CGNSCornerMap(1,4),this%CGNSCornerMap(2,4),iel) - ! nc1 = min(n1,n2) - ! nc2 = max(n1,n2) - ! sideInfo(2,1,iel) = (nc1+nc2)*(nc1+nc2+1)/2 + nc2 - if(i == 1) then ! western most part of the tile - if(ti == 1) then ! western most tile - nedges = nedges+1 - sideinfo(2,4,iel) = nedges - sideinfo(3,4,iel) = 0 ! Neigbor element (null, boundary condition) - sideinfo(4,4,iel) = 0 ! Neighbor side id (null, boundary condition) - sideinfo(5,4,iel) = bcids(4) ! Boundary condition id; eastern boundary set from the user input - else ! interior tile, but western most edge of the tile - e2 = nxPerTile+nxPerTile*(j-1+nyPerTile*(ti-2+nTilex*(tj-1))) ! Neigbor element, easternnmost element in tile to the west - sideinfo(3,4,iel) = sideInfo(2,2,e2) ! Copy the edge id from neighbor's east edge - sideinfo(3,4,iel) = e2 - sideinfo(4,4,iel) = 10*2 ! Neighbor side id - neighbor to the west, east side (2) - sideinfo(5,4,iel) = 0 ! Boundary condition id; (null, interior edge) - endif - else ! interior to the tile - e2 = i-1+nxPerTile*(j-1+nyPerTile*(ti-1+nTilex*(tj-1))) ! Neigbor element, inside same tile, to the west - sideinfo(3,4,iel) = sideInfo(2,2,e2) ! Copy the edge id from neighbor's east edge - sideinfo(3,4,iel) = e2 - sideinfo(4,4,iel) = 10*2 ! Neighbor side id - neighbor to the west, east side (2) - sideinfo(5,4,iel) = 0 ! Boundary condition id; (null, interior edge) - endif - - enddo - enddo - enddo - enddo - - call this%decomp%GenerateDecomposition(nGlobalElem,nUniqueSides) - - e1 = this%decomp%offsetElem(this%decomp%rankId+1)+1 - e2 = this%decomp%offsetElem(this%decomp%rankId+2) - nLocalElems = e2-e1+1 - - nLocalSides = nLocalElems*4 - nLocalNodes = nLocalElems*4 - call this%Init(nGeo,nLocalElems,nLocalSides,nLocalNodes,nBCs) - this%nUniqueSides = nUniqueSides - this%quadrature = UNIFORM - - this%nodeCoords(1:2,1:nGeo+1,1:nGeo+1,1:nLocalElems) = nodeCoords(1:2,1:nGeo+1,1:nGeo+1,e1:e2) - this%globalNodeIDs(1:nGeo+1,1:nGeo+1,1:nLocalElems) = globalNodeIDs(1:nGeo+1,1:nGeo+1,e1:e2) - this%sideInfo(1:5,1:4,1:nLocalElems) = sideInfo(1:5,1:4,e1:e2) - - deallocate(nodeCoords) - deallocate(globalNodeIDs) - deallocate(sideInfo) - - call this%UpdateDevice() - - endsubroutine UniformStructuredMesh_Mesh2D_t - - subroutine Read_HOPr_Mesh2D_t(this,meshFile,enableDomainDecomposition) - ! From https://www.hopr-project.org/externals/Meshformat.pdf, Algorithm 6 - ! Adapted for 2D Mesh : Note that HOPR does not have 2D mesh output. - implicit none - class(Mesh2D_t),intent(out) :: this - character(*),intent(in) :: meshFile - logical,intent(in),optional :: enableDomainDecomposition - ! Local - integer(HID_T) :: fileId - integer(HID_T) :: offset(1:2),gOffset(1) - integer :: nGlobalElem - integer :: firstElem - integer :: firstNode - integer :: firstSide - integer :: nLocalElems - integer :: nLocalNodes3D - integer :: nLocalSides3D - integer :: nUniqueSides3D - integer :: nLocalNodes2D - integer :: nLocalSides2D - integer :: nUniqueSides2D - integer :: nGeo,nBCs - integer :: eid,lsid,iSide - integer :: i,j,nid - integer,dimension(:,:),allocatable :: hopr_elemInfo - integer,dimension(:,:),allocatable :: hopr_sideInfo - real(prec),dimension(:,:),allocatable :: hopr_nodeCoords - integer,dimension(:),allocatable :: hopr_globalNodeIDs - integer,dimension(:,:),allocatable :: bcType - - if(present(enableDomainDecomposition)) then - call this%decomp%init(enableDomainDecomposition) - else - call this%decomp%init(.false.) - endif - - print*,__FILE__//' : Reading HOPr mesh from'//trim(meshfile) - if(this%decomp%mpiEnabled) then - call Open_HDF5(meshFile,H5F_ACC_RDONLY_F,fileId,this%decomp%mpiComm) - else - call Open_HDF5(meshFile,H5F_ACC_RDONLY_F,fileId) - endif - - print*,__FILE__//' : Loading mesh attributes' - call ReadAttribute_HDF5(fileId,'nElems',nGlobalElem) - call ReadAttribute_HDF5(fileId,'Ngeo',nGeo) - call ReadAttribute_HDF5(fileId,'nBCs',nBCs) - call ReadAttribute_HDF5(fileId,'nUniqueSides',nUniqueSides3D) - print*,__FILE__//' : N Global Elements = ',nGlobalElem - print*,__FILE__//' : Mesh geometry degree = ',nGeo - print*,__FILE__//' : N Boundary conditions = ',nBCs - print*,__FILE__//' : N Unique Sides (3D) = ',nUniqueSides3D - - ! Read BCType - allocate(bcType(1:4,1:nBCS)) - - if(this%decomp%mpiEnabled) then - offset(:) = 0 - call ReadArray_HDF5(fileId,'BCType',bcType,offset) - else - call ReadArray_HDF5(fileId,'BCType',bcType) - endif - - ! Read local subarray of ElemInfo - print*,__FILE__//' : Generating Domain Decomposition' - call this%decomp%GenerateDecomposition(nGlobalElem,nUniqueSides3D) - - firstElem = this%decomp%offsetElem(this%decomp%rankId+1)+1 - nLocalElems = this%decomp%offsetElem(this%decomp%rankId+2)- & - this%decomp%offsetElem(this%decomp%rankId+1) - - print*,__FILE__//' : Rank ',this%decomp%rankId+1,' : element offset = ',firstElem - print*,__FILE__//' : Rank ',this%decomp%rankId+1,' : n_elements = ',nLocalElems - - ! Allocate Space for hopr_elemInfo! - allocate(hopr_elemInfo(1:6,1:nLocalElems)) - - if(this%decomp%mpiEnabled) then - offset = (/0,firstElem-1/) - call ReadArray_HDF5(fileId,'ElemInfo',hopr_elemInfo,offset) - else - call ReadArray_HDF5(fileId,'ElemInfo',hopr_elemInfo) - endif - - ! Read local subarray of NodeCoords and GlobalNodeIDs - firstNode = hopr_elemInfo(5,1)+1 - nLocalNodes3D = hopr_elemInfo(6,nLocalElems)-hopr_elemInfo(5,1) - - ! Allocate Space for hopr_nodeCoords and hopr_globalNodeIDs ! - allocate(hopr_nodeCoords(1:3,nLocalNodes3D),hopr_globalNodeIDs(1:nLocalNodes3D)) - - if(this%decomp%mpiEnabled) then - offset = (/0,firstNode-1/) - call ReadArray_HDF5(fileId,'NodeCoords',hopr_nodeCoords,offset) - gOffset = (/firstNode-1/) - call ReadArray_HDF5(fileId,'GlobalNodeIDs',hopr_globalNodeIDs,gOffset) - else - call ReadArray_HDF5(fileId,'NodeCoords',hopr_nodeCoords) - call ReadArray_HDF5(fileId,'GlobalNodeIDs',hopr_globalNodeIDs) - endif - - ! Read local subarray of SideInfo - firstSide = hopr_elemInfo(3,1)+1 - nLocalSides3D = hopr_elemInfo(4,nLocalElems)-hopr_elemInfo(3,1) - - ! Allocate space for hopr_sideInfo - allocate(hopr_sideInfo(1:5,1:nLocalSides3D)) - if(this%decomp%mpiEnabled) then - offset = (/0,firstSide-1/) - print*,__FILE__//' : Rank ',this%decomp%rankId+1,' Reading side information' - call ReadArray_HDF5(fileId,'SideInfo',hopr_sideInfo,offset) - else - call ReadArray_HDF5(fileId,'SideInfo',hopr_sideInfo) - endif - - call Close_HDF5(fileID) - ! ---- Done reading 3-D Mesh information ---- ! - - ! Now we need to convert from 3-D to 2-D ! - nLocalSides2D = nLocalSides3D-2*nLocalElems - nUniqueSides2D = nUniqueSides3D-2*nGlobalElem ! Remove the "top" and "bottom" faces - nLocalNodes2D = nLocalNodes2D-nLocalElems*nGeo*(nGeo+1)**2 ! Remove the third dimension - - print*,__FILE__//' : Rank ',this%decomp%rankId+1,' Allocating memory for mesh' - print*,__FILE__//' : Rank ',this%decomp%rankId+1,' n local sides : ',nLocalSides2D - call this%Init(nGeo,nLocalElems,nLocalSides2D,nLocalNodes2D,nBCs) - this%nUniqueSides = nUniqueSides2D ! Store the number of sides in the global mesh - - ! Copy data from local arrays into this - ! elemInfo(1:6,iEl) - ! 1 - Element Type - ! 2 - Zone - ! 3 - offset index for side array (not needed when all quads are assumed) - ! 4 - last index for side array (not needed when all quads are assumed) - ! 5 - offset index for node array (not needed when all quads are assumed) - ! 6 - last index for node array (not needed when all quads are assumed) - this%elemInfo = hopr_elemInfo - this%quadrature = UNIFORM ! HOPr uses uniformly spaced points - - ! Grab the node coordinates (x and y only) from the "bottom" layer of the extruded mesh - do eid = 1,this%nElem - do j = 1,nGeo+1 - do i = 1,nGeo+1 - nid = i+(nGeo+1)*(j-1+(nGeo+1)*((nGeo+1)*(eid-1))) - this%nodeCoords(1:2,i,j,eid) = hopr_nodeCoords(1:2,nid) - this%globalNodeIDs(i,j,eid) = hopr_globalNodeIDs(nid) - enddo - enddo - enddo - - ! Grab the south, west, north, and south sides of the elements - ! sideInfo(1:5,iSide,iEl) - ! - ! 1 - Side Type (currently unused in SELF) - ! 2 - Global Side ID (Used for message passing. Don't need to change) - ! 3 - Neighbor Element ID (Can stay the same) - ! 4 - 10*( neighbor local side ) + flip (Need to recalculate flip) - ! 5 - Boundary Condition ID (Can stay the same) - do eid = 1,this%nElem - do lsid = 1,4 - ! Calculate the 3-D side ID from the 2-D local side id and element ID - iSide = lsid+1+6*(eid-1) - this%sideInfo(1:5,lsid,eid) = hopr_sideInfo(1:5,iSide) - ! Adjust the secondary side index for 2-D - this%sideInfo(4,lsid,eid) = this%sideInfo(4,lsid,eid)-10 - enddo - enddo - call this%RecalculateFlip() - - deallocate(hopr_elemInfo,hopr_nodeCoords,hopr_globalNodeIDs,hopr_sideInfo) - - call this%UpdateDevice() - - endsubroutine Read_HOPr_Mesh2D_t - - subroutine RecalculateFlip_Mesh2D_t(this) - implicit none - class(Mesh2D_t),intent(inout) :: this - ! Local - integer :: e1 - integer :: s1 - integer :: e2 - integer :: e2Global - integer :: s2 - integer :: flip - integer :: bcid - integer :: lnid1(1:2) - integer :: lnid2(1:2) - integer :: nid1(1:2,1:4,1:this%nElem) - integer :: nid2(1:2,1:4,1:this%nElem) - integer :: nloc1(1:2) - integer :: nloc2(1:2) - integer :: n1 - integer :: n1Global - integer :: n2 - integer :: n2Global - integer :: c1 - integer :: c2 - integer :: i,j - integer :: l - integer :: nShifts - integer :: neighborRank - integer :: rankId - integer :: offset - integer :: msgCount - integer :: globalSideId - integer,allocatable :: requests(:) - integer,allocatable :: stats(:,:) - integer :: iError - integer :: tag - logical :: theyMatch - - allocate(requests(1:this%nSides*2)) - allocate(stats(MPI_STATUS_SIZE,1:this%nSides*2)) - - if(this%decomp%mpiEnabled) then - rankId = this%decomp%rankId - offset = this%decomp%offsetElem(rankId+1) - else - rankId = 0 - offset = 0 - endif - - msgCount = 0 - do e1 = 1,this%nElem - do s1 = 1,4 - - e2Global = this%sideInfo(3,s1,e1) - e2 = e2Global-offset - s2 = this%sideInfo(4,s1,e1)/10 - flip = this%sideInfo(4,s1,e1)-s2*10 - bcid = this%sideInfo(5,s1,e1) - - if(e2Global > 0) then - - if(this%decomp%mpiEnabled) then - neighborRank = this%decomp%elemToRank(e2Global) - else - neighborRank = 0 - endif - - if(neighborRank == rankId) then - - lnid1 = this%CGNSSideMap(1:2,s1) ! local CGNS corner node ids for element 1 side - lnid2 = this%CGNSSideMap(1:2,s2) ! local CGNS corner node ids for element 2 side - - do l = 1,2 - - i = this%CGNSCornerMap(1,lnid1(l)) - j = this%CGNSCornerMap(2,lnid1(l)) - nid1(l,s1,e1) = this%globalNodeIDs(i,j,e1) - - i = this%CGNSCornerMap(1,lnid2(l)) - j = this%CGNSCornerMap(2,lnid2(l)) - nid2(l,s1,e1) = this%globalNodeIDs(i,j,e2) - - enddo - - else ! In this case, we need to exchange - - globalSideId = abs(this%sideInfo(2,s1,e1)) - - lnid1 = this%CGNSSideMap(1:2,s1) ! local CGNS corner node ids for element 1 side - - do l = 1,2 - - i = this%CGNSCornerMap(1,lnid1(l)) - j = this%CGNSCornerMap(2,lnid1(l)) - nid1(l,s1,e1) = this%globalNodeIDs(i,j,e1) - - tag = l+2*globalSideId - msgCount = msgCount+1 - call MPI_IRECV(nid2(l,s1,e1), & - 1, & - MPI_INTEGER, & - neighborRank,tag, & - this%decomp%mpiComm, & - requests(msgCount),iError) - - ! Send nid1(l) from this rank to nid2(l) on the other rank - msgCount = msgCount+1 - call MPI_ISEND(nid1(l,s1,e1), & - 1, & - MPI_INTEGER, & - neighborRank,tag, & - this%decomp%mpiComm, & - requests(msgCount),iError) - - enddo - - endif ! MPI or not - - endif ! If not physical boundary - - enddo - enddo - - if(this%decomp%mpiEnabled .and. msgCount > 0) then - call MPI_WaitAll(msgCount, & - requests(1:msgCount), & - stats(1:MPI_STATUS_SIZE,1:msgCount), & - iError) - endif + implicit none + class(Mesh2D_t), intent(out) :: this + integer, intent(in) :: nxPerTile + integer, intent(in) :: nyPerTile + integer, intent(in) :: nTileX + integer, intent(in) :: nTileY + real(prec), intent(in) :: dx + real(prec), intent(in) :: dy + integer, intent(in) :: bcids(1:4) + ! Local + integer :: nX, nY, nGeo, nBCs + integer :: nGlobalElem + integer :: nUniqueSides + integer :: nUniqueNodes + integer :: nLocalElems + integer :: nLocalSides + integer :: nLocalNodes + real(prec), allocatable :: nodeCoords(:, :, :, :) + integer, allocatable :: globalNodeIDs(:, :, :) + integer, allocatable :: sideInfo(:, :, :) + integer :: i, j, ti, tj + integer :: ix, iy, iel + integer :: ni, nj + integer :: e1, e2 + integer :: nedges + + call this%decomp%init() + + nX = nTileX*nxPerTile + nY = nTileY*nyPerTile + nGeo = 1 ! Force the geometry to be linear + nBCs = 4 ! Force the number of boundary conditions to 4 + + nGlobalElem = nX*nY + nUniqueSides = (nX + 1)*nY + (nY + 1)*nX + nUniqueNodes = (nX + 1)*(nY + 1) + + allocate (nodeCoords(1:2, 1:nGeo + 1, 1:nGeo + 1, 1:nGlobalElem)) + allocate (globalNodeIDs(1:nGeo + 1, 1:nGeo + 1, 1:nGlobalElem)) + allocate (sideInfo(1:5, 1:4, 1:nGlobalElem)) + + do tj = 1, nTileY + do ti = 1, nTileX + do j = 1, nyPerTile + iy = j + nyPerTile*(tj - 1) + do i = 1, nxPerTile + iel = i + nxPerTile*(j - 1 + nyPerTile*(ti - 1 + nTilex*(tj - 1))) + ix = i + nxPerTile*(ti - 1) ! nxpertile + nxpertile*(nTileX-1) = nxperTile*nTilex = 1 + do nj = 1, nGeo + 1 + do ni = 1, nGeo + 1 + nodeCoords(1, ni, nj, iel) = real(ni - 1 + ix - 1, prec)*dx + nodeCoords(2, ni, nj, iel) = real(nj - 1 + iy - 1, prec)*dy + globalNodeIDs(ni, nj, iel) = ni - 1 + i + (nxPerTile + 1)*( & + nj - 1 + j - 1 + (nyPerTile + 1)*( & + ti - 1 + nTileX*(tj - 1))) + end do + end do + end do + end do + end do + end do + + ! Fill in edge information + ! sideInfo(1:5,iSide,iEl) + ! 1 - Side Type (currently unused in SELF) + ! 2 - Global Side ID (Used for message passing. Don't need to change) + ! 3 - Neighbor Element ID (Can stay the same) + ! 4 - 10*( neighbor local side ) + flip (Need to recalculate flip) + ! 5 - Boundary Condition ID (Can stay the same) + nedges = 0 + do tj = 1, nTileY + do ti = 1, nTileX + do j = 1, nyPerTile + do i = 1, nxPerTile + iel = i + nxPerTile*(j - 1 + nyPerTile*(ti - 1 + nTilex*(tj - 1))) + + ! south, iside=1 + ! Get the corner node ids for this edge + ! sideInfo(2,1,iel) = (nc1+nc2)*(nc1+nc2+1)/2 + nc2 + if (j == 1) then ! southern most part of the tile + if (tj == 1) then ! southern most tile + nedges = nedges + 1 + sideinfo(2, 1, iel) = nedges + sideinfo(3, 1, iel) = 0 ! Neigbor element (null, boundary condition) + sideinfo(4, 1, iel) = 0 ! Neighbor side id (null, boundary condition) + sideinfo(5, 1, iel) = bcids(1) ! Boundary condition id; set from the user input + else ! interior tile, but souther most edge of the tile + e2 = i + nxPerTile*(nyPerTile - 1 + nyPerTile*(ti - 1 + nTilex*(tj - 2))) ! Neigbor element, northernmost element, in tile to the south + sideinfo(2, 1, iel) = sideInfo(2, 3, e2) ! Copy the edge id from neighbor's north edge + sideinfo(3, 1, iel) = e2 + sideinfo(4, 1, iel) = 10*3 ! Neighbor side id - neighbor to the south, north side (3) + sideinfo(5, 1, iel) = 0 ! Boundary condition id; (null, interior edge) + end if + else ! interior to the tile + e2 = i + nxPerTile*(j - 2 + nyPerTile*(ti - 1 + nTilex*(tj - 1))) ! Neigbor element, inside same tile, to the south + sideinfo(2, 1, iel) = sideInfo(2, 3, e2) ! Copy the edge id from neighbor's north edge + sideinfo(3, 1, iel) = e2 + sideinfo(4, 1, iel) = 10*3 ! Neighbor side id - neighbor to the south, north side (3) + sideinfo(5, 1, iel) = 0 ! Boundary condition id; (null, interior edge) + end if + + ! east, iside=2 + ! Get the corner node ids for this edge + ! East edges are always new edges, due to the way we are traversing the grid + nedges = nedges + 1 + sideinfo(2, 2, iel) = nedges + if (i == nxPerTile) then ! eastern most part of the tile + if (ti == nTileX) then ! eastern most tile + sideinfo(3, 2, iel) = 0 ! Neigbor element (null, boundary condition) + sideinfo(4, 2, iel) = 0 ! Neighbor side id (null, boundary condition) + sideinfo(5, 2, iel) = bcids(2) ! Boundary condition id; eastern boundary set from the user input + else ! interior tile, but eastern most edge of the tile + sideinfo(3, 2, iel) = 1 + nxPerTile*(j - 1 + nyPerTile*(ti + nTilex*(tj - 1))) ! Neigbor element, westernnmost element, in tile to the east + sideinfo(4, 2, iel) = 10*4 ! Neighbor side id - neighbor to the east, west side (4) + sideinfo(5, 2, iel) = 0 ! Boundary condition id; (null, interior edge) + end if + else ! interior to the tile + sideinfo(3, 2, iel) = i + 1 + nxPerTile*(j - 1 + nyPerTile*(ti - 1 + nTilex*(tj - 1))) ! Neigbor element, inside same tile, to the east + sideinfo(4, 2, iel) = 10*4 ! Neighbor side id - neighbor to the east, west side (4) + sideinfo(5, 2, iel) = 0 ! Boundary condition id; (null, interior edge) + end if + + ! north, iside=3 + ! Get the corner node ids for this edge + ! East edges are always new edges, due to the way we are traversing the grid + nedges = nedges + 1 + sideinfo(2, 3, iel) = nedges + if (j == nyPerTile) then ! northern most part of the tile + if (tj == nTileY) then ! northern most tile + sideinfo(3, 3, iel) = 0 ! Neigbor element (null, boundary condition) + sideinfo(4, 3, iel) = 0 ! Neighbor side id (null, boundary condition) + sideinfo(5, 3, iel) = bcids(3) ! Boundary condition id; set from the user input + else ! interior tile, but northern most edge of the tile + sideinfo(3, 3, iel) = i + nxPerTile*(nyPerTile*(ti - 1 + nTilex*(tj))) ! Neigbor element, southernmost element in tile to the north + sideinfo(4, 3, iel) = 10*1 ! Neighbor side id - neighbor to the north, south side (1) + sideinfo(5, 3, iel) = 0 ! Boundary condition id; (null, interior edge) + end if + else ! interior to the tile + sideinfo(3, 3, iel) = i + nxPerTile*(j + nyPerTile*(ti - 1 + nTilex*(tj - 1))) ! Neigbor element, inside same tile, to the north + sideinfo(4, 3, iel) = 10*1 ! Neighbor side id - neighbor to the north, south side (1) + sideinfo(5, 3, iel) = 0 ! Boundary condition id; (null, interior edge) + end if + + ! west, iside=4 + ! Get the corner node ids for this edge + ! n1 = globalNodeIds(this%CGNSCornerMap(1,1),this%CGNSCornerMap(2,1),iel) + ! n2 = globalNodeIds(this%CGNSCornerMap(1,4),this%CGNSCornerMap(2,4),iel) + ! nc1 = min(n1,n2) + ! nc2 = max(n1,n2) + ! sideInfo(2,1,iel) = (nc1+nc2)*(nc1+nc2+1)/2 + nc2 + if (i == 1) then ! western most part of the tile + if (ti == 1) then ! western most tile + nedges = nedges + 1 + sideinfo(2, 4, iel) = nedges + sideinfo(3, 4, iel) = 0 ! Neigbor element (null, boundary condition) + sideinfo(4, 4, iel) = 0 ! Neighbor side id (null, boundary condition) + sideinfo(5, 4, iel) = bcids(4) ! Boundary condition id; eastern boundary set from the user input + else ! interior tile, but western most edge of the tile + e2 = nxPerTile + nxPerTile*(j - 1 + nyPerTile*(ti - 2 + nTilex*(tj - 1))) ! Neigbor element, easternnmost element in tile to the west + sideinfo(3, 4, iel) = sideInfo(2, 2, e2) ! Copy the edge id from neighbor's east edge + sideinfo(3, 4, iel) = e2 + sideinfo(4, 4, iel) = 10*2 ! Neighbor side id - neighbor to the west, east side (2) + sideinfo(5, 4, iel) = 0 ! Boundary condition id; (null, interior edge) + end if + else ! interior to the tile + e2 = i - 1 + nxPerTile*(j - 1 + nyPerTile*(ti - 1 + nTilex*(tj - 1))) ! Neigbor element, inside same tile, to the west + sideinfo(3, 4, iel) = sideInfo(2, 2, e2) ! Copy the edge id from neighbor's east edge + sideinfo(3, 4, iel) = e2 + sideinfo(4, 4, iel) = 10*2 ! Neighbor side id - neighbor to the west, east side (2) + sideinfo(5, 4, iel) = 0 ! Boundary condition id; (null, interior edge) + end if + + end do + end do + end do + end do + + call this%decomp%GenerateDecomposition(nGlobalElem, nUniqueSides) + + e1 = this%decomp%offsetElem(this%decomp%rankId + 1) + 1 + e2 = this%decomp%offsetElem(this%decomp%rankId + 2) + nLocalElems = e2 - e1 + 1 + + nLocalSides = nLocalElems*4 + nLocalNodes = nLocalElems*4 + call this%Init(nGeo, nLocalElems, nLocalSides, nLocalNodes, nBCs) + this%nUniqueSides = nUniqueSides + this%quadrature = UNIFORM + + this%nodeCoords(1:2, 1:nGeo + 1, 1:nGeo + 1, 1:nLocalElems) = nodeCoords(1:2, 1:nGeo + 1, 1:nGeo + 1, e1:e2) + this%globalNodeIDs(1:nGeo + 1, 1:nGeo + 1, 1:nLocalElems) = globalNodeIDs(1:nGeo + 1, 1:nGeo + 1, e1:e2) + this%sideInfo(1:5, 1:4, 1:nLocalElems) = sideInfo(1:5, 1:4, e1:e2) + + deallocate (nodeCoords) + deallocate (globalNodeIDs) + deallocate (sideInfo) + + call this%UpdateDevice() + + end subroutine UniformStructuredMesh_Mesh2D_t + + subroutine Read_HOPr_Mesh2D_t(this, meshFile) + ! From https://www.hopr-project.org/externals/Meshformat.pdf, Algorithm 6 + ! Adapted for 2D Mesh : Note that HOPR does not have 2D mesh output. + implicit none + class(Mesh2D_t), intent(out) :: this + character(*), intent(in) :: meshFile + ! Local + integer(HID_T) :: fileId + integer(HID_T) :: offset(1:2), gOffset(1) + integer :: nGlobalElem + integer :: firstElem + integer :: firstNode + integer :: firstSide + integer :: nLocalElems + integer :: nLocalNodes3D + integer :: nLocalSides3D + integer :: nUniqueSides3D + integer :: nLocalNodes2D + integer :: nLocalSides2D + integer :: nUniqueSides2D + integer :: nGeo, nBCs + integer :: eid, lsid, iSide + integer :: i, j, nid + integer, dimension(:, :), allocatable :: hopr_elemInfo + integer, dimension(:, :), allocatable :: hopr_sideInfo + real(prec), dimension(:, :), allocatable :: hopr_nodeCoords + integer, dimension(:), allocatable :: hopr_globalNodeIDs + integer, dimension(:, :), allocatable :: bcType + + call this%decomp%init() + + print *, __FILE__//' : Reading HOPr mesh from'//trim(meshfile) + if (this%decomp%mpiEnabled) then + call Open_HDF5(meshFile, H5F_ACC_RDONLY_F, fileId, this%decomp%mpiComm) + else + call Open_HDF5(meshFile, H5F_ACC_RDONLY_F, fileId) + end if + + print *, __FILE__//' : Loading mesh attributes' + call ReadAttribute_HDF5(fileId, 'nElems', nGlobalElem) + call ReadAttribute_HDF5(fileId, 'Ngeo', nGeo) + call ReadAttribute_HDF5(fileId, 'nBCs', nBCs) + call ReadAttribute_HDF5(fileId, 'nUniqueSides', nUniqueSides3D) + print *, __FILE__//' : N Global Elements = ', nGlobalElem + print *, __FILE__//' : Mesh geometry degree = ', nGeo + print *, __FILE__//' : N Boundary conditions = ', nBCs + print *, __FILE__//' : N Unique Sides (3D) = ', nUniqueSides3D + + ! Read BCType + allocate (bcType(1:4, 1:nBCS)) + + if (this%decomp%mpiEnabled) then + offset(:) = 0 + call ReadArray_HDF5(fileId, 'BCType', bcType, offset) + else + call ReadArray_HDF5(fileId, 'BCType', bcType) + end if + + ! Read local subarray of ElemInfo + print *, __FILE__//' : Generating Domain Decomposition' + call this%decomp%GenerateDecomposition(nGlobalElem, nUniqueSides3D) + + firstElem = this%decomp%offsetElem(this%decomp%rankId + 1) + 1 + nLocalElems = this%decomp%offsetElem(this%decomp%rankId + 2) - & + this%decomp%offsetElem(this%decomp%rankId + 1) + + print *, __FILE__//' : Rank ', this%decomp%rankId + 1, ' : element offset = ', firstElem + print *, __FILE__//' : Rank ', this%decomp%rankId + 1, ' : n_elements = ', nLocalElems + + ! Allocate Space for hopr_elemInfo! + allocate (hopr_elemInfo(1:6, 1:nLocalElems)) + + if (this%decomp%mpiEnabled) then + offset = (/0, firstElem - 1/) + call ReadArray_HDF5(fileId, 'ElemInfo', hopr_elemInfo, offset) + else + call ReadArray_HDF5(fileId, 'ElemInfo', hopr_elemInfo) + end if + + ! Read local subarray of NodeCoords and GlobalNodeIDs + firstNode = hopr_elemInfo(5, 1) + 1 + nLocalNodes3D = hopr_elemInfo(6, nLocalElems) - hopr_elemInfo(5, 1) + + ! Allocate Space for hopr_nodeCoords and hopr_globalNodeIDs ! + allocate (hopr_nodeCoords(1:3, nLocalNodes3D), hopr_globalNodeIDs(1:nLocalNodes3D)) + + if (this%decomp%mpiEnabled) then + offset = (/0, firstNode - 1/) + call ReadArray_HDF5(fileId, 'NodeCoords', hopr_nodeCoords, offset) + gOffset = (/firstNode - 1/) + call ReadArray_HDF5(fileId, 'GlobalNodeIDs', hopr_globalNodeIDs, gOffset) + else + call ReadArray_HDF5(fileId, 'NodeCoords', hopr_nodeCoords) + call ReadArray_HDF5(fileId, 'GlobalNodeIDs', hopr_globalNodeIDs) + end if + + ! Read local subarray of SideInfo + firstSide = hopr_elemInfo(3, 1) + 1 + nLocalSides3D = hopr_elemInfo(4, nLocalElems) - hopr_elemInfo(3, 1) + + ! Allocate space for hopr_sideInfo + allocate (hopr_sideInfo(1:5, 1:nLocalSides3D)) + if (this%decomp%mpiEnabled) then + offset = (/0, firstSide - 1/) + print *, __FILE__//' : Rank ', this%decomp%rankId + 1, ' Reading side information' + call ReadArray_HDF5(fileId, 'SideInfo', hopr_sideInfo, offset) + else + call ReadArray_HDF5(fileId, 'SideInfo', hopr_sideInfo) + end if + + call Close_HDF5(fileID) + ! ---- Done reading 3-D Mesh information ---- ! + + ! Now we need to convert from 3-D to 2-D ! + nLocalSides2D = nLocalSides3D - 2*nLocalElems + nUniqueSides2D = nUniqueSides3D - 2*nGlobalElem ! Remove the "top" and "bottom" faces + nLocalNodes2D = nLocalNodes2D - nLocalElems*nGeo*(nGeo + 1)**2 ! Remove the third dimension + + print *, __FILE__//' : Rank ', this%decomp%rankId + 1, ' Allocating memory for mesh' + print *, __FILE__//' : Rank ', this%decomp%rankId + 1, ' n local sides : ', nLocalSides2D + call this%Init(nGeo, nLocalElems, nLocalSides2D, nLocalNodes2D, nBCs) + this%nUniqueSides = nUniqueSides2D ! Store the number of sides in the global mesh + + ! Copy data from local arrays into this + ! elemInfo(1:6,iEl) + ! 1 - Element Type + ! 2 - Zone + ! 3 - offset index for side array (not needed when all quads are assumed) + ! 4 - last index for side array (not needed when all quads are assumed) + ! 5 - offset index for node array (not needed when all quads are assumed) + ! 6 - last index for node array (not needed when all quads are assumed) + this%elemInfo = hopr_elemInfo + this%quadrature = UNIFORM ! HOPr uses uniformly spaced points + + ! Grab the node coordinates (x and y only) from the "bottom" layer of the extruded mesh + do eid = 1, this%nElem + do j = 1, nGeo + 1 + do i = 1, nGeo + 1 + nid = i + (nGeo + 1)*(j - 1 + (nGeo + 1)*((nGeo + 1)*(eid - 1))) + this%nodeCoords(1:2, i, j, eid) = hopr_nodeCoords(1:2, nid) + this%globalNodeIDs(i, j, eid) = hopr_globalNodeIDs(nid) + end do + end do + end do + + ! Grab the south, west, north, and south sides of the elements + ! sideInfo(1:5,iSide,iEl) + ! + ! 1 - Side Type (currently unused in SELF) + ! 2 - Global Side ID (Used for message passing. Don't need to change) + ! 3 - Neighbor Element ID (Can stay the same) + ! 4 - 10*( neighbor local side ) + flip (Need to recalculate flip) + ! 5 - Boundary Condition ID (Can stay the same) + do eid = 1, this%nElem + do lsid = 1, 4 + ! Calculate the 3-D side ID from the 2-D local side id and element ID + iSide = lsid + 1 + 6*(eid - 1) + this%sideInfo(1:5, lsid, eid) = hopr_sideInfo(1:5, iSide) + ! Adjust the secondary side index for 2-D + this%sideInfo(4, lsid, eid) = this%sideInfo(4, lsid, eid) - 10 + end do + end do + call this%RecalculateFlip() + + deallocate (hopr_elemInfo, hopr_nodeCoords, hopr_globalNodeIDs, hopr_sideInfo) + + call this%UpdateDevice() + + end subroutine Read_HOPr_Mesh2D_t + + subroutine RecalculateFlip_Mesh2D_t(this) + implicit none + class(Mesh2D_t), intent(inout) :: this + ! Local + integer :: e1 + integer :: s1 + integer :: e2 + integer :: e2Global + integer :: s2 + integer :: flip + integer :: bcid + integer :: lnid1(1:2) + integer :: lnid2(1:2) + integer :: nid1(1:2, 1:4, 1:this%nElem) + integer :: nid2(1:2, 1:4, 1:this%nElem) + integer :: nloc1(1:2) + integer :: nloc2(1:2) + integer :: n1 + integer :: n1Global + integer :: n2 + integer :: n2Global + integer :: c1 + integer :: c2 + integer :: i, j + integer :: l + integer :: nShifts + integer :: neighborRank + integer :: rankId + integer :: offset + integer :: msgCount + integer :: globalSideId + integer, allocatable :: requests(:) + integer, allocatable :: stats(:, :) + integer :: iError + integer :: tag + logical :: theyMatch + + allocate (requests(1:this%nSides*2)) + allocate (stats(MPI_STATUS_SIZE, 1:this%nSides*2)) + + if (this%decomp%mpiEnabled) then + rankId = this%decomp%rankId + offset = this%decomp%offsetElem(rankId + 1) + else + rankId = 0 + offset = 0 + end if + + msgCount = 0 + do e1 = 1, this%nElem + do s1 = 1, 4 + + e2Global = this%sideInfo(3, s1, e1) + e2 = e2Global - offset + s2 = this%sideInfo(4, s1, e1)/10 + flip = this%sideInfo(4, s1, e1) - s2*10 + bcid = this%sideInfo(5, s1, e1) + + if (e2Global > 0) then + + if (this%decomp%mpiEnabled) then + neighborRank = this%decomp%elemToRank(e2Global) + else + neighborRank = 0 + end if + + if (neighborRank == rankId) then + + lnid1 = this%CGNSSideMap(1:2, s1) ! local CGNS corner node ids for element 1 side + lnid2 = this%CGNSSideMap(1:2, s2) ! local CGNS corner node ids for element 2 side + + do l = 1, 2 + + i = this%CGNSCornerMap(1, lnid1(l)) + j = this%CGNSCornerMap(2, lnid1(l)) + nid1(l, s1, e1) = this%globalNodeIDs(i, j, e1) + + i = this%CGNSCornerMap(1, lnid2(l)) + j = this%CGNSCornerMap(2, lnid2(l)) + nid2(l, s1, e1) = this%globalNodeIDs(i, j, e2) + + end do + + else ! In this case, we need to exchange + + globalSideId = abs(this%sideInfo(2, s1, e1)) + + lnid1 = this%CGNSSideMap(1:2, s1) ! local CGNS corner node ids for element 1 side + + do l = 1, 2 + + i = this%CGNSCornerMap(1, lnid1(l)) + j = this%CGNSCornerMap(2, lnid1(l)) + nid1(l, s1, e1) = this%globalNodeIDs(i, j, e1) + + tag = l + 2*globalSideId + msgCount = msgCount + 1 + call MPI_IRECV(nid2(l, s1, e1), & + 1, & + MPI_INTEGER, & + neighborRank, tag, & + this%decomp%mpiComm, & + requests(msgCount), iError) + + ! Send nid1(l) from this rank to nid2(l) on the other rank + msgCount = msgCount + 1 + call MPI_ISEND(nid1(l, s1, e1), & + 1, & + MPI_INTEGER, & + neighborRank, tag, & + this%decomp%mpiComm, & + requests(msgCount), iError) + + end do + + end if ! MPI or not + + end if ! If not physical boundary + + end do + end do + + if (this%decomp%mpiEnabled .and. msgCount > 0) then + call MPI_WaitAll(msgCount, & + requests(1:msgCount), & + stats(1:MPI_STATUS_SIZE, 1:msgCount), & + iError) + end if - do e1 = 1,this%nElem - do s1 = 1,4 - e2Global = this%sideInfo(3,s1,e1) - s2 = this%sideInfo(4,s1,e1)/10 - nloc1(1:2) = nid1(1:2,s1,e1) - nloc2(1:2) = nid2(1:2,s1,e1) + do e1 = 1, this%nElem + do s1 = 1, 4 + e2Global = this%sideInfo(3, s1, e1) + s2 = this%sideInfo(4, s1, e1)/10 + nloc1(1:2) = nid1(1:2, s1, e1) + nloc2(1:2) = nid2(1:2, s1, e1) - if(e2Global > 0) then - theyMatch = CompareArray(nloc1,nloc2,2) + if (e2Global > 0) then + theyMatch = CompareArray(nloc1, nloc2, 2) - if(theyMatch) then - this%sideInfo(4,s1,e1) = 10*s2 - else - this%sideInfo(4,s1,e1) = 10*s2+1 - endif + if (theyMatch) then + this%sideInfo(4, s1, e1) = 10*s2 + else + this%sideInfo(4, s1, e1) = 10*s2 + 1 + end if - endif + end if - enddo - enddo + end do + end do - deallocate(requests) - deallocate(stats) + deallocate (requests) + deallocate (stats) - endsubroutine RecalculateFlip_Mesh2D_t + end subroutine RecalculateFlip_Mesh2D_t - subroutine Write_Mesh2D_t(this,meshFile) - ! Writes mesh output in HOPR format (serial only) - implicit none - class(Mesh2D_t),intent(inout) :: this - character(*),intent(in) :: meshFile - ! Local - integer(HID_T) :: fileId + subroutine Write_Mesh2D_t(this, meshFile) + ! Writes mesh output in HOPR format (serial only) + implicit none + class(Mesh2D_t), intent(inout) :: this + character(*), intent(in) :: meshFile + ! Local + integer(HID_T) :: fileId - call Open_HDF5(meshFile,H5F_ACC_RDWR_F,fileId) - call WriteAttribute_HDF5(fileId,'nElems',this%nElem) - call WriteAttribute_HDF5(fileId,'Ngeo',this%nGeo) - call WriteAttribute_HDF5(fileId,'nBCs',this%nBCs) + call Open_HDF5(meshFile, H5F_ACC_RDWR_F, fileId) + call WriteAttribute_HDF5(fileId, 'nElems', this%nElem) + call WriteAttribute_HDF5(fileId, 'Ngeo', this%nGeo) + call WriteAttribute_HDF5(fileId, 'nBCs', this%nBCs) - call WriteArray_HDF5(fileId,'BCType',this%bcType) + call WriteArray_HDF5(fileId, 'BCType', this%bcType) - ! Write local subarray of ElemInfo - call WriteArray_HDF5(fileId,'ElemInfo',this%elemInfo) + ! Write local subarray of ElemInfo + call WriteArray_HDF5(fileId, 'ElemInfo', this%elemInfo) - ! Write local subarray of NodeCoords and GlobalNodeIDs - call WriteArray_HDF5(fileId,'NodeCoords',this%nodeCoords) - call WriteArray_HDF5(fileId,'GlobalNodeIDs',this%globalNodeIDs) + ! Write local subarray of NodeCoords and GlobalNodeIDs + call WriteArray_HDF5(fileId, 'NodeCoords', this%nodeCoords) + call WriteArray_HDF5(fileId, 'GlobalNodeIDs', this%globalNodeIDs) - ! Write local subarray of SideInfo - call WriteArray_HDF5(fileId,'SideInfo',this%sideInfo) + ! Write local subarray of SideInfo + call WriteArray_HDF5(fileId, 'SideInfo', this%sideInfo) - call Close_HDF5(fileID) + call Close_HDF5(fileID) - endsubroutine Write_Mesh2D_t + end subroutine Write_Mesh2D_t -endmodule SELF_Mesh_2D_t +end module SELF_Mesh_2D_t diff --git a/src/SELF_Mesh_3D_t.f90 b/src/SELF_Mesh_3D_t.f90 index dddc19aa3..b97c694a6 100644 --- a/src/SELF_Mesh_3D_t.f90 +++ b/src/SELF_Mesh_3D_t.f90 @@ -26,19 +26,19 @@ module SELF_Mesh_3D_t - use SELF_Constants - use SELF_Lagrange - use SELF_SupportRoutines - use SELF_HDF5 - use SELF_Mesh - use SELF_DomainDecomposition + use SELF_Constants + use SELF_Lagrange + use SELF_SupportRoutines + use SELF_HDF5 + use SELF_Mesh + use SELF_DomainDecomposition - ! External Libs ! - use HDF5 + ! External Libs ! + use HDF5 - use iso_c_binding + use iso_c_binding - implicit none + implicit none #include "SELF_Macros.h" ! ========================================================================= ! @@ -96,257 +96,257 @@ module SELF_Mesh_3D_t ! ! ========================================================================= ! - ! Side Ordering - integer,parameter :: selfSide3D_Bottom = 1 - integer,parameter :: selfSide3D_South = 2 - integer,parameter :: selfSide3D_East = 3 - integer,parameter :: selfSide3D_North = 4 - integer,parameter :: selfSide3D_West = 5 - integer,parameter :: selfSide3D_Top = 6 - - type,extends(SEMMesh) :: Mesh3D_t - integer,pointer,dimension(:,:,:) :: sideInfo - real(prec),pointer,dimension(:,:,:,:,:) :: nodeCoords - integer,pointer,dimension(:,:) :: elemInfo - integer,pointer,dimension(:,:,:,:) :: globalNodeIDs - integer,pointer,dimension(:,:) :: CGNSCornerMap - integer,pointer,dimension(:,:) :: sideMap - integer,pointer,dimension(:,:) :: CGNSSideMap - integer,pointer,dimension(:,:) :: BCType - character(LEN=255),allocatable :: BCNames(:) - - contains - - procedure,public :: Init => Init_Mesh3D_t - procedure,public :: Free => Free_Mesh3D_t - procedure,public :: UpdateDevice => UpdateDevice_Mesh3D_t - - generic,public :: StructuredMesh => UniformStructuredMesh_Mesh3D_t - procedure,private :: UniformStructuredMesh_Mesh3D_t - - procedure,public :: Read_HOPr => Read_HOPr_Mesh3D_t - - procedure,public :: ResetBoundaryConditionType => ResetBoundaryConditionType_Mesh3D_t - - procedure,public :: Write_Mesh => Write_Mesh3D_t - - procedure,public :: RecalculateFlip => RecalculateFlip_Mesh3D_t - - endtype Mesh3D_t - - integer,private :: CGNStoSELFflip(1:6,1:6,1:4) - - ! This table maps the primary side, secondary side, and CGNS flip values - ! to indexing flips that are used in SELF. - ! This table is used after reading in HOPr mesh information in "RecalculateFlip" - ! SELF's flip indices correspond to the following scenarios - ! - ! 0 i2 = i1 j2 = j1 - ! 1 i2 = N-i1 j2 = j1 - ! 2 i2 = N-i1 j2 = N-j1 - ! 3 i2 = i1 j2 = N-j1 - ! 4 i2 = j1 j2 = i1 - ! 5 i2 = N-j1 j2 = i1 - ! 6 i2 = N-j1 j2 = N-i1 - ! 7 i2 = j1 j2 = N-i1 - ! - data CGNStoSELFflip/ & - 4,0,0,1,4,0, & - 0,4,4,5,0,4, & - 0,4,4,5,0,4, & - 1,7,7,6,1,7, & - 4,0,0,1,4,0, & - 0,4,4,5,0,4, & - 3,5,5,4,3,5, & - 7,1,1,0,7,1, & - 7,1,1,0,7,1, & - 4,0,0,1,4,0, & - 3,5,5,4,3,5, & - 7,1,1,0,7,1, & - 6,2,2,3,6,2, & - 2,6,6,7,2,6, & - 2,6,6,7,2,6, & - 3,5,5,4,3,5, & - 6,2,2,3,6,2, & - 2,6,6,7,2,6, & - 1,7,7,6,1,7, & - 5,3,3,2,5,3, & - 5,3,3,2,5,3, & - 6,2,2,3,6,2, & - 1,7,7,6,1,7, & - 5,3,3,2,5,3/ + ! Side Ordering + integer, parameter :: selfSide3D_Bottom = 1 + integer, parameter :: selfSide3D_South = 2 + integer, parameter :: selfSide3D_East = 3 + integer, parameter :: selfSide3D_North = 4 + integer, parameter :: selfSide3D_West = 5 + integer, parameter :: selfSide3D_Top = 6 + + type, extends(SEMMesh) :: Mesh3D_t + integer, pointer, dimension(:, :, :) :: sideInfo + real(prec), pointer, dimension(:, :, :, :, :) :: nodeCoords + integer, pointer, dimension(:, :) :: elemInfo + integer, pointer, dimension(:, :, :, :) :: globalNodeIDs + integer, pointer, dimension(:, :) :: CGNSCornerMap + integer, pointer, dimension(:, :) :: sideMap + integer, pointer, dimension(:, :) :: CGNSSideMap + integer, pointer, dimension(:, :) :: BCType + character(LEN=255), allocatable :: BCNames(:) + + contains + + procedure, public :: Init => Init_Mesh3D_t + procedure, public :: Free => Free_Mesh3D_t + procedure, public :: UpdateDevice => UpdateDevice_Mesh3D_t + + generic, public :: StructuredMesh => UniformStructuredMesh_Mesh3D_t + procedure, private :: UniformStructuredMesh_Mesh3D_t + + procedure, public :: Read_HOPr => Read_HOPr_Mesh3D_t + + procedure, public :: ResetBoundaryConditionType => ResetBoundaryConditionType_Mesh3D_t + + procedure, public :: Write_Mesh => Write_Mesh3D_t + + procedure, public :: RecalculateFlip => RecalculateFlip_Mesh3D_t + + end type Mesh3D_t + + integer, private :: CGNStoSELFflip(1:6, 1:6, 1:4) + + ! This table maps the primary side, secondary side, and CGNS flip values + ! to indexing flips that are used in SELF. + ! This table is used after reading in HOPr mesh information in "RecalculateFlip" + ! SELF's flip indices correspond to the following scenarios + ! + ! 0 i2 = i1 j2 = j1 + ! 1 i2 = N-i1 j2 = j1 + ! 2 i2 = N-i1 j2 = N-j1 + ! 3 i2 = i1 j2 = N-j1 + ! 4 i2 = j1 j2 = i1 + ! 5 i2 = N-j1 j2 = i1 + ! 6 i2 = N-j1 j2 = N-i1 + ! 7 i2 = j1 j2 = N-i1 + ! + data CGNStoSELFflip/ & + 4, 0, 0, 1, 4, 0, & + 0, 4, 4, 5, 0, 4, & + 0, 4, 4, 5, 0, 4, & + 1, 7, 7, 6, 1, 7, & + 4, 0, 0, 1, 4, 0, & + 0, 4, 4, 5, 0, 4, & + 3, 5, 5, 4, 3, 5, & + 7, 1, 1, 0, 7, 1, & + 7, 1, 1, 0, 7, 1, & + 4, 0, 0, 1, 4, 0, & + 3, 5, 5, 4, 3, 5, & + 7, 1, 1, 0, 7, 1, & + 6, 2, 2, 3, 6, 2, & + 2, 6, 6, 7, 2, 6, & + 2, 6, 6, 7, 2, 6, & + 3, 5, 5, 4, 3, 5, & + 6, 2, 2, 3, 6, 2, & + 2, 6, 6, 7, 2, 6, & + 1, 7, 7, 6, 1, 7, & + 5, 3, 3, 2, 5, 3, & + 5, 3, 3, 2, 5, 3, & + 6, 2, 2, 3, 6, 2, & + 1, 7, 7, 6, 1, 7, & + 5, 3, 3, 2, 5, 3/ contains - subroutine Init_Mesh3D_t(this,nGeo,nElem,nSides,nNodes,nBCs) - implicit none - class(Mesh3D_t),intent(inout) :: this - integer,intent(in) :: nGeo - integer,intent(in) :: nElem - integer,intent(in) :: nSides - integer,intent(in) :: nNodes - integer,intent(in) :: nBCs - ! Local - integer :: i,j,k,l - - this%nElem = nElem - this%nGlobalElem = nElem - this%nGeo = nGeo - this%nSides = nSides - this%nNodes = nNodes - this%nCornerNodes = 0 - this%nUniqueSides = 0 - this%nUniqueNodes = 0 - this%nBCs = nBCs - - allocate(this%elemInfo(1:6,1:nElem)) - allocate(this%sideInfo(1:5,1:6,1:nElem)) - allocate(this%nodeCoords(1:3,1:nGeo+1,1:nGeo+1,1:nGeo+1,1:nElem)) - allocate(this%globalNodeIDs(1:nGeo+1,1:nGeo+1,1:nGeo+1,1:nElem)) - allocate(this%CGNSCornerMap(1:3,1:8)) - allocate(this%CGNSSideMap(1:4,1:6)) - allocate(this%sideMap(1:4,1:6)) - allocate(this%BCType(1:4,1:nBCs)) - - allocate(this%BCNames(1:nBCs)) - - ! Create lookup tables to assist with connectivity generation - this%CGNSCornerMap(1:3,1) = (/1,1,1/) ! Bottom-South-West - this%CGNSCornerMap(1:3,2) = (/nGeo+1,1,1/) ! Bottom-South-East - this%CGNSCornerMap(1:3,3) = (/nGeo+1,nGeo+1,1/) ! Bottom-North-East - this%CGNSCornerMap(1:3,4) = (/1,nGeo+1,1/) ! Bottom-North-West - this%CGNSCornerMap(1:3,5) = (/1,1,nGeo+1/) ! Top-South-West - this%CGNSCornerMap(1:3,6) = (/nGeo+1,1,nGeo+1/) ! Top-South-East - this%CGNSCornerMap(1:3,7) = (/nGeo+1,nGeo+1,nGeo+1/) ! Top-North-East - this%CGNSCornerMap(1:3,8) = (/1,nGeo+1,nGeo+1/) ! Top-North-West - - ! Maps from local corner node id to CGNS side - this%CGNSSideMap(1:4,1) = (/1,4,3,2/) - this%CGNSSideMap(1:4,2) = (/1,2,6,5/) - this%CGNSSideMap(1:4,3) = (/2,3,7,6/) - this%CGNSSideMap(1:4,4) = (/3,4,8,7/) - this%CGNSSideMap(1:4,5) = (/1,5,8,4/) - this%CGNSSideMap(1:4,6) = (/5,6,7,8/) - - ! Sidemap traverses each face so that the normal - ! formed by the right hand rule is the coordinate - ! positive pointing normal. For east,north,and top - ! this is an outward facing normal. - ! For bottom, south, and west, the normal is inward - ! facing. - this%sideMap(1:4,1) = (/1,2,3,4/) ! Bottom - this%sideMap(1:4,2) = (/1,2,6,5/) ! South - this%sideMap(1:4,3) = (/2,3,7,6/) ! East - this%sideMap(1:4,4) = (/4,3,7,8/) ! North - this%sideMap(1:4,5) = (/1,4,8,5/) ! West - this%sideMap(1:4,6) = (/5,6,7,8/) ! Top - - endsubroutine Init_Mesh3D_t - - subroutine Free_Mesh3D_t(this) - implicit none - class(Mesh3D_t),intent(inout) :: this - - this%nElem = 0 - this%nSides = 0 - this%nNodes = 0 - this%nCornerNodes = 0 - this%nUniqueSides = 0 - this%nUniqueNodes = 0 - this%nBCs = 0 - - deallocate(this%elemInfo) - deallocate(this%sideInfo) - deallocate(this%nodeCoords) - deallocate(this%globalNodeIDs) - deallocate(this%CGNSCornerMap) - deallocate(this%sideMap) - deallocate(this%CGNSSideMap) - deallocate(this%BCType) - - deallocate(this%BCNames) - call this%decomp%Free() - - endsubroutine Free_Mesh3D_t - - subroutine UpdateDevice_Mesh3D_t(this) - implicit none - class(Mesh3D_t),intent(inout) :: this - - return - - endsubroutine UpdateDevice_Mesh3D_t - - subroutine ResetBoundaryConditionType_Mesh3D_t(this,bcid) + subroutine Init_Mesh3D_t(this, nGeo, nElem, nSides, nNodes, nBCs) + implicit none + class(Mesh3D_t), intent(inout) :: this + integer, intent(in) :: nGeo + integer, intent(in) :: nElem + integer, intent(in) :: nSides + integer, intent(in) :: nNodes + integer, intent(in) :: nBCs + ! Local + integer :: i, j, k, l + + this%nElem = nElem + this%nGlobalElem = nElem + this%nGeo = nGeo + this%nSides = nSides + this%nNodes = nNodes + this%nCornerNodes = 0 + this%nUniqueSides = 0 + this%nUniqueNodes = 0 + this%nBCs = nBCs + + allocate (this%elemInfo(1:6, 1:nElem)) + allocate (this%sideInfo(1:5, 1:6, 1:nElem)) + allocate (this%nodeCoords(1:3, 1:nGeo + 1, 1:nGeo + 1, 1:nGeo + 1, 1:nElem)) + allocate (this%globalNodeIDs(1:nGeo + 1, 1:nGeo + 1, 1:nGeo + 1, 1:nElem)) + allocate (this%CGNSCornerMap(1:3, 1:8)) + allocate (this%CGNSSideMap(1:4, 1:6)) + allocate (this%sideMap(1:4, 1:6)) + allocate (this%BCType(1:4, 1:nBCs)) + + allocate (this%BCNames(1:nBCs)) + + ! Create lookup tables to assist with connectivity generation + this%CGNSCornerMap(1:3, 1) = (/1, 1, 1/) ! Bottom-South-West + this%CGNSCornerMap(1:3, 2) = (/nGeo + 1, 1, 1/) ! Bottom-South-East + this%CGNSCornerMap(1:3, 3) = (/nGeo + 1, nGeo + 1, 1/) ! Bottom-North-East + this%CGNSCornerMap(1:3, 4) = (/1, nGeo + 1, 1/) ! Bottom-North-West + this%CGNSCornerMap(1:3, 5) = (/1, 1, nGeo + 1/) ! Top-South-West + this%CGNSCornerMap(1:3, 6) = (/nGeo + 1, 1, nGeo + 1/) ! Top-South-East + this%CGNSCornerMap(1:3, 7) = (/nGeo + 1, nGeo + 1, nGeo + 1/) ! Top-North-East + this%CGNSCornerMap(1:3, 8) = (/1, nGeo + 1, nGeo + 1/) ! Top-North-West + + ! Maps from local corner node id to CGNS side + this%CGNSSideMap(1:4, 1) = (/1, 4, 3, 2/) + this%CGNSSideMap(1:4, 2) = (/1, 2, 6, 5/) + this%CGNSSideMap(1:4, 3) = (/2, 3, 7, 6/) + this%CGNSSideMap(1:4, 4) = (/3, 4, 8, 7/) + this%CGNSSideMap(1:4, 5) = (/1, 5, 8, 4/) + this%CGNSSideMap(1:4, 6) = (/5, 6, 7, 8/) + + ! Sidemap traverses each face so that the normal + ! formed by the right hand rule is the coordinate + ! positive pointing normal. For east,north,and top + ! this is an outward facing normal. + ! For bottom, south, and west, the normal is inward + ! facing. + this%sideMap(1:4, 1) = (/1, 2, 3, 4/) ! Bottom + this%sideMap(1:4, 2) = (/1, 2, 6, 5/) ! South + this%sideMap(1:4, 3) = (/2, 3, 7, 6/) ! East + this%sideMap(1:4, 4) = (/4, 3, 7, 8/) ! North + this%sideMap(1:4, 5) = (/1, 4, 8, 5/) ! West + this%sideMap(1:4, 6) = (/5, 6, 7, 8/) ! Top + + end subroutine Init_Mesh3D_t + + subroutine Free_Mesh3D_t(this) + implicit none + class(Mesh3D_t), intent(inout) :: this + + this%nElem = 0 + this%nSides = 0 + this%nNodes = 0 + this%nCornerNodes = 0 + this%nUniqueSides = 0 + this%nUniqueNodes = 0 + this%nBCs = 0 + + deallocate (this%elemInfo) + deallocate (this%sideInfo) + deallocate (this%nodeCoords) + deallocate (this%globalNodeIDs) + deallocate (this%CGNSCornerMap) + deallocate (this%sideMap) + deallocate (this%CGNSSideMap) + deallocate (this%BCType) + + deallocate (this%BCNames) + call this%decomp%Free() + + end subroutine Free_Mesh3D_t + + subroutine UpdateDevice_Mesh3D_t(this) + implicit none + class(Mesh3D_t), intent(inout) :: this + + return + + end subroutine UpdateDevice_Mesh3D_t + + subroutine ResetBoundaryConditionType_Mesh3D_t(this, bcid) !! This method can be used to reset all of the boundary elements !! boundary condition type to the desired value. !! !! Note that ALL physical boundaries will be set to have this boundary !! condition - implicit none - class(Mesh3D_t),intent(inout) :: this - integer,intent(in) :: bcid - ! Local - integer :: iSide,iEl,e2 + implicit none + class(Mesh3D_t), intent(inout) :: this + integer, intent(in) :: bcid + ! Local + integer :: iSide, iEl, e2 - do iEl = 1,this%nElem - do iSide = 1,6 + do iEl = 1, this%nElem + do iSide = 1, 6 - e2 = this%sideInfo(3,iSide,iEl) + e2 = this%sideInfo(3, iSide, iEl) - if(e2 == 0) then - this%sideInfo(5,iSide,iEl) = bcid - endif + if (e2 == 0) then + this%sideInfo(5, iSide, iEl) = bcid + end if - enddo - enddo + end do + end do - endsubroutine ResetBoundaryConditionType_Mesh3D_t + end subroutine ResetBoundaryConditionType_Mesh3D_t - subroutine RecalculateFlip_Mesh3D_t(this) - implicit none - class(Mesh3D_t),intent(inout) :: this - ! Local - integer :: e1 - integer :: s1 - integer :: e2 - integer :: s2 - integer :: cgnsFlip,selfFlip + subroutine RecalculateFlip_Mesh3D_t(this) + implicit none + class(Mesh3D_t), intent(inout) :: this + ! Local + integer :: e1 + integer :: s1 + integer :: e2 + integer :: s2 + integer :: cgnsFlip, selfFlip - do e1 = 1,this%nElem - do s1 = 1,6 + do e1 = 1, this%nElem + do s1 = 1, 6 - e2 = this%sideInfo(3,s1,e1) - s2 = this%sideInfo(4,s1,e1)/10 - cgnsFlip = this%sideInfo(4,s1,e1)-s2*10 + e2 = this%sideInfo(3, s1, e1) + s2 = this%sideInfo(4, s1, e1)/10 + cgnsFlip = this%sideInfo(4, s1, e1) - s2*10 - if(e2 /= 0) then + if (e2 /= 0) then - selfFlip = CGNStoSELFflip(s2,s1,cgnsFlip) - this%sideInfo(4,s1,e1) = 10*s2+selfFlip + selfFlip = CGNStoSELFflip(s2, s1, cgnsFlip) + this%sideInfo(4, s1, e1) = 10*s2 + selfFlip - endif + end if - enddo - enddo + end do + end do - endsubroutine RecalculateFlip_Mesh3D_t + end subroutine RecalculateFlip_Mesh3D_t - pure function elementid(i,j,k,ti,tj,tk,nxpertile,nypertile,nzpertile, & - ntilex,ntiley,ntilez) result(eid) - integer,intent(in) :: i,j,k - integer,intent(in) :: ti,tj,tk - integer,intent(in) :: nxpertile,nypertile,nzpertile - integer,intent(in) :: ntilex,ntiley,ntilez - integer :: eid + pure function elementid(i, j, k, ti, tj, tk, nxpertile, nypertile, nzpertile, & + ntilex, ntiley, ntilez) result(eid) + integer, intent(in) :: i, j, k + integer, intent(in) :: ti, tj, tk + integer, intent(in) :: nxpertile, nypertile, nzpertile + integer, intent(in) :: ntilex, ntiley, ntilez + integer :: eid - eid = i+nxpertile*(j-1+nypertile*(k-1+nzpertile*( & - ti-1+ntilex*(tj-1+ntiley*(tk-1))))) + eid = i + nxpertile*(j - 1 + nypertile*(k - 1 + nzpertile*( & + ti - 1 + ntilex*(tj - 1 + ntiley*(tk - 1))))) - endfunction elementid + end function elementid - subroutine UniformStructuredMesh_Mesh3D_t(this,nxPerTile,nyPerTile,nzPerTile, & - nTileX,nTileY,nTileZ,dx,dy,dz,bcids,enableDomainDecomposition) + subroutine UniformStructuredMesh_Mesh3D_t(this, nxPerTile, nyPerTile, nzPerTile, & + nTileX, nTileY, nTileZ, dx, dy, dz, bcids) !! !! Create a structured mesh and store it in SELF's unstructured mesh format. !! The mesh is created in tiles of size (tnx,tny,tnz). Tiling is used to determine @@ -376,494 +376,485 @@ subroutine UniformStructuredMesh_Mesh3D_t(this,nxPerTile,nyPerTile,nzPerTile, & !! Length of the domain in the x-direction is Lx = dx*nX !! Length of the domain in the y-direction is Ly = dy*nY !! - implicit none - class(Mesh3D_t),intent(out) :: this - integer,intent(in) :: nxPerTile - integer,intent(in) :: nyPerTile - integer,intent(in) :: nzPerTile - integer,intent(in) :: nTileX - integer,intent(in) :: nTileY - integer,intent(in) :: nTileZ - real(prec),intent(in) :: dx - real(prec),intent(in) :: dy - real(prec),intent(in) :: dz - integer,intent(in) :: bcids(1:6) - logical,optional,intent(in) :: enableDomainDecomposition - ! Local - integer :: nX,nY,nZ,nGeo,nBCs - integer :: nGlobalElem - integer :: nUniqueSides - integer :: nUniqueNodes - integer :: nLocalElems - integer :: nLocalSides - integer :: nLocalNodes - real(prec),allocatable :: nodeCoords(:,:,:,:,:) - integer,allocatable :: globalNodeIDs(:,:,:,:) - integer,allocatable :: sideInfo(:,:,:) - integer :: i,j,k,ti,tj,tk - integer :: ix,iy,iz,iel - integer :: ni,nj,nk - integer :: e1,e2,s1,s2 - integer :: nfaces - - if(present(enableDomainDecomposition)) then - call this%decomp%init(enableDomainDecomposition) - else - call this%decomp%init(.false.) - endif - nX = nTileX*nxPerTile - nY = nTileY*nyPerTile - nZ = nTileZ*nzPerTile - nGeo = 1 ! Force the geometry to be linear - nBCs = 6 ! Force the number of boundary conditions to 4 - - nGlobalElem = nX*nY*nZ - nUniqueSides = (nX+1)*nY*nZ+(nY+1)*nX*nZ+(nZ+1)*nX*nY - nUniqueNodes = (nX+1)*(nY+1)*(nZ+1) - - allocate(nodeCoords(1:3,1:nGeo+1,1:nGeo+1,1:nGeo+1,1:nGlobalElem)) - allocate(globalNodeIDs(1:nGeo+1,1:nGeo+1,1:nGeo+1,1:nGlobalElem)) - allocate(sideInfo(1:5,1:6,1:nGlobalElem)) - - do tk = 1,nTileZ - do tj = 1,nTileY - do ti = 1,nTileX - do k = 1,nzPerTile - iz = k+nzPerTile*(tk-1) - do j = 1,nyPerTile - iy = j+nyPerTile*(tj-1) - do i = 1,nxPerTile - - iel = elementid(i,j,k,ti,tj,tk, & - nxpertile,nypertile,nzpertile, & - ntilex,ntiley,ntilez) - ix = i+nxPerTile*(ti-1) - - do nk = 1,nGeo+1 - do nj = 1,nGeo+1 - do ni = 1,nGeo+1 - nodeCoords(1,ni,nj,nk,iel) = real(ni-1+ix-1,prec)*dx - nodeCoords(2,ni,nj,nk,iel) = real(nj-1+iy-1,prec)*dy - nodeCoords(3,ni,nj,nk,iel) = real(nk-1+iz-1,prec)*dz - globalNodeIDs(ni,nj,nk,iel) = ni-1+i+(nxPerTile+1)*( & - nj-1+j-1+(nyPerTile+1)*( & - nk-1+k-1+(nzPerTile+1)*( & - (ti-1+nTileX*( & - tj-1+nTileY*(tk-1)))))) - enddo - enddo - enddo - - enddo - enddo - enddo - enddo - enddo - enddo - - ! Fill in face information - ! sideInfo(1:5,iSide,iEl) - ! 1 - Side Type (currently unused in SELF) - ! 2 - Global Side ID (Used for message passing) - ! 3 - Neighbor Element ID - ! 4 - 10*( neighbor local side ) + flip - ! 5 - Boundary Condition ID - nfaces = 0 - do tk = 1,nTileZ - do tj = 1,nTileY - do ti = 1,nTileX - do k = 1,nzPerTile - do j = 1,nyPerTile - do i = 1,nxPerTile - - iel = elementid(i,j,k,ti,tj,tk, & - nxpertile,nypertile,nzpertile, & - ntilex,ntiley,ntilez) - ! bottom, iside=1 - s1 = 1 - s2 = 6 - if(k == 1) then ! bottom most part of the tile - if(tk == 1) then ! bottom most tile - nfaces = nfaces+1 - sideinfo(2,s1,iel) = nfaces - sideinfo(3,s1,iel) = 0 ! Neigbor element (null, boundary condition) - sideinfo(4,s1,iel) = 0 ! Neighbor side id (null, boundary condition) - sideinfo(5,s1,iel) = bcids(s1) ! Boundary condition id; set from the user input - else ! interior tile - !neighbor element is the top most element in the tile beneath - e2 = elementid(i,j,nzpertile,ti,tj,tk-1, & - nxpertile,nypertile,nzpertile, & - ntilex,ntiley,ntilez) - - sideinfo(2,s1,iel) = sideInfo(2,s2,e2) ! Copy the face id from neighbor - sideinfo(3,s1,iel) = e2 - sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id - sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) - endif - else ! interior to the tile - !neighbor element is in the same tile, but beneath - e2 = elementid(i,j,k-1,ti,tj,tk, & - nxpertile,nypertile,nzpertile, & - ntilex,ntiley,ntilez) - - sideinfo(2,s1,iel) = sideInfo(2,s2,e2) ! Copy the face id from neighbor - sideinfo(3,s1,iel) = e2 - sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id - sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) - endif - - ! south, iside=2 - s1 = 2 - s2 = 4 ! Neighbor side is north (4) - if(j == 1) then ! southern most part of the tile - if(tj == 1) then ! southern most tile - nfaces = nfaces+1 - sideinfo(2,s1,iel) = nfaces - sideinfo(3,s1,iel) = 0 ! Neigbor element (null, boundary condition) - sideinfo(4,s1,iel) = 0 ! Neighbor side id (null, boundary condition) - sideinfo(5,s1,iel) = bcids(s1) ! Boundary condition id; eastern boundary set from the user input - else ! interior tile - !neighbor element is northernmost element in the tile to the south - e2 = elementid(i,nypertile,k,ti,tj-1,tk, & - nxpertile,nypertile,nzpertile, & - ntilex,ntiley,ntilez) - - sideinfo(2,s1,iel) = sideInfo(2,s2,e2) ! Copy the face id from neighbor - sideinfo(3,s1,iel) = e2 ! Neigbor element - sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id - sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) - endif - else ! interior to the tile - !neighbor element is in the same tile, to the south - e2 = elementid(i,j-1,k,ti,tj,tk, & - nxpertile,nypertile,nzpertile, & - ntilex,ntiley,ntilez) - - sideinfo(2,s1,iel) = sideInfo(2,s2,e2) ! Copy the face id from neighbor - sideinfo(3,s1,iel) = e2 ! Neigbor element - sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id - sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) - endif - - ! east, iside=3 - s1 = 3 - s2 = 5 ! neighbor side id is west (5) - ! East faces are always new faces, due to the way we are traversing the grid - nfaces = nfaces+1 - sideinfo(2,s1,iel) = nfaces - if(i == nxPerTile) then ! eastern most part of the tile - if(ti == nTileX) then ! eastern most tile - sideinfo(3,s1,iel) = 0 ! Neigbor element (null, boundary condition) - sideinfo(4,s1,iel) = 0 ! Neighbor side id (null, boundary condition) - sideinfo(5,s1,iel) = bcids(s1) ! Boundary condition id; - else ! interior tile - !neighbor element is westernmost element in tile to the east - e2 = elementid(1,j,k,ti+1,tj,tk, & - nxpertile,nypertile,nzpertile, & - ntilex,ntiley,ntilez) - sideinfo(3,s1,iel) = e2 ! Neigbor element - sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id - sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) - endif - else ! interior to the tile - !neighbor element is in the same tile, to the east - e2 = elementid(i+1,j,k,ti,tj,tk, & - nxpertile,nypertile,nzpertile, & - ntilex,ntiley,ntilez) - sideinfo(3,s1,iel) = e2 ! Neigbor element - sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id - sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) - endif - - ! north, iside=4 - s1 = 4 - s2 = 2 ! neighbor side is south (2) - ! North faces are always new faces, due to the way we are traversing the grid - nfaces = nfaces+1 - sideinfo(2,s1,iel) = nfaces - if(j == nyPerTile) then ! northern most part of the tile - if(tj == nTileY) then ! northern most tile - sideinfo(3,s1,iel) = 0 ! Neigbor element (null, boundary condition) - sideinfo(4,s1,iel) = 0 ! Neighbor side id (null, boundary condition) - sideinfo(5,s1,iel) = bcids(s1) ! Boundary condition id; set from the user input - else ! interior tile, but northern most face of the tile - !neighbor element is the southernmost element in the tile to the north - e2 = elementid(i,1,k,ti,tj+1,tk, & - nxpertile,nypertile,nzpertile, & - ntilex,ntiley,ntilez) - sideinfo(3,s1,iel) = e2 ! Neigbor element - sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id - sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) - endif - else ! interior to the tile - !neighbor element is the tile to the north - e2 = elementid(i,j+1,k,ti,tj,tk, & - nxpertile,nypertile,nzpertile, & - ntilex,ntiley,ntilez) - sideinfo(3,s1,iel) = e2 ! Neigbor element - sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id - sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) - endif - - ! west, iside=5 - s1 = 5 - s2 = 3 ! neighbor side id is east (3) - if(i == 1) then ! western most part of the tile - if(ti == 1) then ! western most tile - nfaces = nfaces+1 - sideinfo(2,s1,iel) = nfaces - sideinfo(3,s1,iel) = 0 ! Neigbor element (null, boundary condition) - sideinfo(4,s1,iel) = 0 ! Neighbor side id (null, boundary condition) - sideinfo(5,s1,iel) = bcids(s1) ! Boundary condition id - else ! interior tile, but western most face of the tile - !neighbor element is the easternmost element in the tile to the west - e2 = elementid(nxperTile,j,k,ti-1,tj,tk, & - nxpertile,nypertile,nzpertile, & - ntilex,ntiley,ntilez) - - sideinfo(2,s1,iel) = sideInfo(2,s2,e2) ! Copy the face id from neighbor's east face - sideinfo(3,s1,iel) = e2 - sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id - neighbor to the west, east side (2) - sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) - endif - else ! interior to the tile - !neighbor element is the element to the west in the same tile - e2 = elementid(i-1,j,k,ti,tj,tk, & - nxpertile,nypertile,nzpertile, & - ntilex,ntiley,ntilez) - - sideinfo(2,s1,iel) = sideInfo(2,s2,e2) ! Copy the face id from neighbor's east face - sideinfo(3,s1,iel) = e2 - sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id - neighbor to the west, east side (2) - sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) - endif - - ! top, iside=6 - s1 = 6 - s2 = 1 ! neighbor side is bottom (1) - ! Top faces are always new faces, due to the way we are traversing the grid - nfaces = nfaces+1 - sideinfo(2,s1,iel) = nfaces - if(k == nzPerTile) then ! top most part of the tile - if(tk == nTileZ) then ! top most tile - sideinfo(3,s1,iel) = 0 ! Neigbor element (null, boundary condition) - sideinfo(4,s1,iel) = 0 ! Neighbor side id (null, boundary condition) - sideinfo(5,s1,iel) = bcids(s1) ! Boundary condition id; set from the user input - else ! interior tile, but top most face of the tile - !neighbor element is the bottom-most element in the tile above - e2 = elementid(i,j,1,ti,tj,tk+1, & - nxpertile,nypertile,nzpertile, & - ntilex,ntiley,ntilez) - sideinfo(3,s1,iel) = e2 ! Neigbor element - sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id - sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) - endif - else ! interior to the tile - !neighbor element is the tile above - e2 = elementid(i,j,k+1,ti,tj,tk, & - nxpertile,nypertile,nzpertile, & - ntilex,ntiley,ntilez) - sideinfo(3,s1,iel) = e2 ! Neigbor element, inside same tile, to the north - sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id - neighbor to the north, south side (1) - sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) - endif - - enddo - enddo - enddo - enddo - enddo - enddo - - call this%decomp%GenerateDecomposition(nGlobalElem,nUniqueSides) - - e1 = this%decomp%offsetElem(this%decomp%rankId+1)+1 - e2 = this%decomp%offsetElem(this%decomp%rankId+2) - nLocalElems = e2-e1+1 - - nLocalSides = nLocalElems*6 - nLocalNodes = nLocalElems*8 - call this%Init(nGeo,nLocalElems,nLocalSides,nLocalNodes,nBCs) - this%nUniqueSides = nUniqueSides - this%quadrature = UNIFORM - - this%nodeCoords(1:3,1:nGeo+1,1:nGeo+1,1:nGeo+1,1:nLocalElems) = nodeCoords(1:3,1:nGeo+1,1:nGeo+1,1:nGeo+1,e1:e2) - this%globalNodeIDs(1:nGeo+1,1:nGeo+1,1:nGeo+1,1:nLocalElems) = globalNodeIDs(1:nGeo+1,1:nGeo+1,1:nGeo+1,e1:e2) - this%sideInfo(1:5,1:6,1:nLocalElems) = sideInfo(1:5,1:6,e1:e2) - - deallocate(nodeCoords) - deallocate(globalNodeIDs) - deallocate(sideInfo) - - call this%UpdateDevice() - - endsubroutine UniformStructuredMesh_Mesh3D_t - - subroutine Read_HOPr_Mesh3D_t(this,meshFile,enableDomainDecomposition) - ! From https://www.hopr-project.org/externals/Meshformat.pdf, Algorithm 6 - implicit none - class(Mesh3D_t),intent(out) :: this - character(*),intent(in) :: meshFile - logical,intent(in),optional :: enableDomainDecomposition - ! Local - integer(HID_T) :: fileId - integer(HID_T) :: offset(1:2),gOffset(1) - integer :: nGlobalElem - integer :: firstElem - integer :: firstNode - integer :: firstSide - integer :: nLocalElems - integer :: nLocalNodes - integer :: nLocalSides - integer :: nUniqueSides - integer :: nGeo,nBCs - integer :: eid,lsid,iSide - integer :: i,j,k,nid - integer,dimension(:,:),allocatable :: hopr_elemInfo - integer,dimension(:,:),allocatable :: hopr_sideInfo - real(prec),dimension(:,:),allocatable :: hopr_nodeCoords - integer,dimension(:),allocatable :: hopr_globalNodeIDs - integer,dimension(:,:),allocatable :: bcType - - if(present(enableDomainDecomposition)) then - call this%decomp%init(enableDomainDecomposition) - else - call this%decomp%init(.false.) - endif - - if(this%decomp%mpiEnabled) then - call Open_HDF5(meshFile,H5F_ACC_RDONLY_F,fileId,this%decomp%mpiComm) - else - call Open_HDF5(meshFile,H5F_ACC_RDONLY_F,fileId) - endif - - call ReadAttribute_HDF5(fileId,'nElems',nGlobalElem) - call ReadAttribute_HDF5(fileId,'Ngeo',nGeo) - call ReadAttribute_HDF5(fileId,'nBCs',nBCs) - call ReadAttribute_HDF5(fileId,'nUniqueSides',nUniqueSides) - - ! Read BCType - allocate(bcType(1:4,1:nBCs)) - if(this%decomp%mpiEnabled) then - offset(:) = 0 - call ReadArray_HDF5(fileId,'BCType',bcType,offset) - else - call ReadArray_HDF5(fileId,'BCType',bcType) - endif - - ! Read local subarray of ElemInfo - call this%decomp%GenerateDecomposition(nGlobalElem,nUniqueSides) - - firstElem = this%decomp%offsetElem(this%decomp%rankId+1)+1 - nLocalElems = this%decomp%offsetElem(this%decomp%rankId+2)- & - this%decomp%offsetElem(this%decomp%rankId+1) - - ! Allocate Space for hopr_elemInfo! - allocate(hopr_elemInfo(1:6,1:nLocalElems)) - if(this%decomp%mpiEnabled) then - offset = (/0,firstElem-1/) - call ReadArray_HDF5(fileId,'ElemInfo',hopr_elemInfo,offset) - else - call ReadArray_HDF5(fileId,'ElemInfo',hopr_elemInfo) - endif - - ! Read local subarray of NodeCoords and GlobalNodeIDs - firstNode = hopr_elemInfo(5,1)+1 - nLocalNodes = hopr_elemInfo(6,nLocalElems)-hopr_elemInfo(5,1) - - ! Allocate Space for hopr_nodeCoords and hopr_globalNodeIDs ! - allocate(hopr_nodeCoords(1:3,1:nLocalNodes),hopr_globalNodeIDs(1:nLocalNodes)) - - if(this%decomp%mpiEnabled) then - offset = (/0,firstNode-1/) - call ReadArray_HDF5(fileId,'NodeCoords',hopr_nodeCoords,offset) - gOffset = (/firstNode-1/) - call ReadArray_HDF5(fileId,'GlobalNodeIDs',hopr_globalNodeIDs,gOffset) - else - call ReadArray_HDF5(fileId,'NodeCoords',hopr_nodeCoords) - call ReadArray_HDF5(fileId,'GlobalNodeIDs',hopr_globalNodeIDs) - endif - - ! Read local subarray of SideInfo - firstSide = hopr_elemInfo(3,1)+1 - nLocalSides = hopr_elemInfo(4,nLocalElems)-hopr_elemInfo(3,1) - - ! Allocate space for hopr_sideInfo - allocate(hopr_sideInfo(1:5,1:nLocalSides)) - - if(this%decomp%mpiEnabled) then - offset = (/0,firstSide-1/) - call ReadArray_HDF5(fileId,'SideInfo',hopr_sideInfo,offset) - else - call ReadArray_HDF5(fileId,'SideInfo',hopr_sideInfo) - endif - - call Close_HDF5(fileID) - ! ---- Done reading 3-D Mesh information ---- ! - ! Load hopr data into mesh data structure - - call this%Init(nGeo,nLocalElems,nLocalSides,nLocalNodes,nBCs) - - ! Copy data from local arrays into this - this%elemInfo = hopr_elemInfo - this%nUniqueSides = nUniqueSides - this%quadrature = UNIFORM - - ! Grab the node coordinates - do eid = 1,this%nElem - do k = 1,nGeo+1 - do j = 1,nGeo+1 - do i = 1,nGeo+1 - nid = i+(nGeo+1)*(j-1+(nGeo+1)*(k-1+(nGeo+1)*(eid-1))) - this%nodeCoords(1:3,i,j,k,eid) = hopr_nodeCoords(1:3,nid) - this%globalNodeIDs(i,j,k,eid) = hopr_globalNodeIDs(nid) - enddo - enddo - enddo - enddo - - iSide = 0 - do eid = 1,this%nElem - do lsid = 1,6 - iSide = iSide+1 - this%sideInfo(1:5,lsid,eid) = hopr_sideInfo(1:5,iSide) - enddo - enddo - - call this%RecalculateFlip() - - deallocate(hopr_elemInfo,hopr_nodeCoords,hopr_globalNodeIDs,hopr_sideInfo) - - call this%UpdateDevice() - - endsubroutine Read_HOPr_Mesh3D_t - - subroutine Write_Mesh3D_t(this,meshFile) - ! Writes mesh output in HOPR format (serial only) - implicit none - class(Mesh3D_t),intent(inout) :: this - character(*),intent(in) :: meshFile - ! Local - integer(HID_T) :: fileId - - call Open_HDF5(meshFile,H5F_ACC_RDWR_F,fileId) - - call WriteAttribute_HDF5(fileId,'nElems',this%nElem) - call WriteAttribute_HDF5(fileId,'Ngeo',this%nGeo) - call WriteAttribute_HDF5(fileId,'nBCs',this%nBCs) - - call WriteArray_HDF5(fileId,'BCType',this%bcType) - call WriteArray_HDF5(fileId,'ElemInfo',this%elemInfo) - - ! Read local subarray of NodeCoords and GlobalNodeIDs - call WriteArray_HDF5(fileId,'NodeCoords',this%nodeCoords) - call WriteArray_HDF5(fileId,'GlobalNodeIDs',this%globalNodeIDs) - - ! Read local subarray of SideInfo - call WriteArray_HDF5(fileId,'SideInfo',this%sideInfo) - - call Close_HDF5(fileID) - - endsubroutine Write_Mesh3D_t - -endmodule SELF_Mesh_3D_t + implicit none + class(Mesh3D_t), intent(out) :: this + integer, intent(in) :: nxPerTile + integer, intent(in) :: nyPerTile + integer, intent(in) :: nzPerTile + integer, intent(in) :: nTileX + integer, intent(in) :: nTileY + integer, intent(in) :: nTileZ + real(prec), intent(in) :: dx + real(prec), intent(in) :: dy + real(prec), intent(in) :: dz + integer, intent(in) :: bcids(1:6) + ! Local + integer :: nX, nY, nZ, nGeo, nBCs + integer :: nGlobalElem + integer :: nUniqueSides + integer :: nUniqueNodes + integer :: nLocalElems + integer :: nLocalSides + integer :: nLocalNodes + real(prec), allocatable :: nodeCoords(:, :, :, :, :) + integer, allocatable :: globalNodeIDs(:, :, :, :) + integer, allocatable :: sideInfo(:, :, :) + integer :: i, j, k, ti, tj, tk + integer :: ix, iy, iz, iel + integer :: ni, nj, nk + integer :: e1, e2, s1, s2 + integer :: nfaces + + call this%decomp%init() + + nX = nTileX*nxPerTile + nY = nTileY*nyPerTile + nZ = nTileZ*nzPerTile + nGeo = 1 ! Force the geometry to be linear + nBCs = 6 ! Force the number of boundary conditions to 4 + + nGlobalElem = nX*nY*nZ + nUniqueSides = (nX + 1)*nY*nZ + (nY + 1)*nX*nZ + (nZ + 1)*nX*nY + nUniqueNodes = (nX + 1)*(nY + 1)*(nZ + 1) + + allocate (nodeCoords(1:3, 1:nGeo + 1, 1:nGeo + 1, 1:nGeo + 1, 1:nGlobalElem)) + allocate (globalNodeIDs(1:nGeo + 1, 1:nGeo + 1, 1:nGeo + 1, 1:nGlobalElem)) + allocate (sideInfo(1:5, 1:6, 1:nGlobalElem)) + + do tk = 1, nTileZ + do tj = 1, nTileY + do ti = 1, nTileX + do k = 1, nzPerTile + iz = k + nzPerTile*(tk - 1) + do j = 1, nyPerTile + iy = j + nyPerTile*(tj - 1) + do i = 1, nxPerTile + + iel = elementid(i, j, k, ti, tj, tk, & + nxpertile, nypertile, nzpertile, & + ntilex, ntiley, ntilez) + ix = i + nxPerTile*(ti - 1) + + do nk = 1, nGeo + 1 + do nj = 1, nGeo + 1 + do ni = 1, nGeo + 1 + nodeCoords(1, ni, nj, nk, iel) = real(ni - 1 + ix - 1, prec)*dx + nodeCoords(2, ni, nj, nk, iel) = real(nj - 1 + iy - 1, prec)*dy + nodeCoords(3, ni, nj, nk, iel) = real(nk - 1 + iz - 1, prec)*dz + globalNodeIDs(ni, nj, nk, iel) = ni - 1 + i + (nxPerTile + 1)*( & + nj - 1 + j - 1 + (nyPerTile + 1)*( & + nk - 1 + k - 1 + (nzPerTile + 1)*( & + (ti - 1 + nTileX*( & + tj - 1 + nTileY*(tk - 1)))))) + end do + end do + end do + + end do + end do + end do + end do + end do + end do + + ! Fill in face information + ! sideInfo(1:5,iSide,iEl) + ! 1 - Side Type (currently unused in SELF) + ! 2 - Global Side ID (Used for message passing) + ! 3 - Neighbor Element ID + ! 4 - 10*( neighbor local side ) + flip + ! 5 - Boundary Condition ID + nfaces = 0 + do tk = 1, nTileZ + do tj = 1, nTileY + do ti = 1, nTileX + do k = 1, nzPerTile + do j = 1, nyPerTile + do i = 1, nxPerTile + + iel = elementid(i, j, k, ti, tj, tk, & + nxpertile, nypertile, nzpertile, & + ntilex, ntiley, ntilez) + ! bottom, iside=1 + s1 = 1 + s2 = 6 + if (k == 1) then ! bottom most part of the tile + if (tk == 1) then ! bottom most tile + nfaces = nfaces + 1 + sideinfo(2, s1, iel) = nfaces + sideinfo(3, s1, iel) = 0 ! Neigbor element (null, boundary condition) + sideinfo(4, s1, iel) = 0 ! Neighbor side id (null, boundary condition) + sideinfo(5, s1, iel) = bcids(s1) ! Boundary condition id; set from the user input + else ! interior tile + !neighbor element is the top most element in the tile beneath + e2 = elementid(i, j, nzpertile, ti, tj, tk - 1, & + nxpertile, nypertile, nzpertile, & + ntilex, ntiley, ntilez) + + sideinfo(2, s1, iel) = sideInfo(2, s2, e2) ! Copy the face id from neighbor + sideinfo(3, s1, iel) = e2 + sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id + sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) + end if + else ! interior to the tile + !neighbor element is in the same tile, but beneath + e2 = elementid(i, j, k - 1, ti, tj, tk, & + nxpertile, nypertile, nzpertile, & + ntilex, ntiley, ntilez) + + sideinfo(2, s1, iel) = sideInfo(2, s2, e2) ! Copy the face id from neighbor + sideinfo(3, s1, iel) = e2 + sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id + sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) + end if + + ! south, iside=2 + s1 = 2 + s2 = 4 ! Neighbor side is north (4) + if (j == 1) then ! southern most part of the tile + if (tj == 1) then ! southern most tile + nfaces = nfaces + 1 + sideinfo(2, s1, iel) = nfaces + sideinfo(3, s1, iel) = 0 ! Neigbor element (null, boundary condition) + sideinfo(4, s1, iel) = 0 ! Neighbor side id (null, boundary condition) + sideinfo(5, s1, iel) = bcids(s1) ! Boundary condition id; eastern boundary set from the user input + else ! interior tile + !neighbor element is northernmost element in the tile to the south + e2 = elementid(i, nypertile, k, ti, tj - 1, tk, & + nxpertile, nypertile, nzpertile, & + ntilex, ntiley, ntilez) + + sideinfo(2, s1, iel) = sideInfo(2, s2, e2) ! Copy the face id from neighbor + sideinfo(3, s1, iel) = e2 ! Neigbor element + sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id + sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) + end if + else ! interior to the tile + !neighbor element is in the same tile, to the south + e2 = elementid(i, j - 1, k, ti, tj, tk, & + nxpertile, nypertile, nzpertile, & + ntilex, ntiley, ntilez) + + sideinfo(2, s1, iel) = sideInfo(2, s2, e2) ! Copy the face id from neighbor + sideinfo(3, s1, iel) = e2 ! Neigbor element + sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id + sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) + end if + + ! east, iside=3 + s1 = 3 + s2 = 5 ! neighbor side id is west (5) + ! East faces are always new faces, due to the way we are traversing the grid + nfaces = nfaces + 1 + sideinfo(2, s1, iel) = nfaces + if (i == nxPerTile) then ! eastern most part of the tile + if (ti == nTileX) then ! eastern most tile + sideinfo(3, s1, iel) = 0 ! Neigbor element (null, boundary condition) + sideinfo(4, s1, iel) = 0 ! Neighbor side id (null, boundary condition) + sideinfo(5, s1, iel) = bcids(s1) ! Boundary condition id; + else ! interior tile + !neighbor element is westernmost element in tile to the east + e2 = elementid(1, j, k, ti + 1, tj, tk, & + nxpertile, nypertile, nzpertile, & + ntilex, ntiley, ntilez) + sideinfo(3, s1, iel) = e2 ! Neigbor element + sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id + sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) + end if + else ! interior to the tile + !neighbor element is in the same tile, to the east + e2 = elementid(i + 1, j, k, ti, tj, tk, & + nxpertile, nypertile, nzpertile, & + ntilex, ntiley, ntilez) + sideinfo(3, s1, iel) = e2 ! Neigbor element + sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id + sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) + end if + + ! north, iside=4 + s1 = 4 + s2 = 2 ! neighbor side is south (2) + ! North faces are always new faces, due to the way we are traversing the grid + nfaces = nfaces + 1 + sideinfo(2, s1, iel) = nfaces + if (j == nyPerTile) then ! northern most part of the tile + if (tj == nTileY) then ! northern most tile + sideinfo(3, s1, iel) = 0 ! Neigbor element (null, boundary condition) + sideinfo(4, s1, iel) = 0 ! Neighbor side id (null, boundary condition) + sideinfo(5, s1, iel) = bcids(s1) ! Boundary condition id; set from the user input + else ! interior tile, but northern most face of the tile + !neighbor element is the southernmost element in the tile to the north + e2 = elementid(i, 1, k, ti, tj + 1, tk, & + nxpertile, nypertile, nzpertile, & + ntilex, ntiley, ntilez) + sideinfo(3, s1, iel) = e2 ! Neigbor element + sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id + sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) + end if + else ! interior to the tile + !neighbor element is the tile to the north + e2 = elementid(i, j + 1, k, ti, tj, tk, & + nxpertile, nypertile, nzpertile, & + ntilex, ntiley, ntilez) + sideinfo(3, s1, iel) = e2 ! Neigbor element + sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id + sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) + end if + + ! west, iside=5 + s1 = 5 + s2 = 3 ! neighbor side id is east (3) + if (i == 1) then ! western most part of the tile + if (ti == 1) then ! western most tile + nfaces = nfaces + 1 + sideinfo(2, s1, iel) = nfaces + sideinfo(3, s1, iel) = 0 ! Neigbor element (null, boundary condition) + sideinfo(4, s1, iel) = 0 ! Neighbor side id (null, boundary condition) + sideinfo(5, s1, iel) = bcids(s1) ! Boundary condition id + else ! interior tile, but western most face of the tile + !neighbor element is the easternmost element in the tile to the west + e2 = elementid(nxperTile, j, k, ti - 1, tj, tk, & + nxpertile, nypertile, nzpertile, & + ntilex, ntiley, ntilez) + + sideinfo(2, s1, iel) = sideInfo(2, s2, e2) ! Copy the face id from neighbor's east face + sideinfo(3, s1, iel) = e2 + sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id - neighbor to the west, east side (2) + sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) + end if + else ! interior to the tile + !neighbor element is the element to the west in the same tile + e2 = elementid(i - 1, j, k, ti, tj, tk, & + nxpertile, nypertile, nzpertile, & + ntilex, ntiley, ntilez) + + sideinfo(2, s1, iel) = sideInfo(2, s2, e2) ! Copy the face id from neighbor's east face + sideinfo(3, s1, iel) = e2 + sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id - neighbor to the west, east side (2) + sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) + end if + + ! top, iside=6 + s1 = 6 + s2 = 1 ! neighbor side is bottom (1) + ! Top faces are always new faces, due to the way we are traversing the grid + nfaces = nfaces + 1 + sideinfo(2, s1, iel) = nfaces + if (k == nzPerTile) then ! top most part of the tile + if (tk == nTileZ) then ! top most tile + sideinfo(3, s1, iel) = 0 ! Neigbor element (null, boundary condition) + sideinfo(4, s1, iel) = 0 ! Neighbor side id (null, boundary condition) + sideinfo(5, s1, iel) = bcids(s1) ! Boundary condition id; set from the user input + else ! interior tile, but top most face of the tile + !neighbor element is the bottom-most element in the tile above + e2 = elementid(i, j, 1, ti, tj, tk + 1, & + nxpertile, nypertile, nzpertile, & + ntilex, ntiley, ntilez) + sideinfo(3, s1, iel) = e2 ! Neigbor element + sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id + sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) + end if + else ! interior to the tile + !neighbor element is the tile above + e2 = elementid(i, j, k + 1, ti, tj, tk, & + nxpertile, nypertile, nzpertile, & + ntilex, ntiley, ntilez) + sideinfo(3, s1, iel) = e2 ! Neigbor element, inside same tile, to the north + sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id - neighbor to the north, south side (1) + sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) + end if + + end do + end do + end do + end do + end do + end do + + call this%decomp%GenerateDecomposition(nGlobalElem, nUniqueSides) + + e1 = this%decomp%offsetElem(this%decomp%rankId + 1) + 1 + e2 = this%decomp%offsetElem(this%decomp%rankId + 2) + nLocalElems = e2 - e1 + 1 + + nLocalSides = nLocalElems*6 + nLocalNodes = nLocalElems*8 + call this%Init(nGeo, nLocalElems, nLocalSides, nLocalNodes, nBCs) + this%nUniqueSides = nUniqueSides + this%quadrature = UNIFORM + +this%nodeCoords(1:3, 1:nGeo + 1, 1:nGeo + 1, 1:nGeo + 1, 1:nLocalElems) = nodeCoords(1:3, 1:nGeo + 1, 1:nGeo + 1, 1:nGeo + 1, e1:e2) + this%globalNodeIDs(1:nGeo + 1, 1:nGeo + 1, 1:nGeo + 1, 1:nLocalElems) = globalNodeIDs(1:nGeo + 1, 1:nGeo + 1, 1:nGeo + 1, e1:e2) + this%sideInfo(1:5, 1:6, 1:nLocalElems) = sideInfo(1:5, 1:6, e1:e2) + + deallocate (nodeCoords) + deallocate (globalNodeIDs) + deallocate (sideInfo) + + call this%UpdateDevice() + + end subroutine UniformStructuredMesh_Mesh3D_t + + subroutine Read_HOPr_Mesh3D_t(this, meshFile) + ! From https://www.hopr-project.org/externals/Meshformat.pdf, Algorithm 6 + implicit none + class(Mesh3D_t), intent(out) :: this + character(*), intent(in) :: meshFile + ! Local + integer(HID_T) :: fileId + integer(HID_T) :: offset(1:2), gOffset(1) + integer :: nGlobalElem + integer :: firstElem + integer :: firstNode + integer :: firstSide + integer :: nLocalElems + integer :: nLocalNodes + integer :: nLocalSides + integer :: nUniqueSides + integer :: nGeo, nBCs + integer :: eid, lsid, iSide + integer :: i, j, k, nid + integer, dimension(:, :), allocatable :: hopr_elemInfo + integer, dimension(:, :), allocatable :: hopr_sideInfo + real(prec), dimension(:, :), allocatable :: hopr_nodeCoords + integer, dimension(:), allocatable :: hopr_globalNodeIDs + integer, dimension(:, :), allocatable :: bcType + + call this%decomp%init() + + if (this%decomp%mpiEnabled) then + call Open_HDF5(meshFile, H5F_ACC_RDONLY_F, fileId, this%decomp%mpiComm) + else + call Open_HDF5(meshFile, H5F_ACC_RDONLY_F, fileId) + end if + + call ReadAttribute_HDF5(fileId, 'nElems', nGlobalElem) + call ReadAttribute_HDF5(fileId, 'Ngeo', nGeo) + call ReadAttribute_HDF5(fileId, 'nBCs', nBCs) + call ReadAttribute_HDF5(fileId, 'nUniqueSides', nUniqueSides) + + ! Read BCType + allocate (bcType(1:4, 1:nBCs)) + if (this%decomp%mpiEnabled) then + offset(:) = 0 + call ReadArray_HDF5(fileId, 'BCType', bcType, offset) + else + call ReadArray_HDF5(fileId, 'BCType', bcType) + end if + + ! Read local subarray of ElemInfo + call this%decomp%GenerateDecomposition(nGlobalElem, nUniqueSides) + + firstElem = this%decomp%offsetElem(this%decomp%rankId + 1) + 1 + nLocalElems = this%decomp%offsetElem(this%decomp%rankId + 2) - & + this%decomp%offsetElem(this%decomp%rankId + 1) + + ! Allocate Space for hopr_elemInfo! + allocate (hopr_elemInfo(1:6, 1:nLocalElems)) + if (this%decomp%mpiEnabled) then + offset = (/0, firstElem - 1/) + call ReadArray_HDF5(fileId, 'ElemInfo', hopr_elemInfo, offset) + else + call ReadArray_HDF5(fileId, 'ElemInfo', hopr_elemInfo) + end if + + ! Read local subarray of NodeCoords and GlobalNodeIDs + firstNode = hopr_elemInfo(5, 1) + 1 + nLocalNodes = hopr_elemInfo(6, nLocalElems) - hopr_elemInfo(5, 1) + + ! Allocate Space for hopr_nodeCoords and hopr_globalNodeIDs ! + allocate (hopr_nodeCoords(1:3, 1:nLocalNodes), hopr_globalNodeIDs(1:nLocalNodes)) + + if (this%decomp%mpiEnabled) then + offset = (/0, firstNode - 1/) + call ReadArray_HDF5(fileId, 'NodeCoords', hopr_nodeCoords, offset) + gOffset = (/firstNode - 1/) + call ReadArray_HDF5(fileId, 'GlobalNodeIDs', hopr_globalNodeIDs, gOffset) + else + call ReadArray_HDF5(fileId, 'NodeCoords', hopr_nodeCoords) + call ReadArray_HDF5(fileId, 'GlobalNodeIDs', hopr_globalNodeIDs) + end if + + ! Read local subarray of SideInfo + firstSide = hopr_elemInfo(3, 1) + 1 + nLocalSides = hopr_elemInfo(4, nLocalElems) - hopr_elemInfo(3, 1) + + ! Allocate space for hopr_sideInfo + allocate (hopr_sideInfo(1:5, 1:nLocalSides)) + + if (this%decomp%mpiEnabled) then + offset = (/0, firstSide - 1/) + call ReadArray_HDF5(fileId, 'SideInfo', hopr_sideInfo, offset) + else + call ReadArray_HDF5(fileId, 'SideInfo', hopr_sideInfo) + end if + + call Close_HDF5(fileID) + ! ---- Done reading 3-D Mesh information ---- ! + ! Load hopr data into mesh data structure + + call this%Init(nGeo, nLocalElems, nLocalSides, nLocalNodes, nBCs) + + ! Copy data from local arrays into this + this%elemInfo = hopr_elemInfo + this%nUniqueSides = nUniqueSides + this%quadrature = UNIFORM + + ! Grab the node coordinates + do eid = 1, this%nElem + do k = 1, nGeo + 1 + do j = 1, nGeo + 1 + do i = 1, nGeo + 1 + nid = i + (nGeo + 1)*(j - 1 + (nGeo + 1)*(k - 1 + (nGeo + 1)*(eid - 1))) + this%nodeCoords(1:3, i, j, k, eid) = hopr_nodeCoords(1:3, nid) + this%globalNodeIDs(i, j, k, eid) = hopr_globalNodeIDs(nid) + end do + end do + end do + end do + + iSide = 0 + do eid = 1, this%nElem + do lsid = 1, 6 + iSide = iSide + 1 + this%sideInfo(1:5, lsid, eid) = hopr_sideInfo(1:5, iSide) + end do + end do + + call this%RecalculateFlip() + + deallocate (hopr_elemInfo, hopr_nodeCoords, hopr_globalNodeIDs, hopr_sideInfo) + + call this%UpdateDevice() + + end subroutine Read_HOPr_Mesh3D_t + + subroutine Write_Mesh3D_t(this, meshFile) + ! Writes mesh output in HOPR format (serial only) + implicit none + class(Mesh3D_t), intent(inout) :: this + character(*), intent(in) :: meshFile + ! Local + integer(HID_T) :: fileId + + call Open_HDF5(meshFile, H5F_ACC_RDWR_F, fileId) + + call WriteAttribute_HDF5(fileId, 'nElems', this%nElem) + call WriteAttribute_HDF5(fileId, 'Ngeo', this%nGeo) + call WriteAttribute_HDF5(fileId, 'nBCs', this%nBCs) + + call WriteArray_HDF5(fileId, 'BCType', this%bcType) + call WriteArray_HDF5(fileId, 'ElemInfo', this%elemInfo) + + ! Read local subarray of NodeCoords and GlobalNodeIDs + call WriteArray_HDF5(fileId, 'NodeCoords', this%nodeCoords) + call WriteArray_HDF5(fileId, 'GlobalNodeIDs', this%globalNodeIDs) + + ! Read local subarray of SideInfo + call WriteArray_HDF5(fileId, 'SideInfo', this%sideInfo) + + call Close_HDF5(fileID) + + end subroutine Write_Mesh3D_t + +end module SELF_Mesh_3D_t diff --git a/test/advection_diffusion_2d_rk3_mpi.f90 b/test/advection_diffusion_2d_rk3_mpi.f90 index c2a48251d..7b329eacd 100644 --- a/test/advection_diffusion_2d_rk3_mpi.f90 +++ b/test/advection_diffusion_2d_rk3_mpi.f90 @@ -26,82 +26,82 @@ program advection_diffusion_2d_rk3 - use self_data - use self_advection_diffusion_2d + use self_data + use self_advection_diffusion_2d - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 0.25_prec ! velocity - real(prec),parameter :: v = 0.25_prec - real(prec),parameter :: nu = 0.005_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(advection_diffusion_2d) :: modelobj - type(Lagrange),target :: interp - type(Mesh2D),target :: mesh - type(SEMQuad),target :: geometry - character(LEN=255) :: WORKSPACE + implicit none + character(SELF_INTEGRATOR_LENGTH), parameter :: integrator = 'rk3' + integer, parameter :: controlDegree = 7 + integer, parameter :: targetDegree = 16 + real(prec), parameter :: u = 0.25_prec ! velocity + real(prec), parameter :: v = 0.25_prec + real(prec), parameter :: nu = 0.005_prec ! diffusivity + real(prec), parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size + real(prec), parameter :: endtime = 0.2_prec + real(prec), parameter :: iointerval = 0.1_prec + real(prec) :: e0, ef ! Initial and final entropy + type(advection_diffusion_2d) :: modelobj + type(Lagrange), target :: interp + type(Mesh2D), target :: mesh + type(SEMQuad), target :: geometry + character(LEN=255) :: WORKSPACE - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5",enableDomainDecomposition=.true.) + ! Create a uniform block mesh + call get_environment_variable("WORKSPACE", WORKSPACE) + call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp, mesh%nElem) + call geometry%GenerateFromMesh(mesh) - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. + ! Initialize the model + call modelobj%Init(mesh, geometry) + modelobj%gradient_enabled = .true. - ! Set the velocity - modelobj%u = u - modelobj%v = v - !Set the diffusivity - modelobj%nu = nu + ! Set the velocity + modelobj%u = u + modelobj%v = v + !Set the diffusivity + modelobj%nu = nu - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 + (y-0.5)^2 )/0.005 )') - call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) + ! Set the initial condition + call modelobj%solution%SetEquation(1, 'f = exp( -( (x-0.5)^2 + (y-0.5)^2 )/0.005 )') + call modelobj%solution%SetInteriorFromEquation(geometry, 0.0_prec) - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) + print *, "min, max (interior)", & + minval(modelobj%solution%interior), & + maxval(modelobj%solution%interior) - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) + call modelobj%CalculateEntropy() + call modelobj%ReportEntropy() + e0 = modelobj%entropy + ! Set the model's time integration method + call modelobj%SetTimeIntegrator(integrator) - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - call modelobj%WriteModel("advdiff2d-rk3-mpi.pickup.h5") + ! forward step the model to `endtime` using a time step + ! of `dt` and outputing model data every `iointerval` + call modelobj%ForwardStep(endtime, dt, iointerval) + call modelobj%WriteModel("advdiff2d-rk3-mpi.pickup.h5") - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = modelobj%entropy + print *, "min, max (interior)", & + minval(modelobj%solution%interior), & + maxval(modelobj%solution%interior) + ef = modelobj%entropy - if(ef > e0) then - print*,"Error: Final absmax greater than initial absmax! ",e0,ef - stop 1 - endif - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() + if (ef > e0) then + print *, "Error: Final absmax greater than initial absmax! ", e0, ef + stop 1 + end if + ! Clean up + call modelobj%free() + call mesh%free() + call geometry%free() + call interp%free() -endprogram advection_diffusion_2d_rk3 +end program advection_diffusion_2d_rk3 diff --git a/test/advection_diffusion_2d_rk3_pickup_mpi.f90 b/test/advection_diffusion_2d_rk3_pickup_mpi.f90 index 8ee8a37f1..357e12e2d 100644 --- a/test/advection_diffusion_2d_rk3_pickup_mpi.f90 +++ b/test/advection_diffusion_2d_rk3_pickup_mpi.f90 @@ -26,80 +26,80 @@ program advection_diffusion_2d_rk3 - use self_data - use self_advection_diffusion_2d + use self_data + use self_advection_diffusion_2d - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 0.25_prec ! velocity - real(prec),parameter :: v = 0.25_prec - real(prec),parameter :: nu = 0.005_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(advection_diffusion_2d) :: modelobj - type(Lagrange),target :: interp - type(Mesh2D),target :: mesh - type(SEMQuad),target :: geometry - character(LEN=255) :: WORKSPACE + implicit none + character(SELF_INTEGRATOR_LENGTH), parameter :: integrator = 'rk3' + integer, parameter :: controlDegree = 7 + integer, parameter :: targetDegree = 16 + real(prec), parameter :: u = 0.25_prec ! velocity + real(prec), parameter :: v = 0.25_prec + real(prec), parameter :: nu = 0.005_prec ! diffusivity + real(prec), parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size + real(prec), parameter :: endtime = 0.2_prec + real(prec), parameter :: iointerval = 0.1_prec + real(prec) :: e0, ef ! Initial and final entropy + type(advection_diffusion_2d) :: modelobj + type(Lagrange), target :: interp + type(Mesh2D), target :: mesh + type(SEMQuad), target :: geometry + character(LEN=255) :: WORKSPACE - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5",enableDomainDecomposition=.true.) + ! Create a uniform block mesh + call get_environment_variable("WORKSPACE", WORKSPACE) + call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp, mesh%nElem) + call geometry%GenerateFromMesh(mesh) - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. + ! Initialize the model + call modelobj%Init(mesh, geometry) + modelobj%gradient_enabled = .true. - ! Set the velocity - modelobj%u = u - modelobj%v = v - !Set the diffusivity - modelobj%nu = nu + ! Set the velocity + modelobj%u = u + modelobj%v = v + !Set the diffusivity + modelobj%nu = nu - ! Set the initial condition from pickup file - call modelobj%ReadModel("advdiff2d-rk3-mpi.pickup.h5") + ! Set the initial condition from pickup file + call modelobj%ReadModel("advdiff2d-rk3-mpi.pickup.h5") - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) + print *, "min, max (interior)", & + minval(modelobj%solution%interior), & + maxval(modelobj%solution%interior) - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) + call modelobj%CalculateEntropy() + call modelobj%ReportEntropy() + e0 = modelobj%entropy + ! Set the model's time integration method + call modelobj%SetTimeIntegrator(integrator) - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) + ! forward step the model to `endtime` using a time step + ! of `dt` and outputing model data every `iointerval` + call modelobj%ForwardStep(endtime, dt, iointerval) - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = modelobj%entropy + print *, "min, max (interior)", & + minval(modelobj%solution%interior), & + maxval(modelobj%solution%interior) + ef = modelobj%entropy - if(ef > e0) then - print*,"Error: Final absmax greater than initial absmax! ",e0,ef - stop 1 - endif - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() + if (ef > e0) then + print *, "Error: Final absmax greater than initial absmax! ", e0, ef + stop 1 + end if + ! Clean up + call modelobj%free() + call mesh%free() + call geometry%free() + call interp%free() -endprogram advection_diffusion_2d_rk3 +end program advection_diffusion_2d_rk3 diff --git a/test/advection_diffusion_3d_rk3_mpi.f90 b/test/advection_diffusion_3d_rk3_mpi.f90 index ef38e488a..165b912a7 100644 --- a/test/advection_diffusion_3d_rk3_mpi.f90 +++ b/test/advection_diffusion_3d_rk3_mpi.f90 @@ -26,86 +26,86 @@ program advection_diffusion_3d_rk3 - use self_data - use self_advection_diffusion_3d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 0.25_prec ! velocity - real(prec),parameter :: v = 0.25_prec - real(prec),parameter :: w = 0.25_prec - real(prec),parameter :: nu = 0.001_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.01_prec - real(prec),parameter :: iointerval = 0.01_prec - type(advection_diffusion_3d) :: modelobj - type(Lagrange),target :: interp - type(Mesh3D),target :: mesh - type(SEMHex),target :: geometry - character(LEN=255) :: WORKSPACE - real(prec) :: e0,ef - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5",enableDomainDecomposition=.true.) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - - ! Set the velocity - modelobj%u = u - modelobj%v = v - modelobj%w = w - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 + (y-0.5)^2 + (z-0.5)^2 )/0.005 )') - call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy - - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - call modelobj%WriteModel("advdiff3d-rk3-mpi.pickup.h5") - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final entropy greater than initial entropy! ",e0,ef - stop 1 - endif - - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_3d_rk3 + use self_data + use self_advection_diffusion_3d + + implicit none + character(SELF_INTEGRATOR_LENGTH), parameter :: integrator = 'rk3' + integer, parameter :: controlDegree = 7 + integer, parameter :: targetDegree = 16 + real(prec), parameter :: u = 0.25_prec ! velocity + real(prec), parameter :: v = 0.25_prec + real(prec), parameter :: w = 0.25_prec + real(prec), parameter :: nu = 0.001_prec ! diffusivity + real(prec), parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size + real(prec), parameter :: endtime = 0.01_prec + real(prec), parameter :: iointerval = 0.01_prec + type(advection_diffusion_3d) :: modelobj + type(Lagrange), target :: interp + type(Mesh3D), target :: mesh + type(SEMHex), target :: geometry + character(LEN=255) :: WORKSPACE + real(prec) :: e0, ef + + ! Create a uniform block mesh + call get_environment_variable("WORKSPACE", WORKSPACE) + call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") + + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) + + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp, mesh%nElem) + call geometry%GenerateFromMesh(mesh) + + ! Initialize the model + call modelobj%Init(mesh, geometry) + modelobj%gradient_enabled = .true. + + ! Set the velocity + modelobj%u = u + modelobj%v = v + modelobj%w = w + !Set the diffusivity + modelobj%nu = nu + + ! Set the initial condition + call modelobj%solution%SetEquation(1, 'f = exp( -( (x-0.5)^2 + (y-0.5)^2 + (z-0.5)^2 )/0.005 )') + call modelobj%solution%SetInteriorFromEquation(geometry, 0.0_prec) + + print *, "min, max (interior)", & + minval(modelobj%solution%interior), & + maxval(modelobj%solution%interior) + + call modelobj%CalculateEntropy() + call modelobj%ReportEntropy() + e0 = modelobj%entropy + + ! Set the model's time integration method + call modelobj%SetTimeIntegrator(integrator) + + ! forward step the model to `endtime` using a time step + ! of `dt` and outputing model data every `iointerval` + call modelobj%ForwardStep(endtime, dt, iointerval) + call modelobj%WriteModel("advdiff3d-rk3-mpi.pickup.h5") + + print *, "min, max (interior)", & + minval(modelobj%solution%interior), & + maxval(modelobj%solution%interior) + ef = modelobj%entropy + + if (ef > e0) then + print *, "Error: Final entropy greater than initial entropy! ", e0, ef + stop 1 + end if + + ! Clean up + call modelobj%free() + call mesh%free() + call geometry%free() + call interp%free() + +end program advection_diffusion_3d_rk3 diff --git a/test/advection_diffusion_3d_rk3_pickup_mpi.f90 b/test/advection_diffusion_3d_rk3_pickup_mpi.f90 index d5124cf81..6ab14c9c6 100644 --- a/test/advection_diffusion_3d_rk3_pickup_mpi.f90 +++ b/test/advection_diffusion_3d_rk3_pickup_mpi.f90 @@ -26,84 +26,84 @@ program advection_diffusion_3d_rk3 - use self_data - use self_advection_diffusion_3d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 0.25_prec ! velocity - real(prec),parameter :: v = 0.25_prec - real(prec),parameter :: w = 0.25_prec - real(prec),parameter :: nu = 0.001_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.01_prec - real(prec),parameter :: iointerval = 0.01_prec - type(advection_diffusion_3d) :: modelobj - type(Lagrange),target :: interp - type(Mesh3D),target :: mesh - type(SEMHex),target :: geometry - character(LEN=255) :: WORKSPACE - real(prec) :: e0,ef - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5",enableDomainDecomposition=.true.) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - - ! Set the velocity - modelobj%u = u - modelobj%v = v - modelobj%w = w - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition from pickup file - call modelobj%ReadModel("advdiff3d-rk3-mpi.pickup.h5") - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy - - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final entropy greater than initial entropy! ",e0,ef - stop 1 - endif - - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_3d_rk3 + use self_data + use self_advection_diffusion_3d + + implicit none + character(SELF_INTEGRATOR_LENGTH), parameter :: integrator = 'rk3' + integer, parameter :: controlDegree = 7 + integer, parameter :: targetDegree = 16 + real(prec), parameter :: u = 0.25_prec ! velocity + real(prec), parameter :: v = 0.25_prec + real(prec), parameter :: w = 0.25_prec + real(prec), parameter :: nu = 0.001_prec ! diffusivity + real(prec), parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size + real(prec), parameter :: endtime = 0.01_prec + real(prec), parameter :: iointerval = 0.01_prec + type(advection_diffusion_3d) :: modelobj + type(Lagrange), target :: interp + type(Mesh3D), target :: mesh + type(SEMHex), target :: geometry + character(LEN=255) :: WORKSPACE + real(prec) :: e0, ef + + ! Create a uniform block mesh + call get_environment_variable("WORKSPACE", WORKSPACE) + call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") + + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) + + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp, mesh%nElem) + call geometry%GenerateFromMesh(mesh) + + ! Initialize the model + call modelobj%Init(mesh, geometry) + modelobj%gradient_enabled = .true. + + ! Set the velocity + modelobj%u = u + modelobj%v = v + modelobj%w = w + !Set the diffusivity + modelobj%nu = nu + + ! Set the initial condition from pickup file + call modelobj%ReadModel("advdiff3d-rk3-mpi.pickup.h5") + + print *, "min, max (interior)", & + minval(modelobj%solution%interior), & + maxval(modelobj%solution%interior) + + call modelobj%CalculateEntropy() + call modelobj%ReportEntropy() + e0 = modelobj%entropy + + ! Set the model's time integration method + call modelobj%SetTimeIntegrator(integrator) + + ! forward step the model to `endtime` using a time step + ! of `dt` and outputing model data every `iointerval` + call modelobj%ForwardStep(endtime, dt, iointerval) + + print *, "min, max (interior)", & + minval(modelobj%solution%interior), & + maxval(modelobj%solution%interior) + ef = modelobj%entropy + + if (ef > e0) then + print *, "Error: Final entropy greater than initial entropy! ", e0, ef + stop 1 + end if + + ! Clean up + call modelobj%free() + call mesh%free() + call geometry%free() + call interp%free() + +end program advection_diffusion_3d_rk3 diff --git a/test/mappedscalarbrgradient_2d_linear_mpi.f90 b/test/mappedscalarbrgradient_2d_linear_mpi.f90 index c621d40c2..f373d8876 100644 --- a/test/mappedscalarbrgradient_2d_linear_mpi.f90 +++ b/test/mappedscalarbrgradient_2d_linear_mpi.f90 @@ -26,130 +26,130 @@ program test - implicit none - integer :: exit_code + implicit none + integer :: exit_code - exit_code = mappedscalarbrgradient_2d_linear() - if(exit_code /= 0) then - stop exit_code - endif + exit_code = mappedscalarbrgradient_2d_linear() + if (exit_code /= 0) then + stop exit_code + end if contains - integer function mappedscalarbrgradient_2d_linear() result(r) + integer function mappedscalarbrgradient_2d_linear() result(r) - use SELF_Constants - use SELF_Lagrange - use SELF_Mesh_2D - use SELF_Geometry_2D - use SELF_MappedScalar_2D - use SELF_MappedVector_2D + use SELF_Constants + use SELF_Lagrange + use SELF_Mesh_2D + use SELF_Geometry_2D + use SELF_MappedScalar_2D + use SELF_MappedVector_2D - implicit none + implicit none - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - integer,parameter :: nvar = 1 + integer, parameter :: controlDegree = 7 + integer, parameter :: targetDegree = 16 + integer, parameter :: nvar = 1 #ifdef DOUBLE_PRECISION - real(prec),parameter :: tolerance = 10.0_prec**(-7) + real(prec), parameter :: tolerance = 10.0_prec**(-7) #else - real(prec),parameter :: tolerance = 5.0_prec*10.0_prec**(-3) + real(prec), parameter :: tolerance = 5.0_prec*10.0_prec**(-3) #endif - type(Lagrange),target :: interp - type(Mesh2D),target :: mesh - type(SEMQuad),target :: geometry - type(MappedScalar2D) :: f - type(MappedVector2D) :: df - integer :: iside - integer :: e2 - character(LEN=255) :: WORKSPACE - integer :: iel,j,i - integer(HID_T) :: fileId - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5",enableDomainDecomposition=.true.) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - call f%Init(interp,nvar,mesh%nelem) - call df%Init(interp,nvar,mesh%nelem) - call f%AssociateGeometry(geometry) - - call f%SetEquation(1,'f = x*y') - - call f%SetInteriorFromEquation(geometry,0.0_prec) - print*,"min, max (interior)",minval(f%interior),maxval(f%interior) - - call f%BoundaryInterp() - call f%UpdateHost() - print*,"min, max (boundary)",minval(f%boundary),maxval(f%boundary) - - call f%SideExchange(mesh) - call f%UpdateHost() - ! Set boundary conditions by prolonging the "boundary" attribute to the domain boundaries - do iel = 1,f%nElem - do iside = 1,4 - e2 = mesh%sideInfo(3,iside,iel) ! Neighboring Element ID - if(e2 == 0) then - do i = 1,f%interp%N+1 - f%extBoundary(i,iside,iel,1) = f%boundary(i,iside,iel,1) - enddo - endif - enddo - enddo - - print*,"min, max (extboundary)",minval(f%extBoundary),maxval(f%extBoundary) - call f%UpdateDevice() - - call f%AverageSides() - - call f%UpdateHost() - print*,"min, max (avgboundary)",minval(f%avgboundary),maxval(f%avgboundary) + type(Lagrange), target :: interp + type(Mesh2D), target :: mesh + type(SEMQuad), target :: geometry + type(MappedScalar2D) :: f + type(MappedVector2D) :: df + integer :: iside + integer :: e2 + character(LEN=255) :: WORKSPACE + integer :: iel, j, i + integer(HID_T) :: fileId + + ! Create a uniform block mesh + call get_environment_variable("WORKSPACE", WORKSPACE) + call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") + + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) + + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp, mesh%nElem) + call geometry%GenerateFromMesh(mesh) + + call f%Init(interp, nvar, mesh%nelem) + call df%Init(interp, nvar, mesh%nelem) + call f%AssociateGeometry(geometry) + + call f%SetEquation(1, 'f = x*y') + + call f%SetInteriorFromEquation(geometry, 0.0_prec) + print *, "min, max (interior)", minval(f%interior), maxval(f%interior) + + call f%BoundaryInterp() + call f%UpdateHost() + print *, "min, max (boundary)", minval(f%boundary), maxval(f%boundary) + + call f%SideExchange(mesh) + call f%UpdateHost() + ! Set boundary conditions by prolonging the "boundary" attribute to the domain boundaries + do iel = 1, f%nElem + do iside = 1, 4 + e2 = mesh%sideInfo(3, iside, iel) ! Neighboring Element ID + if (e2 == 0) then + do i = 1, f%interp%N + 1 + f%extBoundary(i, iside, iel, 1) = f%boundary(i, iside, iel, 1) + end do + end if + end do + end do + + print *, "min, max (extboundary)", minval(f%extBoundary), maxval(f%extBoundary) + call f%UpdateDevice() + + call f%AverageSides() + + call f%UpdateHost() + print *, "min, max (avgboundary)", minval(f%avgboundary), maxval(f%avgboundary) #ifdef ENABLE_GPU - call f%MappedDGGradient(df%interior_gpu) + call f%MappedDGGradient(df%interior_gpu) #else - call f%MappedDGGradient(df%interior) + call f%MappedDGGradient(df%interior) #endif - call df%UpdateHost() - - print*,"min, max (df/dx)",minval(df%interior(:,:,:,1,1)),maxval(df%interior(:,:,:,1,1)) - print*,"min, max (df/dy)",minval(df%interior(:,:,:,1,2)),maxval(df%interior(:,:,:,1,2)) - - ! Calculate diff from exact - do iel = 1,mesh%nelem - do j = 1,controlDegree+1 - do i = 1,controlDegree+1 - df%interior(i,j,iel,1,1) = abs(df%interior(i,j,iel,1,1)-geometry%x%interior(i,j,iel,1,2)) ! df/dx = y - df%interior(i,j,iel,1,2) = abs(df%interior(i,j,iel,1,2)-geometry%x%interior(i,j,iel,1,1)) ! df/dy = x - - enddo - enddo - enddo - - print*,"maxval(df_error)",maxval(df%interior),tolerance - - if(maxval(df%interior) <= tolerance) then - r = 0 - else - r = 1 - endif - - ! Clean up - call f%DissociateGeometry() - call geometry%Free() - call mesh%Free() - call interp%Free() - call f%free() - call df%free() - - endfunction mappedscalarbrgradient_2d_linear -endprogram test + call df%UpdateHost() + + print *, "min, max (df/dx)", minval(df%interior(:, :, :, 1, 1)), maxval(df%interior(:, :, :, 1, 1)) + print *, "min, max (df/dy)", minval(df%interior(:, :, :, 1, 2)), maxval(df%interior(:, :, :, 1, 2)) + + ! Calculate diff from exact + do iel = 1, mesh%nelem + do j = 1, controlDegree + 1 + do i = 1, controlDegree + 1 + df%interior(i, j, iel, 1, 1) = abs(df%interior(i, j, iel, 1, 1) - geometry%x%interior(i, j, iel, 1, 2)) ! df/dx = y + df%interior(i, j, iel, 1, 2) = abs(df%interior(i, j, iel, 1, 2) - geometry%x%interior(i, j, iel, 1, 1)) ! df/dy = x + + end do + end do + end do + + print *, "maxval(df_error)", maxval(df%interior), tolerance + + if (maxval(df%interior) <= tolerance) then + r = 0 + else + r = 1 + end if + + ! Clean up + call f%DissociateGeometry() + call geometry%Free() + call mesh%Free() + call interp%Free() + call f%free() + call df%free() + + end function mappedscalarbrgradient_2d_linear +end program test diff --git a/test/mappedscalarbrgradient_3d_linear_mpi.f90 b/test/mappedscalarbrgradient_3d_linear_mpi.f90 index c72ffeb18..b9281b257 100644 --- a/test/mappedscalarbrgradient_3d_linear_mpi.f90 +++ b/test/mappedscalarbrgradient_3d_linear_mpi.f90 @@ -26,139 +26,139 @@ program test - implicit none - integer :: exit_code + implicit none + integer :: exit_code - exit_code = mappedscalarbrgradient_3d_linear() - if(exit_code /= 0) then - stop exit_code - endif + exit_code = mappedscalarbrgradient_3d_linear() + if (exit_code /= 0) then + stop exit_code + end if contains - integer function mappedscalarbrgradient_3d_linear() result(r) + integer function mappedscalarbrgradient_3d_linear() result(r) - use SELF_Constants - use SELF_Lagrange - use SELF_Mesh_3D - use SELF_Geometry_3D - use SELF_MappedScalar_3D - use SELF_MappedVector_3D + use SELF_Constants + use SELF_Lagrange + use SELF_Mesh_3D + use SELF_Geometry_3D + use SELF_MappedScalar_3D + use SELF_MappedVector_3D - implicit none + implicit none - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - integer,parameter :: nvar = 1 + integer, parameter :: controlDegree = 7 + integer, parameter :: targetDegree = 16 + integer, parameter :: nvar = 1 #ifdef DOUBLE_PRECISION - real(prec),parameter :: tolerance = 10.0_prec**(-7) + real(prec), parameter :: tolerance = 10.0_prec**(-7) #else - real(prec),parameter :: tolerance = 10.0_prec**(-2) + real(prec), parameter :: tolerance = 10.0_prec**(-2) #endif - type(Lagrange),target :: interp - type(Mesh3D),target :: mesh - type(SEMHex),target :: geometry - type(MappedScalar3D) :: f - type(MappedVector3D) :: df - integer :: iel - integer :: iside - integer :: i - integer :: j - integer :: k - integer :: e2,s2,bcid - character(LEN=255) :: WORKSPACE - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5",enableDomainDecomposition=.true.) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - call f%Init(interp,nvar,mesh%nelem) - call df%Init(interp,nvar,mesh%nelem) - call f%AssociateGeometry(geometry) - - call f%SetName(1,"f") - call df%SetName(1,"df") - - call f%SetEquation(1,'f = x*y') - - call f%SetInteriorFromEquation(geometry,0.0_prec) - print*,"min, max (interior)",minval(f%interior),maxval(f%interior) - - call f%BoundaryInterp() - call f%UpdateHost() - print*,"min, max (boundary)",minval(f%boundary),maxval(f%boundary) - - call f%SideExchange(mesh) - call f%UpdateHost() - - ! Set boundary conditions by prolonging the "boundary" attribute to the domain boundaries - do iel = 1,f%nElem - do iside = 1,6 - e2 = mesh%sideInfo(3,iside,iel) ! Neighboring Element ID - s2 = mesh%sideInfo(4,iside,iel)/10 - bcid = mesh%sideInfo(5,iside,iel) - if(e2 == 0) then - do j = 1,f%interp%N+1 - do i = 1,f%interp%N+1 - f%extBoundary(i,j,iside,iel,1) = f%boundary(i,j,iside,iel,1) - enddo - enddo - endif - enddo - enddo - - print*,"min, max (extboundary)",minval(f%extBoundary),maxval(f%extBoundary) - - call f%UpdateDevice() - call f%AverageSides() - call f%UpdateHost() - print*,"min, max (avgboundary)",minval(f%avgBoundary),maxval(f%avgBoundary) + type(Lagrange), target :: interp + type(Mesh3D), target :: mesh + type(SEMHex), target :: geometry + type(MappedScalar3D) :: f + type(MappedVector3D) :: df + integer :: iel + integer :: iside + integer :: i + integer :: j + integer :: k + integer :: e2, s2, bcid + character(LEN=255) :: WORKSPACE + + ! Create a uniform block mesh + call get_environment_variable("WORKSPACE", WORKSPACE) + call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") + + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) + + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp, mesh%nElem) + call geometry%GenerateFromMesh(mesh) + + call f%Init(interp, nvar, mesh%nelem) + call df%Init(interp, nvar, mesh%nelem) + call f%AssociateGeometry(geometry) + + call f%SetName(1, "f") + call df%SetName(1, "df") + + call f%SetEquation(1, 'f = x*y') + + call f%SetInteriorFromEquation(geometry, 0.0_prec) + print *, "min, max (interior)", minval(f%interior), maxval(f%interior) + + call f%BoundaryInterp() + call f%UpdateHost() + print *, "min, max (boundary)", minval(f%boundary), maxval(f%boundary) + + call f%SideExchange(mesh) + call f%UpdateHost() + + ! Set boundary conditions by prolonging the "boundary" attribute to the domain boundaries + do iel = 1, f%nElem + do iside = 1, 6 + e2 = mesh%sideInfo(3, iside, iel) ! Neighboring Element ID + s2 = mesh%sideInfo(4, iside, iel)/10 + bcid = mesh%sideInfo(5, iside, iel) + if (e2 == 0) then + do j = 1, f%interp%N + 1 + do i = 1, f%interp%N + 1 + f%extBoundary(i, j, iside, iel, 1) = f%boundary(i, j, iside, iel, 1) + end do + end do + end if + end do + end do + + print *, "min, max (extboundary)", minval(f%extBoundary), maxval(f%extBoundary) + + call f%UpdateDevice() + call f%AverageSides() + call f%UpdateHost() + print *, "min, max (avgboundary)", minval(f%avgBoundary), maxval(f%avgBoundary) #ifdef ENABLE_GPU - call f%MappedDGGradient(df%interior_gpu) + call f%MappedDGGradient(df%interior_gpu) #else - call f%MappedDGGradient(df%interior) + call f%MappedDGGradient(df%interior) #endif - call df%UpdateHost() - - ! Calculate diff from exact - do iel = 1,mesh%nelem - do k = 1,controlDegree+1 - do j = 1,controlDegree+1 - do i = 1,controlDegree+1 - df%interior(i,j,k,iel,1,1) = abs(df%interior(i,j,k,iel,1,1)- & - geometry%x%interior(i,j,k,iel,1,2)) ! df/dx = y*z - df%interior(i,j,k,iel,1,2) = abs(df%interior(i,j,k,iel,1,2)- & - geometry%x%interior(i,j,k,iel,1,1)) ! df/dy = x*z - df%interior(i,j,k,iel,1,3) = abs(df%interior(i,j,k,iel,1,3)) ! df/dy = x*y - enddo - enddo - enddo - enddo - print*,"maxval(df_error)",maxval(df%interior),tolerance - - if(maxval(df%interior) <= tolerance) then - r = 0 - else - r = 1 - endif - - ! Clean up - call f%DissociateGeometry() - call geometry%Free() - call mesh%Free() - call interp%Free() - call f%free() - call df%free() - - endfunction mappedscalarbrgradient_3d_linear -endprogram test + call df%UpdateHost() + + ! Calculate diff from exact + do iel = 1, mesh%nelem + do k = 1, controlDegree + 1 + do j = 1, controlDegree + 1 + do i = 1, controlDegree + 1 + df%interior(i, j, k, iel, 1, 1) = abs(df%interior(i, j, k, iel, 1, 1) - & + geometry%x%interior(i, j, k, iel, 1, 2)) ! df/dx = y*z + df%interior(i, j, k, iel, 1, 2) = abs(df%interior(i, j, k, iel, 1, 2) - & + geometry%x%interior(i, j, k, iel, 1, 1)) ! df/dy = x*z + df%interior(i, j, k, iel, 1, 3) = abs(df%interior(i, j, k, iel, 1, 3)) ! df/dy = x*y + end do + end do + end do + end do + print *, "maxval(df_error)", maxval(df%interior), tolerance + + if (maxval(df%interior) <= tolerance) then + r = 0 + else + r = 1 + end if + + ! Clean up + call f%DissociateGeometry() + call geometry%Free() + call mesh%Free() + call interp%Free() + call f%free() + call df%free() + + end function mappedscalarbrgradient_3d_linear +end program test diff --git a/test/mappedvectordgdivergence_2d_linear_mpi.f90 b/test/mappedvectordgdivergence_2d_linear_mpi.f90 index a330cf9c0..84ca11b28 100644 --- a/test/mappedvectordgdivergence_2d_linear_mpi.f90 +++ b/test/mappedvectordgdivergence_2d_linear_mpi.f90 @@ -26,112 +26,112 @@ program test - implicit none - integer :: exit_code + implicit none + integer :: exit_code - exit_code = mappedvectordgdivergence_2d_linear() - if(exit_code /= 0) then - stop exit_code - endif + exit_code = mappedvectordgdivergence_2d_linear() + if (exit_code /= 0) then + stop exit_code + end if contains - integer function mappedvectordgdivergence_2d_linear() result(r) + integer function mappedvectordgdivergence_2d_linear() result(r) - use SELF_Constants - use SELF_Lagrange - use SELF_Mesh_2D - use SELF_Geometry_2D - use SELF_MappedScalar_2D - use SELF_MappedVector_2D + use SELF_Constants + use SELF_Lagrange + use SELF_Mesh_2D + use SELF_Geometry_2D + use SELF_MappedScalar_2D + use SELF_MappedVector_2D - implicit none + implicit none - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - integer,parameter :: nvar = 1 + integer, parameter :: controlDegree = 7 + integer, parameter :: targetDegree = 16 + integer, parameter :: nvar = 1 #ifdef DOUBLE_PRECISION - real(prec),parameter :: tolerance = 10.0_prec**(-7) + real(prec), parameter :: tolerance = 10.0_prec**(-7) #else - real(prec),parameter :: tolerance = 10.0_prec**(-3) + real(prec), parameter :: tolerance = 10.0_prec**(-3) #endif - type(Lagrange),target :: interp - type(Mesh2D),target :: mesh - type(SEMQuad),target :: geometry - type(MappedVector2D) :: f - type(MappedScalar2D) :: df - character(LEN=255) :: WORKSPACE - integer :: i,j,iel - real(prec) :: nhat(1:2),nmag + type(Lagrange), target :: interp + type(Mesh2D), target :: mesh + type(SEMQuad), target :: geometry + type(MappedVector2D) :: f + type(MappedScalar2D) :: df + character(LEN=255) :: WORKSPACE + integer :: i, j, iel + real(prec) :: nhat(1:2), nmag - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5",enableDomainDecomposition=.true.) + ! Create a uniform block mesh + call get_environment_variable("WORKSPACE", WORKSPACE) + call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp, mesh%nElem) + call geometry%GenerateFromMesh(mesh) - call f%Init(interp,nvar,mesh%nelem) - call df%Init(interp,nvar,mesh%nelem) - call f%AssociateGeometry(geometry) + call f%Init(interp, nvar, mesh%nelem) + call df%Init(interp, nvar, mesh%nelem) + call f%AssociateGeometry(geometry) - call f%SetEquation(1,1,'f = x') ! x-component - call f%SetEquation(2,1,'f = y') ! y-component + call f%SetEquation(1, 1, 'f = x') ! x-component + call f%SetEquation(2, 1, 'f = y') ! y-component - call f%SetInteriorFromEquation(geometry,0.0_prec) - print*,"min, max (interior)",minval(f%interior),maxval(f%interior) + call f%SetInteriorFromEquation(geometry, 0.0_prec) + print *, "min, max (interior)", minval(f%interior), maxval(f%interior) - call f%boundaryInterp() - call f%UpdateHost() + call f%boundaryInterp() + call f%UpdateHost() - do iEl = 1,f%nElem - do j = 1,4 - do i = 1,f%interp%N+1 + do iEl = 1, f%nElem + do j = 1, 4 + do i = 1, f%interp%N + 1 - ! Get the boundary normals on cell edges from the mesh geometry - nhat(1:2) = geometry%nHat%boundary(i,j,iEl,1,1:2) - nmag = geometry%nScale%boundary(i,j,iEl,1) + ! Get the boundary normals on cell edges from the mesh geometry + nhat(1:2) = geometry%nHat%boundary(i, j, iEl, 1, 1:2) + nmag = geometry%nScale%boundary(i, j, iEl, 1) - f%boundaryNormal(i,j,iEl,1) = (f%boundary(i,j,iEl,1,1)*nhat(1)+ & - f%boundary(i,j,iEl,1,2)*nhat(2))*nmag + f%boundaryNormal(i, j, iEl, 1) = (f%boundary(i, j, iEl, 1, 1)*nhat(1) + & + f%boundary(i, j, iEl, 1, 2)*nhat(2))*nmag - enddo - enddo - enddo + end do + end do + end do - call f%UpdateDevice() + call f%UpdateDevice() #ifdef ENABLE_GPU - call f%MappedDGDivergence(df%interior_gpu) + call f%MappedDGDivergence(df%interior_gpu) #else - call f%MappedDGDivergence(df%interior) + call f%MappedDGDivergence(df%interior) #endif - call df%UpdateHost() - - ! Calculate diff from exact - df%interior = abs(df%interior-2.0_prec) - - print*,"absmax error :",maxval(df%interior) - if(maxval(df%interior) <= tolerance) then - r = 0 - else - print*,"absmax error greater than tolerance :",tolerance - r = 1 - endif - - ! Clean up - call f%DissociateGeometry() - call geometry%Free() - call interp%Free() - call f%free() - call df%free() - call mesh%Free() - - endfunction mappedvectordgdivergence_2d_linear -endprogram test + call df%UpdateHost() + + ! Calculate diff from exact + df%interior = abs(df%interior - 2.0_prec) + + print *, "absmax error :", maxval(df%interior) + if (maxval(df%interior) <= tolerance) then + r = 0 + else + print *, "absmax error greater than tolerance :", tolerance + r = 1 + end if + + ! Clean up + call f%DissociateGeometry() + call geometry%Free() + call interp%Free() + call f%free() + call df%free() + call mesh%Free() + + end function mappedvectordgdivergence_2d_linear +end program test diff --git a/test/mappedvectordgdivergence_2d_linear_sideexchange_mpi.f90 b/test/mappedvectordgdivergence_2d_linear_sideexchange_mpi.f90 index 42eed794c..29ac8fcf6 100644 --- a/test/mappedvectordgdivergence_2d_linear_sideexchange_mpi.f90 +++ b/test/mappedvectordgdivergence_2d_linear_sideexchange_mpi.f90 @@ -26,134 +26,134 @@ program test - implicit none - integer :: exit_code + implicit none + integer :: exit_code - exit_code = mappedvectordgdivergence_2d_linear() - if(exit_code /= 0) then - stop exit_code - endif + exit_code = mappedvectordgdivergence_2d_linear() + if (exit_code /= 0) then + stop exit_code + end if contains - integer function mappedvectordgdivergence_2d_linear() result(r) + integer function mappedvectordgdivergence_2d_linear() result(r) - use SELF_Constants - use SELF_Lagrange - use SELF_Mesh_2D - use SELF_Geometry_2D - use SELF_MappedScalar_2D - use SELF_MappedVector_2D + use SELF_Constants + use SELF_Lagrange + use SELF_Mesh_2D + use SELF_Geometry_2D + use SELF_MappedScalar_2D + use SELF_MappedVector_2D - implicit none + implicit none - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - integer,parameter :: nvar = 1 + integer, parameter :: controlDegree = 7 + integer, parameter :: targetDegree = 16 + integer, parameter :: nvar = 1 #ifdef DOUBLE_PRECISION - real(prec),parameter :: tolerance = 10.0_prec**(-7) + real(prec), parameter :: tolerance = 10.0_prec**(-7) #else - real(prec),parameter :: tolerance = 10.0_prec**(-3) + real(prec), parameter :: tolerance = 10.0_prec**(-3) #endif - type(Lagrange),target :: interp - type(Mesh2D),target :: mesh - type(SEMQuad),target :: geometry - type(MappedVector2D) :: f - type(MappedScalar2D) :: df - character(LEN=255) :: WORKSPACE - integer :: i,j,iel,e2 - real(prec) :: nhat(1:2),nmag,fx,fy,diff - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5",enableDomainDecomposition=.true.) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - call f%Init(interp,nvar,mesh%nelem) - call df%Init(interp,nvar,mesh%nelem) - call f%AssociateGeometry(geometry) - - call f%SetEquation(1,1,'f = x') ! x-component - call f%SetEquation(2,1,'f = y') ! y-component - - call f%SetInteriorFromEquation(geometry,0.0_prec) - print*,"min, max (interior)",minval(f%interior),maxval(f%interior) - - call f%boundaryInterp() - call f%UpdateHost() - - call f%SideExchange(mesh) - call f%UpdateHost() - - ! Set boundary conditions - do iEl = 1,f%nElem - do j = 1,4 - e2 = mesh%sideInfo(3,j,iel) ! Neighbor Element (global id) - - if(e2 == 0) then ! Exterior edge - do i = 1,f%interp%N+1 - f%extboundary(i,j,iEl,1,1) = f%boundary(i,j,iEl,1,1) - f%extboundary(i,j,iEl,1,2) = f%boundary(i,j,iEl,1,2) - enddo - endif - enddo - enddo - - do iEl = 1,f%nElem - do j = 1,4 - diff = 0.0_prec - do i = 1,f%interp%N+1 - - ! Get the boundary normals on cell edges from the mesh geometry - nhat(1:2) = geometry%nHat%boundary(i,j,iEl,1,1:2) - nmag = geometry%nScale%boundary(i,j,iEl,1) - diff = diff+abs(f%boundary(i,j,iEl,1,1)-f%extboundary(i,j,iEl,1,1)) - fx = 0.5*(f%boundary(i,j,iEl,1,1)+f%extboundary(i,j,iEl,1,1)) - fy = 0.5*(f%boundary(i,j,iEl,1,2)+f%extboundary(i,j,iEl,1,2)) - - f%boundaryNormal(i,j,iEl,1) = (fx*nhat(1)+fy*nhat(2))*nmag - - enddo - if(diff > tolerance) then - print*,'rank ',mesh%decomp%rankId,' : mismatched edge iel, s (diff)= ',iel,j,diff - endif - enddo - enddo - - call f%UpdateDevice() + type(Lagrange), target :: interp + type(Mesh2D), target :: mesh + type(SEMQuad), target :: geometry + type(MappedVector2D) :: f + type(MappedScalar2D) :: df + character(LEN=255) :: WORKSPACE + integer :: i, j, iel, e2 + real(prec) :: nhat(1:2), nmag, fx, fy, diff + + ! Create a uniform block mesh + call get_environment_variable("WORKSPACE", WORKSPACE) + call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") + + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) + + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp, mesh%nElem) + call geometry%GenerateFromMesh(mesh) + + call f%Init(interp, nvar, mesh%nelem) + call df%Init(interp, nvar, mesh%nelem) + call f%AssociateGeometry(geometry) + + call f%SetEquation(1, 1, 'f = x') ! x-component + call f%SetEquation(2, 1, 'f = y') ! y-component + + call f%SetInteriorFromEquation(geometry, 0.0_prec) + print *, "min, max (interior)", minval(f%interior), maxval(f%interior) + + call f%boundaryInterp() + call f%UpdateHost() + + call f%SideExchange(mesh) + call f%UpdateHost() + + ! Set boundary conditions + do iEl = 1, f%nElem + do j = 1, 4 + e2 = mesh%sideInfo(3, j, iel) ! Neighbor Element (global id) + + if (e2 == 0) then ! Exterior edge + do i = 1, f%interp%N + 1 + f%extboundary(i, j, iEl, 1, 1) = f%boundary(i, j, iEl, 1, 1) + f%extboundary(i, j, iEl, 1, 2) = f%boundary(i, j, iEl, 1, 2) + end do + end if + end do + end do + + do iEl = 1, f%nElem + do j = 1, 4 + diff = 0.0_prec + do i = 1, f%interp%N + 1 + + ! Get the boundary normals on cell edges from the mesh geometry + nhat(1:2) = geometry%nHat%boundary(i, j, iEl, 1, 1:2) + nmag = geometry%nScale%boundary(i, j, iEl, 1) + diff = diff + abs(f%boundary(i, j, iEl, 1, 1) - f%extboundary(i, j, iEl, 1, 1)) + fx = 0.5*(f%boundary(i, j, iEl, 1, 1) + f%extboundary(i, j, iEl, 1, 1)) + fy = 0.5*(f%boundary(i, j, iEl, 1, 2) + f%extboundary(i, j, iEl, 1, 2)) + + f%boundaryNormal(i, j, iEl, 1) = (fx*nhat(1) + fy*nhat(2))*nmag + + end do + if (diff > tolerance) then + print *, 'rank ', mesh%decomp%rankId, ' : mismatched edge iel, s (diff)= ', iel, j, diff + end if + end do + end do + + call f%UpdateDevice() #ifdef ENABLE_GPU - call f%MappedDGDivergence(df%interior_gpu) + call f%MappedDGDivergence(df%interior_gpu) #else - call f%MappedDGDivergence(df%interior) + call f%MappedDGDivergence(df%interior) #endif - call df%UpdateHost() - - ! Calculate diff from exact - df%interior = abs(df%interior-2.0_prec) - - print*,"absmax error :",maxval(df%interior) - if(maxval(df%interior) <= tolerance) then - r = 0 - else - r = 1 - endif - - ! Clean up - call f%DissociateGeometry() - call geometry%Free() - call mesh%Free() - call interp%Free() - call f%free() - call df%free() - - endfunction mappedvectordgdivergence_2d_linear -endprogram test + call df%UpdateHost() + + ! Calculate diff from exact + df%interior = abs(df%interior - 2.0_prec) + + print *, "absmax error :", maxval(df%interior) + if (maxval(df%interior) <= tolerance) then + r = 0 + else + r = 1 + end if + + ! Clean up + call f%DissociateGeometry() + call geometry%Free() + call mesh%Free() + call interp%Free() + call f%free() + call df%free() + + end function mappedvectordgdivergence_2d_linear +end program test diff --git a/test/mappedvectordgdivergence_2d_linear_structuredmesh_mpi.f90 b/test/mappedvectordgdivergence_2d_linear_structuredmesh_mpi.f90 index d5d5632a5..2f6cee4a3 100644 --- a/test/mappedvectordgdivergence_2d_linear_structuredmesh_mpi.f90 +++ b/test/mappedvectordgdivergence_2d_linear_structuredmesh_mpi.f90 @@ -26,134 +26,134 @@ program test - implicit none - integer :: exit_code + implicit none + integer :: exit_code - exit_code = mappedvectordgdivergence_2d_linear() - if(exit_code /= 0) then - stop exit_code - endif + exit_code = mappedvectordgdivergence_2d_linear() + if (exit_code /= 0) then + stop exit_code + end if contains - integer function mappedvectordgdivergence_2d_linear() result(r) + integer function mappedvectordgdivergence_2d_linear() result(r) - use SELF_Constants - use SELF_Lagrange - use SELF_Mesh_2D - use SELF_Geometry_2D - use SELF_MappedScalar_2D - use SELF_MappedVector_2D + use SELF_Constants + use SELF_Lagrange + use SELF_Mesh_2D + use SELF_Geometry_2D + use SELF_MappedScalar_2D + use SELF_MappedVector_2D - implicit none + implicit none - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - integer,parameter :: nvar = 1 + integer, parameter :: controlDegree = 7 + integer, parameter :: targetDegree = 16 + integer, parameter :: nvar = 1 #ifdef DOUBLE_PRECISION - real(prec),parameter :: tolerance = 10.0_prec**(-7) + real(prec), parameter :: tolerance = 10.0_prec**(-7) #else - real(prec),parameter :: tolerance = 10.0_prec**(-3) + real(prec), parameter :: tolerance = 10.0_prec**(-3) #endif - type(Lagrange),target :: interp - type(Mesh2D),target :: mesh - type(SEMQuad),target :: geometry - type(MappedVector2D) :: f - type(MappedScalar2D) :: df - character(LEN=255) :: WORKSPACE - integer :: i,j,iel,e2 - real(prec) :: nhat(1:2),nmag,fx,fy,diff - integer :: bcids(1:4) - - ! Create a structured mesh - bcids(1:4) = [SELF_BC_PRESCRIBED, & ! South - SELF_BC_PRESCRIBED, & ! East - SELF_BC_PRESCRIBED, & ! North - SELF_BC_PRESCRIBED] ! West - call mesh%StructuredMesh(10,10,2,2,0.05_prec,0.05_prec,bcids,enableDomainDecomposition=.true.) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - call f%Init(interp,nvar,mesh%nelem) - call df%Init(interp,nvar,mesh%nelem) - call f%AssociateGeometry(geometry) - - call f%SetEquation(1,1,'f = x') ! x-component - call f%SetEquation(2,1,'f = y') ! y-component - - call f%SetInteriorFromEquation(geometry,0.0_prec) - print*,"min, max (interior)",minval(f%interior),maxval(f%interior) - - call f%boundaryInterp() - call f%SideExchange(mesh) - call f%UpdateHost() - ! Set boundary conditions by prolonging the "boundary" attribute to the domain boundaries - do iel = 1,f%nElem - do j = 1,4 - e2 = mesh%sideInfo(3,j,iel) ! Neighboring Element ID - if(e2 == 0) then - do i = 1,f%interp%N+1 - f%extBoundary(i,j,iel,1,1:2) = f%boundary(i,j,iel,1,1:2) - enddo - endif - enddo - enddo - - do iEl = 1,f%nElem - do j = 1,4 - diff = 0.0_prec - do i = 1,f%interp%N+1 - - ! Get the boundary normals on cell edges from the mesh geometry - nhat(1:2) = geometry%nHat%boundary(i,j,iEl,1,1:2) - nmag = geometry%nScale%boundary(i,j,iEl,1) - diff = diff+abs(f%boundary(i,j,iEl,1,1)-f%extboundary(i,j,iEl,1,1)) - - fx = 0.5*(f%boundary(i,j,iEl,1,1)+f%extboundary(i,j,iEl,1,1)) - fy = 0.5*(f%boundary(i,j,iEl,1,2)+f%extboundary(i,j,iEl,1,2)) - - f%boundaryNormal(i,j,iEl,1) = (fx*nhat(1)+fy*nhat(2))*nmag - - enddo - if(diff > tolerance) then - print*,'rank ',mesh%decomp%rankId,' : mismatched edge iel, s (diff)= ',iel,j,diff - endif - enddo - enddo - - call f%UpdateDevice() + type(Lagrange), target :: interp + type(Mesh2D), target :: mesh + type(SEMQuad), target :: geometry + type(MappedVector2D) :: f + type(MappedScalar2D) :: df + character(LEN=255) :: WORKSPACE + integer :: i, j, iel, e2 + real(prec) :: nhat(1:2), nmag, fx, fy, diff + integer :: bcids(1:4) + + ! Create a structured mesh + bcids(1:4) = [SELF_BC_PRESCRIBED, & ! South + SELF_BC_PRESCRIBED, & ! East + SELF_BC_PRESCRIBED, & ! North + SELF_BC_PRESCRIBED] ! West + call mesh%StructuredMesh(10, 10, 2, 2, 0.05_prec, 0.05_prec, bcids) + + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) + + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp, mesh%nElem) + call geometry%GenerateFromMesh(mesh) + + call f%Init(interp, nvar, mesh%nelem) + call df%Init(interp, nvar, mesh%nelem) + call f%AssociateGeometry(geometry) + + call f%SetEquation(1, 1, 'f = x') ! x-component + call f%SetEquation(2, 1, 'f = y') ! y-component + + call f%SetInteriorFromEquation(geometry, 0.0_prec) + print *, "min, max (interior)", minval(f%interior), maxval(f%interior) + + call f%boundaryInterp() + call f%SideExchange(mesh) + call f%UpdateHost() + ! Set boundary conditions by prolonging the "boundary" attribute to the domain boundaries + do iel = 1, f%nElem + do j = 1, 4 + e2 = mesh%sideInfo(3, j, iel) ! Neighboring Element ID + if (e2 == 0) then + do i = 1, f%interp%N + 1 + f%extBoundary(i, j, iel, 1, 1:2) = f%boundary(i, j, iel, 1, 1:2) + end do + end if + end do + end do + + do iEl = 1, f%nElem + do j = 1, 4 + diff = 0.0_prec + do i = 1, f%interp%N + 1 + + ! Get the boundary normals on cell edges from the mesh geometry + nhat(1:2) = geometry%nHat%boundary(i, j, iEl, 1, 1:2) + nmag = geometry%nScale%boundary(i, j, iEl, 1) + diff = diff + abs(f%boundary(i, j, iEl, 1, 1) - f%extboundary(i, j, iEl, 1, 1)) + + fx = 0.5*(f%boundary(i, j, iEl, 1, 1) + f%extboundary(i, j, iEl, 1, 1)) + fy = 0.5*(f%boundary(i, j, iEl, 1, 2) + f%extboundary(i, j, iEl, 1, 2)) + + f%boundaryNormal(i, j, iEl, 1) = (fx*nhat(1) + fy*nhat(2))*nmag + + end do + if (diff > tolerance) then + print *, 'rank ', mesh%decomp%rankId, ' : mismatched edge iel, s (diff)= ', iel, j, diff + end if + end do + end do + + call f%UpdateDevice() #ifdef ENABLE_GPU - call f%MappedDGDivergence(df%interior_gpu) + call f%MappedDGDivergence(df%interior_gpu) #else - call f%MappedDGDivergence(df%interior) + call f%MappedDGDivergence(df%interior) #endif - call df%UpdateHost() - - ! Calculate diff from exact - df%interior = abs(df%interior-2.0_prec) - - print*,"absmax error :",maxval(df%interior) - if(maxval(df%interior) <= tolerance) then - r = 0 - else - r = 1 - endif - - ! Clean up - call f%DissociateGeometry() - call geometry%Free() - call mesh%Free() - call interp%Free() - call f%free() - call df%free() - - endfunction mappedvectordgdivergence_2d_linear -endprogram test + call df%UpdateHost() + + ! Calculate diff from exact + df%interior = abs(df%interior - 2.0_prec) + + print *, "absmax error :", maxval(df%interior) + if (maxval(df%interior) <= tolerance) then + r = 0 + else + r = 1 + end if + + ! Clean up + call f%DissociateGeometry() + call geometry%Free() + call mesh%Free() + call interp%Free() + call f%free() + call df%free() + + end function mappedvectordgdivergence_2d_linear +end program test diff --git a/test/mappedvectordgdivergence_3d_linear_mpi.f90 b/test/mappedvectordgdivergence_3d_linear_mpi.f90 index 3187c1152..4817d75d3 100644 --- a/test/mappedvectordgdivergence_3d_linear_mpi.f90 +++ b/test/mappedvectordgdivergence_3d_linear_mpi.f90 @@ -26,113 +26,113 @@ program test - implicit none - integer :: exit_code + implicit none + integer :: exit_code - exit_code = mappedvectordgdivergence_3d_linear() - if(exit_code /= 0) then - stop exit_code - endif + exit_code = mappedvectordgdivergence_3d_linear() + if (exit_code /= 0) then + stop exit_code + end if contains - integer function mappedvectordgdivergence_3d_linear() result(r) + integer function mappedvectordgdivergence_3d_linear() result(r) - use SELF_Constants - use SELF_Lagrange - use SELF_Mesh_3D - use SELF_Geometry_3D - use SELF_MappedScalar_3D - use SELF_MappedVector_3D + use SELF_Constants + use SELF_Lagrange + use SELF_Mesh_3D + use SELF_Geometry_3D + use SELF_MappedScalar_3D + use SELF_MappedVector_3D - implicit none + implicit none - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - integer,parameter :: nvar = 1 + integer, parameter :: controlDegree = 7 + integer, parameter :: targetDegree = 16 + integer, parameter :: nvar = 1 #ifdef DOUBLE_PRECISION - real(prec),parameter :: tolerance = 10.0_prec**(-7) + real(prec), parameter :: tolerance = 10.0_prec**(-7) #else - real(prec),parameter :: tolerance = 10.0_prec**(-3) + real(prec), parameter :: tolerance = 10.0_prec**(-3) #endif - type(Lagrange),target :: interp - type(Mesh3D),target :: mesh - type(SEMHex),target :: geometry - type(MappedVector3D) :: f - type(MappedScalar3D) :: df - character(LEN=255) :: WORKSPACE - integer :: i,j,k,iel - real(prec) :: nhat(1:3),nmag - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5",enableDomainDecomposition=.true.) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - call f%Init(interp,nvar,mesh%nelem) - call df%Init(interp,nvar,mesh%nelem) - call f%AssociateGeometry(geometry) - - call f%SetEquation(1,1,'f = x') ! x-component - call f%SetEquation(2,1,'f = y') ! y-component - call f%SetEquation(3,1,'f = z') ! z-component - - call f%SetInteriorFromEquation(geometry,0.0_prec) - print*,"min, max (interior)",minval(f%interior),maxval(f%interior) - call f%boundaryInterp() - call f%UpdateHost() - - do iEl = 1,f%nElem - do k = 1,6 - do j = 1,f%interp%N+1 - do i = 1,f%interp%N+1 - - ! Get the boundary normals on cell edges from the mesh geometry - nhat(1:3) = geometry%nHat%boundary(i,j,k,iEl,1,1:3) - nmag = geometry%nScale%boundary(i,j,k,iEl,1) - - f%boundaryNormal(i,j,k,iEl,1) = (f%boundary(i,j,k,iEl,1,1)*nhat(1)+ & - f%boundary(i,j,k,iEl,1,2)*nhat(2)+ & - f%boundary(i,j,k,iEl,1,3)*nhat(3))*nmag - enddo - enddo - enddo - enddo - call f%UpdateDevice() + type(Lagrange), target :: interp + type(Mesh3D), target :: mesh + type(SEMHex), target :: geometry + type(MappedVector3D) :: f + type(MappedScalar3D) :: df + character(LEN=255) :: WORKSPACE + integer :: i, j, k, iel + real(prec) :: nhat(1:3), nmag + + ! Create a uniform block mesh + call get_environment_variable("WORKSPACE", WORKSPACE) + call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") + + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) + + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp, mesh%nElem) + call geometry%GenerateFromMesh(mesh) + + call f%Init(interp, nvar, mesh%nelem) + call df%Init(interp, nvar, mesh%nelem) + call f%AssociateGeometry(geometry) + + call f%SetEquation(1, 1, 'f = x') ! x-component + call f%SetEquation(2, 1, 'f = y') ! y-component + call f%SetEquation(3, 1, 'f = z') ! z-component + + call f%SetInteriorFromEquation(geometry, 0.0_prec) + print *, "min, max (interior)", minval(f%interior), maxval(f%interior) + call f%boundaryInterp() + call f%UpdateHost() + + do iEl = 1, f%nElem + do k = 1, 6 + do j = 1, f%interp%N + 1 + do i = 1, f%interp%N + 1 + + ! Get the boundary normals on cell edges from the mesh geometry + nhat(1:3) = geometry%nHat%boundary(i, j, k, iEl, 1, 1:3) + nmag = geometry%nScale%boundary(i, j, k, iEl, 1) + + f%boundaryNormal(i, j, k, iEl, 1) = (f%boundary(i, j, k, iEl, 1, 1)*nhat(1) + & + f%boundary(i, j, k, iEl, 1, 2)*nhat(2) + & + f%boundary(i, j, k, iEl, 1, 3)*nhat(3))*nmag + end do + end do + end do + end do + call f%UpdateDevice() #ifdef ENABLE_GPU - call f%MappedDGDivergence(df%interior_gpu) + call f%MappedDGDivergence(df%interior_gpu) #else - call f%MappedDGDivergence(df%interior) + call f%MappedDGDivergence(df%interior) #endif - call df%UpdateHost() - - ! Calculate diff from exact - df%interior = abs(df%interior-3.0_prec) - - print*,"absmax error :",maxval(df%interior) - if(maxval(df%interior) <= tolerance) then - r = 0 - else - print*,"absmax error greater than tolerance :",tolerance - r = 1 - endif - - ! Clean up - call f%DissociateGeometry() - call geometry%Free() - call interp%Free() - call f%free() - call df%free() - call mesh%Free() - - endfunction mappedvectordgdivergence_3d_linear -endprogram test + call df%UpdateHost() + + ! Calculate diff from exact + df%interior = abs(df%interior - 3.0_prec) + + print *, "absmax error :", maxval(df%interior) + if (maxval(df%interior) <= tolerance) then + r = 0 + else + print *, "absmax error greater than tolerance :", tolerance + r = 1 + end if + + ! Clean up + call f%DissociateGeometry() + call geometry%Free() + call interp%Free() + call f%free() + call df%free() + call mesh%Free() + + end function mappedvectordgdivergence_3d_linear +end program test diff --git a/test/mappedvectordgdivergence_3d_linear_sideexchange_mpi.f90 b/test/mappedvectordgdivergence_3d_linear_sideexchange_mpi.f90 index b48d5402b..eee0efdd9 100644 --- a/test/mappedvectordgdivergence_3d_linear_sideexchange_mpi.f90 +++ b/test/mappedvectordgdivergence_3d_linear_sideexchange_mpi.f90 @@ -26,136 +26,136 @@ program test - implicit none - integer :: exit_code + implicit none + integer :: exit_code - exit_code = mappedvectordgdivergence_3d_linear() - if(exit_code /= 0) then - stop exit_code - endif + exit_code = mappedvectordgdivergence_3d_linear() + if (exit_code /= 0) then + stop exit_code + end if contains - integer function mappedvectordgdivergence_3d_linear() result(r) + integer function mappedvectordgdivergence_3d_linear() result(r) - use SELF_Constants - use SELF_Lagrange - use SELF_Mesh_3D - use SELF_Geometry_3D - use SELF_MappedScalar_3D - use SELF_MappedVector_3D + use SELF_Constants + use SELF_Lagrange + use SELF_Mesh_3D + use SELF_Geometry_3D + use SELF_MappedScalar_3D + use SELF_MappedVector_3D - implicit none + implicit none - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - integer,parameter :: nvar = 1 + integer, parameter :: controlDegree = 7 + integer, parameter :: targetDegree = 16 + integer, parameter :: nvar = 1 #ifdef DOUBLE_PRECISION - real(prec),parameter :: tolerance = 10.0_prec**(-7) + real(prec), parameter :: tolerance = 10.0_prec**(-7) #else - real(prec),parameter :: tolerance = 10.0_prec**(-3) + real(prec), parameter :: tolerance = 10.0_prec**(-3) #endif - type(Lagrange),target :: interp - type(Mesh3D),target :: mesh - type(SEMHex),target :: geometry - type(MappedVector3D) :: f - type(MappedScalar3D) :: df - character(LEN=255) :: WORKSPACE - integer :: i,j,k,iel,e2 - real(prec) :: nhat(1:3),nmag,fx,fy,fz - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5",enableDomainDecomposition=.true.) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - call f%Init(interp,nvar,mesh%nelem) - call df%Init(interp,nvar,mesh%nelem) - call f%AssociateGeometry(geometry) - - call f%SetEquation(1,1,'f = x') ! x-component - call f%SetEquation(2,1,'f = y') ! y-component - call f%SetEquation(3,1,'f = 0') ! z-component - - call f%SetInteriorFromEquation(geometry,0.0_prec) - print*,"min, max (interior)",minval(f%interior),maxval(f%interior) - call f%boundaryInterp() - - print*,"Exchanging data on element faces" - - call f%SideExchange(mesh) - call f%UpdateHost() - - print*,"Setting boundary conditions" - ! Set boundary conditions - do iEl = 1,f%nElem - do k = 1,6 - e2 = mesh%sideInfo(3,k,iel) ! Neighbor Element (global id) - - if(e2 == 0) then ! Exterior edge - do j = 1,f%interp%N+1 - do i = 1,f%interp%N+1 - f%extboundary(i,j,k,iEl,1,1) = f%boundary(i,j,k,iEl,1,1) - f%extboundary(i,j,k,iEl,1,2) = f%boundary(i,j,k,iEl,1,2) - f%extboundary(i,j,k,iEl,1,3) = f%boundary(i,j,k,iEl,1,3) - enddo - enddo - endif - enddo - enddo - - print*,"Calculating boundary normal flux" - do iEl = 1,f%nElem - do k = 1,6 - do j = 1,f%interp%N+1 - do i = 1,f%interp%N+1 - - ! Get the boundary normals on cell edges from the mesh geometry - nhat(1:3) = geometry%nHat%boundary(i,j,k,iEl,1,1:3) - nmag = geometry%nScale%boundary(i,j,k,iEl,1) - fx = 0.5*(f%boundary(i,j,k,iEl,1,1)+f%extboundary(i,j,k,iEl,1,1)) - fy = 0.5*(f%boundary(i,j,k,iEl,1,2)+f%extboundary(i,j,k,iEl,1,2)) - fz = 0.5*(f%boundary(i,j,k,iEl,1,3)+f%extboundary(i,j,k,iEl,1,3)) - - f%boundaryNormal(i,j,k,iEl,1) = (fx*nhat(1)+fy*nhat(2)+fz*nhat(3))*nmag - enddo - enddo - enddo - enddo - call f%UpdateDevice() + type(Lagrange), target :: interp + type(Mesh3D), target :: mesh + type(SEMHex), target :: geometry + type(MappedVector3D) :: f + type(MappedScalar3D) :: df + character(LEN=255) :: WORKSPACE + integer :: i, j, k, iel, e2 + real(prec) :: nhat(1:3), nmag, fx, fy, fz + + ! Create a uniform block mesh + call get_environment_variable("WORKSPACE", WORKSPACE) + call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") + + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) + + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp, mesh%nElem) + call geometry%GenerateFromMesh(mesh) + + call f%Init(interp, nvar, mesh%nelem) + call df%Init(interp, nvar, mesh%nelem) + call f%AssociateGeometry(geometry) + + call f%SetEquation(1, 1, 'f = x') ! x-component + call f%SetEquation(2, 1, 'f = y') ! y-component + call f%SetEquation(3, 1, 'f = 0') ! z-component + + call f%SetInteriorFromEquation(geometry, 0.0_prec) + print *, "min, max (interior)", minval(f%interior), maxval(f%interior) + call f%boundaryInterp() + + print *, "Exchanging data on element faces" + + call f%SideExchange(mesh) + call f%UpdateHost() + + print *, "Setting boundary conditions" + ! Set boundary conditions + do iEl = 1, f%nElem + do k = 1, 6 + e2 = mesh%sideInfo(3, k, iel) ! Neighbor Element (global id) + + if (e2 == 0) then ! Exterior edge + do j = 1, f%interp%N + 1 + do i = 1, f%interp%N + 1 + f%extboundary(i, j, k, iEl, 1, 1) = f%boundary(i, j, k, iEl, 1, 1) + f%extboundary(i, j, k, iEl, 1, 2) = f%boundary(i, j, k, iEl, 1, 2) + f%extboundary(i, j, k, iEl, 1, 3) = f%boundary(i, j, k, iEl, 1, 3) + end do + end do + end if + end do + end do + + print *, "Calculating boundary normal flux" + do iEl = 1, f%nElem + do k = 1, 6 + do j = 1, f%interp%N + 1 + do i = 1, f%interp%N + 1 + + ! Get the boundary normals on cell edges from the mesh geometry + nhat(1:3) = geometry%nHat%boundary(i, j, k, iEl, 1, 1:3) + nmag = geometry%nScale%boundary(i, j, k, iEl, 1) + fx = 0.5*(f%boundary(i, j, k, iEl, 1, 1) + f%extboundary(i, j, k, iEl, 1, 1)) + fy = 0.5*(f%boundary(i, j, k, iEl, 1, 2) + f%extboundary(i, j, k, iEl, 1, 2)) + fz = 0.5*(f%boundary(i, j, k, iEl, 1, 3) + f%extboundary(i, j, k, iEl, 1, 3)) + + f%boundaryNormal(i, j, k, iEl, 1) = (fx*nhat(1) + fy*nhat(2) + fz*nhat(3))*nmag + end do + end do + end do + end do + call f%UpdateDevice() #ifdef ENABLE_GPU - call f%MappedDGDivergence(df%interior_gpu) + call f%MappedDGDivergence(df%interior_gpu) #else - call f%MappedDGDivergence(df%interior) + call f%MappedDGDivergence(df%interior) #endif - call df%UpdateHost() - - ! Calculate diff from exact - df%interior = abs(df%interior-2.0_prec) - - if(maxval(df%interior) <= tolerance) then - r = 0 - else - print*,"max error (tolerance)",maxval(df%interior),tolerance - r = 1 - endif - - ! Clean up - call f%DissociateGeometry() - call geometry%Free() - call mesh%Free() - call interp%Free() - call f%free() - call df%free() - - endfunction mappedvectordgdivergence_3d_linear -endprogram test + call df%UpdateHost() + + ! Calculate diff from exact + df%interior = abs(df%interior - 2.0_prec) + + if (maxval(df%interior) <= tolerance) then + r = 0 + else + print *, "max error (tolerance)", maxval(df%interior), tolerance + r = 1 + end if + + ! Clean up + call f%DissociateGeometry() + call geometry%Free() + call mesh%Free() + call interp%Free() + call f%free() + call df%free() + + end function mappedvectordgdivergence_3d_linear +end program test diff --git a/test/mappedvectordgdivergence_3d_linear_structuredmesh_mpi.f90 b/test/mappedvectordgdivergence_3d_linear_structuredmesh_mpi.f90 index 9a4b2fbfe..cb2a80757 100644 --- a/test/mappedvectordgdivergence_3d_linear_structuredmesh_mpi.f90 +++ b/test/mappedvectordgdivergence_3d_linear_structuredmesh_mpi.f90 @@ -26,145 +26,145 @@ program test - implicit none - integer :: exit_code + implicit none + integer :: exit_code - exit_code = mappedvectordgdivergence_3d_linear() - if(exit_code /= 0) then - stop exit_code - endif + exit_code = mappedvectordgdivergence_3d_linear() + if (exit_code /= 0) then + stop exit_code + end if contains - integer function mappedvectordgdivergence_3d_linear() result(r) + integer function mappedvectordgdivergence_3d_linear() result(r) - use SELF_Constants - use SELF_Lagrange - use SELF_Mesh_3D - use SELF_Geometry_3D - use SELF_MappedScalar_3D - use SELF_MappedVector_3D + use SELF_Constants + use SELF_Lagrange + use SELF_Mesh_3D + use SELF_Geometry_3D + use SELF_MappedScalar_3D + use SELF_MappedVector_3D - implicit none + implicit none - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - integer,parameter :: nvar = 1 + integer, parameter :: controlDegree = 7 + integer, parameter :: targetDegree = 16 + integer, parameter :: nvar = 1 #ifdef DOUBLE_PRECISION - real(prec),parameter :: tolerance = 10.0_prec**(-7) + real(prec), parameter :: tolerance = 10.0_prec**(-7) #else - real(prec),parameter :: tolerance = 10.0_prec**(-3) + real(prec), parameter :: tolerance = 10.0_prec**(-3) #endif - type(Lagrange),target :: interp - type(Mesh3D),target :: mesh - type(SEMHex),target :: geometry - type(MappedVector3D) :: f - type(MappedScalar3D) :: df - integer :: i,j,k,iel,e2 - real(prec) :: nhat(1:3),nmag,fx,fy,fz - integer :: bcids(1:6) - - ! Create a uniform block mesh - bcids(1:6) = [SELF_BC_PRESCRIBED, & ! Bottom - SELF_BC_PRESCRIBED, & ! South - SELF_BC_PRESCRIBED, & ! East - SELF_BC_PRESCRIBED, & ! North - SELF_BC_PRESCRIBED, & ! West - SELF_BC_PRESCRIBED] ! Top - - call mesh%StructuredMesh(5,5,5, & - 2,2,2, & - 0.1_prec,0.1_prec,0.1_prec, & - bcids,enableDomainDecomposition=.true.) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - call f%Init(interp,nvar,mesh%nelem) - call df%Init(interp,nvar,mesh%nelem) - call f%AssociateGeometry(geometry) - - call f%SetEquation(1,1,'f = x') ! x-component - call f%SetEquation(2,1,'f = y') ! y-component - call f%SetEquation(3,1,'f = 0') ! z-component - - call f%SetInteriorFromEquation(geometry,0.0_prec) - print*,"min, max (interior)",minval(f%interior),maxval(f%interior) - call f%boundaryInterp() - - print*,"Exchanging data on element faces" - - call f%SideExchange(mesh) - call f%UpdateHost() - - print*,"Setting boundary conditions" - ! Set boundary conditions - do iEl = 1,f%nElem - do k = 1,6 - e2 = mesh%sideInfo(3,k,iel) ! Neighbor Element (global id) - - if(e2 == 0) then ! Exterior edge - do j = 1,f%interp%N+1 - do i = 1,f%interp%N+1 - f%extboundary(i,j,k,iEl,1,1) = f%boundary(i,j,k,iEl,1,1) - f%extboundary(i,j,k,iEl,1,2) = f%boundary(i,j,k,iEl,1,2) - f%extboundary(i,j,k,iEl,1,3) = f%boundary(i,j,k,iEl,1,3) - enddo - enddo - endif - enddo - enddo - - print*,"Calculating boundary normal flux" - do iEl = 1,f%nElem - do k = 1,6 - do j = 1,f%interp%N+1 - do i = 1,f%interp%N+1 - - ! Get the boundary normals on cell edges from the mesh geometry - nhat(1:3) = geometry%nHat%boundary(i,j,k,iEl,1,1:3) - nmag = geometry%nScale%boundary(i,j,k,iEl,1) - fx = 0.5*(f%boundary(i,j,k,iEl,1,1)+f%extboundary(i,j,k,iEl,1,1)) - fy = 0.5*(f%boundary(i,j,k,iEl,1,2)+f%extboundary(i,j,k,iEl,1,2)) - fz = 0.5*(f%boundary(i,j,k,iEl,1,3)+f%extboundary(i,j,k,iEl,1,3)) - - f%boundaryNormal(i,j,k,iEl,1) = (fx*nhat(1)+fy*nhat(2)+fz*nhat(3))*nmag - enddo - enddo - enddo - enddo - call f%UpdateDevice() + type(Lagrange), target :: interp + type(Mesh3D), target :: mesh + type(SEMHex), target :: geometry + type(MappedVector3D) :: f + type(MappedScalar3D) :: df + integer :: i, j, k, iel, e2 + real(prec) :: nhat(1:3), nmag, fx, fy, fz + integer :: bcids(1:6) + + ! Create a uniform block mesh + bcids(1:6) = [SELF_BC_PRESCRIBED, & ! Bottom + SELF_BC_PRESCRIBED, & ! South + SELF_BC_PRESCRIBED, & ! East + SELF_BC_PRESCRIBED, & ! North + SELF_BC_PRESCRIBED, & ! West + SELF_BC_PRESCRIBED] ! Top + + call mesh%StructuredMesh(5, 5, 5, & + 2, 2, 2, & + 0.1_prec, 0.1_prec, 0.1_prec, & + bcids) + + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) + + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp, mesh%nElem) + call geometry%GenerateFromMesh(mesh) + + call f%Init(interp, nvar, mesh%nelem) + call df%Init(interp, nvar, mesh%nelem) + call f%AssociateGeometry(geometry) + + call f%SetEquation(1, 1, 'f = x') ! x-component + call f%SetEquation(2, 1, 'f = y') ! y-component + call f%SetEquation(3, 1, 'f = 0') ! z-component + + call f%SetInteriorFromEquation(geometry, 0.0_prec) + print *, "min, max (interior)", minval(f%interior), maxval(f%interior) + call f%boundaryInterp() + + print *, "Exchanging data on element faces" + + call f%SideExchange(mesh) + call f%UpdateHost() + + print *, "Setting boundary conditions" + ! Set boundary conditions + do iEl = 1, f%nElem + do k = 1, 6 + e2 = mesh%sideInfo(3, k, iel) ! Neighbor Element (global id) + + if (e2 == 0) then ! Exterior edge + do j = 1, f%interp%N + 1 + do i = 1, f%interp%N + 1 + f%extboundary(i, j, k, iEl, 1, 1) = f%boundary(i, j, k, iEl, 1, 1) + f%extboundary(i, j, k, iEl, 1, 2) = f%boundary(i, j, k, iEl, 1, 2) + f%extboundary(i, j, k, iEl, 1, 3) = f%boundary(i, j, k, iEl, 1, 3) + end do + end do + end if + end do + end do + + print *, "Calculating boundary normal flux" + do iEl = 1, f%nElem + do k = 1, 6 + do j = 1, f%interp%N + 1 + do i = 1, f%interp%N + 1 + + ! Get the boundary normals on cell edges from the mesh geometry + nhat(1:3) = geometry%nHat%boundary(i, j, k, iEl, 1, 1:3) + nmag = geometry%nScale%boundary(i, j, k, iEl, 1) + fx = 0.5*(f%boundary(i, j, k, iEl, 1, 1) + f%extboundary(i, j, k, iEl, 1, 1)) + fy = 0.5*(f%boundary(i, j, k, iEl, 1, 2) + f%extboundary(i, j, k, iEl, 1, 2)) + fz = 0.5*(f%boundary(i, j, k, iEl, 1, 3) + f%extboundary(i, j, k, iEl, 1, 3)) + + f%boundaryNormal(i, j, k, iEl, 1) = (fx*nhat(1) + fy*nhat(2) + fz*nhat(3))*nmag + end do + end do + end do + end do + call f%UpdateDevice() #ifdef ENABLE_GPU - call f%MappedDGDivergence(df%interior_gpu) + call f%MappedDGDivergence(df%interior_gpu) #else - call f%MappedDGDivergence(df%interior) + call f%MappedDGDivergence(df%interior) #endif - call df%UpdateHost() - - ! Calculate diff from exact - df%interior = abs(df%interior-2.0_prec) - - if(maxval(df%interior) <= tolerance) then - r = 0 - else - print*,"max error (tolerance)",maxval(df%interior),tolerance - r = 1 - endif - - ! Clean up - call f%DissociateGeometry() - call geometry%Free() - call mesh%Free() - call interp%Free() - call f%free() - call df%free() - - endfunction mappedvectordgdivergence_3d_linear -endprogram test + call df%UpdateHost() + + ! Calculate diff from exact + df%interior = abs(df%interior - 2.0_prec) + + if (maxval(df%interior) <= tolerance) then + r = 0 + else + print *, "max error (tolerance)", maxval(df%interior), tolerance + r = 1 + end if + + ! Clean up + call f%DissociateGeometry() + call geometry%Free() + call mesh%Free() + call interp%Free() + call f%free() + call df%free() + + end function mappedvectordgdivergence_3d_linear +end program test From d18893c701c7c0148792ff22f35050df29026612 Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Tue, 26 Nov 2024 02:38:41 +0000 Subject: [PATCH 2/5] Update docs to reflect automatic domain decomposition --- docs/MeshGeneration/StructuredMesh.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/docs/MeshGeneration/StructuredMesh.md b/docs/MeshGeneration/StructuredMesh.md index 67441ba80..eff24038e 100644 --- a/docs/MeshGeneration/StructuredMesh.md +++ b/docs/MeshGeneration/StructuredMesh.md @@ -56,7 +56,7 @@ You can set boundary conditions for each of the four sides of the structured mes * `SELF_BC_PRESCRIBED` * `SELF_BC_RADIATION` -The tiled layout is convenient for domain decomposition, when you are wanting to scale up your application for distributed memory platforms. You can further enable domain decomposition by setting the optional `enableDomainDecompisition` input to `.true.` . In this case, when you launch your application with `mpirun`, the domain will be automatically divided as evenly as possible across all MPI ranks. +The tiled layout is convenient for domain decomposition, when you are wanting to scale up your application for distributed memory platforms. Domain decomposition is automatically enabled when you launch your application with `mpirun/mpiexec/srun` with more than one rank. In this case, the domain will be automatically divided as evenly as possible across all MPI ranks. !!! note It's good practice to set the total number of tiles equal to the number of MPI ranks that you are running with. Alternatively, you can use fairly small tiles when working with a large number of MPI ranks to increase the chance of minimizing point-to-point communications . @@ -66,7 +66,7 @@ In the example below, we create a 2-D mesh with the following attributes * $2 × 2$ tiles for the domain * $10 × 10$ elements per tile * Each element is has dimensions of $0.05 × 0.05$. The domain dimensions are then $L_x × L_y = 1 × 1$ -* Domain decomposition is enabled +* Domain decomposition is enabled automatically when launched with more than one mpi rank The geometry fields are created from the mesh information and a $7^{th}$ degree interpolant through the Legendre-Gauss points. @@ -124,7 +124,7 @@ You can set boundary conditions for each of the four sides of the structured mes * `SELF_BC_PRESCRIBED` * `SELF_BC_RADIATION` -The tiled layout is convenient for domain decomposition, when you are wanting to scale up your application for distributed memory platforms. You can further enable domain decomposition by setting the optional `enableDomainDecompisition` input to `.true.` . In this case, when you launch your application with `mpirun`, the domain will be automatically divided as evenly as possible across all MPI ranks. +The tiled layout is convenient for domain decomposition, when you are wanting to scale up your application for distributed memory platforms. Domain decomposition is automatically enabled when you launch your application with `mpirun/mpiexec/srun` with more than one rank. In this case, the domain will be automatically divided as evenly as possible across all MPI ranks. !!! note It's good practice to set the total number of tiles equal to the number of MPI ranks that you are running with. Alternatively, you can use fairly small tiles when working with a large number of MPI ranks to increase the chance of minimizing point-to-point communications . From faecda056bf71d40dd1ad567415faeba7c8d0076 Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Tue, 26 Nov 2024 02:56:10 +0000 Subject: [PATCH 3/5] Remove commented code; propagate changes to gpu backend --- src/SELF_DomainDecomposition_t.f90 | 4 - src/gpu/SELF_DomainDecomposition.f90 | 205 +++++++++++++-------------- 2 files changed, 102 insertions(+), 107 deletions(-) diff --git a/src/SELF_DomainDecomposition_t.f90 b/src/SELF_DomainDecomposition_t.f90 index 9361edc91..e16d0cd83 100644 --- a/src/SELF_DomainDecomposition_t.f90 +++ b/src/SELF_DomainDecomposition_t.f90 @@ -76,7 +76,6 @@ subroutine Init_DomainDecomposition_t(this) this%nElem = 0 this%mpiEnabled = .false. - !if(enableMPI) then this%mpiComm = MPI_COMM_WORLD print *, __FILE__, " : Initializing MPI" call mpi_init(ierror) @@ -89,9 +88,6 @@ subroutine Init_DomainDecomposition_t(this) else print *, __FILE__, " : No domain decomposition used." end if - !else - ! print*,__FILE__," : MPI not initialized. No domain decomposition used." - !endif if (prec == real32) then this%mpiPrec = MPI_FLOAT diff --git a/src/gpu/SELF_DomainDecomposition.f90 b/src/gpu/SELF_DomainDecomposition.f90 index e2e9124e5..f52349e7f 100644 --- a/src/gpu/SELF_DomainDecomposition.f90 +++ b/src/gpu/SELF_DomainDecomposition.f90 @@ -26,126 +26,125 @@ module SELF_DomainDecomposition - use SELF_DomainDecomposition_t - use mpi - use iso_c_binding + use SELF_DomainDecomposition_t + use mpi + use iso_c_binding - implicit none + implicit none - type,extends(DomainDecomposition_t) :: DomainDecomposition - type(c_ptr) :: elemToRank_gpu + type, extends(DomainDecomposition_t) :: DomainDecomposition + type(c_ptr) :: elemToRank_gpu - contains + contains - procedure :: Init => Init_DomainDecomposition - procedure :: Free => Free_DomainDecomposition + procedure :: Init => Init_DomainDecomposition + procedure :: Free => Free_DomainDecomposition - procedure :: SetElemToRank => SetElemToRank_DomainDecomposition + procedure :: SetElemToRank => SetElemToRank_DomainDecomposition - endtype DomainDecomposition + end type DomainDecomposition contains - subroutine Init_DomainDecomposition(this,enableMPI) - implicit none - class(DomainDecomposition),intent(inout) :: this - logical,intent(in) :: enableMPI - ! Local - integer :: ierror - integer(c_int) :: num_devices,hip_err,device_id - - this%mpiComm = 0 - this%mpiPrec = prec - this%rankId = 0 - this%nRanks = 1 - this%nElem = 0 - this%mpiEnabled = enableMPI - - if(enableMPI) then + subroutine Init_DomainDecomposition(this) + implicit none + class(DomainDecomposition), intent(inout) :: this + ! Local + integer :: ierror + integer(c_int) :: num_devices, hip_err, device_id + + this%mpiComm = 0 + this%mpiPrec = prec + this%rankId = 0 + this%nRanks = 1 + this%nElem = 0 + this%mpiEnabled = .false. + this%mpiComm = MPI_COMM_WORLD - print*,__FILE__," : Initializing MPI" + print *, __FILE__, " : Initializing MPI" call mpi_init(ierror) - call mpi_comm_rank(this%mpiComm,this%rankId,ierror) - call mpi_comm_size(this%mpiComm,this%nRanks,ierror) - print*,__FILE__," : Rank ",this%rankId+1,"/",this%nRanks," checking in." - else - print*,__FILE__," : MPI not initialized. No domain decomposition used." - endif - - if(prec == real32) then - this%mpiPrec = MPI_FLOAT - else - this%mpiPrec = MPI_DOUBLE - endif - - allocate(this%offsetElem(1:this%nRanks+1)) - - hip_err = hipGetDeviceCount(num_devices) - if(hip_err /= 0) then - print*,'Failed to get device count on rank',this%rankId - call MPI_Abort(MPI_COMM_WORLD,hip_err,ierror) - endif - - ! Assign GPU device ID based on MPI rank - device_id = modulo(this%rankId,num_devices) ! Assumes that mpi ranks are packed sequentially on a node until the node is filled up. - hip_err = hipSetDevice(device_id) - print*,__FILE__," : Rank ",this%rankId+1," assigned to device ",device_id - if(hip_err /= 0) then - print*,'Failed to set device for rank',this%rankId,'to device',device_id - call MPI_Abort(MPI_COMM_WORLD,hip_err,ierror) - endif - - this%initialized = .true. - - endsubroutine Init_DomainDecomposition - subroutine Free_DomainDecomposition(this) - implicit none - class(DomainDecomposition),intent(inout) :: this - ! Local - integer :: ierror - - if(associated(this%offSetElem)) then - deallocate(this%offSetElem) - endif - if(associated(this%elemToRank)) then - deallocate(this%elemToRank) - call gpuCheck(hipFree(this%elemToRank_gpu)) - endif - - if(allocated(this%requests)) deallocate(this%requests) - if(allocated(this%stats)) deallocate(this%stats) - - if(this%mpiEnabled) then - print*,__FILE__," : Rank ",this%rankId+1,"/",this%nRanks," checking out." + call mpi_comm_rank(this%mpiComm, this%rankId, ierror) + call mpi_comm_size(this%mpiComm, this%nRanks, ierror) + print *, __FILE__, " : Rank ", this%rankId + 1, "/", this%nRanks, " checking in." + + if (this%nRanks > 1) then + this%mpiEnabled = .true. + else + print *, __FILE__, " : No domain decomposition used." + end if + + if (prec == real32) then + this%mpiPrec = MPI_FLOAT + else + this%mpiPrec = MPI_DOUBLE + end if + + allocate (this%offsetElem(1:this%nRanks + 1)) + + hip_err = hipGetDeviceCount(num_devices) + if (hip_err /= 0) then + print *, 'Failed to get device count on rank', this%rankId + call MPI_Abort(MPI_COMM_WORLD, hip_err, ierror) + end if + + ! Assign GPU device ID based on MPI rank + device_id = modulo(this%rankId, num_devices) ! Assumes that mpi ranks are packed sequentially on a node until the node is filled up. + hip_err = hipSetDevice(device_id) + print *, __FILE__, " : Rank ", this%rankId + 1, " assigned to device ", device_id + if (hip_err /= 0) then + print *, 'Failed to set device for rank', this%rankId, 'to device', device_id + call MPI_Abort(MPI_COMM_WORLD, hip_err, ierror) + end if + + this%initialized = .true. + + end subroutine Init_DomainDecomposition + subroutine Free_DomainDecomposition(this) + implicit none + class(DomainDecomposition), intent(inout) :: this + ! Local + integer :: ierror + + if (associated(this%offSetElem)) then + deallocate (this%offSetElem) + end if + if (associated(this%elemToRank)) then + deallocate (this%elemToRank) + call gpuCheck(hipFree(this%elemToRank_gpu)) + end if + + if (allocated(this%requests)) deallocate (this%requests) + if (allocated(this%stats)) deallocate (this%stats) + + print *, __FILE__, " : Rank ", this%rankId + 1, "/", this%nRanks, " checking out." call MPI_FINALIZE(ierror) - endif - endsubroutine Free_DomainDecomposition + end subroutine Free_DomainDecomposition - subroutine SetElemToRank_DomainDecomposition(this,nElem) - implicit none - class(DomainDecomposition),intent(inout) :: this - integer,intent(in) :: nElem - ! Local - integer :: iel + subroutine SetElemToRank_DomainDecomposition(this, nElem) + implicit none + class(DomainDecomposition), intent(inout) :: this + integer, intent(in) :: nElem + ! Local + integer :: iel - this%nElem = nElem + this%nElem = nElem - allocate(this%elemToRank(1:nelem)) - call gpuCheck(hipMalloc(this%elemToRank_gpu,sizeof(this%elemToRank))) + allocate (this%elemToRank(1:nelem)) + call gpuCheck(hipMalloc(this%elemToRank_gpu, sizeof(this%elemToRank))) - call DomainDecomp(nElem, & - this%nRanks, & - this%offSetElem) + call DomainDecomp(nElem, & + this%nRanks, & + this%offSetElem) - do iel = 1,nElem - call ElemToRank(this%nRanks, & - this%offSetElem, & - iel, & - this%elemToRank(iel)) - enddo - call gpuCheck(hipMemcpy(this%elemToRank_gpu,c_loc(this%elemToRank),sizeof(this%elemToRank),hipMemcpyHostToDevice)) + do iel = 1, nElem + call ElemToRank(this%nRanks, & + this%offSetElem, & + iel, & + this%elemToRank(iel)) + end do + call gpuCheck(hipMemcpy(this%elemToRank_gpu, c_loc(this%elemToRank), sizeof(this%elemToRank), hipMemcpyHostToDevice)) - endsubroutine SetElemToRank_DomainDecomposition + end subroutine SetElemToRank_DomainDecomposition -endmodule SELF_DomainDecomposition +end module SELF_DomainDecomposition From cd31b3fc321df222b5193b331f532cafb11c9d0e Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Tue, 26 Nov 2024 02:58:55 +0000 Subject: [PATCH 4/5] Remove additional unused commented code --- src/SELF_DomainDecomposition_t.f90 | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/src/SELF_DomainDecomposition_t.f90 b/src/SELF_DomainDecomposition_t.f90 index e16d0cd83..0eb1eb151 100644 --- a/src/SELF_DomainDecomposition_t.f90 +++ b/src/SELF_DomainDecomposition_t.f90 @@ -126,18 +126,6 @@ subroutine Free_DomainDecomposition_t(this) end subroutine Free_DomainDecomposition_t - ! subroutine LaunchedWithMPI_DomainDecomposition_t(this) - ! !! This subroutine uses typical environment variables to determine if the - ! !! program was launched with MPI. If so, the `mpiEnabled` flag is set to - ! !! true. - ! implicit none - ! class(DomainDecomposition_t),intent(inout) :: this - ! ! Local - ! integer :: var_status - - ! this%mpiEnabled = .false. - ! call get_environment_variable("OMPI_COMM_WORLD_SIZE",this%nRanks,status=var_status) - subroutine GenerateDecomposition_DomainDecomposition_t(this, nGlobalElem, maxMsg) implicit none class(DomainDecomposition_t), intent(inout) :: this From 0c3932ee375aeb5d5ae0a74da5fa93604b7ff38d Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Tue, 26 Nov 2024 03:13:36 +0000 Subject: [PATCH 5/5] Formatting --- src/SELF_DomainDecomposition_t.f90 | 416 ++--- src/SELF_Mesh_1D.f90 | 314 ++-- src/SELF_Mesh_2D_t.f90 | 1340 +++++++-------- src/SELF_Mesh_3D_t.f90 | 1436 ++++++++--------- src/gpu/SELF_DomainDecomposition.f90 | 226 +-- test/advection_diffusion_2d_rk3_mpi.f90 | 132 +- .../advection_diffusion_2d_rk3_pickup_mpi.f90 | 128 +- test/advection_diffusion_3d_rk3_mpi.f90 | 166 +- .../advection_diffusion_3d_rk3_pickup_mpi.f90 | 162 +- test/mappedscalarbrgradient_2d_linear_mpi.f90 | 228 +-- test/mappedscalarbrgradient_3d_linear_mpi.f90 | 246 +-- ...mappedvectordgdivergence_2d_linear_mpi.f90 | 168 +- ...gdivergence_2d_linear_sideexchange_mpi.f90 | 236 +-- ...ivergence_2d_linear_structuredmesh_mpi.f90 | 236 +-- ...mappedvectordgdivergence_3d_linear_mpi.f90 | 194 +-- ...gdivergence_3d_linear_sideexchange_mpi.f90 | 240 +-- ...ivergence_3d_linear_structuredmesh_mpi.f90 | 258 +-- 17 files changed, 3063 insertions(+), 3063 deletions(-) diff --git a/src/SELF_DomainDecomposition_t.f90 b/src/SELF_DomainDecomposition_t.f90 index 0eb1eb151..a2f591185 100644 --- a/src/SELF_DomainDecomposition_t.f90 +++ b/src/SELF_DomainDecomposition_t.f90 @@ -26,222 +26,222 @@ module SELF_DomainDecomposition_t - use SELF_Constants - use SELF_Lagrange - use SELF_SupportRoutines - use mpi - use iso_c_binding + use SELF_Constants + use SELF_Lagrange + use SELF_SupportRoutines + use mpi + use iso_c_binding - implicit none + implicit none - type DomainDecomposition_t - logical :: mpiEnabled = .false. - logical :: initialized = .false. - integer :: mpiComm - integer :: mpiPrec - integer :: rankId - integer :: nRanks - integer :: nElem - integer :: maxMsg - integer :: msgCount - integer, pointer, dimension(:) :: elemToRank - integer, pointer, dimension(:) :: offSetElem - integer, allocatable :: requests(:) - integer, allocatable :: stats(:, :) + type DomainDecomposition_t + logical :: mpiEnabled = .false. + logical :: initialized = .false. + integer :: mpiComm + integer :: mpiPrec + integer :: rankId + integer :: nRanks + integer :: nElem + integer :: maxMsg + integer :: msgCount + integer,pointer,dimension(:) :: elemToRank + integer,pointer,dimension(:) :: offSetElem + integer,allocatable :: requests(:) + integer,allocatable :: stats(:,:) - contains + contains - procedure :: Init => Init_DomainDecomposition_t - procedure :: Free => Free_DomainDecomposition_t + procedure :: Init => Init_DomainDecomposition_t + procedure :: Free => Free_DomainDecomposition_t - procedure :: GenerateDecomposition => GenerateDecomposition_DomainDecomposition_t - procedure :: SetElemToRank => SetElemToRank_DomainDecomposition_t + procedure :: GenerateDecomposition => GenerateDecomposition_DomainDecomposition_t + procedure :: SetElemToRank => SetElemToRank_DomainDecomposition_t - procedure, public :: FinalizeMPIExchangeAsync + procedure,public :: FinalizeMPIExchangeAsync - end type DomainDecomposition_t + endtype DomainDecomposition_t contains - subroutine Init_DomainDecomposition_t(this) - implicit none - class(DomainDecomposition_t), intent(inout) :: this - ! Local - integer :: ierror + subroutine Init_DomainDecomposition_t(this) + implicit none + class(DomainDecomposition_t),intent(inout) :: this + ! Local + integer :: ierror - this%mpiComm = 0 - this%mpiPrec = prec - this%rankId = 0 - this%nRanks = 1 - this%nElem = 0 - this%mpiEnabled = .false. - - this%mpiComm = MPI_COMM_WORLD - print *, __FILE__, " : Initializing MPI" - call mpi_init(ierror) - call mpi_comm_rank(this%mpiComm, this%rankId, ierror) - call mpi_comm_size(this%mpiComm, this%nRanks, ierror) - print *, __FILE__, " : Rank ", this%rankId + 1, "/", this%nRanks, " checking in." - - if (this%nRanks > 1) then - this%mpiEnabled = .true. - else - print *, __FILE__, " : No domain decomposition used." - end if - - if (prec == real32) then - this%mpiPrec = MPI_FLOAT - else - this%mpiPrec = MPI_DOUBLE - end if - - allocate (this%offsetElem(1:this%nRanks + 1)) - - this%initialized = .true. - - this%initialized = .true. - - end subroutine Init_DomainDecomposition_t - - subroutine Free_DomainDecomposition_t(this) - implicit none - class(DomainDecomposition_t), intent(inout) :: this - ! Local - integer :: ierror - - if (associated(this%offSetElem)) then - deallocate (this%offSetElem) - end if - if (associated(this%elemToRank)) then - deallocate (this%elemToRank) - end if - - if (allocated(this%requests)) deallocate (this%requests) - if (allocated(this%stats)) deallocate (this%stats) - - !if(this%mpiEnabled) then - print *, __FILE__, " : Rank ", this%rankId + 1, "/", this%nRanks, " checking out." - call MPI_FINALIZE(ierror) - !endif - - end subroutine Free_DomainDecomposition_t - - subroutine GenerateDecomposition_DomainDecomposition_t(this, nGlobalElem, maxMsg) - implicit none - class(DomainDecomposition_t), intent(inout) :: this - integer, intent(in) :: nGlobalElem - integer, intent(in) :: maxMsg - - call this%setElemToRank(nGlobalElem) - if (allocated(this%requests)) deallocate (this%requests) - if (allocated(this%stats)) deallocate (this%stats) - - allocate (this%requests(1:maxMsg)) - allocate (this%stats(MPI_STATUS_SIZE, 1:maxMsg)) - this%maxMsg = maxMsg - - print *, __FILE__//" : Rank ", this%rankId + 1, " : n_elements = ", & - this%offSetElem(this%rankId + 2) - this%offSetElem(this%rankId + 1) - - end subroutine GenerateDecomposition_DomainDecomposition_t - - subroutine SetElemToRank_DomainDecomposition_t(this, nElem) - implicit none - class(DomainDecomposition_t), intent(inout) :: this - integer, intent(in) :: nElem - ! Local - integer :: iel - - this%nElem = nElem - - allocate (this%elemToRank(1:nelem)) - - call DomainDecomp(nElem, & - this%nRanks, & - this%offSetElem) - - do iel = 1, nElem - call ElemToRank(this%nRanks, & - this%offSetElem, & - iel, & - this%elemToRank(iel)) - end do - - end subroutine SetElemToRank_DomainDecomposition_t - - subroutine DomainDecomp(nElems, nDomains, offSetElem) - ! From https://www.hopr-project.org/externals/Meshformat.pdf, Algorithm 4 - implicit none - integer, intent(in) :: nElems - integer, intent(in) :: nDomains - integer, intent(out) :: offsetElem(0:nDomains) - ! Local - integer :: nLocalElems - integer :: remainElems - integer :: iDom - - nLocalElems = nElems/nDomains - remainElems = nElems - nLocalElems*nDomains - do iDom = 0, nDomains - 1 - offSetElem(iDom) = iDom*nLocalElems + min(iDom, remainElems) - end do - offSetElem(nDomains) = nElems - - end subroutine DomainDecomp - - subroutine ElemToRank(nDomains, offsetElem, elemID, domain) - ! From https://www.hopr-project.org/externals/Meshformat.pdf, Algorithm 7 - ! "Find domain containing element index" - ! - implicit none - integer, intent(in) :: nDomains - integer, intent(in) :: offsetElem(0:nDomains) - integer, intent(in) :: elemID - integer, intent(out) :: domain - ! Local - integer :: maxSteps - integer :: low, up, mid - integer :: i - - domain = 0 - maxSteps = int(log10(real(nDomains))/log10(2.0)) + 1 - low = 0 - up = nDomains - 1 - - if (offsetElem(low) < elemID .and. elemID <= offsetElem(low + 1)) then - domain = low - elseif (offsetElem(up) < elemID .and. elemID <= offsetElem(up + 1)) then - domain = up - else - do i = 1, maxSteps - mid = (up - low)/2 + low - if (offsetElem(mid) < elemID .and. elemID <= offsetElem(mid + 1)) then - domain = mid - return - elseif (elemID > offsetElem(mid + 1)) then - low = mid + 1 - else - up = mid - end if - end do - end if - - end subroutine ElemToRank - - subroutine FinalizeMPIExchangeAsync(mpiHandler) - class(DomainDecomposition_t), intent(inout) :: mpiHandler - ! Local - integer :: ierror - integer :: msgCount - - if (mpiHandler%mpiEnabled) then - msgCount = mpiHandler%msgCount - call MPI_WaitAll(msgCount, & - mpiHandler%requests(1:msgCount), & - mpiHandler%stats(1:MPI_STATUS_SIZE, 1:msgCount), & - iError) - end if - - end subroutine FinalizeMPIExchangeAsync - -end module SELF_DomainDecomposition_t + this%mpiComm = 0 + this%mpiPrec = prec + this%rankId = 0 + this%nRanks = 1 + this%nElem = 0 + this%mpiEnabled = .false. + + this%mpiComm = MPI_COMM_WORLD + print*,__FILE__," : Initializing MPI" + call mpi_init(ierror) + call mpi_comm_rank(this%mpiComm,this%rankId,ierror) + call mpi_comm_size(this%mpiComm,this%nRanks,ierror) + print*,__FILE__," : Rank ",this%rankId+1,"/",this%nRanks," checking in." + + if(this%nRanks > 1) then + this%mpiEnabled = .true. + else + print*,__FILE__," : No domain decomposition used." + endif + + if(prec == real32) then + this%mpiPrec = MPI_FLOAT + else + this%mpiPrec = MPI_DOUBLE + endif + + allocate(this%offsetElem(1:this%nRanks+1)) + + this%initialized = .true. + + this%initialized = .true. + + endsubroutine Init_DomainDecomposition_t + + subroutine Free_DomainDecomposition_t(this) + implicit none + class(DomainDecomposition_t),intent(inout) :: this + ! Local + integer :: ierror + + if(associated(this%offSetElem)) then + deallocate(this%offSetElem) + endif + if(associated(this%elemToRank)) then + deallocate(this%elemToRank) + endif + + if(allocated(this%requests)) deallocate(this%requests) + if(allocated(this%stats)) deallocate(this%stats) + + !if(this%mpiEnabled) then + print*,__FILE__," : Rank ",this%rankId+1,"/",this%nRanks," checking out." + call MPI_FINALIZE(ierror) + !endif + + endsubroutine Free_DomainDecomposition_t + + subroutine GenerateDecomposition_DomainDecomposition_t(this,nGlobalElem,maxMsg) + implicit none + class(DomainDecomposition_t),intent(inout) :: this + integer,intent(in) :: nGlobalElem + integer,intent(in) :: maxMsg + + call this%setElemToRank(nGlobalElem) + if(allocated(this%requests)) deallocate(this%requests) + if(allocated(this%stats)) deallocate(this%stats) + + allocate(this%requests(1:maxMsg)) + allocate(this%stats(MPI_STATUS_SIZE,1:maxMsg)) + this%maxMsg = maxMsg + + print*,__FILE__//" : Rank ",this%rankId+1," : n_elements = ", & + this%offSetElem(this%rankId+2)-this%offSetElem(this%rankId+1) + + endsubroutine GenerateDecomposition_DomainDecomposition_t + + subroutine SetElemToRank_DomainDecomposition_t(this,nElem) + implicit none + class(DomainDecomposition_t),intent(inout) :: this + integer,intent(in) :: nElem + ! Local + integer :: iel + + this%nElem = nElem + + allocate(this%elemToRank(1:nelem)) + + call DomainDecomp(nElem, & + this%nRanks, & + this%offSetElem) + + do iel = 1,nElem + call ElemToRank(this%nRanks, & + this%offSetElem, & + iel, & + this%elemToRank(iel)) + enddo + + endsubroutine SetElemToRank_DomainDecomposition_t + + subroutine DomainDecomp(nElems,nDomains,offSetElem) + ! From https://www.hopr-project.org/externals/Meshformat.pdf, Algorithm 4 + implicit none + integer,intent(in) :: nElems + integer,intent(in) :: nDomains + integer,intent(out) :: offsetElem(0:nDomains) + ! Local + integer :: nLocalElems + integer :: remainElems + integer :: iDom + + nLocalElems = nElems/nDomains + remainElems = nElems-nLocalElems*nDomains + do iDom = 0,nDomains-1 + offSetElem(iDom) = iDom*nLocalElems+min(iDom,remainElems) + enddo + offSetElem(nDomains) = nElems + + endsubroutine DomainDecomp + + subroutine ElemToRank(nDomains,offsetElem,elemID,domain) + ! From https://www.hopr-project.org/externals/Meshformat.pdf, Algorithm 7 + ! "Find domain containing element index" + ! + implicit none + integer,intent(in) :: nDomains + integer,intent(in) :: offsetElem(0:nDomains) + integer,intent(in) :: elemID + integer,intent(out) :: domain + ! Local + integer :: maxSteps + integer :: low,up,mid + integer :: i + + domain = 0 + maxSteps = int(log10(real(nDomains))/log10(2.0))+1 + low = 0 + up = nDomains-1 + + if(offsetElem(low) < elemID .and. elemID <= offsetElem(low+1)) then + domain = low + elseif(offsetElem(up) < elemID .and. elemID <= offsetElem(up+1)) then + domain = up + else + do i = 1,maxSteps + mid = (up-low)/2+low + if(offsetElem(mid) < elemID .and. elemID <= offsetElem(mid+1)) then + domain = mid + return + elseif(elemID > offsetElem(mid+1)) then + low = mid+1 + else + up = mid + endif + enddo + endif + + endsubroutine ElemToRank + + subroutine FinalizeMPIExchangeAsync(mpiHandler) + class(DomainDecomposition_t),intent(inout) :: mpiHandler + ! Local + integer :: ierror + integer :: msgCount + + if(mpiHandler%mpiEnabled) then + msgCount = mpiHandler%msgCount + call MPI_WaitAll(msgCount, & + mpiHandler%requests(1:msgCount), & + mpiHandler%stats(1:MPI_STATUS_SIZE,1:msgCount), & + iError) + endif + + endsubroutine FinalizeMPIExchangeAsync + +endmodule SELF_DomainDecomposition_t diff --git a/src/SELF_Mesh_1D.f90 b/src/SELF_Mesh_1D.f90 index 4a3c80d0c..b9708b0c8 100644 --- a/src/SELF_Mesh_1D.f90 +++ b/src/SELF_Mesh_1D.f90 @@ -26,186 +26,186 @@ module SELF_Mesh_1D - use SELF_Constants - use SELF_Lagrange - use SELF_Data - use SELF_Scalar_1D - use SELF_SupportRoutines - use SELF_HDF5 - use SELF_Mesh + use SELF_Constants + use SELF_Lagrange + use SELF_Data + use SELF_Scalar_1D + use SELF_SupportRoutines + use SELF_HDF5 + use SELF_Mesh - ! External Libs ! - use HDF5 + ! External Libs ! + use HDF5 - use iso_c_binding + use iso_c_binding - implicit none + implicit none - type, extends(SEMMesh) :: Mesh1D - integer, pointer, dimension(:, :) :: elemInfo - real(prec), pointer, dimension(:) :: nodeCoords - integer, pointer, dimension(:) :: globalNodeIDs - integer, pointer, dimension(:, :) :: BCType - character(LEN=255), allocatable :: BCNames(:) - integer, dimension(2) :: bcid = 0 ! Boundary conditions for the left and right endpoints + type,extends(SEMMesh) :: Mesh1D + integer,pointer,dimension(:,:) :: elemInfo + real(prec),pointer,dimension(:) :: nodeCoords + integer,pointer,dimension(:) :: globalNodeIDs + integer,pointer,dimension(:,:) :: BCType + character(LEN=255),allocatable :: BCNames(:) + integer,dimension(2) :: bcid = 0 ! Boundary conditions for the left and right endpoints - contains - procedure, public :: Init => Init_Mesh1D - procedure, public :: Free => Free_Mesh1D - generic, public :: StructuredMesh => UniformBlockMesh_Mesh1D - procedure, private :: UniformBlockMesh_Mesh1D - procedure, public :: ResetBoundaryConditionType => ResetBoundaryConditionType_Mesh1D + contains + procedure,public :: Init => Init_Mesh1D + procedure,public :: Free => Free_Mesh1D + generic,public :: StructuredMesh => UniformBlockMesh_Mesh1D + procedure,private :: UniformBlockMesh_Mesh1D + procedure,public :: ResetBoundaryConditionType => ResetBoundaryConditionType_Mesh1D - procedure, public :: Write_Mesh => Write_Mesh1D + procedure,public :: Write_Mesh => Write_Mesh1D - end type Mesh1D + endtype Mesh1D contains - subroutine Init_Mesh1D(this, nElem, nNodes, nBCs) - implicit none - class(Mesh1D), intent(out) :: this - integer, intent(in) :: nElem - integer, intent(in) :: nNodes - integer, intent(in) :: nBCs - - this%nGeo = 1 - this%nElem = nElem - this%nGlobalElem = nElem - this%nNodes = nNodes - this%nCornerNodes = nElem*2 - this%nUniqueNodes = 0 - this%nBCs = nBCs - this%bcid = 0 - - allocate (this%elemInfo(1:4, 1:nElem)) - allocate (this%nodeCoords(1:nNodes)) - allocate (this%globalNodeIDs(1:nNodes)) - allocate (this%BCType(1:4, 1:nBCs)) - - allocate (this%BCNames(1:nBCs)) - call this%decomp%Init() - - end subroutine Init_Mesh1D - - subroutine Free_Mesh1D(this) - implicit none - class(Mesh1D), intent(inout) :: this - - this%nElem = 0 - this%nNodes = 0 - this%nCornerNodes = 0 - this%nUniqueNodes = 0 - this%nBCs = 0 - deallocate (this%elemInfo) - deallocate (this%nodeCoords) - deallocate (this%globalNodeIDs) - deallocate (this%BCType) - deallocate (this%BCNames) - call this%decomp%Free() - - end subroutine Free_Mesh1D - - subroutine UniformBlockMesh_Mesh1D(this, nElem, x) - implicit none - class(Mesh1D), intent(out) :: this - integer, intent(in) :: nElem - real(prec), intent(in) :: x(1:2) - ! Local - integer :: iel, ngeo - integer :: nid, nNodes - integer :: i - real(prec) :: xU(1:nElem + 1) - type(Lagrange), target :: linearInterp - type(Lagrange), target :: nGeoInterp - type(Scalar1D) :: xLinear - type(Scalar1D) :: xGeo - - ngeo = 1 - - nNodes = nElem*(nGeo + 1) - call this%Init(nElem, nNodes, 2) - this%quadrature = GAUSS_LOBATTO - - ! Set the hopr_nodeCoords - xU = UniformPoints(x(1), x(2), 1, nElem + 1) - - call linearInterp%Init(1, GAUSS_LOBATTO, & - nGeo, GAUSS_LOBATTO) - - call nGeoInterp%Init(nGeo, GAUSS_LOBATTO, & - nGeo, GAUSS_LOBATTO) - - ! Create a linear interpolant to interpolate to nGeo grid - call xLinear%Init(linearInterp, 1, nElem) - call xGeo%Init(nGeoInterp, 1, nElem) - - do iel = 1, nElem - xLinear%interior(1:2, iel, 1) = xU(iel:iel + 1) - end do - - call xLinear%GridInterp(xGeo%interior) - - ! Set the element information - nid = 1 - do iel = 1, nElem - this%elemInfo(1, iel) = selfLineLinear ! Element Type - this%elemInfo(2, iel) = 1 ! Element Zone - this%elemInfo(3, iel) = nid ! Node Index Start - do i = 1, nGeo + 1 - this%nodeCoords(nid) = xGeo%interior(i, iel, 1) - nid = nid + 1 - end do - this%elemInfo(4, iel) = nid - 1 ! Node Index End - end do - - call xLinear%Free() - call xGeo%Free() - call linearInterp%Free() - call nGeoInterp%Free() - - end subroutine UniformBlockMesh_Mesh1D - - subroutine ResetBoundaryConditionType_Mesh1D(this, leftbc, rightbc) + subroutine Init_Mesh1D(this,nElem,nNodes,nBCs) + implicit none + class(Mesh1D),intent(out) :: this + integer,intent(in) :: nElem + integer,intent(in) :: nNodes + integer,intent(in) :: nBCs + + this%nGeo = 1 + this%nElem = nElem + this%nGlobalElem = nElem + this%nNodes = nNodes + this%nCornerNodes = nElem*2 + this%nUniqueNodes = 0 + this%nBCs = nBCs + this%bcid = 0 + + allocate(this%elemInfo(1:4,1:nElem)) + allocate(this%nodeCoords(1:nNodes)) + allocate(this%globalNodeIDs(1:nNodes)) + allocate(this%BCType(1:4,1:nBCs)) + + allocate(this%BCNames(1:nBCs)) + call this%decomp%Init() + + endsubroutine Init_Mesh1D + + subroutine Free_Mesh1D(this) + implicit none + class(Mesh1D),intent(inout) :: this + + this%nElem = 0 + this%nNodes = 0 + this%nCornerNodes = 0 + this%nUniqueNodes = 0 + this%nBCs = 0 + deallocate(this%elemInfo) + deallocate(this%nodeCoords) + deallocate(this%globalNodeIDs) + deallocate(this%BCType) + deallocate(this%BCNames) + call this%decomp%Free() + + endsubroutine Free_Mesh1D + + subroutine UniformBlockMesh_Mesh1D(this,nElem,x) + implicit none + class(Mesh1D),intent(out) :: this + integer,intent(in) :: nElem + real(prec),intent(in) :: x(1:2) + ! Local + integer :: iel,ngeo + integer :: nid,nNodes + integer :: i + real(prec) :: xU(1:nElem+1) + type(Lagrange),target :: linearInterp + type(Lagrange),target :: nGeoInterp + type(Scalar1D) :: xLinear + type(Scalar1D) :: xGeo + + ngeo = 1 + + nNodes = nElem*(nGeo+1) + call this%Init(nElem,nNodes,2) + this%quadrature = GAUSS_LOBATTO + + ! Set the hopr_nodeCoords + xU = UniformPoints(x(1),x(2),1,nElem+1) + + call linearInterp%Init(1,GAUSS_LOBATTO, & + nGeo,GAUSS_LOBATTO) + + call nGeoInterp%Init(nGeo,GAUSS_LOBATTO, & + nGeo,GAUSS_LOBATTO) + + ! Create a linear interpolant to interpolate to nGeo grid + call xLinear%Init(linearInterp,1,nElem) + call xGeo%Init(nGeoInterp,1,nElem) + + do iel = 1,nElem + xLinear%interior(1:2,iel,1) = xU(iel:iel+1) + enddo + + call xLinear%GridInterp(xGeo%interior) + + ! Set the element information + nid = 1 + do iel = 1,nElem + this%elemInfo(1,iel) = selfLineLinear ! Element Type + this%elemInfo(2,iel) = 1 ! Element Zone + this%elemInfo(3,iel) = nid ! Node Index Start + do i = 1,nGeo+1 + this%nodeCoords(nid) = xGeo%interior(i,iel,1) + nid = nid+1 + enddo + this%elemInfo(4,iel) = nid-1 ! Node Index End + enddo + + call xLinear%Free() + call xGeo%Free() + call linearInterp%Free() + call nGeoInterp%Free() + + endsubroutine UniformBlockMesh_Mesh1D + + subroutine ResetBoundaryConditionType_Mesh1D(this,leftbc,rightbc) !! This method can be used to reset all of the boundary elements !! boundary condition type to the desired value. !! !! Note that ALL physical boundaries will be set to have this boundary !! condition - implicit none - class(Mesh1D), intent(inout) :: this - integer, intent(in) ::leftbc, rightbc + implicit none + class(Mesh1D),intent(inout) :: this + integer,intent(in) ::leftbc,rightbc - this%bcid(1) = leftbc - this%bcid(2) = rightbc + this%bcid(1) = leftbc + this%bcid(2) = rightbc - end subroutine ResetBoundaryConditionType_Mesh1D + endsubroutine ResetBoundaryConditionType_Mesh1D - subroutine Write_Mesh1D(this, meshFile) - ! Writes mesh output in HOPR format (serial IO only) - implicit none - class(Mesh1D), intent(inout) :: this - character(*), intent(in) :: meshFile - ! Local - integer(HID_T) :: fileId + subroutine Write_Mesh1D(this,meshFile) + ! Writes mesh output in HOPR format (serial IO only) + implicit none + class(Mesh1D),intent(inout) :: this + character(*),intent(in) :: meshFile + ! Local + integer(HID_T) :: fileId - call Open_HDF5(meshFile, H5F_ACC_RDWR_F, fileId) + call Open_HDF5(meshFile,H5F_ACC_RDWR_F,fileId) - call WriteAttribute_HDF5(fileId, 'nElems', this%nElem) - call WriteAttribute_HDF5(fileId, 'Ngeo', this%nGeo) - call WriteAttribute_HDF5(fileId, 'nBCs', this%nBCs) + call WriteAttribute_HDF5(fileId,'nElems',this%nElem) + call WriteAttribute_HDF5(fileId,'Ngeo',this%nGeo) + call WriteAttribute_HDF5(fileId,'nBCs',this%nBCs) - call WriteArray_HDF5(fileId, 'BCType', this%bcType) + call WriteArray_HDF5(fileId,'BCType',this%bcType) - ! Read local subarray of ElemInfo - call WriteArray_HDF5(fileId, 'ElemInfo', this%elemInfo) + ! Read local subarray of ElemInfo + call WriteArray_HDF5(fileId,'ElemInfo',this%elemInfo) - ! Read local subarray of NodeCoords and GlobalNodeIDs - call WriteArray_HDF5(fileId, 'NodeCoords', this%nodeCoords) - call WriteArray_HDF5(fileId, 'GlobalNodeIDs', this%globalNodeIDs) + ! Read local subarray of NodeCoords and GlobalNodeIDs + call WriteArray_HDF5(fileId,'NodeCoords',this%nodeCoords) + call WriteArray_HDF5(fileId,'GlobalNodeIDs',this%globalNodeIDs) - call Close_HDF5(fileID) + call Close_HDF5(fileID) - end subroutine Write_Mesh1D + endsubroutine Write_Mesh1D -end module SELF_Mesh_1D +endmodule SELF_Mesh_1D diff --git a/src/SELF_Mesh_2D_t.f90 b/src/SELF_Mesh_2D_t.f90 index df80a8436..31d020d6e 100644 --- a/src/SELF_Mesh_2D_t.f90 +++ b/src/SELF_Mesh_2D_t.f90 @@ -26,19 +26,19 @@ module SELF_Mesh_2D_t - use SELF_Constants - use SELF_Lagrange - use SELF_SupportRoutines - use SELF_HDF5 - use SELF_Mesh - use SELF_DomainDecomposition + use SELF_Constants + use SELF_Lagrange + use SELF_SupportRoutines + use SELF_HDF5 + use SELF_Mesh + use SELF_DomainDecomposition - ! External Libs ! - use HDF5 + ! External Libs ! + use HDF5 - use iso_c_binding + use iso_c_binding - implicit none + implicit none ! ========================================================================= ! ! Node, Edge, Face, Element and Connectivity Standard @@ -86,148 +86,148 @@ module SELF_Mesh_2D_t ! ! ========================================================================= ! - ! Side Ordering - integer, parameter :: selfSide2D_South = 1 - integer, parameter :: selfSide2D_East = 2 - integer, parameter :: selfSide2D_North = 3 - integer, parameter :: selfSide2D_West = 4 + ! Side Ordering + integer,parameter :: selfSide2D_South = 1 + integer,parameter :: selfSide2D_East = 2 + integer,parameter :: selfSide2D_North = 3 + integer,parameter :: selfSide2D_West = 4 - ! Mesh format is set up similar to the HOPr format - ! See https://hopr-project.org/externals/MeshFormat.pdf + ! Mesh format is set up similar to the HOPr format + ! See https://hopr-project.org/externals/MeshFormat.pdf - type, extends(SEMMesh) :: Mesh2D_t - integer, pointer, dimension(:, :, :) :: sideInfo - real(prec), pointer, dimension(:, :, :, :) :: nodeCoords - integer, pointer, dimension(:, :) :: elemInfo - integer, pointer, dimension(:, :, :) :: globalNodeIDs - integer, pointer, dimension(:, :) :: CGNSCornerMap - integer, pointer, dimension(:, :) :: CGNSSideMap - integer, pointer, dimension(:, :) :: BCType - character(LEN=255), allocatable :: BCNames(:) + type,extends(SEMMesh) :: Mesh2D_t + integer,pointer,dimension(:,:,:) :: sideInfo + real(prec),pointer,dimension(:,:,:,:) :: nodeCoords + integer,pointer,dimension(:,:) :: elemInfo + integer,pointer,dimension(:,:,:) :: globalNodeIDs + integer,pointer,dimension(:,:) :: CGNSCornerMap + integer,pointer,dimension(:,:) :: CGNSSideMap + integer,pointer,dimension(:,:) :: BCType + character(LEN=255),allocatable :: BCNames(:) - contains - procedure, public :: Init => Init_Mesh2D_t - procedure, public :: Free => Free_Mesh2D_t - procedure, public :: UpdateDevice => UpdateDevice_Mesh2D_t + contains + procedure,public :: Init => Init_Mesh2D_t + procedure,public :: Free => Free_Mesh2D_t + procedure,public :: UpdateDevice => UpdateDevice_Mesh2D_t - generic, public :: StructuredMesh => UniformStructuredMesh_Mesh2D_t - procedure, private :: UniformStructuredMesh_Mesh2D_t - procedure, public :: ResetBoundaryConditionType => ResetBoundaryConditionType_Mesh2D_t + generic,public :: StructuredMesh => UniformStructuredMesh_Mesh2D_t + procedure,private :: UniformStructuredMesh_Mesh2D_t + procedure,public :: ResetBoundaryConditionType => ResetBoundaryConditionType_Mesh2D_t - procedure, public :: Read_HOPr => Read_HOPr_Mesh2D_t + procedure,public :: Read_HOPr => Read_HOPr_Mesh2D_t - procedure, public :: Write_Mesh => Write_Mesh2D_t + procedure,public :: Write_Mesh => Write_Mesh2D_t - procedure, public :: RecalculateFlip => RecalculateFlip_Mesh2D_t + procedure,public :: RecalculateFlip => RecalculateFlip_Mesh2D_t - end type Mesh2D_t + endtype Mesh2D_t contains - subroutine Init_Mesh2D_t(this, nGeo, nElem, nSides, nNodes, nBCs) - implicit none - class(Mesh2D_t), intent(inout) :: this - integer, intent(in) :: nGeo - integer, intent(in) :: nElem - integer, intent(in) :: nSides - integer, intent(in) :: nNodes - integer, intent(in) :: nBCs - ! Local - integer :: i, j, l - - this%nGeo = nGeo - this%nElem = nElem - this%nGlobalElem = nElem - this%nNodes = nNodes - this%nSides = nSides - this%nCornerNodes = 0 - this%nUniqueNodes = 0 - this%nUniqueSides = 0 - this%nBCs = nBCs - - allocate (this%elemInfo(1:6, 1:nElem)) - allocate (this%sideInfo(1:5, 1:4, 1:nElem)) - allocate (this%nodeCoords(1:2, 1:nGeo + 1, 1:nGeo + 1, 1:nElem)) - allocate (this%globalNodeIDs(1:nGeo + 1, 1:nGeo + 1, 1:nElem)) - allocate (this%CGNSCornerMap(1:2, 1:4)) - allocate (this%CGNSSideMap(1:2, 1:4)) - allocate (this%BCType(1:4, 1:nBCs)) - - allocate (this%BCNames(1:nBCs)) - - ! Create lookup tables to assist with connectivity generation - this%CGNSCornerMap(1:2, 1) = (/1, 1/) - this%CGNSCornerMap(1:2, 2) = (/nGeo + 1, 1/) - this%CGNSCornerMap(1:2, 3) = (/nGeo + 1, nGeo + 1/) - this%CGNSCornerMap(1:2, 4) = (/1, nGeo + 1/) - - ! Maps from local corner node id to CGNS side - this%CGNSSideMap(1:2, 1) = (/1, 2/) - this%CGNSSideMap(1:2, 2) = (/2, 3/) - this%CGNSSideMap(1:2, 3) = (/4, 3/) - this%CGNSSideMap(1:2, 4) = (/1, 4/) - - end subroutine Init_Mesh2D_t - - subroutine Free_Mesh2D_t(this) - implicit none - class(Mesh2D_t), intent(inout) :: this - - this%nElem = 0 - this%nNodes = 0 - this%nSides = 0 - this%nCornerNodes = 0 - this%nUniqueSides = 0 - this%nUniqueNodes = 0 - this%nBCs = 0 - - deallocate (this%elemInfo) - deallocate (this%sideInfo) - deallocate (this%nodeCoords) - deallocate (this%globalNodeIDs) - deallocate (this%CGNSCornerMap) - deallocate (this%CGNSSideMap) - deallocate (this%BCType) - deallocate (this%BCNames) - call this%decomp%Free() - - end subroutine Free_Mesh2D_t - - subroutine UpdateDevice_Mesh2D_t(this) - implicit none - class(Mesh2D_t), intent(inout) :: this - - return - - end subroutine UpdateDevice_Mesh2D_t - - subroutine ResetBoundaryConditionType_Mesh2D_t(this, bcid) + subroutine Init_Mesh2D_t(this,nGeo,nElem,nSides,nNodes,nBCs) + implicit none + class(Mesh2D_t),intent(inout) :: this + integer,intent(in) :: nGeo + integer,intent(in) :: nElem + integer,intent(in) :: nSides + integer,intent(in) :: nNodes + integer,intent(in) :: nBCs + ! Local + integer :: i,j,l + + this%nGeo = nGeo + this%nElem = nElem + this%nGlobalElem = nElem + this%nNodes = nNodes + this%nSides = nSides + this%nCornerNodes = 0 + this%nUniqueNodes = 0 + this%nUniqueSides = 0 + this%nBCs = nBCs + + allocate(this%elemInfo(1:6,1:nElem)) + allocate(this%sideInfo(1:5,1:4,1:nElem)) + allocate(this%nodeCoords(1:2,1:nGeo+1,1:nGeo+1,1:nElem)) + allocate(this%globalNodeIDs(1:nGeo+1,1:nGeo+1,1:nElem)) + allocate(this%CGNSCornerMap(1:2,1:4)) + allocate(this%CGNSSideMap(1:2,1:4)) + allocate(this%BCType(1:4,1:nBCs)) + + allocate(this%BCNames(1:nBCs)) + + ! Create lookup tables to assist with connectivity generation + this%CGNSCornerMap(1:2,1) = (/1,1/) + this%CGNSCornerMap(1:2,2) = (/nGeo+1,1/) + this%CGNSCornerMap(1:2,3) = (/nGeo+1,nGeo+1/) + this%CGNSCornerMap(1:2,4) = (/1,nGeo+1/) + + ! Maps from local corner node id to CGNS side + this%CGNSSideMap(1:2,1) = (/1,2/) + this%CGNSSideMap(1:2,2) = (/2,3/) + this%CGNSSideMap(1:2,3) = (/4,3/) + this%CGNSSideMap(1:2,4) = (/1,4/) + + endsubroutine Init_Mesh2D_t + + subroutine Free_Mesh2D_t(this) + implicit none + class(Mesh2D_t),intent(inout) :: this + + this%nElem = 0 + this%nNodes = 0 + this%nSides = 0 + this%nCornerNodes = 0 + this%nUniqueSides = 0 + this%nUniqueNodes = 0 + this%nBCs = 0 + + deallocate(this%elemInfo) + deallocate(this%sideInfo) + deallocate(this%nodeCoords) + deallocate(this%globalNodeIDs) + deallocate(this%CGNSCornerMap) + deallocate(this%CGNSSideMap) + deallocate(this%BCType) + deallocate(this%BCNames) + call this%decomp%Free() + + endsubroutine Free_Mesh2D_t + + subroutine UpdateDevice_Mesh2D_t(this) + implicit none + class(Mesh2D_t),intent(inout) :: this + + return + + endsubroutine UpdateDevice_Mesh2D_t + + subroutine ResetBoundaryConditionType_Mesh2D_t(this,bcid) !! This method can be used to reset all of the boundary elements !! boundary condition type to the desired value. !! !! Note that ALL physical boundaries will be set to have this boundary !! condition - implicit none - class(Mesh2D_t), intent(inout) :: this - integer, intent(in) :: bcid - ! Local - integer :: iSide, iEl, e2 + implicit none + class(Mesh2D_t),intent(inout) :: this + integer,intent(in) :: bcid + ! Local + integer :: iSide,iEl,e2 - do iEl = 1, this%nElem - do iSide = 1, 4 + do iEl = 1,this%nElem + do iSide = 1,4 - e2 = this%sideInfo(3, iSide, iEl) + e2 = this%sideInfo(3,iSide,iEl) - if (e2 == 0) then - this%sideInfo(5, iSide, iEl) = bcid - end if + if(e2 == 0) then + this%sideInfo(5,iSide,iEl) = bcid + endif - end do - end do + enddo + enddo - end subroutine ResetBoundaryConditionType_Mesh2D_t + endsubroutine ResetBoundaryConditionType_Mesh2D_t - subroutine UniformStructuredMesh_Mesh2D_t(this, nxPerTile, nyPerTile, nTileX, nTileY, dx, dy, bcids) + subroutine UniformStructuredMesh_Mesh2D_t(this,nxPerTile,nyPerTile,nTileX,nTileY,dx,dy,bcids) !! !! Create a structured mesh and store it in SELF's unstructured mesh format. !! The mesh is created in tiles of size (tnx,tny). Tiling is used to determine @@ -254,559 +254,559 @@ subroutine UniformStructuredMesh_Mesh2D_t(this, nxPerTile, nyPerTile, nTileX, nT !! Length of the domain in the x-direction is Lx = dx*nX !! Length of the domain in the y-direction is Ly = dy*nY !! - implicit none - class(Mesh2D_t), intent(out) :: this - integer, intent(in) :: nxPerTile - integer, intent(in) :: nyPerTile - integer, intent(in) :: nTileX - integer, intent(in) :: nTileY - real(prec), intent(in) :: dx - real(prec), intent(in) :: dy - integer, intent(in) :: bcids(1:4) - ! Local - integer :: nX, nY, nGeo, nBCs - integer :: nGlobalElem - integer :: nUniqueSides - integer :: nUniqueNodes - integer :: nLocalElems - integer :: nLocalSides - integer :: nLocalNodes - real(prec), allocatable :: nodeCoords(:, :, :, :) - integer, allocatable :: globalNodeIDs(:, :, :) - integer, allocatable :: sideInfo(:, :, :) - integer :: i, j, ti, tj - integer :: ix, iy, iel - integer :: ni, nj - integer :: e1, e2 - integer :: nedges - - call this%decomp%init() - - nX = nTileX*nxPerTile - nY = nTileY*nyPerTile - nGeo = 1 ! Force the geometry to be linear - nBCs = 4 ! Force the number of boundary conditions to 4 - - nGlobalElem = nX*nY - nUniqueSides = (nX + 1)*nY + (nY + 1)*nX - nUniqueNodes = (nX + 1)*(nY + 1) - - allocate (nodeCoords(1:2, 1:nGeo + 1, 1:nGeo + 1, 1:nGlobalElem)) - allocate (globalNodeIDs(1:nGeo + 1, 1:nGeo + 1, 1:nGlobalElem)) - allocate (sideInfo(1:5, 1:4, 1:nGlobalElem)) - - do tj = 1, nTileY - do ti = 1, nTileX - do j = 1, nyPerTile - iy = j + nyPerTile*(tj - 1) - do i = 1, nxPerTile - iel = i + nxPerTile*(j - 1 + nyPerTile*(ti - 1 + nTilex*(tj - 1))) - ix = i + nxPerTile*(ti - 1) ! nxpertile + nxpertile*(nTileX-1) = nxperTile*nTilex = 1 - do nj = 1, nGeo + 1 - do ni = 1, nGeo + 1 - nodeCoords(1, ni, nj, iel) = real(ni - 1 + ix - 1, prec)*dx - nodeCoords(2, ni, nj, iel) = real(nj - 1 + iy - 1, prec)*dy - globalNodeIDs(ni, nj, iel) = ni - 1 + i + (nxPerTile + 1)*( & - nj - 1 + j - 1 + (nyPerTile + 1)*( & - ti - 1 + nTileX*(tj - 1))) - end do - end do - end do - end do - end do - end do - - ! Fill in edge information - ! sideInfo(1:5,iSide,iEl) - ! 1 - Side Type (currently unused in SELF) - ! 2 - Global Side ID (Used for message passing. Don't need to change) - ! 3 - Neighbor Element ID (Can stay the same) - ! 4 - 10*( neighbor local side ) + flip (Need to recalculate flip) - ! 5 - Boundary Condition ID (Can stay the same) - nedges = 0 - do tj = 1, nTileY - do ti = 1, nTileX - do j = 1, nyPerTile - do i = 1, nxPerTile - iel = i + nxPerTile*(j - 1 + nyPerTile*(ti - 1 + nTilex*(tj - 1))) - - ! south, iside=1 - ! Get the corner node ids for this edge - ! sideInfo(2,1,iel) = (nc1+nc2)*(nc1+nc2+1)/2 + nc2 - if (j == 1) then ! southern most part of the tile - if (tj == 1) then ! southern most tile - nedges = nedges + 1 - sideinfo(2, 1, iel) = nedges - sideinfo(3, 1, iel) = 0 ! Neigbor element (null, boundary condition) - sideinfo(4, 1, iel) = 0 ! Neighbor side id (null, boundary condition) - sideinfo(5, 1, iel) = bcids(1) ! Boundary condition id; set from the user input - else ! interior tile, but souther most edge of the tile - e2 = i + nxPerTile*(nyPerTile - 1 + nyPerTile*(ti - 1 + nTilex*(tj - 2))) ! Neigbor element, northernmost element, in tile to the south - sideinfo(2, 1, iel) = sideInfo(2, 3, e2) ! Copy the edge id from neighbor's north edge - sideinfo(3, 1, iel) = e2 - sideinfo(4, 1, iel) = 10*3 ! Neighbor side id - neighbor to the south, north side (3) - sideinfo(5, 1, iel) = 0 ! Boundary condition id; (null, interior edge) - end if - else ! interior to the tile - e2 = i + nxPerTile*(j - 2 + nyPerTile*(ti - 1 + nTilex*(tj - 1))) ! Neigbor element, inside same tile, to the south - sideinfo(2, 1, iel) = sideInfo(2, 3, e2) ! Copy the edge id from neighbor's north edge - sideinfo(3, 1, iel) = e2 - sideinfo(4, 1, iel) = 10*3 ! Neighbor side id - neighbor to the south, north side (3) - sideinfo(5, 1, iel) = 0 ! Boundary condition id; (null, interior edge) - end if - - ! east, iside=2 - ! Get the corner node ids for this edge - ! East edges are always new edges, due to the way we are traversing the grid - nedges = nedges + 1 - sideinfo(2, 2, iel) = nedges - if (i == nxPerTile) then ! eastern most part of the tile - if (ti == nTileX) then ! eastern most tile - sideinfo(3, 2, iel) = 0 ! Neigbor element (null, boundary condition) - sideinfo(4, 2, iel) = 0 ! Neighbor side id (null, boundary condition) - sideinfo(5, 2, iel) = bcids(2) ! Boundary condition id; eastern boundary set from the user input - else ! interior tile, but eastern most edge of the tile - sideinfo(3, 2, iel) = 1 + nxPerTile*(j - 1 + nyPerTile*(ti + nTilex*(tj - 1))) ! Neigbor element, westernnmost element, in tile to the east - sideinfo(4, 2, iel) = 10*4 ! Neighbor side id - neighbor to the east, west side (4) - sideinfo(5, 2, iel) = 0 ! Boundary condition id; (null, interior edge) - end if - else ! interior to the tile - sideinfo(3, 2, iel) = i + 1 + nxPerTile*(j - 1 + nyPerTile*(ti - 1 + nTilex*(tj - 1))) ! Neigbor element, inside same tile, to the east - sideinfo(4, 2, iel) = 10*4 ! Neighbor side id - neighbor to the east, west side (4) - sideinfo(5, 2, iel) = 0 ! Boundary condition id; (null, interior edge) - end if - - ! north, iside=3 - ! Get the corner node ids for this edge - ! East edges are always new edges, due to the way we are traversing the grid - nedges = nedges + 1 - sideinfo(2, 3, iel) = nedges - if (j == nyPerTile) then ! northern most part of the tile - if (tj == nTileY) then ! northern most tile - sideinfo(3, 3, iel) = 0 ! Neigbor element (null, boundary condition) - sideinfo(4, 3, iel) = 0 ! Neighbor side id (null, boundary condition) - sideinfo(5, 3, iel) = bcids(3) ! Boundary condition id; set from the user input - else ! interior tile, but northern most edge of the tile - sideinfo(3, 3, iel) = i + nxPerTile*(nyPerTile*(ti - 1 + nTilex*(tj))) ! Neigbor element, southernmost element in tile to the north - sideinfo(4, 3, iel) = 10*1 ! Neighbor side id - neighbor to the north, south side (1) - sideinfo(5, 3, iel) = 0 ! Boundary condition id; (null, interior edge) - end if - else ! interior to the tile - sideinfo(3, 3, iel) = i + nxPerTile*(j + nyPerTile*(ti - 1 + nTilex*(tj - 1))) ! Neigbor element, inside same tile, to the north - sideinfo(4, 3, iel) = 10*1 ! Neighbor side id - neighbor to the north, south side (1) - sideinfo(5, 3, iel) = 0 ! Boundary condition id; (null, interior edge) - end if - - ! west, iside=4 - ! Get the corner node ids for this edge - ! n1 = globalNodeIds(this%CGNSCornerMap(1,1),this%CGNSCornerMap(2,1),iel) - ! n2 = globalNodeIds(this%CGNSCornerMap(1,4),this%CGNSCornerMap(2,4),iel) - ! nc1 = min(n1,n2) - ! nc2 = max(n1,n2) - ! sideInfo(2,1,iel) = (nc1+nc2)*(nc1+nc2+1)/2 + nc2 - if (i == 1) then ! western most part of the tile - if (ti == 1) then ! western most tile - nedges = nedges + 1 - sideinfo(2, 4, iel) = nedges - sideinfo(3, 4, iel) = 0 ! Neigbor element (null, boundary condition) - sideinfo(4, 4, iel) = 0 ! Neighbor side id (null, boundary condition) - sideinfo(5, 4, iel) = bcids(4) ! Boundary condition id; eastern boundary set from the user input - else ! interior tile, but western most edge of the tile - e2 = nxPerTile + nxPerTile*(j - 1 + nyPerTile*(ti - 2 + nTilex*(tj - 1))) ! Neigbor element, easternnmost element in tile to the west - sideinfo(3, 4, iel) = sideInfo(2, 2, e2) ! Copy the edge id from neighbor's east edge - sideinfo(3, 4, iel) = e2 - sideinfo(4, 4, iel) = 10*2 ! Neighbor side id - neighbor to the west, east side (2) - sideinfo(5, 4, iel) = 0 ! Boundary condition id; (null, interior edge) - end if - else ! interior to the tile - e2 = i - 1 + nxPerTile*(j - 1 + nyPerTile*(ti - 1 + nTilex*(tj - 1))) ! Neigbor element, inside same tile, to the west - sideinfo(3, 4, iel) = sideInfo(2, 2, e2) ! Copy the edge id from neighbor's east edge - sideinfo(3, 4, iel) = e2 - sideinfo(4, 4, iel) = 10*2 ! Neighbor side id - neighbor to the west, east side (2) - sideinfo(5, 4, iel) = 0 ! Boundary condition id; (null, interior edge) - end if - - end do - end do - end do - end do - - call this%decomp%GenerateDecomposition(nGlobalElem, nUniqueSides) - - e1 = this%decomp%offsetElem(this%decomp%rankId + 1) + 1 - e2 = this%decomp%offsetElem(this%decomp%rankId + 2) - nLocalElems = e2 - e1 + 1 - - nLocalSides = nLocalElems*4 - nLocalNodes = nLocalElems*4 - call this%Init(nGeo, nLocalElems, nLocalSides, nLocalNodes, nBCs) - this%nUniqueSides = nUniqueSides - this%quadrature = UNIFORM - - this%nodeCoords(1:2, 1:nGeo + 1, 1:nGeo + 1, 1:nLocalElems) = nodeCoords(1:2, 1:nGeo + 1, 1:nGeo + 1, e1:e2) - this%globalNodeIDs(1:nGeo + 1, 1:nGeo + 1, 1:nLocalElems) = globalNodeIDs(1:nGeo + 1, 1:nGeo + 1, e1:e2) - this%sideInfo(1:5, 1:4, 1:nLocalElems) = sideInfo(1:5, 1:4, e1:e2) - - deallocate (nodeCoords) - deallocate (globalNodeIDs) - deallocate (sideInfo) - - call this%UpdateDevice() - - end subroutine UniformStructuredMesh_Mesh2D_t - - subroutine Read_HOPr_Mesh2D_t(this, meshFile) - ! From https://www.hopr-project.org/externals/Meshformat.pdf, Algorithm 6 - ! Adapted for 2D Mesh : Note that HOPR does not have 2D mesh output. - implicit none - class(Mesh2D_t), intent(out) :: this - character(*), intent(in) :: meshFile - ! Local - integer(HID_T) :: fileId - integer(HID_T) :: offset(1:2), gOffset(1) - integer :: nGlobalElem - integer :: firstElem - integer :: firstNode - integer :: firstSide - integer :: nLocalElems - integer :: nLocalNodes3D - integer :: nLocalSides3D - integer :: nUniqueSides3D - integer :: nLocalNodes2D - integer :: nLocalSides2D - integer :: nUniqueSides2D - integer :: nGeo, nBCs - integer :: eid, lsid, iSide - integer :: i, j, nid - integer, dimension(:, :), allocatable :: hopr_elemInfo - integer, dimension(:, :), allocatable :: hopr_sideInfo - real(prec), dimension(:, :), allocatable :: hopr_nodeCoords - integer, dimension(:), allocatable :: hopr_globalNodeIDs - integer, dimension(:, :), allocatable :: bcType - - call this%decomp%init() - - print *, __FILE__//' : Reading HOPr mesh from'//trim(meshfile) - if (this%decomp%mpiEnabled) then - call Open_HDF5(meshFile, H5F_ACC_RDONLY_F, fileId, this%decomp%mpiComm) - else - call Open_HDF5(meshFile, H5F_ACC_RDONLY_F, fileId) - end if - - print *, __FILE__//' : Loading mesh attributes' - call ReadAttribute_HDF5(fileId, 'nElems', nGlobalElem) - call ReadAttribute_HDF5(fileId, 'Ngeo', nGeo) - call ReadAttribute_HDF5(fileId, 'nBCs', nBCs) - call ReadAttribute_HDF5(fileId, 'nUniqueSides', nUniqueSides3D) - print *, __FILE__//' : N Global Elements = ', nGlobalElem - print *, __FILE__//' : Mesh geometry degree = ', nGeo - print *, __FILE__//' : N Boundary conditions = ', nBCs - print *, __FILE__//' : N Unique Sides (3D) = ', nUniqueSides3D - - ! Read BCType - allocate (bcType(1:4, 1:nBCS)) - - if (this%decomp%mpiEnabled) then - offset(:) = 0 - call ReadArray_HDF5(fileId, 'BCType', bcType, offset) - else - call ReadArray_HDF5(fileId, 'BCType', bcType) - end if - - ! Read local subarray of ElemInfo - print *, __FILE__//' : Generating Domain Decomposition' - call this%decomp%GenerateDecomposition(nGlobalElem, nUniqueSides3D) - - firstElem = this%decomp%offsetElem(this%decomp%rankId + 1) + 1 - nLocalElems = this%decomp%offsetElem(this%decomp%rankId + 2) - & - this%decomp%offsetElem(this%decomp%rankId + 1) - - print *, __FILE__//' : Rank ', this%decomp%rankId + 1, ' : element offset = ', firstElem - print *, __FILE__//' : Rank ', this%decomp%rankId + 1, ' : n_elements = ', nLocalElems - - ! Allocate Space for hopr_elemInfo! - allocate (hopr_elemInfo(1:6, 1:nLocalElems)) - - if (this%decomp%mpiEnabled) then - offset = (/0, firstElem - 1/) - call ReadArray_HDF5(fileId, 'ElemInfo', hopr_elemInfo, offset) - else - call ReadArray_HDF5(fileId, 'ElemInfo', hopr_elemInfo) - end if - - ! Read local subarray of NodeCoords and GlobalNodeIDs - firstNode = hopr_elemInfo(5, 1) + 1 - nLocalNodes3D = hopr_elemInfo(6, nLocalElems) - hopr_elemInfo(5, 1) - - ! Allocate Space for hopr_nodeCoords and hopr_globalNodeIDs ! - allocate (hopr_nodeCoords(1:3, nLocalNodes3D), hopr_globalNodeIDs(1:nLocalNodes3D)) - - if (this%decomp%mpiEnabled) then - offset = (/0, firstNode - 1/) - call ReadArray_HDF5(fileId, 'NodeCoords', hopr_nodeCoords, offset) - gOffset = (/firstNode - 1/) - call ReadArray_HDF5(fileId, 'GlobalNodeIDs', hopr_globalNodeIDs, gOffset) - else - call ReadArray_HDF5(fileId, 'NodeCoords', hopr_nodeCoords) - call ReadArray_HDF5(fileId, 'GlobalNodeIDs', hopr_globalNodeIDs) - end if - - ! Read local subarray of SideInfo - firstSide = hopr_elemInfo(3, 1) + 1 - nLocalSides3D = hopr_elemInfo(4, nLocalElems) - hopr_elemInfo(3, 1) - - ! Allocate space for hopr_sideInfo - allocate (hopr_sideInfo(1:5, 1:nLocalSides3D)) - if (this%decomp%mpiEnabled) then - offset = (/0, firstSide - 1/) - print *, __FILE__//' : Rank ', this%decomp%rankId + 1, ' Reading side information' - call ReadArray_HDF5(fileId, 'SideInfo', hopr_sideInfo, offset) - else - call ReadArray_HDF5(fileId, 'SideInfo', hopr_sideInfo) - end if - - call Close_HDF5(fileID) - ! ---- Done reading 3-D Mesh information ---- ! - - ! Now we need to convert from 3-D to 2-D ! - nLocalSides2D = nLocalSides3D - 2*nLocalElems - nUniqueSides2D = nUniqueSides3D - 2*nGlobalElem ! Remove the "top" and "bottom" faces - nLocalNodes2D = nLocalNodes2D - nLocalElems*nGeo*(nGeo + 1)**2 ! Remove the third dimension - - print *, __FILE__//' : Rank ', this%decomp%rankId + 1, ' Allocating memory for mesh' - print *, __FILE__//' : Rank ', this%decomp%rankId + 1, ' n local sides : ', nLocalSides2D - call this%Init(nGeo, nLocalElems, nLocalSides2D, nLocalNodes2D, nBCs) - this%nUniqueSides = nUniqueSides2D ! Store the number of sides in the global mesh - - ! Copy data from local arrays into this - ! elemInfo(1:6,iEl) - ! 1 - Element Type - ! 2 - Zone - ! 3 - offset index for side array (not needed when all quads are assumed) - ! 4 - last index for side array (not needed when all quads are assumed) - ! 5 - offset index for node array (not needed when all quads are assumed) - ! 6 - last index for node array (not needed when all quads are assumed) - this%elemInfo = hopr_elemInfo - this%quadrature = UNIFORM ! HOPr uses uniformly spaced points - - ! Grab the node coordinates (x and y only) from the "bottom" layer of the extruded mesh - do eid = 1, this%nElem - do j = 1, nGeo + 1 - do i = 1, nGeo + 1 - nid = i + (nGeo + 1)*(j - 1 + (nGeo + 1)*((nGeo + 1)*(eid - 1))) - this%nodeCoords(1:2, i, j, eid) = hopr_nodeCoords(1:2, nid) - this%globalNodeIDs(i, j, eid) = hopr_globalNodeIDs(nid) - end do - end do - end do - - ! Grab the south, west, north, and south sides of the elements - ! sideInfo(1:5,iSide,iEl) - ! - ! 1 - Side Type (currently unused in SELF) - ! 2 - Global Side ID (Used for message passing. Don't need to change) - ! 3 - Neighbor Element ID (Can stay the same) - ! 4 - 10*( neighbor local side ) + flip (Need to recalculate flip) - ! 5 - Boundary Condition ID (Can stay the same) - do eid = 1, this%nElem - do lsid = 1, 4 - ! Calculate the 3-D side ID from the 2-D local side id and element ID - iSide = lsid + 1 + 6*(eid - 1) - this%sideInfo(1:5, lsid, eid) = hopr_sideInfo(1:5, iSide) - ! Adjust the secondary side index for 2-D - this%sideInfo(4, lsid, eid) = this%sideInfo(4, lsid, eid) - 10 - end do - end do - call this%RecalculateFlip() - - deallocate (hopr_elemInfo, hopr_nodeCoords, hopr_globalNodeIDs, hopr_sideInfo) - - call this%UpdateDevice() - - end subroutine Read_HOPr_Mesh2D_t - - subroutine RecalculateFlip_Mesh2D_t(this) - implicit none - class(Mesh2D_t), intent(inout) :: this - ! Local - integer :: e1 - integer :: s1 - integer :: e2 - integer :: e2Global - integer :: s2 - integer :: flip - integer :: bcid - integer :: lnid1(1:2) - integer :: lnid2(1:2) - integer :: nid1(1:2, 1:4, 1:this%nElem) - integer :: nid2(1:2, 1:4, 1:this%nElem) - integer :: nloc1(1:2) - integer :: nloc2(1:2) - integer :: n1 - integer :: n1Global - integer :: n2 - integer :: n2Global - integer :: c1 - integer :: c2 - integer :: i, j - integer :: l - integer :: nShifts - integer :: neighborRank - integer :: rankId - integer :: offset - integer :: msgCount - integer :: globalSideId - integer, allocatable :: requests(:) - integer, allocatable :: stats(:, :) - integer :: iError - integer :: tag - logical :: theyMatch - - allocate (requests(1:this%nSides*2)) - allocate (stats(MPI_STATUS_SIZE, 1:this%nSides*2)) - - if (this%decomp%mpiEnabled) then - rankId = this%decomp%rankId - offset = this%decomp%offsetElem(rankId + 1) - else - rankId = 0 - offset = 0 - end if - - msgCount = 0 - do e1 = 1, this%nElem - do s1 = 1, 4 - - e2Global = this%sideInfo(3, s1, e1) - e2 = e2Global - offset - s2 = this%sideInfo(4, s1, e1)/10 - flip = this%sideInfo(4, s1, e1) - s2*10 - bcid = this%sideInfo(5, s1, e1) - - if (e2Global > 0) then - - if (this%decomp%mpiEnabled) then - neighborRank = this%decomp%elemToRank(e2Global) - else - neighborRank = 0 - end if - - if (neighborRank == rankId) then - - lnid1 = this%CGNSSideMap(1:2, s1) ! local CGNS corner node ids for element 1 side - lnid2 = this%CGNSSideMap(1:2, s2) ! local CGNS corner node ids for element 2 side - - do l = 1, 2 - - i = this%CGNSCornerMap(1, lnid1(l)) - j = this%CGNSCornerMap(2, lnid1(l)) - nid1(l, s1, e1) = this%globalNodeIDs(i, j, e1) - - i = this%CGNSCornerMap(1, lnid2(l)) - j = this%CGNSCornerMap(2, lnid2(l)) - nid2(l, s1, e1) = this%globalNodeIDs(i, j, e2) - - end do - - else ! In this case, we need to exchange - - globalSideId = abs(this%sideInfo(2, s1, e1)) - - lnid1 = this%CGNSSideMap(1:2, s1) ! local CGNS corner node ids for element 1 side - - do l = 1, 2 - - i = this%CGNSCornerMap(1, lnid1(l)) - j = this%CGNSCornerMap(2, lnid1(l)) - nid1(l, s1, e1) = this%globalNodeIDs(i, j, e1) - - tag = l + 2*globalSideId - msgCount = msgCount + 1 - call MPI_IRECV(nid2(l, s1, e1), & - 1, & - MPI_INTEGER, & - neighborRank, tag, & - this%decomp%mpiComm, & - requests(msgCount), iError) - - ! Send nid1(l) from this rank to nid2(l) on the other rank - msgCount = msgCount + 1 - call MPI_ISEND(nid1(l, s1, e1), & - 1, & - MPI_INTEGER, & - neighborRank, tag, & - this%decomp%mpiComm, & - requests(msgCount), iError) - - end do - - end if ! MPI or not - - end if ! If not physical boundary - - end do - end do - - if (this%decomp%mpiEnabled .and. msgCount > 0) then - call MPI_WaitAll(msgCount, & - requests(1:msgCount), & - stats(1:MPI_STATUS_SIZE, 1:msgCount), & - iError) - end if + implicit none + class(Mesh2D_t),intent(out) :: this + integer,intent(in) :: nxPerTile + integer,intent(in) :: nyPerTile + integer,intent(in) :: nTileX + integer,intent(in) :: nTileY + real(prec),intent(in) :: dx + real(prec),intent(in) :: dy + integer,intent(in) :: bcids(1:4) + ! Local + integer :: nX,nY,nGeo,nBCs + integer :: nGlobalElem + integer :: nUniqueSides + integer :: nUniqueNodes + integer :: nLocalElems + integer :: nLocalSides + integer :: nLocalNodes + real(prec),allocatable :: nodeCoords(:,:,:,:) + integer,allocatable :: globalNodeIDs(:,:,:) + integer,allocatable :: sideInfo(:,:,:) + integer :: i,j,ti,tj + integer :: ix,iy,iel + integer :: ni,nj + integer :: e1,e2 + integer :: nedges + + call this%decomp%init() + + nX = nTileX*nxPerTile + nY = nTileY*nyPerTile + nGeo = 1 ! Force the geometry to be linear + nBCs = 4 ! Force the number of boundary conditions to 4 + + nGlobalElem = nX*nY + nUniqueSides = (nX+1)*nY+(nY+1)*nX + nUniqueNodes = (nX+1)*(nY+1) + + allocate(nodeCoords(1:2,1:nGeo+1,1:nGeo+1,1:nGlobalElem)) + allocate(globalNodeIDs(1:nGeo+1,1:nGeo+1,1:nGlobalElem)) + allocate(sideInfo(1:5,1:4,1:nGlobalElem)) + + do tj = 1,nTileY + do ti = 1,nTileX + do j = 1,nyPerTile + iy = j+nyPerTile*(tj-1) + do i = 1,nxPerTile + iel = i+nxPerTile*(j-1+nyPerTile*(ti-1+nTilex*(tj-1))) + ix = i+nxPerTile*(ti-1) ! nxpertile + nxpertile*(nTileX-1) = nxperTile*nTilex = 1 + do nj = 1,nGeo+1 + do ni = 1,nGeo+1 + nodeCoords(1,ni,nj,iel) = real(ni-1+ix-1,prec)*dx + nodeCoords(2,ni,nj,iel) = real(nj-1+iy-1,prec)*dy + globalNodeIDs(ni,nj,iel) = ni-1+i+(nxPerTile+1)*( & + nj-1+j-1+(nyPerTile+1)*( & + ti-1+nTileX*(tj-1))) + enddo + enddo + enddo + enddo + enddo + enddo + + ! Fill in edge information + ! sideInfo(1:5,iSide,iEl) + ! 1 - Side Type (currently unused in SELF) + ! 2 - Global Side ID (Used for message passing. Don't need to change) + ! 3 - Neighbor Element ID (Can stay the same) + ! 4 - 10*( neighbor local side ) + flip (Need to recalculate flip) + ! 5 - Boundary Condition ID (Can stay the same) + nedges = 0 + do tj = 1,nTileY + do ti = 1,nTileX + do j = 1,nyPerTile + do i = 1,nxPerTile + iel = i+nxPerTile*(j-1+nyPerTile*(ti-1+nTilex*(tj-1))) + + ! south, iside=1 + ! Get the corner node ids for this edge + ! sideInfo(2,1,iel) = (nc1+nc2)*(nc1+nc2+1)/2 + nc2 + if(j == 1) then ! southern most part of the tile + if(tj == 1) then ! southern most tile + nedges = nedges+1 + sideinfo(2,1,iel) = nedges + sideinfo(3,1,iel) = 0 ! Neigbor element (null, boundary condition) + sideinfo(4,1,iel) = 0 ! Neighbor side id (null, boundary condition) + sideinfo(5,1,iel) = bcids(1) ! Boundary condition id; set from the user input + else ! interior tile, but souther most edge of the tile + e2 = i+nxPerTile*(nyPerTile-1+nyPerTile*(ti-1+nTilex*(tj-2))) ! Neigbor element, northernmost element, in tile to the south + sideinfo(2,1,iel) = sideInfo(2,3,e2) ! Copy the edge id from neighbor's north edge + sideinfo(3,1,iel) = e2 + sideinfo(4,1,iel) = 10*3 ! Neighbor side id - neighbor to the south, north side (3) + sideinfo(5,1,iel) = 0 ! Boundary condition id; (null, interior edge) + endif + else ! interior to the tile + e2 = i+nxPerTile*(j-2+nyPerTile*(ti-1+nTilex*(tj-1))) ! Neigbor element, inside same tile, to the south + sideinfo(2,1,iel) = sideInfo(2,3,e2) ! Copy the edge id from neighbor's north edge + sideinfo(3,1,iel) = e2 + sideinfo(4,1,iel) = 10*3 ! Neighbor side id - neighbor to the south, north side (3) + sideinfo(5,1,iel) = 0 ! Boundary condition id; (null, interior edge) + endif + + ! east, iside=2 + ! Get the corner node ids for this edge + ! East edges are always new edges, due to the way we are traversing the grid + nedges = nedges+1 + sideinfo(2,2,iel) = nedges + if(i == nxPerTile) then ! eastern most part of the tile + if(ti == nTileX) then ! eastern most tile + sideinfo(3,2,iel) = 0 ! Neigbor element (null, boundary condition) + sideinfo(4,2,iel) = 0 ! Neighbor side id (null, boundary condition) + sideinfo(5,2,iel) = bcids(2) ! Boundary condition id; eastern boundary set from the user input + else ! interior tile, but eastern most edge of the tile + sideinfo(3,2,iel) = 1+nxPerTile*(j-1+nyPerTile*(ti+nTilex*(tj-1))) ! Neigbor element, westernnmost element, in tile to the east + sideinfo(4,2,iel) = 10*4 ! Neighbor side id - neighbor to the east, west side (4) + sideinfo(5,2,iel) = 0 ! Boundary condition id; (null, interior edge) + endif + else ! interior to the tile + sideinfo(3,2,iel) = i+1+nxPerTile*(j-1+nyPerTile*(ti-1+nTilex*(tj-1))) ! Neigbor element, inside same tile, to the east + sideinfo(4,2,iel) = 10*4 ! Neighbor side id - neighbor to the east, west side (4) + sideinfo(5,2,iel) = 0 ! Boundary condition id; (null, interior edge) + endif + + ! north, iside=3 + ! Get the corner node ids for this edge + ! East edges are always new edges, due to the way we are traversing the grid + nedges = nedges+1 + sideinfo(2,3,iel) = nedges + if(j == nyPerTile) then ! northern most part of the tile + if(tj == nTileY) then ! northern most tile + sideinfo(3,3,iel) = 0 ! Neigbor element (null, boundary condition) + sideinfo(4,3,iel) = 0 ! Neighbor side id (null, boundary condition) + sideinfo(5,3,iel) = bcids(3) ! Boundary condition id; set from the user input + else ! interior tile, but northern most edge of the tile + sideinfo(3,3,iel) = i+nxPerTile*(nyPerTile*(ti-1+nTilex*(tj))) ! Neigbor element, southernmost element in tile to the north + sideinfo(4,3,iel) = 10*1 ! Neighbor side id - neighbor to the north, south side (1) + sideinfo(5,3,iel) = 0 ! Boundary condition id; (null, interior edge) + endif + else ! interior to the tile + sideinfo(3,3,iel) = i+nxPerTile*(j+nyPerTile*(ti-1+nTilex*(tj-1))) ! Neigbor element, inside same tile, to the north + sideinfo(4,3,iel) = 10*1 ! Neighbor side id - neighbor to the north, south side (1) + sideinfo(5,3,iel) = 0 ! Boundary condition id; (null, interior edge) + endif + + ! west, iside=4 + ! Get the corner node ids for this edge + ! n1 = globalNodeIds(this%CGNSCornerMap(1,1),this%CGNSCornerMap(2,1),iel) + ! n2 = globalNodeIds(this%CGNSCornerMap(1,4),this%CGNSCornerMap(2,4),iel) + ! nc1 = min(n1,n2) + ! nc2 = max(n1,n2) + ! sideInfo(2,1,iel) = (nc1+nc2)*(nc1+nc2+1)/2 + nc2 + if(i == 1) then ! western most part of the tile + if(ti == 1) then ! western most tile + nedges = nedges+1 + sideinfo(2,4,iel) = nedges + sideinfo(3,4,iel) = 0 ! Neigbor element (null, boundary condition) + sideinfo(4,4,iel) = 0 ! Neighbor side id (null, boundary condition) + sideinfo(5,4,iel) = bcids(4) ! Boundary condition id; eastern boundary set from the user input + else ! interior tile, but western most edge of the tile + e2 = nxPerTile+nxPerTile*(j-1+nyPerTile*(ti-2+nTilex*(tj-1))) ! Neigbor element, easternnmost element in tile to the west + sideinfo(3,4,iel) = sideInfo(2,2,e2) ! Copy the edge id from neighbor's east edge + sideinfo(3,4,iel) = e2 + sideinfo(4,4,iel) = 10*2 ! Neighbor side id - neighbor to the west, east side (2) + sideinfo(5,4,iel) = 0 ! Boundary condition id; (null, interior edge) + endif + else ! interior to the tile + e2 = i-1+nxPerTile*(j-1+nyPerTile*(ti-1+nTilex*(tj-1))) ! Neigbor element, inside same tile, to the west + sideinfo(3,4,iel) = sideInfo(2,2,e2) ! Copy the edge id from neighbor's east edge + sideinfo(3,4,iel) = e2 + sideinfo(4,4,iel) = 10*2 ! Neighbor side id - neighbor to the west, east side (2) + sideinfo(5,4,iel) = 0 ! Boundary condition id; (null, interior edge) + endif + + enddo + enddo + enddo + enddo + + call this%decomp%GenerateDecomposition(nGlobalElem,nUniqueSides) + + e1 = this%decomp%offsetElem(this%decomp%rankId+1)+1 + e2 = this%decomp%offsetElem(this%decomp%rankId+2) + nLocalElems = e2-e1+1 + + nLocalSides = nLocalElems*4 + nLocalNodes = nLocalElems*4 + call this%Init(nGeo,nLocalElems,nLocalSides,nLocalNodes,nBCs) + this%nUniqueSides = nUniqueSides + this%quadrature = UNIFORM + + this%nodeCoords(1:2,1:nGeo+1,1:nGeo+1,1:nLocalElems) = nodeCoords(1:2,1:nGeo+1,1:nGeo+1,e1:e2) + this%globalNodeIDs(1:nGeo+1,1:nGeo+1,1:nLocalElems) = globalNodeIDs(1:nGeo+1,1:nGeo+1,e1:e2) + this%sideInfo(1:5,1:4,1:nLocalElems) = sideInfo(1:5,1:4,e1:e2) + + deallocate(nodeCoords) + deallocate(globalNodeIDs) + deallocate(sideInfo) + + call this%UpdateDevice() + + endsubroutine UniformStructuredMesh_Mesh2D_t + + subroutine Read_HOPr_Mesh2D_t(this,meshFile) + ! From https://www.hopr-project.org/externals/Meshformat.pdf, Algorithm 6 + ! Adapted for 2D Mesh : Note that HOPR does not have 2D mesh output. + implicit none + class(Mesh2D_t),intent(out) :: this + character(*),intent(in) :: meshFile + ! Local + integer(HID_T) :: fileId + integer(HID_T) :: offset(1:2),gOffset(1) + integer :: nGlobalElem + integer :: firstElem + integer :: firstNode + integer :: firstSide + integer :: nLocalElems + integer :: nLocalNodes3D + integer :: nLocalSides3D + integer :: nUniqueSides3D + integer :: nLocalNodes2D + integer :: nLocalSides2D + integer :: nUniqueSides2D + integer :: nGeo,nBCs + integer :: eid,lsid,iSide + integer :: i,j,nid + integer,dimension(:,:),allocatable :: hopr_elemInfo + integer,dimension(:,:),allocatable :: hopr_sideInfo + real(prec),dimension(:,:),allocatable :: hopr_nodeCoords + integer,dimension(:),allocatable :: hopr_globalNodeIDs + integer,dimension(:,:),allocatable :: bcType + + call this%decomp%init() + + print*,__FILE__//' : Reading HOPr mesh from'//trim(meshfile) + if(this%decomp%mpiEnabled) then + call Open_HDF5(meshFile,H5F_ACC_RDONLY_F,fileId,this%decomp%mpiComm) + else + call Open_HDF5(meshFile,H5F_ACC_RDONLY_F,fileId) + endif + + print*,__FILE__//' : Loading mesh attributes' + call ReadAttribute_HDF5(fileId,'nElems',nGlobalElem) + call ReadAttribute_HDF5(fileId,'Ngeo',nGeo) + call ReadAttribute_HDF5(fileId,'nBCs',nBCs) + call ReadAttribute_HDF5(fileId,'nUniqueSides',nUniqueSides3D) + print*,__FILE__//' : N Global Elements = ',nGlobalElem + print*,__FILE__//' : Mesh geometry degree = ',nGeo + print*,__FILE__//' : N Boundary conditions = ',nBCs + print*,__FILE__//' : N Unique Sides (3D) = ',nUniqueSides3D + + ! Read BCType + allocate(bcType(1:4,1:nBCS)) + + if(this%decomp%mpiEnabled) then + offset(:) = 0 + call ReadArray_HDF5(fileId,'BCType',bcType,offset) + else + call ReadArray_HDF5(fileId,'BCType',bcType) + endif + + ! Read local subarray of ElemInfo + print*,__FILE__//' : Generating Domain Decomposition' + call this%decomp%GenerateDecomposition(nGlobalElem,nUniqueSides3D) + + firstElem = this%decomp%offsetElem(this%decomp%rankId+1)+1 + nLocalElems = this%decomp%offsetElem(this%decomp%rankId+2)- & + this%decomp%offsetElem(this%decomp%rankId+1) + + print*,__FILE__//' : Rank ',this%decomp%rankId+1,' : element offset = ',firstElem + print*,__FILE__//' : Rank ',this%decomp%rankId+1,' : n_elements = ',nLocalElems + + ! Allocate Space for hopr_elemInfo! + allocate(hopr_elemInfo(1:6,1:nLocalElems)) + + if(this%decomp%mpiEnabled) then + offset = (/0,firstElem-1/) + call ReadArray_HDF5(fileId,'ElemInfo',hopr_elemInfo,offset) + else + call ReadArray_HDF5(fileId,'ElemInfo',hopr_elemInfo) + endif + + ! Read local subarray of NodeCoords and GlobalNodeIDs + firstNode = hopr_elemInfo(5,1)+1 + nLocalNodes3D = hopr_elemInfo(6,nLocalElems)-hopr_elemInfo(5,1) + + ! Allocate Space for hopr_nodeCoords and hopr_globalNodeIDs ! + allocate(hopr_nodeCoords(1:3,nLocalNodes3D),hopr_globalNodeIDs(1:nLocalNodes3D)) + + if(this%decomp%mpiEnabled) then + offset = (/0,firstNode-1/) + call ReadArray_HDF5(fileId,'NodeCoords',hopr_nodeCoords,offset) + gOffset = (/firstNode-1/) + call ReadArray_HDF5(fileId,'GlobalNodeIDs',hopr_globalNodeIDs,gOffset) + else + call ReadArray_HDF5(fileId,'NodeCoords',hopr_nodeCoords) + call ReadArray_HDF5(fileId,'GlobalNodeIDs',hopr_globalNodeIDs) + endif + + ! Read local subarray of SideInfo + firstSide = hopr_elemInfo(3,1)+1 + nLocalSides3D = hopr_elemInfo(4,nLocalElems)-hopr_elemInfo(3,1) + + ! Allocate space for hopr_sideInfo + allocate(hopr_sideInfo(1:5,1:nLocalSides3D)) + if(this%decomp%mpiEnabled) then + offset = (/0,firstSide-1/) + print*,__FILE__//' : Rank ',this%decomp%rankId+1,' Reading side information' + call ReadArray_HDF5(fileId,'SideInfo',hopr_sideInfo,offset) + else + call ReadArray_HDF5(fileId,'SideInfo',hopr_sideInfo) + endif + + call Close_HDF5(fileID) + ! ---- Done reading 3-D Mesh information ---- ! + + ! Now we need to convert from 3-D to 2-D ! + nLocalSides2D = nLocalSides3D-2*nLocalElems + nUniqueSides2D = nUniqueSides3D-2*nGlobalElem ! Remove the "top" and "bottom" faces + nLocalNodes2D = nLocalNodes2D-nLocalElems*nGeo*(nGeo+1)**2 ! Remove the third dimension + + print*,__FILE__//' : Rank ',this%decomp%rankId+1,' Allocating memory for mesh' + print*,__FILE__//' : Rank ',this%decomp%rankId+1,' n local sides : ',nLocalSides2D + call this%Init(nGeo,nLocalElems,nLocalSides2D,nLocalNodes2D,nBCs) + this%nUniqueSides = nUniqueSides2D ! Store the number of sides in the global mesh + + ! Copy data from local arrays into this + ! elemInfo(1:6,iEl) + ! 1 - Element Type + ! 2 - Zone + ! 3 - offset index for side array (not needed when all quads are assumed) + ! 4 - last index for side array (not needed when all quads are assumed) + ! 5 - offset index for node array (not needed when all quads are assumed) + ! 6 - last index for node array (not needed when all quads are assumed) + this%elemInfo = hopr_elemInfo + this%quadrature = UNIFORM ! HOPr uses uniformly spaced points + + ! Grab the node coordinates (x and y only) from the "bottom" layer of the extruded mesh + do eid = 1,this%nElem + do j = 1,nGeo+1 + do i = 1,nGeo+1 + nid = i+(nGeo+1)*(j-1+(nGeo+1)*((nGeo+1)*(eid-1))) + this%nodeCoords(1:2,i,j,eid) = hopr_nodeCoords(1:2,nid) + this%globalNodeIDs(i,j,eid) = hopr_globalNodeIDs(nid) + enddo + enddo + enddo + + ! Grab the south, west, north, and south sides of the elements + ! sideInfo(1:5,iSide,iEl) + ! + ! 1 - Side Type (currently unused in SELF) + ! 2 - Global Side ID (Used for message passing. Don't need to change) + ! 3 - Neighbor Element ID (Can stay the same) + ! 4 - 10*( neighbor local side ) + flip (Need to recalculate flip) + ! 5 - Boundary Condition ID (Can stay the same) + do eid = 1,this%nElem + do lsid = 1,4 + ! Calculate the 3-D side ID from the 2-D local side id and element ID + iSide = lsid+1+6*(eid-1) + this%sideInfo(1:5,lsid,eid) = hopr_sideInfo(1:5,iSide) + ! Adjust the secondary side index for 2-D + this%sideInfo(4,lsid,eid) = this%sideInfo(4,lsid,eid)-10 + enddo + enddo + call this%RecalculateFlip() + + deallocate(hopr_elemInfo,hopr_nodeCoords,hopr_globalNodeIDs,hopr_sideInfo) + + call this%UpdateDevice() + + endsubroutine Read_HOPr_Mesh2D_t + + subroutine RecalculateFlip_Mesh2D_t(this) + implicit none + class(Mesh2D_t),intent(inout) :: this + ! Local + integer :: e1 + integer :: s1 + integer :: e2 + integer :: e2Global + integer :: s2 + integer :: flip + integer :: bcid + integer :: lnid1(1:2) + integer :: lnid2(1:2) + integer :: nid1(1:2,1:4,1:this%nElem) + integer :: nid2(1:2,1:4,1:this%nElem) + integer :: nloc1(1:2) + integer :: nloc2(1:2) + integer :: n1 + integer :: n1Global + integer :: n2 + integer :: n2Global + integer :: c1 + integer :: c2 + integer :: i,j + integer :: l + integer :: nShifts + integer :: neighborRank + integer :: rankId + integer :: offset + integer :: msgCount + integer :: globalSideId + integer,allocatable :: requests(:) + integer,allocatable :: stats(:,:) + integer :: iError + integer :: tag + logical :: theyMatch + + allocate(requests(1:this%nSides*2)) + allocate(stats(MPI_STATUS_SIZE,1:this%nSides*2)) + + if(this%decomp%mpiEnabled) then + rankId = this%decomp%rankId + offset = this%decomp%offsetElem(rankId+1) + else + rankId = 0 + offset = 0 + endif + + msgCount = 0 + do e1 = 1,this%nElem + do s1 = 1,4 + + e2Global = this%sideInfo(3,s1,e1) + e2 = e2Global-offset + s2 = this%sideInfo(4,s1,e1)/10 + flip = this%sideInfo(4,s1,e1)-s2*10 + bcid = this%sideInfo(5,s1,e1) + + if(e2Global > 0) then + + if(this%decomp%mpiEnabled) then + neighborRank = this%decomp%elemToRank(e2Global) + else + neighborRank = 0 + endif + + if(neighborRank == rankId) then + + lnid1 = this%CGNSSideMap(1:2,s1) ! local CGNS corner node ids for element 1 side + lnid2 = this%CGNSSideMap(1:2,s2) ! local CGNS corner node ids for element 2 side + + do l = 1,2 + + i = this%CGNSCornerMap(1,lnid1(l)) + j = this%CGNSCornerMap(2,lnid1(l)) + nid1(l,s1,e1) = this%globalNodeIDs(i,j,e1) + + i = this%CGNSCornerMap(1,lnid2(l)) + j = this%CGNSCornerMap(2,lnid2(l)) + nid2(l,s1,e1) = this%globalNodeIDs(i,j,e2) + + enddo + + else ! In this case, we need to exchange + + globalSideId = abs(this%sideInfo(2,s1,e1)) + + lnid1 = this%CGNSSideMap(1:2,s1) ! local CGNS corner node ids for element 1 side + + do l = 1,2 + + i = this%CGNSCornerMap(1,lnid1(l)) + j = this%CGNSCornerMap(2,lnid1(l)) + nid1(l,s1,e1) = this%globalNodeIDs(i,j,e1) + + tag = l+2*globalSideId + msgCount = msgCount+1 + call MPI_IRECV(nid2(l,s1,e1), & + 1, & + MPI_INTEGER, & + neighborRank,tag, & + this%decomp%mpiComm, & + requests(msgCount),iError) + + ! Send nid1(l) from this rank to nid2(l) on the other rank + msgCount = msgCount+1 + call MPI_ISEND(nid1(l,s1,e1), & + 1, & + MPI_INTEGER, & + neighborRank,tag, & + this%decomp%mpiComm, & + requests(msgCount),iError) + + enddo + + endif ! MPI or not + + endif ! If not physical boundary + + enddo + enddo + + if(this%decomp%mpiEnabled .and. msgCount > 0) then + call MPI_WaitAll(msgCount, & + requests(1:msgCount), & + stats(1:MPI_STATUS_SIZE,1:msgCount), & + iError) + endif - do e1 = 1, this%nElem - do s1 = 1, 4 - e2Global = this%sideInfo(3, s1, e1) - s2 = this%sideInfo(4, s1, e1)/10 - nloc1(1:2) = nid1(1:2, s1, e1) - nloc2(1:2) = nid2(1:2, s1, e1) + do e1 = 1,this%nElem + do s1 = 1,4 + e2Global = this%sideInfo(3,s1,e1) + s2 = this%sideInfo(4,s1,e1)/10 + nloc1(1:2) = nid1(1:2,s1,e1) + nloc2(1:2) = nid2(1:2,s1,e1) - if (e2Global > 0) then - theyMatch = CompareArray(nloc1, nloc2, 2) + if(e2Global > 0) then + theyMatch = CompareArray(nloc1,nloc2,2) - if (theyMatch) then - this%sideInfo(4, s1, e1) = 10*s2 - else - this%sideInfo(4, s1, e1) = 10*s2 + 1 - end if + if(theyMatch) then + this%sideInfo(4,s1,e1) = 10*s2 + else + this%sideInfo(4,s1,e1) = 10*s2+1 + endif - end if + endif - end do - end do + enddo + enddo - deallocate (requests) - deallocate (stats) + deallocate(requests) + deallocate(stats) - end subroutine RecalculateFlip_Mesh2D_t + endsubroutine RecalculateFlip_Mesh2D_t - subroutine Write_Mesh2D_t(this, meshFile) - ! Writes mesh output in HOPR format (serial only) - implicit none - class(Mesh2D_t), intent(inout) :: this - character(*), intent(in) :: meshFile - ! Local - integer(HID_T) :: fileId + subroutine Write_Mesh2D_t(this,meshFile) + ! Writes mesh output in HOPR format (serial only) + implicit none + class(Mesh2D_t),intent(inout) :: this + character(*),intent(in) :: meshFile + ! Local + integer(HID_T) :: fileId - call Open_HDF5(meshFile, H5F_ACC_RDWR_F, fileId) - call WriteAttribute_HDF5(fileId, 'nElems', this%nElem) - call WriteAttribute_HDF5(fileId, 'Ngeo', this%nGeo) - call WriteAttribute_HDF5(fileId, 'nBCs', this%nBCs) + call Open_HDF5(meshFile,H5F_ACC_RDWR_F,fileId) + call WriteAttribute_HDF5(fileId,'nElems',this%nElem) + call WriteAttribute_HDF5(fileId,'Ngeo',this%nGeo) + call WriteAttribute_HDF5(fileId,'nBCs',this%nBCs) - call WriteArray_HDF5(fileId, 'BCType', this%bcType) + call WriteArray_HDF5(fileId,'BCType',this%bcType) - ! Write local subarray of ElemInfo - call WriteArray_HDF5(fileId, 'ElemInfo', this%elemInfo) + ! Write local subarray of ElemInfo + call WriteArray_HDF5(fileId,'ElemInfo',this%elemInfo) - ! Write local subarray of NodeCoords and GlobalNodeIDs - call WriteArray_HDF5(fileId, 'NodeCoords', this%nodeCoords) - call WriteArray_HDF5(fileId, 'GlobalNodeIDs', this%globalNodeIDs) + ! Write local subarray of NodeCoords and GlobalNodeIDs + call WriteArray_HDF5(fileId,'NodeCoords',this%nodeCoords) + call WriteArray_HDF5(fileId,'GlobalNodeIDs',this%globalNodeIDs) - ! Write local subarray of SideInfo - call WriteArray_HDF5(fileId, 'SideInfo', this%sideInfo) + ! Write local subarray of SideInfo + call WriteArray_HDF5(fileId,'SideInfo',this%sideInfo) - call Close_HDF5(fileID) + call Close_HDF5(fileID) - end subroutine Write_Mesh2D_t + endsubroutine Write_Mesh2D_t -end module SELF_Mesh_2D_t +endmodule SELF_Mesh_2D_t diff --git a/src/SELF_Mesh_3D_t.f90 b/src/SELF_Mesh_3D_t.f90 index b97c694a6..c415c0022 100644 --- a/src/SELF_Mesh_3D_t.f90 +++ b/src/SELF_Mesh_3D_t.f90 @@ -26,19 +26,19 @@ module SELF_Mesh_3D_t - use SELF_Constants - use SELF_Lagrange - use SELF_SupportRoutines - use SELF_HDF5 - use SELF_Mesh - use SELF_DomainDecomposition + use SELF_Constants + use SELF_Lagrange + use SELF_SupportRoutines + use SELF_HDF5 + use SELF_Mesh + use SELF_DomainDecomposition - ! External Libs ! - use HDF5 + ! External Libs ! + use HDF5 - use iso_c_binding + use iso_c_binding - implicit none + implicit none #include "SELF_Macros.h" ! ========================================================================= ! @@ -96,257 +96,257 @@ module SELF_Mesh_3D_t ! ! ========================================================================= ! - ! Side Ordering - integer, parameter :: selfSide3D_Bottom = 1 - integer, parameter :: selfSide3D_South = 2 - integer, parameter :: selfSide3D_East = 3 - integer, parameter :: selfSide3D_North = 4 - integer, parameter :: selfSide3D_West = 5 - integer, parameter :: selfSide3D_Top = 6 - - type, extends(SEMMesh) :: Mesh3D_t - integer, pointer, dimension(:, :, :) :: sideInfo - real(prec), pointer, dimension(:, :, :, :, :) :: nodeCoords - integer, pointer, dimension(:, :) :: elemInfo - integer, pointer, dimension(:, :, :, :) :: globalNodeIDs - integer, pointer, dimension(:, :) :: CGNSCornerMap - integer, pointer, dimension(:, :) :: sideMap - integer, pointer, dimension(:, :) :: CGNSSideMap - integer, pointer, dimension(:, :) :: BCType - character(LEN=255), allocatable :: BCNames(:) - - contains - - procedure, public :: Init => Init_Mesh3D_t - procedure, public :: Free => Free_Mesh3D_t - procedure, public :: UpdateDevice => UpdateDevice_Mesh3D_t - - generic, public :: StructuredMesh => UniformStructuredMesh_Mesh3D_t - procedure, private :: UniformStructuredMesh_Mesh3D_t - - procedure, public :: Read_HOPr => Read_HOPr_Mesh3D_t - - procedure, public :: ResetBoundaryConditionType => ResetBoundaryConditionType_Mesh3D_t - - procedure, public :: Write_Mesh => Write_Mesh3D_t - - procedure, public :: RecalculateFlip => RecalculateFlip_Mesh3D_t - - end type Mesh3D_t - - integer, private :: CGNStoSELFflip(1:6, 1:6, 1:4) - - ! This table maps the primary side, secondary side, and CGNS flip values - ! to indexing flips that are used in SELF. - ! This table is used after reading in HOPr mesh information in "RecalculateFlip" - ! SELF's flip indices correspond to the following scenarios - ! - ! 0 i2 = i1 j2 = j1 - ! 1 i2 = N-i1 j2 = j1 - ! 2 i2 = N-i1 j2 = N-j1 - ! 3 i2 = i1 j2 = N-j1 - ! 4 i2 = j1 j2 = i1 - ! 5 i2 = N-j1 j2 = i1 - ! 6 i2 = N-j1 j2 = N-i1 - ! 7 i2 = j1 j2 = N-i1 - ! - data CGNStoSELFflip/ & - 4, 0, 0, 1, 4, 0, & - 0, 4, 4, 5, 0, 4, & - 0, 4, 4, 5, 0, 4, & - 1, 7, 7, 6, 1, 7, & - 4, 0, 0, 1, 4, 0, & - 0, 4, 4, 5, 0, 4, & - 3, 5, 5, 4, 3, 5, & - 7, 1, 1, 0, 7, 1, & - 7, 1, 1, 0, 7, 1, & - 4, 0, 0, 1, 4, 0, & - 3, 5, 5, 4, 3, 5, & - 7, 1, 1, 0, 7, 1, & - 6, 2, 2, 3, 6, 2, & - 2, 6, 6, 7, 2, 6, & - 2, 6, 6, 7, 2, 6, & - 3, 5, 5, 4, 3, 5, & - 6, 2, 2, 3, 6, 2, & - 2, 6, 6, 7, 2, 6, & - 1, 7, 7, 6, 1, 7, & - 5, 3, 3, 2, 5, 3, & - 5, 3, 3, 2, 5, 3, & - 6, 2, 2, 3, 6, 2, & - 1, 7, 7, 6, 1, 7, & - 5, 3, 3, 2, 5, 3/ + ! Side Ordering + integer,parameter :: selfSide3D_Bottom = 1 + integer,parameter :: selfSide3D_South = 2 + integer,parameter :: selfSide3D_East = 3 + integer,parameter :: selfSide3D_North = 4 + integer,parameter :: selfSide3D_West = 5 + integer,parameter :: selfSide3D_Top = 6 + + type,extends(SEMMesh) :: Mesh3D_t + integer,pointer,dimension(:,:,:) :: sideInfo + real(prec),pointer,dimension(:,:,:,:,:) :: nodeCoords + integer,pointer,dimension(:,:) :: elemInfo + integer,pointer,dimension(:,:,:,:) :: globalNodeIDs + integer,pointer,dimension(:,:) :: CGNSCornerMap + integer,pointer,dimension(:,:) :: sideMap + integer,pointer,dimension(:,:) :: CGNSSideMap + integer,pointer,dimension(:,:) :: BCType + character(LEN=255),allocatable :: BCNames(:) + + contains + + procedure,public :: Init => Init_Mesh3D_t + procedure,public :: Free => Free_Mesh3D_t + procedure,public :: UpdateDevice => UpdateDevice_Mesh3D_t + + generic,public :: StructuredMesh => UniformStructuredMesh_Mesh3D_t + procedure,private :: UniformStructuredMesh_Mesh3D_t + + procedure,public :: Read_HOPr => Read_HOPr_Mesh3D_t + + procedure,public :: ResetBoundaryConditionType => ResetBoundaryConditionType_Mesh3D_t + + procedure,public :: Write_Mesh => Write_Mesh3D_t + + procedure,public :: RecalculateFlip => RecalculateFlip_Mesh3D_t + + endtype Mesh3D_t + + integer,private :: CGNStoSELFflip(1:6,1:6,1:4) + + ! This table maps the primary side, secondary side, and CGNS flip values + ! to indexing flips that are used in SELF. + ! This table is used after reading in HOPr mesh information in "RecalculateFlip" + ! SELF's flip indices correspond to the following scenarios + ! + ! 0 i2 = i1 j2 = j1 + ! 1 i2 = N-i1 j2 = j1 + ! 2 i2 = N-i1 j2 = N-j1 + ! 3 i2 = i1 j2 = N-j1 + ! 4 i2 = j1 j2 = i1 + ! 5 i2 = N-j1 j2 = i1 + ! 6 i2 = N-j1 j2 = N-i1 + ! 7 i2 = j1 j2 = N-i1 + ! + data CGNStoSELFflip/ & + 4,0,0,1,4,0, & + 0,4,4,5,0,4, & + 0,4,4,5,0,4, & + 1,7,7,6,1,7, & + 4,0,0,1,4,0, & + 0,4,4,5,0,4, & + 3,5,5,4,3,5, & + 7,1,1,0,7,1, & + 7,1,1,0,7,1, & + 4,0,0,1,4,0, & + 3,5,5,4,3,5, & + 7,1,1,0,7,1, & + 6,2,2,3,6,2, & + 2,6,6,7,2,6, & + 2,6,6,7,2,6, & + 3,5,5,4,3,5, & + 6,2,2,3,6,2, & + 2,6,6,7,2,6, & + 1,7,7,6,1,7, & + 5,3,3,2,5,3, & + 5,3,3,2,5,3, & + 6,2,2,3,6,2, & + 1,7,7,6,1,7, & + 5,3,3,2,5,3/ contains - subroutine Init_Mesh3D_t(this, nGeo, nElem, nSides, nNodes, nBCs) - implicit none - class(Mesh3D_t), intent(inout) :: this - integer, intent(in) :: nGeo - integer, intent(in) :: nElem - integer, intent(in) :: nSides - integer, intent(in) :: nNodes - integer, intent(in) :: nBCs - ! Local - integer :: i, j, k, l - - this%nElem = nElem - this%nGlobalElem = nElem - this%nGeo = nGeo - this%nSides = nSides - this%nNodes = nNodes - this%nCornerNodes = 0 - this%nUniqueSides = 0 - this%nUniqueNodes = 0 - this%nBCs = nBCs - - allocate (this%elemInfo(1:6, 1:nElem)) - allocate (this%sideInfo(1:5, 1:6, 1:nElem)) - allocate (this%nodeCoords(1:3, 1:nGeo + 1, 1:nGeo + 1, 1:nGeo + 1, 1:nElem)) - allocate (this%globalNodeIDs(1:nGeo + 1, 1:nGeo + 1, 1:nGeo + 1, 1:nElem)) - allocate (this%CGNSCornerMap(1:3, 1:8)) - allocate (this%CGNSSideMap(1:4, 1:6)) - allocate (this%sideMap(1:4, 1:6)) - allocate (this%BCType(1:4, 1:nBCs)) - - allocate (this%BCNames(1:nBCs)) - - ! Create lookup tables to assist with connectivity generation - this%CGNSCornerMap(1:3, 1) = (/1, 1, 1/) ! Bottom-South-West - this%CGNSCornerMap(1:3, 2) = (/nGeo + 1, 1, 1/) ! Bottom-South-East - this%CGNSCornerMap(1:3, 3) = (/nGeo + 1, nGeo + 1, 1/) ! Bottom-North-East - this%CGNSCornerMap(1:3, 4) = (/1, nGeo + 1, 1/) ! Bottom-North-West - this%CGNSCornerMap(1:3, 5) = (/1, 1, nGeo + 1/) ! Top-South-West - this%CGNSCornerMap(1:3, 6) = (/nGeo + 1, 1, nGeo + 1/) ! Top-South-East - this%CGNSCornerMap(1:3, 7) = (/nGeo + 1, nGeo + 1, nGeo + 1/) ! Top-North-East - this%CGNSCornerMap(1:3, 8) = (/1, nGeo + 1, nGeo + 1/) ! Top-North-West - - ! Maps from local corner node id to CGNS side - this%CGNSSideMap(1:4, 1) = (/1, 4, 3, 2/) - this%CGNSSideMap(1:4, 2) = (/1, 2, 6, 5/) - this%CGNSSideMap(1:4, 3) = (/2, 3, 7, 6/) - this%CGNSSideMap(1:4, 4) = (/3, 4, 8, 7/) - this%CGNSSideMap(1:4, 5) = (/1, 5, 8, 4/) - this%CGNSSideMap(1:4, 6) = (/5, 6, 7, 8/) - - ! Sidemap traverses each face so that the normal - ! formed by the right hand rule is the coordinate - ! positive pointing normal. For east,north,and top - ! this is an outward facing normal. - ! For bottom, south, and west, the normal is inward - ! facing. - this%sideMap(1:4, 1) = (/1, 2, 3, 4/) ! Bottom - this%sideMap(1:4, 2) = (/1, 2, 6, 5/) ! South - this%sideMap(1:4, 3) = (/2, 3, 7, 6/) ! East - this%sideMap(1:4, 4) = (/4, 3, 7, 8/) ! North - this%sideMap(1:4, 5) = (/1, 4, 8, 5/) ! West - this%sideMap(1:4, 6) = (/5, 6, 7, 8/) ! Top - - end subroutine Init_Mesh3D_t - - subroutine Free_Mesh3D_t(this) - implicit none - class(Mesh3D_t), intent(inout) :: this - - this%nElem = 0 - this%nSides = 0 - this%nNodes = 0 - this%nCornerNodes = 0 - this%nUniqueSides = 0 - this%nUniqueNodes = 0 - this%nBCs = 0 - - deallocate (this%elemInfo) - deallocate (this%sideInfo) - deallocate (this%nodeCoords) - deallocate (this%globalNodeIDs) - deallocate (this%CGNSCornerMap) - deallocate (this%sideMap) - deallocate (this%CGNSSideMap) - deallocate (this%BCType) - - deallocate (this%BCNames) - call this%decomp%Free() - - end subroutine Free_Mesh3D_t - - subroutine UpdateDevice_Mesh3D_t(this) - implicit none - class(Mesh3D_t), intent(inout) :: this - - return - - end subroutine UpdateDevice_Mesh3D_t - - subroutine ResetBoundaryConditionType_Mesh3D_t(this, bcid) + subroutine Init_Mesh3D_t(this,nGeo,nElem,nSides,nNodes,nBCs) + implicit none + class(Mesh3D_t),intent(inout) :: this + integer,intent(in) :: nGeo + integer,intent(in) :: nElem + integer,intent(in) :: nSides + integer,intent(in) :: nNodes + integer,intent(in) :: nBCs + ! Local + integer :: i,j,k,l + + this%nElem = nElem + this%nGlobalElem = nElem + this%nGeo = nGeo + this%nSides = nSides + this%nNodes = nNodes + this%nCornerNodes = 0 + this%nUniqueSides = 0 + this%nUniqueNodes = 0 + this%nBCs = nBCs + + allocate(this%elemInfo(1:6,1:nElem)) + allocate(this%sideInfo(1:5,1:6,1:nElem)) + allocate(this%nodeCoords(1:3,1:nGeo+1,1:nGeo+1,1:nGeo+1,1:nElem)) + allocate(this%globalNodeIDs(1:nGeo+1,1:nGeo+1,1:nGeo+1,1:nElem)) + allocate(this%CGNSCornerMap(1:3,1:8)) + allocate(this%CGNSSideMap(1:4,1:6)) + allocate(this%sideMap(1:4,1:6)) + allocate(this%BCType(1:4,1:nBCs)) + + allocate(this%BCNames(1:nBCs)) + + ! Create lookup tables to assist with connectivity generation + this%CGNSCornerMap(1:3,1) = (/1,1,1/) ! Bottom-South-West + this%CGNSCornerMap(1:3,2) = (/nGeo+1,1,1/) ! Bottom-South-East + this%CGNSCornerMap(1:3,3) = (/nGeo+1,nGeo+1,1/) ! Bottom-North-East + this%CGNSCornerMap(1:3,4) = (/1,nGeo+1,1/) ! Bottom-North-West + this%CGNSCornerMap(1:3,5) = (/1,1,nGeo+1/) ! Top-South-West + this%CGNSCornerMap(1:3,6) = (/nGeo+1,1,nGeo+1/) ! Top-South-East + this%CGNSCornerMap(1:3,7) = (/nGeo+1,nGeo+1,nGeo+1/) ! Top-North-East + this%CGNSCornerMap(1:3,8) = (/1,nGeo+1,nGeo+1/) ! Top-North-West + + ! Maps from local corner node id to CGNS side + this%CGNSSideMap(1:4,1) = (/1,4,3,2/) + this%CGNSSideMap(1:4,2) = (/1,2,6,5/) + this%CGNSSideMap(1:4,3) = (/2,3,7,6/) + this%CGNSSideMap(1:4,4) = (/3,4,8,7/) + this%CGNSSideMap(1:4,5) = (/1,5,8,4/) + this%CGNSSideMap(1:4,6) = (/5,6,7,8/) + + ! Sidemap traverses each face so that the normal + ! formed by the right hand rule is the coordinate + ! positive pointing normal. For east,north,and top + ! this is an outward facing normal. + ! For bottom, south, and west, the normal is inward + ! facing. + this%sideMap(1:4,1) = (/1,2,3,4/) ! Bottom + this%sideMap(1:4,2) = (/1,2,6,5/) ! South + this%sideMap(1:4,3) = (/2,3,7,6/) ! East + this%sideMap(1:4,4) = (/4,3,7,8/) ! North + this%sideMap(1:4,5) = (/1,4,8,5/) ! West + this%sideMap(1:4,6) = (/5,6,7,8/) ! Top + + endsubroutine Init_Mesh3D_t + + subroutine Free_Mesh3D_t(this) + implicit none + class(Mesh3D_t),intent(inout) :: this + + this%nElem = 0 + this%nSides = 0 + this%nNodes = 0 + this%nCornerNodes = 0 + this%nUniqueSides = 0 + this%nUniqueNodes = 0 + this%nBCs = 0 + + deallocate(this%elemInfo) + deallocate(this%sideInfo) + deallocate(this%nodeCoords) + deallocate(this%globalNodeIDs) + deallocate(this%CGNSCornerMap) + deallocate(this%sideMap) + deallocate(this%CGNSSideMap) + deallocate(this%BCType) + + deallocate(this%BCNames) + call this%decomp%Free() + + endsubroutine Free_Mesh3D_t + + subroutine UpdateDevice_Mesh3D_t(this) + implicit none + class(Mesh3D_t),intent(inout) :: this + + return + + endsubroutine UpdateDevice_Mesh3D_t + + subroutine ResetBoundaryConditionType_Mesh3D_t(this,bcid) !! This method can be used to reset all of the boundary elements !! boundary condition type to the desired value. !! !! Note that ALL physical boundaries will be set to have this boundary !! condition - implicit none - class(Mesh3D_t), intent(inout) :: this - integer, intent(in) :: bcid - ! Local - integer :: iSide, iEl, e2 + implicit none + class(Mesh3D_t),intent(inout) :: this + integer,intent(in) :: bcid + ! Local + integer :: iSide,iEl,e2 - do iEl = 1, this%nElem - do iSide = 1, 6 + do iEl = 1,this%nElem + do iSide = 1,6 - e2 = this%sideInfo(3, iSide, iEl) + e2 = this%sideInfo(3,iSide,iEl) - if (e2 == 0) then - this%sideInfo(5, iSide, iEl) = bcid - end if + if(e2 == 0) then + this%sideInfo(5,iSide,iEl) = bcid + endif - end do - end do + enddo + enddo - end subroutine ResetBoundaryConditionType_Mesh3D_t + endsubroutine ResetBoundaryConditionType_Mesh3D_t - subroutine RecalculateFlip_Mesh3D_t(this) - implicit none - class(Mesh3D_t), intent(inout) :: this - ! Local - integer :: e1 - integer :: s1 - integer :: e2 - integer :: s2 - integer :: cgnsFlip, selfFlip + subroutine RecalculateFlip_Mesh3D_t(this) + implicit none + class(Mesh3D_t),intent(inout) :: this + ! Local + integer :: e1 + integer :: s1 + integer :: e2 + integer :: s2 + integer :: cgnsFlip,selfFlip - do e1 = 1, this%nElem - do s1 = 1, 6 + do e1 = 1,this%nElem + do s1 = 1,6 - e2 = this%sideInfo(3, s1, e1) - s2 = this%sideInfo(4, s1, e1)/10 - cgnsFlip = this%sideInfo(4, s1, e1) - s2*10 + e2 = this%sideInfo(3,s1,e1) + s2 = this%sideInfo(4,s1,e1)/10 + cgnsFlip = this%sideInfo(4,s1,e1)-s2*10 - if (e2 /= 0) then + if(e2 /= 0) then - selfFlip = CGNStoSELFflip(s2, s1, cgnsFlip) - this%sideInfo(4, s1, e1) = 10*s2 + selfFlip + selfFlip = CGNStoSELFflip(s2,s1,cgnsFlip) + this%sideInfo(4,s1,e1) = 10*s2+selfFlip - end if + endif - end do - end do + enddo + enddo - end subroutine RecalculateFlip_Mesh3D_t + endsubroutine RecalculateFlip_Mesh3D_t - pure function elementid(i, j, k, ti, tj, tk, nxpertile, nypertile, nzpertile, & - ntilex, ntiley, ntilez) result(eid) - integer, intent(in) :: i, j, k - integer, intent(in) :: ti, tj, tk - integer, intent(in) :: nxpertile, nypertile, nzpertile - integer, intent(in) :: ntilex, ntiley, ntilez - integer :: eid + pure function elementid(i,j,k,ti,tj,tk,nxpertile,nypertile,nzpertile, & + ntilex,ntiley,ntilez) result(eid) + integer,intent(in) :: i,j,k + integer,intent(in) :: ti,tj,tk + integer,intent(in) :: nxpertile,nypertile,nzpertile + integer,intent(in) :: ntilex,ntiley,ntilez + integer :: eid - eid = i + nxpertile*(j - 1 + nypertile*(k - 1 + nzpertile*( & - ti - 1 + ntilex*(tj - 1 + ntiley*(tk - 1))))) + eid = i+nxpertile*(j-1+nypertile*(k-1+nzpertile*( & + ti-1+ntilex*(tj-1+ntiley*(tk-1))))) - end function elementid + endfunction elementid - subroutine UniformStructuredMesh_Mesh3D_t(this, nxPerTile, nyPerTile, nzPerTile, & - nTileX, nTileY, nTileZ, dx, dy, dz, bcids) + subroutine UniformStructuredMesh_Mesh3D_t(this,nxPerTile,nyPerTile,nzPerTile, & + nTileX,nTileY,nTileZ,dx,dy,dz,bcids) !! !! Create a structured mesh and store it in SELF's unstructured mesh format. !! The mesh is created in tiles of size (tnx,tny,tnz). Tiling is used to determine @@ -376,485 +376,485 @@ subroutine UniformStructuredMesh_Mesh3D_t(this, nxPerTile, nyPerTile, nzPerTile, !! Length of the domain in the x-direction is Lx = dx*nX !! Length of the domain in the y-direction is Ly = dy*nY !! - implicit none - class(Mesh3D_t), intent(out) :: this - integer, intent(in) :: nxPerTile - integer, intent(in) :: nyPerTile - integer, intent(in) :: nzPerTile - integer, intent(in) :: nTileX - integer, intent(in) :: nTileY - integer, intent(in) :: nTileZ - real(prec), intent(in) :: dx - real(prec), intent(in) :: dy - real(prec), intent(in) :: dz - integer, intent(in) :: bcids(1:6) - ! Local - integer :: nX, nY, nZ, nGeo, nBCs - integer :: nGlobalElem - integer :: nUniqueSides - integer :: nUniqueNodes - integer :: nLocalElems - integer :: nLocalSides - integer :: nLocalNodes - real(prec), allocatable :: nodeCoords(:, :, :, :, :) - integer, allocatable :: globalNodeIDs(:, :, :, :) - integer, allocatable :: sideInfo(:, :, :) - integer :: i, j, k, ti, tj, tk - integer :: ix, iy, iz, iel - integer :: ni, nj, nk - integer :: e1, e2, s1, s2 - integer :: nfaces - - call this%decomp%init() - - nX = nTileX*nxPerTile - nY = nTileY*nyPerTile - nZ = nTileZ*nzPerTile - nGeo = 1 ! Force the geometry to be linear - nBCs = 6 ! Force the number of boundary conditions to 4 - - nGlobalElem = nX*nY*nZ - nUniqueSides = (nX + 1)*nY*nZ + (nY + 1)*nX*nZ + (nZ + 1)*nX*nY - nUniqueNodes = (nX + 1)*(nY + 1)*(nZ + 1) - - allocate (nodeCoords(1:3, 1:nGeo + 1, 1:nGeo + 1, 1:nGeo + 1, 1:nGlobalElem)) - allocate (globalNodeIDs(1:nGeo + 1, 1:nGeo + 1, 1:nGeo + 1, 1:nGlobalElem)) - allocate (sideInfo(1:5, 1:6, 1:nGlobalElem)) - - do tk = 1, nTileZ - do tj = 1, nTileY - do ti = 1, nTileX - do k = 1, nzPerTile - iz = k + nzPerTile*(tk - 1) - do j = 1, nyPerTile - iy = j + nyPerTile*(tj - 1) - do i = 1, nxPerTile - - iel = elementid(i, j, k, ti, tj, tk, & - nxpertile, nypertile, nzpertile, & - ntilex, ntiley, ntilez) - ix = i + nxPerTile*(ti - 1) - - do nk = 1, nGeo + 1 - do nj = 1, nGeo + 1 - do ni = 1, nGeo + 1 - nodeCoords(1, ni, nj, nk, iel) = real(ni - 1 + ix - 1, prec)*dx - nodeCoords(2, ni, nj, nk, iel) = real(nj - 1 + iy - 1, prec)*dy - nodeCoords(3, ni, nj, nk, iel) = real(nk - 1 + iz - 1, prec)*dz - globalNodeIDs(ni, nj, nk, iel) = ni - 1 + i + (nxPerTile + 1)*( & - nj - 1 + j - 1 + (nyPerTile + 1)*( & - nk - 1 + k - 1 + (nzPerTile + 1)*( & - (ti - 1 + nTileX*( & - tj - 1 + nTileY*(tk - 1)))))) - end do - end do - end do - - end do - end do - end do - end do - end do - end do - - ! Fill in face information - ! sideInfo(1:5,iSide,iEl) - ! 1 - Side Type (currently unused in SELF) - ! 2 - Global Side ID (Used for message passing) - ! 3 - Neighbor Element ID - ! 4 - 10*( neighbor local side ) + flip - ! 5 - Boundary Condition ID - nfaces = 0 - do tk = 1, nTileZ - do tj = 1, nTileY - do ti = 1, nTileX - do k = 1, nzPerTile - do j = 1, nyPerTile - do i = 1, nxPerTile - - iel = elementid(i, j, k, ti, tj, tk, & - nxpertile, nypertile, nzpertile, & - ntilex, ntiley, ntilez) - ! bottom, iside=1 - s1 = 1 - s2 = 6 - if (k == 1) then ! bottom most part of the tile - if (tk == 1) then ! bottom most tile - nfaces = nfaces + 1 - sideinfo(2, s1, iel) = nfaces - sideinfo(3, s1, iel) = 0 ! Neigbor element (null, boundary condition) - sideinfo(4, s1, iel) = 0 ! Neighbor side id (null, boundary condition) - sideinfo(5, s1, iel) = bcids(s1) ! Boundary condition id; set from the user input - else ! interior tile - !neighbor element is the top most element in the tile beneath - e2 = elementid(i, j, nzpertile, ti, tj, tk - 1, & - nxpertile, nypertile, nzpertile, & - ntilex, ntiley, ntilez) - - sideinfo(2, s1, iel) = sideInfo(2, s2, e2) ! Copy the face id from neighbor - sideinfo(3, s1, iel) = e2 - sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id - sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) - end if - else ! interior to the tile - !neighbor element is in the same tile, but beneath - e2 = elementid(i, j, k - 1, ti, tj, tk, & - nxpertile, nypertile, nzpertile, & - ntilex, ntiley, ntilez) - - sideinfo(2, s1, iel) = sideInfo(2, s2, e2) ! Copy the face id from neighbor - sideinfo(3, s1, iel) = e2 - sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id - sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) - end if - - ! south, iside=2 - s1 = 2 - s2 = 4 ! Neighbor side is north (4) - if (j == 1) then ! southern most part of the tile - if (tj == 1) then ! southern most tile - nfaces = nfaces + 1 - sideinfo(2, s1, iel) = nfaces - sideinfo(3, s1, iel) = 0 ! Neigbor element (null, boundary condition) - sideinfo(4, s1, iel) = 0 ! Neighbor side id (null, boundary condition) - sideinfo(5, s1, iel) = bcids(s1) ! Boundary condition id; eastern boundary set from the user input - else ! interior tile - !neighbor element is northernmost element in the tile to the south - e2 = elementid(i, nypertile, k, ti, tj - 1, tk, & - nxpertile, nypertile, nzpertile, & - ntilex, ntiley, ntilez) - - sideinfo(2, s1, iel) = sideInfo(2, s2, e2) ! Copy the face id from neighbor - sideinfo(3, s1, iel) = e2 ! Neigbor element - sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id - sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) - end if - else ! interior to the tile - !neighbor element is in the same tile, to the south - e2 = elementid(i, j - 1, k, ti, tj, tk, & - nxpertile, nypertile, nzpertile, & - ntilex, ntiley, ntilez) - - sideinfo(2, s1, iel) = sideInfo(2, s2, e2) ! Copy the face id from neighbor - sideinfo(3, s1, iel) = e2 ! Neigbor element - sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id - sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) - end if - - ! east, iside=3 - s1 = 3 - s2 = 5 ! neighbor side id is west (5) - ! East faces are always new faces, due to the way we are traversing the grid - nfaces = nfaces + 1 - sideinfo(2, s1, iel) = nfaces - if (i == nxPerTile) then ! eastern most part of the tile - if (ti == nTileX) then ! eastern most tile - sideinfo(3, s1, iel) = 0 ! Neigbor element (null, boundary condition) - sideinfo(4, s1, iel) = 0 ! Neighbor side id (null, boundary condition) - sideinfo(5, s1, iel) = bcids(s1) ! Boundary condition id; - else ! interior tile - !neighbor element is westernmost element in tile to the east - e2 = elementid(1, j, k, ti + 1, tj, tk, & - nxpertile, nypertile, nzpertile, & - ntilex, ntiley, ntilez) - sideinfo(3, s1, iel) = e2 ! Neigbor element - sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id - sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) - end if - else ! interior to the tile - !neighbor element is in the same tile, to the east - e2 = elementid(i + 1, j, k, ti, tj, tk, & - nxpertile, nypertile, nzpertile, & - ntilex, ntiley, ntilez) - sideinfo(3, s1, iel) = e2 ! Neigbor element - sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id - sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) - end if - - ! north, iside=4 - s1 = 4 - s2 = 2 ! neighbor side is south (2) - ! North faces are always new faces, due to the way we are traversing the grid - nfaces = nfaces + 1 - sideinfo(2, s1, iel) = nfaces - if (j == nyPerTile) then ! northern most part of the tile - if (tj == nTileY) then ! northern most tile - sideinfo(3, s1, iel) = 0 ! Neigbor element (null, boundary condition) - sideinfo(4, s1, iel) = 0 ! Neighbor side id (null, boundary condition) - sideinfo(5, s1, iel) = bcids(s1) ! Boundary condition id; set from the user input - else ! interior tile, but northern most face of the tile - !neighbor element is the southernmost element in the tile to the north - e2 = elementid(i, 1, k, ti, tj + 1, tk, & - nxpertile, nypertile, nzpertile, & - ntilex, ntiley, ntilez) - sideinfo(3, s1, iel) = e2 ! Neigbor element - sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id - sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) - end if - else ! interior to the tile - !neighbor element is the tile to the north - e2 = elementid(i, j + 1, k, ti, tj, tk, & - nxpertile, nypertile, nzpertile, & - ntilex, ntiley, ntilez) - sideinfo(3, s1, iel) = e2 ! Neigbor element - sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id - sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) - end if - - ! west, iside=5 - s1 = 5 - s2 = 3 ! neighbor side id is east (3) - if (i == 1) then ! western most part of the tile - if (ti == 1) then ! western most tile - nfaces = nfaces + 1 - sideinfo(2, s1, iel) = nfaces - sideinfo(3, s1, iel) = 0 ! Neigbor element (null, boundary condition) - sideinfo(4, s1, iel) = 0 ! Neighbor side id (null, boundary condition) - sideinfo(5, s1, iel) = bcids(s1) ! Boundary condition id - else ! interior tile, but western most face of the tile - !neighbor element is the easternmost element in the tile to the west - e2 = elementid(nxperTile, j, k, ti - 1, tj, tk, & - nxpertile, nypertile, nzpertile, & - ntilex, ntiley, ntilez) - - sideinfo(2, s1, iel) = sideInfo(2, s2, e2) ! Copy the face id from neighbor's east face - sideinfo(3, s1, iel) = e2 - sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id - neighbor to the west, east side (2) - sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) - end if - else ! interior to the tile - !neighbor element is the element to the west in the same tile - e2 = elementid(i - 1, j, k, ti, tj, tk, & - nxpertile, nypertile, nzpertile, & - ntilex, ntiley, ntilez) - - sideinfo(2, s1, iel) = sideInfo(2, s2, e2) ! Copy the face id from neighbor's east face - sideinfo(3, s1, iel) = e2 - sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id - neighbor to the west, east side (2) - sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) - end if - - ! top, iside=6 - s1 = 6 - s2 = 1 ! neighbor side is bottom (1) - ! Top faces are always new faces, due to the way we are traversing the grid - nfaces = nfaces + 1 - sideinfo(2, s1, iel) = nfaces - if (k == nzPerTile) then ! top most part of the tile - if (tk == nTileZ) then ! top most tile - sideinfo(3, s1, iel) = 0 ! Neigbor element (null, boundary condition) - sideinfo(4, s1, iel) = 0 ! Neighbor side id (null, boundary condition) - sideinfo(5, s1, iel) = bcids(s1) ! Boundary condition id; set from the user input - else ! interior tile, but top most face of the tile - !neighbor element is the bottom-most element in the tile above - e2 = elementid(i, j, 1, ti, tj, tk + 1, & - nxpertile, nypertile, nzpertile, & - ntilex, ntiley, ntilez) - sideinfo(3, s1, iel) = e2 ! Neigbor element - sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id - sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) - end if - else ! interior to the tile - !neighbor element is the tile above - e2 = elementid(i, j, k + 1, ti, tj, tk, & - nxpertile, nypertile, nzpertile, & - ntilex, ntiley, ntilez) - sideinfo(3, s1, iel) = e2 ! Neigbor element, inside same tile, to the north - sideinfo(4, s1, iel) = 10*s2 ! Neighbor side id - neighbor to the north, south side (1) - sideinfo(5, s1, iel) = 0 ! Boundary condition id; (null, interior face) - end if - - end do - end do - end do - end do - end do - end do - - call this%decomp%GenerateDecomposition(nGlobalElem, nUniqueSides) - - e1 = this%decomp%offsetElem(this%decomp%rankId + 1) + 1 - e2 = this%decomp%offsetElem(this%decomp%rankId + 2) - nLocalElems = e2 - e1 + 1 - - nLocalSides = nLocalElems*6 - nLocalNodes = nLocalElems*8 - call this%Init(nGeo, nLocalElems, nLocalSides, nLocalNodes, nBCs) - this%nUniqueSides = nUniqueSides - this%quadrature = UNIFORM - -this%nodeCoords(1:3, 1:nGeo + 1, 1:nGeo + 1, 1:nGeo + 1, 1:nLocalElems) = nodeCoords(1:3, 1:nGeo + 1, 1:nGeo + 1, 1:nGeo + 1, e1:e2) - this%globalNodeIDs(1:nGeo + 1, 1:nGeo + 1, 1:nGeo + 1, 1:nLocalElems) = globalNodeIDs(1:nGeo + 1, 1:nGeo + 1, 1:nGeo + 1, e1:e2) - this%sideInfo(1:5, 1:6, 1:nLocalElems) = sideInfo(1:5, 1:6, e1:e2) - - deallocate (nodeCoords) - deallocate (globalNodeIDs) - deallocate (sideInfo) - - call this%UpdateDevice() - - end subroutine UniformStructuredMesh_Mesh3D_t - - subroutine Read_HOPr_Mesh3D_t(this, meshFile) - ! From https://www.hopr-project.org/externals/Meshformat.pdf, Algorithm 6 - implicit none - class(Mesh3D_t), intent(out) :: this - character(*), intent(in) :: meshFile - ! Local - integer(HID_T) :: fileId - integer(HID_T) :: offset(1:2), gOffset(1) - integer :: nGlobalElem - integer :: firstElem - integer :: firstNode - integer :: firstSide - integer :: nLocalElems - integer :: nLocalNodes - integer :: nLocalSides - integer :: nUniqueSides - integer :: nGeo, nBCs - integer :: eid, lsid, iSide - integer :: i, j, k, nid - integer, dimension(:, :), allocatable :: hopr_elemInfo - integer, dimension(:, :), allocatable :: hopr_sideInfo - real(prec), dimension(:, :), allocatable :: hopr_nodeCoords - integer, dimension(:), allocatable :: hopr_globalNodeIDs - integer, dimension(:, :), allocatable :: bcType - - call this%decomp%init() - - if (this%decomp%mpiEnabled) then - call Open_HDF5(meshFile, H5F_ACC_RDONLY_F, fileId, this%decomp%mpiComm) - else - call Open_HDF5(meshFile, H5F_ACC_RDONLY_F, fileId) - end if - - call ReadAttribute_HDF5(fileId, 'nElems', nGlobalElem) - call ReadAttribute_HDF5(fileId, 'Ngeo', nGeo) - call ReadAttribute_HDF5(fileId, 'nBCs', nBCs) - call ReadAttribute_HDF5(fileId, 'nUniqueSides', nUniqueSides) - - ! Read BCType - allocate (bcType(1:4, 1:nBCs)) - if (this%decomp%mpiEnabled) then - offset(:) = 0 - call ReadArray_HDF5(fileId, 'BCType', bcType, offset) - else - call ReadArray_HDF5(fileId, 'BCType', bcType) - end if - - ! Read local subarray of ElemInfo - call this%decomp%GenerateDecomposition(nGlobalElem, nUniqueSides) - - firstElem = this%decomp%offsetElem(this%decomp%rankId + 1) + 1 - nLocalElems = this%decomp%offsetElem(this%decomp%rankId + 2) - & - this%decomp%offsetElem(this%decomp%rankId + 1) - - ! Allocate Space for hopr_elemInfo! - allocate (hopr_elemInfo(1:6, 1:nLocalElems)) - if (this%decomp%mpiEnabled) then - offset = (/0, firstElem - 1/) - call ReadArray_HDF5(fileId, 'ElemInfo', hopr_elemInfo, offset) - else - call ReadArray_HDF5(fileId, 'ElemInfo', hopr_elemInfo) - end if - - ! Read local subarray of NodeCoords and GlobalNodeIDs - firstNode = hopr_elemInfo(5, 1) + 1 - nLocalNodes = hopr_elemInfo(6, nLocalElems) - hopr_elemInfo(5, 1) - - ! Allocate Space for hopr_nodeCoords and hopr_globalNodeIDs ! - allocate (hopr_nodeCoords(1:3, 1:nLocalNodes), hopr_globalNodeIDs(1:nLocalNodes)) - - if (this%decomp%mpiEnabled) then - offset = (/0, firstNode - 1/) - call ReadArray_HDF5(fileId, 'NodeCoords', hopr_nodeCoords, offset) - gOffset = (/firstNode - 1/) - call ReadArray_HDF5(fileId, 'GlobalNodeIDs', hopr_globalNodeIDs, gOffset) - else - call ReadArray_HDF5(fileId, 'NodeCoords', hopr_nodeCoords) - call ReadArray_HDF5(fileId, 'GlobalNodeIDs', hopr_globalNodeIDs) - end if - - ! Read local subarray of SideInfo - firstSide = hopr_elemInfo(3, 1) + 1 - nLocalSides = hopr_elemInfo(4, nLocalElems) - hopr_elemInfo(3, 1) - - ! Allocate space for hopr_sideInfo - allocate (hopr_sideInfo(1:5, 1:nLocalSides)) - - if (this%decomp%mpiEnabled) then - offset = (/0, firstSide - 1/) - call ReadArray_HDF5(fileId, 'SideInfo', hopr_sideInfo, offset) - else - call ReadArray_HDF5(fileId, 'SideInfo', hopr_sideInfo) - end if - - call Close_HDF5(fileID) - ! ---- Done reading 3-D Mesh information ---- ! - ! Load hopr data into mesh data structure - - call this%Init(nGeo, nLocalElems, nLocalSides, nLocalNodes, nBCs) - - ! Copy data from local arrays into this - this%elemInfo = hopr_elemInfo - this%nUniqueSides = nUniqueSides - this%quadrature = UNIFORM - - ! Grab the node coordinates - do eid = 1, this%nElem - do k = 1, nGeo + 1 - do j = 1, nGeo + 1 - do i = 1, nGeo + 1 - nid = i + (nGeo + 1)*(j - 1 + (nGeo + 1)*(k - 1 + (nGeo + 1)*(eid - 1))) - this%nodeCoords(1:3, i, j, k, eid) = hopr_nodeCoords(1:3, nid) - this%globalNodeIDs(i, j, k, eid) = hopr_globalNodeIDs(nid) - end do - end do - end do - end do - - iSide = 0 - do eid = 1, this%nElem - do lsid = 1, 6 - iSide = iSide + 1 - this%sideInfo(1:5, lsid, eid) = hopr_sideInfo(1:5, iSide) - end do - end do - - call this%RecalculateFlip() - - deallocate (hopr_elemInfo, hopr_nodeCoords, hopr_globalNodeIDs, hopr_sideInfo) - - call this%UpdateDevice() - - end subroutine Read_HOPr_Mesh3D_t - - subroutine Write_Mesh3D_t(this, meshFile) - ! Writes mesh output in HOPR format (serial only) - implicit none - class(Mesh3D_t), intent(inout) :: this - character(*), intent(in) :: meshFile - ! Local - integer(HID_T) :: fileId - - call Open_HDF5(meshFile, H5F_ACC_RDWR_F, fileId) - - call WriteAttribute_HDF5(fileId, 'nElems', this%nElem) - call WriteAttribute_HDF5(fileId, 'Ngeo', this%nGeo) - call WriteAttribute_HDF5(fileId, 'nBCs', this%nBCs) - - call WriteArray_HDF5(fileId, 'BCType', this%bcType) - call WriteArray_HDF5(fileId, 'ElemInfo', this%elemInfo) - - ! Read local subarray of NodeCoords and GlobalNodeIDs - call WriteArray_HDF5(fileId, 'NodeCoords', this%nodeCoords) - call WriteArray_HDF5(fileId, 'GlobalNodeIDs', this%globalNodeIDs) - - ! Read local subarray of SideInfo - call WriteArray_HDF5(fileId, 'SideInfo', this%sideInfo) - - call Close_HDF5(fileID) - - end subroutine Write_Mesh3D_t - -end module SELF_Mesh_3D_t + implicit none + class(Mesh3D_t),intent(out) :: this + integer,intent(in) :: nxPerTile + integer,intent(in) :: nyPerTile + integer,intent(in) :: nzPerTile + integer,intent(in) :: nTileX + integer,intent(in) :: nTileY + integer,intent(in) :: nTileZ + real(prec),intent(in) :: dx + real(prec),intent(in) :: dy + real(prec),intent(in) :: dz + integer,intent(in) :: bcids(1:6) + ! Local + integer :: nX,nY,nZ,nGeo,nBCs + integer :: nGlobalElem + integer :: nUniqueSides + integer :: nUniqueNodes + integer :: nLocalElems + integer :: nLocalSides + integer :: nLocalNodes + real(prec),allocatable :: nodeCoords(:,:,:,:,:) + integer,allocatable :: globalNodeIDs(:,:,:,:) + integer,allocatable :: sideInfo(:,:,:) + integer :: i,j,k,ti,tj,tk + integer :: ix,iy,iz,iel + integer :: ni,nj,nk + integer :: e1,e2,s1,s2 + integer :: nfaces + + call this%decomp%init() + + nX = nTileX*nxPerTile + nY = nTileY*nyPerTile + nZ = nTileZ*nzPerTile + nGeo = 1 ! Force the geometry to be linear + nBCs = 6 ! Force the number of boundary conditions to 4 + + nGlobalElem = nX*nY*nZ + nUniqueSides = (nX+1)*nY*nZ+(nY+1)*nX*nZ+(nZ+1)*nX*nY + nUniqueNodes = (nX+1)*(nY+1)*(nZ+1) + + allocate(nodeCoords(1:3,1:nGeo+1,1:nGeo+1,1:nGeo+1,1:nGlobalElem)) + allocate(globalNodeIDs(1:nGeo+1,1:nGeo+1,1:nGeo+1,1:nGlobalElem)) + allocate(sideInfo(1:5,1:6,1:nGlobalElem)) + + do tk = 1,nTileZ + do tj = 1,nTileY + do ti = 1,nTileX + do k = 1,nzPerTile + iz = k+nzPerTile*(tk-1) + do j = 1,nyPerTile + iy = j+nyPerTile*(tj-1) + do i = 1,nxPerTile + + iel = elementid(i,j,k,ti,tj,tk, & + nxpertile,nypertile,nzpertile, & + ntilex,ntiley,ntilez) + ix = i+nxPerTile*(ti-1) + + do nk = 1,nGeo+1 + do nj = 1,nGeo+1 + do ni = 1,nGeo+1 + nodeCoords(1,ni,nj,nk,iel) = real(ni-1+ix-1,prec)*dx + nodeCoords(2,ni,nj,nk,iel) = real(nj-1+iy-1,prec)*dy + nodeCoords(3,ni,nj,nk,iel) = real(nk-1+iz-1,prec)*dz + globalNodeIDs(ni,nj,nk,iel) = ni-1+i+(nxPerTile+1)*( & + nj-1+j-1+(nyPerTile+1)*( & + nk-1+k-1+(nzPerTile+1)*( & + (ti-1+nTileX*( & + tj-1+nTileY*(tk-1)))))) + enddo + enddo + enddo + + enddo + enddo + enddo + enddo + enddo + enddo + + ! Fill in face information + ! sideInfo(1:5,iSide,iEl) + ! 1 - Side Type (currently unused in SELF) + ! 2 - Global Side ID (Used for message passing) + ! 3 - Neighbor Element ID + ! 4 - 10*( neighbor local side ) + flip + ! 5 - Boundary Condition ID + nfaces = 0 + do tk = 1,nTileZ + do tj = 1,nTileY + do ti = 1,nTileX + do k = 1,nzPerTile + do j = 1,nyPerTile + do i = 1,nxPerTile + + iel = elementid(i,j,k,ti,tj,tk, & + nxpertile,nypertile,nzpertile, & + ntilex,ntiley,ntilez) + ! bottom, iside=1 + s1 = 1 + s2 = 6 + if(k == 1) then ! bottom most part of the tile + if(tk == 1) then ! bottom most tile + nfaces = nfaces+1 + sideinfo(2,s1,iel) = nfaces + sideinfo(3,s1,iel) = 0 ! Neigbor element (null, boundary condition) + sideinfo(4,s1,iel) = 0 ! Neighbor side id (null, boundary condition) + sideinfo(5,s1,iel) = bcids(s1) ! Boundary condition id; set from the user input + else ! interior tile + !neighbor element is the top most element in the tile beneath + e2 = elementid(i,j,nzpertile,ti,tj,tk-1, & + nxpertile,nypertile,nzpertile, & + ntilex,ntiley,ntilez) + + sideinfo(2,s1,iel) = sideInfo(2,s2,e2) ! Copy the face id from neighbor + sideinfo(3,s1,iel) = e2 + sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id + sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) + endif + else ! interior to the tile + !neighbor element is in the same tile, but beneath + e2 = elementid(i,j,k-1,ti,tj,tk, & + nxpertile,nypertile,nzpertile, & + ntilex,ntiley,ntilez) + + sideinfo(2,s1,iel) = sideInfo(2,s2,e2) ! Copy the face id from neighbor + sideinfo(3,s1,iel) = e2 + sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id + sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) + endif + + ! south, iside=2 + s1 = 2 + s2 = 4 ! Neighbor side is north (4) + if(j == 1) then ! southern most part of the tile + if(tj == 1) then ! southern most tile + nfaces = nfaces+1 + sideinfo(2,s1,iel) = nfaces + sideinfo(3,s1,iel) = 0 ! Neigbor element (null, boundary condition) + sideinfo(4,s1,iel) = 0 ! Neighbor side id (null, boundary condition) + sideinfo(5,s1,iel) = bcids(s1) ! Boundary condition id; eastern boundary set from the user input + else ! interior tile + !neighbor element is northernmost element in the tile to the south + e2 = elementid(i,nypertile,k,ti,tj-1,tk, & + nxpertile,nypertile,nzpertile, & + ntilex,ntiley,ntilez) + + sideinfo(2,s1,iel) = sideInfo(2,s2,e2) ! Copy the face id from neighbor + sideinfo(3,s1,iel) = e2 ! Neigbor element + sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id + sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) + endif + else ! interior to the tile + !neighbor element is in the same tile, to the south + e2 = elementid(i,j-1,k,ti,tj,tk, & + nxpertile,nypertile,nzpertile, & + ntilex,ntiley,ntilez) + + sideinfo(2,s1,iel) = sideInfo(2,s2,e2) ! Copy the face id from neighbor + sideinfo(3,s1,iel) = e2 ! Neigbor element + sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id + sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) + endif + + ! east, iside=3 + s1 = 3 + s2 = 5 ! neighbor side id is west (5) + ! East faces are always new faces, due to the way we are traversing the grid + nfaces = nfaces+1 + sideinfo(2,s1,iel) = nfaces + if(i == nxPerTile) then ! eastern most part of the tile + if(ti == nTileX) then ! eastern most tile + sideinfo(3,s1,iel) = 0 ! Neigbor element (null, boundary condition) + sideinfo(4,s1,iel) = 0 ! Neighbor side id (null, boundary condition) + sideinfo(5,s1,iel) = bcids(s1) ! Boundary condition id; + else ! interior tile + !neighbor element is westernmost element in tile to the east + e2 = elementid(1,j,k,ti+1,tj,tk, & + nxpertile,nypertile,nzpertile, & + ntilex,ntiley,ntilez) + sideinfo(3,s1,iel) = e2 ! Neigbor element + sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id + sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) + endif + else ! interior to the tile + !neighbor element is in the same tile, to the east + e2 = elementid(i+1,j,k,ti,tj,tk, & + nxpertile,nypertile,nzpertile, & + ntilex,ntiley,ntilez) + sideinfo(3,s1,iel) = e2 ! Neigbor element + sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id + sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) + endif + + ! north, iside=4 + s1 = 4 + s2 = 2 ! neighbor side is south (2) + ! North faces are always new faces, due to the way we are traversing the grid + nfaces = nfaces+1 + sideinfo(2,s1,iel) = nfaces + if(j == nyPerTile) then ! northern most part of the tile + if(tj == nTileY) then ! northern most tile + sideinfo(3,s1,iel) = 0 ! Neigbor element (null, boundary condition) + sideinfo(4,s1,iel) = 0 ! Neighbor side id (null, boundary condition) + sideinfo(5,s1,iel) = bcids(s1) ! Boundary condition id; set from the user input + else ! interior tile, but northern most face of the tile + !neighbor element is the southernmost element in the tile to the north + e2 = elementid(i,1,k,ti,tj+1,tk, & + nxpertile,nypertile,nzpertile, & + ntilex,ntiley,ntilez) + sideinfo(3,s1,iel) = e2 ! Neigbor element + sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id + sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) + endif + else ! interior to the tile + !neighbor element is the tile to the north + e2 = elementid(i,j+1,k,ti,tj,tk, & + nxpertile,nypertile,nzpertile, & + ntilex,ntiley,ntilez) + sideinfo(3,s1,iel) = e2 ! Neigbor element + sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id + sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) + endif + + ! west, iside=5 + s1 = 5 + s2 = 3 ! neighbor side id is east (3) + if(i == 1) then ! western most part of the tile + if(ti == 1) then ! western most tile + nfaces = nfaces+1 + sideinfo(2,s1,iel) = nfaces + sideinfo(3,s1,iel) = 0 ! Neigbor element (null, boundary condition) + sideinfo(4,s1,iel) = 0 ! Neighbor side id (null, boundary condition) + sideinfo(5,s1,iel) = bcids(s1) ! Boundary condition id + else ! interior tile, but western most face of the tile + !neighbor element is the easternmost element in the tile to the west + e2 = elementid(nxperTile,j,k,ti-1,tj,tk, & + nxpertile,nypertile,nzpertile, & + ntilex,ntiley,ntilez) + + sideinfo(2,s1,iel) = sideInfo(2,s2,e2) ! Copy the face id from neighbor's east face + sideinfo(3,s1,iel) = e2 + sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id - neighbor to the west, east side (2) + sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) + endif + else ! interior to the tile + !neighbor element is the element to the west in the same tile + e2 = elementid(i-1,j,k,ti,tj,tk, & + nxpertile,nypertile,nzpertile, & + ntilex,ntiley,ntilez) + + sideinfo(2,s1,iel) = sideInfo(2,s2,e2) ! Copy the face id from neighbor's east face + sideinfo(3,s1,iel) = e2 + sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id - neighbor to the west, east side (2) + sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) + endif + + ! top, iside=6 + s1 = 6 + s2 = 1 ! neighbor side is bottom (1) + ! Top faces are always new faces, due to the way we are traversing the grid + nfaces = nfaces+1 + sideinfo(2,s1,iel) = nfaces + if(k == nzPerTile) then ! top most part of the tile + if(tk == nTileZ) then ! top most tile + sideinfo(3,s1,iel) = 0 ! Neigbor element (null, boundary condition) + sideinfo(4,s1,iel) = 0 ! Neighbor side id (null, boundary condition) + sideinfo(5,s1,iel) = bcids(s1) ! Boundary condition id; set from the user input + else ! interior tile, but top most face of the tile + !neighbor element is the bottom-most element in the tile above + e2 = elementid(i,j,1,ti,tj,tk+1, & + nxpertile,nypertile,nzpertile, & + ntilex,ntiley,ntilez) + sideinfo(3,s1,iel) = e2 ! Neigbor element + sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id + sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) + endif + else ! interior to the tile + !neighbor element is the tile above + e2 = elementid(i,j,k+1,ti,tj,tk, & + nxpertile,nypertile,nzpertile, & + ntilex,ntiley,ntilez) + sideinfo(3,s1,iel) = e2 ! Neigbor element, inside same tile, to the north + sideinfo(4,s1,iel) = 10*s2 ! Neighbor side id - neighbor to the north, south side (1) + sideinfo(5,s1,iel) = 0 ! Boundary condition id; (null, interior face) + endif + + enddo + enddo + enddo + enddo + enddo + enddo + + call this%decomp%GenerateDecomposition(nGlobalElem,nUniqueSides) + + e1 = this%decomp%offsetElem(this%decomp%rankId+1)+1 + e2 = this%decomp%offsetElem(this%decomp%rankId+2) + nLocalElems = e2-e1+1 + + nLocalSides = nLocalElems*6 + nLocalNodes = nLocalElems*8 + call this%Init(nGeo,nLocalElems,nLocalSides,nLocalNodes,nBCs) + this%nUniqueSides = nUniqueSides + this%quadrature = UNIFORM + + this%nodeCoords(1:3,1:nGeo+1,1:nGeo+1,1:nGeo+1,1:nLocalElems) = nodeCoords(1:3,1:nGeo+1,1:nGeo+1,1:nGeo+1,e1:e2) + this%globalNodeIDs(1:nGeo+1,1:nGeo+1,1:nGeo+1,1:nLocalElems) = globalNodeIDs(1:nGeo+1,1:nGeo+1,1:nGeo+1,e1:e2) + this%sideInfo(1:5,1:6,1:nLocalElems) = sideInfo(1:5,1:6,e1:e2) + + deallocate(nodeCoords) + deallocate(globalNodeIDs) + deallocate(sideInfo) + + call this%UpdateDevice() + + endsubroutine UniformStructuredMesh_Mesh3D_t + + subroutine Read_HOPr_Mesh3D_t(this,meshFile) + ! From https://www.hopr-project.org/externals/Meshformat.pdf, Algorithm 6 + implicit none + class(Mesh3D_t),intent(out) :: this + character(*),intent(in) :: meshFile + ! Local + integer(HID_T) :: fileId + integer(HID_T) :: offset(1:2),gOffset(1) + integer :: nGlobalElem + integer :: firstElem + integer :: firstNode + integer :: firstSide + integer :: nLocalElems + integer :: nLocalNodes + integer :: nLocalSides + integer :: nUniqueSides + integer :: nGeo,nBCs + integer :: eid,lsid,iSide + integer :: i,j,k,nid + integer,dimension(:,:),allocatable :: hopr_elemInfo + integer,dimension(:,:),allocatable :: hopr_sideInfo + real(prec),dimension(:,:),allocatable :: hopr_nodeCoords + integer,dimension(:),allocatable :: hopr_globalNodeIDs + integer,dimension(:,:),allocatable :: bcType + + call this%decomp%init() + + if(this%decomp%mpiEnabled) then + call Open_HDF5(meshFile,H5F_ACC_RDONLY_F,fileId,this%decomp%mpiComm) + else + call Open_HDF5(meshFile,H5F_ACC_RDONLY_F,fileId) + endif + + call ReadAttribute_HDF5(fileId,'nElems',nGlobalElem) + call ReadAttribute_HDF5(fileId,'Ngeo',nGeo) + call ReadAttribute_HDF5(fileId,'nBCs',nBCs) + call ReadAttribute_HDF5(fileId,'nUniqueSides',nUniqueSides) + + ! Read BCType + allocate(bcType(1:4,1:nBCs)) + if(this%decomp%mpiEnabled) then + offset(:) = 0 + call ReadArray_HDF5(fileId,'BCType',bcType,offset) + else + call ReadArray_HDF5(fileId,'BCType',bcType) + endif + + ! Read local subarray of ElemInfo + call this%decomp%GenerateDecomposition(nGlobalElem,nUniqueSides) + + firstElem = this%decomp%offsetElem(this%decomp%rankId+1)+1 + nLocalElems = this%decomp%offsetElem(this%decomp%rankId+2)- & + this%decomp%offsetElem(this%decomp%rankId+1) + + ! Allocate Space for hopr_elemInfo! + allocate(hopr_elemInfo(1:6,1:nLocalElems)) + if(this%decomp%mpiEnabled) then + offset = (/0,firstElem-1/) + call ReadArray_HDF5(fileId,'ElemInfo',hopr_elemInfo,offset) + else + call ReadArray_HDF5(fileId,'ElemInfo',hopr_elemInfo) + endif + + ! Read local subarray of NodeCoords and GlobalNodeIDs + firstNode = hopr_elemInfo(5,1)+1 + nLocalNodes = hopr_elemInfo(6,nLocalElems)-hopr_elemInfo(5,1) + + ! Allocate Space for hopr_nodeCoords and hopr_globalNodeIDs ! + allocate(hopr_nodeCoords(1:3,1:nLocalNodes),hopr_globalNodeIDs(1:nLocalNodes)) + + if(this%decomp%mpiEnabled) then + offset = (/0,firstNode-1/) + call ReadArray_HDF5(fileId,'NodeCoords',hopr_nodeCoords,offset) + gOffset = (/firstNode-1/) + call ReadArray_HDF5(fileId,'GlobalNodeIDs',hopr_globalNodeIDs,gOffset) + else + call ReadArray_HDF5(fileId,'NodeCoords',hopr_nodeCoords) + call ReadArray_HDF5(fileId,'GlobalNodeIDs',hopr_globalNodeIDs) + endif + + ! Read local subarray of SideInfo + firstSide = hopr_elemInfo(3,1)+1 + nLocalSides = hopr_elemInfo(4,nLocalElems)-hopr_elemInfo(3,1) + + ! Allocate space for hopr_sideInfo + allocate(hopr_sideInfo(1:5,1:nLocalSides)) + + if(this%decomp%mpiEnabled) then + offset = (/0,firstSide-1/) + call ReadArray_HDF5(fileId,'SideInfo',hopr_sideInfo,offset) + else + call ReadArray_HDF5(fileId,'SideInfo',hopr_sideInfo) + endif + + call Close_HDF5(fileID) + ! ---- Done reading 3-D Mesh information ---- ! + ! Load hopr data into mesh data structure + + call this%Init(nGeo,nLocalElems,nLocalSides,nLocalNodes,nBCs) + + ! Copy data from local arrays into this + this%elemInfo = hopr_elemInfo + this%nUniqueSides = nUniqueSides + this%quadrature = UNIFORM + + ! Grab the node coordinates + do eid = 1,this%nElem + do k = 1,nGeo+1 + do j = 1,nGeo+1 + do i = 1,nGeo+1 + nid = i+(nGeo+1)*(j-1+(nGeo+1)*(k-1+(nGeo+1)*(eid-1))) + this%nodeCoords(1:3,i,j,k,eid) = hopr_nodeCoords(1:3,nid) + this%globalNodeIDs(i,j,k,eid) = hopr_globalNodeIDs(nid) + enddo + enddo + enddo + enddo + + iSide = 0 + do eid = 1,this%nElem + do lsid = 1,6 + iSide = iSide+1 + this%sideInfo(1:5,lsid,eid) = hopr_sideInfo(1:5,iSide) + enddo + enddo + + call this%RecalculateFlip() + + deallocate(hopr_elemInfo,hopr_nodeCoords,hopr_globalNodeIDs,hopr_sideInfo) + + call this%UpdateDevice() + + endsubroutine Read_HOPr_Mesh3D_t + + subroutine Write_Mesh3D_t(this,meshFile) + ! Writes mesh output in HOPR format (serial only) + implicit none + class(Mesh3D_t),intent(inout) :: this + character(*),intent(in) :: meshFile + ! Local + integer(HID_T) :: fileId + + call Open_HDF5(meshFile,H5F_ACC_RDWR_F,fileId) + + call WriteAttribute_HDF5(fileId,'nElems',this%nElem) + call WriteAttribute_HDF5(fileId,'Ngeo',this%nGeo) + call WriteAttribute_HDF5(fileId,'nBCs',this%nBCs) + + call WriteArray_HDF5(fileId,'BCType',this%bcType) + call WriteArray_HDF5(fileId,'ElemInfo',this%elemInfo) + + ! Read local subarray of NodeCoords and GlobalNodeIDs + call WriteArray_HDF5(fileId,'NodeCoords',this%nodeCoords) + call WriteArray_HDF5(fileId,'GlobalNodeIDs',this%globalNodeIDs) + + ! Read local subarray of SideInfo + call WriteArray_HDF5(fileId,'SideInfo',this%sideInfo) + + call Close_HDF5(fileID) + + endsubroutine Write_Mesh3D_t + +endmodule SELF_Mesh_3D_t diff --git a/src/gpu/SELF_DomainDecomposition.f90 b/src/gpu/SELF_DomainDecomposition.f90 index f52349e7f..586fd88c7 100644 --- a/src/gpu/SELF_DomainDecomposition.f90 +++ b/src/gpu/SELF_DomainDecomposition.f90 @@ -26,125 +26,125 @@ module SELF_DomainDecomposition - use SELF_DomainDecomposition_t - use mpi - use iso_c_binding + use SELF_DomainDecomposition_t + use mpi + use iso_c_binding - implicit none + implicit none - type, extends(DomainDecomposition_t) :: DomainDecomposition - type(c_ptr) :: elemToRank_gpu + type,extends(DomainDecomposition_t) :: DomainDecomposition + type(c_ptr) :: elemToRank_gpu - contains + contains - procedure :: Init => Init_DomainDecomposition - procedure :: Free => Free_DomainDecomposition + procedure :: Init => Init_DomainDecomposition + procedure :: Free => Free_DomainDecomposition - procedure :: SetElemToRank => SetElemToRank_DomainDecomposition + procedure :: SetElemToRank => SetElemToRank_DomainDecomposition - end type DomainDecomposition + endtype DomainDecomposition contains - subroutine Init_DomainDecomposition(this) - implicit none - class(DomainDecomposition), intent(inout) :: this - ! Local - integer :: ierror - integer(c_int) :: num_devices, hip_err, device_id - - this%mpiComm = 0 - this%mpiPrec = prec - this%rankId = 0 - this%nRanks = 1 - this%nElem = 0 - this%mpiEnabled = .false. - - this%mpiComm = MPI_COMM_WORLD - print *, __FILE__, " : Initializing MPI" - call mpi_init(ierror) - call mpi_comm_rank(this%mpiComm, this%rankId, ierror) - call mpi_comm_size(this%mpiComm, this%nRanks, ierror) - print *, __FILE__, " : Rank ", this%rankId + 1, "/", this%nRanks, " checking in." - - if (this%nRanks > 1) then - this%mpiEnabled = .true. - else - print *, __FILE__, " : No domain decomposition used." - end if - - if (prec == real32) then - this%mpiPrec = MPI_FLOAT - else - this%mpiPrec = MPI_DOUBLE - end if - - allocate (this%offsetElem(1:this%nRanks + 1)) - - hip_err = hipGetDeviceCount(num_devices) - if (hip_err /= 0) then - print *, 'Failed to get device count on rank', this%rankId - call MPI_Abort(MPI_COMM_WORLD, hip_err, ierror) - end if - - ! Assign GPU device ID based on MPI rank - device_id = modulo(this%rankId, num_devices) ! Assumes that mpi ranks are packed sequentially on a node until the node is filled up. - hip_err = hipSetDevice(device_id) - print *, __FILE__, " : Rank ", this%rankId + 1, " assigned to device ", device_id - if (hip_err /= 0) then - print *, 'Failed to set device for rank', this%rankId, 'to device', device_id - call MPI_Abort(MPI_COMM_WORLD, hip_err, ierror) - end if - - this%initialized = .true. - - end subroutine Init_DomainDecomposition - subroutine Free_DomainDecomposition(this) - implicit none - class(DomainDecomposition), intent(inout) :: this - ! Local - integer :: ierror - - if (associated(this%offSetElem)) then - deallocate (this%offSetElem) - end if - if (associated(this%elemToRank)) then - deallocate (this%elemToRank) - call gpuCheck(hipFree(this%elemToRank_gpu)) - end if - - if (allocated(this%requests)) deallocate (this%requests) - if (allocated(this%stats)) deallocate (this%stats) - - print *, __FILE__, " : Rank ", this%rankId + 1, "/", this%nRanks, " checking out." - call MPI_FINALIZE(ierror) - - end subroutine Free_DomainDecomposition - - subroutine SetElemToRank_DomainDecomposition(this, nElem) - implicit none - class(DomainDecomposition), intent(inout) :: this - integer, intent(in) :: nElem - ! Local - integer :: iel - - this%nElem = nElem - - allocate (this%elemToRank(1:nelem)) - call gpuCheck(hipMalloc(this%elemToRank_gpu, sizeof(this%elemToRank))) - - call DomainDecomp(nElem, & - this%nRanks, & - this%offSetElem) - - do iel = 1, nElem - call ElemToRank(this%nRanks, & - this%offSetElem, & - iel, & - this%elemToRank(iel)) - end do - call gpuCheck(hipMemcpy(this%elemToRank_gpu, c_loc(this%elemToRank), sizeof(this%elemToRank), hipMemcpyHostToDevice)) - - end subroutine SetElemToRank_DomainDecomposition - -end module SELF_DomainDecomposition + subroutine Init_DomainDecomposition(this) + implicit none + class(DomainDecomposition),intent(inout) :: this + ! Local + integer :: ierror + integer(c_int) :: num_devices,hip_err,device_id + + this%mpiComm = 0 + this%mpiPrec = prec + this%rankId = 0 + this%nRanks = 1 + this%nElem = 0 + this%mpiEnabled = .false. + + this%mpiComm = MPI_COMM_WORLD + print*,__FILE__," : Initializing MPI" + call mpi_init(ierror) + call mpi_comm_rank(this%mpiComm,this%rankId,ierror) + call mpi_comm_size(this%mpiComm,this%nRanks,ierror) + print*,__FILE__," : Rank ",this%rankId+1,"/",this%nRanks," checking in." + + if(this%nRanks > 1) then + this%mpiEnabled = .true. + else + print*,__FILE__," : No domain decomposition used." + endif + + if(prec == real32) then + this%mpiPrec = MPI_FLOAT + else + this%mpiPrec = MPI_DOUBLE + endif + + allocate(this%offsetElem(1:this%nRanks+1)) + + hip_err = hipGetDeviceCount(num_devices) + if(hip_err /= 0) then + print*,'Failed to get device count on rank',this%rankId + call MPI_Abort(MPI_COMM_WORLD,hip_err,ierror) + endif + + ! Assign GPU device ID based on MPI rank + device_id = modulo(this%rankId,num_devices) ! Assumes that mpi ranks are packed sequentially on a node until the node is filled up. + hip_err = hipSetDevice(device_id) + print*,__FILE__," : Rank ",this%rankId+1," assigned to device ",device_id + if(hip_err /= 0) then + print*,'Failed to set device for rank',this%rankId,'to device',device_id + call MPI_Abort(MPI_COMM_WORLD,hip_err,ierror) + endif + + this%initialized = .true. + + endsubroutine Init_DomainDecomposition + subroutine Free_DomainDecomposition(this) + implicit none + class(DomainDecomposition),intent(inout) :: this + ! Local + integer :: ierror + + if(associated(this%offSetElem)) then + deallocate(this%offSetElem) + endif + if(associated(this%elemToRank)) then + deallocate(this%elemToRank) + call gpuCheck(hipFree(this%elemToRank_gpu)) + endif + + if(allocated(this%requests)) deallocate(this%requests) + if(allocated(this%stats)) deallocate(this%stats) + + print*,__FILE__," : Rank ",this%rankId+1,"/",this%nRanks," checking out." + call MPI_FINALIZE(ierror) + + endsubroutine Free_DomainDecomposition + + subroutine SetElemToRank_DomainDecomposition(this,nElem) + implicit none + class(DomainDecomposition),intent(inout) :: this + integer,intent(in) :: nElem + ! Local + integer :: iel + + this%nElem = nElem + + allocate(this%elemToRank(1:nelem)) + call gpuCheck(hipMalloc(this%elemToRank_gpu,sizeof(this%elemToRank))) + + call DomainDecomp(nElem, & + this%nRanks, & + this%offSetElem) + + do iel = 1,nElem + call ElemToRank(this%nRanks, & + this%offSetElem, & + iel, & + this%elemToRank(iel)) + enddo + call gpuCheck(hipMemcpy(this%elemToRank_gpu,c_loc(this%elemToRank),sizeof(this%elemToRank),hipMemcpyHostToDevice)) + + endsubroutine SetElemToRank_DomainDecomposition + +endmodule SELF_DomainDecomposition diff --git a/test/advection_diffusion_2d_rk3_mpi.f90 b/test/advection_diffusion_2d_rk3_mpi.f90 index 7b329eacd..5fa72b177 100644 --- a/test/advection_diffusion_2d_rk3_mpi.f90 +++ b/test/advection_diffusion_2d_rk3_mpi.f90 @@ -26,82 +26,82 @@ program advection_diffusion_2d_rk3 - use self_data - use self_advection_diffusion_2d + use self_data + use self_advection_diffusion_2d - implicit none - character(SELF_INTEGRATOR_LENGTH), parameter :: integrator = 'rk3' - integer, parameter :: controlDegree = 7 - integer, parameter :: targetDegree = 16 - real(prec), parameter :: u = 0.25_prec ! velocity - real(prec), parameter :: v = 0.25_prec - real(prec), parameter :: nu = 0.005_prec ! diffusivity - real(prec), parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec), parameter :: endtime = 0.2_prec - real(prec), parameter :: iointerval = 0.1_prec - real(prec) :: e0, ef ! Initial and final entropy - type(advection_diffusion_2d) :: modelobj - type(Lagrange), target :: interp - type(Mesh2D), target :: mesh - type(SEMQuad), target :: geometry - character(LEN=255) :: WORKSPACE + implicit none + character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' + integer,parameter :: controlDegree = 7 + integer,parameter :: targetDegree = 16 + real(prec),parameter :: u = 0.25_prec ! velocity + real(prec),parameter :: v = 0.25_prec + real(prec),parameter :: nu = 0.005_prec ! diffusivity + real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size + real(prec),parameter :: endtime = 0.2_prec + real(prec),parameter :: iointerval = 0.1_prec + real(prec) :: e0,ef ! Initial and final entropy + type(advection_diffusion_2d) :: modelobj + type(Lagrange),target :: interp + type(Mesh2D),target :: mesh + type(SEMQuad),target :: geometry + character(LEN=255) :: WORKSPACE - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE", WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") + ! Create a uniform block mesh + call get_environment_variable("WORKSPACE",WORKSPACE) + call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp, mesh%nElem) - call geometry%GenerateFromMesh(mesh) + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp,mesh%nElem) + call geometry%GenerateFromMesh(mesh) - ! Initialize the model - call modelobj%Init(mesh, geometry) - modelobj%gradient_enabled = .true. + ! Initialize the model + call modelobj%Init(mesh,geometry) + modelobj%gradient_enabled = .true. - ! Set the velocity - modelobj%u = u - modelobj%v = v - !Set the diffusivity - modelobj%nu = nu + ! Set the velocity + modelobj%u = u + modelobj%v = v + !Set the diffusivity + modelobj%nu = nu - ! Set the initial condition - call modelobj%solution%SetEquation(1, 'f = exp( -( (x-0.5)^2 + (y-0.5)^2 )/0.005 )') - call modelobj%solution%SetInteriorFromEquation(geometry, 0.0_prec) + ! Set the initial condition + call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 + (y-0.5)^2 )/0.005 )') + call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) - print *, "min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) + print*,"min, max (interior)", & + minval(modelobj%solution%interior), & + maxval(modelobj%solution%interior) - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) + call modelobj%CalculateEntropy() + call modelobj%ReportEntropy() + e0 = modelobj%entropy + ! Set the model's time integration method + call modelobj%SetTimeIntegrator(integrator) - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime, dt, iointerval) - call modelobj%WriteModel("advdiff2d-rk3-mpi.pickup.h5") + ! forward step the model to `endtime` using a time step + ! of `dt` and outputing model data every `iointerval` + call modelobj%ForwardStep(endtime,dt,iointerval) + call modelobj%WriteModel("advdiff2d-rk3-mpi.pickup.h5") - print *, "min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = modelobj%entropy + print*,"min, max (interior)", & + minval(modelobj%solution%interior), & + maxval(modelobj%solution%interior) + ef = modelobj%entropy - if (ef > e0) then - print *, "Error: Final absmax greater than initial absmax! ", e0, ef - stop 1 - end if - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() + if(ef > e0) then + print*,"Error: Final absmax greater than initial absmax! ",e0,ef + stop 1 + endif + ! Clean up + call modelobj%free() + call mesh%free() + call geometry%free() + call interp%free() -end program advection_diffusion_2d_rk3 +endprogram advection_diffusion_2d_rk3 diff --git a/test/advection_diffusion_2d_rk3_pickup_mpi.f90 b/test/advection_diffusion_2d_rk3_pickup_mpi.f90 index 357e12e2d..6f830bd39 100644 --- a/test/advection_diffusion_2d_rk3_pickup_mpi.f90 +++ b/test/advection_diffusion_2d_rk3_pickup_mpi.f90 @@ -26,80 +26,80 @@ program advection_diffusion_2d_rk3 - use self_data - use self_advection_diffusion_2d + use self_data + use self_advection_diffusion_2d - implicit none - character(SELF_INTEGRATOR_LENGTH), parameter :: integrator = 'rk3' - integer, parameter :: controlDegree = 7 - integer, parameter :: targetDegree = 16 - real(prec), parameter :: u = 0.25_prec ! velocity - real(prec), parameter :: v = 0.25_prec - real(prec), parameter :: nu = 0.005_prec ! diffusivity - real(prec), parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec), parameter :: endtime = 0.2_prec - real(prec), parameter :: iointerval = 0.1_prec - real(prec) :: e0, ef ! Initial and final entropy - type(advection_diffusion_2d) :: modelobj - type(Lagrange), target :: interp - type(Mesh2D), target :: mesh - type(SEMQuad), target :: geometry - character(LEN=255) :: WORKSPACE + implicit none + character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' + integer,parameter :: controlDegree = 7 + integer,parameter :: targetDegree = 16 + real(prec),parameter :: u = 0.25_prec ! velocity + real(prec),parameter :: v = 0.25_prec + real(prec),parameter :: nu = 0.005_prec ! diffusivity + real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size + real(prec),parameter :: endtime = 0.2_prec + real(prec),parameter :: iointerval = 0.1_prec + real(prec) :: e0,ef ! Initial and final entropy + type(advection_diffusion_2d) :: modelobj + type(Lagrange),target :: interp + type(Mesh2D),target :: mesh + type(SEMQuad),target :: geometry + character(LEN=255) :: WORKSPACE - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE", WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") + ! Create a uniform block mesh + call get_environment_variable("WORKSPACE",WORKSPACE) + call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp, mesh%nElem) - call geometry%GenerateFromMesh(mesh) + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp,mesh%nElem) + call geometry%GenerateFromMesh(mesh) - ! Initialize the model - call modelobj%Init(mesh, geometry) - modelobj%gradient_enabled = .true. + ! Initialize the model + call modelobj%Init(mesh,geometry) + modelobj%gradient_enabled = .true. - ! Set the velocity - modelobj%u = u - modelobj%v = v - !Set the diffusivity - modelobj%nu = nu + ! Set the velocity + modelobj%u = u + modelobj%v = v + !Set the diffusivity + modelobj%nu = nu - ! Set the initial condition from pickup file - call modelobj%ReadModel("advdiff2d-rk3-mpi.pickup.h5") + ! Set the initial condition from pickup file + call modelobj%ReadModel("advdiff2d-rk3-mpi.pickup.h5") - print *, "min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) + print*,"min, max (interior)", & + minval(modelobj%solution%interior), & + maxval(modelobj%solution%interior) - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) + call modelobj%CalculateEntropy() + call modelobj%ReportEntropy() + e0 = modelobj%entropy + ! Set the model's time integration method + call modelobj%SetTimeIntegrator(integrator) - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime, dt, iointerval) + ! forward step the model to `endtime` using a time step + ! of `dt` and outputing model data every `iointerval` + call modelobj%ForwardStep(endtime,dt,iointerval) - print *, "min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = modelobj%entropy + print*,"min, max (interior)", & + minval(modelobj%solution%interior), & + maxval(modelobj%solution%interior) + ef = modelobj%entropy - if (ef > e0) then - print *, "Error: Final absmax greater than initial absmax! ", e0, ef - stop 1 - end if - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() + if(ef > e0) then + print*,"Error: Final absmax greater than initial absmax! ",e0,ef + stop 1 + endif + ! Clean up + call modelobj%free() + call mesh%free() + call geometry%free() + call interp%free() -end program advection_diffusion_2d_rk3 +endprogram advection_diffusion_2d_rk3 diff --git a/test/advection_diffusion_3d_rk3_mpi.f90 b/test/advection_diffusion_3d_rk3_mpi.f90 index 165b912a7..22479518b 100644 --- a/test/advection_diffusion_3d_rk3_mpi.f90 +++ b/test/advection_diffusion_3d_rk3_mpi.f90 @@ -26,86 +26,86 @@ program advection_diffusion_3d_rk3 - use self_data - use self_advection_diffusion_3d - - implicit none - character(SELF_INTEGRATOR_LENGTH), parameter :: integrator = 'rk3' - integer, parameter :: controlDegree = 7 - integer, parameter :: targetDegree = 16 - real(prec), parameter :: u = 0.25_prec ! velocity - real(prec), parameter :: v = 0.25_prec - real(prec), parameter :: w = 0.25_prec - real(prec), parameter :: nu = 0.001_prec ! diffusivity - real(prec), parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec), parameter :: endtime = 0.01_prec - real(prec), parameter :: iointerval = 0.01_prec - type(advection_diffusion_3d) :: modelobj - type(Lagrange), target :: interp - type(Mesh3D), target :: mesh - type(SEMHex), target :: geometry - character(LEN=255) :: WORKSPACE - real(prec) :: e0, ef - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE", WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp, mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh, geometry) - modelobj%gradient_enabled = .true. - - ! Set the velocity - modelobj%u = u - modelobj%v = v - modelobj%w = w - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1, 'f = exp( -( (x-0.5)^2 + (y-0.5)^2 + (z-0.5)^2 )/0.005 )') - call modelobj%solution%SetInteriorFromEquation(geometry, 0.0_prec) - - print *, "min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy - - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime, dt, iointerval) - call modelobj%WriteModel("advdiff3d-rk3-mpi.pickup.h5") - - print *, "min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = modelobj%entropy - - if (ef > e0) then - print *, "Error: Final entropy greater than initial entropy! ", e0, ef - stop 1 - end if - - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -end program advection_diffusion_3d_rk3 + use self_data + use self_advection_diffusion_3d + + implicit none + character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' + integer,parameter :: controlDegree = 7 + integer,parameter :: targetDegree = 16 + real(prec),parameter :: u = 0.25_prec ! velocity + real(prec),parameter :: v = 0.25_prec + real(prec),parameter :: w = 0.25_prec + real(prec),parameter :: nu = 0.001_prec ! diffusivity + real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size + real(prec),parameter :: endtime = 0.01_prec + real(prec),parameter :: iointerval = 0.01_prec + type(advection_diffusion_3d) :: modelobj + type(Lagrange),target :: interp + type(Mesh3D),target :: mesh + type(SEMHex),target :: geometry + character(LEN=255) :: WORKSPACE + real(prec) :: e0,ef + + ! Create a uniform block mesh + call get_environment_variable("WORKSPACE",WORKSPACE) + call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") + + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) + + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp,mesh%nElem) + call geometry%GenerateFromMesh(mesh) + + ! Initialize the model + call modelobj%Init(mesh,geometry) + modelobj%gradient_enabled = .true. + + ! Set the velocity + modelobj%u = u + modelobj%v = v + modelobj%w = w + !Set the diffusivity + modelobj%nu = nu + + ! Set the initial condition + call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 + (y-0.5)^2 + (z-0.5)^2 )/0.005 )') + call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) + + print*,"min, max (interior)", & + minval(modelobj%solution%interior), & + maxval(modelobj%solution%interior) + + call modelobj%CalculateEntropy() + call modelobj%ReportEntropy() + e0 = modelobj%entropy + + ! Set the model's time integration method + call modelobj%SetTimeIntegrator(integrator) + + ! forward step the model to `endtime` using a time step + ! of `dt` and outputing model data every `iointerval` + call modelobj%ForwardStep(endtime,dt,iointerval) + call modelobj%WriteModel("advdiff3d-rk3-mpi.pickup.h5") + + print*,"min, max (interior)", & + minval(modelobj%solution%interior), & + maxval(modelobj%solution%interior) + ef = modelobj%entropy + + if(ef > e0) then + print*,"Error: Final entropy greater than initial entropy! ",e0,ef + stop 1 + endif + + ! Clean up + call modelobj%free() + call mesh%free() + call geometry%free() + call interp%free() + +endprogram advection_diffusion_3d_rk3 diff --git a/test/advection_diffusion_3d_rk3_pickup_mpi.f90 b/test/advection_diffusion_3d_rk3_pickup_mpi.f90 index 6ab14c9c6..479a070a8 100644 --- a/test/advection_diffusion_3d_rk3_pickup_mpi.f90 +++ b/test/advection_diffusion_3d_rk3_pickup_mpi.f90 @@ -26,84 +26,84 @@ program advection_diffusion_3d_rk3 - use self_data - use self_advection_diffusion_3d - - implicit none - character(SELF_INTEGRATOR_LENGTH), parameter :: integrator = 'rk3' - integer, parameter :: controlDegree = 7 - integer, parameter :: targetDegree = 16 - real(prec), parameter :: u = 0.25_prec ! velocity - real(prec), parameter :: v = 0.25_prec - real(prec), parameter :: w = 0.25_prec - real(prec), parameter :: nu = 0.001_prec ! diffusivity - real(prec), parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec), parameter :: endtime = 0.01_prec - real(prec), parameter :: iointerval = 0.01_prec - type(advection_diffusion_3d) :: modelobj - type(Lagrange), target :: interp - type(Mesh3D), target :: mesh - type(SEMHex), target :: geometry - character(LEN=255) :: WORKSPACE - real(prec) :: e0, ef - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE", WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp, mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh, geometry) - modelobj%gradient_enabled = .true. - - ! Set the velocity - modelobj%u = u - modelobj%v = v - modelobj%w = w - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition from pickup file - call modelobj%ReadModel("advdiff3d-rk3-mpi.pickup.h5") - - print *, "min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy - - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime, dt, iointerval) - - print *, "min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = modelobj%entropy - - if (ef > e0) then - print *, "Error: Final entropy greater than initial entropy! ", e0, ef - stop 1 - end if - - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -end program advection_diffusion_3d_rk3 + use self_data + use self_advection_diffusion_3d + + implicit none + character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' + integer,parameter :: controlDegree = 7 + integer,parameter :: targetDegree = 16 + real(prec),parameter :: u = 0.25_prec ! velocity + real(prec),parameter :: v = 0.25_prec + real(prec),parameter :: w = 0.25_prec + real(prec),parameter :: nu = 0.001_prec ! diffusivity + real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size + real(prec),parameter :: endtime = 0.01_prec + real(prec),parameter :: iointerval = 0.01_prec + type(advection_diffusion_3d) :: modelobj + type(Lagrange),target :: interp + type(Mesh3D),target :: mesh + type(SEMHex),target :: geometry + character(LEN=255) :: WORKSPACE + real(prec) :: e0,ef + + ! Create a uniform block mesh + call get_environment_variable("WORKSPACE",WORKSPACE) + call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") + + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) + + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp,mesh%nElem) + call geometry%GenerateFromMesh(mesh) + + ! Initialize the model + call modelobj%Init(mesh,geometry) + modelobj%gradient_enabled = .true. + + ! Set the velocity + modelobj%u = u + modelobj%v = v + modelobj%w = w + !Set the diffusivity + modelobj%nu = nu + + ! Set the initial condition from pickup file + call modelobj%ReadModel("advdiff3d-rk3-mpi.pickup.h5") + + print*,"min, max (interior)", & + minval(modelobj%solution%interior), & + maxval(modelobj%solution%interior) + + call modelobj%CalculateEntropy() + call modelobj%ReportEntropy() + e0 = modelobj%entropy + + ! Set the model's time integration method + call modelobj%SetTimeIntegrator(integrator) + + ! forward step the model to `endtime` using a time step + ! of `dt` and outputing model data every `iointerval` + call modelobj%ForwardStep(endtime,dt,iointerval) + + print*,"min, max (interior)", & + minval(modelobj%solution%interior), & + maxval(modelobj%solution%interior) + ef = modelobj%entropy + + if(ef > e0) then + print*,"Error: Final entropy greater than initial entropy! ",e0,ef + stop 1 + endif + + ! Clean up + call modelobj%free() + call mesh%free() + call geometry%free() + call interp%free() + +endprogram advection_diffusion_3d_rk3 diff --git a/test/mappedscalarbrgradient_2d_linear_mpi.f90 b/test/mappedscalarbrgradient_2d_linear_mpi.f90 index f373d8876..5d42c6541 100644 --- a/test/mappedscalarbrgradient_2d_linear_mpi.f90 +++ b/test/mappedscalarbrgradient_2d_linear_mpi.f90 @@ -26,130 +26,130 @@ program test - implicit none - integer :: exit_code + implicit none + integer :: exit_code - exit_code = mappedscalarbrgradient_2d_linear() - if (exit_code /= 0) then - stop exit_code - end if + exit_code = mappedscalarbrgradient_2d_linear() + if(exit_code /= 0) then + stop exit_code + endif contains - integer function mappedscalarbrgradient_2d_linear() result(r) + integer function mappedscalarbrgradient_2d_linear() result(r) - use SELF_Constants - use SELF_Lagrange - use SELF_Mesh_2D - use SELF_Geometry_2D - use SELF_MappedScalar_2D - use SELF_MappedVector_2D + use SELF_Constants + use SELF_Lagrange + use SELF_Mesh_2D + use SELF_Geometry_2D + use SELF_MappedScalar_2D + use SELF_MappedVector_2D - implicit none + implicit none - integer, parameter :: controlDegree = 7 - integer, parameter :: targetDegree = 16 - integer, parameter :: nvar = 1 + integer,parameter :: controlDegree = 7 + integer,parameter :: targetDegree = 16 + integer,parameter :: nvar = 1 #ifdef DOUBLE_PRECISION - real(prec), parameter :: tolerance = 10.0_prec**(-7) + real(prec),parameter :: tolerance = 10.0_prec**(-7) #else - real(prec), parameter :: tolerance = 5.0_prec*10.0_prec**(-3) + real(prec),parameter :: tolerance = 5.0_prec*10.0_prec**(-3) #endif - type(Lagrange), target :: interp - type(Mesh2D), target :: mesh - type(SEMQuad), target :: geometry - type(MappedScalar2D) :: f - type(MappedVector2D) :: df - integer :: iside - integer :: e2 - character(LEN=255) :: WORKSPACE - integer :: iel, j, i - integer(HID_T) :: fileId - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE", WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp, mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - call f%Init(interp, nvar, mesh%nelem) - call df%Init(interp, nvar, mesh%nelem) - call f%AssociateGeometry(geometry) - - call f%SetEquation(1, 'f = x*y') - - call f%SetInteriorFromEquation(geometry, 0.0_prec) - print *, "min, max (interior)", minval(f%interior), maxval(f%interior) - - call f%BoundaryInterp() - call f%UpdateHost() - print *, "min, max (boundary)", minval(f%boundary), maxval(f%boundary) - - call f%SideExchange(mesh) - call f%UpdateHost() - ! Set boundary conditions by prolonging the "boundary" attribute to the domain boundaries - do iel = 1, f%nElem - do iside = 1, 4 - e2 = mesh%sideInfo(3, iside, iel) ! Neighboring Element ID - if (e2 == 0) then - do i = 1, f%interp%N + 1 - f%extBoundary(i, iside, iel, 1) = f%boundary(i, iside, iel, 1) - end do - end if - end do - end do - - print *, "min, max (extboundary)", minval(f%extBoundary), maxval(f%extBoundary) - call f%UpdateDevice() - - call f%AverageSides() - - call f%UpdateHost() - print *, "min, max (avgboundary)", minval(f%avgboundary), maxval(f%avgboundary) + type(Lagrange),target :: interp + type(Mesh2D),target :: mesh + type(SEMQuad),target :: geometry + type(MappedScalar2D) :: f + type(MappedVector2D) :: df + integer :: iside + integer :: e2 + character(LEN=255) :: WORKSPACE + integer :: iel,j,i + integer(HID_T) :: fileId + + ! Create a uniform block mesh + call get_environment_variable("WORKSPACE",WORKSPACE) + call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") + + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) + + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp,mesh%nElem) + call geometry%GenerateFromMesh(mesh) + + call f%Init(interp,nvar,mesh%nelem) + call df%Init(interp,nvar,mesh%nelem) + call f%AssociateGeometry(geometry) + + call f%SetEquation(1,'f = x*y') + + call f%SetInteriorFromEquation(geometry,0.0_prec) + print*,"min, max (interior)",minval(f%interior),maxval(f%interior) + + call f%BoundaryInterp() + call f%UpdateHost() + print*,"min, max (boundary)",minval(f%boundary),maxval(f%boundary) + + call f%SideExchange(mesh) + call f%UpdateHost() + ! Set boundary conditions by prolonging the "boundary" attribute to the domain boundaries + do iel = 1,f%nElem + do iside = 1,4 + e2 = mesh%sideInfo(3,iside,iel) ! Neighboring Element ID + if(e2 == 0) then + do i = 1,f%interp%N+1 + f%extBoundary(i,iside,iel,1) = f%boundary(i,iside,iel,1) + enddo + endif + enddo + enddo + + print*,"min, max (extboundary)",minval(f%extBoundary),maxval(f%extBoundary) + call f%UpdateDevice() + + call f%AverageSides() + + call f%UpdateHost() + print*,"min, max (avgboundary)",minval(f%avgboundary),maxval(f%avgboundary) #ifdef ENABLE_GPU - call f%MappedDGGradient(df%interior_gpu) + call f%MappedDGGradient(df%interior_gpu) #else - call f%MappedDGGradient(df%interior) + call f%MappedDGGradient(df%interior) #endif - call df%UpdateHost() - - print *, "min, max (df/dx)", minval(df%interior(:, :, :, 1, 1)), maxval(df%interior(:, :, :, 1, 1)) - print *, "min, max (df/dy)", minval(df%interior(:, :, :, 1, 2)), maxval(df%interior(:, :, :, 1, 2)) - - ! Calculate diff from exact - do iel = 1, mesh%nelem - do j = 1, controlDegree + 1 - do i = 1, controlDegree + 1 - df%interior(i, j, iel, 1, 1) = abs(df%interior(i, j, iel, 1, 1) - geometry%x%interior(i, j, iel, 1, 2)) ! df/dx = y - df%interior(i, j, iel, 1, 2) = abs(df%interior(i, j, iel, 1, 2) - geometry%x%interior(i, j, iel, 1, 1)) ! df/dy = x - - end do - end do - end do - - print *, "maxval(df_error)", maxval(df%interior), tolerance - - if (maxval(df%interior) <= tolerance) then - r = 0 - else - r = 1 - end if - - ! Clean up - call f%DissociateGeometry() - call geometry%Free() - call mesh%Free() - call interp%Free() - call f%free() - call df%free() - - end function mappedscalarbrgradient_2d_linear -end program test + call df%UpdateHost() + + print*,"min, max (df/dx)",minval(df%interior(:,:,:,1,1)),maxval(df%interior(:,:,:,1,1)) + print*,"min, max (df/dy)",minval(df%interior(:,:,:,1,2)),maxval(df%interior(:,:,:,1,2)) + + ! Calculate diff from exact + do iel = 1,mesh%nelem + do j = 1,controlDegree+1 + do i = 1,controlDegree+1 + df%interior(i,j,iel,1,1) = abs(df%interior(i,j,iel,1,1)-geometry%x%interior(i,j,iel,1,2)) ! df/dx = y + df%interior(i,j,iel,1,2) = abs(df%interior(i,j,iel,1,2)-geometry%x%interior(i,j,iel,1,1)) ! df/dy = x + + enddo + enddo + enddo + + print*,"maxval(df_error)",maxval(df%interior),tolerance + + if(maxval(df%interior) <= tolerance) then + r = 0 + else + r = 1 + endif + + ! Clean up + call f%DissociateGeometry() + call geometry%Free() + call mesh%Free() + call interp%Free() + call f%free() + call df%free() + + endfunction mappedscalarbrgradient_2d_linear +endprogram test diff --git a/test/mappedscalarbrgradient_3d_linear_mpi.f90 b/test/mappedscalarbrgradient_3d_linear_mpi.f90 index b9281b257..d11b7f0bf 100644 --- a/test/mappedscalarbrgradient_3d_linear_mpi.f90 +++ b/test/mappedscalarbrgradient_3d_linear_mpi.f90 @@ -26,139 +26,139 @@ program test - implicit none - integer :: exit_code + implicit none + integer :: exit_code - exit_code = mappedscalarbrgradient_3d_linear() - if (exit_code /= 0) then - stop exit_code - end if + exit_code = mappedscalarbrgradient_3d_linear() + if(exit_code /= 0) then + stop exit_code + endif contains - integer function mappedscalarbrgradient_3d_linear() result(r) + integer function mappedscalarbrgradient_3d_linear() result(r) - use SELF_Constants - use SELF_Lagrange - use SELF_Mesh_3D - use SELF_Geometry_3D - use SELF_MappedScalar_3D - use SELF_MappedVector_3D + use SELF_Constants + use SELF_Lagrange + use SELF_Mesh_3D + use SELF_Geometry_3D + use SELF_MappedScalar_3D + use SELF_MappedVector_3D - implicit none + implicit none - integer, parameter :: controlDegree = 7 - integer, parameter :: targetDegree = 16 - integer, parameter :: nvar = 1 + integer,parameter :: controlDegree = 7 + integer,parameter :: targetDegree = 16 + integer,parameter :: nvar = 1 #ifdef DOUBLE_PRECISION - real(prec), parameter :: tolerance = 10.0_prec**(-7) + real(prec),parameter :: tolerance = 10.0_prec**(-7) #else - real(prec), parameter :: tolerance = 10.0_prec**(-2) + real(prec),parameter :: tolerance = 10.0_prec**(-2) #endif - type(Lagrange), target :: interp - type(Mesh3D), target :: mesh - type(SEMHex), target :: geometry - type(MappedScalar3D) :: f - type(MappedVector3D) :: df - integer :: iel - integer :: iside - integer :: i - integer :: j - integer :: k - integer :: e2, s2, bcid - character(LEN=255) :: WORKSPACE - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE", WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp, mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - call f%Init(interp, nvar, mesh%nelem) - call df%Init(interp, nvar, mesh%nelem) - call f%AssociateGeometry(geometry) - - call f%SetName(1, "f") - call df%SetName(1, "df") - - call f%SetEquation(1, 'f = x*y') - - call f%SetInteriorFromEquation(geometry, 0.0_prec) - print *, "min, max (interior)", minval(f%interior), maxval(f%interior) - - call f%BoundaryInterp() - call f%UpdateHost() - print *, "min, max (boundary)", minval(f%boundary), maxval(f%boundary) - - call f%SideExchange(mesh) - call f%UpdateHost() - - ! Set boundary conditions by prolonging the "boundary" attribute to the domain boundaries - do iel = 1, f%nElem - do iside = 1, 6 - e2 = mesh%sideInfo(3, iside, iel) ! Neighboring Element ID - s2 = mesh%sideInfo(4, iside, iel)/10 - bcid = mesh%sideInfo(5, iside, iel) - if (e2 == 0) then - do j = 1, f%interp%N + 1 - do i = 1, f%interp%N + 1 - f%extBoundary(i, j, iside, iel, 1) = f%boundary(i, j, iside, iel, 1) - end do - end do - end if - end do - end do - - print *, "min, max (extboundary)", minval(f%extBoundary), maxval(f%extBoundary) - - call f%UpdateDevice() - call f%AverageSides() - call f%UpdateHost() - print *, "min, max (avgboundary)", minval(f%avgBoundary), maxval(f%avgBoundary) + type(Lagrange),target :: interp + type(Mesh3D),target :: mesh + type(SEMHex),target :: geometry + type(MappedScalar3D) :: f + type(MappedVector3D) :: df + integer :: iel + integer :: iside + integer :: i + integer :: j + integer :: k + integer :: e2,s2,bcid + character(LEN=255) :: WORKSPACE + + ! Create a uniform block mesh + call get_environment_variable("WORKSPACE",WORKSPACE) + call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") + + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) + + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp,mesh%nElem) + call geometry%GenerateFromMesh(mesh) + + call f%Init(interp,nvar,mesh%nelem) + call df%Init(interp,nvar,mesh%nelem) + call f%AssociateGeometry(geometry) + + call f%SetName(1,"f") + call df%SetName(1,"df") + + call f%SetEquation(1,'f = x*y') + + call f%SetInteriorFromEquation(geometry,0.0_prec) + print*,"min, max (interior)",minval(f%interior),maxval(f%interior) + + call f%BoundaryInterp() + call f%UpdateHost() + print*,"min, max (boundary)",minval(f%boundary),maxval(f%boundary) + + call f%SideExchange(mesh) + call f%UpdateHost() + + ! Set boundary conditions by prolonging the "boundary" attribute to the domain boundaries + do iel = 1,f%nElem + do iside = 1,6 + e2 = mesh%sideInfo(3,iside,iel) ! Neighboring Element ID + s2 = mesh%sideInfo(4,iside,iel)/10 + bcid = mesh%sideInfo(5,iside,iel) + if(e2 == 0) then + do j = 1,f%interp%N+1 + do i = 1,f%interp%N+1 + f%extBoundary(i,j,iside,iel,1) = f%boundary(i,j,iside,iel,1) + enddo + enddo + endif + enddo + enddo + + print*,"min, max (extboundary)",minval(f%extBoundary),maxval(f%extBoundary) + + call f%UpdateDevice() + call f%AverageSides() + call f%UpdateHost() + print*,"min, max (avgboundary)",minval(f%avgBoundary),maxval(f%avgBoundary) #ifdef ENABLE_GPU - call f%MappedDGGradient(df%interior_gpu) + call f%MappedDGGradient(df%interior_gpu) #else - call f%MappedDGGradient(df%interior) + call f%MappedDGGradient(df%interior) #endif - call df%UpdateHost() - - ! Calculate diff from exact - do iel = 1, mesh%nelem - do k = 1, controlDegree + 1 - do j = 1, controlDegree + 1 - do i = 1, controlDegree + 1 - df%interior(i, j, k, iel, 1, 1) = abs(df%interior(i, j, k, iel, 1, 1) - & - geometry%x%interior(i, j, k, iel, 1, 2)) ! df/dx = y*z - df%interior(i, j, k, iel, 1, 2) = abs(df%interior(i, j, k, iel, 1, 2) - & - geometry%x%interior(i, j, k, iel, 1, 1)) ! df/dy = x*z - df%interior(i, j, k, iel, 1, 3) = abs(df%interior(i, j, k, iel, 1, 3)) ! df/dy = x*y - end do - end do - end do - end do - print *, "maxval(df_error)", maxval(df%interior), tolerance - - if (maxval(df%interior) <= tolerance) then - r = 0 - else - r = 1 - end if - - ! Clean up - call f%DissociateGeometry() - call geometry%Free() - call mesh%Free() - call interp%Free() - call f%free() - call df%free() - - end function mappedscalarbrgradient_3d_linear -end program test + call df%UpdateHost() + + ! Calculate diff from exact + do iel = 1,mesh%nelem + do k = 1,controlDegree+1 + do j = 1,controlDegree+1 + do i = 1,controlDegree+1 + df%interior(i,j,k,iel,1,1) = abs(df%interior(i,j,k,iel,1,1)- & + geometry%x%interior(i,j,k,iel,1,2)) ! df/dx = y*z + df%interior(i,j,k,iel,1,2) = abs(df%interior(i,j,k,iel,1,2)- & + geometry%x%interior(i,j,k,iel,1,1)) ! df/dy = x*z + df%interior(i,j,k,iel,1,3) = abs(df%interior(i,j,k,iel,1,3)) ! df/dy = x*y + enddo + enddo + enddo + enddo + print*,"maxval(df_error)",maxval(df%interior),tolerance + + if(maxval(df%interior) <= tolerance) then + r = 0 + else + r = 1 + endif + + ! Clean up + call f%DissociateGeometry() + call geometry%Free() + call mesh%Free() + call interp%Free() + call f%free() + call df%free() + + endfunction mappedscalarbrgradient_3d_linear +endprogram test diff --git a/test/mappedvectordgdivergence_2d_linear_mpi.f90 b/test/mappedvectordgdivergence_2d_linear_mpi.f90 index 84ca11b28..89e60989f 100644 --- a/test/mappedvectordgdivergence_2d_linear_mpi.f90 +++ b/test/mappedvectordgdivergence_2d_linear_mpi.f90 @@ -26,112 +26,112 @@ program test - implicit none - integer :: exit_code + implicit none + integer :: exit_code - exit_code = mappedvectordgdivergence_2d_linear() - if (exit_code /= 0) then - stop exit_code - end if + exit_code = mappedvectordgdivergence_2d_linear() + if(exit_code /= 0) then + stop exit_code + endif contains - integer function mappedvectordgdivergence_2d_linear() result(r) + integer function mappedvectordgdivergence_2d_linear() result(r) - use SELF_Constants - use SELF_Lagrange - use SELF_Mesh_2D - use SELF_Geometry_2D - use SELF_MappedScalar_2D - use SELF_MappedVector_2D + use SELF_Constants + use SELF_Lagrange + use SELF_Mesh_2D + use SELF_Geometry_2D + use SELF_MappedScalar_2D + use SELF_MappedVector_2D - implicit none + implicit none - integer, parameter :: controlDegree = 7 - integer, parameter :: targetDegree = 16 - integer, parameter :: nvar = 1 + integer,parameter :: controlDegree = 7 + integer,parameter :: targetDegree = 16 + integer,parameter :: nvar = 1 #ifdef DOUBLE_PRECISION - real(prec), parameter :: tolerance = 10.0_prec**(-7) + real(prec),parameter :: tolerance = 10.0_prec**(-7) #else - real(prec), parameter :: tolerance = 10.0_prec**(-3) + real(prec),parameter :: tolerance = 10.0_prec**(-3) #endif - type(Lagrange), target :: interp - type(Mesh2D), target :: mesh - type(SEMQuad), target :: geometry - type(MappedVector2D) :: f - type(MappedScalar2D) :: df - character(LEN=255) :: WORKSPACE - integer :: i, j, iel - real(prec) :: nhat(1:2), nmag + type(Lagrange),target :: interp + type(Mesh2D),target :: mesh + type(SEMQuad),target :: geometry + type(MappedVector2D) :: f + type(MappedScalar2D) :: df + character(LEN=255) :: WORKSPACE + integer :: i,j,iel + real(prec) :: nhat(1:2),nmag - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE", WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") + ! Create a uniform block mesh + call get_environment_variable("WORKSPACE",WORKSPACE) + call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp, mesh%nElem) - call geometry%GenerateFromMesh(mesh) + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp,mesh%nElem) + call geometry%GenerateFromMesh(mesh) - call f%Init(interp, nvar, mesh%nelem) - call df%Init(interp, nvar, mesh%nelem) - call f%AssociateGeometry(geometry) + call f%Init(interp,nvar,mesh%nelem) + call df%Init(interp,nvar,mesh%nelem) + call f%AssociateGeometry(geometry) - call f%SetEquation(1, 1, 'f = x') ! x-component - call f%SetEquation(2, 1, 'f = y') ! y-component + call f%SetEquation(1,1,'f = x') ! x-component + call f%SetEquation(2,1,'f = y') ! y-component - call f%SetInteriorFromEquation(geometry, 0.0_prec) - print *, "min, max (interior)", minval(f%interior), maxval(f%interior) + call f%SetInteriorFromEquation(geometry,0.0_prec) + print*,"min, max (interior)",minval(f%interior),maxval(f%interior) - call f%boundaryInterp() - call f%UpdateHost() + call f%boundaryInterp() + call f%UpdateHost() - do iEl = 1, f%nElem - do j = 1, 4 - do i = 1, f%interp%N + 1 + do iEl = 1,f%nElem + do j = 1,4 + do i = 1,f%interp%N+1 - ! Get the boundary normals on cell edges from the mesh geometry - nhat(1:2) = geometry%nHat%boundary(i, j, iEl, 1, 1:2) - nmag = geometry%nScale%boundary(i, j, iEl, 1) + ! Get the boundary normals on cell edges from the mesh geometry + nhat(1:2) = geometry%nHat%boundary(i,j,iEl,1,1:2) + nmag = geometry%nScale%boundary(i,j,iEl,1) - f%boundaryNormal(i, j, iEl, 1) = (f%boundary(i, j, iEl, 1, 1)*nhat(1) + & - f%boundary(i, j, iEl, 1, 2)*nhat(2))*nmag + f%boundaryNormal(i,j,iEl,1) = (f%boundary(i,j,iEl,1,1)*nhat(1)+ & + f%boundary(i,j,iEl,1,2)*nhat(2))*nmag - end do - end do - end do + enddo + enddo + enddo - call f%UpdateDevice() + call f%UpdateDevice() #ifdef ENABLE_GPU - call f%MappedDGDivergence(df%interior_gpu) + call f%MappedDGDivergence(df%interior_gpu) #else - call f%MappedDGDivergence(df%interior) + call f%MappedDGDivergence(df%interior) #endif - call df%UpdateHost() - - ! Calculate diff from exact - df%interior = abs(df%interior - 2.0_prec) - - print *, "absmax error :", maxval(df%interior) - if (maxval(df%interior) <= tolerance) then - r = 0 - else - print *, "absmax error greater than tolerance :", tolerance - r = 1 - end if - - ! Clean up - call f%DissociateGeometry() - call geometry%Free() - call interp%Free() - call f%free() - call df%free() - call mesh%Free() - - end function mappedvectordgdivergence_2d_linear -end program test + call df%UpdateHost() + + ! Calculate diff from exact + df%interior = abs(df%interior-2.0_prec) + + print*,"absmax error :",maxval(df%interior) + if(maxval(df%interior) <= tolerance) then + r = 0 + else + print*,"absmax error greater than tolerance :",tolerance + r = 1 + endif + + ! Clean up + call f%DissociateGeometry() + call geometry%Free() + call interp%Free() + call f%free() + call df%free() + call mesh%Free() + + endfunction mappedvectordgdivergence_2d_linear +endprogram test diff --git a/test/mappedvectordgdivergence_2d_linear_sideexchange_mpi.f90 b/test/mappedvectordgdivergence_2d_linear_sideexchange_mpi.f90 index 29ac8fcf6..f5bb9724e 100644 --- a/test/mappedvectordgdivergence_2d_linear_sideexchange_mpi.f90 +++ b/test/mappedvectordgdivergence_2d_linear_sideexchange_mpi.f90 @@ -26,134 +26,134 @@ program test - implicit none - integer :: exit_code + implicit none + integer :: exit_code - exit_code = mappedvectordgdivergence_2d_linear() - if (exit_code /= 0) then - stop exit_code - end if + exit_code = mappedvectordgdivergence_2d_linear() + if(exit_code /= 0) then + stop exit_code + endif contains - integer function mappedvectordgdivergence_2d_linear() result(r) + integer function mappedvectordgdivergence_2d_linear() result(r) - use SELF_Constants - use SELF_Lagrange - use SELF_Mesh_2D - use SELF_Geometry_2D - use SELF_MappedScalar_2D - use SELF_MappedVector_2D + use SELF_Constants + use SELF_Lagrange + use SELF_Mesh_2D + use SELF_Geometry_2D + use SELF_MappedScalar_2D + use SELF_MappedVector_2D - implicit none + implicit none - integer, parameter :: controlDegree = 7 - integer, parameter :: targetDegree = 16 - integer, parameter :: nvar = 1 + integer,parameter :: controlDegree = 7 + integer,parameter :: targetDegree = 16 + integer,parameter :: nvar = 1 #ifdef DOUBLE_PRECISION - real(prec), parameter :: tolerance = 10.0_prec**(-7) + real(prec),parameter :: tolerance = 10.0_prec**(-7) #else - real(prec), parameter :: tolerance = 10.0_prec**(-3) + real(prec),parameter :: tolerance = 10.0_prec**(-3) #endif - type(Lagrange), target :: interp - type(Mesh2D), target :: mesh - type(SEMQuad), target :: geometry - type(MappedVector2D) :: f - type(MappedScalar2D) :: df - character(LEN=255) :: WORKSPACE - integer :: i, j, iel, e2 - real(prec) :: nhat(1:2), nmag, fx, fy, diff - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE", WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp, mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - call f%Init(interp, nvar, mesh%nelem) - call df%Init(interp, nvar, mesh%nelem) - call f%AssociateGeometry(geometry) - - call f%SetEquation(1, 1, 'f = x') ! x-component - call f%SetEquation(2, 1, 'f = y') ! y-component - - call f%SetInteriorFromEquation(geometry, 0.0_prec) - print *, "min, max (interior)", minval(f%interior), maxval(f%interior) - - call f%boundaryInterp() - call f%UpdateHost() - - call f%SideExchange(mesh) - call f%UpdateHost() - - ! Set boundary conditions - do iEl = 1, f%nElem - do j = 1, 4 - e2 = mesh%sideInfo(3, j, iel) ! Neighbor Element (global id) - - if (e2 == 0) then ! Exterior edge - do i = 1, f%interp%N + 1 - f%extboundary(i, j, iEl, 1, 1) = f%boundary(i, j, iEl, 1, 1) - f%extboundary(i, j, iEl, 1, 2) = f%boundary(i, j, iEl, 1, 2) - end do - end if - end do - end do - - do iEl = 1, f%nElem - do j = 1, 4 - diff = 0.0_prec - do i = 1, f%interp%N + 1 - - ! Get the boundary normals on cell edges from the mesh geometry - nhat(1:2) = geometry%nHat%boundary(i, j, iEl, 1, 1:2) - nmag = geometry%nScale%boundary(i, j, iEl, 1) - diff = diff + abs(f%boundary(i, j, iEl, 1, 1) - f%extboundary(i, j, iEl, 1, 1)) - fx = 0.5*(f%boundary(i, j, iEl, 1, 1) + f%extboundary(i, j, iEl, 1, 1)) - fy = 0.5*(f%boundary(i, j, iEl, 1, 2) + f%extboundary(i, j, iEl, 1, 2)) - - f%boundaryNormal(i, j, iEl, 1) = (fx*nhat(1) + fy*nhat(2))*nmag - - end do - if (diff > tolerance) then - print *, 'rank ', mesh%decomp%rankId, ' : mismatched edge iel, s (diff)= ', iel, j, diff - end if - end do - end do - - call f%UpdateDevice() + type(Lagrange),target :: interp + type(Mesh2D),target :: mesh + type(SEMQuad),target :: geometry + type(MappedVector2D) :: f + type(MappedScalar2D) :: df + character(LEN=255) :: WORKSPACE + integer :: i,j,iel,e2 + real(prec) :: nhat(1:2),nmag,fx,fy,diff + + ! Create a uniform block mesh + call get_environment_variable("WORKSPACE",WORKSPACE) + call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") + + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) + + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp,mesh%nElem) + call geometry%GenerateFromMesh(mesh) + + call f%Init(interp,nvar,mesh%nelem) + call df%Init(interp,nvar,mesh%nelem) + call f%AssociateGeometry(geometry) + + call f%SetEquation(1,1,'f = x') ! x-component + call f%SetEquation(2,1,'f = y') ! y-component + + call f%SetInteriorFromEquation(geometry,0.0_prec) + print*,"min, max (interior)",minval(f%interior),maxval(f%interior) + + call f%boundaryInterp() + call f%UpdateHost() + + call f%SideExchange(mesh) + call f%UpdateHost() + + ! Set boundary conditions + do iEl = 1,f%nElem + do j = 1,4 + e2 = mesh%sideInfo(3,j,iel) ! Neighbor Element (global id) + + if(e2 == 0) then ! Exterior edge + do i = 1,f%interp%N+1 + f%extboundary(i,j,iEl,1,1) = f%boundary(i,j,iEl,1,1) + f%extboundary(i,j,iEl,1,2) = f%boundary(i,j,iEl,1,2) + enddo + endif + enddo + enddo + + do iEl = 1,f%nElem + do j = 1,4 + diff = 0.0_prec + do i = 1,f%interp%N+1 + + ! Get the boundary normals on cell edges from the mesh geometry + nhat(1:2) = geometry%nHat%boundary(i,j,iEl,1,1:2) + nmag = geometry%nScale%boundary(i,j,iEl,1) + diff = diff+abs(f%boundary(i,j,iEl,1,1)-f%extboundary(i,j,iEl,1,1)) + fx = 0.5*(f%boundary(i,j,iEl,1,1)+f%extboundary(i,j,iEl,1,1)) + fy = 0.5*(f%boundary(i,j,iEl,1,2)+f%extboundary(i,j,iEl,1,2)) + + f%boundaryNormal(i,j,iEl,1) = (fx*nhat(1)+fy*nhat(2))*nmag + + enddo + if(diff > tolerance) then + print*,'rank ',mesh%decomp%rankId,' : mismatched edge iel, s (diff)= ',iel,j,diff + endif + enddo + enddo + + call f%UpdateDevice() #ifdef ENABLE_GPU - call f%MappedDGDivergence(df%interior_gpu) + call f%MappedDGDivergence(df%interior_gpu) #else - call f%MappedDGDivergence(df%interior) + call f%MappedDGDivergence(df%interior) #endif - call df%UpdateHost() - - ! Calculate diff from exact - df%interior = abs(df%interior - 2.0_prec) - - print *, "absmax error :", maxval(df%interior) - if (maxval(df%interior) <= tolerance) then - r = 0 - else - r = 1 - end if - - ! Clean up - call f%DissociateGeometry() - call geometry%Free() - call mesh%Free() - call interp%Free() - call f%free() - call df%free() - - end function mappedvectordgdivergence_2d_linear -end program test + call df%UpdateHost() + + ! Calculate diff from exact + df%interior = abs(df%interior-2.0_prec) + + print*,"absmax error :",maxval(df%interior) + if(maxval(df%interior) <= tolerance) then + r = 0 + else + r = 1 + endif + + ! Clean up + call f%DissociateGeometry() + call geometry%Free() + call mesh%Free() + call interp%Free() + call f%free() + call df%free() + + endfunction mappedvectordgdivergence_2d_linear +endprogram test diff --git a/test/mappedvectordgdivergence_2d_linear_structuredmesh_mpi.f90 b/test/mappedvectordgdivergence_2d_linear_structuredmesh_mpi.f90 index 2f6cee4a3..484fd0ce5 100644 --- a/test/mappedvectordgdivergence_2d_linear_structuredmesh_mpi.f90 +++ b/test/mappedvectordgdivergence_2d_linear_structuredmesh_mpi.f90 @@ -26,134 +26,134 @@ program test - implicit none - integer :: exit_code + implicit none + integer :: exit_code - exit_code = mappedvectordgdivergence_2d_linear() - if (exit_code /= 0) then - stop exit_code - end if + exit_code = mappedvectordgdivergence_2d_linear() + if(exit_code /= 0) then + stop exit_code + endif contains - integer function mappedvectordgdivergence_2d_linear() result(r) + integer function mappedvectordgdivergence_2d_linear() result(r) - use SELF_Constants - use SELF_Lagrange - use SELF_Mesh_2D - use SELF_Geometry_2D - use SELF_MappedScalar_2D - use SELF_MappedVector_2D + use SELF_Constants + use SELF_Lagrange + use SELF_Mesh_2D + use SELF_Geometry_2D + use SELF_MappedScalar_2D + use SELF_MappedVector_2D - implicit none + implicit none - integer, parameter :: controlDegree = 7 - integer, parameter :: targetDegree = 16 - integer, parameter :: nvar = 1 + integer,parameter :: controlDegree = 7 + integer,parameter :: targetDegree = 16 + integer,parameter :: nvar = 1 #ifdef DOUBLE_PRECISION - real(prec), parameter :: tolerance = 10.0_prec**(-7) + real(prec),parameter :: tolerance = 10.0_prec**(-7) #else - real(prec), parameter :: tolerance = 10.0_prec**(-3) + real(prec),parameter :: tolerance = 10.0_prec**(-3) #endif - type(Lagrange), target :: interp - type(Mesh2D), target :: mesh - type(SEMQuad), target :: geometry - type(MappedVector2D) :: f - type(MappedScalar2D) :: df - character(LEN=255) :: WORKSPACE - integer :: i, j, iel, e2 - real(prec) :: nhat(1:2), nmag, fx, fy, diff - integer :: bcids(1:4) - - ! Create a structured mesh - bcids(1:4) = [SELF_BC_PRESCRIBED, & ! South - SELF_BC_PRESCRIBED, & ! East - SELF_BC_PRESCRIBED, & ! North - SELF_BC_PRESCRIBED] ! West - call mesh%StructuredMesh(10, 10, 2, 2, 0.05_prec, 0.05_prec, bcids) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp, mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - call f%Init(interp, nvar, mesh%nelem) - call df%Init(interp, nvar, mesh%nelem) - call f%AssociateGeometry(geometry) - - call f%SetEquation(1, 1, 'f = x') ! x-component - call f%SetEquation(2, 1, 'f = y') ! y-component - - call f%SetInteriorFromEquation(geometry, 0.0_prec) - print *, "min, max (interior)", minval(f%interior), maxval(f%interior) - - call f%boundaryInterp() - call f%SideExchange(mesh) - call f%UpdateHost() - ! Set boundary conditions by prolonging the "boundary" attribute to the domain boundaries - do iel = 1, f%nElem - do j = 1, 4 - e2 = mesh%sideInfo(3, j, iel) ! Neighboring Element ID - if (e2 == 0) then - do i = 1, f%interp%N + 1 - f%extBoundary(i, j, iel, 1, 1:2) = f%boundary(i, j, iel, 1, 1:2) - end do - end if - end do - end do - - do iEl = 1, f%nElem - do j = 1, 4 - diff = 0.0_prec - do i = 1, f%interp%N + 1 - - ! Get the boundary normals on cell edges from the mesh geometry - nhat(1:2) = geometry%nHat%boundary(i, j, iEl, 1, 1:2) - nmag = geometry%nScale%boundary(i, j, iEl, 1) - diff = diff + abs(f%boundary(i, j, iEl, 1, 1) - f%extboundary(i, j, iEl, 1, 1)) - - fx = 0.5*(f%boundary(i, j, iEl, 1, 1) + f%extboundary(i, j, iEl, 1, 1)) - fy = 0.5*(f%boundary(i, j, iEl, 1, 2) + f%extboundary(i, j, iEl, 1, 2)) - - f%boundaryNormal(i, j, iEl, 1) = (fx*nhat(1) + fy*nhat(2))*nmag - - end do - if (diff > tolerance) then - print *, 'rank ', mesh%decomp%rankId, ' : mismatched edge iel, s (diff)= ', iel, j, diff - end if - end do - end do - - call f%UpdateDevice() + type(Lagrange),target :: interp + type(Mesh2D),target :: mesh + type(SEMQuad),target :: geometry + type(MappedVector2D) :: f + type(MappedScalar2D) :: df + character(LEN=255) :: WORKSPACE + integer :: i,j,iel,e2 + real(prec) :: nhat(1:2),nmag,fx,fy,diff + integer :: bcids(1:4) + + ! Create a structured mesh + bcids(1:4) = [SELF_BC_PRESCRIBED, & ! South + SELF_BC_PRESCRIBED, & ! East + SELF_BC_PRESCRIBED, & ! North + SELF_BC_PRESCRIBED] ! West + call mesh%StructuredMesh(10,10,2,2,0.05_prec,0.05_prec,bcids) + + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) + + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp,mesh%nElem) + call geometry%GenerateFromMesh(mesh) + + call f%Init(interp,nvar,mesh%nelem) + call df%Init(interp,nvar,mesh%nelem) + call f%AssociateGeometry(geometry) + + call f%SetEquation(1,1,'f = x') ! x-component + call f%SetEquation(2,1,'f = y') ! y-component + + call f%SetInteriorFromEquation(geometry,0.0_prec) + print*,"min, max (interior)",minval(f%interior),maxval(f%interior) + + call f%boundaryInterp() + call f%SideExchange(mesh) + call f%UpdateHost() + ! Set boundary conditions by prolonging the "boundary" attribute to the domain boundaries + do iel = 1,f%nElem + do j = 1,4 + e2 = mesh%sideInfo(3,j,iel) ! Neighboring Element ID + if(e2 == 0) then + do i = 1,f%interp%N+1 + f%extBoundary(i,j,iel,1,1:2) = f%boundary(i,j,iel,1,1:2) + enddo + endif + enddo + enddo + + do iEl = 1,f%nElem + do j = 1,4 + diff = 0.0_prec + do i = 1,f%interp%N+1 + + ! Get the boundary normals on cell edges from the mesh geometry + nhat(1:2) = geometry%nHat%boundary(i,j,iEl,1,1:2) + nmag = geometry%nScale%boundary(i,j,iEl,1) + diff = diff+abs(f%boundary(i,j,iEl,1,1)-f%extboundary(i,j,iEl,1,1)) + + fx = 0.5*(f%boundary(i,j,iEl,1,1)+f%extboundary(i,j,iEl,1,1)) + fy = 0.5*(f%boundary(i,j,iEl,1,2)+f%extboundary(i,j,iEl,1,2)) + + f%boundaryNormal(i,j,iEl,1) = (fx*nhat(1)+fy*nhat(2))*nmag + + enddo + if(diff > tolerance) then + print*,'rank ',mesh%decomp%rankId,' : mismatched edge iel, s (diff)= ',iel,j,diff + endif + enddo + enddo + + call f%UpdateDevice() #ifdef ENABLE_GPU - call f%MappedDGDivergence(df%interior_gpu) + call f%MappedDGDivergence(df%interior_gpu) #else - call f%MappedDGDivergence(df%interior) + call f%MappedDGDivergence(df%interior) #endif - call df%UpdateHost() - - ! Calculate diff from exact - df%interior = abs(df%interior - 2.0_prec) - - print *, "absmax error :", maxval(df%interior) - if (maxval(df%interior) <= tolerance) then - r = 0 - else - r = 1 - end if - - ! Clean up - call f%DissociateGeometry() - call geometry%Free() - call mesh%Free() - call interp%Free() - call f%free() - call df%free() - - end function mappedvectordgdivergence_2d_linear -end program test + call df%UpdateHost() + + ! Calculate diff from exact + df%interior = abs(df%interior-2.0_prec) + + print*,"absmax error :",maxval(df%interior) + if(maxval(df%interior) <= tolerance) then + r = 0 + else + r = 1 + endif + + ! Clean up + call f%DissociateGeometry() + call geometry%Free() + call mesh%Free() + call interp%Free() + call f%free() + call df%free() + + endfunction mappedvectordgdivergence_2d_linear +endprogram test diff --git a/test/mappedvectordgdivergence_3d_linear_mpi.f90 b/test/mappedvectordgdivergence_3d_linear_mpi.f90 index 4817d75d3..92c8f88d1 100644 --- a/test/mappedvectordgdivergence_3d_linear_mpi.f90 +++ b/test/mappedvectordgdivergence_3d_linear_mpi.f90 @@ -26,113 +26,113 @@ program test - implicit none - integer :: exit_code + implicit none + integer :: exit_code - exit_code = mappedvectordgdivergence_3d_linear() - if (exit_code /= 0) then - stop exit_code - end if + exit_code = mappedvectordgdivergence_3d_linear() + if(exit_code /= 0) then + stop exit_code + endif contains - integer function mappedvectordgdivergence_3d_linear() result(r) + integer function mappedvectordgdivergence_3d_linear() result(r) - use SELF_Constants - use SELF_Lagrange - use SELF_Mesh_3D - use SELF_Geometry_3D - use SELF_MappedScalar_3D - use SELF_MappedVector_3D + use SELF_Constants + use SELF_Lagrange + use SELF_Mesh_3D + use SELF_Geometry_3D + use SELF_MappedScalar_3D + use SELF_MappedVector_3D - implicit none + implicit none - integer, parameter :: controlDegree = 7 - integer, parameter :: targetDegree = 16 - integer, parameter :: nvar = 1 + integer,parameter :: controlDegree = 7 + integer,parameter :: targetDegree = 16 + integer,parameter :: nvar = 1 #ifdef DOUBLE_PRECISION - real(prec), parameter :: tolerance = 10.0_prec**(-7) + real(prec),parameter :: tolerance = 10.0_prec**(-7) #else - real(prec), parameter :: tolerance = 10.0_prec**(-3) + real(prec),parameter :: tolerance = 10.0_prec**(-3) #endif - type(Lagrange), target :: interp - type(Mesh3D), target :: mesh - type(SEMHex), target :: geometry - type(MappedVector3D) :: f - type(MappedScalar3D) :: df - character(LEN=255) :: WORKSPACE - integer :: i, j, k, iel - real(prec) :: nhat(1:3), nmag - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE", WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp, mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - call f%Init(interp, nvar, mesh%nelem) - call df%Init(interp, nvar, mesh%nelem) - call f%AssociateGeometry(geometry) - - call f%SetEquation(1, 1, 'f = x') ! x-component - call f%SetEquation(2, 1, 'f = y') ! y-component - call f%SetEquation(3, 1, 'f = z') ! z-component - - call f%SetInteriorFromEquation(geometry, 0.0_prec) - print *, "min, max (interior)", minval(f%interior), maxval(f%interior) - call f%boundaryInterp() - call f%UpdateHost() - - do iEl = 1, f%nElem - do k = 1, 6 - do j = 1, f%interp%N + 1 - do i = 1, f%interp%N + 1 - - ! Get the boundary normals on cell edges from the mesh geometry - nhat(1:3) = geometry%nHat%boundary(i, j, k, iEl, 1, 1:3) - nmag = geometry%nScale%boundary(i, j, k, iEl, 1) - - f%boundaryNormal(i, j, k, iEl, 1) = (f%boundary(i, j, k, iEl, 1, 1)*nhat(1) + & - f%boundary(i, j, k, iEl, 1, 2)*nhat(2) + & - f%boundary(i, j, k, iEl, 1, 3)*nhat(3))*nmag - end do - end do - end do - end do - call f%UpdateDevice() + type(Lagrange),target :: interp + type(Mesh3D),target :: mesh + type(SEMHex),target :: geometry + type(MappedVector3D) :: f + type(MappedScalar3D) :: df + character(LEN=255) :: WORKSPACE + integer :: i,j,k,iel + real(prec) :: nhat(1:3),nmag + + ! Create a uniform block mesh + call get_environment_variable("WORKSPACE",WORKSPACE) + call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") + + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) + + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp,mesh%nElem) + call geometry%GenerateFromMesh(mesh) + + call f%Init(interp,nvar,mesh%nelem) + call df%Init(interp,nvar,mesh%nelem) + call f%AssociateGeometry(geometry) + + call f%SetEquation(1,1,'f = x') ! x-component + call f%SetEquation(2,1,'f = y') ! y-component + call f%SetEquation(3,1,'f = z') ! z-component + + call f%SetInteriorFromEquation(geometry,0.0_prec) + print*,"min, max (interior)",minval(f%interior),maxval(f%interior) + call f%boundaryInterp() + call f%UpdateHost() + + do iEl = 1,f%nElem + do k = 1,6 + do j = 1,f%interp%N+1 + do i = 1,f%interp%N+1 + + ! Get the boundary normals on cell edges from the mesh geometry + nhat(1:3) = geometry%nHat%boundary(i,j,k,iEl,1,1:3) + nmag = geometry%nScale%boundary(i,j,k,iEl,1) + + f%boundaryNormal(i,j,k,iEl,1) = (f%boundary(i,j,k,iEl,1,1)*nhat(1)+ & + f%boundary(i,j,k,iEl,1,2)*nhat(2)+ & + f%boundary(i,j,k,iEl,1,3)*nhat(3))*nmag + enddo + enddo + enddo + enddo + call f%UpdateDevice() #ifdef ENABLE_GPU - call f%MappedDGDivergence(df%interior_gpu) + call f%MappedDGDivergence(df%interior_gpu) #else - call f%MappedDGDivergence(df%interior) + call f%MappedDGDivergence(df%interior) #endif - call df%UpdateHost() - - ! Calculate diff from exact - df%interior = abs(df%interior - 3.0_prec) - - print *, "absmax error :", maxval(df%interior) - if (maxval(df%interior) <= tolerance) then - r = 0 - else - print *, "absmax error greater than tolerance :", tolerance - r = 1 - end if - - ! Clean up - call f%DissociateGeometry() - call geometry%Free() - call interp%Free() - call f%free() - call df%free() - call mesh%Free() - - end function mappedvectordgdivergence_3d_linear -end program test + call df%UpdateHost() + + ! Calculate diff from exact + df%interior = abs(df%interior-3.0_prec) + + print*,"absmax error :",maxval(df%interior) + if(maxval(df%interior) <= tolerance) then + r = 0 + else + print*,"absmax error greater than tolerance :",tolerance + r = 1 + endif + + ! Clean up + call f%DissociateGeometry() + call geometry%Free() + call interp%Free() + call f%free() + call df%free() + call mesh%Free() + + endfunction mappedvectordgdivergence_3d_linear +endprogram test diff --git a/test/mappedvectordgdivergence_3d_linear_sideexchange_mpi.f90 b/test/mappedvectordgdivergence_3d_linear_sideexchange_mpi.f90 index eee0efdd9..62f59173e 100644 --- a/test/mappedvectordgdivergence_3d_linear_sideexchange_mpi.f90 +++ b/test/mappedvectordgdivergence_3d_linear_sideexchange_mpi.f90 @@ -26,136 +26,136 @@ program test - implicit none - integer :: exit_code + implicit none + integer :: exit_code - exit_code = mappedvectordgdivergence_3d_linear() - if (exit_code /= 0) then - stop exit_code - end if + exit_code = mappedvectordgdivergence_3d_linear() + if(exit_code /= 0) then + stop exit_code + endif contains - integer function mappedvectordgdivergence_3d_linear() result(r) + integer function mappedvectordgdivergence_3d_linear() result(r) - use SELF_Constants - use SELF_Lagrange - use SELF_Mesh_3D - use SELF_Geometry_3D - use SELF_MappedScalar_3D - use SELF_MappedVector_3D + use SELF_Constants + use SELF_Lagrange + use SELF_Mesh_3D + use SELF_Geometry_3D + use SELF_MappedScalar_3D + use SELF_MappedVector_3D - implicit none + implicit none - integer, parameter :: controlDegree = 7 - integer, parameter :: targetDegree = 16 - integer, parameter :: nvar = 1 + integer,parameter :: controlDegree = 7 + integer,parameter :: targetDegree = 16 + integer,parameter :: nvar = 1 #ifdef DOUBLE_PRECISION - real(prec), parameter :: tolerance = 10.0_prec**(-7) + real(prec),parameter :: tolerance = 10.0_prec**(-7) #else - real(prec), parameter :: tolerance = 10.0_prec**(-3) + real(prec),parameter :: tolerance = 10.0_prec**(-3) #endif - type(Lagrange), target :: interp - type(Mesh3D), target :: mesh - type(SEMHex), target :: geometry - type(MappedVector3D) :: f - type(MappedScalar3D) :: df - character(LEN=255) :: WORKSPACE - integer :: i, j, k, iel, e2 - real(prec) :: nhat(1:3), nmag, fx, fy, fz - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE", WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp, mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - call f%Init(interp, nvar, mesh%nelem) - call df%Init(interp, nvar, mesh%nelem) - call f%AssociateGeometry(geometry) - - call f%SetEquation(1, 1, 'f = x') ! x-component - call f%SetEquation(2, 1, 'f = y') ! y-component - call f%SetEquation(3, 1, 'f = 0') ! z-component - - call f%SetInteriorFromEquation(geometry, 0.0_prec) - print *, "min, max (interior)", minval(f%interior), maxval(f%interior) - call f%boundaryInterp() - - print *, "Exchanging data on element faces" - - call f%SideExchange(mesh) - call f%UpdateHost() - - print *, "Setting boundary conditions" - ! Set boundary conditions - do iEl = 1, f%nElem - do k = 1, 6 - e2 = mesh%sideInfo(3, k, iel) ! Neighbor Element (global id) - - if (e2 == 0) then ! Exterior edge - do j = 1, f%interp%N + 1 - do i = 1, f%interp%N + 1 - f%extboundary(i, j, k, iEl, 1, 1) = f%boundary(i, j, k, iEl, 1, 1) - f%extboundary(i, j, k, iEl, 1, 2) = f%boundary(i, j, k, iEl, 1, 2) - f%extboundary(i, j, k, iEl, 1, 3) = f%boundary(i, j, k, iEl, 1, 3) - end do - end do - end if - end do - end do - - print *, "Calculating boundary normal flux" - do iEl = 1, f%nElem - do k = 1, 6 - do j = 1, f%interp%N + 1 - do i = 1, f%interp%N + 1 - - ! Get the boundary normals on cell edges from the mesh geometry - nhat(1:3) = geometry%nHat%boundary(i, j, k, iEl, 1, 1:3) - nmag = geometry%nScale%boundary(i, j, k, iEl, 1) - fx = 0.5*(f%boundary(i, j, k, iEl, 1, 1) + f%extboundary(i, j, k, iEl, 1, 1)) - fy = 0.5*(f%boundary(i, j, k, iEl, 1, 2) + f%extboundary(i, j, k, iEl, 1, 2)) - fz = 0.5*(f%boundary(i, j, k, iEl, 1, 3) + f%extboundary(i, j, k, iEl, 1, 3)) - - f%boundaryNormal(i, j, k, iEl, 1) = (fx*nhat(1) + fy*nhat(2) + fz*nhat(3))*nmag - end do - end do - end do - end do - call f%UpdateDevice() + type(Lagrange),target :: interp + type(Mesh3D),target :: mesh + type(SEMHex),target :: geometry + type(MappedVector3D) :: f + type(MappedScalar3D) :: df + character(LEN=255) :: WORKSPACE + integer :: i,j,k,iel,e2 + real(prec) :: nhat(1:3),nmag,fx,fy,fz + + ! Create a uniform block mesh + call get_environment_variable("WORKSPACE",WORKSPACE) + call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") + + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) + + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp,mesh%nElem) + call geometry%GenerateFromMesh(mesh) + + call f%Init(interp,nvar,mesh%nelem) + call df%Init(interp,nvar,mesh%nelem) + call f%AssociateGeometry(geometry) + + call f%SetEquation(1,1,'f = x') ! x-component + call f%SetEquation(2,1,'f = y') ! y-component + call f%SetEquation(3,1,'f = 0') ! z-component + + call f%SetInteriorFromEquation(geometry,0.0_prec) + print*,"min, max (interior)",minval(f%interior),maxval(f%interior) + call f%boundaryInterp() + + print*,"Exchanging data on element faces" + + call f%SideExchange(mesh) + call f%UpdateHost() + + print*,"Setting boundary conditions" + ! Set boundary conditions + do iEl = 1,f%nElem + do k = 1,6 + e2 = mesh%sideInfo(3,k,iel) ! Neighbor Element (global id) + + if(e2 == 0) then ! Exterior edge + do j = 1,f%interp%N+1 + do i = 1,f%interp%N+1 + f%extboundary(i,j,k,iEl,1,1) = f%boundary(i,j,k,iEl,1,1) + f%extboundary(i,j,k,iEl,1,2) = f%boundary(i,j,k,iEl,1,2) + f%extboundary(i,j,k,iEl,1,3) = f%boundary(i,j,k,iEl,1,3) + enddo + enddo + endif + enddo + enddo + + print*,"Calculating boundary normal flux" + do iEl = 1,f%nElem + do k = 1,6 + do j = 1,f%interp%N+1 + do i = 1,f%interp%N+1 + + ! Get the boundary normals on cell edges from the mesh geometry + nhat(1:3) = geometry%nHat%boundary(i,j,k,iEl,1,1:3) + nmag = geometry%nScale%boundary(i,j,k,iEl,1) + fx = 0.5*(f%boundary(i,j,k,iEl,1,1)+f%extboundary(i,j,k,iEl,1,1)) + fy = 0.5*(f%boundary(i,j,k,iEl,1,2)+f%extboundary(i,j,k,iEl,1,2)) + fz = 0.5*(f%boundary(i,j,k,iEl,1,3)+f%extboundary(i,j,k,iEl,1,3)) + + f%boundaryNormal(i,j,k,iEl,1) = (fx*nhat(1)+fy*nhat(2)+fz*nhat(3))*nmag + enddo + enddo + enddo + enddo + call f%UpdateDevice() #ifdef ENABLE_GPU - call f%MappedDGDivergence(df%interior_gpu) + call f%MappedDGDivergence(df%interior_gpu) #else - call f%MappedDGDivergence(df%interior) + call f%MappedDGDivergence(df%interior) #endif - call df%UpdateHost() - - ! Calculate diff from exact - df%interior = abs(df%interior - 2.0_prec) - - if (maxval(df%interior) <= tolerance) then - r = 0 - else - print *, "max error (tolerance)", maxval(df%interior), tolerance - r = 1 - end if - - ! Clean up - call f%DissociateGeometry() - call geometry%Free() - call mesh%Free() - call interp%Free() - call f%free() - call df%free() - - end function mappedvectordgdivergence_3d_linear -end program test + call df%UpdateHost() + + ! Calculate diff from exact + df%interior = abs(df%interior-2.0_prec) + + if(maxval(df%interior) <= tolerance) then + r = 0 + else + print*,"max error (tolerance)",maxval(df%interior),tolerance + r = 1 + endif + + ! Clean up + call f%DissociateGeometry() + call geometry%Free() + call mesh%Free() + call interp%Free() + call f%free() + call df%free() + + endfunction mappedvectordgdivergence_3d_linear +endprogram test diff --git a/test/mappedvectordgdivergence_3d_linear_structuredmesh_mpi.f90 b/test/mappedvectordgdivergence_3d_linear_structuredmesh_mpi.f90 index cb2a80757..d8d13418b 100644 --- a/test/mappedvectordgdivergence_3d_linear_structuredmesh_mpi.f90 +++ b/test/mappedvectordgdivergence_3d_linear_structuredmesh_mpi.f90 @@ -26,145 +26,145 @@ program test - implicit none - integer :: exit_code + implicit none + integer :: exit_code - exit_code = mappedvectordgdivergence_3d_linear() - if (exit_code /= 0) then - stop exit_code - end if + exit_code = mappedvectordgdivergence_3d_linear() + if(exit_code /= 0) then + stop exit_code + endif contains - integer function mappedvectordgdivergence_3d_linear() result(r) + integer function mappedvectordgdivergence_3d_linear() result(r) - use SELF_Constants - use SELF_Lagrange - use SELF_Mesh_3D - use SELF_Geometry_3D - use SELF_MappedScalar_3D - use SELF_MappedVector_3D + use SELF_Constants + use SELF_Lagrange + use SELF_Mesh_3D + use SELF_Geometry_3D + use SELF_MappedScalar_3D + use SELF_MappedVector_3D - implicit none + implicit none - integer, parameter :: controlDegree = 7 - integer, parameter :: targetDegree = 16 - integer, parameter :: nvar = 1 + integer,parameter :: controlDegree = 7 + integer,parameter :: targetDegree = 16 + integer,parameter :: nvar = 1 #ifdef DOUBLE_PRECISION - real(prec), parameter :: tolerance = 10.0_prec**(-7) + real(prec),parameter :: tolerance = 10.0_prec**(-7) #else - real(prec), parameter :: tolerance = 10.0_prec**(-3) + real(prec),parameter :: tolerance = 10.0_prec**(-3) #endif - type(Lagrange), target :: interp - type(Mesh3D), target :: mesh - type(SEMHex), target :: geometry - type(MappedVector3D) :: f - type(MappedScalar3D) :: df - integer :: i, j, k, iel, e2 - real(prec) :: nhat(1:3), nmag, fx, fy, fz - integer :: bcids(1:6) - - ! Create a uniform block mesh - bcids(1:6) = [SELF_BC_PRESCRIBED, & ! Bottom - SELF_BC_PRESCRIBED, & ! South - SELF_BC_PRESCRIBED, & ! East - SELF_BC_PRESCRIBED, & ! North - SELF_BC_PRESCRIBED, & ! West - SELF_BC_PRESCRIBED] ! Top - - call mesh%StructuredMesh(5, 5, 5, & - 2, 2, 2, & - 0.1_prec, 0.1_prec, 0.1_prec, & - bcids) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp, mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - call f%Init(interp, nvar, mesh%nelem) - call df%Init(interp, nvar, mesh%nelem) - call f%AssociateGeometry(geometry) - - call f%SetEquation(1, 1, 'f = x') ! x-component - call f%SetEquation(2, 1, 'f = y') ! y-component - call f%SetEquation(3, 1, 'f = 0') ! z-component - - call f%SetInteriorFromEquation(geometry, 0.0_prec) - print *, "min, max (interior)", minval(f%interior), maxval(f%interior) - call f%boundaryInterp() - - print *, "Exchanging data on element faces" - - call f%SideExchange(mesh) - call f%UpdateHost() - - print *, "Setting boundary conditions" - ! Set boundary conditions - do iEl = 1, f%nElem - do k = 1, 6 - e2 = mesh%sideInfo(3, k, iel) ! Neighbor Element (global id) - - if (e2 == 0) then ! Exterior edge - do j = 1, f%interp%N + 1 - do i = 1, f%interp%N + 1 - f%extboundary(i, j, k, iEl, 1, 1) = f%boundary(i, j, k, iEl, 1, 1) - f%extboundary(i, j, k, iEl, 1, 2) = f%boundary(i, j, k, iEl, 1, 2) - f%extboundary(i, j, k, iEl, 1, 3) = f%boundary(i, j, k, iEl, 1, 3) - end do - end do - end if - end do - end do - - print *, "Calculating boundary normal flux" - do iEl = 1, f%nElem - do k = 1, 6 - do j = 1, f%interp%N + 1 - do i = 1, f%interp%N + 1 - - ! Get the boundary normals on cell edges from the mesh geometry - nhat(1:3) = geometry%nHat%boundary(i, j, k, iEl, 1, 1:3) - nmag = geometry%nScale%boundary(i, j, k, iEl, 1) - fx = 0.5*(f%boundary(i, j, k, iEl, 1, 1) + f%extboundary(i, j, k, iEl, 1, 1)) - fy = 0.5*(f%boundary(i, j, k, iEl, 1, 2) + f%extboundary(i, j, k, iEl, 1, 2)) - fz = 0.5*(f%boundary(i, j, k, iEl, 1, 3) + f%extboundary(i, j, k, iEl, 1, 3)) - - f%boundaryNormal(i, j, k, iEl, 1) = (fx*nhat(1) + fy*nhat(2) + fz*nhat(3))*nmag - end do - end do - end do - end do - call f%UpdateDevice() + type(Lagrange),target :: interp + type(Mesh3D),target :: mesh + type(SEMHex),target :: geometry + type(MappedVector3D) :: f + type(MappedScalar3D) :: df + integer :: i,j,k,iel,e2 + real(prec) :: nhat(1:3),nmag,fx,fy,fz + integer :: bcids(1:6) + + ! Create a uniform block mesh + bcids(1:6) = [SELF_BC_PRESCRIBED, & ! Bottom + SELF_BC_PRESCRIBED, & ! South + SELF_BC_PRESCRIBED, & ! East + SELF_BC_PRESCRIBED, & ! North + SELF_BC_PRESCRIBED, & ! West + SELF_BC_PRESCRIBED] ! Top + + call mesh%StructuredMesh(5,5,5, & + 2,2,2, & + 0.1_prec,0.1_prec,0.1_prec, & + bcids) + + ! Create an interpolant + call interp%Init(N=controlDegree, & + controlNodeType=GAUSS, & + M=targetDegree, & + targetNodeType=UNIFORM) + + ! Generate geometry (metric terms) from the mesh elements + call geometry%Init(interp,mesh%nElem) + call geometry%GenerateFromMesh(mesh) + + call f%Init(interp,nvar,mesh%nelem) + call df%Init(interp,nvar,mesh%nelem) + call f%AssociateGeometry(geometry) + + call f%SetEquation(1,1,'f = x') ! x-component + call f%SetEquation(2,1,'f = y') ! y-component + call f%SetEquation(3,1,'f = 0') ! z-component + + call f%SetInteriorFromEquation(geometry,0.0_prec) + print*,"min, max (interior)",minval(f%interior),maxval(f%interior) + call f%boundaryInterp() + + print*,"Exchanging data on element faces" + + call f%SideExchange(mesh) + call f%UpdateHost() + + print*,"Setting boundary conditions" + ! Set boundary conditions + do iEl = 1,f%nElem + do k = 1,6 + e2 = mesh%sideInfo(3,k,iel) ! Neighbor Element (global id) + + if(e2 == 0) then ! Exterior edge + do j = 1,f%interp%N+1 + do i = 1,f%interp%N+1 + f%extboundary(i,j,k,iEl,1,1) = f%boundary(i,j,k,iEl,1,1) + f%extboundary(i,j,k,iEl,1,2) = f%boundary(i,j,k,iEl,1,2) + f%extboundary(i,j,k,iEl,1,3) = f%boundary(i,j,k,iEl,1,3) + enddo + enddo + endif + enddo + enddo + + print*,"Calculating boundary normal flux" + do iEl = 1,f%nElem + do k = 1,6 + do j = 1,f%interp%N+1 + do i = 1,f%interp%N+1 + + ! Get the boundary normals on cell edges from the mesh geometry + nhat(1:3) = geometry%nHat%boundary(i,j,k,iEl,1,1:3) + nmag = geometry%nScale%boundary(i,j,k,iEl,1) + fx = 0.5*(f%boundary(i,j,k,iEl,1,1)+f%extboundary(i,j,k,iEl,1,1)) + fy = 0.5*(f%boundary(i,j,k,iEl,1,2)+f%extboundary(i,j,k,iEl,1,2)) + fz = 0.5*(f%boundary(i,j,k,iEl,1,3)+f%extboundary(i,j,k,iEl,1,3)) + + f%boundaryNormal(i,j,k,iEl,1) = (fx*nhat(1)+fy*nhat(2)+fz*nhat(3))*nmag + enddo + enddo + enddo + enddo + call f%UpdateDevice() #ifdef ENABLE_GPU - call f%MappedDGDivergence(df%interior_gpu) + call f%MappedDGDivergence(df%interior_gpu) #else - call f%MappedDGDivergence(df%interior) + call f%MappedDGDivergence(df%interior) #endif - call df%UpdateHost() - - ! Calculate diff from exact - df%interior = abs(df%interior - 2.0_prec) - - if (maxval(df%interior) <= tolerance) then - r = 0 - else - print *, "max error (tolerance)", maxval(df%interior), tolerance - r = 1 - end if - - ! Clean up - call f%DissociateGeometry() - call geometry%Free() - call mesh%Free() - call interp%Free() - call f%free() - call df%free() - - end function mappedvectordgdivergence_3d_linear -end program test + call df%UpdateHost() + + ! Calculate diff from exact + df%interior = abs(df%interior-2.0_prec) + + if(maxval(df%interior) <= tolerance) then + r = 0 + else + print*,"max error (tolerance)",maxval(df%interior),tolerance + r = 1 + endif + + ! Clean up + call f%DissociateGeometry() + call geometry%Free() + call mesh%Free() + call interp%Free() + call f%free() + call df%free() + + endfunction mappedvectordgdivergence_3d_linear +endprogram test