From 05403d2808523b9735df7a943bef037a8b1e7e14 Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Thu, 30 Jan 2025 16:00:58 -0500 Subject: [PATCH 01/17] [WIP] Drafting the Compressible Euler LES solver (3D) --- src/SELF_GFDLES3D_t.f90 | 606 ++++++++++++++++++++++++++++++++++++++ src/cpu/SELF_GFDLES3D.f90 | 36 +++ src/gpu/SELF_GFDLES3D.f90 | 151 ++++++++++ 3 files changed, 793 insertions(+) create mode 100644 src/SELF_GFDLES3D_t.f90 create mode 100644 src/cpu/SELF_GFDLES3D.f90 create mode 100644 src/gpu/SELF_GFDLES3D.f90 diff --git a/src/SELF_GFDLES3D_t.f90 b/src/SELF_GFDLES3D_t.f90 new file mode 100644 index 000000000..0cdcd2a5b --- /dev/null +++ b/src/SELF_GFDLES3D_t.f90 @@ -0,0 +1,606 @@ +! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! +! +! Maintainers : support@fluidnumerics.com +! Official Repository : https://github.com/FluidNumerics/self/ +! +! Copyright © 2024 Fluid Numerics LLC +! +! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in +! the documentation and/or other materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from +! this software without specific prior written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUsLESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARIsLG IN ANY WAY OUT OF THE USE OF +! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! + +module self_GFDLES3D_t +!! This module defines a class that can be used to solve the filtered +!! compressible navier-stokes equations in 3-D +!! +!! The conserved variables are +!! +!! \begin{equation} +!! \vec{s} = \begin{pmatrix} +!! \rho \\ +!! \rho u \\ +!! \rho v \\ +!! \rho w \\ +!! \rho \theta +!! \end{pmatrix} +!! \end{equation} +!! +!! The conservative flux is +!! +!! \begin{equation} +!! \overleftrightarrow{f} = \begin{pmatrix} +!! \rho u \hat{x} + \rho v \hat{y} + \rho w \hat{z} \\ +!! \vec{u} \rho u + \frac{p}{\rho_0} \hat{x} \\ +!! \vec{u} \rho v + \frac{p}{\rho_0} \hat{y} \\ +!! \vec{u} \rho w + \frac{p}{\rho_0} \hat{z} \\ +!! \vec{u} \rho \theta +!! \end{pmatrix} +!! \end{equation} +!! +!! and the source terms include the graviational acceleration, where +!! gravity is assumed a constant acting in the z-direction +!! +!! \begin{equation} +!! \overleftrightarrow{f} = \begin{pmatrix} +!! 0 \\ +!! 0 \\ +!! 0 \\ +!! -\rho g \\ +!! 0 +!! \end{pmatrix} +!! \end{equation} +!! +!! ...Subgrid-scale closure... +!! + use self_model + use self_dgmodel3D + use self_mesh + + implicit none + + type,extends(dgmodel3D) :: GFDLES3D_t + type(MappedScalar3D) :: primitive + type(MappedScalar3D) :: diagnostics + + ! Model parameters + real(prec) :: p0 = 10.0_prec**(5) ! Reference pressure for potential temperature () + real(prec) :: Cp = 1.005_prec*10.0_prec**(3) ! Specific heat at constant pressure (J/kg-K) + real(prec) :: Cv = 0.718_prec*10.0_prec**(3) ! Specific heat at constant volume (J/kg-K) + real(prec) :: R = 287.04_prec ! Gas constant (Cp - Cv) + real(prec) :: gamma = 1.399721448_prec ! Ratio of specific heats (Cp/Cv) + real(prec) :: nu = 0.0_prec ! Dynamic viscosity + real(prec) :: kappa = 0.0_prec ! Thermal diffusivity + real(prec) :: g = 9.81_prec ! gravitational acceleration (z-direction only) + + contains + + ! Setup / Book-keeping methods + procedure :: AdditionalInit => AdditionalInit_GFDLES3D_t + procedure :: AdditionalFree => AdditionalFree_GFDLES3D_t + procedure :: SetMetadata => SetMetadata_GFDLES3D_t + procedure :: SetNumberOfVariables => SetNumberOfVariables_GFDLES3D_t + + ! File IO methods + !procedure :: AdditionalOutput => AdditionalOutput_GFDLES3D_t + + ! Pre-tendency methods + procedure :: CalculateDiagnostics => CalculateDiagnostics_GFDLES3D_t + procedure :: ConservativeToPrimitive => ConservativeToPrimitive_GFDLES3D_t + procedure :: SetPrimitiveBoundaryCondition => setprimitiveboundarycondition_GFDLES3D_t + procedure :: PreTendency => PreTendency_GFDLES3D_t + + ! Model method overrides + procedure :: hbc2d_NoNormalFlow => hbc2d_NoNormalFlow_GFDLES3D_t + procedure :: pbc2d_NoNormalFlow => pbc2d_NoNormalFlow_GFDLES3D_t + + procedure :: SourceMethod => sourcemethod_GFDLES3D_t + procedure :: entropy_func => entropy_func_GFDLES3D_t + procedure :: flux3D => flux3D_GFDLES3D_t + procedure :: riemannflux3D => riemannflux3D_GFDLES3D_t + + ! Additional support methods + procedure :: ReportUserMetrics => ReportUserMetrics_GFDLES3D_t + procedure :: PrimitiveToConservative => PrimitiveToConservative_GFDLES3D_t + procedure,private :: pressure + procedure,private :: temperature + procedure,private :: speedofsound + + ! Example Initial Conditions + !procedure :: SphericalSoundWave => SphericalSoundWave_GFDLES3D_t + + endtype GFDLES3D_t + +contains + + subroutine AdditionalInit_GFDLES3D_t(this) + implicit none + class(GFDLES3D_t),intent(inout) :: this + + call this%primitive%Init(this%geometry%x%interp,this%nvar,this%mesh%nElem) + call this%primitive%AssociateGeometry(this%geometry) + call this%diagnostics%Init(this%geometry%x%interp,this%ndiagnostics,this%mesh%nElem) + + endsubroutine AdditionalInit_GFDLES3D_t + + subroutine AdditionalFree_GFDLES3D_t(this) + implicit none + class(GFDLES3D_t),intent(inout) :: this + + call this%primitive%Free() + !call this%primitiveGradient%Free() + call this%diagnostics%Free() + + endsubroutine AdditionalFree_GFDLES3D_t + + subroutine SetNumberOfVariables_GFDLES3D_t(this) + implicit none + class(GFDLES3D_t),intent(inout) :: this + + this%nvar = 5 + + endsubroutine SetNumberOfVariables_GFDLES3D_t + + subroutine SetMetadata_GFDLES3D_t(this) + implicit none + class(GFDLES3D_t),intent(inout) :: this + + call this%solution%SetName(1,"ρ") ! Density + call this%solution%SetDescription(1,"Density") ! Density + call this%solution%SetUnits(1,"kg⋅m⁻³") + + call this%solution%SetName(2,"ρu") ! x-momentum + call this%solution%SetDescription(2,"x-momentum") + call this%solution%SetUnits(2,"(kg⋅m⁻³)(m⋅s⁻¹)") + + call this%solution%SetName(3,"ρv") ! y-momentum + call this%solution%SetDescription(3,"y-momentum") + call this%solution%SetUnits(3,"(kg⋅m⁻³)(m⋅s⁻¹)") + + call this%solution%SetName(4,"ρw") ! z-momentum + call this%solution%SetDescription(4,"z-momentum") + call this%solution%SetUnits(4,"(kg⋅m⁻³)(m⋅s⁻¹)") + + call this%solution%SetName(5,"ρθ") ! Density weighted potential temperature + call this%solution%SetDescription(5,"Density weighted potential temperature") + call this%solution%SetUnits(5,"(kg⋅m⁻³)(m²⋅s⁻²)") + + call this%primitive%SetName(1,"ρ") ! Density + call this%primitive%SetDescription(1,"Density") ! Density + call this%primitive%SetUnits(1,"kg⋅m⁻³") + + call this%primitive%SetName(2,"u") ! x-velocity + call this%primitive%SetDescription(2,"x-velocity") + call this%primitive%SetUnits(2,"(m⋅s⁻¹)") + + call this%primitive%SetName(3,"v") ! y-momentum + call this%primitive%SetDescription(3,"y-velocity") + call this%primitive%SetUnits(3,"(m⋅s⁻¹)") + + call this%primitive%SetName(4,"w") ! z-momentum + call this%primitive%SetDescription(4,"z-velocity") + call this%primitive%SetUnits(4,"(m⋅s⁻¹)") + + call this%primitive%SetName(5,"θ") ! in-situ temperature + call this%primitive%SetDescription(5,"Potential temperature") + call this%primitive%SetUnits(5,"K") + + call this%diagnostics%SetName(1,"c") ! Speed of sound + call this%diagnostics%SetDescription(1,"Speed of sound") + call this%diagnostics%SetUnits(1,"m⋅s⁻¹") + + call this%diagnostics%SetName(2,"P") ! Pressure + call this%diagnostics%SetDescription(2,"Pressure") + call this%diagnostics%SetUnits(2,"kg⋅m⁻¹⋅s⁻²") + + call this%diagnostics%SetName(3,"ρK") ! kinetic energy + call this%diagnostics%SetDescription(3,"Kinetic energy") + call this%diagnostics%SetUnits(3,"(kg⋅m⁻³)(m²⋅s⁻²)") + + call this%diagnostics%SetName(4,"CFL-J") ! kinetic energy + call this%diagnostics%SetDescription(4,"CFL number using the |u|*dt/\sqrt{J}") + call this%diagnostics%SetUnits(4,"-") + + endsubroutine SetMetadata_GFDLES3D_t + + subroutine ReportUserMetrics_GFDLES3D_t(this) + !! Base method for reporting the entropy of a model + !! to stdout. Only override this procedure if additional + !! reporting is needed. Alternatively, if you think + !! additional reporting would be valuable for all models, + !! open a pull request with modifications to this base + !! method. + implicit none + class(GFDLES3D_t),intent(inout) :: this + ! Local + character(len=20) :: modelTime + character(len=20) :: minv,maxv + character(len=:),allocatable :: str + integer :: ivar + + call this%ConservativeToPrimitive() + call this%CalculateDiagnostics() + + ! Copy the time and entropy to a string + write(modelTime,"(ES16.7E3)") this%t + + do ivar = 1,this%nvar + write(maxv,"(ES16.7E3)") maxval(this%primitive%interior(:,:,:,ivar)) + write(minv,"(ES16.7E3)") minval(this%primitive%interior(:,:,:,ivar)) + + ! Write the output to STDOUT + open(output_unit,ENCODING='utf-8') + write(output_unit,'(1x, A," : ")',ADVANCE='no') __FILE__ + str = 'tᵢ ='//trim(modelTime) + write(output_unit,'(A)',ADVANCE='no') str + str = ' | min('//trim(this%primitive%meta(ivar)%name)//'), max('//trim(this%primitive%meta(ivar)%name)//') = '//minv//" , "//maxv + write(output_unit,'(A)',ADVANCE='yes') str + enddo + + do ivar = 1,this%ndiagnostics + write(maxv,"(ES16.7E3)") maxval(this%diagnostics%interior(:,:,:,ivar)) + write(minv,"(ES16.7E3)") minval(this%diagnostics%interior(:,:,:,ivar)) + + ! Write the output to STDOUT + open(output_unit,ENCODING='utf-8') + write(output_unit,'(1x,A," : ")',ADVANCE='no') __FILE__ + str = 'tᵢ ='//trim(modelTime) + write(output_unit,'(A)',ADVANCE='no') str + str = ' | min('//trim(this%diagnostics%meta(ivar)%name)//'), max('//trim(this%diagnostics%meta(ivar)%name)//') = '//minv//" , "//maxv + write(output_unit,'(A)',ADVANCE='yes') str + enddo + + endsubroutine ReportUserMetrics_GFDLES3D_t + + subroutine setprimitiveboundarycondition_GFDLES3D_t(this) + !! Boundary conditions for the solution are set to + !! 0 for the external state to provide radiation type + !! boundary conditions. + implicit none + class(GFDLES3D_t),intent(inout) :: this + ! local + integer :: i,j,k,iEl,j,e2,bcid + real(prec) :: nhat(1:3) + + do concurrent(k=1:6,iel=1:this%mesh%nElem) + + bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID + e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID + + if(e2 == 0) then + if(bcid == SELF_BC_PRESCRIBED) then + ! To do : need to set different prescribed function for the primitive variables + do j = 1,this%solution%interp%N+1 ! Loop over quadrature points + do i = 1,this%solution%interp%N+1 ! Loop over quadrature points + nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) + + this%primitive%extBoundary(i,j,k,iEl,1:this%nvar) = & + this%hbc3d_Prescribed(this%primitive%boundary(i,j,k,iEl,1:this%nvar),nhat) + enddo + enddo + + elseif(bcid == SELF_BC_RADIATION) then + ! To do : need to set different prescribed function for the primitive variables + do j = 1,this%solution%interp%N+1 ! Loop over quadrature points + do i = 1,this%solution%interp%N+1 ! Loop over quadrature points + nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) + + this%primitive%extBoundary(i,j,k,iEl,1:this%nvar) = & + this%hbc3d_Radiation(this%primitive%boundary(i,j,k,iEl,1:this%nvar),nhat) + enddo + enddo + + elseif(bcid == SELF_BC_NONORMALFLOW) then + do j = 1,this%solution%interp%N+1 ! Loop over quadrature points + do i = 1,this%solution%interp%N+1 ! Loop over quadrature points + nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) + + this%primitive%extBoundary(i,j,k,iEl,1:this%nvar) = & + this%hbc3d_NoNormalFlow(this%primitive%boundary(i,j,k,iEl,1:this%nvar),nhat) + enddo + enddo + + endif + endif + + enddo + enddo + + endsubroutine setprimitiveboundarycondition_GFDLES3D_t + subroutine PreTendency_GFDLES3D_t(this) + implicit none + class(GFDLES3D_t),intent(inout) :: this + + if(this%primitive_gradient_enabled) then + call this%ConservativeToPrimitive() + call this%primitive%BoundaryInterp() + call this%primitive%SideExchange(this%mesh) + + call this%SetPrimitiveBoundaryCondition() + + call this%primitive%AverageSides() + + ! Compute the gradient of the primitive variables + ! and store the result in the solutionGradient property. + call this%primitive%MappedDGGradient(this%solutionGradient%interior) + call this%solutionGradient%BoundaryInterp() + call this%solutionGradient%SideExchange(this%mesh) + call this%SetGradientBoundaryCondition() + call this%solutionGradient%AverageSides() + endif + + endsubroutine PreTendency_GFDLES3D_t + + subroutine CalculateDiagnostics_GFDLES3D_t(this) + implicit none + class(GFDLES3D_t),intent(inout) :: this + ! Local + integer :: i,j,k,iEl + real(prec) :: c,e,ke + real(prec) :: s(1:this%nvar) + + do concurrent(i=1:this%diagnostics%N+1,j=1:this%diagnostics%N+1, & + k=1:this%diagnostics%N+1,iel=1:this%mesh%nElem) + s(1:this%nvar) = this%solution%interior(i,j,k,iEl,1:this%nvar) + c = this%speedofsound(s) + ke = 0.5_prec*(s(2)**2+s(3)**2+s(4)**2)/s(1) ! kinetic energy (kg⋅m²⋅s⁻²) + this%diagnostics%interior(i,j,k,iEl,1) = c ! Speed of sound + this%diagnostics%interior(i,j,k,iEl,2) = this%pressure(s) ! Pressure (total) + this%diagnostics%interior(i,j,k,iEl,3) = ke ! kinetic energy + this%diagnostics%interior(i,j,k,iEl,4) = (sqrt(ke)+c)*this%dt/sqrt(this%geometry%J%interior(i,j,iEl,1)) ! CFL number + enddo + + endsubroutine CalculateDiagnostics_GFDLES3D_t + + subroutine ConservativeToPrimitive_GFDLES3D_t(this) + implicit none + class(GFDLES3D_t),intent(inout) :: this + ! Local + integer :: i,j,k,El + real(prec) :: s(1:this%nvar) + + do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & + k=1:this%diagnostics%N+1,iel=1:this%mesh%nElem) + s(1:this%nvar) = this%solution%interior(i,j,iEl,1:this%nvar) + this%primitive%interior(i,j,k,iEl,1) = s(1) ! density + this%primitive%interior(i,j,k,iEl,2) = s(2)/s(1) ! x-velocity + this%primitive%interior(i,j,k,iEl,3) = s(3)/s(1) ! y-velocity + this%primitive%interior(i,j,k,iEl,4) = s(4)/s(1) ! z-velocity + this%primitive%interior(i,j,k,iEl,5) = s(5)/s(1) ! Potential temperature + enddo + + endsubroutine ConservativeToPrimitive_GFDLES3D_t + + subroutine PrimitiveToConservative_GFDLES3D_t(this) + implicit none + class(GFDLES3D_t),intent(inout) :: this + ! Local + integer :: i,j,k,El + real(prec) :: s(1:this%nvar) + + do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & + k=1:this%diagnostics%N+1,iel=1:this%mesh%nElem) + s(1:this%nvar) = this%primitive%interior(i,j,iEl,1:this%nvar) + this%solution%interior(i,j,k,iEl,1) = s(1) ! density + this%solution%interior(i,j,k,iEl,2) = s(2)*s(1) ! x-momentum + this%solution%interior(i,j,k,iEl,3) = s(3)*s(1) ! y-momentum + this%solution%interior(i,j,k,iEl,4) = s(4)*s(1) ! z-momentum + this%solution%interior(i,j,k,iEl,5) = s(5)*s(1) ! Density weighted Potential temperature + enddo + + endsubroutine PrimitiveToConservative_GFDLES3D_t + + pure function entropy_func_GFDLES3D_t(this,s) result(e) + !! The entropy function is the sum of kinetic and internal energy + !! For the linear model, this is + !! + !! \begin{equation} + !! e = \frac{1}{2} \left( \rho_0*( u^2 + v^2 ) + \frac{P^2}{\rho_0 c^2} \right) + class(GFDLES3D_t),intent(in) :: this + real(prec),intent(in) :: s(1:this%nvar) + real(prec) :: e + ! Local + real(prec) :: ke,ie,pe + + ke = 0.5_prec*(s(2)*s(2)+s(3)*(3)+s(4)*s(4))/s(1) ! kinetic energy + !pe = s(1)*this%g*z Potential energy + ie = this%Cv*s(5)*(this%pressure(s)/this%p0)**(this%R/this%Cp) ! internal energy = rho*Cv*T + + e = ke+e + endfunction entropy_func_GFDLES3D_t + + ! pure function hbc3D_NoNormalFlow_GFDLES3D_t(this,s,nhat) result(exts) + ! class(GFDLES3D_t),intent(in) :: this + ! real(prec),intent(in) :: s(1:this%nvar) + ! real(prec),intent(in) :: nhat(1:2) + ! real(prec) :: exts(1:this%nvar) + ! ! Local + ! integer :: ivar + + ! exts(1) = s(1) ! density + ! exts(2) = (nhat(2)**2-nhat(1)**2)*s(2)-2.0_prec*nhat(1)*nhat(2)*s(3) ! u + ! exts(3) = (nhat(1)**2-nhat(2)**2)*s(3)-2.0_prec*nhat(1)*nhat(2)*s(2) ! v + ! exts(4) = (nhat(1)**2-nhat(2)**2)*s(3)-2.0_prec*nhat(1)*nhat(2)*s(2) ! w + ! exts(5) = s(4) ! p + + ! endfunction hbc3D_NoNormalFlow_GFDLES3D_t + + pure function pressure(this,s) result(p) + class(GFDLES3D_t),intent(in) :: this + real(prec),intent(in) :: s(1:this%nvar) + real(prec) :: p + + p = (this%R*s(5)*(this%p0)**(-this%R/this%Cp))**(this%gamma) + + endfunction pressure + + ! pure function temperature(this, s) result(t) + ! class(GFDLES3D_t), intent(in) :: this + ! real(prec), intent(in) :: s(1:this%nvar) + ! real(prec) :: t + + ! t = (s(4) - 0.5_prec*(s(2)**2 + s(3)**2)/s(1))/(s(1)*this%Cv) ! temperature = e/Cv + + ! end function temperature + + pure function speedofsound(this,s) result(c) + class(GFDLES3D_t),intent(in) :: this + real(prec),intent(in) :: s(1:this%nvar) + real(prec) :: c + + c = sqrt(this%gamma*this%pressure(s)/s(1)) + + endfunction speedofsound + + pure function flux3d_GFDLES3D_t(this,s,dsdx) result(flux) + class(GFDLES3D_t),intent(in) :: this + real(prec),intent(in) :: s(1:this%nvar) + real(prec),intent(in) :: dsdx(1:this%nvar,1:2) + real(prec) :: flux(1:this%nvar,1:2) + ! Local + real(prec) :: p,nu,kappa,u,v,w + real(prec) :: tau_11,tau_12,tau_13 + real(prec) :: tau_22,tau_23 + real(prec) :: tau_33 + + ! Computes the pressure for an ideal gas + p = this%pressure(s) + u = s(2)/s(1) + v = s(3)/s(1) + w = s(4)/s(1) + ! LEFT OFF HERE !! + flux(1,1) = s(2) ! density, x flux ; rho*u + flux(1,2) = s(3) ! density, y flux ; rho*v + flux(2,1) = s(2)*u+p ! x-momentum, x flux; \rho*u*u + p + flux(2,2) = s(2)*v ! x-momentum, y flux; \rho*u*v + flux(3,1) = s(2)*u ! y-momentum, x flux; \rho*v*u + flux(3,2) = s(3)*v+p ! y-momentum, y flux; \rho*v*v + p + flux(4,1) = (s(4)+p)*s(2)/s(1) ! total energy, x flux : (\rho*E + p)*u + flux(4,2) = (s(4)+p)*s(3)/s(1) ! total energy, y flux : (\rho*E + p)*v + + if(this%primitive_gradient_enabled) then + ! Viscous and difussive terms + ! Recall that the solutionGradient now contains + ! the primitive variable gradients + ! Calculate the stress tensor + nu = this%nu + kappa = this%kappa + tau_11 = 4.0_prec*dsdx(2,1)/3.0_prec-2.0_prec*dsdx(3,2)/3.0_prec + tau_12 = dsdx(2,2)+dsdx(3,1) + !tau_21 = tau_12 + tau_22 = 4.0_prec*dsdx(3,2)/3.0_prec-2.0_prec*dsdx(2,1)/3.0_prec + + flux(2,1) = flux(2,1)-nu*tau_11 ! x-momentum, x flux + flux(2,2) = flux(2,2)-nu*tau_12 ! x-momentum, y flux (-tau_21*nu = -tau_12*nu) + flux(3,1) = flux(3,1)-nu*tau_12 ! y-momentum, x flux + flux(3,2) = flux(3,2)-nu*tau_22 ! y-momentum, y flux + flux(4,1) = flux(4,1)-(kappa*dsdx(4,1)+u*tau_11+v*tau_12) ! total energy, x flux = -(kappa*dTdx + u*tau_11 + v*tau_12) + flux(4,2) = flux(4,2)-(kappa*dsdx(4,2)+u*tau_11+v*tau_12) ! total energy, y flux = -(kappa*dTdy + u*tau_12 + v*tau_22) + endif + + endfunction flux3d_GFDLES3D_t + + pure function riemannflux3D_GFDLES3D_t(this,sL,sR,dsdx,nhat) result(flux) + !! Uses a local lax-friedrich's upwind flux + !! The max eigenvalue is taken as the sound speed + class(GFDLES3D_t),intent(in) :: this + real(prec),intent(in) :: sL(1:this%nvar) + real(prec),intent(in) :: sR(1:this%nvar) + real(prec),intent(in) :: dsdx(1:this%nvar,1:3) + real(prec),intent(in) :: nhat(1:3) + real(prec) :: flux(1:this%nvar) + ! Local + real(prec) :: fL(1:this%nvar) + real(prec) :: fR(1:this%nvar) + real(prec) :: u,v,w,p,c,rho0 + + u = sL(2) + v = sL(3) + w = sL(4) + p = sL(5) + rho0 = this%rho0 + c = this%c + fL(1) = rho0*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! density + fL(2) = p*nhat(1)/rho0 ! u + fL(3) = p*nhat(2)/rho0 ! v + fL(4) = p*nhat(3)/rho0 ! w + fL(5) = rho0*c*c*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! pressure + + u = sR(2) + v = sR(3) + w = sR(4) + p = sR(5) + fR(1) = rho0*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! density + fR(2) = p*nhat(1)/rho0 ! u + fR(3) = p*nhat(2)/rho0 ! v' + fR(4) = p*nhat(3)/rho0 ! w + fR(5) = rho0*c*c*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! pressure + + flux(1:5) = 0.5_prec*(fL(1:5)+fR(1:5))+c*(sL(1:5)-sR(1:5)) + + endfunction riemannflux3D_GFDLES3D_t + + subroutine SphericalSoundWave_GFDLES3D_t(this,rhoprime,Lr,x0,y0,z0) + !! This subroutine sets the initial condition for a weak blast wave + !! problem. The initial condition is given by + !! + !! \begin{equation} + !! \begin{aligned} + !! \rho &= \rho_0 + \rho' \exp\left( -\ln(2) \frac{(x-x_0)^2 + (y-y_0)^2}{L_r^2} \right) + !! u &= 0 \\ + !! v &= 0 \\ + !! E &= \frac{P_0}{\gamma - 1} + E \exp\left( -\ln(2) \frac{(x-x_0)^2 + (y-y_0)^2}{L_e^2} \right) + !! \end{aligned} + !! \end{equation} + !! + implicit none + class(GFDLES3D_t),intent(inout) :: this + real(prec),intent(in) :: rhoprime,Lr,x0,y0,z0 + ! Local + integer :: i,j,k,iEl + real(prec) :: x,y,z,rho,r,E + + print*,__FILE__," : Configuring weak blast wave initial condition. " + print*,__FILE__," : rhoprime = ",rhoprime + print*,__FILE__," : Lr = ",Lr + print*,__FILE__," : x0 = ",x0 + print*,__FILE__," : y0 = ",y0 + print*,__FILE__," : z0 = ",z0 + + do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & + k=1:this%solution%N+1,iel=1:this%mesh%nElem) + x = this%geometry%x%interior(i,j,k,iEl,1,1)-x0 + y = this%geometry%x%interior(i,j,k,iEl,1,2)-y0 + z = this%geometry%x%interior(i,j,k,iEl,1,3)-z0 + r = sqrt(x**2+y**2+z**2) + + rho = (rhoprime)*exp(-log(2.0_prec)*r**2/Lr**2) + + this%solution%interior(i,j,k,iEl,1) = rho + this%solution%interior(i,j,k,iEl,2) = 0.0_prec + this%solution%interior(i,j,k,iEl,3) = 0.0_prec + this%solution%interior(i,j,k,iEl,4) = 0.0_prec + this%solution%interior(i,j,k,iEl,5) = rho*this%c*this%c + + enddo + + call this%ReportMetrics() + call this%solution%UpdateDevice() + + endsubroutine SphericalSoundWave_GFDLES3D_t + + endmodule self_GFDLES3D_t diff --git a/src/cpu/SELF_GFDLES3D.f90 b/src/cpu/SELF_GFDLES3D.f90 new file mode 100644 index 000000000..62102d1f2 --- /dev/null +++ b/src/cpu/SELF_GFDLES3D.f90 @@ -0,0 +1,36 @@ +! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! +! +! Maintainers : support@fluidnumerics.com +! Official Repository : https://github.com/FluidNumerics/self/ +! +! Copyright © 2024 Fluid Numerics LLC +! +! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in +! the documentation and/or other materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from +! this software without specific prior written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! + +module self_LinearEuler3D + + use self_LinearEuler3D_t + + implicit none + + type,extends(LinearEuler3D_t) :: LinearEuler3D + endtype LinearEuler3D + +endmodule self_LinearEuler3D diff --git a/src/gpu/SELF_GFDLES3D.f90 b/src/gpu/SELF_GFDLES3D.f90 new file mode 100644 index 000000000..76190a383 --- /dev/null +++ b/src/gpu/SELF_GFDLES3D.f90 @@ -0,0 +1,151 @@ +! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! +! +! Maintainers : support@fluidnumerics.com +! Official Repository : https://github.com/FluidNumerics/self/ +! +! Copyright © 2024 Fluid Numerics LLC +! +! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in +! the documentation and/or other materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from +! this software without specific prior written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! + +module self_LinearEuler3D + + use self_LinearEuler3D_t + + implicit none + + type,extends(LinearEuler3D_t) :: LinearEuler3D + contains + procedure :: setboundarycondition => setboundarycondition_LinearEuler3D + procedure :: boundaryflux => boundaryflux_LinearEuler3D + procedure :: fluxmethod => fluxmethod_LinearEuler3D + + endtype LinearEuler3D + + interface + subroutine setboundarycondition_LinearEuler3D_gpu(extboundary,boundary,sideinfo,nhat,N,nel) & + bind(c,name="setboundarycondition_LinearEuler3D_gpu") + use iso_c_binding + type(c_ptr),value :: extboundary,boundary,sideinfo,nhat + integer(c_int),value :: N,nel + endsubroutine setboundarycondition_LinearEuler3D_gpu + endinterface + + interface + subroutine fluxmethod_LinearEuler3D_gpu(solution,flux,rho0,c,N,nel,nvar) & + bind(c,name="fluxmethod_LinearEuler3D_gpu") + use iso_c_binding + use SELF_Constants + type(c_ptr),value :: solution,flux + real(c_prec),value :: rho0,c + integer(c_int),value :: N,nel,nvar + endsubroutine fluxmethod_LinearEuler3D_gpu + endinterface + + interface + subroutine boundaryflux_LinearEuler3D_gpu(fb,fextb,nhat,nscale,flux,rho0,c,N,nel) & + bind(c,name="boundaryflux_LinearEuler3D_gpu") + use iso_c_binding + use SELF_Constants + type(c_ptr),value :: fb,fextb,flux,nhat,nscale + real(c_prec),value :: rho0,c + integer(c_int),value :: N,nel + endsubroutine boundaryflux_LinearEuler3D_gpu + endinterface + +contains + + subroutine boundaryflux_LinearEuler3D(this) + implicit none + class(LinearEuler3D),intent(inout) :: this + + call boundaryflux_LinearEuler3D_gpu(this%solution%boundary_gpu, & + this%solution%extBoundary_gpu, & + this%geometry%nhat%boundary_gpu, & + this%geometry%nscale%boundary_gpu, & + this%flux%boundarynormal_gpu, & + this%rho0,this%c,this%solution%interp%N, & + this%solution%nelem) + + endsubroutine boundaryflux_LinearEuler3D + + subroutine fluxmethod_LinearEuler3D(this) + implicit none + class(LinearEuler3D),intent(inout) :: this + + call fluxmethod_LinearEuler3D_gpu(this%solution%interior_gpu, & + this%flux%interior_gpu, & + this%rho0,this%c,this%solution%interp%N,this%solution%nelem, & + this%solution%nvar) + + endsubroutine fluxmethod_LinearEuler3D + + subroutine setboundarycondition_LinearEuler3D(this) + !! Boundary conditions are set to periodic boundary conditions + implicit none + class(LinearEuler3D),intent(inout) :: this + ! local + integer :: i,iEl,j,k,e2,bcid + real(prec) :: x(1:3) + + if(this%prescribed_bcs_enabled) then + call gpuCheck(hipMemcpy(c_loc(this%solution%extboundary), & + this%solution%extboundary_gpu,sizeof(this%solution%extboundary), & + hipMemcpyDeviceToHost)) + + ! Prescribed boundaries are still done on the CPU + do iEl = 1,this%solution%nElem ! Loop over all elements + do k = 1,6 ! Loop over all sides + + bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID + e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID + + if(e2 == 0) then + if(bcid == SELF_BC_PRESCRIBED) then + + do j = 1,this%solution%interp%N+1 ! Loop over quadrature points + do i = 1,this%solution%interp%N+1 ! Loop over quadrature points + x = this%geometry%x%boundary(i,j,k,iEl,1,1:3) + + this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & + this%hbc3D_Prescribed(x,this%t) + enddo + enddo + + endif + endif + + enddo + enddo + + call gpuCheck(hipMemcpy(this%solution%extBoundary_gpu, & + c_loc(this%solution%extBoundary), & + sizeof(this%solution%extBoundary), & + hipMemcpyHostToDevice)) + endif + call setboundarycondition_LinearEuler3D_gpu(this%solution%extboundary_gpu, & + this%solution%boundary_gpu, & + this%mesh%sideInfo_gpu, & + this%geometry%nhat%boundary_gpu, & + this%solution%interp%N, & + this%solution%nelem) + + endsubroutine setboundarycondition_LinearEuler3D + +endmodule self_LinearEuler3D From 76b367ca8748b56a768759a0d24241e463b62a1b Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Tue, 4 Feb 2025 09:40:41 -0500 Subject: [PATCH 02/17] Draft json configs and interface for python --- CMakeLists.txt | 12 +- pyself/SELF_Model_Interface.f90 | 252 +++++++++++++ share/input.json | 58 +++ share/self.json | 531 ++++++++++++++++++++++++++ src/CMakeLists.txt | 26 +- src/SELF_GFDLES3D_t.f90 | 564 ++++++++++++++-------------- src/SELF_LinearShallowWater2D_t.f90 | 6 + src/cpu/SELF_GFDLES3D.f90 | 10 +- src/gpu/SELF_GFDLES3D.f90 | 234 ++++++------ src/json/CMakeLists.txt | 82 ++++ src/json/SELF_JSON_Config.f90 | 263 +++++++++++++ 11 files changed, 1629 insertions(+), 409 deletions(-) create mode 100644 pyself/SELF_Model_Interface.f90 create mode 100644 share/input.json create mode 100644 share/self.json create mode 100644 src/json/CMakeLists.txt create mode 100644 src/json/SELF_JSON_Config.f90 diff --git a/CMakeLists.txt b/CMakeLists.txt index e63bdea3a..9f76cde71 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -131,9 +131,9 @@ find_package(MPI COMPONENTS Fortran C REQUIRED) # HDF5 : See https://cmake.org/cmake/help/latest/module/FindHDF5.html find_package(HDF5 REQUIRED Fortran) -# # JSON-Fortran -# find_library(JSONFORTRAN_LIBRARIES NAMES jsonfortran REQUIRED) -# find_path(JSONFORTRAN_INCLUDE_DIRS json_module.mod) +# JSON-Fortran +find_library(JSONFORTRAN_LIBRARIES NAMES jsonfortran OPTIONAL) +find_path(JSONFORTRAN_INCLUDE_DIRS json_module.mod) # FEQ-Parse @@ -225,7 +225,6 @@ endif() # Libraries add_subdirectory(${CMAKE_SOURCE_DIR}/src) -# link_directories(${CMAKE_BINARY_DIR}/src) if(SELF_ENABLE_TESTING) enable_testing() @@ -241,3 +240,8 @@ else() endif() +# Share / etc resources +install(DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}/share DESTINATION ${CMAKE_INSTALL_PREFIX}) + + + diff --git a/pyself/SELF_Model_Interface.f90 b/pyself/SELF_Model_Interface.f90 new file mode 100644 index 000000000..7a4fa1dac --- /dev/null +++ b/pyself/SELF_Model_Interface.f90 @@ -0,0 +1,252 @@ + +module SELF_ModelInterface + + ! Core + use SELF_Constants + use SELF_SupportRoutines + use SELF_Mesh + use SELF_Geometry_1D + use SELF_Geometry_2D + use SELF_Geometry_3D + use SELF_MappedData + use SELF_JSON_Config + + ! Models + use SELF_Model + !use SELF_DGModel1D + use SELF_DGModel2D + ! use SELF_DGModel3D + use self_LinearShallowWater2D + + ! External + use iso_fortran_env +! use HDF5 +! use FEQParse + + implicit none + + !type(SELFConfig) :: config + type(Lagrange),target,private :: interp + !type(MPILayer),target :: decomp + + class(Model),pointer,private :: selfModel + class(SEMMesh),pointer,private :: selfMesh + !class(SEMGeometry),pointer,private :: selfGeometry + + ! Mesh + ! type(Mesh1D),target,private :: selfMesh1D + type(Mesh2D),target,private :: selfMesh2D + + ! Geometry + ! type(Geometry1D),target,private :: selfGeometry1D + type(SEMQuad),target,private :: selfGeometry2D + + ! Models + ! type(Burgers1D),target,private :: selfBurgers1D + ! type(CompressibleIdealGas2D),target,private :: selfCompressibleIdealGas2D + type(LinearShallowWater2D),target,private :: selfLinearShallowWater2D + + integer,parameter,private :: MODEL_NAME_LENGTH = 50 + + ! TO DO : Set character length + character(LEN=),private :: model_configuration_file + public :: Initialize,ForwardStep,WritePickupFile, !GetSolution, Finalize + private :: GetBCFlagForChar,Init2DWorkspace,UpdateParameters,InitLinearShallowWater2D + +contains + + function GetBCFlagForChar(charFlag) result(intFlag) + !! This method is used to return the integer flag from a char for boundary conditions + !! + implicit none + character(*),intent(in) :: charFlag + integer :: intFlag + + select case(UpperCase(trim(charFlag))) + + case("PRESCRIBED") + intFlag = SELF_BC_PRESCRIBED + + case("RADIATION") + intFlag = SELF_BC_RADIATION + + case("NO_NORMAL_FLOW") + intFlag = SELF_BC_NONORMALFLOW + + case DEFAULT + intFlag = 0 + + endselect + + endfunction GetBCFlagForChar + subroutine Initialize(config_file) + implicit none + character(LEN=*),intent(in) :: config_file + ! local + character(LEN=MODEL_NAME_LENGTH) :: modelname + + call config%Init(config_file) + model_configuration_file = config_file + + ! Select the model + select case(trim(modelname)) + + case("linear-shallow-water-2d") + + call Init2DWorkspace() + call InitLinearShallowWater2D() + + case default + endselect + + endsubroutine Initialize + + subroutine Init2DWorkspace() + implicit none + ! Local + logical :: mpiRequested + character(LEN=self_QuadratureTypeCharLength) :: qChar + character(LEN=MODEL_NAME_LENGTH) :: meshfile + character(LEN=MODEL_NAME_LENGTH) :: uniformBoundaryCondition + integer :: controlQuadrature + integer :: controlDegree + integer :: targetDegree + integer :: targetQuadrature + integer :: bcFlag + + call config%Get("geometry.control_degree",controlDegree) + call config%Get("geometry.target_degree",targetDegree) + call config%Get("geometry.control_quadrature",qChar) + controlQuadrature = GetIntForChar(trim(qChar)) + call config%Get("geometry.target_quadrature",qChar) + targetQuadrature = GetIntForChar(trim(qChar)) + call config%Get("geometry.mesh_file",meshfile) + call config%Get("geometry.uniform_boundary_condition",uniformBoundaryCondition) + bcFlag = GetBCFlagForChar(uniformBoundaryCondition) + + INFO("Mesh file : "//trim(meshfile)) + ! Read in mesh file and set the public mesh pointer to selfMesh2D + call selfMesh2D%Read_HOPr(trim(meshfile)) + call mesh%ResetBoundaryConditionType(bcFlag) + + selfMesh => selfMesh2D + + ! Create an interpolant + call interp%Init(controlDegree, & + controlQuadrature, & + targetDegree, & + targetQuadrature) + + ! Generate geometry (metric terms) from the mesh elements + call selfGeometry2D%Init(interp,selfMesh2D%nElem) + call selfGeometry2D%GenerateFromMesh(selfMesh2D) + +! selfGeometry => selfGeometry2D + + endsubroutine Init2DWorkspace + + subroutine InitLinearShallowWater2D() + implicit none + + print*,"Model set to Linear Shallow Water (2D)" + + call selfLinearShallowWater2D%Init(selfMesh2D,selfGeometry2D) + selfLinearShallowWater2D%prescribed_bcs_enabled = .false. ! Disables prescribed boundary condition block for gpu accelerated implementations + selfLinearShallowWater2D%tecplot_enabled = .false. ! Disables tecplot output + + call UpdateParameters() + + selfModel => selfLinearShallowWater2D + + endsubroutine InitLinearShallowWater2D + + subroutine WritePickupFile() + implicit none + + select type(selfModel) + + type is(LinearShallowWater2D) + call selfModel%WriteModel() + + endselect + endsubroutine WritePickupFile + + subroutine UpdateParameters() + implicit none + + call config%Free() + call config%Init(model_configuration_file) + select type(selfModel) + + type is(LinearShallowWater2D) + + call config%Get("linear-shallow-water-2d.environment.g", & + selfLinearShallowWater2D%g) + + call config%Get("linear-shallow-water-2d.environment.H", & + selfLinearShallowWater2D%H) + + call config%Get("linear-shallow-water-2d.environment.Cd", & + selfLinearShallowWater2D%Cd) + + call config%Get("linear-shallow-water-2d.environment.f0", & + selfLinearShallowWater2D%f0) + + call config%Get("linear-shallow-water-2d.environment.beta", & + selfLinearShallowWater2D%beta) + + endselect + + endsubroutine UpdateParameters + + subroutine ForwardStep() + implicit none + + real(prec) :: dt + real(prec) :: targetTime + integer :: updateInterval + + ! Reload config + call UpdateParameters() + + call config%Get("time_options.io_interval",ioInterval) + call config%Get("time_options.dt",dt) + + this%dt = dt + targetTime = this%t+dt*real(updateInterval,prec) + call this%timeIntegrator(targetTime) + this%t = targetTime + + endsubroutine ForwardStep + +endmodule SELF_Model_Interface + +! program SELF + +! use SELF_Main + +! implicit none +! ! Public + +! call InitializeSELF() + +! ! Show us which model we're running +! call selfModel % PrintType() + +! ! Set the model initial conditions +! call selfModel % SetInitialConditions(config) + +! ! Do the initial file IO +! call FileIO() +! ! Main time integration loop +! call MainLoop() +! ! Do the last file IO +! call FileIO() + +! ! Clean up [TO DO] +! ! CALL selfModel % Free() +! ! CALL selfGeometry % Free() +! ! CALL selfMesh % Free() +! ! CALL interp % Free() + +endmodule SELF_Model_Interface diff --git a/share/input.json b/share/input.json new file mode 100644 index 000000000..5ee835612 --- /dev/null +++ b/share/input.json @@ -0,0 +1,58 @@ +{ + "version": "v0.0.0", + "model_name": "linear-shallow-water-2d", + "geometry": { + "mesh_file": "mesh/Circle/Circle_mesh.h5", + "control_degree": 7, + "control_quadrature": "gauss", + "target_degree": 16, + "target_quadrature": "uniform", + "uniform_boundary_condition":"no_normal_flow" + }, + "time_options": { + "integrator": "rk3", + "dt": 0.0025, + "cfl_max": 0.0, + "start_time": 0.0, + "duration": 30.0, + "io_interval": 0.05, + "update_interval": 50 + }, + "units": { + "time": "s", + "length": "m", + "mass": "kg" + }, + "linear-shallow-water-2d": { + "environment": { + "g": 1.0, + "H": 1.0, + "Cd": 0.25, + "f0": 10.0, + "beta": 0.0 + }, + "initial_conditions": { + "geostrophic_balance": false, + "static_state": true, + "file": "", + "u": "", + "v": "", + "eta": "" + }, + "boundary_conditions": { + "time_dependent": false, + "dt": 0.0, + "file": "", + "from_initial_conditions": false, + "u": "", + "v": "", + "eta": "" + }, + "impulse_source_term": { + "amplitude": [0.0], + "spatial_width": [0.0], + "xc": [0.0], + "yc": [0.0] + } + } +} \ No newline at end of file diff --git a/share/self.json b/share/self.json new file mode 100644 index 000000000..632a3991e --- /dev/null +++ b/share/self.json @@ -0,0 +1,531 @@ +{ + "$schema": "http://json-schema.org/draft-07/schema", + "$id": "blank", + "title": "SELF Model Configuration", + "description": "Schema for conservation law solvers with the Spectral Element Library in Fortran", + "type": "object", + "properties": { + "version": { + "description": "Version of SELF associated with this schema", + "type": "string", + "default": "v0.0.0" + }, + "model_name": { + "description": "Name of the model to run with", + "type": "string", + "enum": [ + "burgers-1d", + "linear-shallow-water-2d", + "gfdles-3d" + ] + }, + "geometry": { + "description": "Configurations related to the mesh and quadrature", + "type": "object", + "properties": { + "mesh_file": { + "description": "Fully qualified path to a mesh file.", + "type": "string", + "default": "" + }, + "uniform_boundary_condition": { + "description": "If provided, all boundary conditions will be set to this value.", + "type": "string", + "default": "", + "enum": [ + "", + "no_normal_flow", + "radiation", + "prescribed" + ] + }, + "control_degree": { + "description": "Polynomial degree for the control grid quadrature.", + "type": "integer", + "default": 7 + }, + "control_quadrature": { + "description": "The quadrature type for the control points.", + "type": "string", + "enum": [ + "gauss", + "gauss-lobatto", + "chebyshev-gauss", + "chebyshev-gauss-lobatto" + ], + "default": "gauss" + }, + "target_degree": { + "description": "Polynomial degree for the target grid quadrature.", + "type": "integer", + "default": 10 + }, + "target_quadrature": { + "description": "The quadrature type for the target points.", + "type": "string", + "enum": [ + "uniform", + "gauss", + "gauss-lobatto", + "chebyshev-gauss", + "chebyshev-gauss-lobatto" + ], + "default": "uniform" + }, + "nX": { + "description": "Number of points in the x-direction for structured grid generation.", + "type": "integer", + "default": 3 + }, + "nY": { + "description": "Number of points in the y-direction for structured grid generation.", + "type": "integer", + "default": 3 + }, + "x0": { + "description": "First point in the x-direction for structured grid generation.", + "type": "number", + "default": 0 + }, + "xN": { + "description": "Last point in the x-direction for structured grid generation.", + "type": "number", + "default": 1 + }, + "y0": { + "description": "First point in the y-direction for structured grid generation.", + "type": "number", + "default": 0 + }, + "yN": { + "description": "Last point in the y-direction for structured grid generation.", + "type": "number", + "default": 0 + } + } + }, + "time_options": { + "description": "Configuration for the time integration.", + "type": "object", + "properties": { + "integrator": { + "description": "Type of time integrator to use to forward step the model.", + "type": "string", + "enum": [ + "euler", + "rk2", + "rk3", + "rk4" + ], + "default": "euler" + }, + "dt": { + "type": "number", + "minimum": 0, + "description": "The size of the time step for a time integrator expressed in units.time ." + }, + "cfl_max": { + "type": "number", + "minimum": 0, + "description": "The maximum CFL number for time integration. If non-zero, dt will be calculated using cfl_max and the mesh." + }, + "start_time": { + "description": "The value for the initial time in units.time .", + "type": "number", + "minimum": 0 + }, + "duration": { + "description": "The length of the simulation in units.time .", + "type": "number", + "minimum": 0 + }, + "io_interval": { + "description": "The amount of time between model state ouput in units.time . If set to 0, only the first and last state will be output.", + "type": "number", + "minimum": 0 + }, + "update_interval": { + "description": "The number of time steps between model parameter updates. (For interactivity)", + "type": "number", + "minimum": 50 + } + } + }, + "units": { + "description": "", + "type": "object", + "properties": { + "time": { + "description": "The units for time", + "type": "string", + "enum": [ + "ns", + "ms", + "s", + "Ks", + "Ms", + "Gs" + ], + "default": "s" + }, + "length": { + "description": "The units for length", + "type": "string", + "enum": [ + "nm", + "mm", + "cm", + "m", + "Km" + ], + "default": "m" + }, + "mass": { + "description": "The units for mass", + "type": "string", + "enum": [ + "mg", + "g", + "kg" + ], + "default": "kg" + } + } + }, + "burgers-1d": { + "description": "Parameters for the burgers 1d solver", + "type": "object", + "properties": { + "u0": { + "type": "string", + "description": "Initial condition.", + "default": "u=0" + }, + "uL": { + "type": "string", + "description": "Left boundary condition.", + "default": "u=0" + }, + "uR": { + "type": "string", + "description": "Right boundary condition.", + "default": "u=0" + }, + "uxL": { + "type": "string", + "description": "Left boundary condition for the gradient.", + "default": "u=0" + }, + "uxR": { + "type": "string", + "description": "Right boundary condition for the gradient.", + "default": "u=0" + }, + "viscosity": { + "type": "number", + "description": "Viscosity of the fluid.", + "default": "u=0" + } + } + }, + "gfdles-3d": { + "description": "Parameters for the compressible navier-stokes (2d) solver", + "type": "object", + "properties": { + "sgs_closure": { + "description": "Parameters for sub-grid scale closure", + "type": "object", + "properties": { + "model": { + "description": "The SGS model to use for closure", + "type": "string", + "enum": [ + "none", + "constant_del2" + ], + "default": "constant_del2" + }, + "gradient_variables": { + "description": "The type of variables to use for gradient calculations for SGS fluxes", + "type": "string", + "enum": [ + "conservative", + "primitive", + "entropy" + ], + "default": "primitive" + } + } + }, + "split_form": { + "description": "The formulation of the hyperbolic fluxes to use", + "type": "string", + "enum": [ + "conservative" + ], + "default": "conservative" + }, + "environment": { + "description": "Settings for environmental parameters", + "type": "object", + "properties": { + "potential": { + "description": "An equation that describes the potential force. The gradient of this field is the potential force in the momentum equations", + "type": "string", + "default": "" + } + } + }, + "fluid": { + "description": "Settings for fluid parameters", + "type": "object", + "properties": { + "Cp": { + "description": "Heat capacity at constant pressure", + "type": "number", + "default": 1.005 + }, + "Cv": { + "description": "Heat capacity at constant volume", + "type": "number", + "default": 0.718 + }, + "R": { + "description": "Ideal gas constant", + "type": "number", + "default": 287 + }, + "rho": { + "description": "Default density", + "type": "number", + "default": 1.2754 + }, + "T": { + "description": "Default temperature", + "type": "number", + "default": 273 + }, + "energy": { + "description": "Default internal energy", + "type": "number", + "default": 117526.5 + }, + "equation_of_state": { + "description": "Equation of state", + "type": "string", + "enum": [ + "ideal_gas", + "linear_gibbs_seawater" + ], + "default": "ideal_gas" + }, + "viscosity": { + "description": "The constant value of the dynamic viscosity expressed using units consistent with units attributes", + "type": "number", + "default": 0 + }, + "thermal_diffusivity": { + "description": "The constant value of the thermal diffusivity expressed using units consistent with units attributes", + "type": "number", + "default": 0 + } + } + }, + "initial_conditions": { + "description": "Settings for the fluid initial conditions. Assumes primitive variables are set.", + "type": "object", + "properties": { + "hydrostatic_adjustment": { + "type": "boolean", + "description": "Enable hydrostatic adjustment before starting forward integration.", + "default": false + }, + "static_state": { + "type": "boolean", + "description": "Set the fluid state to the static parameters in fluid attribute at the beginning. If set to true, supplied equations or fields from file are added to the static state.", + "default": false + }, + "file": { + "type": "string", + "description": "File to read initial conditions from. Assumes conservative variables are defined in the file.", + "default": "" + }, + "u": { + "type": "string", + "description": "Equation for the x-velocity component initial condition.", + "default": "u=0" + }, + "v": { + "type": "string", + "description": "Equation for the y-velocity component initial condition.", + "default": "v=0" + }, + "rho": { + "type": "string", + "description": "Equation for the density field initial condition.", + "default": "r=0" + }, + "T": { + "type": "string", + "description": "Equation for the temperature field initial condition.", + "default": "u=0" + } + } + }, + "boundary_conditions": { + "description": "Settings for prescribed fluid boundary conditions. Assumes primitive variables are set.", + "type": "object", + "properties": { + "time_dependent": { + "type": "boolean", + "description": "Enable time dependent boundary conditions.", + "default": false + }, + "dt": { + "type": "number", + "description": "The time interval at which the boundary conditions are re-evaluated. Linear interpolation is done in-between.", + "default": 0 + }, + "from_initial_conditions": { + "type": "boolean", + "description": "Obtain the boundary conditions from the initial conditions.", + "default": false + }, + "u": { + "type": "string", + "description": "Equation for the x-velocity component.", + "default": "u=0" + }, + "v": { + "type": "string", + "description": "Equation for the y-velocity component.", + "default": "v=0" + }, + "rho": { + "type": "string", + "description": "Equation for the density field.", + "default": "r=0" + }, + "T": { + "type": "string", + "description": "Equation for the temperature field.", + "default": "u=0" + } + } + } + } + }, + "linear-shallow-water-2d": { + "description": "Parameters for the linear-shallow-water-2d solver", + "type": "object", + "properties": { + "environment": { + "description": "Settings for environmental parameters", + "type": "object", + "properties": { + "g": { + "description": "Acceleration of gravity", + "type": "number", + "default": 1.0 + }, + "H": { + "description": "Resting fluid depth (constant)", + "type": "number", + "default": 1.0 + }, + "Cd": { + "description": "Linear drag coefficient", + "type": "number", + "default": 0.0 + }, + "f0": { + "description": "Constant coriolis parameter", + "type": "number", + "default": 0.0 + }, + "beta": { + "description": "Rate of change of coriolis parameter with latitude (y)", + "type": "number", + "default": 0.0 + } + + } + }, + "initial_conditions": { + "description": "Settings for the fluid initial conditions.", + "type": "object", + "properties": { + "geostrophic_balance": { + "type": "boolean", + "description": "When the coriolis parameter is non-zero within the model domain, determines if the velocity fields are calculated from the free surface height.", + "default": false + }, + "file": { + "type": "string", + "description": "File to read initial conditions from. Assumes conservative variables are defined in the file.", + "default": "" + }, + "u": { + "type": "string", + "description": "Equation for the x-velocity component initial condition.", + "default": "u=0" + }, + "v": { + "type": "string", + "description": "Equation for the y-velocity component initial condition.", + "default": "v=0" + }, + "eta": { + "type": "string", + "description": "Equation for the free-surface height.", + "default": "r=0" + } + } + }, + "boundary_conditions": { + "description": "Settings for prescribed fluid boundary conditions.", + "type": "object", + "properties": { + "time_dependent": { + "type": "boolean", + "description": "Enable time dependent boundary conditions.", + "default": false + }, + "dt": { + "type": "number", + "description": "The time interval at which the boundary conditions are re-evaluated. Linear interpolation is done in-between.", + "default": 0 + }, + "from_initial_conditions": { + "type": "boolean", + "description": "Obtain the boundary conditions from the initial conditions.", + "default": false + }, + "u": { + "type": "string", + "description": "Equation for the x-velocity component.", + "default": "u=0" + }, + "v": { + "type": "string", + "description": "Equation for the y-velocity component.", + "default": "v=0" + }, + "eta": { + "type": "string", + "description": "Equation for the free surface height field", + "default": "r=0" + } + } + } + } + } + }, + "required": [ + "version", + "model_name", + "geometry", + "time_options", + "units" + ] +} \ No newline at end of file diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 6dc5ca790..4ad3a6a5a 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -41,6 +41,11 @@ endif() file(GLOB SELF_HEADERS "${CMAKE_CURRENT_SOURCE_DIR}/*.h") +if(JSONFORTRAN_LIBRARIES) + file(GLOB SELF_JSON_FSRC "${CMAKE_CURRENT_SOURCE_DIR}/json/*.f*") + file(APPEND SELF_FSRC "${SELF_JSON_FSRC}") +endif() + # Enable pre-processing for source code set_source_files_properties( ${SELF_FSRC} @@ -61,16 +66,19 @@ set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/include) add_library(self SHARED ${SELF_FSRC} ${SELF_BACKEND_CPPSRC} ${SELF_BACKEND_FSRC}) #set_target_properties(self PROPERTIES OUTPUT_NAME "self") + target_link_libraries(self PUBLIC ${FEQPARSE_LIBRARIES} HDF5::HDF5 ${MPI_Fortran_LIBRARIES} - ${BACKEND_LIBRARIES}) + ${BACKEND_LIBRARIES} + ${JSONFORTRAN_LIBRARIES}) target_include_directories(self PUBLIC ${FEQPARSE_INCLUDE_DIRS} ${HDF5_INCLUDE_DIRS} - ${MPI_Fortran_INCLUDE_DIRS}) + ${MPI_Fortran_INCLUDE_DIRS} + ${JSONFORTRAN_INCLUDE_DIRS}) target_compile_options(self PUBLIC -fPIC) @@ -82,4 +90,16 @@ install(TARGETS self LIBRARY DESTINATION lib PUBLIC_HEADER DESTINATION include) -install(DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/ DESTINATION include) \ No newline at end of file +install(DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/ DESTINATION include) + +# add_library(self-python SHARED ${SELF_FSRC} ${SELF_BACKEND_CPPSRC} ${SELF_BACKEND_FSRC}) +# target_link_libraries(self PUBLIC +# ${FEQPARSE_LIBRARIES} +# HDF5::HDF5 +# ${MPI_Fortran_LIBRARIES} +# ${BACKEND_LIBRARIES}) + +# target_include_directories(self PUBLIC +# ${FEQPARSE_INCLUDE_DIRS} +# ${HDF5_INCLUDE_DIRS} +# ${MPI_Fortran_INCLUDE_DIRS}) \ No newline at end of file diff --git a/src/SELF_GFDLES3D_t.f90 b/src/SELF_GFDLES3D_t.f90 index 0cdcd2a5b..1a341616c 100644 --- a/src/SELF_GFDLES3D_t.f90 +++ b/src/SELF_GFDLES3D_t.f90 @@ -76,6 +76,7 @@ module self_GFDLES3D_t type,extends(dgmodel3D) :: GFDLES3D_t type(MappedScalar3D) :: primitive type(MappedScalar3D) :: diagnostics + integer :: ndiagnostics ! Model parameters real(prec) :: p0 = 10.0_prec**(5) ! Reference pressure for potential temperature () @@ -87,6 +88,7 @@ module self_GFDLES3D_t real(prec) :: kappa = 0.0_prec ! Thermal diffusivity real(prec) :: g = 9.81_prec ! gravitational acceleration (z-direction only) + logical :: sgs_enabled = .false. contains ! Setup / Book-keeping methods @@ -105,10 +107,10 @@ module self_GFDLES3D_t procedure :: PreTendency => PreTendency_GFDLES3D_t ! Model method overrides - procedure :: hbc2d_NoNormalFlow => hbc2d_NoNormalFlow_GFDLES3D_t - procedure :: pbc2d_NoNormalFlow => pbc2d_NoNormalFlow_GFDLES3D_t + !procedure :: hbc2d_NoNormalFlow => hbc2d_NoNormalFlow_GFDLES3D_t + !procedure :: pbc2d_NoNormalFlow => pbc2d_NoNormalFlow_GFDLES3D_t - procedure :: SourceMethod => sourcemethod_GFDLES3D_t + !procedure :: SourceMethod => sourcemethod_GFDLES3D_t procedure :: entropy_func => entropy_func_GFDLES3D_t procedure :: flux3D => flux3D_GFDLES3D_t procedure :: riemannflux3D => riemannflux3D_GFDLES3D_t @@ -117,7 +119,7 @@ module self_GFDLES3D_t procedure :: ReportUserMetrics => ReportUserMetrics_GFDLES3D_t procedure :: PrimitiveToConservative => PrimitiveToConservative_GFDLES3D_t procedure,private :: pressure - procedure,private :: temperature + !procedure,private :: temperature procedure,private :: speedofsound ! Example Initial Conditions @@ -152,6 +154,7 @@ subroutine SetNumberOfVariables_GFDLES3D_t(this) class(GFDLES3D_t),intent(inout) :: this this%nvar = 5 + this%ndiagnostics = 4 endsubroutine SetNumberOfVariables_GFDLES3D_t @@ -239,8 +242,8 @@ subroutine ReportUserMetrics_GFDLES3D_t(this) write(modelTime,"(ES16.7E3)") this%t do ivar = 1,this%nvar - write(maxv,"(ES16.7E3)") maxval(this%primitive%interior(:,:,:,ivar)) - write(minv,"(ES16.7E3)") minval(this%primitive%interior(:,:,:,ivar)) + write(maxv,"(ES16.7E3)") maxval(this%primitive%interior(:,:,:,:,ivar)) + write(minv,"(ES16.7E3)") minval(this%primitive%interior(:,:,:,:,ivar)) ! Write the output to STDOUT open(output_unit,ENCODING='utf-8') @@ -252,8 +255,8 @@ subroutine ReportUserMetrics_GFDLES3D_t(this) enddo do ivar = 1,this%ndiagnostics - write(maxv,"(ES16.7E3)") maxval(this%diagnostics%interior(:,:,:,ivar)) - write(minv,"(ES16.7E3)") minval(this%diagnostics%interior(:,:,:,ivar)) + write(maxv,"(ES16.7E3)") maxval(this%diagnostics%interior(:,:,:,:,ivar)) + write(minv,"(ES16.7E3)") minval(this%diagnostics%interior(:,:,:,:,ivar)) ! Write the output to STDOUT open(output_unit,ENCODING='utf-8') @@ -273,7 +276,7 @@ subroutine setprimitiveboundarycondition_GFDLES3D_t(this) implicit none class(GFDLES3D_t),intent(inout) :: this ! local - integer :: i,j,k,iEl,j,e2,bcid + integer :: i,j,k,iEl,e2,bcid real(prec) :: nhat(1:3) do concurrent(k=1:6,iel=1:this%mesh%nElem) @@ -289,7 +292,7 @@ subroutine setprimitiveboundarycondition_GFDLES3D_t(this) nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) this%primitive%extBoundary(i,j,k,iEl,1:this%nvar) = & - this%hbc3d_Prescribed(this%primitive%boundary(i,j,k,iEl,1:this%nvar),nhat) + this%hbc3d_Prescribed(this%primitive%boundary(i,j,k,iEl,1:this%nvar),this%t) enddo enddo @@ -318,289 +321,290 @@ subroutine setprimitiveboundarycondition_GFDLES3D_t(this) endif enddo + + endsubroutine setprimitiveboundarycondition_GFDLES3D_t + subroutine PreTendency_GFDLES3D_t(this) + implicit none + class(GFDLES3D_t),intent(inout) :: this + + if(this%sgs_enabled) then + call this%ConservativeToPrimitive() + call this%primitive%BoundaryInterp() + call this%primitive%SideExchange(this%mesh) + + call this%SetPrimitiveBoundaryCondition() + + call this%primitive%AverageSides() + + ! Compute the gradient of the primitive variables + ! and store the result in the solutionGradient property. + call this%primitive%MappedDGGradient(this%solutionGradient%interior) + call this%solutionGradient%BoundaryInterp() + call this%solutionGradient%SideExchange(this%mesh) + call this%SetGradientBoundaryCondition() + call this%solutionGradient%AverageSides() + endif + + endsubroutine PreTendency_GFDLES3D_t + + subroutine CalculateDiagnostics_GFDLES3D_t(this) + implicit none + class(GFDLES3D_t),intent(inout) :: this + ! Local + integer :: i,j,k,iEl + real(prec) :: c,e,ke + real(prec) :: s(1:this%nvar) + + do concurrent(i=1:this%diagnostics%N+1,j=1:this%diagnostics%N+1, & + k=1:this%diagnostics%N+1,iel=1:this%mesh%nElem) + s(1:this%nvar) = this%solution%interior(i,j,k,iEl,1:this%nvar) + c = this%speedofsound(s) + ke = 0.5_prec*(s(2)**2+s(3)**2+s(4)**2)/s(1) ! kinetic energy (kg⋅m²⋅s⁻²) + this%diagnostics%interior(i,j,k,iEl,1) = c ! Speed of sound + this%diagnostics%interior(i,j,k,iEl,2) = this%pressure(s) ! Pressure (total) + this%diagnostics%interior(i,j,k,iEl,3) = ke ! kinetic energy + this%diagnostics%interior(i,j,k,iEl,4) = (sqrt(ke)+c)*this%dt/sqrt(this%geometry%J%interior(i,j,k,iEl,1)) ! CFL number enddo - endsubroutine setprimitiveboundarycondition_GFDLES3D_t - subroutine PreTendency_GFDLES3D_t(this) - implicit none - class(GFDLES3D_t),intent(inout) :: this + endsubroutine CalculateDiagnostics_GFDLES3D_t - if(this%primitive_gradient_enabled) then - call this%ConservativeToPrimitive() - call this%primitive%BoundaryInterp() - call this%primitive%SideExchange(this%mesh) + subroutine ConservativeToPrimitive_GFDLES3D_t(this) + implicit none + class(GFDLES3D_t),intent(inout) :: this + ! Local + integer :: i,j,k,iEl + real(prec) :: s(1:this%nvar) + + do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & + k=1:this%diagnostics%N+1,iel=1:this%mesh%nElem) + s(1:this%nvar) = this%solution%interior(i,j,k,iEl,1:this%nvar) + this%primitive%interior(i,j,k,iEl,1) = s(1) ! density + this%primitive%interior(i,j,k,iEl,2) = s(2)/s(1) ! x-velocity + this%primitive%interior(i,j,k,iEl,3) = s(3)/s(1) ! y-velocity + this%primitive%interior(i,j,k,iEl,4) = s(4)/s(1) ! z-velocity + this%primitive%interior(i,j,k,iEl,5) = s(5)/s(1) ! Potential temperature + enddo - call this%SetPrimitiveBoundaryCondition() + endsubroutine ConservativeToPrimitive_GFDLES3D_t - call this%primitive%AverageSides() + subroutine PrimitiveToConservative_GFDLES3D_t(this) + implicit none + class(GFDLES3D_t),intent(inout) :: this + ! Local + integer :: i,j,k,iEl + real(prec) :: s(1:this%nvar) + + do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & + k=1:this%diagnostics%N+1,iel=1:this%mesh%nElem) + s(1:this%nvar) = this%primitive%interior(i,j,k,iEl,1:this%nvar) + this%solution%interior(i,j,k,iEl,1) = s(1) ! density + this%solution%interior(i,j,k,iEl,2) = s(2)*s(1) ! x-momentum + this%solution%interior(i,j,k,iEl,3) = s(3)*s(1) ! y-momentum + this%solution%interior(i,j,k,iEl,4) = s(4)*s(1) ! z-momentum + this%solution%interior(i,j,k,iEl,5) = s(5)*s(1) ! Density weighted Potential temperature + enddo - ! Compute the gradient of the primitive variables - ! and store the result in the solutionGradient property. - call this%primitive%MappedDGGradient(this%solutionGradient%interior) - call this%solutionGradient%BoundaryInterp() - call this%solutionGradient%SideExchange(this%mesh) - call this%SetGradientBoundaryCondition() - call this%solutionGradient%AverageSides() - endif + endsubroutine PrimitiveToConservative_GFDLES3D_t - endsubroutine PreTendency_GFDLES3D_t - - subroutine CalculateDiagnostics_GFDLES3D_t(this) - implicit none - class(GFDLES3D_t),intent(inout) :: this - ! Local - integer :: i,j,k,iEl - real(prec) :: c,e,ke - real(prec) :: s(1:this%nvar) - - do concurrent(i=1:this%diagnostics%N+1,j=1:this%diagnostics%N+1, & - k=1:this%diagnostics%N+1,iel=1:this%mesh%nElem) - s(1:this%nvar) = this%solution%interior(i,j,k,iEl,1:this%nvar) - c = this%speedofsound(s) - ke = 0.5_prec*(s(2)**2+s(3)**2+s(4)**2)/s(1) ! kinetic energy (kg⋅m²⋅s⁻²) - this%diagnostics%interior(i,j,k,iEl,1) = c ! Speed of sound - this%diagnostics%interior(i,j,k,iEl,2) = this%pressure(s) ! Pressure (total) - this%diagnostics%interior(i,j,k,iEl,3) = ke ! kinetic energy - this%diagnostics%interior(i,j,k,iEl,4) = (sqrt(ke)+c)*this%dt/sqrt(this%geometry%J%interior(i,j,iEl,1)) ! CFL number - enddo - - endsubroutine CalculateDiagnostics_GFDLES3D_t - - subroutine ConservativeToPrimitive_GFDLES3D_t(this) - implicit none - class(GFDLES3D_t),intent(inout) :: this - ! Local - integer :: i,j,k,El - real(prec) :: s(1:this%nvar) - - do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & - k=1:this%diagnostics%N+1,iel=1:this%mesh%nElem) - s(1:this%nvar) = this%solution%interior(i,j,iEl,1:this%nvar) - this%primitive%interior(i,j,k,iEl,1) = s(1) ! density - this%primitive%interior(i,j,k,iEl,2) = s(2)/s(1) ! x-velocity - this%primitive%interior(i,j,k,iEl,3) = s(3)/s(1) ! y-velocity - this%primitive%interior(i,j,k,iEl,4) = s(4)/s(1) ! z-velocity - this%primitive%interior(i,j,k,iEl,5) = s(5)/s(1) ! Potential temperature - enddo - - endsubroutine ConservativeToPrimitive_GFDLES3D_t - - subroutine PrimitiveToConservative_GFDLES3D_t(this) - implicit none - class(GFDLES3D_t),intent(inout) :: this - ! Local - integer :: i,j,k,El - real(prec) :: s(1:this%nvar) - - do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & - k=1:this%diagnostics%N+1,iel=1:this%mesh%nElem) - s(1:this%nvar) = this%primitive%interior(i,j,iEl,1:this%nvar) - this%solution%interior(i,j,k,iEl,1) = s(1) ! density - this%solution%interior(i,j,k,iEl,2) = s(2)*s(1) ! x-momentum - this%solution%interior(i,j,k,iEl,3) = s(3)*s(1) ! y-momentum - this%solution%interior(i,j,k,iEl,4) = s(4)*s(1) ! z-momentum - this%solution%interior(i,j,k,iEl,5) = s(5)*s(1) ! Density weighted Potential temperature - enddo - - endsubroutine PrimitiveToConservative_GFDLES3D_t - - pure function entropy_func_GFDLES3D_t(this,s) result(e) + pure function entropy_func_GFDLES3D_t(this,s) result(e) !! The entropy function is the sum of kinetic and internal energy !! For the linear model, this is !! !! \begin{equation} !! e = \frac{1}{2} \left( \rho_0*( u^2 + v^2 ) + \frac{P^2}{\rho_0 c^2} \right) - class(GFDLES3D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec) :: e - ! Local - real(prec) :: ke,ie,pe - - ke = 0.5_prec*(s(2)*s(2)+s(3)*(3)+s(4)*s(4))/s(1) ! kinetic energy - !pe = s(1)*this%g*z Potential energy - ie = this%Cv*s(5)*(this%pressure(s)/this%p0)**(this%R/this%Cp) ! internal energy = rho*Cv*T - - e = ke+e - endfunction entropy_func_GFDLES3D_t - - ! pure function hbc3D_NoNormalFlow_GFDLES3D_t(this,s,nhat) result(exts) - ! class(GFDLES3D_t),intent(in) :: this - ! real(prec),intent(in) :: s(1:this%nvar) - ! real(prec),intent(in) :: nhat(1:2) - ! real(prec) :: exts(1:this%nvar) - ! ! Local - ! integer :: ivar - - ! exts(1) = s(1) ! density - ! exts(2) = (nhat(2)**2-nhat(1)**2)*s(2)-2.0_prec*nhat(1)*nhat(2)*s(3) ! u - ! exts(3) = (nhat(1)**2-nhat(2)**2)*s(3)-2.0_prec*nhat(1)*nhat(2)*s(2) ! v - ! exts(4) = (nhat(1)**2-nhat(2)**2)*s(3)-2.0_prec*nhat(1)*nhat(2)*s(2) ! w - ! exts(5) = s(4) ! p - - ! endfunction hbc3D_NoNormalFlow_GFDLES3D_t - - pure function pressure(this,s) result(p) - class(GFDLES3D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec) :: p - - p = (this%R*s(5)*(this%p0)**(-this%R/this%Cp))**(this%gamma) - - endfunction pressure - - ! pure function temperature(this, s) result(t) - ! class(GFDLES3D_t), intent(in) :: this - ! real(prec), intent(in) :: s(1:this%nvar) - ! real(prec) :: t - - ! t = (s(4) - 0.5_prec*(s(2)**2 + s(3)**2)/s(1))/(s(1)*this%Cv) ! temperature = e/Cv - - ! end function temperature - - pure function speedofsound(this,s) result(c) - class(GFDLES3D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec) :: c - - c = sqrt(this%gamma*this%pressure(s)/s(1)) - - endfunction speedofsound - - pure function flux3d_GFDLES3D_t(this,s,dsdx) result(flux) - class(GFDLES3D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec),intent(in) :: dsdx(1:this%nvar,1:2) - real(prec) :: flux(1:this%nvar,1:2) - ! Local - real(prec) :: p,nu,kappa,u,v,w - real(prec) :: tau_11,tau_12,tau_13 - real(prec) :: tau_22,tau_23 - real(prec) :: tau_33 - - ! Computes the pressure for an ideal gas - p = this%pressure(s) - u = s(2)/s(1) - v = s(3)/s(1) - w = s(4)/s(1) - ! LEFT OFF HERE !! - flux(1,1) = s(2) ! density, x flux ; rho*u - flux(1,2) = s(3) ! density, y flux ; rho*v - flux(2,1) = s(2)*u+p ! x-momentum, x flux; \rho*u*u + p - flux(2,2) = s(2)*v ! x-momentum, y flux; \rho*u*v - flux(3,1) = s(2)*u ! y-momentum, x flux; \rho*v*u - flux(3,2) = s(3)*v+p ! y-momentum, y flux; \rho*v*v + p - flux(4,1) = (s(4)+p)*s(2)/s(1) ! total energy, x flux : (\rho*E + p)*u - flux(4,2) = (s(4)+p)*s(3)/s(1) ! total energy, y flux : (\rho*E + p)*v - - if(this%primitive_gradient_enabled) then - ! Viscous and difussive terms - ! Recall that the solutionGradient now contains - ! the primitive variable gradients - ! Calculate the stress tensor - nu = this%nu - kappa = this%kappa - tau_11 = 4.0_prec*dsdx(2,1)/3.0_prec-2.0_prec*dsdx(3,2)/3.0_prec - tau_12 = dsdx(2,2)+dsdx(3,1) - !tau_21 = tau_12 - tau_22 = 4.0_prec*dsdx(3,2)/3.0_prec-2.0_prec*dsdx(2,1)/3.0_prec - - flux(2,1) = flux(2,1)-nu*tau_11 ! x-momentum, x flux - flux(2,2) = flux(2,2)-nu*tau_12 ! x-momentum, y flux (-tau_21*nu = -tau_12*nu) - flux(3,1) = flux(3,1)-nu*tau_12 ! y-momentum, x flux - flux(3,2) = flux(3,2)-nu*tau_22 ! y-momentum, y flux - flux(4,1) = flux(4,1)-(kappa*dsdx(4,1)+u*tau_11+v*tau_12) ! total energy, x flux = -(kappa*dTdx + u*tau_11 + v*tau_12) - flux(4,2) = flux(4,2)-(kappa*dsdx(4,2)+u*tau_11+v*tau_12) ! total energy, y flux = -(kappa*dTdy + u*tau_12 + v*tau_22) - endif + class(GFDLES3D_t),intent(in) :: this + real(prec),intent(in) :: s(1:this%nvar) + real(prec) :: e + ! Local + real(prec) :: ke,ie,pe + + ke = 0.5_prec*(s(2)*s(2)+s(3)*(3)+s(4)*s(4))/s(1) ! kinetic energy + !pe = s(1)*this%g*z Potential energy + ie = this%Cv*s(5)*(this%pressure(s)/this%p0)**(this%R/this%Cp) ! internal energy = rho*Cv*T + + e = ke+e + endfunction entropy_func_GFDLES3D_t + + ! pure function hbc3D_NoNormalFlow_GFDLES3D_t(this,s,nhat) result(exts) + ! class(GFDLES3D_t),intent(in) :: this + ! real(prec),intent(in) :: s(1:this%nvar) + ! real(prec),intent(in) :: nhat(1:2) + ! real(prec) :: exts(1:this%nvar) + ! ! Local + ! integer :: ivar + + ! exts(1) = s(1) ! density + ! exts(2) = (nhat(2)**2-nhat(1)**2)*s(2)-2.0_prec*nhat(1)*nhat(2)*s(3) ! u + ! exts(3) = (nhat(1)**2-nhat(2)**2)*s(3)-2.0_prec*nhat(1)*nhat(2)*s(2) ! v + ! exts(4) = (nhat(1)**2-nhat(2)**2)*s(3)-2.0_prec*nhat(1)*nhat(2)*s(2) ! w + ! exts(5) = s(4) ! p + + ! endfunction hbc3D_NoNormalFlow_GFDLES3D_t + + pure function pressure(this,s) result(p) + class(GFDLES3D_t),intent(in) :: this + real(prec),intent(in) :: s(1:this%nvar) + real(prec) :: p + + p = (this%R*s(5)*(this%p0)**(-this%R/this%Cp))**(this%gamma) + + endfunction pressure - endfunction flux3d_GFDLES3D_t + ! pure function temperature(this, s) result(t) + ! class(GFDLES3D_t), intent(in) :: this + ! real(prec), intent(in) :: s(1:this%nvar) + ! real(prec) :: t - pure function riemannflux3D_GFDLES3D_t(this,sL,sR,dsdx,nhat) result(flux) + ! t = (s(4) - 0.5_prec*(s(2)**2 + s(3)**2)/s(1))/(s(1)*this%Cv) ! temperature = e/Cv + + ! end function temperature + + pure function speedofsound(this,s) result(c) + class(GFDLES3D_t),intent(in) :: this + real(prec),intent(in) :: s(1:this%nvar) + real(prec) :: c + + c = sqrt(this%gamma*this%pressure(s)/s(1)) + + endfunction speedofsound + + pure function flux3d_GFDLES3D_t(this,s,dsdx) result(flux) + class(GFDLES3D_t),intent(in) :: this + real(prec),intent(in) :: s(1:this%nvar) + real(prec),intent(in) :: dsdx(1:this%nvar,1:3) + real(prec) :: flux(1:this%nvar,1:3) + ! Local + real(prec) :: p,nu,kappa,u,v,w + real(prec) :: tau_11,tau_12,tau_13 + real(prec) :: tau_22,tau_23 + real(prec) :: tau_33 + + ! Computes the pressure for an ideal gas + p = this%pressure(s) + u = s(2)/s(1) + v = s(3)/s(1) + w = s(4)/s(1) + ! LEFT OFF HERE !! + flux(1,1) = s(2) ! density, x flux ; rho*u + flux(1,2) = s(3) ! density, y flux ; rho*v + flux(1,3) = s(3) ! density, z flux ; rho*w + + flux(2,1) = s(2)*u+p ! x-momentum, x flux; \rho*u*u + p + flux(2,2) = s(2)*v ! x-momentum, y flux; \rho*u*v + flux(3,1) = s(2)*u ! y-momentum, x flux; \rho*v*u + flux(3,2) = s(3)*v+p ! y-momentum, y flux; \rho*v*v + p + flux(4,1) = (s(4)+p)*s(2)/s(1) ! total energy, x flux : (\rho*E + p)*u + flux(4,2) = (s(4)+p)*s(3)/s(1) ! total energy, y flux : (\rho*E + p)*v + + if(this%sgs_enabled) then + ! Viscous and difussive terms + ! Recall that the solutionGradient now contains + ! the primitive variable gradients + ! Calculate the stress tensor + nu = this%nu + kappa = this%kappa + tau_11 = 4.0_prec*dsdx(2,1)/3.0_prec-2.0_prec*dsdx(3,2)/3.0_prec + tau_12 = dsdx(2,2)+dsdx(3,1) + !tau_21 = tau_12 + tau_22 = 4.0_prec*dsdx(3,2)/3.0_prec-2.0_prec*dsdx(2,1)/3.0_prec + + flux(2,1) = flux(2,1)-nu*tau_11 ! x-momentum, x flux + flux(2,2) = flux(2,2)-nu*tau_12 ! x-momentum, y flux (-tau_21*nu = -tau_12*nu) + flux(3,1) = flux(3,1)-nu*tau_12 ! y-momentum, x flux + flux(3,2) = flux(3,2)-nu*tau_22 ! y-momentum, y flux + flux(4,1) = flux(4,1)-(kappa*dsdx(4,1)+u*tau_11+v*tau_12) ! total energy, x flux = -(kappa*dTdx + u*tau_11 + v*tau_12) + flux(4,2) = flux(4,2)-(kappa*dsdx(4,2)+u*tau_11+v*tau_12) ! total energy, y flux = -(kappa*dTdy + u*tau_12 + v*tau_22) + endif + + endfunction flux3d_GFDLES3D_t + + pure function riemannflux3D_GFDLES3D_t(this,sL,sR,dsdx,nhat) result(flux) !! Uses a local lax-friedrich's upwind flux !! The max eigenvalue is taken as the sound speed - class(GFDLES3D_t),intent(in) :: this - real(prec),intent(in) :: sL(1:this%nvar) - real(prec),intent(in) :: sR(1:this%nvar) - real(prec),intent(in) :: dsdx(1:this%nvar,1:3) - real(prec),intent(in) :: nhat(1:3) - real(prec) :: flux(1:this%nvar) - ! Local - real(prec) :: fL(1:this%nvar) - real(prec) :: fR(1:this%nvar) - real(prec) :: u,v,w,p,c,rho0 - - u = sL(2) - v = sL(3) - w = sL(4) - p = sL(5) - rho0 = this%rho0 - c = this%c - fL(1) = rho0*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! density - fL(2) = p*nhat(1)/rho0 ! u - fL(3) = p*nhat(2)/rho0 ! v - fL(4) = p*nhat(3)/rho0 ! w - fL(5) = rho0*c*c*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! pressure - - u = sR(2) - v = sR(3) - w = sR(4) - p = sR(5) - fR(1) = rho0*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! density - fR(2) = p*nhat(1)/rho0 ! u - fR(3) = p*nhat(2)/rho0 ! v' - fR(4) = p*nhat(3)/rho0 ! w - fR(5) = rho0*c*c*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! pressure - - flux(1:5) = 0.5_prec*(fL(1:5)+fR(1:5))+c*(sL(1:5)-sR(1:5)) - - endfunction riemannflux3D_GFDLES3D_t - - subroutine SphericalSoundWave_GFDLES3D_t(this,rhoprime,Lr,x0,y0,z0) - !! This subroutine sets the initial condition for a weak blast wave - !! problem. The initial condition is given by - !! - !! \begin{equation} - !! \begin{aligned} - !! \rho &= \rho_0 + \rho' \exp\left( -\ln(2) \frac{(x-x_0)^2 + (y-y_0)^2}{L_r^2} \right) - !! u &= 0 \\ - !! v &= 0 \\ - !! E &= \frac{P_0}{\gamma - 1} + E \exp\left( -\ln(2) \frac{(x-x_0)^2 + (y-y_0)^2}{L_e^2} \right) - !! \end{aligned} - !! \end{equation} - !! - implicit none - class(GFDLES3D_t),intent(inout) :: this - real(prec),intent(in) :: rhoprime,Lr,x0,y0,z0 - ! Local - integer :: i,j,k,iEl - real(prec) :: x,y,z,rho,r,E - - print*,__FILE__," : Configuring weak blast wave initial condition. " - print*,__FILE__," : rhoprime = ",rhoprime - print*,__FILE__," : Lr = ",Lr - print*,__FILE__," : x0 = ",x0 - print*,__FILE__," : y0 = ",y0 - print*,__FILE__," : z0 = ",z0 - - do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & - k=1:this%solution%N+1,iel=1:this%mesh%nElem) - x = this%geometry%x%interior(i,j,k,iEl,1,1)-x0 - y = this%geometry%x%interior(i,j,k,iEl,1,2)-y0 - z = this%geometry%x%interior(i,j,k,iEl,1,3)-z0 - r = sqrt(x**2+y**2+z**2) - - rho = (rhoprime)*exp(-log(2.0_prec)*r**2/Lr**2) - - this%solution%interior(i,j,k,iEl,1) = rho - this%solution%interior(i,j,k,iEl,2) = 0.0_prec - this%solution%interior(i,j,k,iEl,3) = 0.0_prec - this%solution%interior(i,j,k,iEl,4) = 0.0_prec - this%solution%interior(i,j,k,iEl,5) = rho*this%c*this%c - - enddo - - call this%ReportMetrics() - call this%solution%UpdateDevice() - - endsubroutine SphericalSoundWave_GFDLES3D_t - - endmodule self_GFDLES3D_t + class(GFDLES3D_t),intent(in) :: this + real(prec),intent(in) :: sL(1:this%nvar) + real(prec),intent(in) :: sR(1:this%nvar) + real(prec),intent(in) :: dsdx(1:this%nvar,1:3) + real(prec),intent(in) :: nhat(1:3) + real(prec) :: flux(1:this%nvar) + ! Local + real(prec) :: fL(1:this%nvar) + real(prec) :: fR(1:this%nvar) + real(prec) :: u,v,w,p,c,rho0 + + u = sL(2) + v = sL(3) + w = sL(4) + p = sL(5) + rho0 = 1.0 !this%rho0 + c = 1.0 !this%c + fL(1) = rho0*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! density + fL(2) = p*nhat(1)/rho0 ! u + fL(3) = p*nhat(2)/rho0 ! v + fL(4) = p*nhat(3)/rho0 ! w + fL(5) = rho0*c*c*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! pressure + + u = sR(2) + v = sR(3) + w = sR(4) + p = sR(5) + fR(1) = rho0*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! density + fR(2) = p*nhat(1)/rho0 ! u + fR(3) = p*nhat(2)/rho0 ! v' + fR(4) = p*nhat(3)/rho0 ! w + fR(5) = rho0*c*c*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! pressure + + flux(1:5) = 0.5_prec*(fL(1:5)+fR(1:5))+c*(sL(1:5)-sR(1:5)) + + endfunction riemannflux3D_GFDLES3D_t + + ! subroutine SphericalSoundWave_GFDLES3D_t(this,rhoprime,Lr,x0,y0,z0) + ! !! This subroutine sets the initial condition for a weak blast wave + ! !! problem. The initial condition is given by + ! !! + ! !! \begin{equation} + ! !! \begin{aligned} + ! !! \rho &= \rho_0 + \rho' \exp\left( -\ln(2) \frac{(x-x_0)^2 + (y-y_0)^2}{L_r^2} \right) + ! !! u &= 0 \\ + ! !! v &= 0 \\ + ! !! E &= \frac{P_0}{\gamma - 1} + E \exp\left( -\ln(2) \frac{(x-x_0)^2 + (y-y_0)^2}{L_e^2} \right) + ! !! \end{aligned} + ! !! \end{equation} + ! !! + ! implicit none + ! class(GFDLES3D_t),intent(inout) :: this + ! real(prec),intent(in) :: rhoprime,Lr,x0,y0,z0 + ! ! Local + ! integer :: i,j,k,iEl + ! real(prec) :: x,y,z,rho,r,E + + ! print*,__FILE__," : Configuring weak blast wave initial condition. " + ! print*,__FILE__," : rhoprime = ",rhoprime + ! print*,__FILE__," : Lr = ",Lr + ! print*,__FILE__," : x0 = ",x0 + ! print*,__FILE__," : y0 = ",y0 + ! print*,__FILE__," : z0 = ",z0 + + ! do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & + ! k=1:this%solution%N+1,iel=1:this%mesh%nElem) + ! x = this%geometry%x%interior(i,j,k,iEl,1,1)-x0 + ! y = this%geometry%x%interior(i,j,k,iEl,1,2)-y0 + ! z = this%geometry%x%interior(i,j,k,iEl,1,3)-z0 + ! r = sqrt(x**2+y**2+z**2) + + ! rho = (rhoprime)*exp(-log(2.0_prec)*r**2/Lr**2) + + ! this%solution%interior(i,j,k,iEl,1) = rho + ! this%solution%interior(i,j,k,iEl,2) = 0.0_prec + ! this%solution%interior(i,j,k,iEl,3) = 0.0_prec + ! this%solution%interior(i,j,k,iEl,4) = 0.0_prec + ! this%solution%interior(i,j,k,iEl,5) = rho*this%c*this%c + + ! enddo + + ! call this%ReportMetrics() + ! call this%solution%UpdateDevice() + + ! endsubroutine SphericalSoundWave_GFDLES3D_t + +endmodule self_GFDLES3D_t diff --git a/src/SELF_LinearShallowWater2D_t.f90 b/src/SELF_LinearShallowWater2D_t.f90 index 69121d622..b2eb52c94 100644 --- a/src/SELF_LinearShallowWater2D_t.f90 +++ b/src/SELF_LinearShallowWater2D_t.f90 @@ -250,6 +250,12 @@ subroutine sourcemethod_LinearShallowWater2D_t(this) this%source%interior(i,j,iel,1) = this%fCori%interior(i,j,iel,1)*s(2)-this%Cd*s(1) ! du/dt = f*v - Cd*u this%source%interior(i,j,iel,2) = -this%fCori%interior(i,j,iel,1)*s(1)-this%Cd*s(2) ! dv/dt = -f*u - Cd*v + ! newsignal = 0.0 + ! do n = 1,nnotes + ! newsignal = newsignal + A(n)*exp( -( (x-this%xc(n))**2 +(y-this%yc(n))**2 )/(2.0*this%Lr(n)**2) ) + ! enddo + ! this%source%interior(i,j,iel,3) = w1*this%source%interior(i,j,iel,3)+ w2*newsignal + enddo endsubroutine sourcemethod_LinearShallowWater2D_t diff --git a/src/cpu/SELF_GFDLES3D.f90 b/src/cpu/SELF_GFDLES3D.f90 index 62102d1f2..3eee2a673 100644 --- a/src/cpu/SELF_GFDLES3D.f90 +++ b/src/cpu/SELF_GFDLES3D.f90 @@ -24,13 +24,13 @@ ! ! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -module self_LinearEuler3D +module self_GFDLES3D - use self_LinearEuler3D_t + use self_GFDLES3D_t implicit none - type,extends(LinearEuler3D_t) :: LinearEuler3D - endtype LinearEuler3D + type,extends(GFDLES3D_t) :: GFDLES3D + endtype GFDLES3D -endmodule self_LinearEuler3D +endmodule self_GFDLES3D diff --git a/src/gpu/SELF_GFDLES3D.f90 b/src/gpu/SELF_GFDLES3D.f90 index 76190a383..59d0acc90 100644 --- a/src/gpu/SELF_GFDLES3D.f90 +++ b/src/gpu/SELF_GFDLES3D.f90 @@ -24,128 +24,128 @@ ! ! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -module self_LinearEuler3D +module self_GFDLES3D - use self_LinearEuler3D_t + use self_GFDLES3D_t implicit none - type,extends(LinearEuler3D_t) :: LinearEuler3D + type,extends(GFDLES3D_t) :: GFDLES3D contains - procedure :: setboundarycondition => setboundarycondition_LinearEuler3D - procedure :: boundaryflux => boundaryflux_LinearEuler3D - procedure :: fluxmethod => fluxmethod_LinearEuler3D - - endtype LinearEuler3D - - interface - subroutine setboundarycondition_LinearEuler3D_gpu(extboundary,boundary,sideinfo,nhat,N,nel) & - bind(c,name="setboundarycondition_LinearEuler3D_gpu") - use iso_c_binding - type(c_ptr),value :: extboundary,boundary,sideinfo,nhat - integer(c_int),value :: N,nel - endsubroutine setboundarycondition_LinearEuler3D_gpu - endinterface - - interface - subroutine fluxmethod_LinearEuler3D_gpu(solution,flux,rho0,c,N,nel,nvar) & - bind(c,name="fluxmethod_LinearEuler3D_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: solution,flux - real(c_prec),value :: rho0,c - integer(c_int),value :: N,nel,nvar - endsubroutine fluxmethod_LinearEuler3D_gpu - endinterface - - interface - subroutine boundaryflux_LinearEuler3D_gpu(fb,fextb,nhat,nscale,flux,rho0,c,N,nel) & - bind(c,name="boundaryflux_LinearEuler3D_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: fb,fextb,flux,nhat,nscale - real(c_prec),value :: rho0,c - integer(c_int),value :: N,nel - endsubroutine boundaryflux_LinearEuler3D_gpu - endinterface + ! procedure :: setboundarycondition => setboundarycondition_GFDLES3D + ! procedure :: boundaryflux => boundaryflux_GFDLES3D + ! procedure :: fluxmethod => fluxmethod_GFDLES3D + + endtype GFDLES3D + + ! interface + ! subroutine setboundarycondition_GFDLES3D_gpu(extboundary,boundary,sideinfo,nhat,N,nel) & + ! bind(c,name="setboundarycondition_GFDLES3D_gpu") + ! use iso_c_binding + ! type(c_ptr),value :: extboundary,boundary,sideinfo,nhat + ! integer(c_int),value :: N,nel + ! endsubroutine setboundarycondition_GFDLES3D_gpu + ! endinterface + + ! interface + ! subroutine fluxmethod_GFDLES3D_gpu(solution,flux,rho0,c,N,nel,nvar) & + ! bind(c,name="fluxmethod_GFDLES3D_gpu") + ! use iso_c_binding + ! use SELF_Constants + ! type(c_ptr),value :: solution,flux + ! real(c_prec),value :: rho0,c + ! integer(c_int),value :: N,nel,nvar + ! endsubroutine fluxmethod_GFDLES3D_gpu + ! endinterface + + ! interface + ! subroutine boundaryflux_GFDLES3D_gpu(fb,fextb,nhat,nscale,flux,rho0,c,N,nel) & + ! bind(c,name="boundaryflux_GFDLES3D_gpu") + ! use iso_c_binding + ! use SELF_Constants + ! type(c_ptr),value :: fb,fextb,flux,nhat,nscale + ! real(c_prec),value :: rho0,c + ! integer(c_int),value :: N,nel + ! endsubroutine boundaryflux_GFDLES3D_gpu + ! endinterface contains - subroutine boundaryflux_LinearEuler3D(this) - implicit none - class(LinearEuler3D),intent(inout) :: this - - call boundaryflux_LinearEuler3D_gpu(this%solution%boundary_gpu, & - this%solution%extBoundary_gpu, & - this%geometry%nhat%boundary_gpu, & - this%geometry%nscale%boundary_gpu, & - this%flux%boundarynormal_gpu, & - this%rho0,this%c,this%solution%interp%N, & - this%solution%nelem) - - endsubroutine boundaryflux_LinearEuler3D - - subroutine fluxmethod_LinearEuler3D(this) - implicit none - class(LinearEuler3D),intent(inout) :: this - - call fluxmethod_LinearEuler3D_gpu(this%solution%interior_gpu, & - this%flux%interior_gpu, & - this%rho0,this%c,this%solution%interp%N,this%solution%nelem, & - this%solution%nvar) - - endsubroutine fluxmethod_LinearEuler3D - - subroutine setboundarycondition_LinearEuler3D(this) - !! Boundary conditions are set to periodic boundary conditions - implicit none - class(LinearEuler3D),intent(inout) :: this - ! local - integer :: i,iEl,j,k,e2,bcid - real(prec) :: x(1:3) - - if(this%prescribed_bcs_enabled) then - call gpuCheck(hipMemcpy(c_loc(this%solution%extboundary), & - this%solution%extboundary_gpu,sizeof(this%solution%extboundary), & - hipMemcpyDeviceToHost)) - - ! Prescribed boundaries are still done on the CPU - do iEl = 1,this%solution%nElem ! Loop over all elements - do k = 1,6 ! Loop over all sides - - bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - - do j = 1,this%solution%interp%N+1 ! Loop over quadrature points - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - x = this%geometry%x%boundary(i,j,k,iEl,1,1:3) - - this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & - this%hbc3D_Prescribed(x,this%t) - enddo - enddo - - endif - endif - - enddo - enddo - - call gpuCheck(hipMemcpy(this%solution%extBoundary_gpu, & - c_loc(this%solution%extBoundary), & - sizeof(this%solution%extBoundary), & - hipMemcpyHostToDevice)) - endif - call setboundarycondition_LinearEuler3D_gpu(this%solution%extboundary_gpu, & - this%solution%boundary_gpu, & - this%mesh%sideInfo_gpu, & - this%geometry%nhat%boundary_gpu, & - this%solution%interp%N, & - this%solution%nelem) - - endsubroutine setboundarycondition_LinearEuler3D - -endmodule self_LinearEuler3D + ! subroutine boundaryflux_GFDLES3D(this) + ! implicit none + ! class(GFDLES3D),intent(inout) :: this + + ! call boundaryflux_GFDLES3D_gpu(this%solution%boundary_gpu, & + ! this%solution%extBoundary_gpu, & + ! this%geometry%nhat%boundary_gpu, & + ! this%geometry%nscale%boundary_gpu, & + ! this%flux%boundarynormal_gpu, & + ! this%rho0,this%c,this%solution%interp%N, & + ! this%solution%nelem) + + ! endsubroutine boundaryflux_GFDLES3D + + ! subroutine fluxmethod_GFDLES3D(this) + ! implicit none + ! class(GFDLES3D),intent(inout) :: this + + ! call fluxmethod_GFDLES3D_gpu(this%solution%interior_gpu, & + ! this%flux%interior_gpu, & + ! this%rho0,this%c,this%solution%interp%N,this%solution%nelem, & + ! this%solution%nvar) + + ! endsubroutine fluxmethod_GFDLES3D + + ! subroutine setboundarycondition_GFDLES3D(this) + ! !! Boundary conditions are set to periodic boundary conditions + ! implicit none + ! class(GFDLES3D),intent(inout) :: this + ! ! local + ! integer :: i,iEl,j,k,e2,bcid + ! real(prec) :: x(1:3) + + ! if(this%prescribed_bcs_enabled) then + ! call gpuCheck(hipMemcpy(c_loc(this%solution%extboundary), & + ! this%solution%extboundary_gpu,sizeof(this%solution%extboundary), & + ! hipMemcpyDeviceToHost)) + + ! ! Prescribed boundaries are still done on the CPU + ! do iEl = 1,this%solution%nElem ! Loop over all elements + ! do k = 1,6 ! Loop over all sides + + ! bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID + ! e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID + + ! if(e2 == 0) then + ! if(bcid == SELF_BC_PRESCRIBED) then + + ! do j = 1,this%solution%interp%N+1 ! Loop over quadrature points + ! do i = 1,this%solution%interp%N+1 ! Loop over quadrature points + ! x = this%geometry%x%boundary(i,j,k,iEl,1,1:3) + + ! this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & + ! this%hbc3D_Prescribed(x,this%t) + ! enddo + ! enddo + + ! endif + ! endif + + ! enddo + ! enddo + + ! call gpuCheck(hipMemcpy(this%solution%extBoundary_gpu, & + ! c_loc(this%solution%extBoundary), & + ! sizeof(this%solution%extBoundary), & + ! hipMemcpyHostToDevice)) + ! endif + ! call setboundarycondition_GFDLES3D_gpu(this%solution%extboundary_gpu, & + ! this%solution%boundary_gpu, & + ! this%mesh%sideInfo_gpu, & + ! this%geometry%nhat%boundary_gpu, & + ! this%solution%interp%N, & + ! this%solution%nelem) + + ! endsubroutine setboundarycondition_GFDLES3D + +endmodule self_GFDLES3D diff --git a/src/json/CMakeLists.txt b/src/json/CMakeLists.txt new file mode 100644 index 000000000..481d0bb9e --- /dev/null +++ b/src/json/CMakeLists.txt @@ -0,0 +1,82 @@ + +# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +# +# Maintainers : support@fluidnumerics.com +# Official Repository : https://github.com/FluidNumerics/self/ +# +# Copyright © 2024 Fluid Numerics LLC +# +# Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: +# +# 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. +# +# 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in +# the documentation and/or other materials provided with the distribution. +# +# 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from +# this software without specific prior written permission. +# +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +# HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +# +# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +file(GLOB SELF_PYINT_FSRC "${CMAKE_CURRENT_SOURCE_DIR}/*.f*") + +# Enable pre-processing for source code +set_source_files_properties( + ${SELF_FSRC} + PROPERTIES Fortran_PREPROCESS ON +) + + +set_source_files_properties( + ${SELF_MODEL_FSRC} + PROPERTIES Fortran_PREPROCESS ON +) + +set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/include) + +add_library(self_interface SHARED ${SELF_PYINT_FSRC}) +#set_target_properties(self PROPERTIES OUTPUT_NAME "self") +target_link_libraries(self_interface PUBLIC + self + ${FEQPARSE_LIBRARIES} + HDF5::HDF5 + ${MPI_Fortran_LIBRARIES} + ${BACKEND_LIBRARIES} + ${JSONFORTRAN_LIBRARIES}) + +target_include_directories(self_interface PUBLIC + ${FEQPARSE_INCLUDE_DIRS} + ${HDF5_INCLUDE_DIRS} + ${MPI_Fortran_INCLUDE_DIRS} + ${JSONFORTRAN_INCLUDE_DIRS}) + +target_compile_options(self_interface PUBLIC -fPIC) + +set_target_properties(self_interface PROPERTIES LINKER_LANGUAGE Fortran) + +install(TARGETS self_interface + ARCHIVE DESTINATION lib + LIBRARY DESTINATION lib + PUBLIC_HEADER DESTINATION include) + +install(DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/ DESTINATION include) + +# if(JSONFORTRAN_LIBRARIES) +# add_library(self-python SHARED ${SELF_FSRC} ${SELF_BACKEND_CPPSRC} ${SELF_BACKEND_FSRC}) +# target_link_libraries(self PUBLIC +# ${FEQPARSE_LIBRARIES} +# HDF5::HDF5 +# ${MPI_Fortran_LIBRARIES} +# ${BACKEND_LIBRARIES}) + +# target_include_directories(self PUBLIC +# ${FEQPARSE_INCLUDE_DIRS} +# ${HDF5_INCLUDE_DIRS} +# ${MPI_Fortran_INCLUDE_DIRS}) \ No newline at end of file diff --git a/src/json/SELF_JSON_Config.f90 b/src/json/SELF_JSON_Config.f90 new file mode 100644 index 000000000..1aed9ce37 --- /dev/null +++ b/src/json/SELF_JSON_Config.f90 @@ -0,0 +1,263 @@ +! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! +! +! Maintainers : support@fluidnumerics.com +! Official Repository : https://github.com/FluidNumerics/self/ +! +! Copyright © 2024 Fluid Numerics LLC +! +! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in +! the documentation and/or other materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from +! this software without specific prior written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUsLESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARIsLG IN ANY WAY OUT OF THE USE OF +! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! + +module SELF_JSON_Config + + !USE SELF_Constants + !USE SELF_CLI + ! External Modules + use json_module + use iso_fortran_env + + implicit none + + integer,parameter :: SELF_FILE_DEFAULT_LENGTH = 500 + + type,public :: SELFConfig + !TYPE(JSON_FILE) :: schema + type(JSON_FILE) :: concretization + !CHARACTER(SELF_FILE_DEFAULT_LENGTH) :: schemaFile + + contains + + generic,public :: Init => Init_SELFConfig_FromFile !, Init_SELFConfig_FromCLI + procedure,private :: Init_SELFConfig_FromFile + !PROCEDURE, PRIVATE :: Init_SELFConfig_FromCLI + + !GENERIC, PUBLIC :: LoadSchema => LoadSchema_SELFConfig_FromFile + !PROCEDURE, PRIVATE :: LoadSchema_SELFConfig_FromFile + + generic,public :: LoadConcretization => LoadConcretization_SELFConfig_FromFile + procedure,private :: LoadConcretization_SELFConfig_FromFile + + procedure,public :: Free => Free_SELFConfig + + generic,public :: Get => Get_SELFConfig_int32, & + Get_SELFConfig_int64, & + Get_SELFConfig_real32, & + Get_SELFConfig_real64, & + Get_SELFConfig_logical, & + Get_SELFConfig_char + + procedure,private :: Get_SELFConfig_int32 + procedure,private :: Get_SELFConfig_int64 + procedure,private :: Get_SELFConfig_real32 + procedure,private :: Get_SELFConfig_real64 + procedure,private :: Get_SELFConfig_logical + procedure,private :: Get_SELFConfig_char + + endtype SELFConfig + + integer,parameter :: SELF_JSON_DEFAULT_KEY_LENGTH = 200 + integer,parameter :: SELF_JSON_DEFAULT_VALUE_LENGTH = 200 + +contains + + subroutine Init_SELFConfig_FromFile(this,concretizationFile) + implicit none + class(SELFConfig),intent(out) :: this + character(*),intent(in) :: concretizationFile + + !CALL this % LoadSchema( schemaFile ) + call this%LoadConcretization(concretizationFile) + + endsubroutine Init_SELFConfig_FromFile + +! SUBROUTINE Init_SELFConfig_FromCLI( this ) +! #undef __FUNC__ +! #define __FUNC__ "Init" +! IMPLICIT NONE +! CLASS(SELFConfig), INTENT(out) :: this +! ! Local +! CHARACTER(LEN=SELF_FILE_DEFAULT_LENGTH) :: concretizationFile +! CHARACTER(LEN=200) :: SELF_PREFIX +! LOGICAL :: fileExists + +! ! Set Default configuration file to +! ! ${SELF_PREFIX}/etc/schema/defaults/self.json +! CALL get_environment_variable("SELF_PREFIX", SELF_PREFIX) +! concretizationFile = TRIM(SELF_PREFIX)//"/etc/schema/defaults/self.json" + +! IF ( CommandLineArgumentIsPresent(argument = "-i") ) THEN +! concretizationFile = StringValueForArgument(argument = "-i") +! END IF +! INFO("Using configuration file : "//TRIM(concretizationFile)) +! INQUIRE(FILE=TRIM(concretizationFile), EXIST=fileExists ) +! IF( fileExists )THEN +! CALL this % LoadConcretization( TRIM(concretizationFile) ) +! ELSE +! ERROR("Configuration file does not exist : "//TRIM(concretizationFile)) +! STOP 1 +! ENDIF + +! END SUBROUTINE Init_SELFConfig_FromCLI + + ! SUBROUTINE LoadSchema_SELFConfig_FromFile( this, schemaFile ) + ! !! Loads schema from file and stores in schema attribute + ! IMPLICIT NONE + ! CLASS(SELFConfig), INTENT(out) :: this + ! CHARACTER(*), INTENT(in) :: schemaFile + + ! this % schemaFile = schemaFile + ! CALL this % schema % initialize(stop_on_error = .true., & + ! comment_char = '#') + + ! CALL this % schema % load_file(filename = TRIM(schemaFile)) + + ! CALL this % schema % print_file() + + ! END SUBROUTINE LoadSchema_SELFConfig_FromFile + + subroutine LoadConcretization_SELFConfig_FromFile(this,concretizationFile) + !! Loads a concretization and stores in concretization attributes + implicit none + class(SELFConfig),intent(out) :: this + character(*),intent(in) :: concretizationFile + + call this%concretization%initialize(stop_on_error=.true., & + comment_char='#') + + call this%concretization%load_file(filename=trim(concretizationFile)) + + !CALL get_environment_variable("SELF_DEBUG", SELF_DEBUG) + !IF (SELF_DEBUG == 1)THEN + ! CALL this % concretization % print_file() + !ENDIF + endsubroutine LoadConcretization_SELFConfig_FromFile + + subroutine Free_SELFConfig(this) + !! Frees the attributes of the SELFConfig class and reset the config attribute + !! to an empty string + implicit none + class(SELFConfig),intent(inout) :: this + + !CALL this % schema % destroy() + call this%concretization%destroy() + ! this % schemaFile = "" + + endsubroutine Free_SELFConfig + + subroutine Get_SELFConfig_int32(this,jsonKey,res) + implicit none + class(SELFConfig),intent(inout) :: this + character(*),intent(in) :: jsonKey + integer(int32),intent(out) :: res + ! Local + logical :: found + + call this%concretization%get(trim(jsonKey),res,found) + if(.not. found) then + print*,"JSON key not found : "//trim(jsonKey) + stop 1 + endif + + endsubroutine Get_SELFConfig_int32 + + subroutine Get_SELFConfig_int64(this,jsonKey,res) + implicit none + class(SELFConfig),intent(inout) :: this + character(*),intent(in) :: jsonKey + integer(int64),intent(out) :: res + ! Local + logical :: found + integer(int32) :: res32 + + call this%concretization%get(trim(jsonKey),res32,found) + if(.not. found) then + print*,"JSON key not found : "//trim(jsonKey) + stop 1 + endif + res = int(res32,kind=int64) + + endsubroutine Get_SELFConfig_int64 + + subroutine Get_SELFConfig_real32(this,jsonKey,res) + implicit none + class(SELFConfig),intent(inout) :: this + character(*),intent(in) :: jsonKey + real(real32),intent(out) :: res + ! Local + logical :: found + + call this%concretization%get(trim(jsonKey),res,found) + if(.not. found) then + print*,"JSON key not found : "//trim(jsonKey) + stop 1 + endif + + endsubroutine Get_SELFConfig_real32 + + subroutine Get_SELFConfig_real64(this,jsonKey,res) + implicit none + class(SELFConfig),intent(inout) :: this + character(*),intent(in) :: jsonKey + real(real64),intent(out) :: res + ! Local + logical :: found + + call this%concretization%get(trim(jsonKey),res,found) + if(.not. found) then + print*,"JSON key not found : "//trim(jsonKey) + stop 1 + endif + + endsubroutine Get_SELFConfig_real64 + + subroutine Get_SELFConfig_logical(this,jsonKey,res) + implicit none + class(SELFConfig),intent(inout) :: this + character(*),intent(in) :: jsonKey + logical,intent(out) :: res + ! Local + logical :: found + + call this%concretization%get(trim(jsonKey),res,found) + if(.not. found) then + print*,"JSON key not found : "//trim(jsonKey) + stop 1 + endif + + endsubroutine Get_SELFConfig_logical + + subroutine Get_SELFConfig_char(this,jsonKey,res) + implicit none + class(SELFConfig),intent(inout) :: this + character(*),intent(in) :: jsonKey + character(*),intent(out) :: res + ! Local + logical :: found + character(LEN=:),allocatable :: resLoc + + call this%concretization%get(trim(jsonKey),resLoc,found) + if(.not. found) then + print*,"JSON key not found : "//trim(jsonKey) + stop 1 + endif + res = trim(resLoc) + + endsubroutine Get_SELFConfig_char + +endmodule SELF_JSON_Config From 12308a8f9fe454d6a260c0c67fdb4f6d7c788964 Mon Sep 17 00:00:00 2001 From: Joe Date: Tue, 4 Feb 2025 16:05:22 -0500 Subject: [PATCH 03/17] Fix build errors and add self interface library --- CMakeLists.txt | 19 ++++- src/CMakeLists.txt | 19 +---- src/SELF_GFDLES3D_t.f90 | 2 +- src/SELF_LinearShallowWater2D_t.f90 | 2 + .../interface}/SELF_Model_Interface.f90 | 54 ++++++++---- src/json/CMakeLists.txt | 82 ------------------- 6 files changed, 61 insertions(+), 117 deletions(-) rename {pyself => src/interface}/SELF_Model_Interface.f90 (84%) delete mode 100644 src/json/CMakeLists.txt diff --git a/CMakeLists.txt b/CMakeLists.txt index 9f76cde71..f9defcc19 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -26,6 +26,7 @@ cmake_minimum_required(VERSION 3.21) cmake_policy(VERSION 3.21...3.27) +include(CMakePrintHelpers) # C Language is needed in order to verify Fortran compiler is C-interoperable project(SELF VERSION 1.0.0 @@ -38,7 +39,7 @@ option(SELF_ENABLE_EXAMPLES "Option to enable build of examples. (Default On)" option(SELF_ENABLE_GPU "Option to enable GPU backend. Requires either CUDA or HIP. (Default Off)" OFF) option(SELF_ENABLE_APU "Option to enable APU backend. Requires either CUDA or HIP. (Default Off)" OFF) option(SELF_ENABLE_DOUBLE_PRECISION "Option to enable double precision for floating point arithmetic. (Default On)" ON) - +option(SELF_ENABLE_MODELINTERFACE "Option to enable the model interface and JSON config class for SELF (Default Off)" OFF) set(SELF_MPIEXEC_NUMPROCS "2" CACHE STRING "The number of MPI ranks to use to launch MPI tests. Only used when launching test programs via ctest.") set(SELF_MPIEXEC_OPTIONS "" CACHE STRING "Any additional options, such as binding options, to use for MPI tests.Only used when launching test programs via ctest. Defaults to nothing") @@ -132,9 +133,17 @@ find_package(MPI COMPONENTS Fortran C REQUIRED) find_package(HDF5 REQUIRED Fortran) # JSON-Fortran -find_library(JSONFORTRAN_LIBRARIES NAMES jsonfortran OPTIONAL) -find_path(JSONFORTRAN_INCLUDE_DIRS json_module.mod) +if(SELF_ENABLE_MODELINTERFACE) + find_library(JSONFORTRAN_LIBRARIES NAMES jsonfortran REQUIRED) + find_path(JSONFORTRAN_INCLUDE_DIRS json_module.mod) +else() + # Allow the JSON Config class to be built if jsonfortran is found + find_library(JSONFORTRAN_LIBRARIES NAMES jsonfortran OPTIONAL) + find_path(JSONFORTRAN_INCLUDE_DIRS json_module.mod) +endif() +cmake_print_variables(JSONFORTRAN_LIBRARIES) +cmake_print_variables(JSONFORTRAN_INCLUDE_DIRS) # FEQ-Parse find_library(FEQPARSE_LIBRARIES NAMES feqparse REQUIRED) @@ -226,6 +235,10 @@ endif() # Libraries add_subdirectory(${CMAKE_SOURCE_DIR}/src) +if(SELF_ENABLE_MODELINTERFACE) + add_subdirectory(${CMAKE_SOURCE_DIR}/src/interface) +endif() + if(SELF_ENABLE_TESTING) enable_testing() add_subdirectory(${CMAKE_SOURCE_DIR}/test) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 4ad3a6a5a..6af7adb37 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -43,8 +43,9 @@ file(GLOB SELF_HEADERS "${CMAKE_CURRENT_SOURCE_DIR}/*.h") if(JSONFORTRAN_LIBRARIES) file(GLOB SELF_JSON_FSRC "${CMAKE_CURRENT_SOURCE_DIR}/json/*.f*") - file(APPEND SELF_FSRC "${SELF_JSON_FSRC}") endif() +#cmake_print_variables(SELF_JSON_FSRC) + # Enable pre-processing for source code set_source_files_properties( @@ -64,7 +65,7 @@ set_source_files_properties( set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/include) -add_library(self SHARED ${SELF_FSRC} ${SELF_BACKEND_CPPSRC} ${SELF_BACKEND_FSRC}) +add_library(self SHARED ${SELF_FSRC} ${SELF_JSON_FSRC} ${SELF_BACKEND_CPPSRC} ${SELF_BACKEND_FSRC}) #set_target_properties(self PROPERTIES OUTPUT_NAME "self") target_link_libraries(self PUBLIC @@ -90,16 +91,4 @@ install(TARGETS self LIBRARY DESTINATION lib PUBLIC_HEADER DESTINATION include) -install(DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/ DESTINATION include) - -# add_library(self-python SHARED ${SELF_FSRC} ${SELF_BACKEND_CPPSRC} ${SELF_BACKEND_FSRC}) -# target_link_libraries(self PUBLIC -# ${FEQPARSE_LIBRARIES} -# HDF5::HDF5 -# ${MPI_Fortran_LIBRARIES} -# ${BACKEND_LIBRARIES}) - -# target_include_directories(self PUBLIC -# ${FEQPARSE_INCLUDE_DIRS} -# ${HDF5_INCLUDE_DIRS} -# ${MPI_Fortran_INCLUDE_DIRS}) \ No newline at end of file +install(DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/ DESTINATION include) \ No newline at end of file diff --git a/src/SELF_GFDLES3D_t.f90 b/src/SELF_GFDLES3D_t.f90 index 1a341616c..6f96a9be7 100644 --- a/src/SELF_GFDLES3D_t.f90 +++ b/src/SELF_GFDLES3D_t.f90 @@ -422,7 +422,7 @@ pure function entropy_func_GFDLES3D_t(this,s) result(e) !pe = s(1)*this%g*z Potential energy ie = this%Cv*s(5)*(this%pressure(s)/this%p0)**(this%R/this%Cp) ! internal energy = rho*Cv*T - e = ke+e + e = ke+ie endfunction entropy_func_GFDLES3D_t ! pure function hbc3D_NoNormalFlow_GFDLES3D_t(this,s,nhat) result(exts) diff --git a/src/SELF_LinearShallowWater2D_t.f90 b/src/SELF_LinearShallowWater2D_t.f90 index b2eb52c94..eb4da93e8 100644 --- a/src/SELF_LinearShallowWater2D_t.f90 +++ b/src/SELF_LinearShallowWater2D_t.f90 @@ -34,6 +34,8 @@ module self_LinearShallowWater2D_t type,extends(dgmodel2d) :: LinearShallowWater2D_t real(prec) :: H = 0.0_prec ! uniform resting depth real(prec) :: g = 0.0_prec ! acceleration due to gravity + real(prec) :: f0 = 0.0_prec ! reference coriolis parameter (1/s) [for conveniently setting fCori] + real(prec) :: beta = 0.0_prec ! reference coriolis parameter variation with latitude (1/ms) [for conveniently setting fCori] real(prec) :: Cd = 0.0_prec ! Linear drag coefficient (1/s) type(MappedScalar2D) :: fCori ! The coriolis parameter diff --git a/pyself/SELF_Model_Interface.f90 b/src/interface/SELF_Model_Interface.f90 similarity index 84% rename from pyself/SELF_Model_Interface.f90 rename to src/interface/SELF_Model_Interface.f90 index 7a4fa1dac..628c1256e 100644 --- a/pyself/SELF_Model_Interface.f90 +++ b/src/interface/SELF_Model_Interface.f90 @@ -1,5 +1,5 @@ -module SELF_ModelInterface +module SELF_Model_Interface ! Core use SELF_Constants @@ -8,7 +8,6 @@ module SELF_ModelInterface use SELF_Geometry_1D use SELF_Geometry_2D use SELF_Geometry_3D - use SELF_MappedData use SELF_JSON_Config ! Models @@ -25,7 +24,7 @@ module SELF_ModelInterface implicit none - !type(SELFConfig) :: config + type(SELFConfig) :: config type(Lagrange),target,private :: interp !type(MPILayer),target :: decomp @@ -48,9 +47,10 @@ module SELF_ModelInterface integer,parameter,private :: MODEL_NAME_LENGTH = 50 - ! TO DO : Set character length - character(LEN=),private :: model_configuration_file - public :: Initialize,ForwardStep,WritePickupFile, !GetSolution, Finalize + character(LEN=500),private :: model_configuration_file + + ! Interfaces + public :: Initialize,ForwardStep,WritePickupFile!, !GetSolution, Finalize private :: GetBCFlagForChar,Init2DWorkspace,UpdateParameters,InitLinearShallowWater2D contains @@ -79,6 +79,28 @@ function GetBCFlagForChar(charFlag) result(intFlag) endselect endfunction GetBCFlagForChar + function GetQFlagForChar(charFlag) result(intFlag) + !! This method is used to return the integer flag from a char for boundary conditions + !! + implicit none + character(*),intent(in) :: charFlag + integer :: intFlag + + select case(UpperCase(trim(charFlag))) + + case("GAUSS") + intFlag = GAUSS + + case("GAUSS-LOBATTO") + intFlag = GAUSS_LOBATTO + + case DEFAULT + intFlag = 0 + + endselect + + endfunction GetQFlagForChar + subroutine Initialize(config_file) implicit none character(LEN=*),intent(in) :: config_file @@ -117,17 +139,17 @@ subroutine Init2DWorkspace() call config%Get("geometry.control_degree",controlDegree) call config%Get("geometry.target_degree",targetDegree) call config%Get("geometry.control_quadrature",qChar) - controlQuadrature = GetIntForChar(trim(qChar)) + controlQuadrature = GetQFlagForChar(trim(qChar)) call config%Get("geometry.target_quadrature",qChar) - targetQuadrature = GetIntForChar(trim(qChar)) + targetQuadrature = GetQFlagForChar(trim(qChar)) call config%Get("geometry.mesh_file",meshfile) call config%Get("geometry.uniform_boundary_condition",uniformBoundaryCondition) bcFlag = GetBCFlagForChar(uniformBoundaryCondition) - INFO("Mesh file : "//trim(meshfile)) + print*, "Using Mesh file : "//trim(meshfile) ! Read in mesh file and set the public mesh pointer to selfMesh2D call selfMesh2D%Read_HOPr(trim(meshfile)) - call mesh%ResetBoundaryConditionType(bcFlag) + call selfMesh2D%ResetBoundaryConditionType(bcFlag) selfMesh => selfMesh2D @@ -209,13 +231,13 @@ subroutine ForwardStep() ! Reload config call UpdateParameters() - call config%Get("time_options.io_interval",ioInterval) + call config%Get("time_options.update_interval",updateInterval) call config%Get("time_options.dt",dt) - this%dt = dt - targetTime = this%t+dt*real(updateInterval,prec) - call this%timeIntegrator(targetTime) - this%t = targetTime + selfModel%dt = dt + targetTime = selfModel%t+dt*real(updateInterval,prec) + call selfModel%timeIntegrator(targetTime) + selfModel%t = targetTime endsubroutine ForwardStep @@ -249,4 +271,4 @@ subroutine ForwardStep() ! ! CALL selfMesh % Free() ! ! CALL interp % Free() -endmodule SELF_Model_Interface +! endmodule SELF_Model_Interface diff --git a/src/json/CMakeLists.txt b/src/json/CMakeLists.txt deleted file mode 100644 index 481d0bb9e..000000000 --- a/src/json/CMakeLists.txt +++ /dev/null @@ -1,82 +0,0 @@ - -# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -# -# Maintainers : support@fluidnumerics.com -# Official Repository : https://github.com/FluidNumerics/self/ -# -# Copyright © 2024 Fluid Numerics LLC -# -# Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -# -# 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -# -# 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -# the documentation and/or other materials provided with the distribution. -# -# 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -# this software without specific prior written permission. -# -# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -# HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -# -# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// - -file(GLOB SELF_PYINT_FSRC "${CMAKE_CURRENT_SOURCE_DIR}/*.f*") - -# Enable pre-processing for source code -set_source_files_properties( - ${SELF_FSRC} - PROPERTIES Fortran_PREPROCESS ON -) - - -set_source_files_properties( - ${SELF_MODEL_FSRC} - PROPERTIES Fortran_PREPROCESS ON -) - -set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/include) - -add_library(self_interface SHARED ${SELF_PYINT_FSRC}) -#set_target_properties(self PROPERTIES OUTPUT_NAME "self") -target_link_libraries(self_interface PUBLIC - self - ${FEQPARSE_LIBRARIES} - HDF5::HDF5 - ${MPI_Fortran_LIBRARIES} - ${BACKEND_LIBRARIES} - ${JSONFORTRAN_LIBRARIES}) - -target_include_directories(self_interface PUBLIC - ${FEQPARSE_INCLUDE_DIRS} - ${HDF5_INCLUDE_DIRS} - ${MPI_Fortran_INCLUDE_DIRS} - ${JSONFORTRAN_INCLUDE_DIRS}) - -target_compile_options(self_interface PUBLIC -fPIC) - -set_target_properties(self_interface PROPERTIES LINKER_LANGUAGE Fortran) - -install(TARGETS self_interface - ARCHIVE DESTINATION lib - LIBRARY DESTINATION lib - PUBLIC_HEADER DESTINATION include) - -install(DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/ DESTINATION include) - -# if(JSONFORTRAN_LIBRARIES) -# add_library(self-python SHARED ${SELF_FSRC} ${SELF_BACKEND_CPPSRC} ${SELF_BACKEND_FSRC}) -# target_link_libraries(self PUBLIC -# ${FEQPARSE_LIBRARIES} -# HDF5::HDF5 -# ${MPI_Fortran_LIBRARIES} -# ${BACKEND_LIBRARIES}) - -# target_include_directories(self PUBLIC -# ${FEQPARSE_INCLUDE_DIRS} -# ${HDF5_INCLUDE_DIRS} -# ${MPI_Fortran_INCLUDE_DIRS}) \ No newline at end of file From 85e8ac91e9f3955244340995e9363b68e20f96e5 Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Sun, 2 Mar 2025 16:28:21 -0500 Subject: [PATCH 04/17] Add SelfModelConfig class on python side --- CMakeLists.txt | 13 ++- pyself/config.py | 108 ++++++++++++++++++ share/self.json | 51 ++++++--- src/CMakeLists.txt | 19 +-- src/{json => python}/CMakeLists.txt | 8 +- src/{json => python}/SELF_JSON_Config.f90 | 0 .../python}/SELF_Model_Interface.f90 | 1 + 7 files changed, 152 insertions(+), 48 deletions(-) create mode 100644 pyself/config.py rename src/{json => python}/CMakeLists.txt (97%) rename src/{json => python}/SELF_JSON_Config.f90 (100%) rename {pyself => src/python}/SELF_Model_Interface.f90 (99%) diff --git a/CMakeLists.txt b/CMakeLists.txt index 9f76cde71..c88072eda 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -38,6 +38,7 @@ option(SELF_ENABLE_EXAMPLES "Option to enable build of examples. (Default On)" option(SELF_ENABLE_GPU "Option to enable GPU backend. Requires either CUDA or HIP. (Default Off)" OFF) option(SELF_ENABLE_APU "Option to enable APU backend. Requires either CUDA or HIP. (Default Off)" OFF) option(SELF_ENABLE_DOUBLE_PRECISION "Option to enable double precision for floating point arithmetic. (Default On)" ON) +option(SELF_ENABLE_PYTHON "Option to enable Python interface. (Default Off)" OFF) set(SELF_MPIEXEC_NUMPROCS "2" CACHE STRING "The number of MPI ranks to use to launch MPI tests. Only used when launching test programs via ctest.") set(SELF_MPIEXEC_OPTIONS "" CACHE STRING "Any additional options, such as binding options, to use for MPI tests.Only used when launching test programs via ctest. Defaults to nothing") @@ -131,11 +132,6 @@ find_package(MPI COMPONENTS Fortran C REQUIRED) # HDF5 : See https://cmake.org/cmake/help/latest/module/FindHDF5.html find_package(HDF5 REQUIRED Fortran) -# JSON-Fortran -find_library(JSONFORTRAN_LIBRARIES NAMES jsonfortran OPTIONAL) -find_path(JSONFORTRAN_INCLUDE_DIRS json_module.mod) - - # FEQ-Parse find_library(FEQPARSE_LIBRARIES NAMES feqparse REQUIRED) find_path(FEQPARSE_INCLUDE_DIRS feqparse.mod) @@ -226,6 +222,13 @@ endif() # Libraries add_subdirectory(${CMAKE_SOURCE_DIR}/src) +if(SELF_ENABLE_PYTHON) + # JSON-Fortran + find_library(JSONFORTRAN_LIBRARIES NAMES jsonfortran REQUIRED) + find_path(JSONFORTRAN_INCLUDE_DIRS json_module.mod) + add_subdirectory(${CMAKE_SOURCE_DIR}/src/python) +endif() + if(SELF_ENABLE_TESTING) enable_testing() add_subdirectory(${CMAKE_SOURCE_DIR}/test) diff --git a/pyself/config.py b/pyself/config.py new file mode 100644 index 000000000..da89b90fb --- /dev/null +++ b/pyself/config.py @@ -0,0 +1,108 @@ +import json +from typing import Optional, Dict, Any + +class SelfModelConfig: + def __init__(self, config_file: Optional[str] = None, case_directory: Optional[str] = None): + """Initialize the SELF model configuration from a JSON file or defaults.""" + self.config = self.default_config() + + self.config_file = config_file + + if config_file: + self.load_config(config_file) + + if case_directory: + self.case_directory = case_directory + else: + self.case_directory = "." + + + + @staticmethod + def default_config() -> Dict[str, Any]: + """Return default configuration based on the JSON schema.""" + return { + "version": "v0.0.0", + "model_name": "linear-shallow-water-2d", + "geometry": { + "mesh_file": "", + "uniform_boundary_condition": "no_normal_flow", + "control_degree": 7, + "control_quadrature": "gauss", + "target_degree": 10, + "target_quadrature": "uniform", + "nX": 5, + "nY": 5, + "nZ": 5, + "nTx": 1, + "nTy": 1, + "nTz": 1, + "dx": 0.02, + "dy": 0.02, + "dz": 0.02 + }, + "time_options": { + "integrator": "euler", + "dt": 0.001, + "cfl_max": 0.5, + "start_time": 0.0, + "duration": 1.0, + "io_interval": 0.1, + "update_interval": 50 + }, + "units": { + "time": "s", + "length": "m", + "mass": "kg" + }, + "linear-shallow-water-2d": { + "g": 1.0, + "H": 1.0, + "Cd": 0.01, + "f0": 0.0, + "beta": 0.0, + "initial_conditions": { + "geostrophic_balance": false, + "file": "" + "u": 0.0, + "v": 0.0, + "eta": 0.0 + }, + "boundary_conditions": { + "time_deppendent": false, + "dt": 0.0, + "from_initial_conditions": false, + "u": 0.0, + "v": 0.0, + "eta": 0.0 + } + } + } + + def load_config(self, file_path: str): + """Load configuration from a JSON file.""" + with open(file_path, "r") as f: + self.config.update(json.load(f)) + + def save_config(self, file_path: str): + """Save configuration to a JSON file.""" + with open(file_path, "w") as f: + json.dump(self.config, f, indent=4) + + def set_parameter(self, section: str, key: str, value: Any): + """Set a specific parameter within the configuration.""" + if section in self.config and key in self.config[section]: + self.config[section][key] = value + else: + raise KeyError(f"Invalid section '{section}' or key '{key}'.") + + def get_parameter(self, section: str, key: str) -> Any: + """Retrieve a specific parameter value.""" + return self.config.get(section, {}).get(key, None) + + +# Example Usage +config = SelfModelConfig() +config.set_parameter("geometry", "nX", 10) +config.set_parameter("time_options", "dt", 0.005) +print(config.generate_fortran_input()) diff --git a/share/self.json b/share/self.json index 632a3991e..cf5fed390 100644 --- a/share/self.json +++ b/share/self.json @@ -73,35 +73,50 @@ "default": "uniform" }, "nX": { - "description": "Number of points in the x-direction for structured grid generation.", + "description": "Number of points in the x-direction per tile for structured grid generation.", "type": "integer", - "default": 3 + "default": 5 }, "nY": { - "description": "Number of points in the y-direction for structured grid generation.", + "description": "Number of points in the y-direction per tile for structured grid generation.", "type": "integer", - "default": 3 + "default": 5 }, - "x0": { - "description": "First point in the x-direction for structured grid generation.", - "type": "number", - "default": 0 + "nZ": { + "description": "Number of points in the y-direction per tile for structured grid generation.", + "type": "integer", + "default": 5 }, - "xN": { - "description": "Last point in the x-direction for structured grid generation.", - "type": "number", + "nTx": { + "description": "Number of tiles in the x-direction for structured grid generation.", + "type": "integer", + "default": 1 + }, + "nTy": { + "description": "Number of tiles in the x-direction for structured grid generation.", + "type": "integer", "default": 1 }, - "y0": { - "description": "First point in the y-direction for structured grid generation.", + "nTz": { + "description": "Number of tiles in the x-direction for structured grid generation.", + "type": "integer", + "default": 1 + }, + "dx": { + "description": "Element width in the x-direction.", "type": "number", - "default": 0 + "default": 0.02 }, - "yN": { - "description": "Last point in the y-direction for structured grid generation.", + "dy": { + "description": "Element width in the y-direction.", "type": "number", - "default": 0 - } + "default": 0.02 + }, + "dz": { + "description": "Element width in the z-direction.", + "type": "number", + "default": 0.02 + } }, "time_options": { diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 4ad3a6a5a..ccc1ef059 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -57,15 +57,10 @@ set_source_files_properties( PROPERTIES Fortran_PREPROCESS ON ) -set_source_files_properties( - ${SELF_MODEL_FSRC} - PROPERTIES Fortran_PREPROCESS ON -) set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/include) add_library(self SHARED ${SELF_FSRC} ${SELF_BACKEND_CPPSRC} ${SELF_BACKEND_FSRC}) -#set_target_properties(self PROPERTIES OUTPUT_NAME "self") target_link_libraries(self PUBLIC ${FEQPARSE_LIBRARIES} @@ -90,16 +85,4 @@ install(TARGETS self LIBRARY DESTINATION lib PUBLIC_HEADER DESTINATION include) -install(DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/ DESTINATION include) - -# add_library(self-python SHARED ${SELF_FSRC} ${SELF_BACKEND_CPPSRC} ${SELF_BACKEND_FSRC}) -# target_link_libraries(self PUBLIC -# ${FEQPARSE_LIBRARIES} -# HDF5::HDF5 -# ${MPI_Fortran_LIBRARIES} -# ${BACKEND_LIBRARIES}) - -# target_include_directories(self PUBLIC -# ${FEQPARSE_INCLUDE_DIRS} -# ${HDF5_INCLUDE_DIRS} -# ${MPI_Fortran_INCLUDE_DIRS}) \ No newline at end of file +install(DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/ DESTINATION include) \ No newline at end of file diff --git a/src/json/CMakeLists.txt b/src/python/CMakeLists.txt similarity index 97% rename from src/json/CMakeLists.txt rename to src/python/CMakeLists.txt index 481d0bb9e..ea1d92b92 100644 --- a/src/json/CMakeLists.txt +++ b/src/python/CMakeLists.txt @@ -29,13 +29,7 @@ file(GLOB SELF_PYINT_FSRC "${CMAKE_CURRENT_SOURCE_DIR}/*.f*") # Enable pre-processing for source code set_source_files_properties( - ${SELF_FSRC} - PROPERTIES Fortran_PREPROCESS ON -) - - -set_source_files_properties( - ${SELF_MODEL_FSRC} + ${SELF_PYINT_FSRC} PROPERTIES Fortran_PREPROCESS ON ) diff --git a/src/json/SELF_JSON_Config.f90 b/src/python/SELF_JSON_Config.f90 similarity index 100% rename from src/json/SELF_JSON_Config.f90 rename to src/python/SELF_JSON_Config.f90 diff --git a/pyself/SELF_Model_Interface.f90 b/src/python/SELF_Model_Interface.f90 similarity index 99% rename from pyself/SELF_Model_Interface.f90 rename to src/python/SELF_Model_Interface.f90 index 7a4fa1dac..5bfff2293 100644 --- a/pyself/SELF_Model_Interface.f90 +++ b/src/python/SELF_Model_Interface.f90 @@ -79,6 +79,7 @@ function GetBCFlagForChar(charFlag) result(intFlag) endselect endfunction GetBCFlagForChar + subroutine Initialize(config_file) implicit none character(LEN=*),intent(in) :: config_file From 0e1ea7fa1cb99aa3275479366252dac1419c2bd2 Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Sun, 2 Mar 2025 16:47:43 -0500 Subject: [PATCH 05/17] Draft model interface from python side --- .pre-commit-config.yaml | 11 +++++++++++ pyself/interface.py | 42 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 53 insertions(+) create mode 100644 pyself/interface.py diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index 73fa638ef..48f4ca0c4 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -1,4 +1,15 @@ repos: + - repo: https://github.com/pre-commit/pre-commit-hooks + rev: v5.0.0 + hooks: + - id: check-yaml + - id: end-of-file-fixer + - id: trailing-whitespace + - repo: https://github.com/psf/black-pre-commit-mirror + rev: 25.1.0 + hooks: + - id: black + language_version: python3 - repo: local hooks: - id: fprettify diff --git a/pyself/interface.py b/pyself/interface.py new file mode 100644 index 000000000..880630b23 --- /dev/null +++ b/pyself/interface.py @@ -0,0 +1,42 @@ +#!/usr/bin/env python + + +from pyself.config import SelfModelConfig + + +## Add ctypes interface to fortran library +from ctypes import CDLL, c_int, c_double, c_char_p, POINTER, c_void_p +import os + +# Load the fortran library +lib = CDLL(os.path.join(os.path.dirname(__file__), "libself_interface.so")) + + +class SelfModel: + def __init__(self, config: SelfModelConfig): + self.case_directory = case_directory + self.config = config + + # To do : Call fortran library to ininitialize the model + # To do : Add mpi support - pass communicator and rank to fortran library + InitializeModel(self.config.config_file) + self._initialized = True + + # def report_parameters(self): + + def set_parameter(self, section: str, key: str, value: Any): + self.config.set_parameter(section, key, value) + + def get_parameter(self, section: str, key: str, value: Any): + return self.config.get_parameter(section, key) + + # def forward_step(self): + + # def write_pickup_file(self): + + # def get_solution(self): + + # def finalize(self): + + # def run(self): + # print("Running SELF model...") From 84043bf2891561a9a227dcb99d79f23f5636757e Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Wed, 12 Mar 2025 15:58:18 -0400 Subject: [PATCH 06/17] Change build option to SELF_ENABLE_INTERFACE --- CMakeLists.txt | 29 +++++++++++++---------------- src/python/CMakeLists.txt | 37 ++++++++++++------------------------- 2 files changed, 25 insertions(+), 41 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index c88072eda..74778f03e 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,28 +1,28 @@ -# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -# +# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +# # Maintainers : support@fluidnumerics.com # Official Repository : https://github.com/FluidNumerics/self/ -# +# # Copyright © 2024 Fluid Numerics LLC -# +# # Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -# +# # 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -# +# # 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in # the documentation and/or other materials provided with the distribution. -# +# # 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from # this software without specific prior written permission. -# +# # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT # HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT # LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -# -# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +# +# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// cmake_minimum_required(VERSION 3.21) cmake_policy(VERSION 3.21...3.27) @@ -38,7 +38,7 @@ option(SELF_ENABLE_EXAMPLES "Option to enable build of examples. (Default On)" option(SELF_ENABLE_GPU "Option to enable GPU backend. Requires either CUDA or HIP. (Default Off)" OFF) option(SELF_ENABLE_APU "Option to enable APU backend. Requires either CUDA or HIP. (Default Off)" OFF) option(SELF_ENABLE_DOUBLE_PRECISION "Option to enable double precision for floating point arithmetic. (Default On)" ON) -option(SELF_ENABLE_PYTHON "Option to enable Python interface. (Default Off)" OFF) +option(SELF_ENABLE_INTERFACE "Option to enable Python interface. (Default Off)" OFF) set(SELF_MPIEXEC_NUMPROCS "2" CACHE STRING "The number of MPI ranks to use to launch MPI tests. Only used when launching test programs via ctest.") set(SELF_MPIEXEC_OPTIONS "" CACHE STRING "Any additional options, such as binding options, to use for MPI tests.Only used when launching test programs via ctest. Defaults to nothing") @@ -55,7 +55,7 @@ FortranCInterface_VERIFY() if(NOT FortranCInterface_VERIFIED_C) message(FATAL_ERROR "Fortran compiler must support C Interface") endif(NOT FortranCInterface_VERIFIED_C) - + if(NOT CMAKE_Fortran_COMPILER_SUPPORTS_F90) MESSAGE(FATAL_ERROR "Fortran compiler does not support F90") endif(NOT CMAKE_Fortran_COMPILER_SUPPORTS_F90) @@ -222,7 +222,7 @@ endif() # Libraries add_subdirectory(${CMAKE_SOURCE_DIR}/src) -if(SELF_ENABLE_PYTHON) +if(SELF_ENABLE_INTERFACE) # JSON-Fortran find_library(JSONFORTRAN_LIBRARIES NAMES jsonfortran REQUIRED) find_path(JSONFORTRAN_INCLUDE_DIRS json_module.mod) @@ -245,6 +245,3 @@ endif() # Share / etc resources install(DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}/share DESTINATION ${CMAKE_INSTALL_PREFIX}) - - - diff --git a/src/python/CMakeLists.txt b/src/python/CMakeLists.txt index ea1d92b92..cb1738e75 100644 --- a/src/python/CMakeLists.txt +++ b/src/python/CMakeLists.txt @@ -1,29 +1,29 @@ -# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -# +# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +# # Maintainers : support@fluidnumerics.com # Official Repository : https://github.com/FluidNumerics/self/ -# +# # Copyright © 2024 Fluid Numerics LLC -# +# # Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -# +# # 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -# +# # 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in # the documentation and/or other materials provided with the distribution. -# +# # 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from # this software without specific prior written permission. -# +# # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT # HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT # LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -# -# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +# +# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// file(GLOB SELF_PYINT_FSRC "${CMAKE_CURRENT_SOURCE_DIR}/*.f*") @@ -36,7 +36,7 @@ set_source_files_properties( set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/include) add_library(self_interface SHARED ${SELF_PYINT_FSRC}) -#set_target_properties(self PROPERTIES OUTPUT_NAME "self") +#set_target_properties(self PROPERTIES OUTPUT_NAME "self") target_link_libraries(self_interface PUBLIC self ${FEQPARSE_LIBRARIES} @@ -51,7 +51,7 @@ target_include_directories(self_interface PUBLIC ${MPI_Fortran_INCLUDE_DIRS} ${JSONFORTRAN_INCLUDE_DIRS}) -target_compile_options(self_interface PUBLIC -fPIC) +target_compile_options(self_interface PUBLIC -fPIC) set_target_properties(self_interface PROPERTIES LINKER_LANGUAGE Fortran) @@ -61,16 +61,3 @@ install(TARGETS self_interface PUBLIC_HEADER DESTINATION include) install(DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/ DESTINATION include) - -# if(JSONFORTRAN_LIBRARIES) -# add_library(self-python SHARED ${SELF_FSRC} ${SELF_BACKEND_CPPSRC} ${SELF_BACKEND_FSRC}) -# target_link_libraries(self PUBLIC -# ${FEQPARSE_LIBRARIES} -# HDF5::HDF5 -# ${MPI_Fortran_LIBRARIES} -# ${BACKEND_LIBRARIES}) - -# target_include_directories(self PUBLIC -# ${FEQPARSE_INCLUDE_DIRS} -# ${HDF5_INCLUDE_DIRS} -# ${MPI_Fortran_INCLUDE_DIRS}) \ No newline at end of file From ab374de85872e69644be6118fc7e04ad8dbdff17 Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Wed, 12 Mar 2025 15:59:14 -0400 Subject: [PATCH 07/17] Allow lib to be set dyamically in the SelfModel init --- pyself/interface.py | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/pyself/interface.py b/pyself/interface.py index 880630b23..7137a7e48 100644 --- a/pyself/interface.py +++ b/pyself/interface.py @@ -6,17 +6,28 @@ ## Add ctypes interface to fortran library from ctypes import CDLL, c_int, c_double, c_char_p, POINTER, c_void_p +from ctypes.util import find_library import os -# Load the fortran library -lib = CDLL(os.path.join(os.path.dirname(__file__), "libself_interface.so")) - class SelfModel: - def __init__(self, config: SelfModelConfig): + def __init__(self, config: SelfModelConfig, lib: str = None): self.case_directory = case_directory self.config = config + if lib is None: + try: + self.lib = CDLL(find_lib("self_interface")) + except: + raise Exception( + "Could not find the libself_interface.so library. Ensure your LD_LIBRARY_PATH includes the path for libself_interface.so" + ) + else: + # To do - check if path exists.. + # To do - must be libself_interface.so + self.lib = CDLL(lib) + # To do - exceptions on CDLL failures. + # To do : Call fortran library to ininitialize the model # To do : Add mpi support - pass communicator and rank to fortran library InitializeModel(self.config.config_file) @@ -39,4 +50,4 @@ def get_parameter(self, section: str, key: str, value: Any): # def finalize(self): # def run(self): - # print("Running SELF model...") + # print("Running SELF model..." From d3152bcb6ca2ea06698839d5db0dcabb15ed184c Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Wed, 12 Mar 2025 16:58:15 -0400 Subject: [PATCH 08/17] Add ctypes interface for fortran interface module. --- pyself/config.py | 41 +++++++------- pyself/interface.py | 74 +++++++++++++++++++++---- src/python/SELF_JSON_Config.f90 | 4 -- src/python/SELF_Model_Interface.f90 | 83 ++++++++++------------------- 4 files changed, 112 insertions(+), 90 deletions(-) diff --git a/pyself/config.py b/pyself/config.py index da89b90fb..e3c0c3064 100644 --- a/pyself/config.py +++ b/pyself/config.py @@ -1,22 +1,25 @@ import json from typing import Optional, Dict, Any +import os + class SelfModelConfig: - def __init__(self, config_file: Optional[str] = None, case_directory: Optional[str] = None): + def __init__( + self, config_file: Optional[str] = None, case_directory: Optional[str] = None + ): """Initialize the SELF model configuration from a JSON file or defaults.""" self.config = self.default_config() self.config_file = config_file - + if config_file: self.load_config(config_file) if case_directory: self.case_directory = case_directory + os.makedirs(self.case_directory, exist_ok=True) else: - self.case_directory = "." - - + self.case_directory = os.getcwd() @staticmethod def default_config() -> Dict[str, Any]: @@ -39,7 +42,7 @@ def default_config() -> Dict[str, Any]: "nTz": 1, "dx": 0.02, "dy": 0.02, - "dz": 0.02 + "dz": 0.02, }, "time_options": { "integrator": "euler", @@ -48,13 +51,9 @@ def default_config() -> Dict[str, Any]: "start_time": 0.0, "duration": 1.0, "io_interval": 0.1, - "update_interval": 50 - }, - "units": { - "time": "s", - "length": "m", - "mass": "kg" + "update_interval": 50, }, + "units": {"time": "s", "length": "m", "mass": "kg"}, "linear-shallow-water-2d": { "g": 1.0, "H": 1.0, @@ -63,10 +62,10 @@ def default_config() -> Dict[str, Any]: "beta": 0.0, "initial_conditions": { "geostrophic_balance": false, - "file": "" + "file": "", "u": 0.0, "v": 0.0, - "eta": 0.0 + "eta": 0.0, }, "boundary_conditions": { "time_deppendent": false, @@ -74,19 +73,19 @@ def default_config() -> Dict[str, Any]: "from_initial_conditions": false, "u": 0.0, "v": 0.0, - "eta": 0.0 - } - } + "eta": 0.0, + }, + }, } def load_config(self, file_path: str): - """Load configuration from a JSON file.""" + """Load configuration from a JSON file""" with open(file_path, "r") as f: self.config.update(json.load(f)) - def save_config(self, file_path: str): - """Save configuration to a JSON file.""" - with open(file_path, "w") as f: + def save_config(self): + """Save configuration to a JSON file in the self.case_directory.""" + with open(f"{self.case_directory}/model_input.json", "w") as f: json.dump(self.config, f, indent=4) def set_parameter(self, section: str, key: str, value: Any): diff --git a/pyself/interface.py b/pyself/interface.py index 7137a7e48..442d954b9 100644 --- a/pyself/interface.py +++ b/pyself/interface.py @@ -11,27 +11,52 @@ class SelfModel: - def __init__(self, config: SelfModelConfig, lib: str = None): + def __init__(self, config: SelfModelConfig = SelfModelConfig(), lib: str = None): self.case_directory = case_directory self.config = config + self._config_file = f"{self.config.case_directory}/model_input.json" if lib is None: try: - self.lib = CDLL(find_lib("self_interface")) + self._lib = CDLL(find_lib("self_interface")) except: raise Exception( "Could not find the libself_interface.so library. Ensure your LD_LIBRARY_PATH includes the path for libself_interface.so" ) else: - # To do - check if path exists.. - # To do - must be libself_interface.so - self.lib = CDLL(lib) - # To do - exceptions on CDLL failures. + # Library ust be libself_interface.so + if not lib.endswith("libself_interface.so"): + raise Exception("Library must be libself_interface.so") + # Library must exist + if not os.path.exists(lib): + raise Exception(f"Could not find the library {lib}") + try: + self._lib = CDLL(lib) + except: + raise Exception(f"Could not load the library {lib}") + + self._configure_interface() + + self._initialized = False + + def _configure_interface(self): + self._lib.Initialize.argtypes = [c_char_p] + self._lib.Initialize.restype = None + + self._lib.UpdateParameters.argtypes = [] + self._lib.UpdateParameters.restype = None + + self._lib.ForwardStep.argtypes = [c_double, c_double] # No arguments + self._lib.ForwardStep.restype = c_int # Function returns an integer - # To do : Call fortran library to ininitialize the model - # To do : Add mpi support - pass communicator and rank to fortran library - InitializeModel(self.config.config_file) - self._initialized = True + self.lib.WritePickupFile.argtypes = [c_char_p] + self.lib.WritePickupFile.restype = None + + # self.lib.get_solution.argtypes = [c_void_p] + # self.lib.get_solution.restype = POINTER(c_double) + + # self.lib.finalize.argtypes = [c_void_p] + # self.lib.finalize.restype = None # def report_parameters(self): @@ -41,7 +66,34 @@ def set_parameter(self, section: str, key: str, value: Any): def get_parameter(self, section: str, key: str, value: Any): return self.config.get_parameter(section, key) - # def forward_step(self): + def update_parameters(self): + self.config.save_config() + if self._initialized: + self._lib.UpdateParameters() + else: + raise Exception( + "Configuration file saved, but not pushed to model. Model is not initialized" + ) + + def initialize_model(self): + if not self._initialized: + # Save the config to the case directory + self.config.save_config() + # Call the initialize model function + self._lib.Initialize(self._config_file.encode("utf-8")) + + # To do, print out model parameters, nicely formatted + self._initialized = True + else: + raise Exception("Model is already initialized") + + def forward_step(self, dt, update_interval): + if not self._initialized: + self.initialize_model() + + err = self._lib.ForwardStep(c_double(dt), c_double(update_interval)) + + # To do: error handling # def write_pickup_file(self): diff --git a/src/python/SELF_JSON_Config.f90 b/src/python/SELF_JSON_Config.f90 index 1aed9ce37..239d59586 100644 --- a/src/python/SELF_JSON_Config.f90 +++ b/src/python/SELF_JSON_Config.f90 @@ -142,10 +142,6 @@ subroutine LoadConcretization_SELFConfig_FromFile(this,concretizationFile) call this%concretization%load_file(filename=trim(concretizationFile)) - !CALL get_environment_variable("SELF_DEBUG", SELF_DEBUG) - !IF (SELF_DEBUG == 1)THEN - ! CALL this % concretization % print_file() - !ENDIF endsubroutine LoadConcretization_SELFConfig_FromFile subroutine Free_SELFConfig(this) diff --git a/src/python/SELF_Model_Interface.f90 b/src/python/SELF_Model_Interface.f90 index 84a3a5f73..652ce85b5 100644 --- a/src/python/SELF_Model_Interface.f90 +++ b/src/python/SELF_Model_Interface.f90 @@ -19,8 +19,7 @@ module SELF_Model_Interface ! External use iso_fortran_env -! use HDF5 -! use FEQParse + use iso_c_binding implicit none @@ -47,11 +46,11 @@ module SELF_Model_Interface integer,parameter,private :: MODEL_NAME_LENGTH = 50 - character(LEN=500),private :: model_configuration_file + character(c_char,len=500),private :: model_configuration_file ! Interfaces - public :: Initialize,ForwardStep,WritePickupFile !, !GetSolution, Finalize - private :: GetBCFlagForChar,Init2DWorkspace,UpdateParameters,InitLinearShallowWater2D + public :: Initialize,ForwardStep,WritePickupFile,UpdateParameters !, !GetSolution, Finalize + private :: GetBCFlagForChar,Init2DWorkspace,InitLinearShallowWater2D contains @@ -102,11 +101,11 @@ function GetQFlagForChar(charFlag) result(intFlag) endfunction GetQFlagForChar - subroutine Initialize(config_file) + subroutine Initialize(config_file) bind(C,name="Initialize") implicit none - character(LEN=*),intent(in) :: config_file + character(kind=c_char,len=*),intent(in) :: config_file ! local - character(LEN=MODEL_NAME_LENGTH) :: modelname + character(len=MODEL_NAME_LENGTH) :: modelname call config%Init(config_file) model_configuration_file = config_file @@ -183,18 +182,26 @@ subroutine InitLinearShallowWater2D() endsubroutine InitLinearShallowWater2D - subroutine WritePickupFile() + subroutine WritePickupFile(case_directory) bind(C,name="WritePickupFile") implicit none + character(kind=c_char,len=*),intent(in) :: case_directory + ! Local + character(LEN=self_FileNameLength) :: pickupFile + character(13) :: timeStampString + + write(timeStampString,'(I13.13)') this%ioIterate + pickupFile = case_directory//'/solution.'//timeStampString//'.h5' select type(selfModel) type is(LinearShallowWater2D) - call selfModel%WriteModel() + call selfModel%WriteModel(pickupfile) endselect + endsubroutine WritePickupFile - subroutine UpdateParameters() + subroutine UpdateParameters() bind(c,name="UpdateParameters") implicit none call config%Free() @@ -222,54 +229,22 @@ subroutine UpdateParameters() endsubroutine UpdateParameters - subroutine ForwardStep() + function ForwardStep(dt,updateInterval) result(err) bind(c,name="ForwardStep") implicit none - - real(prec) :: dt + real(c_double) :: dt + real(c_double) :: updateInterval + integer(c_int) :: err + ! Local real(prec) :: targetTime - integer :: updateInterval - ! Reload config - call UpdateParameters() - - call config%Get("time_options.update_interval",updateInterval) - call config%Get("time_options.dt",dt) - - selfModel%dt = dt - targetTime = selfModel%t+dt*real(updateInterval,prec) + selfModel%dt = real(dt,prec) + targetTime = selfModel%t+selfModel%dt*real(updateInterval,prec) call selfModel%timeIntegrator(targetTime) selfModel%t = targetTime - endsubroutine ForwardStep - -endmodule SELF_Model_Interface - -! program SELF - -! use SELF_Main - -! implicit none -! ! Public - -! call InitializeSELF() + ! To do, check solution validity + err = 0 -! ! Show us which model we're running -! call selfModel % PrintType() + endfunction ForwardStep -! ! Set the model initial conditions -! call selfModel % SetInitialConditions(config) - -! ! Do the initial file IO -! call FileIO() -! ! Main time integration loop -! call MainLoop() -! ! Do the last file IO -! call FileIO() - -! ! Clean up [TO DO] -! ! CALL selfModel % Free() -! ! CALL selfGeometry % Free() -! ! CALL selfMesh % Free() -! ! CALL interp % Free() - -! endmodule SELF_Model_Interface +endmodule SELF_Model_Interface From ee0998d89077f363271b34e3d5b6ca595bf7c3f0 Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Wed, 12 Mar 2025 22:01:17 -0400 Subject: [PATCH 09/17] Add additional support methods for interface This adds the GetSolution, GetVariableName, and Finalize methods to the interface on the Fortran and python side. The UpdateParameters method now sets the time integrator based on the value in the case configuration file. A new method is added to report the precision used in SELF. --- pyself/config.py | 7 -- pyself/interface.py | 140 ++++++++++++++++++++++++---- src/SELF_Model.f90 | 10 ++ src/python/SELF_Model_Interface.f90 | 104 +++++++++++++++++---- 4 files changed, 221 insertions(+), 40 deletions(-) diff --git a/pyself/config.py b/pyself/config.py index e3c0c3064..5a197c0ba 100644 --- a/pyself/config.py +++ b/pyself/config.py @@ -98,10 +98,3 @@ def set_parameter(self, section: str, key: str, value: Any): def get_parameter(self, section: str, key: str) -> Any: """Retrieve a specific parameter value.""" return self.config.get(section, {}).get(key, None) - - -# Example Usage -config = SelfModelConfig() -config.set_parameter("geometry", "nX", 10) -config.set_parameter("time_options", "dt", 0.005) -print(config.generate_fortran_input()) diff --git a/pyself/interface.py b/pyself/interface.py index 442d954b9..f58618a24 100644 --- a/pyself/interface.py +++ b/pyself/interface.py @@ -36,10 +36,15 @@ def __init__(self, config: SelfModelConfig = SelfModelConfig(), lib: str = None) raise Exception(f"Could not load the library {lib}") self._configure_interface() + self._precision = self._lib.GetPrecision() + # self._dtype = {4: np.float32, 8: np.float64}[self._precision] + # self._cprec = {4: c_float, 8: c_double}[self._precision] self._initialized = False def _configure_interface(self): + """Private method to configure the interface to the Fortran library""" + self._lib.Initialize.argtypes = [c_char_p] self._lib.Initialize.restype = None @@ -49,24 +54,61 @@ def _configure_interface(self): self._lib.ForwardStep.argtypes = [c_double, c_double] # No arguments self._lib.ForwardStep.restype = c_int # Function returns an integer - self.lib.WritePickupFile.argtypes = [c_char_p] - self.lib.WritePickupFile.restype = None - - # self.lib.get_solution.argtypes = [c_void_p] - # self.lib.get_solution.restype = POINTER(c_double) - - # self.lib.finalize.argtypes = [c_void_p] - # self.lib.finalize.restype = None - - # def report_parameters(self): + self._lib.WritePickupFile.argtypes = [c_char_p] + self._lib.WritePickupFile.restype = c_char_p + + self._lib.GetSolution.argtypes = [ + POINTER(c_void_p), + POINTER(c_int * 5), + POINTER(c_int), + ] + self._lib.GetSolution.restype = None # Subroutine, no return + + self._lib.GetPrecision.argtypes = [] # No arguments + self._lib.GetPrecision.restype = c_int # Function returns an integer + + self.lib.Finalize.argtypes = [] + self.lib.Finalize.restype = None + + def report_config(self): + """Print the configuration to the console.""" + print("=" * 40) + print(" Model Configuration ".center(40, "=")) + print("=" * 40) + + print("\n[Model]") + model_name = self.config.config["model_name"] + print(f" SELF Configuration Version : {self.config.config['version']}") + print(f" Model Name : {model_name}") + print(f" Case Directory : {self.config.case_directory}") + print(f" Config File : {self._config_file}") + print(f" Precision : {self._precision}") + print(f" Initialized : {self._initialized}") + + print("\n[Geometry]") + for key, value in self.config.config["time_options"].items(): + print(f" {key.replace('_', ' ').capitalize()} : {value}") + + print("\n[Time Options]") + for key, value in self.config.config["time_options"].items(): + print(f" {key.replace('_', ' ').capitalize()} : {value}") + + print("\n[{model_name}]") + for key, value in self.config.config[model_name].items(): + print(json.dumps(value, indent=4)) def set_parameter(self, section: str, key: str, value: Any): + """Set a specific parameter within the model configuration.""" self.config.set_parameter(section, key, value) def get_parameter(self, section: str, key: str, value: Any): + """Retrieve a specific parameter from the model configuration.""" return self.config.get_parameter(section, key) def update_parameters(self): + """Push the configuration to the model by writing the configuration + to file and calling the Fortran-side UpdateParameters function.""" + self.config.save_config() if self._initialized: self._lib.UpdateParameters() @@ -75,7 +117,26 @@ def update_parameters(self): "Configuration file saved, but not pushed to model. Model is not initialized" ) + def set_time_integrator(self, integrator: str): + """Set the time integrator in the configuration file. The + selfModel.config attribut is updated and saved to the case directory + json file. + + Parameters: + ----------- + integrator (str): the time integrator to use. Must be one of + 'euler', 'rk2', 'rk3', or 'rk4' + """ + + self.config.set_parameter("time_options", "integrator", integrator) + self.config.save_config() + def initialize_model(self): + """Initialize the model by calling the Fortran Initialize function. + On the Fortran side this allocates memory and sets up the appropriate + data structures for the model, based on the configuration file. + On exit, the self._initialized flag is set to True.""" + if not self._initialized: # Save the config to the case directory self.config.save_config() @@ -87,19 +148,64 @@ def initialize_model(self): else: raise Exception("Model is already initialized") + def finalize_model(self): + """Finalize the model by calling the Fortran Finalize function. + On the Fortran side this deallocates memory and cleans up the model. + On exit, the self._initialized flag is set to False.""" + + if self._initialized: + self._lib.Finalize() + self._initialized = False + else: + raise Exception("Model is not initialized") + def forward_step(self, dt, update_interval): + """Advance the model forward in time by calling the Fortran ForwardStep function. + The function takes two arguments: the time step dt and the number of time steps to take. + The function returns an error code, which is 0 if the function executed successfully. + The time integrator is controlled by the configuration file in the + time_options.integrator setting""" + if not self._initialized: self.initialize_model() - err = self._lib.ForwardStep(c_double(dt), c_double(update_interval)) + if self._precision == 4: + err = self._lib.ForwardStep(c_float(dt), c_float(update_interval)) + else: + err = self._lib.ForwardStep(c_double(dt), c_double(update_interval)) + + return err - # To do: error handling + def write_pickup_file(self): + if not self._initialized: + raise Exception("Model is not initialized") + self._lib.WritePickupFile(self.config.case_directory.encode("utf-8")) - # def write_pickup_file(self): + def get_solution(self): + if not self._initialized: + raise Exception("Model is not initialized") + + # Get the solution + solution_ptr = c_void_p() + shape = (c_int * 5)() + rank = c_int() + precision = c_int() + self._lib.GetSolution(byref(solution_ptr), shape, byref(rank)) + + # Extract shape values + dim = [shape[i] for i in range(rank.value)] # Extract only relevant dimensions - # def get_solution(self): + # Convert void pointer to float or double pointer + if self._precision == 4: + data_ptr = ctypes.cast(solution_ptr, POINTER(c_float)) + else: + data_ptr = ctypes.cast(solution_ptr, POINTER(c_double)) + + # Convert to NumPy array (handling column-major storage) + solution = np.ctypeslib.as_array( + data_ptr, shape=tuple(reversed(dim)) + ) # Reverse shape for row-major order - # def finalize(self): + # To do: error handling - # def run(self): - # print("Running SELF model..." + return solution diff --git a/src/SELF_Model.f90 b/src/SELF_Model.f90 index 76c10abfb..3cdd8e7c4 100644 --- a/src/SELF_Model.f90 +++ b/src/SELF_Model.f90 @@ -112,6 +112,8 @@ module SELF_Model contains + procedure(SELF_FreeModel),deferred :: Free + procedure :: IncrementIOCounter procedure :: PrintType => PrintType_Model @@ -192,6 +194,14 @@ module SELF_Model endtype Model + interface + subroutine SELF_FreeModel(this) + import Model + implicit none + class(Model),intent(inout) :: this + endsubroutine SELF_FreeModel + endinterface + interface subroutine SELF_timeIntegrator(this,tn) use SELF_Constants,only:prec diff --git a/src/python/SELF_Model_Interface.f90 b/src/python/SELF_Model_Interface.f90 index 652ce85b5..0ba2393ae 100644 --- a/src/python/SELF_Model_Interface.f90 +++ b/src/python/SELF_Model_Interface.f90 @@ -12,9 +12,9 @@ module SELF_Model_Interface ! Models use SELF_Model - !use SELF_DGModel1D + use SELF_DGModel1D use SELF_DGModel2D - ! use SELF_DGModel3D + use SELF_DGModel3D use self_LinearShallowWater2D ! External @@ -49,7 +49,7 @@ module SELF_Model_Interface character(c_char,len=500),private :: model_configuration_file ! Interfaces - public :: Initialize,ForwardStep,WritePickupFile,UpdateParameters !, !GetSolution, Finalize + public :: Initialize,ForwardStep,WritePickupFile,UpdateParameters,GetSolution,GetPrecision,GetVariableName,Finalize private :: GetBCFlagForChar,Init2DWorkspace,InitLinearShallowWater2D contains @@ -123,6 +123,22 @@ subroutine Initialize(config_file) bind(C,name="Initialize") endsubroutine Initialize + subroutine Finalize() bind(C,name="Finalize") + implicit none + + call config%Free() + call selfModel%Free() + selfModel => null() + + ! Free the interpolant + call interp%Free() + + ! Free the mesh + + ! Free the geometry + + endsubroutine Finalize + subroutine Init2DWorkspace() implicit none ! Local @@ -182,30 +198,30 @@ subroutine InitLinearShallowWater2D() endsubroutine InitLinearShallowWater2D - subroutine WritePickupFile(case_directory) bind(C,name="WritePickupFile") + function WritePickupFile(case_directory) result(pickupFile) bind(C,name="WritePickupFile") implicit none - character(kind=c_char,len=*),intent(in) :: case_directory - ! Local + character(kind=c_char,len=*) :: case_directory character(LEN=self_FileNameLength) :: pickupFile + ! Local character(13) :: timeStampString write(timeStampString,'(I13.13)') this%ioIterate pickupFile = case_directory//'/solution.'//timeStampString//'.h5' + call selfModel%WriteModel(pickupfile) - select type(selfModel) - - type is(LinearShallowWater2D) - call selfModel%WriteModel(pickupfile) - - endselect - - endsubroutine WritePickupFile + endfunction WritePickupFile subroutine UpdateParameters() bind(c,name="UpdateParameters") implicit none + character(len=self_IntegratorTypeCharLength) :: timeIntegrator call config%Free() call config%Init(model_configuration_file) + + ! Set the time integrator + call config%Get("time_options.integrator",timeIntegrator) + call selfModel%SetTimeIntegrator(trim(timeIntegrator)) + select type(selfModel) type is(LinearShallowWater2D) @@ -231,8 +247,8 @@ subroutine UpdateParameters() bind(c,name="UpdateParameters") function ForwardStep(dt,updateInterval) result(err) bind(c,name="ForwardStep") implicit none - real(c_double) :: dt - real(c_double) :: updateInterval + real(c_prec) :: dt + real(c_prec) :: updateInterval integer(c_int) :: err ! Local real(prec) :: targetTime @@ -247,4 +263,60 @@ function ForwardStep(dt,updateInterval) result(err) bind(c,name="ForwardStep") endfunction ForwardStep + function GetPrecision() result(precision) bind(c,name="GetPrecision") + integer(c_int) :: precision + + precision = prec + + endfunction GetPrecision + + subroutine GetSolution(solution,solshape,ndim) bind(C,name="GetSolution") + type(c_ptr),intent(out) :: solution ! Pointer to data + integer(c_int),intent(out) :: solshape(5) ! Shape array (max 4D) + integer(c_int),intent(out) :: ndim ! Number of dimensions (3, 4, 5) + + select type(selfModel) + + class is(DGModel1D) + solshape(1:3) = shape(selfModel%solution%interior) + solshape(4:5) = 0 + ndim = 3 + call selfModel%solution%UpdateHost() + solution = c_loc(selfModel%solution%interior) + + class is(DGModel2D) + solshape(1:4) = shape(selfModel%solution%interior) + solshape(5) = 0 + ndim = 4 + call selfModel%solution%UpdateHost() + solution = c_loc(selfModel%solution%interior) + + class is(DGModel3D) + solshape(1:5) = shape(selfModel%solution%interior) + ndim = 5 + call selfModel%solution%UpdateHost() + solution = c_loc(selfModel%solution%interior) + + endselect + + endsubroutine GetSolution + + function GetVariableName() result(name) bind(c,name="GetVariableName") + character(kind=c_char,len=*) :: name + + select type(selfModel) + + class is(SELF_DGModel1D) + name = selfModel%solution%meta(ivar)%name + + class is(SELF_DGModel2D) + name = selfModel%solution%meta(ivar)%name + + class is(SELF_DGModel3D) + name = selfModel%solution%meta(ivar)%name + + endselect + + endfunction GetVariableName + endmodule SELF_Model_Interface From 75c8fb4219b8e63b023dc7fc62c92b499de2958d Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Thu, 13 Mar 2025 17:01:10 -0400 Subject: [PATCH 10/17] Set up generic interfaces for geometry, port all public interface methods to python ctypes layer --- pyself/geometry.py | 110 ++++-- pyself/interface.py | 66 +++- pyself/model2d.py | 128 ++++--- share/self.json | 6 +- src/SELF_Geometry.f90 | 36 ++ src/SELF_Geometry_1D.f90 | 76 ++-- src/SELF_Geometry_2D.f90 | 180 ++++----- src/SELF_Geometry_3D.f90 | 304 +++++++-------- src/SELF_Mesh.f90 | 14 +- .../SELF_LinearShallowWater2D_Interface.f90 | 54 +++ src/python/SELF_Model_Interface.f90 | 357 +++++++++++------- 11 files changed, 803 insertions(+), 528 deletions(-) create mode 100644 src/SELF_Geometry.f90 create mode 100644 src/python/SELF_LinearShallowWater2D_Interface.f90 diff --git a/pyself/geometry.py b/pyself/geometry.py index d00be626b..8c94b8337 100644 --- a/pyself/geometry.py +++ b/pyself/geometry.py @@ -27,7 +27,7 @@ # if 'controlgrid' in list(f.keys()): -# d = f['controlgrid/geometry/x/interior'] +# d = f['controlgrid/geometry/x/interior'] # self.nElem = d.shape[0] # nvar = d.shape[1] # N = d.shape[2] @@ -36,9 +36,9 @@ # else: # print(f"Error: /controlgrid group not found in {hdf5File}.") # return 1 - + # if 'targetgrid' in list(f.keys()): -# d = f['targetgrid/geometry/x/interior'] +# d = f['targetgrid/geometry/x/interior'] # self.nElem = d.shape[0] # nvar = d.shape[1] # N = d.shape[2] @@ -54,13 +54,27 @@ class semquad: def __init__(self): self.interp = lagrange.interp() - self.nElem = 0 # Number of elements - self.x = None # physical x-coordinates at quadrature points - self.y = None # physical y-coordinates at quadrature points - # self.dxds = None # Covariant basis vectors at quadrature points - # self.dsdx = None # Contravariant basis vectors at quadrature points - # self.J = None # Jacobian at quadrature points - self.daskChunkSize=1000 # number of elements per dask chunk + self.nElem = 0 # Number of elements + self.x = None # physical x-coordinates at quadrature points + self.x_name = "x" + self.x_units = None + self.y = None # physical y-coordinates at quadrature points + self.y_name = "y" + self.y_units = None + + self.daskChunkSize = 1000 # number of elements per dask chunk + + def set_coordinates(self, x, y): + self.x = x + self.y = y + self.nElem = x.shape[0] + + def set_units(self, units): + self.x_units = units + self.y_units = units + + def set_interpolant(self, interp: lagrange.interp): + self.interp = interp def load(self, hdf5File): """Loads in interpolant and geometry data from SELF model output""" @@ -69,20 +83,19 @@ def load(self, hdf5File): self.interp.load(hdf5File) - f = h5py.File(hdf5File, 'r') - if 'controlgrid' in list(f.keys()): + f = h5py.File(hdf5File, "r") + if "controlgrid" in list(f.keys()): - d = f['controlgrid/geometry/x_dim1'] + d = f["controlgrid/geometry/x_dim1"] self.nElem = d.shape[0] N = d.shape[2] - self.x = da.from_array(d, chunks=(self.daskChunkSize,N,N)) - d = f['controlgrid/geometry/x_dim2'] - self.y = da.from_array(d, chunks=(self.daskChunkSize,N,N)) + self.x = da.from_array(d, chunks=(self.daskChunkSize, N, N)) + d = f["controlgrid/geometry/x_dim2"] + self.y = da.from_array(d, chunks=(self.daskChunkSize, N, N)) self.x_name = "x" - self.x_units = f['controlgrid/geometry/metadata/units/1'] + self.x_units = f["controlgrid/geometry/metadata/units/1"] self.y_name = "y" - self.y_units = f['controlgrid/geometry/metadata/units/1'] - + self.y_units = f["controlgrid/geometry/metadata/units/1"] else: print(f"Error: /controlgrid group not found in {hdf5File}.") @@ -95,14 +108,32 @@ class semhex: def __init__(self): self.interp = lagrange.interp() - self.nElem = 0 # Number of elements - self.x = None # physical x-coordinates at quadrature points - self.y = None # physical y-coordinates at quadrature points - self.z = None # physical z-coordinates at quadrature points - # self.dxds = None # Covariant basis vectors at quadrature points - # self.dsdx = None # Contravariant basis vectors at quadrature points - # self.J = None # Jacobian at quadrature points - self.daskChunkSize=1000 # number of elements per dask chunk + self.nElem = 0 # Number of elements + self.x = None # physical x-coordinates at quadrature points + self.x_name = "x" + self.x_units = None + self.y = None # physical y-coordinates at quadrature points + self.y_name = "y" + self.y_units = None + self.z = None # physical z-coordinates at quadrature points + self.z_name = "z" + self.z_units = None + + self.daskChunkSize = 1000 # number of elements per dask chunk + + def set_coordinates(self, x, y, z): + self.x = x + self.y = y + self.z = z + self.nElem = x.shape[0] + + def set_units(self, units): + self.x_units = units + self.y_units = units + self.z_units = units + + def set_interpolant(self, interp: lagrange.interp): + self.interp = interp def load(self, hdf5File): """Loads in interpolant and geometry data from SELF model output""" @@ -111,27 +142,26 @@ def load(self, hdf5File): self.interp.load(hdf5File) - f = h5py.File(hdf5File, 'r') - if 'controlgrid' in list(f.keys()): + f = h5py.File(hdf5File, "r") + if "controlgrid" in list(f.keys()): - d = f['controlgrid/geometry/x_dim1'] + d = f["controlgrid/geometry/x_dim1"] self.nElem = d.shape[0] N = d.shape[2] - self.x = da.from_array(d, chunks=(self.daskChunkSize,N,N,N)) - d = f['controlgrid/geometry/x_dim2'] - self.y = da.from_array(d, chunks=(self.daskChunkSize,N,N,N)) - d = f['controlgrid/geometry/x_dim3'] - self.z = da.from_array(d, chunks=(self.daskChunkSize,N,N,N)) + self.x = da.from_array(d, chunks=(self.daskChunkSize, N, N, N)) + d = f["controlgrid/geometry/x_dim2"] + self.y = da.from_array(d, chunks=(self.daskChunkSize, N, N, N)) + d = f["controlgrid/geometry/x_dim3"] + self.z = da.from_array(d, chunks=(self.daskChunkSize, N, N, N)) self.x_name = "x" - self.x_units = f['controlgrid/geometry/metadata/units/1'] + self.x_units = f["controlgrid/geometry/metadata/units/1"] self.y_name = "y" - self.y_units = f['controlgrid/geometry/metadata/units/1'] + self.y_units = f["controlgrid/geometry/metadata/units/1"] self.y_name = "z" - self.y_units = f['controlgrid/geometry/metadata/units/1'] - + self.y_units = f["controlgrid/geometry/metadata/units/1"] else: print(f"Error: /controlgrid group not found in {hdf5File}.") return 1 - return 0 \ No newline at end of file + return 0 diff --git a/pyself/interface.py b/pyself/interface.py index f58618a24..ddf1a262a 100644 --- a/pyself/interface.py +++ b/pyself/interface.py @@ -5,16 +5,31 @@ ## Add ctypes interface to fortran library -from ctypes import CDLL, c_int, c_double, c_char_p, POINTER, c_void_p +from ctypes import ( + CDLL, + c_int, + c_double, + c_char_p, + POINTER, + c_void_p, + create_string_buffer, +) +import numpy as np from ctypes.util import find_library import os +_VAR_BUFFER_SIZE = 256 + class SelfModel: def __init__(self, config: SelfModelConfig = SelfModelConfig(), lib: str = None): self.case_directory = case_directory self.config = config self._config_file = f"{self.config.case_directory}/model_input.json" + self._solution = None + self._mesh = None + self._geometry = None + self._last_pickup_file = None if lib is None: try: @@ -46,7 +61,7 @@ def _configure_interface(self): """Private method to configure the interface to the Fortran library""" self._lib.Initialize.argtypes = [c_char_p] - self._lib.Initialize.restype = None + self._lib.Initialize.restype = c_int self._lib.UpdateParameters.argtypes = [] self._lib.UpdateParameters.restype = None @@ -54,8 +69,8 @@ def _configure_interface(self): self._lib.ForwardStep.argtypes = [c_double, c_double] # No arguments self._lib.ForwardStep.restype = c_int # Function returns an integer - self._lib.WritePickupFile.argtypes = [c_char_p] - self._lib.WritePickupFile.restype = c_char_p + self._lib.WritePickupFile.argtypes = [c_char_p, c_char_p] + self._lib.WritePickupFile.restype = None self._lib.GetSolution.argtypes = [ POINTER(c_void_p), @@ -64,6 +79,9 @@ def _configure_interface(self): ] self._lib.GetSolution.restype = None # Subroutine, no return + self._lib.GetVariableName.argtypes = [c_int, c_char_p] + self._lib.GetVariableName.restype = None + self._lib.GetPrecision.argtypes = [] # No arguments self._lib.GetPrecision.restype = c_int # Function returns an integer @@ -141,7 +159,11 @@ def initialize_model(self): # Save the config to the case directory self.config.save_config() # Call the initialize model function - self._lib.Initialize(self._config_file.encode("utf-8")) + error = self._lib.Initialize(self._config_file.encode("utf-8")) + if error != 0: + raise Exception( + f"Model returned error code {error} for model_name = {self.config.config['model_name']}" + ) # To do, print out model parameters, nicely formatted self._initialized = True @@ -177,9 +199,33 @@ def forward_step(self, dt, update_interval): return err def write_pickup_file(self): + """Write the pickup file by calling the Fortran WritePickupFile function. + The function takes a case directory as an argument and returns the name of the pickup file. + The pickup file is written to the case directory and follows the format "solution.X.h5", where + "X" is a 13-digit zero padded integer that corresponds to the iterate number in the simulation. + + Returns: + -------- + pickup_file (str): the name of the pickup file that was written to disk. + + """ if not self._initialized: raise Exception("Model is not initialized") - self._lib.WritePickupFile(self.config.case_directory.encode("utf-8")) + + # Prepare input and output buffers + case_directory = self.config.case_directory.encode( + "utf-8" + ) # Convert string to bytes (null-terminated) + pickup_file_buffer = create_string_buffer(buffer_size) # Preallocated buffer + + # Call the Fortran subroutine + self._lib.WritePickupFile(case_directory, pickup_file_buffer) + + pickup_file = pickup_file_buffer.value.decode("utf-8").strip() + self._last_pickup_file = pickup_file + + # Convert to Python string (remove null terminator and spaces) + return pickup_file def get_solution(self): if not self._initialized: @@ -206,6 +252,14 @@ def get_solution(self): data_ptr, shape=tuple(reversed(dim)) ) # Reverse shape for row-major order + self._solution = solution # Create a pointer to the data + # To do: error handling return solution + + def _get_variable_name(self, ivar): + variable_name_buffer = create_string_buffer(_VAR_BUFFER_SIZE) + self._lib.GetVariableName(c_int(ivar), variable_name_buffer) + + return variable_name_buffer.value.decode("utf-8").strip() diff --git a/pyself/model2d.py b/pyself/model2d.py index 03186ed89..761c61c99 100644 --- a/pyself/model2d.py +++ b/pyself/model2d.py @@ -3,16 +3,30 @@ # Other SELF modules +import numpy as np import pyself.geometry as geometry + class model: def __init__(self): self.solution = None - self.pvdata = None # Pyvista data + self.pvdata = None # Pyvista data self.varnames = None self.varunits = None self.geom = geometry.semquad() + def set_solution(self, solution: np.array): + self.solution = solution + + def set_varnames(self, varnames: List(str)): + self.varnames = varnames + + def set_varunits(self, varunits: List(str)): + self.varunits = varunits + + def set_geom(self, geom: geometry.semquad): + self.geom = geom + def load(self, hdf5File): """Loads in 2-D model from SELF model output""" import h5py @@ -20,15 +34,15 @@ def load(self, hdf5File): self.geom.load(hdf5File) - f = h5py.File(hdf5File, 'r') + f = h5py.File(hdf5File, "r") self.varnames = [] - - if 'controlgrid' in list(f.keys()): - controlgrid = f['controlgrid'] + if "controlgrid" in list(f.keys()): + + controlgrid = f["controlgrid"] for group_name in controlgrid.keys(): - if( group_name == 'geometry' ): + if group_name == "geometry": continue group = controlgrid[group_name] @@ -36,9 +50,9 @@ def load(self, hdf5File): setattr(self, group_name, []) group_data = getattr(self, group_name) print(f"Loading {group_name} group") - + # Load metadata information - if( 'metadata' in list(group.keys()) ): + if "metadata" in list(group.keys()): for v in group[f"metadata/name"].keys(): name = group[f"metadata/name/{v}"].asstr()[()][0] @@ -47,18 +61,16 @@ def load(self, hdf5File): except: units = "error" - group_data.append({ - "name": name, - "units": units, - 'data': None - }) + group_data.append({"name": name, "units": units, "data": None}) else: - print(f"Error: /controlgrid/{group_name}/metadata group not found in {hdf5File}.") + print( + f"Error: /controlgrid/{group_name}/metadata group not found in {hdf5File}." + ) return 1 for k in group.keys(): - k_decoded = k.encode('utf-8').decode('utf-8') - if k == 'metadata': + k_decoded = k.encode("utf-8").decode("utf-8") + if k == "metadata": continue else: print(f"Loading {k_decoded} field") @@ -69,12 +81,14 @@ def load(self, hdf5File): # Find index for this field i = 0 for sol in group_data: - if sol['name'] == k_decoded: + if sol["name"] == k_decoded: break else: i += 1 - group_data[i]['data'] = da.from_array(d, chunks=(self.geom.daskChunkSize, N, N)) + group_data[i]["data"] = da.from_array( + d, chunks=(self.geom.daskChunkSize, N, N) + ) self.generate_pyvista() @@ -82,59 +96,59 @@ def load(self, hdf5File): print(f"Error: /controlgrid group not found in {hdf5File}.") return 1 - return 0 + return 0 def generate_pyvista(self): """Generates pyvista polyData for each solution variable for plotting""" import numpy as np import pyvista as pv - (nelem, nx, ny) = self.solution[0]['data'].shape - n_points = nelem*nx*ny - n_faces = nelem*(nx-1)*(ny-1) + (nelem, nx, ny) = self.solution[0]["data"].shape + n_points = nelem * nx * ny + n_faces = nelem * (nx - 1) * (ny - 1) # Need to use the plot mesh to create a flat list of (x,y,z=0) points # number of points = (M+1)*(M+1)*nelem # dimension ordering (i,j,iel) # Get the x-y points in flattened array for building unstructured data - np_points = np.zeros((n_points,3)) - np_points[:,0] = self.geom.x.flatten() - np_points[:,1] = self.geom.y.flatten() + np_points = np.zeros((n_points, 3)) + np_points[:, 0] = self.geom.x.flatten() + np_points[:, 1] = self.geom.y.flatten() # Need to construct the faces from here.. # Number of faces = M*M*nelem - faces = np.zeros((n_faces,5),dtype=np.int64) + faces = np.zeros((n_faces, 5), dtype=np.int64) fid = 0 - for iel in range(0,nelem): - for j in range(0,ny-1): - for i in range(0,nx-1): + for iel in range(0, nelem): + for j in range(0, ny - 1): + for i in range(0, nx - 1): # lower left corner - n0 = i + nx*( j + ny*iel ) + n0 = i + nx * (j + ny * iel) # lower right corner - n1 = i+1 + nx*( j + ny*iel ) + n1 = i + 1 + nx * (j + ny * iel) # upper right corner - n2 = i+1 + nx*( j+1 + ny*iel ) + n2 = i + 1 + nx * (j + 1 + ny * iel) # upper left corner - n3 = i + nx*( j+1 + ny*iel ) + n3 = i + nx * (j + 1 + ny * iel) - faces[fid,:] = [4, n0, n1, n2, n3] + faces[fid, :] = [4, n0, n1, n2, n3] fid += 1 - + self.pvdata = pv.PolyData(np_points, faces) # Load fields into pvdata k = 0 for attr in self.__dict__: - if not attr in ['pvdata','varnames','varunits','geom']: + if not attr in ["pvdata", "varnames", "varunits", "geom"]: controlgroup = getattr(self, attr) - #print(f"Loading {attr} into pvdata") + # print(f"Loading {attr} into pvdata") for var in controlgroup: - # print(f"Loading {var['name']} into pvdata") - self.pvdata.point_data.set_array(var['data'].flatten(),var['name']) - k+=1 - + # print(f"Loading {var['name']} into pvdata") + self.pvdata.point_data.set_array(var["data"].flatten(), var["name"]) + k += 1 + print(self.pvdata) def update_from_file(self, hdf5File): @@ -142,24 +156,24 @@ def update_from_file(self, hdf5File): import h5py import dask.array as da - f = h5py.File(hdf5File, 'r') - - if 'controlgrid' in list(f.keys()): + f = h5py.File(hdf5File, "r") - controlgrid = f['controlgrid'] + if "controlgrid" in list(f.keys()): + + controlgrid = f["controlgrid"] for group_name in controlgrid.keys(): - if( group_name == 'geometry' ): + if group_name == "geometry": continue group = controlgrid[group_name] # Create a list to hold data for this group group_data = getattr(self, group_name) print(f"Loading {group_name} group") - + for k in group.keys(): - k_decoded = k.encode('utf-8').decode('utf-8') - if k == 'metadata': + k_decoded = k.encode("utf-8").decode("utf-8") + if k == "metadata": continue else: print(f"Loading {k_decoded} field") @@ -170,24 +184,28 @@ def update_from_file(self, hdf5File): # Find index for this field i = 0 for sol in group_data: - if sol['name'] == k_decoded: + if sol["name"] == k_decoded: break else: i += 1 - group_data[i]['data'] = da.from_array(d, chunks=(self.geom.daskChunkSize, N, N)) + group_data[i]["data"] = da.from_array( + d, chunks=(self.geom.daskChunkSize, N, N) + ) # # Load fields into pvdata k = 0 for attr in self.__dict__: - if not attr in ['pvdata','varnames','varunits','geom']: + if not attr in ["pvdata", "varnames", "varunits", "geom"]: controlgroup = getattr(self, attr) for var in controlgroup: - self.pvdata.point_data.set_array(var['data'].flatten(),var['name']) - k+=1 + self.pvdata.point_data.set_array( + var["data"].flatten(), var["name"] + ) + k += 1 else: print(f"Error: /controlgrid group not found in {hdf5File}.") return 1 - return 0 \ No newline at end of file + return 0 diff --git a/share/self.json b/share/self.json index cf5fed390..953fe4eaa 100644 --- a/share/self.json +++ b/share/self.json @@ -16,6 +16,8 @@ "enum": [ "burgers-1d", "linear-shallow-water-2d", + "linear-euler-2d", + "linear-euler-3d", "gfdles-3d" ] }, @@ -116,7 +118,7 @@ "description": "Element width in the z-direction.", "type": "number", "default": 0.02 - + } }, "time_options": { @@ -543,4 +545,4 @@ "time_options", "units" ] -} \ No newline at end of file +} diff --git a/src/SELF_Geometry.f90 b/src/SELF_Geometry.f90 new file mode 100644 index 000000000..c2038b992 --- /dev/null +++ b/src/SELF_Geometry.f90 @@ -0,0 +1,36 @@ +module SELF_Geometry + + use SELF_Constants + use SELF_Lagrange + + implicit none + + type,abstract :: SEMGeometry + integer :: nElem + contains + + procedure(SELF_InitGeometry),deferred :: Init + procedure(SELF_FreeGeometry),deferred:: Free + + endtype SEMGeometry + + interface + subroutine SELF_InitGeometry(this,interp,nElem) + import SEMGeometry + import Lagrange + implicit none + class(SEMGeometry),intent(out) :: this + type(Lagrange),pointer,intent(in) :: interp + integer,intent(in) :: nElem + endsubroutine SELF_InitGeometry + endinterface + + interface + subroutine SELF_FreeGeometry(this) + import SEMGeometry + implicit none + class(SEMGeometry),intent(inout) :: this + endsubroutine SELF_FreeGeometry + endinterface + +endmodule SELF_Geometry diff --git a/src/SELF_Geometry_1D.f90 b/src/SELF_Geometry_1D.f90 index 549b902d6..9e94dd005 100644 --- a/src/SELF_Geometry_1D.f90 +++ b/src/SELF_Geometry_1D.f90 @@ -32,13 +32,13 @@ module SELF_Geometry_1D use SELF_Scalar_1D use SELF_SupportRoutines use SELF_Mesh_1D + use SELF_Geometry implicit none - type,public :: Geometry1D + type,extends(SEMGeometry),public :: Geometry1D type(Scalar1D) :: x ! Physical Positions type(Scalar1D) :: dxds ! Conversion from computational to physical space - integer :: nElem contains @@ -53,38 +53,38 @@ module SELF_Geometry_1D contains - subroutine Init_Geometry1D(myGeom,interp,nElem) + subroutine Init_Geometry1D(this,interp,nElem) implicit none - class(Geometry1D),intent(out) :: myGeom + class(Geometry1D),intent(out) :: this type(Lagrange),pointer,intent(in) :: interp integer,intent(in) :: nElem - myGeom%nElem = nElem + this%nElem = nElem - call myGeom%x%Init(interp=interp, & - nVar=1, & - nElem=nElem) + call this%x%Init(interp=interp, & + nVar=1, & + nElem=nElem) - call myGeom%dxds%Init(interp=interp, & - nVar=1, & - nElem=nElem) + call this%dxds%Init(interp=interp, & + nVar=1, & + nElem=nElem) endsubroutine Init_Geometry1D - subroutine Free_Geometry1D(myGeom) + subroutine Free_Geometry1D(this) implicit none - class(Geometry1D),intent(inout) :: myGeom + class(Geometry1D),intent(inout) :: this - call myGeom%x%Free() - call myGeom%dxds%Free() + call this%x%Free() + call this%dxds%Free() endsubroutine Free_Geometry1D - subroutine GenerateFromMesh_Geometry1D(myGeom,mesh) + subroutine GenerateFromMesh_Geometry1D(this,mesh) ! Generates the geometry for a 1-D mesh ( set of line segments ) ! Assumes that mesh is using Gauss-Lobatto quadrature and the degree is given by mesh % nGeo implicit none - class(Geometry1D),intent(inout) :: myGeom + class(Geometry1D),intent(inout) :: this type(Mesh1D),intent(in) :: mesh ! Local integer :: iel,i,nid @@ -92,8 +92,8 @@ subroutine GenerateFromMesh_Geometry1D(myGeom,mesh) type(Scalar1D) :: xMesh call meshToModel%Init(mesh%nGeo,mesh%quadrature, & - myGeom%x%interp%N, & - myGeom%x%interp%controlNodeType) + this%x%interp%N, & + this%x%interp%controlNodeType) call xMesh%Init(meshToModel, & 1,mesh%nElem) @@ -108,11 +108,11 @@ subroutine GenerateFromMesh_Geometry1D(myGeom,mesh) enddo ! Interpolate from the mesh hopr_nodeCoords to the geometry (Possibly not gauss_lobatto quadrature) - call xMesh%GridInterp(myGeom%x%interior) - call myGeom%x%UpdateDevice() - call myGeom%x%BoundaryInterp() + call xMesh%GridInterp(this%x%interior) + call this%x%UpdateDevice() + call this%x%BoundaryInterp() - call myGeom%CalculateMetricTerms() + call this%CalculateMetricTerms() call xMesh%Free() @@ -120,19 +120,19 @@ subroutine GenerateFromMesh_Geometry1D(myGeom,mesh) endsubroutine GenerateFromMesh_Geometry1D - subroutine CalculateMetricTerms_Geometry1D(myGeom) + subroutine CalculateMetricTerms_Geometry1D(this) implicit none - class(Geometry1D),intent(inout) :: myGeom + class(Geometry1D),intent(inout) :: this - call myGeom%x%Derivative(myGeom%dxds%interior) - call myGeom%dxds%UpdateDevice() - call myGeom%dxds%BoundaryInterp() + call this%x%Derivative(this%dxds%interior) + call this%dxds%UpdateDevice() + call this%dxds%BoundaryInterp() endsubroutine CalculateMetricTerms_Geometry1D - subroutine Write_Geometry1D(myGeom,fileName) + subroutine Write_Geometry1D(this,fileName) implicit none - class(Geometry1D),intent(in) :: myGeom + class(Geometry1D),intent(in) :: this character(*),optional,intent(in) :: fileName ! Local integer(HID_T) :: fileId @@ -150,16 +150,16 @@ subroutine Write_Geometry1D(myGeom,fileName) call CreateGroup_HDF5(fileId,'/quadrature') call WriteArray_HDF5(fileId,'/quadrature/xi', & - myGeom%x%interp%controlPoints) + this%x%interp%controlPoints) call WriteArray_HDF5(fileId,'/quadrature/weights', & - myGeom%x%interp%qWeights) + this%x%interp%qWeights) call WriteArray_HDF5(fileId,'/quadrature/dgmatrix', & - myGeom%x%interp%dgMatrix) + this%x%interp%dgMatrix) call WriteArray_HDF5(fileId,'/quadrature/dmatrix', & - myGeom%x%interp%dMatrix) + this%x%interp%dMatrix) call CreateGroup_HDF5(fileId,'/mesh') @@ -167,13 +167,13 @@ subroutine Write_Geometry1D(myGeom,fileName) call CreateGroup_HDF5(fileId,'/mesh/boundary') - call WriteArray_HDF5(fileId,'/mesh/interior/x',myGeom%x%interior) + call WriteArray_HDF5(fileId,'/mesh/interior/x',this%x%interior) - call WriteArray_HDF5(fileId,'/mesh/interior/dxds',myGeom%dxds%interior) + call WriteArray_HDF5(fileId,'/mesh/interior/dxds',this%dxds%interior) - call WriteArray_HDF5(fileId,'/mesh/boundary/x',myGeom%x%boundary) + call WriteArray_HDF5(fileId,'/mesh/boundary/x',this%x%boundary) - call WriteArray_HDF5(fileId,'/mesh/boundary/dxds',myGeom%dxds%boundary) + call WriteArray_HDF5(fileId,'/mesh/boundary/dxds',this%dxds%boundary) call Close_HDF5(fileId) diff --git a/src/SELF_Geometry_2D.f90 b/src/SELF_Geometry_2D.f90 index 64033f314..75af20195 100644 --- a/src/SELF_Geometry_2D.f90 +++ b/src/SELF_Geometry_2D.f90 @@ -34,17 +34,17 @@ module SELF_Geometry_2D use SELF_Tensor_2D use SELF_SupportRoutines use SELF_Mesh_2D + use SELF_Geometry implicit none - type,public :: SEMQuad + type,extends(SEMGeometry),public :: SEMQuad type(Vector2D) :: x ! Physical positions type(Tensor2D) :: dxds ! Covariant basis vectors type(Tensor2D) :: dsdx ! Contavariant basis vectors type(Vector2D) :: nHat ! Normal Vectors pointing across coordinate lines type(Scalar2D) :: nScale ! Boundary scale type(Scalar2D) :: J ! Jacobian of the transformation - integer :: nElem contains procedure,public :: Init => Init_SEMQuad @@ -58,58 +58,58 @@ module SELF_Geometry_2D contains - subroutine Init_SEMQuad(myGeom,interp,nElem) + subroutine Init_SEMQuad(this,interp,nElem) implicit none - class(SEMQuad),intent(out) :: myGeom + class(SEMQuad),intent(out) :: this type(Lagrange),pointer,intent(in) :: interp integer,intent(in) :: nElem - myGeom%nElem = nElem + this%nElem = nElem - call myGeom%x%Init(interp=interp, & - nVar=1, & - nElem=nElem) + call this%x%Init(interp=interp, & + nVar=1, & + nElem=nElem) - call myGeom%x%meta(1)%SetName("x") + call this%x%meta(1)%SetName("x") - call myGeom%dxds%Init(interp=interp, & - nVar=1, & - nElem=nElem) + call this%dxds%Init(interp=interp, & + nVar=1, & + nElem=nElem) - call myGeom%dsdx%Init(interp=interp, & - nVar=1, & - nElem=nElem) + call this%dsdx%Init(interp=interp, & + nVar=1, & + nElem=nElem) + + call this%nHat%Init(interp=interp, & + nVar=1, & + nElem=nElem) - call myGeom%nHat%Init(interp=interp, & + call this%nScale%Init(interp=interp, & nVar=1, & nElem=nElem) - call myGeom%nScale%Init(interp=interp, & - nVar=1, & - nElem=nElem) - - call myGeom%J%Init(interp=interp, & - nVar=1, & - nElem=nElem) + call this%J%Init(interp=interp, & + nVar=1, & + nElem=nElem) endsubroutine Init_SEMQuad - subroutine Free_SEMQuad(myGeom) + subroutine Free_SEMQuad(this) implicit none - class(SEMQuad),intent(inout) :: myGeom + class(SEMQuad),intent(inout) :: this - call myGeom%x%Free() - call myGeom%dxds%Free() - call myGeom%dsdx%Free() - call myGeom%nHat%Free() - call myGeom%nScale%Free() - call myGeom%J%Free() + call this%x%Free() + call this%dxds%Free() + call this%dsdx%Free() + call this%nHat%Free() + call this%nScale%Free() + call this%J%Free() endsubroutine Free_SEMQuad - subroutine GenerateFromMesh_SEMQuad(myGeom,mesh) + subroutine GenerateFromMesh_SEMQuad(this,mesh) implicit none - class(SEMQuad),intent(inout) :: myGeom + class(SEMQuad),intent(inout) :: this type(Mesh2D),intent(in) :: mesh ! Local integer :: iel @@ -119,8 +119,8 @@ subroutine GenerateFromMesh_SEMQuad(myGeom,mesh) call meshToModel%Init(mesh%nGeo, & mesh%quadrature, & - myGeom%x%interp%N, & - myGeom%x%interp%controlNodeType) + this%x%interp%N, & + this%x%interp%controlNodeType) call xMesh%Init(meshToModel,1,mesh%nElem) @@ -133,20 +133,20 @@ subroutine GenerateFromMesh_SEMQuad(myGeom,mesh) enddo enddo - call xMesh%GridInterp(myGeom%x%interior) - call myGeom%x%UpdateDevice() - call myGeom%x%BoundaryInterp() ! Boundary interp will run on GPU if enabled, hence why we close in update host/device - call myGeom%x%UpdateHost() - call myGeom%CalculateMetricTerms() + call xMesh%GridInterp(this%x%interior) + call this%x%UpdateDevice() + call this%x%BoundaryInterp() ! Boundary interp will run on GPU if enabled, hence why we close in update host/device + call this%x%UpdateHost() + call this%CalculateMetricTerms() call xMesh%Free() call meshToModel%Free() endsubroutine GenerateFromMesh_SEMQuad - subroutine CalculateContravariantBasis_SEMQuad(myGeom) + subroutine CalculateContravariantBasis_SEMQuad(this) implicit none - class(SEMQuad),intent(inout) :: myGeom + class(SEMQuad),intent(inout) :: this ! Local integer :: iEl,i,j,k real(prec) :: fac @@ -155,104 +155,104 @@ subroutine CalculateContravariantBasis_SEMQuad(myGeom) ! Now calculate the contravariant basis vectors ! In this convention, dsdx(j,i) is contravariant vector i, component j ! To project onto contravariant vector i, dot vector along the first dimension - do iEl = 1,myGeom%nElem - do j = 1,myGeom%dxds%interp%N+1 - do i = 1,myGeom%dxds%interp%N+1 + do iEl = 1,this%nElem + do j = 1,this%dxds%interp%N+1 + do i = 1,this%dxds%interp%N+1 - myGeom%dsdx%interior(i,j,iel,1,1,1) = myGeom%dxds%interior(i,j,iel,1,2,2) - myGeom%dsdx%interior(i,j,iel,1,2,1) = -myGeom%dxds%interior(i,j,iel,1,1,2) - myGeom%dsdx%interior(i,j,iel,1,1,2) = -myGeom%dxds%interior(i,j,iel,1,2,1) - myGeom%dsdx%interior(i,j,iel,1,2,2) = myGeom%dxds%interior(i,j,iel,1,1,1) + this%dsdx%interior(i,j,iel,1,1,1) = this%dxds%interior(i,j,iel,1,2,2) + this%dsdx%interior(i,j,iel,1,2,1) = -this%dxds%interior(i,j,iel,1,1,2) + this%dsdx%interior(i,j,iel,1,1,2) = -this%dxds%interior(i,j,iel,1,2,1) + this%dsdx%interior(i,j,iel,1,2,2) = this%dxds%interior(i,j,iel,1,1,1) enddo enddo enddo ! Interpolate the contravariant tensor to the boundaries - call myGeom%dsdx%BoundaryInterp() ! Tensor boundary interp is not offloaded + call this%dsdx%BoundaryInterp() ! Tensor boundary interp is not offloaded ! Now, modify the sign of dsdx so that - ! myGeom % dsdx % boundary is equal to the outward pointing normal vector - do iEl = 1,myGeom%nElem + ! this % dsdx % boundary is equal to the outward pointing normal vector + do iEl = 1,this%nElem do k = 1,4 - do i = 1,myGeom%J%interp%N+1 + do i = 1,this%J%interp%N+1 if(k == selfSide2D_East .or. k == selfSide2D_North) then - fac = sign(1.0_prec,myGeom%J%boundary(i,k,iEl,1)) + fac = sign(1.0_prec,this%J%boundary(i,k,iEl,1)) else - fac = -sign(1.0_prec,myGeom%J%boundary(i,k,iEl,1)) + fac = -sign(1.0_prec,this%J%boundary(i,k,iEl,1)) endif if(k == 1) then ! South - mag = sqrt(myGeom%dsdx%boundary(i,k,iEl,1,1,2)**2+ & - myGeom%dsdx%boundary(i,k,iEl,1,2,2)**2) + mag = sqrt(this%dsdx%boundary(i,k,iEl,1,1,2)**2+ & + this%dsdx%boundary(i,k,iEl,1,2,2)**2) - myGeom%nScale%boundary(i,k,iEl,1) = mag + this%nScale%boundary(i,k,iEl,1) = mag - myGeom%nHat%boundary(i,k,iEl,1,1:2) = & - fac*myGeom%dsdx%boundary(i,k,iEl,1,1:2,2)/mag + this%nHat%boundary(i,k,iEl,1,1:2) = & + fac*this%dsdx%boundary(i,k,iEl,1,1:2,2)/mag elseif(k == 2) then ! East - mag = sqrt(myGeom%dsdx%boundary(i,k,iEl,1,1,1)**2+ & - myGeom%dsdx%boundary(i,k,iEl,1,2,1)**2) + mag = sqrt(this%dsdx%boundary(i,k,iEl,1,1,1)**2+ & + this%dsdx%boundary(i,k,iEl,1,2,1)**2) - myGeom%nScale%boundary(i,k,iEl,1) = mag + this%nScale%boundary(i,k,iEl,1) = mag - myGeom%nHat%boundary(i,k,iEl,1,1:2) = & - fac*myGeom%dsdx%boundary(i,k,iEl,1,1:2,1)/mag + this%nHat%boundary(i,k,iEl,1,1:2) = & + fac*this%dsdx%boundary(i,k,iEl,1,1:2,1)/mag elseif(k == 3) then ! North - mag = sqrt(myGeom%dsdx%boundary(i,k,iEl,1,1,2)**2+ & - myGeom%dsdx%boundary(i,k,iEl,1,2,2)**2) + mag = sqrt(this%dsdx%boundary(i,k,iEl,1,1,2)**2+ & + this%dsdx%boundary(i,k,iEl,1,2,2)**2) - myGeom%nScale%boundary(i,k,iEl,1) = mag + this%nScale%boundary(i,k,iEl,1) = mag - myGeom%nHat%boundary(i,k,iEl,1,1:2) = & - fac*myGeom%dsdx%boundary(i,k,iEl,1,1:2,2)/mag + this%nHat%boundary(i,k,iEl,1,1:2) = & + fac*this%dsdx%boundary(i,k,iEl,1,1:2,2)/mag elseif(k == 4) then ! West - mag = sqrt(myGeom%dsdx%boundary(i,k,iEl,1,1,1)**2+ & - myGeom%dsdx%boundary(i,k,iEl,1,2,1)**2) + mag = sqrt(this%dsdx%boundary(i,k,iEl,1,1,1)**2+ & + this%dsdx%boundary(i,k,iEl,1,2,1)**2) - myGeom%nScale%boundary(i,k,iEl,1) = mag + this%nScale%boundary(i,k,iEl,1) = mag - myGeom%nHat%boundary(i,k,iEl,1,1:2) = & - fac*myGeom%dsdx%boundary(i,k,iEl,1,1:2,1)/mag + this%nHat%boundary(i,k,iEl,1,1:2) = & + fac*this%dsdx%boundary(i,k,iEl,1,1:2,1)/mag endif ! Set the directionality for dsdx on the boundaries - myGeom%dsdx%boundary(i,k,iEl,1,1:2,1:2) = & - myGeom%dsdx%boundary(i,k,iEl,1,1:2,1:2)*fac + this%dsdx%boundary(i,k,iEl,1,1:2,1:2) = & + this%dsdx%boundary(i,k,iEl,1,1:2,1:2)*fac enddo enddo enddo - call myGeom%dsdx%UpdateDevice() - call myGeom%nHat%UpdateDevice() - call myGeom%nScale%UpdateDevice() + call this%dsdx%UpdateDevice() + call this%nHat%UpdateDevice() + call this%nScale%UpdateDevice() endsubroutine CalculateContravariantBasis_SEMQuad - subroutine CalculateMetricTerms_SEMQuad(myGeom) + subroutine CalculateMetricTerms_SEMQuad(this) implicit none - class(SEMQuad),intent(inout) :: myGeom + class(SEMQuad),intent(inout) :: this - call myGeom%x%Gradient(myGeom%dxds%interior) - call myGeom%dxds%BoundaryInterp() ! Tensor boundary interp is not offloaded to GPU - call myGeom%dxds%UpdateDevice() + call this%x%Gradient(this%dxds%interior) + call this%dxds%BoundaryInterp() ! Tensor boundary interp is not offloaded to GPU + call this%dxds%UpdateDevice() - call myGeom%dxds%Determinant(myGeom%J%interior) + call this%dxds%Determinant(this%J%interior) - call myGeom%J%UpdateDevice() - call myGeom%J%BoundaryInterp() - call myGeom%J%UpdateHost() + call this%J%UpdateDevice() + call this%J%BoundaryInterp() + call this%J%UpdateHost() - call myGeom%CalculateContravariantBasis() + call this%CalculateContravariantBasis() endsubroutine CalculateMetricTerms_SEMQuad diff --git a/src/SELF_Geometry_3D.f90 b/src/SELF_Geometry_3D.f90 index 8c35a191a..a957e8c53 100644 --- a/src/SELF_Geometry_3D.f90 +++ b/src/SELF_Geometry_3D.f90 @@ -34,17 +34,17 @@ module SELF_Geometry_3D use SELF_Tensor_3D use SELF_SupportRoutines use SELF_Mesh_3D + use SELF_Geometry implicit none - type,public :: SEMHex + type,extends(SEMGeometry),public :: SEMHex type(Vector3D) :: x ! Physical positions type(Tensor3D) :: dxds ! Covariant basis vectors type(Tensor3D) :: dsdx ! Contavariant basis vectors type(Vector3D) :: nHat ! Normal Vectors pointing across coordinate lines type(Scalar3D) :: nScale ! Boundary scale type(Scalar3D) :: J ! Jacobian of the transformation - integer :: nElem contains @@ -59,58 +59,58 @@ module SELF_Geometry_3D contains - subroutine Init_SEMHex(myGeom,interp,nElem) + subroutine Init_SEMHex(this,interp,nElem) implicit none - class(SEMHex),intent(out) :: myGeom + class(SEMHex),intent(out) :: this type(Lagrange),pointer,intent(in) :: interp integer,intent(in) :: nElem - myGeom%nElem = nElem + this%nElem = nElem - call myGeom%x%Init(interp=interp, & - nVar=1, & - nElem=nElem) + call this%x%Init(interp=interp, & + nVar=1, & + nElem=nElem) - call myGeom%x%meta(1)%SetName("x") + call this%x%meta(1)%SetName("x") - call myGeom%dxds%Init(interp=interp, & - nVar=1, & - nElem=nElem) + call this%dxds%Init(interp=interp, & + nVar=1, & + nElem=nElem) - call myGeom%dsdx%Init(interp=interp, & - nVar=1, & - nElem=nElem) + call this%dsdx%Init(interp=interp, & + nVar=1, & + nElem=nElem) + + call this%nHat%Init(interp=interp, & + nVar=1, & + nElem=nElem) - call myGeom%nHat%Init(interp=interp, & + call this%nScale%Init(interp=interp, & nVar=1, & nElem=nElem) - call myGeom%nScale%Init(interp=interp, & - nVar=1, & - nElem=nElem) - - call myGeom%J%Init(interp=interp, & - nVar=1, & - nElem=nElem) + call this%J%Init(interp=interp, & + nVar=1, & + nElem=nElem) endsubroutine Init_SEMHex - subroutine Free_SEMHex(myGeom) + subroutine Free_SEMHex(this) implicit none - class(SEMHex),intent(inout) :: myGeom + class(SEMHex),intent(inout) :: this - call myGeom%x%Free() - call myGeom%dxds%Free() - call myGeom%dsdx%Free() - call myGeom%nHat%Free() - call myGeom%nScale%Free() - call myGeom%J%Free() + call this%x%Free() + call this%dxds%Free() + call this%dsdx%Free() + call this%nHat%Free() + call this%nScale%Free() + call this%J%Free() endsubroutine Free_SEMHex - subroutine GenerateFromMesh_SEMHex(myGeom,mesh) + subroutine GenerateFromMesh_SEMHex(this,mesh) implicit none - class(SEMHex),intent(inout) :: myGeom + class(SEMHex),intent(inout) :: this type(Mesh3D),intent(in) :: mesh ! Local integer :: iel @@ -119,8 +119,8 @@ subroutine GenerateFromMesh_SEMHex(myGeom,mesh) type(Vector3D) :: xMesh call meshToModel%Init(mesh%nGeo,mesh%quadrature, & - myGeom%x%interp%N, & - myGeom%x%interp%controlNodeType) + this%x%interp%N, & + this%x%interp%controlNodeType) call xMesh%Init(meshToModel, & 1,mesh%nElem) @@ -136,20 +136,20 @@ subroutine GenerateFromMesh_SEMHex(myGeom,mesh) enddo enddo - call xMesh%GridInterp(myGeom%x%interior) - call myGeom%x%UpdateDevice() - call myGeom%x%BoundaryInterp() - call myGeom%x%UpdateHost() - call myGeom%CalculateMetricTerms() + call xMesh%GridInterp(this%x%interior) + call this%x%UpdateDevice() + call this%x%BoundaryInterp() + call this%x%UpdateHost() + call this%CalculateMetricTerms() call xMesh%Free() call meshToModel%Free() endsubroutine GenerateFromMesh_SEMHex - subroutine CalculateContravariantBasis_SEMHex(myGeom) + subroutine CalculateContravariantBasis_SEMHex(this) implicit none - class(SEMHex),intent(inout) :: myGeom + class(SEMHex),intent(inout) :: this ! Local integer :: iEl,i,j,k real(prec) :: fac @@ -159,19 +159,19 @@ subroutine CalculateContravariantBasis_SEMHex(myGeom) ! Here we use the curl invariant form from Kopriva (2006) ! to calculate the contravariant basis vectors - call xlgradxm%Init(myGeom%x%interp,1,myGeom%x%nElem) - call xmgradxl%Init(myGeom%x%interp,1,myGeom%x%nElem) + call xlgradxm%Init(this%x%interp,1,this%x%nElem) + call xmgradxl%Init(this%x%interp,1,this%x%nElem) - call curl_xlgradxm%Init(myGeom%x%interp,1,myGeom%x%nElem) - call curl_xmgradxl%Init(myGeom%x%interp,1,myGeom%x%nElem) + call curl_xlgradxm%Init(this%x%interp,1,this%x%nElem) + call curl_xmgradxl%Init(this%x%interp,1,this%x%nElem) ! Ja^{1:3}_1 (n=1, m=2, l=3) First component of the contravariant basis vectors - do iEl = 1,myGeom%nElem - do k = 1,myGeom%dxds%interp%N+1 - do j = 1,myGeom%dxds%interp%N+1 - do i = 1,myGeom%dxds%interp%N+1 - xlgradxm%interior(i,j,k,iel,1,1:3) = myGeom%x%interior(i,j,k,iel,1,3)*myGeom%dxds%interior(i,j,k,iel,1,2,1:3) ! x(...,l)*dxds(...,m,1:3) ; l=3,m=2 - xmgradxl%interior(i,j,k,iel,1,1:3) = myGeom%x%interior(i,j,k,iel,1,2)*myGeom%dxds%interior(i,j,k,iel,1,3,1:3) ! x(...,m)*dxds(...,l,1:3) ; l=3,m=2 + do iEl = 1,this%nElem + do k = 1,this%dxds%interp%N+1 + do j = 1,this%dxds%interp%N+1 + do i = 1,this%dxds%interp%N+1 + xlgradxm%interior(i,j,k,iel,1,1:3) = this%x%interior(i,j,k,iel,1,3)*this%dxds%interior(i,j,k,iel,1,2,1:3) ! x(...,l)*dxds(...,m,1:3) ; l=3,m=2 + xmgradxl%interior(i,j,k,iel,1,1:3) = this%x%interior(i,j,k,iel,1,2)*this%dxds%interior(i,j,k,iel,1,3,1:3) ! x(...,m)*dxds(...,l,1:3) ; l=3,m=2 enddo enddo enddo @@ -180,28 +180,28 @@ subroutine CalculateContravariantBasis_SEMHex(myGeom) call xlgradxm%Curl(curl_xlgradxm%interior) call xmgradxl%Curl(curl_xmgradxl%interior) - do iEl = 1,myGeom%nElem - do k = 1,myGeom%dxds%interp%N+1 - do j = 1,myGeom%dxds%interp%N+1 - do i = 1,myGeom%dxds%interp%N+1 + do iEl = 1,this%nElem + do k = 1,this%dxds%interp%N+1 + do j = 1,this%dxds%interp%N+1 + do i = 1,this%dxds%interp%N+1 ! In our convention, dsdx(i,j) is contravariant vector j, component i ! dsdx(...,n,i) = Ja^{i}_{n} = contravariant vector i, component n; ! Here, i = 1:3, and n=1 - myGeom%dsdx%interior(i,j,k,iel,1,1,1:3) = 0.5_prec*( & - curl_xmgradxl%interior(i,j,k,iel,1,1:3)- & - curl_xlgradxm%interior(i,j,k,iel,1,1:3)) + this%dsdx%interior(i,j,k,iel,1,1,1:3) = 0.5_prec*( & + curl_xmgradxl%interior(i,j,k,iel,1,1:3)- & + curl_xlgradxm%interior(i,j,k,iel,1,1:3)) enddo enddo enddo enddo ! Ja^{1:3}_2 (n=2, m=3, l=1) Second component of the contravariant basis vectors - do iEl = 1,myGeom%nElem - do k = 1,myGeom%dxds%interp%N+1 - do j = 1,myGeom%dxds%interp%N+1 - do i = 1,myGeom%dxds%interp%N+1 - xlgradxm%interior(i,j,k,iel,1,1:3) = myGeom%x%interior(i,j,k,iel,1,1)*myGeom%dxds%interior(i,j,k,iel,1,3,1:3) ! x(...,l)*dxds(...,m,1:3) ; l=1,m=3 - xmgradxl%interior(i,j,k,iel,1,1:3) = myGeom%x%interior(i,j,k,iel,1,3)*myGeom%dxds%interior(i,j,k,iel,1,1,1:3) ! x(...,m)*dxds(...,l,1:3) ; l=1,m=3 + do iEl = 1,this%nElem + do k = 1,this%dxds%interp%N+1 + do j = 1,this%dxds%interp%N+1 + do i = 1,this%dxds%interp%N+1 + xlgradxm%interior(i,j,k,iel,1,1:3) = this%x%interior(i,j,k,iel,1,1)*this%dxds%interior(i,j,k,iel,1,3,1:3) ! x(...,l)*dxds(...,m,1:3) ; l=1,m=3 + xmgradxl%interior(i,j,k,iel,1,1:3) = this%x%interior(i,j,k,iel,1,3)*this%dxds%interior(i,j,k,iel,1,1,1:3) ! x(...,m)*dxds(...,l,1:3) ; l=1,m=3 enddo enddo enddo @@ -210,28 +210,28 @@ subroutine CalculateContravariantBasis_SEMHex(myGeom) call xlgradxm%Curl(curl_xlgradxm%interior) call xmgradxl%Curl(curl_xmgradxl%interior) - do iEl = 1,myGeom%nElem - do k = 1,myGeom%dxds%interp%N+1 - do j = 1,myGeom%dxds%interp%N+1 - do i = 1,myGeom%dxds%interp%N+1 + do iEl = 1,this%nElem + do k = 1,this%dxds%interp%N+1 + do j = 1,this%dxds%interp%N+1 + do i = 1,this%dxds%interp%N+1 ! In our convention, dsdx(i,j) is contravariant vector j, component i ! dsdx(...,n,i) = Ja^{i}_{n} = contravariant vector i, component n; ! Here, i = 1:3, and n=2 - myGeom%dsdx%interior(i,j,k,iel,1,2,1:3) = 0.5_prec*( & - curl_xmgradxl%interior(i,j,k,iel,1,1:3)- & - curl_xlgradxm%interior(i,j,k,iel,1,1:3)) + this%dsdx%interior(i,j,k,iel,1,2,1:3) = 0.5_prec*( & + curl_xmgradxl%interior(i,j,k,iel,1,1:3)- & + curl_xlgradxm%interior(i,j,k,iel,1,1:3)) enddo enddo enddo enddo ! Ja^{1:3}_3 (n=3, m=1, l=2) Third component of the contravariant basis vectors - do iEl = 1,myGeom%nElem - do k = 1,myGeom%dxds%interp%N+1 - do j = 1,myGeom%dxds%interp%N+1 - do i = 1,myGeom%dxds%interp%N+1 - xlgradxm%interior(i,j,k,iel,1,1:3) = myGeom%x%interior(i,j,k,iel,1,2)*myGeom%dxds%interior(i,j,k,iel,1,1,1:3) ! x(...,l)*dxds(...,m,1:3) ; l=2,m=1 - xmgradxl%interior(i,j,k,iel,1,1:3) = myGeom%x%interior(i,j,k,iel,1,1)*myGeom%dxds%interior(i,j,k,iel,1,2,1:3) ! x(...,m)*dxds(...,l,1:3) ; l=2,m=1 + do iEl = 1,this%nElem + do k = 1,this%dxds%interp%N+1 + do j = 1,this%dxds%interp%N+1 + do i = 1,this%dxds%interp%N+1 + xlgradxm%interior(i,j,k,iel,1,1:3) = this%x%interior(i,j,k,iel,1,2)*this%dxds%interior(i,j,k,iel,1,1,1:3) ! x(...,l)*dxds(...,m,1:3) ; l=2,m=1 + xmgradxl%interior(i,j,k,iel,1,1:3) = this%x%interior(i,j,k,iel,1,1)*this%dxds%interior(i,j,k,iel,1,2,1:3) ! x(...,m)*dxds(...,l,1:3) ; l=2,m=1 enddo enddo enddo @@ -240,16 +240,16 @@ subroutine CalculateContravariantBasis_SEMHex(myGeom) call xlgradxm%Curl(curl_xlgradxm%interior) call xmgradxl%Curl(curl_xmgradxl%interior) - do iEl = 1,myGeom%nElem - do k = 1,myGeom%dxds%interp%N+1 - do j = 1,myGeom%dxds%interp%N+1 - do i = 1,myGeom%dxds%interp%N+1 + do iEl = 1,this%nElem + do k = 1,this%dxds%interp%N+1 + do j = 1,this%dxds%interp%N+1 + do i = 1,this%dxds%interp%N+1 ! In our convention, dsdx(i,j) is contravariant vector j, component i ! dsdx(...,n,i) = Ja^{i}_{n} = contravariant vector i, component n; ! Here, i = 1:3, and n=3 - myGeom%dsdx%interior(i,j,k,iel,1,3,1:3) = 0.5_prec*( & - curl_xmgradxl%interior(i,j,k,iel,1,1:3)- & - curl_xlgradxm%interior(i,j,k,iel,1,1:3)) + this%dsdx%interior(i,j,k,iel,1,3,1:3) = 0.5_prec*( & + curl_xmgradxl%interior(i,j,k,iel,1,1:3)- & + curl_xlgradxm%interior(i,j,k,iel,1,1:3)) enddo enddo enddo @@ -261,118 +261,118 @@ subroutine CalculateContravariantBasis_SEMHex(myGeom) call curl_xmgradxl%Free() ! Interpolate the contravariant tensor to the boundaries - call myGeom%dsdx%BoundaryInterp() ! Tensor boundary interp is not offloaded + call this%dsdx%BoundaryInterp() ! Tensor boundary interp is not offloaded ! Now, calculate nHat (outward pointing normal) - do iEl = 1,myGeom%nElem + do iEl = 1,this%nElem do k = 1,6 - do j = 1,myGeom%J%interp%N+1 - do i = 1,myGeom%J%interp%N+1 + do j = 1,this%J%interp%N+1 + do i = 1,this%J%interp%N+1 if(k == selfSide3D_Top .or. k == selfSide3D_East .or. k == selfSide3D_North) then - fac = sign(1.0_prec,myGeom%J%boundary(i,j,k,iEl,1)) + fac = sign(1.0_prec,this%J%boundary(i,j,k,iEl,1)) else - fac = -sign(1.0_prec,myGeom%J%boundary(i,j,k,iEl,1)) + fac = -sign(1.0_prec,this%J%boundary(i,j,k,iEl,1)) endif if(k == 1) then ! Bottom - mag = sqrt(myGeom%dsdx%boundary(i,j,k,iEl,1,1,3)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,2,3)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,3,3)**2) + mag = sqrt(this%dsdx%boundary(i,j,k,iEl,1,1,3)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,2,3)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,3,3)**2) - myGeom%nScale%boundary(i,j,k,iEl,1) = mag + this%nScale%boundary(i,j,k,iEl,1) = mag - myGeom%nHat%boundary(i,j,k,iEl,1,1:3) = & - fac*myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,3)/mag + this%nHat%boundary(i,j,k,iEl,1,1:3) = & + fac*this%dsdx%boundary(i,j,k,iEl,1,1:3,3)/mag ! Set the directionality for dsdx on the boundaries ! This is primarily used for DG gradient calculations, ! which do not use nHat for the boundary terms. - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,3) = & - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,3)*fac + this%dsdx%boundary(i,j,k,iEl,1,1:3,3) = & + this%dsdx%boundary(i,j,k,iEl,1,1:3,3)*fac elseif(k == 2) then ! South - mag = sqrt(myGeom%dsdx%boundary(i,j,k,iEl,1,1,2)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,2,2)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,3,2)**2) + mag = sqrt(this%dsdx%boundary(i,j,k,iEl,1,1,2)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,2,2)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,3,2)**2) - myGeom%nScale%boundary(i,j,k,iEl,1) = mag + this%nScale%boundary(i,j,k,iEl,1) = mag - myGeom%nHat%boundary(i,j,k,iEl,1,1:3) = & - fac*myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,2)/mag + this%nHat%boundary(i,j,k,iEl,1,1:3) = & + fac*this%dsdx%boundary(i,j,k,iEl,1,1:3,2)/mag ! Set the directionality for dsdx on the boundaries ! This is primarily used for DG gradient calculations, ! which do not use nHat for the boundary terms. - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,2) = & - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,2)*fac + this%dsdx%boundary(i,j,k,iEl,1,1:3,2) = & + this%dsdx%boundary(i,j,k,iEl,1,1:3,2)*fac elseif(k == 3) then ! East - mag = sqrt(myGeom%dsdx%boundary(i,j,k,iEl,1,1,1)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,2,1)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,3,1)**2) + mag = sqrt(this%dsdx%boundary(i,j,k,iEl,1,1,1)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,2,1)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,3,1)**2) - myGeom%nScale%boundary(i,j,k,iEl,1) = mag + this%nScale%boundary(i,j,k,iEl,1) = mag - myGeom%nHat%boundary(i,j,k,iEl,1,1:3) = & - fac*myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,1)/mag + this%nHat%boundary(i,j,k,iEl,1,1:3) = & + fac*this%dsdx%boundary(i,j,k,iEl,1,1:3,1)/mag ! Set the directionality for dsdx on the boundaries ! This is primarily used for DG gradient calculations, ! which do not use nHat for the boundary terms. - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,1) = & - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,1)*fac + this%dsdx%boundary(i,j,k,iEl,1,1:3,1) = & + this%dsdx%boundary(i,j,k,iEl,1,1:3,1)*fac elseif(k == 4) then ! North - mag = sqrt(myGeom%dsdx%boundary(i,j,k,iEl,1,1,2)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,2,2)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,3,2)**2) + mag = sqrt(this%dsdx%boundary(i,j,k,iEl,1,1,2)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,2,2)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,3,2)**2) - myGeom%nScale%boundary(i,j,k,iEl,1) = mag + this%nScale%boundary(i,j,k,iEl,1) = mag - myGeom%nHat%boundary(i,j,k,iEl,1,1:3) = & - fac*myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,2)/mag + this%nHat%boundary(i,j,k,iEl,1,1:3) = & + fac*this%dsdx%boundary(i,j,k,iEl,1,1:3,2)/mag ! Set the directionality for dsdx on the boundaries ! This is primarily used for DG gradient calculations, ! which do not use nHat for the boundary terms. - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,2) = & - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,2)*fac + this%dsdx%boundary(i,j,k,iEl,1,1:3,2) = & + this%dsdx%boundary(i,j,k,iEl,1,1:3,2)*fac elseif(k == 5) then ! West - mag = sqrt(myGeom%dsdx%boundary(i,j,k,iEl,1,1,1)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,2,1)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,3,1)**2) + mag = sqrt(this%dsdx%boundary(i,j,k,iEl,1,1,1)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,2,1)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,3,1)**2) - myGeom%nScale%boundary(i,j,k,iEl,1) = mag + this%nScale%boundary(i,j,k,iEl,1) = mag - myGeom%nHat%boundary(i,j,k,iEl,1,1:3) = & - fac*myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,1)/mag + this%nHat%boundary(i,j,k,iEl,1,1:3) = & + fac*this%dsdx%boundary(i,j,k,iEl,1,1:3,1)/mag ! Set the directionality for dsdx on the boundaries ! This is primarily used for DG gradient calculations, ! which do not use nHat for the boundary terms. - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,1) = & - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,1)*fac + this%dsdx%boundary(i,j,k,iEl,1,1:3,1) = & + this%dsdx%boundary(i,j,k,iEl,1,1:3,1)*fac elseif(k == 6) then ! Top - mag = sqrt(myGeom%dsdx%boundary(i,j,k,iEl,1,1,3)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,2,3)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,3,3)**2) + mag = sqrt(this%dsdx%boundary(i,j,k,iEl,1,1,3)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,2,3)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,3,3)**2) - myGeom%nScale%boundary(i,j,k,iEl,1) = mag + this%nScale%boundary(i,j,k,iEl,1) = mag - myGeom%nHat%boundary(i,j,k,iEl,1,1:3) = & - fac*myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,3)/mag + this%nHat%boundary(i,j,k,iEl,1,1:3) = & + fac*this%dsdx%boundary(i,j,k,iEl,1,1:3,3)/mag ! Set the directionality for dsdx on the boundaries ! This is primarily used for DG gradient calculations, ! which do not use nHat for the boundary terms. - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,3) = & - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,3)*fac + this%dsdx%boundary(i,j,k,iEl,1,1:3,3) = & + this%dsdx%boundary(i,j,k,iEl,1,1:3,3)*fac endif @@ -381,27 +381,27 @@ subroutine CalculateContravariantBasis_SEMHex(myGeom) enddo enddo - call myGeom%dsdx%UpdateDevice() - call myGeom%nHat%UpdateDevice() - call myGeom%nScale%UpdateDevice() + call this%dsdx%UpdateDevice() + call this%nHat%UpdateDevice() + call this%nScale%UpdateDevice() endsubroutine CalculateContravariantBasis_SEMHex - subroutine CalculateMetricTerms_SEMHex(myGeom) + subroutine CalculateMetricTerms_SEMHex(this) implicit none - class(SEMHex),intent(inout) :: myGeom + class(SEMHex),intent(inout) :: this - call myGeom%x%Gradient(myGeom%dxds%interior) - call myGeom%dxds%BoundaryInterp() ! Tensor boundary interp is not offloaded to GPU - call myGeom%dxds%UpdateDevice() + call this%x%Gradient(this%dxds%interior) + call this%dxds%BoundaryInterp() ! Tensor boundary interp is not offloaded to GPU + call this%dxds%UpdateDevice() - call myGeom%dxds%Determinant(myGeom%J%interior) + call this%dxds%Determinant(this%J%interior) - call myGeom%J%UpdateDevice() - call myGeom%J%BoundaryInterp() - call myGeom%J%UpdateHost() + call this%J%UpdateDevice() + call this%J%BoundaryInterp() + call this%J%UpdateHost() - call myGeom%CalculateContravariantBasis() + call this%CalculateContravariantBasis() endsubroutine CalculateMetricTerms_SEMHex diff --git a/src/SELF_Mesh.f90 b/src/SELF_Mesh.f90 index 5683e7597..94ff8f32d 100644 --- a/src/SELF_Mesh.f90 +++ b/src/SELF_Mesh.f90 @@ -32,7 +32,7 @@ module SELF_Mesh implicit none - type :: SEMMesh + type,abstract :: SEMMesh integer :: nGeo integer :: nElem integer :: nGlobalElem @@ -44,8 +44,20 @@ module SELF_Mesh integer :: nBCs integer :: quadrature type(DomainDecomposition) :: decomp + + contains + procedure(SELF_FreeMesh),deferred :: Free + endtype SEMMesh + interface + subroutine SELF_FreeMesh(this) + import SEMMesh + implicit none + class(SEMMesh),intent(inout) :: this + endsubroutine SELF_FreeMesh + endinterface + ! Element Types - From Table 4.1 of https://www.hopr-project.org/externals/Meshformat.pdf integer,parameter :: selfLineLinear = 1 integer,parameter :: selfLineNonlinear = 2 diff --git a/src/python/SELF_LinearShallowWater2D_Interface.f90 b/src/python/SELF_LinearShallowWater2D_Interface.f90 new file mode 100644 index 000000000..1749630a0 --- /dev/null +++ b/src/python/SELF_LinearShallowWater2D_Interface.f90 @@ -0,0 +1,54 @@ +module SELF_LinearShallowWater2D_Interface +! Core + use SELF_Constants + use SELF_SupportRoutines + use SELF_Mesh + use SELF_Geometry_2D + use SELF_JSON_Config + +! Models + use self_LinearShallowWater2D + +! External + use iso_fortran_env + use iso_c_binding + +contains + + subroutine Init_LinearShallowWater2D(modelObj,geometry,mesh) + implicit none + type(LinearShallowWater2D),intent(inout) :: modelObj + type(SEMQuad),intent(in) :: geometry + type(Mesh2D),intent(in) :: mesh + + print*,"Model set to Linear Shallow Water (2D)" + + call modelObj%Init(mesh,geometry) + modelObj%prescribed_bcs_enabled = .false. ! Disables prescribed boundary condition block for gpu accelerated implementations + modelObj%tecplot_enabled = .false. ! Disables tecplot output + + endsubroutine Init_LinearShallowWater2D + + subroutine UpdateParameters_LinearShallowWater2D(modelObj,config) + implicit none + type(LinearShallowWater2D),intent(inout) :: modelObj + type(SELFConfig),intent(inout) :: config + + call config%Get("linear-shallow-water-2d.environment.g", & + modelObj%g) + + call config%Get("linear-shallow-water-2d.environment.H", & + modelObj%H) + + call config%Get("linear-shallow-water-2d.environment.Cd", & + modelObj%Cd) + + call config%Get("linear-shallow-water-2d.environment.f0", & + modelObj%f0) + + call config%Get("linear-shallow-water-2d.environment.beta", & + modelObj%beta) + + endsubroutine UpdateParameters_LinearShallowWater2D + +endmodule SELF_LinearShallowWater2D_Interface diff --git a/src/python/SELF_Model_Interface.f90 b/src/python/SELF_Model_Interface.f90 index 0ba2393ae..f422f6ea2 100644 --- a/src/python/SELF_Model_Interface.f90 +++ b/src/python/SELF_Model_Interface.f90 @@ -4,10 +4,18 @@ module SELF_Model_Interface ! Core use SELF_Constants use SELF_SupportRoutines + use SELF_Metadata + use SELF_Mesh + use SELF_Mesh_1D + use SELF_Mesh_2D + use SELF_Mesh_3D + + use SELF_Geometry use SELF_Geometry_1D use SELF_Geometry_2D use SELF_Geometry_3D + use SELF_JSON_Config ! Models @@ -15,7 +23,18 @@ module SELF_Model_Interface use SELF_DGModel1D use SELF_DGModel2D use SELF_DGModel3D - use self_LinearShallowWater2D + + use SELF_Burgers1D + !use SELF_Burgers1D_Interface + + use SELF_LinearShallowWater2D + use SELF_LinearShallowWater2D_Interface + + use SELF_LinearEuler2D + !use SELF_LinearEuler2D_Interface + + use SELF_LinearEuler3D + !use SELF_LinearEuler3D_Interface ! External use iso_fortran_env @@ -27,189 +46,153 @@ module SELF_Model_Interface type(Lagrange),target,private :: interp !type(MPILayer),target :: decomp + ! ========================================== ! + ! Top level pointers ! + ! ========================================== ! class(Model),pointer,private :: selfModel class(SEMMesh),pointer,private :: selfMesh - !class(SEMGeometry),pointer,private :: selfGeometry + class(SEMGeometry),pointer,private :: selfGeometry ! Mesh - ! type(Mesh1D),target,private :: selfMesh1D + type(Mesh1D),target,private :: selfMesh1D type(Mesh2D),target,private :: selfMesh2D + type(Mesh3D),target,private :: selfMesh3D ! Geometry - ! type(Geometry1D),target,private :: selfGeometry1D + type(Geometry1D),target,private :: selfGeometry1D type(SEMQuad),target,private :: selfGeometry2D + type(SEMHex),target,private :: selfGeometry3D ! Models - ! type(Burgers1D),target,private :: selfBurgers1D - ! type(CompressibleIdealGas2D),target,private :: selfCompressibleIdealGas2D + type(Burgers1D),target,private :: selfBurgers1D type(LinearShallowWater2D),target,private :: selfLinearShallowWater2D + type(LinearEuler2D),target,private :: selfLinearEuler2D + type(LinearEuler3D),target,private :: selfLinearEuler3D integer,parameter,private :: MODEL_NAME_LENGTH = 50 - character(c_char,len=500),private :: model_configuration_file + character(kind=c_char,len=750),private :: model_configuration_file ! Interfaces public :: Initialize,ForwardStep,WritePickupFile,UpdateParameters,GetSolution,GetPrecision,GetVariableName,Finalize - private :: GetBCFlagForChar,Init2DWorkspace,InitLinearShallowWater2D - + private :: GetBCFlagForChar,Init2DWorkspace contains - function GetBCFlagForChar(charFlag) result(intFlag) - !! This method is used to return the integer flag from a char for boundary conditions - !! - implicit none - character(*),intent(in) :: charFlag - integer :: intFlag - - select case(UpperCase(trim(charFlag))) - - case("PRESCRIBED") - intFlag = SELF_BC_PRESCRIBED - - case("RADIATION") - intFlag = SELF_BC_RADIATION - - case("NO_NORMAL_FLOW") - intFlag = SELF_BC_NONORMALFLOW - - case DEFAULT - intFlag = 0 - - endselect - - endfunction GetBCFlagForChar - - function GetQFlagForChar(charFlag) result(intFlag) - !! This method is used to return the integer flag from a char for boundary conditions - !! - implicit none - character(*),intent(in) :: charFlag - integer :: intFlag - - select case(UpperCase(trim(charFlag))) - - case("GAUSS") - intFlag = GAUSS - - case("GAUSS-LOBATTO") - intFlag = GAUSS_LOBATTO - - case DEFAULT - intFlag = 0 - - endselect - - endfunction GetQFlagForChar + ! ================================================================= + ! Public methods + ! ================================================================= - subroutine Initialize(config_file) bind(C,name="Initialize") + function Initialize(config_file) result(error) bind(C,name="Initialize") implicit none character(kind=c_char,len=*),intent(in) :: config_file + integer(c_int) :: error ! local character(len=MODEL_NAME_LENGTH) :: modelname call config%Init(config_file) model_configuration_file = config_file + call config%Get("model_name",modelname) + ! Select the model select case(trim(modelname)) + case("burgers-1d") + + print*,"Not implemented yet" + error = -1 + ! call Init1DWorkspace() + ! call Init_Burgers1D(selfBurgers1D,selfGeometry1D,selfMesh1D) + ! selfModel => selfBurgers1D + ! error = 0 + case("linear-shallow-water-2d") call Init2DWorkspace() - call InitLinearShallowWater2D() + call Init_LinearShallowWater2D(selfLinearShallowWater2D,selfGeometry2D,selfMesh2D) + selfModel => selfLinearShallowWater2D + error = 0 - case default - endselect + case("linear-euler-2d") - endsubroutine Initialize + print*,"Not implemented yet" + error = -1 + ! call Init2DWorkspace() + ! call Init_LinearEuler2D(selfLinearEuler2D,selfGeometry2D,selfMesh2D) + ! selfModel => selfLinearEuler2D + ! error = 0 - subroutine Finalize() bind(C,name="Finalize") - implicit none + case("linear-euler-3d") - call config%Free() - call selfModel%Free() - selfModel => null() + print*,"Not implemented yet" + error = -1 + ! call Init2DWorkspace() + ! call Init_LinearEuler2D(selfLinearEuler2D,selfGeometry2D,selfMesh2D) + ! selfModel => selfLinearEuler2D + ! error = 0 - ! Free the interpolant - call interp%Free() + case("gfdles-3d") - ! Free the mesh + print*,"Not implemented yet" + error = -1 + ! call Init2DWorkspace() + ! call Init_LinearEuler2D(selfLinearEuler2D,selfGeometry2D,selfMesh2D) + ! selfModel => selfLinearEuler2D + ! error = 0 - ! Free the geometry + case default - endsubroutine Finalize + endselect - subroutine Init2DWorkspace() - implicit none - ! Local - logical :: mpiRequested - character(LEN=self_QuadratureTypeCharLength) :: qChar - character(LEN=MODEL_NAME_LENGTH) :: meshfile - character(LEN=MODEL_NAME_LENGTH) :: uniformBoundaryCondition - integer :: controlQuadrature - integer :: controlDegree - integer :: targetDegree - integer :: targetQuadrature - integer :: bcFlag + ! Point the mesh and geometry top level pointers to the appropriate mesh and geometry objects + select type(selfModel) - call config%Get("geometry.control_degree",controlDegree) - call config%Get("geometry.target_degree",targetDegree) - call config%Get("geometry.control_quadrature",qChar) - controlQuadrature = GetQFlagForChar(trim(qChar)) - call config%Get("geometry.target_quadrature",qChar) - targetQuadrature = GetQFlagForChar(trim(qChar)) - call config%Get("geometry.mesh_file",meshfile) - call config%Get("geometry.uniform_boundary_condition",uniformBoundaryCondition) - bcFlag = GetBCFlagForChar(uniformBoundaryCondition) + class is(DGModel1D) + selfMesh => selfMesh1D + selfGeometry => selfGeometry1D - print*,"Using Mesh file : "//trim(meshfile) - ! Read in mesh file and set the public mesh pointer to selfMesh2D - call selfMesh2D%Read_HOPr(trim(meshfile)) - call selfMesh2D%ResetBoundaryConditionType(bcFlag) + class is(DGModel2D) + selfMesh => selfMesh2D + selfGeometry => selfGeometry2D - selfMesh => selfMesh2D + class is(DGModel3D) + selfMesh => selfMesh3D + selfGeometry => selfGeometry3D - ! Create an interpolant - call interp%Init(controlDegree, & - controlQuadrature, & - targetDegree, & - targetQuadrature) + endselect - ! Generate geometry (metric terms) from the mesh elements - call selfGeometry2D%Init(interp,selfMesh2D%nElem) - call selfGeometry2D%GenerateFromMesh(selfMesh2D) + call UpdateParameters() -! selfGeometry => selfGeometry2D + endfunction Initialize - endsubroutine Init2DWorkspace - - subroutine InitLinearShallowWater2D() + subroutine Finalize() bind(C,name="Finalize") implicit none - print*,"Model set to Linear Shallow Water (2D)" - - call selfLinearShallowWater2D%Init(selfMesh2D,selfGeometry2D) - selfLinearShallowWater2D%prescribed_bcs_enabled = .false. ! Disables prescribed boundary condition block for gpu accelerated implementations - selfLinearShallowWater2D%tecplot_enabled = .false. ! Disables tecplot output - - call UpdateParameters() + call config%Free() + call selfModel%Free() + call selfMesh%Free() + call selfGeometry%Free() + call interp%Free() - selfModel => selfLinearShallowWater2D + ! Nullify the top level pointers + selfModel => null() + selfMesh => null() + selfGeometry => null() - endsubroutine InitLinearShallowWater2D + endsubroutine Finalize - function WritePickupFile(case_directory) result(pickupFile) bind(C,name="WritePickupFile") + subroutine WritePickupFile(case_directory,pickupFile) bind(C,name="WritePickupFile") implicit none - character(kind=c_char,len=*) :: case_directory - character(LEN=self_FileNameLength) :: pickupFile + character(kind=c_char,len=*),intent(in) :: case_directory + character(kind=c_char,len=*),intent(out) :: pickupFile ! Local character(13) :: timeStampString - write(timeStampString,'(I13.13)') this%ioIterate - pickupFile = case_directory//'/solution.'//timeStampString//'.h5' - call selfModel%WriteModel(pickupfile) + write(timeStampString,'(I13.13)') selfModel%ioIterate + pickupFile = trim(case_directory)//'/solution.'//timeStampString//'.h5' + call selfModel%WriteModel(trim(pickupfile)) - endfunction WritePickupFile + endsubroutine WritePickupFile subroutine UpdateParameters() bind(c,name="UpdateParameters") implicit none @@ -224,22 +207,12 @@ subroutine UpdateParameters() bind(c,name="UpdateParameters") select type(selfModel) + type is(Burgers1D) + print*,"Not implemented yet" + !call UpdateParameters_Burgers1D(selfModel,config) type is(LinearShallowWater2D) - call config%Get("linear-shallow-water-2d.environment.g", & - selfLinearShallowWater2D%g) - - call config%Get("linear-shallow-water-2d.environment.H", & - selfLinearShallowWater2D%H) - - call config%Get("linear-shallow-water-2d.environment.Cd", & - selfLinearShallowWater2D%Cd) - - call config%Get("linear-shallow-water-2d.environment.f0", & - selfLinearShallowWater2D%f0) - - call config%Get("linear-shallow-water-2d.environment.beta", & - selfLinearShallowWater2D%beta) + call UpdateParameters_LinearShallowWater2D(selfModel,config) endselect @@ -301,22 +274,118 @@ subroutine GetSolution(solution,solshape,ndim) bind(C,name="GetSolution") endsubroutine GetSolution - function GetVariableName() result(name) bind(c,name="GetVariableName") - character(kind=c_char,len=*) :: name + subroutine GetVariableName(ivar,name) bind(c,name="GetVariableName") + integer(c_int),intent(in) :: ivar + character(kind=c_char,len=*),intent(out) :: name select type(selfModel) - class is(SELF_DGModel1D) + class is(DGModel1D) name = selfModel%solution%meta(ivar)%name - class is(SELF_DGModel2D) + class is(DGModel2D) name = selfModel%solution%meta(ivar)%name - class is(SELF_DGModel3D) + class is(DGModel3D) name = selfModel%solution%meta(ivar)%name endselect - endfunction GetVariableName + endsubroutine GetVariableName + + ! ================================================================= + ! Private methods + ! ================================================================= + + function GetBCFlagForChar(charFlag) result(intFlag) + !! This method is used to return the integer flag from a char for boundary conditions + !! + implicit none + character(*),intent(in) :: charFlag + integer :: intFlag + + select case(UpperCase(trim(charFlag))) + + case("PRESCRIBED") + intFlag = SELF_BC_PRESCRIBED + + case("RADIATION") + intFlag = SELF_BC_RADIATION + + case("NO_NORMAL_FLOW") + intFlag = SELF_BC_NONORMALFLOW + + case DEFAULT + intFlag = 0 + + endselect + + endfunction GetBCFlagForChar + + function GetQFlagForChar(charFlag) result(intFlag) + !! This method is used to return the integer flag from a char for boundary conditions + !! + implicit none + character(*),intent(in) :: charFlag + integer :: intFlag + + select case(UpperCase(trim(charFlag))) + + case("GAUSS") + intFlag = GAUSS + + case("GAUSS-LOBATTO") + intFlag = GAUSS_LOBATTO + + case DEFAULT + intFlag = 0 + + endselect + + endfunction GetQFlagForChar + + subroutine Init2DWorkspace() + implicit none + ! Local + logical :: mpiRequested + character(len=self_QuadratureTypeCharLength) :: qChar + character(len=MODEL_NAME_LENGTH) :: meshfile + character(len=MODEL_NAME_LENGTH) :: uniformBoundaryCondition + integer :: controlQuadrature + integer :: controlDegree + integer :: targetDegree + integer :: targetQuadrature + integer :: bcFlag + + call config%Get("geometry.control_degree",controlDegree) + call config%Get("geometry.target_degree",targetDegree) + call config%Get("geometry.control_quadrature",qChar) + controlQuadrature = GetQFlagForChar(trim(qChar)) + call config%Get("geometry.target_quadrature",qChar) + targetQuadrature = GetQFlagForChar(trim(qChar)) + call config%Get("geometry.mesh_file",meshfile) + call config%Get("geometry.uniform_boundary_condition",uniformBoundaryCondition) + bcFlag = GetBCFlagForChar(uniformBoundaryCondition) + + print*,"Using Mesh file : "//trim(meshfile) + ! Read in mesh file and set the public mesh pointer to selfMesh2D + call selfMesh2D%Read_HOPr(trim(meshfile)) + call selfMesh2D%ResetBoundaryConditionType(bcFlag) + + selfMesh => selfMesh2D + + ! Create an interpolant + call interp%Init(controlDegree, & + controlQuadrature, & + targetDegree, & + targetQuadrature) + + ! Generate geometry (metric terms) from the mesh elements + call selfGeometry2D%Init(interp,selfMesh2D%nElem) + call selfGeometry2D%GenerateFromMesh(selfMesh2D) + +! selfGeometry => selfGeometry2D + + endsubroutine Init2DWorkspace endmodule SELF_Model_Interface From 71ebb13bd84335515d56505604ec75b6a9007e1a Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Wed, 9 Apr 2025 14:23:07 -0400 Subject: [PATCH 11/17] Add utils and consolidate models --- pyself/_utils/__init__.py | 1 + pyself/_utils/library.py | 34 +++ pyself/model.py | 484 ++++++++++++++++++++++++++++++++++++++ pyself/model2d.py | 211 ----------------- pyself/model3d.py | 212 ----------------- 5 files changed, 519 insertions(+), 423 deletions(-) create mode 100644 pyself/_utils/__init__.py create mode 100644 pyself/_utils/library.py create mode 100644 pyself/model.py delete mode 100644 pyself/model2d.py delete mode 100644 pyself/model3d.py diff --git a/pyself/_utils/__init__.py b/pyself/_utils/__init__.py new file mode 100644 index 000000000..9a324e52e --- /dev/null +++ b/pyself/_utils/__init__.py @@ -0,0 +1 @@ +from .library import * diff --git a/pyself/_utils/library.py b/pyself/_utils/library.py new file mode 100644 index 000000000..5f9c4fea1 --- /dev/null +++ b/pyself/_utils/library.py @@ -0,0 +1,34 @@ +import ctypes.util +import os + + +def find_library_full_path(library_name): + """ + Finds the full path of a library using ctypes.util.find_library. + + Args: + library_name: The name of the library to find. + + Returns: + The full path of the library, or None if not found. + """ + library_path = ctypes.util.find_library(library_name) + if library_path: + if os.path.isabs(library_path): + return library_path + else: + # On Linux, find_library often returns just the filename, so we search in common library paths + for path in ["/lib", "/usr/lib", "/usr/local/lib"]: + full_path = os.path.join(path, library_path) + if os.path.exists(full_path): + return full_path + # If not found in standard paths, try searching in the directories in LD_LIBRARY_PATH + ld_library_path = os.environ.get("LD_LIBRARY_PATH") + if ld_library_path: + for path in ld_library_path.split(":"): + full_path = os.path.join(path, library_path) + if os.path.exists(full_path): + return full_path + # If still not found, return None + return None + return None diff --git a/pyself/model.py b/pyself/model.py new file mode 100644 index 000000000..58010d075 --- /dev/null +++ b/pyself/model.py @@ -0,0 +1,484 @@ +#!/usr/bin/env python +# + + +# Other SELF modules +import numpy as np +import pyself.geometry as geometry +from typing import Optional + + +class model2d: + def __init__(self): + self.solution = None + self.pvdata = None # Pyvista data + self.varnames = None + self.varunits = None + self.geom = geometry.semquad() + + def set_coordinates(self, x: np.array, y: np.array): + self.geom.set_coordinates(x, y) + + @property + def shape(self): + """Returns the shape of the solution array with the number of variables""" + nvar = len(self.solution) + return (nvar) + self.solution[0].data.shape() + + def set_solution( + self, + solution: np.ndarray, + varnames: Optional[list[str]] = None, + varunits: Optional[list[str]] = None, + ): + + if len(shape(solution)) != 4: + print("Error: Solution array must have shape (nvar, nel, N+1, N+1)") + return 1 + else: + if len(varnames) != solution.shape[0]: + print("Error: Number of variable names must match solution array") + return 1 + + if varnames is not None: + self.set_varnames(varnames) + + if varunits is not None: + self.set_varunits(varunits) + + if self.solution is None: + self.solution = [] + # Loop over variable names with index + for i, name in enumerate(varnames): + if varunits is not None: + units = varunits[i] + else: + units = "" + + if varnames is not None: + name = varnames[i] + else: + name = f"solution_{i}" + data = da.from_array( + solution[i, :, :, :].flatten(), + chunks=(self.geom.daskChunkSize, N, N), + ) + self.solution.append( + { + "name": name, + "units": units, + "data": solution[i, :, :, :].flatten(), + } + ) + else: + for i in range(len(self.solution)): + self.solution[i]["data"] = da.from_array( + solution[i, :, :, :].flatten(), + chunks=(self.geom.daskChunkSize, N, N), + ) + + def _set_varnames(self, varnames: list[str]): + self.varnames = varnames + + def _set_varunits(self, varunits: list[str]): + self.varunits = varunits + + def set_geom(self, geom: geometry.semquad): + self.geom = geom + + def load(self, hdf5File): + """Loads in 2-D model from SELF model output""" + import h5py + import dask.array as da + + self.geom.load(hdf5File) + + f = h5py.File(hdf5File, "r") + self.varnames = [] + + if "controlgrid" in list(f.keys()): + + controlgrid = f["controlgrid"] + for group_name in controlgrid.keys(): + + if group_name == "geometry": + continue + + group = controlgrid[group_name] + # Create a list to hold data for this group + setattr(self, group_name, []) + group_data = getattr(self, group_name) + print(f"Loading {group_name} group") + + # Load metadata information + if "metadata" in list(group.keys()): + for v in group[f"metadata/name"].keys(): + + name = group[f"metadata/name/{v}"].asstr()[()][0] + try: + units = group[f"metadata/units/{v}"].asstr()[()][0] + except: + units = "error" + + group_data.append({"name": name, "units": units, "data": None}) + else: + print( + f"Error: /controlgrid/{group_name}/metadata group not found in {hdf5File}." + ) + return 1 + + for k in group.keys(): + k_decoded = k.encode("utf-8").decode("utf-8") + if k == "metadata": + continue + else: + print(f"Loading {k_decoded} field") + # Load the actual data + d = group[k] + N = d.shape[2] + + # Find index for this field + i = 0 + for sol in group_data: + if sol["name"] == k_decoded: + break + else: + i += 1 + + group_data[i]["data"] = da.from_array( + d, chunks=(self.geom.daskChunkSize, N, N) + ) + + self.generate_pyvista() + + else: + print(f"Error: /controlgrid group not found in {hdf5File}.") + return 1 + + return 0 + + def generate_pyvista(self): + """Generates pyvista polyData for each solution variable for plotting""" + import numpy as np + import pyvista as pv + + (nelem, nx, ny) = self.solution[0]["data"].shape + n_points = nelem * nx * ny + n_faces = nelem * (nx - 1) * (ny - 1) + + # Need to use the plot mesh to create a flat list of (x,y,z=0) points + # number of points = (M+1)*(M+1)*nelem + # dimension ordering (i,j,iel) + # Get the x-y points in flattened array for building unstructured data + np_points = np.zeros((n_points, 3)) + np_points[:, 0] = self.geom.x.flatten() + np_points[:, 1] = self.geom.y.flatten() + + # Need to construct the faces from here.. + # Number of faces = M*M*nelem + faces = np.zeros((n_faces, 5), dtype=np.int64) + fid = 0 + for iel in range(0, nelem): + for j in range(0, ny - 1): + for i in range(0, nx - 1): + # lower left corner + n0 = i + nx * (j + ny * iel) + # lower right corner + n1 = i + 1 + nx * (j + ny * iel) + + # upper right corner + n2 = i + 1 + nx * (j + 1 + ny * iel) + + # upper left corner + n3 = i + nx * (j + 1 + ny * iel) + + faces[fid, :] = [4, n0, n1, n2, n3] + fid += 1 + + self.pvdata = pv.PolyData(np_points, faces) + + # Load fields into pvdata + k = 0 + for attr in self.__dict__: + if not attr in ["pvdata", "varnames", "varunits", "geom"]: + controlgroup = getattr(self, attr) + # print(f"Loading {attr} into pvdata") + for var in controlgroup: + # print(f"Loading {var['name']} into pvdata") + self.pvdata.point_data.set_array(var["data"].flatten(), var["name"]) + k += 1 + + print(self.pvdata) + + def update_from_file(self, hdf5File): + """Loads in 2-D model from SELF model output""" + import h5py + import dask.array as da + + f = h5py.File(hdf5File, "r") + + if "controlgrid" in list(f.keys()): + + controlgrid = f["controlgrid"] + for group_name in controlgrid.keys(): + + if group_name == "geometry": + continue + + group = controlgrid[group_name] + # Create a list to hold data for this group + group_data = getattr(self, group_name) + print(f"Loading {group_name} group") + + for k in group.keys(): + k_decoded = k.encode("utf-8").decode("utf-8") + if k == "metadata": + continue + else: + print(f"Loading {k_decoded} field") + # Load the actual data + d = group[k] + N = d.shape[2] + + # Find index for this field + i = 0 + for sol in group_data: + if sol["name"] == k_decoded: + break + else: + i += 1 + + group_data[i]["data"] = da.from_array( + d, chunks=(self.geom.daskChunkSize, N, N) + ) + + # # Load fields into pvdata + k = 0 + for attr in self.__dict__: + if not attr in ["pvdata", "varnames", "varunits", "geom"]: + controlgroup = getattr(self, attr) + for var in controlgroup: + self.pvdata.point_data.set_array( + var["data"].flatten(), var["name"] + ) + k += 1 + + else: + print(f"Error: /controlgrid group not found in {hdf5File}.") + return 1 + + return 0 + + +class model3d: + def __init__(self): + self.solution = None + self.pvdata = None # Pyvista data + self.varnames = None + self.varunits = None + self.geom = geometry.semhex() + + def load(self, hdf5File): + """Loads in 3-D model from SELF model output""" + import h5py + import dask.array as da + + self.geom.load(hdf5File) + + f = h5py.File(hdf5File, "r") + self.varnames = [] + + if "controlgrid" in list(f.keys()): + + controlgrid = f["controlgrid"] + for group_name in controlgrid.keys(): + + if group_name == "geometry": + continue + + group = controlgrid[group_name] + # Create a list to hold data for this group + setattr(self, group_name, []) + group_data = getattr(self, group_name) + print(f"Loading {group_name} group") + + # Load metadata information + if "metadata" in list(group.keys()): + for v in group[f"metadata/name"].keys(): + + name = group[f"metadata/name/{v}"].asstr()[()][0] + try: + units = group[f"metadata/units/{v}"].asstr()[()][0] + except: + units = "error" + + group_data.append({"name": name, "units": units, "data": None}) + else: + print( + f"Error: /controlgrid/{group_name}/metadata group not found in {hdf5File}." + ) + return 1 + + for k in group.keys(): + k_decoded = k.encode("utf-8").decode("utf-8") + if k == "metadata": + continue + else: + print(f"Loading {k_decoded} field") + # Load the actual data + d = group[k] + N = d.shape[2] + + # Find index for this field + i = 0 + for sol in group_data: + if sol["name"] == k_decoded: + break + else: + i += 1 + + group_data[i]["data"] = da.from_array( + d, chunks=(self.geom.daskChunkSize, N, N, N) + ) + + self.generate_pyvista() + + else: + print(f"Error: /controlgrid group not found in {hdf5File}.") + return 1 + + return 0 + + def generate_pyvista(self): + """Generates pyvista polyData for each solution variable for plotting""" + import numpy as np + import pyvista as pv + + (nelem, nx, ny, nz) = self.solution[0]["data"].shape + n_points = nelem * nx * ny * nz + n_cells = nelem * (nx - 1) * (ny - 1) * (nz - 1) + + # Need to use the plot mesh to create a flat list of (x,y,z=0) points + # number of points = (M+1)*(M+1)*nelem + # dimension ordering (i,j,iel) + # Get the x-y points in flattened array for building unstructured data + points = np.zeros((n_points, 3)) + points[:, 0] = self.geom.x.flatten() + points[:, 1] = self.geom.y.flatten() + points[:, 2] = self.geom.z.flatten() + + print(f"---------------------") + print(f"Converting to pyvista") + print(f"---------------------") + print(f" n points : {n_points}") + print(f" n cells : {n_cells}") + + cells = np.zeros((n_cells * 9), dtype=pv.ID_TYPE) + celltypes = np.zeros((n_cells), dtype=pv.ID_TYPE) + + eid = 0 + nid = 0 + for iel in range(0, nelem): + for k in range(0, nz - 1): + for j in range(0, ny - 1): + for i in range(0, nx - 1): + cells[nid] = 8 + nid += 1 + cells[nid] = _node_index_3d(i + 1, j + 1, k, nx, ny, nz, iel) + nid += 1 + cells[nid] = _node_index_3d(i, j + 1, k, nx, ny, nz, iel) + nid += 1 + cells[nid] = _node_index_3d(i, j, k, nx, ny, nz, iel) + nid += 1 + cells[nid] = _node_index_3d(i + 1, j, k, nx, ny, nz, iel) + nid += 1 + cells[nid] = _node_index_3d( + i + 1, j + 1, k + 1, nx, ny, nz, iel + ) + nid += 1 + cells[nid] = _node_index_3d(i, j + 1, k + 1, nx, ny, nz, iel) + nid += 1 + cells[nid] = _node_index_3d(i, j, k + 1, nx, ny, nz, iel) + nid += 1 + cells[nid] = _node_index_3d(i + 1, j, k + 1, nx, ny, nz, iel) + nid += 1 + celltypes[eid] = pv.CellType.HEXAHEDRON + eid += 1 + + self.pvdata = pv.UnstructuredGrid(cells, celltypes, points) + + # # Load fields into pvdata + k = 0 + for attr in self.__dict__: + if not attr in ["pvdata", "varnames", "varunits", "geom"]: + controlgroup = getattr(self, attr) + # print(f"Loading {attr} into pvdata") + for var in controlgroup: + # print(f"Loading {var['name']} into pvdata") + self.pvdata.point_data.set_array(var["data"].flatten(), var["name"]) + k += 1 + + print(self.pvdata) + + def update_from_file(self, hdf5File): + """Loads in 3-D model from SELF model output""" + import h5py + import dask.array as da + + f = h5py.File(hdf5File, "r") + + if "controlgrid" in list(f.keys()): + + controlgrid = f["controlgrid"] + for group_name in controlgrid.keys(): + + if group_name == "geometry": + continue + + group = controlgrid[group_name] + # Create a list to hold data for this group + group_data = getattr(self, group_name) + print(f"Loading {group_name} group") + + for k in group.keys(): + k_decoded = k.encode("utf-8").decode("utf-8") + if k == "metadata": + continue + else: + print(f"Loading {k_decoded} field") + # Load the actual data + d = group[k] + N = d.shape[2] + + # Find index for this field + i = 0 + for sol in group_data: + if sol["name"] == k_decoded: + break + else: + i += 1 + + group_data[i]["data"] = da.from_array( + d, chunks=(self.geom.daskChunkSize, N, N, N) + ) + + # # Load fields into pvdata + k = 0 + for attr in self.__dict__: + if not attr in ["pvdata", "varnames", "varunits", "geom"]: + controlgroup = getattr(self, attr) + for var in controlgroup: + self.pvdata.point_data.set_array( + var["data"].flatten(), var["name"] + ) + k += 1 + + else: + print(f"Error: /controlgrid group not found in {hdf5File}.") + return 1 + + return 0 + + +def _node_index_3d(i, j, k, nx, ny, nz, iel): + return i + nx * (j + ny * (k + nz * iel)) diff --git a/pyself/model2d.py b/pyself/model2d.py deleted file mode 100644 index 761c61c99..000000000 --- a/pyself/model2d.py +++ /dev/null @@ -1,211 +0,0 @@ -#!/usr/bin/env python -# - - -# Other SELF modules -import numpy as np -import pyself.geometry as geometry - - -class model: - def __init__(self): - self.solution = None - self.pvdata = None # Pyvista data - self.varnames = None - self.varunits = None - self.geom = geometry.semquad() - - def set_solution(self, solution: np.array): - self.solution = solution - - def set_varnames(self, varnames: List(str)): - self.varnames = varnames - - def set_varunits(self, varunits: List(str)): - self.varunits = varunits - - def set_geom(self, geom: geometry.semquad): - self.geom = geom - - def load(self, hdf5File): - """Loads in 2-D model from SELF model output""" - import h5py - import dask.array as da - - self.geom.load(hdf5File) - - f = h5py.File(hdf5File, "r") - self.varnames = [] - - if "controlgrid" in list(f.keys()): - - controlgrid = f["controlgrid"] - for group_name in controlgrid.keys(): - - if group_name == "geometry": - continue - - group = controlgrid[group_name] - # Create a list to hold data for this group - setattr(self, group_name, []) - group_data = getattr(self, group_name) - print(f"Loading {group_name} group") - - # Load metadata information - if "metadata" in list(group.keys()): - for v in group[f"metadata/name"].keys(): - - name = group[f"metadata/name/{v}"].asstr()[()][0] - try: - units = group[f"metadata/units/{v}"].asstr()[()][0] - except: - units = "error" - - group_data.append({"name": name, "units": units, "data": None}) - else: - print( - f"Error: /controlgrid/{group_name}/metadata group not found in {hdf5File}." - ) - return 1 - - for k in group.keys(): - k_decoded = k.encode("utf-8").decode("utf-8") - if k == "metadata": - continue - else: - print(f"Loading {k_decoded} field") - # Load the actual data - d = group[k] - N = d.shape[2] - - # Find index for this field - i = 0 - for sol in group_data: - if sol["name"] == k_decoded: - break - else: - i += 1 - - group_data[i]["data"] = da.from_array( - d, chunks=(self.geom.daskChunkSize, N, N) - ) - - self.generate_pyvista() - - else: - print(f"Error: /controlgrid group not found in {hdf5File}.") - return 1 - - return 0 - - def generate_pyvista(self): - """Generates pyvista polyData for each solution variable for plotting""" - import numpy as np - import pyvista as pv - - (nelem, nx, ny) = self.solution[0]["data"].shape - n_points = nelem * nx * ny - n_faces = nelem * (nx - 1) * (ny - 1) - - # Need to use the plot mesh to create a flat list of (x,y,z=0) points - # number of points = (M+1)*(M+1)*nelem - # dimension ordering (i,j,iel) - # Get the x-y points in flattened array for building unstructured data - np_points = np.zeros((n_points, 3)) - np_points[:, 0] = self.geom.x.flatten() - np_points[:, 1] = self.geom.y.flatten() - - # Need to construct the faces from here.. - # Number of faces = M*M*nelem - faces = np.zeros((n_faces, 5), dtype=np.int64) - fid = 0 - for iel in range(0, nelem): - for j in range(0, ny - 1): - for i in range(0, nx - 1): - # lower left corner - n0 = i + nx * (j + ny * iel) - # lower right corner - n1 = i + 1 + nx * (j + ny * iel) - - # upper right corner - n2 = i + 1 + nx * (j + 1 + ny * iel) - - # upper left corner - n3 = i + nx * (j + 1 + ny * iel) - - faces[fid, :] = [4, n0, n1, n2, n3] - fid += 1 - - self.pvdata = pv.PolyData(np_points, faces) - - # Load fields into pvdata - k = 0 - for attr in self.__dict__: - if not attr in ["pvdata", "varnames", "varunits", "geom"]: - controlgroup = getattr(self, attr) - # print(f"Loading {attr} into pvdata") - for var in controlgroup: - # print(f"Loading {var['name']} into pvdata") - self.pvdata.point_data.set_array(var["data"].flatten(), var["name"]) - k += 1 - - print(self.pvdata) - - def update_from_file(self, hdf5File): - """Loads in 2-D model from SELF model output""" - import h5py - import dask.array as da - - f = h5py.File(hdf5File, "r") - - if "controlgrid" in list(f.keys()): - - controlgrid = f["controlgrid"] - for group_name in controlgrid.keys(): - - if group_name == "geometry": - continue - - group = controlgrid[group_name] - # Create a list to hold data for this group - group_data = getattr(self, group_name) - print(f"Loading {group_name} group") - - for k in group.keys(): - k_decoded = k.encode("utf-8").decode("utf-8") - if k == "metadata": - continue - else: - print(f"Loading {k_decoded} field") - # Load the actual data - d = group[k] - N = d.shape[2] - - # Find index for this field - i = 0 - for sol in group_data: - if sol["name"] == k_decoded: - break - else: - i += 1 - - group_data[i]["data"] = da.from_array( - d, chunks=(self.geom.daskChunkSize, N, N) - ) - - # # Load fields into pvdata - k = 0 - for attr in self.__dict__: - if not attr in ["pvdata", "varnames", "varunits", "geom"]: - controlgroup = getattr(self, attr) - for var in controlgroup: - self.pvdata.point_data.set_array( - var["data"].flatten(), var["name"] - ) - k += 1 - - else: - print(f"Error: /controlgrid group not found in {hdf5File}.") - return 1 - - return 0 diff --git a/pyself/model3d.py b/pyself/model3d.py deleted file mode 100644 index a255780eb..000000000 --- a/pyself/model3d.py +++ /dev/null @@ -1,212 +0,0 @@ -#!/usr/bin/env python -# - - -# Other SELF modules -import pyself.geometry as geometry - -def node_index_3d(i,j,k,nx,ny,nz,iel): - return i + nx*( j + ny*( k + nz*iel ) ) - -class model: - def __init__(self): - self.solution = None - self.pvdata = None # Pyvista data - self.varnames = None - self.varunits = None - self.geom = geometry.semhex() - - def load(self, hdf5File): - """Loads in 3-D model from SELF model output""" - import h5py - import dask.array as da - - self.geom.load(hdf5File) - - f = h5py.File(hdf5File, 'r') - self.varnames = [] - - if 'controlgrid' in list(f.keys()): - - controlgrid = f['controlgrid'] - for group_name in controlgrid.keys(): - - if( group_name == 'geometry' ): - continue - - group = controlgrid[group_name] - # Create a list to hold data for this group - setattr(self, group_name, []) - group_data = getattr(self, group_name) - print(f"Loading {group_name} group") - - # Load metadata information - if( 'metadata' in list(group.keys()) ): - for v in group[f"metadata/name"].keys(): - - name = group[f"metadata/name/{v}"].asstr()[()][0] - try: - units = group[f"metadata/units/{v}"].asstr()[()][0] - except: - units = "error" - - group_data.append({ - "name": name, - "units": units, - 'data': None - }) - else: - print(f"Error: /controlgrid/{group_name}/metadata group not found in {hdf5File}.") - return 1 - - for k in group.keys(): - k_decoded = k.encode('utf-8').decode('utf-8') - if k == 'metadata': - continue - else: - print(f"Loading {k_decoded} field") - # Load the actual data - d = group[k] - N = d.shape[2] - - # Find index for this field - i = 0 - for sol in group_data: - if sol['name'] == k_decoded: - break - else: - i += 1 - - group_data[i]['data'] = da.from_array(d, chunks=(self.geom.daskChunkSize, N, N, N)) - - self.generate_pyvista() - - else: - print(f"Error: /controlgrid group not found in {hdf5File}.") - return 1 - - return 0 - - def generate_pyvista(self): - """Generates pyvista polyData for each solution variable for plotting""" - import numpy as np - import pyvista as pv - - (nelem, nx, ny, nz) = self.solution[0]['data'].shape - n_points = nelem*nx*ny*nz - n_cells = nelem*(nx-1)*(ny-1)*(nz-1) - - # Need to use the plot mesh to create a flat list of (x,y,z=0) points - # number of points = (M+1)*(M+1)*nelem - # dimension ordering (i,j,iel) - # Get the x-y points in flattened array for building unstructured data - points = np.zeros((n_points,3)) - points[:,0] = self.geom.x.flatten() - points[:,1] = self.geom.y.flatten() - points[:,2] = self.geom.z.flatten() - - print( f"---------------------") - print( f"Converting to pyvista") - print( f"---------------------") - print( f" n points : {n_points}") - print( f" n cells : {n_cells}") - - cells = np.zeros((n_cells*9),dtype=pv.ID_TYPE) - celltypes = np.zeros((n_cells),dtype=pv.ID_TYPE) - - eid = 0 - nid = 0 - for iel in range(0,nelem): - for k in range(0,nz-1): - for j in range(0,ny-1): - for i in range(0,nx-1): - cells[nid] = 8 - nid+=1 - cells[nid] = node_index_3d(i+1,j+1,k,nx,ny,nz,iel) - nid+=1 - cells[nid] = node_index_3d(i,j+1,k,nx,ny,nz,iel) - nid+=1 - cells[nid] = node_index_3d(i,j,k,nx,ny,nz,iel) - nid+=1 - cells[nid] = node_index_3d(i+1,j,k,nx,ny,nz,iel) - nid+=1 - cells[nid] = node_index_3d(i+1,j+1,k+1,nx,ny,nz,iel) - nid+=1 - cells[nid] = node_index_3d(i,j+1,k+1,nx,ny,nz,iel) - nid+=1 - cells[nid] = node_index_3d(i,j,k+1,nx,ny,nz,iel) - nid+=1 - cells[nid] = node_index_3d(i+1,j,k+1,nx,ny,nz,iel) - nid+=1 - celltypes[eid] = pv.CellType.HEXAHEDRON - eid+=1 - - self.pvdata = pv.UnstructuredGrid(cells, celltypes, points) - - # # Load fields into pvdata - k = 0 - for attr in self.__dict__: - if not attr in ['pvdata','varnames','varunits','geom']: - controlgroup = getattr(self, attr) - #print(f"Loading {attr} into pvdata") - for var in controlgroup: - # print(f"Loading {var['name']} into pvdata") - self.pvdata.point_data.set_array(var['data'].flatten(),var['name']) - k+=1 - - print(self.pvdata) - - def update_from_file(self, hdf5File): - """Loads in 3-D model from SELF model output""" - import h5py - import dask.array as da - - f = h5py.File(hdf5File, 'r') - - if 'controlgrid' in list(f.keys()): - - controlgrid = f['controlgrid'] - for group_name in controlgrid.keys(): - - if( group_name == 'geometry' ): - continue - - group = controlgrid[group_name] - # Create a list to hold data for this group - group_data = getattr(self, group_name) - print(f"Loading {group_name} group") - - for k in group.keys(): - k_decoded = k.encode('utf-8').decode('utf-8') - if k == 'metadata': - continue - else: - print(f"Loading {k_decoded} field") - # Load the actual data - d = group[k] - N = d.shape[2] - - # Find index for this field - i = 0 - for sol in group_data: - if sol['name'] == k_decoded: - break - else: - i += 1 - - group_data[i]['data'] = da.from_array(d, chunks=(self.geom.daskChunkSize, N, N, N)) - - # # Load fields into pvdata - k = 0 - for attr in self.__dict__: - if not attr in ['pvdata','varnames','varunits','geom']: - controlgroup = getattr(self, attr) - for var in controlgroup: - self.pvdata.point_data.set_array(var['data'].flatten(),var['name']) - k+=1 - - else: - print(f"Error: /controlgrid group not found in {hdf5File}.") - return 1 - - return 0 \ No newline at end of file From 850c5b106d2d0bc1e69a4b51947e92168ec0aeef Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Thu, 10 Apr 2025 15:59:21 -0400 Subject: [PATCH 12/17] tidy up draft of python interface note that this implementation is a work-in-progress. There are a number of technical hurdles left over to get the python interface completely working, including importing of dependency libraries. Issues will be opened on github to resolve these and this branch will be migrated to v0.1.0-dev --- CMakeLists.txt | 12 +- .../linear_shallow_water2d_kelvinwaves.py | 59 ++++++ pyself/__init__.py | 12 +- pyself/_utils/library.py | 5 + pyself/_version.py | 1 + pyself/config.py | 9 +- pyself/geometry.py | 8 +- pyself/interface.py | 179 ++++++++++++++++-- setup.py | 31 ++- src/python/SELF_Model_Interface.f90 | 52 ++++- 10 files changed, 315 insertions(+), 53 deletions(-) create mode 100644 examples/linear_shallow_water2d_kelvinwaves.py create mode 100644 pyself/_version.py diff --git a/CMakeLists.txt b/CMakeLists.txt index 74778f03e..45e93fa49 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -232,14 +232,10 @@ endif() if(SELF_ENABLE_TESTING) enable_testing() add_subdirectory(${CMAKE_SOURCE_DIR}/test) - if(SELF_ENABLE_EXAMPLES) - add_subdirectory(${CMAKE_SOURCE_DIR}/examples) - endif() -else() - if(SELF_ENABLE_EXAMPLES) - enable_testing() - add_subdirectory(${CMAKE_SOURCE_DIR}/examples) - endif() +endif() + +if(SELF_ENABLE_EXAMPLES) + add_subdirectory(${CMAKE_SOURCE_DIR}/examples) endif() diff --git a/examples/linear_shallow_water2d_kelvinwaves.py b/examples/linear_shallow_water2d_kelvinwaves.py new file mode 100644 index 000000000..ba385ab59 --- /dev/null +++ b/examples/linear_shallow_water2d_kelvinwaves.py @@ -0,0 +1,59 @@ +from pyself.interface import SelfModel +from pyself.config import SelfModelConfig +import os +from datetime import datetime + + +pwd = os.path.dirname(os.path.abspath(__file__)) +# Set the case directory to a new unique directory based in the time stamp +# get current working directory + +case_directory = f"{os.getcwd()}/kelvinwaves-{datetime.now().strftime('%Y%m%d-%H%M%S')}" + + +def configure_geometry(config): + # Configure geometry + config.set_parameter( + "geometry", "mesh_file", f"{pwd}/../share/mesh/Circle/Circle_mesh.h5" + ) + config.set_parameter("geometry", "uniform_boundary_condition", "no_normal_flow") + config.set_parameter("geometry", "control_degree", 7) + config.set_parameter("geometry", "control_quadrature", "gauss") + + +def configure_time_options(config): + # Configure time options + config.set_parameter("time_options", "integrator", "euler") + config.set_parameter("time_options", "dt", 0.0025) + config.set_parameter("time_options", "start_time", 0.0) + config.set_parameter("time_options", "duration", 1.0) + config.set_parameter("time_options", "io_interval", 0.05) + config.set_parameter("time_options", "update_interval", 50) + + +def configure_shallow_water(config): + # Configure shallow water parameters + config.set_parameter("linear-shallow-water-2d", "g", 1.0) + config.set_parameter("linear-shallow-water-2d", "H", 1.0) + config.set_parameter("linear-shallow-water-2d", "Cd", 0.25) + config.set_parameter("linear-shallow-water-2d", "f0", 10.0) + config.set_parameter("linear-shallow-water-2d", "beta", 0.0) + + +def main(): + + config = SelfModelConfig(case_directory=case_directory) + config.config["model_name"] = "linear-shallow-water-2d" + + configure_geometry(config) + configure_time_options(config) + configure_shallow_water(config) + + # Create the model + model = SelfModel(config=config) + + x, y = model.get_coordinates() + + +if __name__ == "__main__": + main() diff --git a/pyself/__init__.py b/pyself/__init__.py index bf2f64cea..864bb2fb4 100644 --- a/pyself/__init__.py +++ b/pyself/__init__.py @@ -4,6 +4,16 @@ A python package for interfacing with the Spectral Element Library in Fortran (https://github.com/fluidnumerics/SELF). """ -__version__ = "0.1.0" +from ._version import version + +__version__ = version +__title__ = "pyself" __author__ = "Dr. Joe Schoonover" __credits__ = "Fluid Numerics LLC" + + +from pyself.config import * +from pyself.geometry import * +from pyself.interface import * +from pyself.lagrange import * +from pyself.model import * diff --git a/pyself/_utils/library.py b/pyself/_utils/library.py index 5f9c4fea1..bbd85d67f 100644 --- a/pyself/_utils/library.py +++ b/pyself/_utils/library.py @@ -13,6 +13,7 @@ def find_library_full_path(library_name): The full path of the library, or None if not found. """ library_path = ctypes.util.find_library(library_name) + print(f"Library path for {library_name}: {library_path}") if library_path: if os.path.isabs(library_path): return library_path @@ -24,9 +25,13 @@ def find_library_full_path(library_name): return full_path # If not found in standard paths, try searching in the directories in LD_LIBRARY_PATH ld_library_path = os.environ.get("LD_LIBRARY_PATH") + print(f"LD_LIBRARY_PATH: {ld_library_path}") if ld_library_path: for path in ld_library_path.split(":"): full_path = os.path.join(path, library_path) + print( + f"Checking {full_path} for library {library_name} : {os.path.exists(full_path)}" + ) if os.path.exists(full_path): return full_path # If still not found, return None diff --git a/pyself/_version.py b/pyself/_version.py new file mode 100644 index 000000000..3e6bb5b54 --- /dev/null +++ b/pyself/_version.py @@ -0,0 +1 @@ +version = "v0.1.0" diff --git a/pyself/config.py b/pyself/config.py index 5a197c0ba..29249c69d 100644 --- a/pyself/config.py +++ b/pyself/config.py @@ -1,6 +1,7 @@ import json from typing import Optional, Dict, Any import os +from ._version import version class SelfModelConfig: @@ -25,7 +26,7 @@ def __init__( def default_config() -> Dict[str, Any]: """Return default configuration based on the JSON schema.""" return { - "version": "v0.0.0", + "version": version, "model_name": "linear-shallow-water-2d", "geometry": { "mesh_file": "", @@ -61,16 +62,16 @@ def default_config() -> Dict[str, Any]: "f0": 0.0, "beta": 0.0, "initial_conditions": { - "geostrophic_balance": false, + "geostrophic_balance": False, "file": "", "u": 0.0, "v": 0.0, "eta": 0.0, }, "boundary_conditions": { - "time_deppendent": false, + "time_dependent": False, "dt": 0.0, - "from_initial_conditions": false, + "from_initial_conditions": False, "u": 0.0, "v": 0.0, "eta": 0.0, diff --git a/pyself/geometry.py b/pyself/geometry.py index 8c94b8337..5f4197124 100644 --- a/pyself/geometry.py +++ b/pyself/geometry.py @@ -2,7 +2,7 @@ # import pyself.lagrange as lagrange - +import numpy as np # class semline: # def __init__(self): @@ -64,9 +64,9 @@ def __init__(self): self.daskChunkSize = 1000 # number of elements per dask chunk - def set_coordinates(self, x, y): - self.x = x - self.y = y + def set_coordinates(self, x: np.array, y: np.array): + self.x = da.from_array(x, chunks=(self.daskChunkSize, N, N)) + self.y = da.from_array(y, chunks=(self.daskChunkSize, N, N)) self.nElem = x.shape[0] def set_units(self, units): diff --git a/pyself/interface.py b/pyself/interface.py index ddf1a262a..7f375a7ef 100644 --- a/pyself/interface.py +++ b/pyself/interface.py @@ -2,7 +2,10 @@ from pyself.config import SelfModelConfig - +from pyself.model import model2d, model3d +from pyself.geometry import semquad, semhex +from pyself import lagrange +from pyself._utils.library import find_library_full_path ## Add ctypes interface to fortran library from ctypes import ( @@ -17,27 +20,46 @@ import numpy as np from ctypes.util import find_library import os +from typing import Union, Any _VAR_BUFFER_SIZE = 256 +MODEL_TO_TYPE = { + # "burgers-1d": model1d, + "linear-shallow-water-2d": model2d, + "linear-euler-2d": model2d, + "linear-euler-3d": model3d, + "gfdles-3d": model3d, +} + class SelfModel: - def __init__(self, config: SelfModelConfig = SelfModelConfig(), lib: str = None): + def __init__( + self, + modeldata: Union[model2d, model3d] = None, + config: SelfModelConfig = SelfModelConfig(), + case_directory: str = os.getcwd(), + lib: str = None, + ): self.case_directory = case_directory self.config = config self._config_file = f"{self.config.case_directory}/model_input.json" - self._solution = None - self._mesh = None - self._geometry = None + + self._modeldata = modeldata # Either a model2d or model3d object + self._last_pickup_file = None if lib is None: - try: - self._lib = CDLL(find_lib("self_interface")) - except: + _lib = find_library_full_path("self_interface") + if _lib is None: raise Exception( "Could not find the libself_interface.so library. Ensure your LD_LIBRARY_PATH includes the path for libself_interface.so" ) + else: + try: + self._lib = CDLL(_lib) + except: + raise Exception(f"Could not load the library {lib}") else: # Library ust be libself_interface.so if not lib.endswith("libself_interface.so"): @@ -52,8 +74,8 @@ def __init__(self, config: SelfModelConfig = SelfModelConfig(), lib: str = None) self._configure_interface() self._precision = self._lib.GetPrecision() - # self._dtype = {4: np.float32, 8: np.float64}[self._precision] - # self._cprec = {4: c_float, 8: c_double}[self._precision] + self._dtype = {4: np.float32, 8: np.float64}[self._precision] + self._cprec = {4: c_float, 8: c_double}[self._precision] self._initialized = False @@ -79,9 +101,18 @@ def _configure_interface(self): ] self._lib.GetSolution.restype = None # Subroutine, no return + self._lib.SetSolution.argtypes = [ + POINTER(c_void_p), + POINTER(c_int * 5), + ] + self._lib.SetSolution.restype = None # Subroutine, no return + self._lib.GetVariableName.argtypes = [c_int, c_char_p] self._lib.GetVariableName.restype = None + self._lib.GetVariableUnits.argtypes = [c_int, c_char_p] + self._lib.GetVariableUnits.restype = None + self._lib.GetPrecision.argtypes = [] # No arguments self._lib.GetPrecision.restype = c_int # Function returns an integer @@ -165,7 +196,11 @@ def initialize_model(self): f"Model returned error code {error} for model_name = {self.config.config['model_name']}" ) - # To do, print out model parameters, nicely formatted + # Initialize the _modeldata object + self._modeldata = MODEL_TO_TYPE[self.config.config["model_name"]]() + x, y = self.get_coordinates() + self._modeldata.set_coordinates(x, y) + self._initialized = True else: raise Exception("Model is already initialized") @@ -228,6 +263,15 @@ def write_pickup_file(self): return pickup_file def get_solution(self): + """ + Obtains the solution data from the Fortran model and stores it in the _modeldata attribute. + The solution data is returned as a model2d or model3d object, depending on the model configuration. + + Returns: + -------- + modeldata (model2d or model3d): the model data object containing the solution + + """ if not self._initialized: raise Exception("Model is not initialized") @@ -242,24 +286,123 @@ def get_solution(self): dim = [shape[i] for i in range(rank.value)] # Extract only relevant dimensions # Convert void pointer to float or double pointer - if self._precision == 4: - data_ptr = ctypes.cast(solution_ptr, POINTER(c_float)) - else: - data_ptr = ctypes.cast(solution_ptr, POINTER(c_double)) + data_ptr = ctypes.cast(solution_ptr, POINTER(self._cprec)) # Convert to NumPy array (handling column-major storage) solution = np.ctypeslib.as_array( data_ptr, shape=tuple(reversed(dim)) ) # Reverse shape for row-major order - self._solution = solution # Create a pointer to the data + # Store the results in the _modeldata object + names = [self._get_variable_name(i) for i in range(dim[0])] + units = [self._get_variable_units(i) for i in range(dim[0])] + self._modeldata.set_solution(solution, names, units) - # To do: error handling + return self._modeldata - return solution + def _validate_solution_data(self, data: np.ndarray): + """ + Validate the solution data against the expected shape and type. + The function checks if the data is a NumPy array and if its shape matches + the expected dimensions for the model. + + Parameters: + ---------- + data (np.ndarray): the solution data to validate + + Raises: + ------- + ValueError: if the data is not a NumPy array or if its shape does not match the expected dimensions + + """ + if not self._initialized: + raise Exception("Model is not initialized") + + if not isinstance(data, np.ndarray): + raise ValueError("Solution data must be a NumPy array") + + # Check the shape of the data + expected_shape = self._modeldata.shape() + if data.shape != expected_shape: + raise ValueError( + f"Solution data shape {data.shape} does not match expected shape {expected_shape}" + ) + + def set_solution(self, data: np.ndarray): + """ + Sets the _modeldata attribute with the provided solution data and pushes the + data to the Fortran model. The function validates the data shape and type + before setting it in the model. The data is expected to be a NumPy array + with the same shape as the model's expected solution shape. + + Parameters: + ---------- + data (np.ndarray): the solution data to set in the model + + """ + if not self._initialized: + raise Exception("Model is not initialized") + + self._validate_solution_data(data) + + # Set the solution data in the _modeldata object + self._modeldata.set_solution(data) + + # Get a void pointer to the data + data_ptr = np.asfortranarray(data, dtype=self._dtype).ctypes.data_as(c_void_p) + # Shape handling: up to 5D, pad with 1s if needed + shape = list(np_array.shape) + shape_5d = shape + [1] * (5 - ndim) # Pad to 5 elements + shape_array = (c_int * 5)(*shape_5d) + self_lib.SetSolution(data_ptr, shape_array) + + return self._modeldata + + def get_coordinates(self): + """ + Obtains the coordinates data from the Fortran model and stores it in the _modeldata attribute. + The coordinates data is returned as a semquad or semhex object, depending on the model configuration. + + Returns: + -------- + x (np.ndarray): x-coordinates of the mesh + y (np.ndarray): y-coordinates of the mesh + + """ + if not self._initialized: + raise Exception("Model is not initialized") + + # Get the coordinates + x_ptr = c_void_p() + shape = (c_int * 5)() + rank = c_int() + precision = c_int() + self._lib.GetGeometryCoordinates(byref(x_ptr), shape, byref(rank)) + + # Extract shape values + dim = [shape[i] for i in range(rank.value)] + + # Convert void pointer to float or double pointer + if self._precision == 4: + data_ptr = ctypes.cast(x_ptr, POINTER(c_float)) + else: + data_ptr = ctypes.cast(x_ptr, POINTER(c_double)) + + # Convert to NumPy array (handling column-major storage) + xy = np.ctypeslib.as_array( + data_ptr, shape=tuple(reversed(dim)) + ) # Reverse shape for row-major order + + return xy[0, ...].flatten(), xy[1, ...].flatten() def _get_variable_name(self, ivar): variable_name_buffer = create_string_buffer(_VAR_BUFFER_SIZE) self._lib.GetVariableName(c_int(ivar), variable_name_buffer) return variable_name_buffer.value.decode("utf-8").strip() + + def _get_variable_units(self, ivar): + variable_units_buffer = create_string_buffer(_VAR_BUFFER_SIZE) + self._lib.GetVariableUnits(c_int(ivar), variable_units_buffer) + + return variable_units_buffer.value.decode("utf-8").strip() diff --git a/setup.py b/setup.py index 73efe4628..592ede798 100644 --- a/setup.py +++ b/setup.py @@ -1,22 +1,19 @@ -from setuptools import setup +from setuptools import setup, find_packages setup( - name='pyself', - version='0.0.1', - description='A python interface for the Spectral Element Library in Fortran', - url='https://github.com/fluidnumerics/self', - author='Fluid Numerics', - author_email='support@fluidnumerics.com', - license='3-Clause BSD with Attribution', - packages=['pyself'], - install_requires=['h5py>=3.7.0', - 'dask', - 'pyvista', - 'imageio[ffmpeg]'], + name="pyself", + version="0.0.1", + description="A python interface for the Spectral Element Library in Fortran", + url="https://github.com/fluidnumerics/self", + author="Fluid Numerics", + author_email="support@fluidnumerics.com", + license="3-Clause BSD with Attribution", + packages=find_packages(), + install_requires=["h5py>=3.7.0", "dask", "pyvista", "imageio[ffmpeg]"], classifiers=[ - 'Development Status :: 1 - Planning', - 'Intended Audience :: Science/Research', - 'Operating System :: POSIX :: Linux', - 'Programming Language :: Python :: 3' + "Development Status :: 1 - Planning", + "Intended Audience :: Science/Research", + "Operating System :: POSIX :: Linux", + "Programming Language :: Python :: 3", ], ) diff --git a/src/python/SELF_Model_Interface.f90 b/src/python/SELF_Model_Interface.f90 index f422f6ea2..fdec49f0b 100644 --- a/src/python/SELF_Model_Interface.f90 +++ b/src/python/SELF_Model_Interface.f90 @@ -74,7 +74,16 @@ module SELF_Model_Interface character(kind=c_char,len=750),private :: model_configuration_file ! Interfaces - public :: Initialize,ForwardStep,WritePickupFile,UpdateParameters,GetSolution,GetPrecision,GetVariableName,Finalize + public :: Initialize + public :: ForwardStep + public :: WritePickupFile + public :: UpdateParameters + public :: GetSolution + public :: SetSolution + public :: GetPrecision + public :: GetVariableName + public :: GetVariableUnits + public :: Finalize private :: GetBCFlagForChar,Init2DWorkspace contains @@ -274,6 +283,28 @@ subroutine GetSolution(solution,solshape,ndim) bind(C,name="GetSolution") endsubroutine GetSolution + subroutine SetSolution(solution,solshape) bind(C,name="SetSolution") + type(c_ptr),intent(in) :: solution ! Pointer to data + integer(c_int),intent(in) :: solshape(5) ! Shape array (max 4D) + + select type(selfModel) + + class is(DGModel1D) + call c_f_pointer(solution,selfModel%solution%interior,solshape(1:3)) + call selfModel%solution%UpdateDevice() + + class is(DGModel2D) + call c_f_pointer(solution,selfModel%solution%interior,solshape(1:4)) + call selfModel%solution%UpdateDevice() + + class is(DGModel3D) + call c_f_pointer(solution,selfModel%solution%interior,solshape(1:5)) + call selfModel%solution%UpdateDevice() + + endselect + + endsubroutine SetSolution + subroutine GetVariableName(ivar,name) bind(c,name="GetVariableName") integer(c_int),intent(in) :: ivar character(kind=c_char,len=*),intent(out) :: name @@ -293,6 +324,25 @@ subroutine GetVariableName(ivar,name) bind(c,name="GetVariableName") endsubroutine GetVariableName + subroutine GetVariableUnits(ivar,name) bind(c,name="GetVariableUnits") + integer(c_int),intent(in) :: ivar + character(kind=c_char,len=*),intent(out) :: name + + select type(selfModel) + + class is(DGModel1D) + name = selfModel%solution%meta(ivar)%units + + class is(DGModel2D) + name = selfModel%solution%meta(ivar)%units + + class is(DGModel3D) + name = selfModel%solution%meta(ivar)%units + + endselect + + endsubroutine GetVariableUnits + ! ================================================================= ! Private methods ! ================================================================= From a988bd1269ffacd50931e13e1830eb29d94e9243 Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Fri, 25 Apr 2025 16:09:21 -0400 Subject: [PATCH 13/17] Draft class for dynamic boundary conditions --- src/SELF_DGModel1D_t.f90 | 137 ++++------- src/SELF_DGModel2D_t.f90 | 113 +++------ src/SELF_DGModel3D_t.f90 | 107 +++----- src/SELF_Model.f90 | 416 +++++++++++++++++--------------- src/gpu/SELF_DGModel1D.f90 | 104 +------- src/gpu/SELF_DGModel2D.f90 | 87 +------ src/gpu/SELF_DGModel3D.f90 | 99 +------- test/burgers1d_nonormalflow.f90 | 110 --------- test/burgers1d_prescribed.f90 | 46 ++++ test/burgers1d_radiation.f90 | 110 --------- 10 files changed, 392 insertions(+), 937 deletions(-) delete mode 100644 test/burgers1d_nonormalflow.f90 delete mode 100644 test/burgers1d_radiation.f90 diff --git a/src/SELF_DGModel1D_t.f90 b/src/SELF_DGModel1D_t.f90 index a82f55cbe..84fd7448a 100644 --- a/src/SELF_DGModel1D_t.f90 +++ b/src/SELF_DGModel1D_t.f90 @@ -91,6 +91,7 @@ subroutine Init_DGModel1D_t(this,mesh,geometry) this%mesh => mesh this%geometry => geometry + this%ndim = 1 call this%SetNumberOfVariables() call this%solution%Init(geometry%x%interp,this%nvar,this%mesh%nElem) @@ -106,6 +107,8 @@ subroutine Init_DGModel1D_t(this,mesh,geometry) call this%flux%AssociateGeometry(geometry) call this%fluxDivergence%AssociateGeometry(geometry) + call this%boundaryconditions%Init() + call this%AdditionalInit() call this%SetMetadata() @@ -145,6 +148,7 @@ subroutine Free_DGModel1D_t(this) call this%flux%Free() call this%source%Free() call this%fluxDivergence%Free() + call this%boundaryconditions%Free() call this%AdditionalFree() endsubroutine Free_DGModel1D_t @@ -325,56 +329,29 @@ subroutine setboundarycondition_DGModel1D_t(this) ! local integer :: ivar integer :: N,nelem - real(prec) :: x + real(prec) :: x(1),nhat(1),s(1:this%nvar),dsdx(1:this%nvar,1),t + type(SELF_BoundaryCondition),pointer :: bc nelem = this%geometry%nelem ! number of elements in the mesh N = this%solution%interp%N ! polynomial degree - ! left-most boundary - if(this%mesh%bcid(1) == SELF_BC_PRESCRIBED) then - - x = this%geometry%x%boundary(1,1,1) - this%solution%extBoundary(1,1,1:this%nvar) = & - this%hbc1d_Prescribed(x,this%t) - - elseif(this%mesh%bcid(1) == SELF_BC_RADIATION) then - - this%solution%extBoundary(1,1,1:this%nvar) = & - this%hbc1d_Radiation(this%solution%boundary(1,1,1:this%nvar),-1.0_prec) - - elseif(this%mesh%bcid(1) == SELF_BC_NONORMALFLOW) then - - this%solution%extBoundary(1,1,1:this%nvar) = & - this%hbc1d_NoNormalFlow(this%solution%boundary(1,1,1:this%nvar),-1.0_prec) - - else ! Periodic - - this%solution%extBoundary(1,1,1:this%nvar) = this%solution%boundary(2,nelem,1:this%nvar) - - endif - - ! right-most boundary - if(this%mesh%bcid(1) == SELF_BC_PRESCRIBED) then - - x = this%geometry%x%boundary(2,nelem,1) - this%solution%extBoundary(2,nelem,1:this%nvar) = & - this%hbc1d_Prescribed(x,this%t) - - elseif(this%mesh%bcid(1) == SELF_BC_RADIATION) then - - this%solution%extBoundary(2,nelem,1:this%nvar) = & - this%hbc1d_Radiation(this%solution%boundary(2,nelem,1:this%nvar),-1.0_prec) - - elseif(this%mesh%bcid(1) == SELF_BC_NONORMALFLOW) then - - this%solution%extBoundary(2,nelem,1:this%nvar) = & - this%hbc1d_NoNormalFlow(this%solution%boundary(2,nelem,1:this%nvar),-1.0_prec) - - else ! Periodic - - this%solution%extBoundary(2,nelem,1:this%nvar) = this%solution%boundary(1,1,1:this%nvar) - - endif + ! Left boundary condition + bcFunc = this%boundaryconditions%GetNodeForBCID(this%mesh%bcid(1)) + x = this%geometry%x%boundary(1,1) + s = this%solution%boundary(1,1,1:this%nvar) + dsdx = this%solutionGradient%boundary(1,1,1:this%nvar) + t = this%t + nhat = -1.0_prec + this%solution%extBoundary(1,1,1:this%nvar) = bc%bcFunc(s,dsdx,x,t,nhat) + + ! Right boundary condition + bcFunc = this%boundaryconditions%GetNodeForBCID(this%mesh%bcid(1)) + x = this%geometry%x%boundary(2,nelem) + s = this%solution%boundary(2,nelem,1:this%nvar) + dsdx = this%solutionGradient%boundary(2,nelem,1:this%nvar) + t = this%t + nhat = 1.0_prec + this%solution%extBoundary(2,nelem,1:this%nvar) = bc%bcFunc(s,dsdx,x,t,nhat) endsubroutine setboundarycondition_DGModel1D_t @@ -387,56 +364,30 @@ subroutine setgradientboundarycondition_DGModel1D_t(this) implicit none class(DGModel1D_t),intent(inout) :: this ! local - real(prec) :: x + real(prec) :: x(1),nhat(1),s(1:this%nvar),dsdx(1:this%nvar,1),t + real(prec) :: exts(1:this%nvar,1) integer :: nelem nelem = this%geometry%nelem ! number of elements in the mesh - - ! left-most boundary - if(this%mesh%bcid(1) == SELF_BC_PRESCRIBED) then - - x = this%geometry%x%boundary(1,1,1) - this%solutionGradient%extBoundary(1,1,1:this%nvar) = & - this%pbc1d_Prescribed(x,this%t) - - elseif(this%mesh%bcid(1) == SELF_BC_RADIATION) then - - this%solutionGradient%extBoundary(1,1,1:this%nvar) = & - this%pbc1d_Radiation(this%solutionGradient%boundary(1,1,1:this%nvar),-1.0_prec) - - elseif(this%mesh%bcid(1) == SELF_BC_NONORMALFLOW) then - - this%solutionGradient%extBoundary(1,1,1:this%nvar) = & - this%pbc1d_NoNormalFlow(this%solutionGradient%boundary(1,1,1:this%nvar),-1.0_prec) - - else ! Periodic - - this%solutionGradient%extBoundary(1,1,1:this%nvar) = this%solutionGradient%boundary(2,nelem,1:this%nvar) - - endif - - ! right-most boundary - if(this%mesh%bcid(1) == SELF_BC_PRESCRIBED) then - - x = this%geometry%x%boundary(2,nelem,1) - this%solutionGradient%extBoundary(2,nelem,1:this%nvar) = & - this%pbc1d_Prescribed(x,this%t) - - elseif(this%mesh%bcid(1) == SELF_BC_RADIATION) then - - this%solutionGradient%extBoundary(2,nelem,1:this%nvar) = & - this%pbc1d_Radiation(this%solutionGradient%boundary(2,nelem,1:this%nvar),-1.0_prec) - - elseif(this%mesh%bcid(1) == SELF_BC_NONORMALFLOW) then - - this%solutionGradient%extBoundary(2,nelem,1:this%nvar) = & - this%pbc1d_NoNormalFlow(this%solutionGradient%boundary(2,nelem,1:this%nvar),-1.0_prec) - - else ! Periodic - - this%solutionGradient%extBoundary(2,nelem,1:this%nvar) = this%solutionGradient%boundary(1,1,1:this%nvar) - - endif + ! Left boundary condition + bcFunc = this%boundaryconditions%GetNodeForBCID(this%mesh%bcid(1)) + x = this%geometry%x%boundary(1,1) + s = this%solution%boundary(1,1,1:this%nvar) + dsdx = this%solutionGradient%boundary(1,1,1:this%nvar) + t = this%t + nhat = -1.0_prec + exts = bc%bcFunc(s,dsdx,x,t,nhat) + this%solutiongradient%extBoundary(1,1,1:this%nvar) = exts(1:this%nvar,1) + + ! Right boundary condition + bcFunc = this%boundaryconditions%GetNodeForBCID(this%mesh%bcid(1)) + x = this%geometry%x%boundary(2,nelem) + s = this%solution%boundary(2,nelem,1:this%nvar) + dsdx = this%solutionGradient%boundary(2,nelem,1:this%nvar) + t = this%t + nhat = 1.0_prec + exts = bc%bcFunc(s,dsdx,x,t,nhat) + this%solutiongradient%extBoundary(2,nelem,1:this%nvar) = exts(1:this%nvar,1) endsubroutine setgradientboundarycondition_DGModel1D_t diff --git a/src/SELF_DGModel2D_t.f90 b/src/SELF_DGModel2D_t.f90 index c3e0f84aa..6d2064afd 100644 --- a/src/SELF_DGModel2D_t.f90 +++ b/src/SELF_DGModel2D_t.f90 @@ -98,6 +98,7 @@ subroutine Init_DGModel2D_t(this,mesh,geometry) this%mesh => mesh this%geometry => geometry + this%ndim = 2 call this%SetNumberOfVariables() call this%solution%Init(geometry%x%interp,this%nvar,this%mesh%nElem) @@ -113,6 +114,8 @@ subroutine Init_DGModel2D_t(this,mesh,geometry) call this%flux%AssociateGeometry(geometry) call this%fluxDivergence%AssociateGeometry(geometry) + call this%boundaryconditions%Init() + call this%AdditionalInit() call this%SetMetadata() @@ -147,6 +150,7 @@ subroutine Free_DGModel2D_t(this) call this%flux%Free() call this%source%Free() call this%fluxDivergence%Free() + call this%boundaryconditions%Free() call this%AdditionalFree() endsubroutine Free_DGModel2D_t @@ -444,44 +448,28 @@ subroutine setboundarycondition_DGModel2D_t(this) class(DGModel2D_t),intent(inout) :: this ! local integer :: i,iEl,j,e2,bcid - real(prec) :: nhat(1:2),x(1:2) - - do concurrent(j=1:4,iel=1:this%mesh%nElem) - - bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - x = this%geometry%x%boundary(i,j,iEl,1,1:2) - - this%solution%extBoundary(i,j,iEl,1:this%nvar) = & - this%hbc2d_Prescribed(x,this%t) - enddo - - elseif(bcid == SELF_BC_RADIATION) then - - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) + real(prec) :: nhat(1:2),x(1:2),s(1:this%nvar),dsdx(1:this%nvar,1:2) + type(SELF_BoundaryCondition),pointer :: bc - this%solution%extBoundary(i,j,iEl,1:this%nvar) = & - this%hbc2d_Radiation(this%solution%boundary(i,j,iEl,1:this%nvar),nhat) - enddo + do iel = 1,this%mesh%nElem + do j = 1,4 - elseif(bcid == SELF_BC_NONORMALFLOW) then + bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID + e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) - - this%solution%extBoundary(i,j,iEl,1:this%nvar) = & - this%hbc2d_NoNormalFlow(this%solution%boundary(i,j,iEl,1:this%nvar),nhat) - enddo + if(e2 == 0) then + bc = this%boundaryconditions%GetNodeForBCID(bcid) + ! Get the boundary normals on cell edges from the mesh geometry + nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) + x = this%geometry%x%boundary(i,j,iEl,1,1:2) + s = this%solution%boundary(i,j,iEl,1:this%nvar) + dsdx = this%solutiongradient%boundary(i,j,iEl,1:this%nvar,1:2) + this%solution%extBoundary(i,j,iEl,1:this%nvar) = & + bc%bcFunc(s,dsdx,x,this%t,nhat) endif - endif + enddo enddo endsubroutine setboundarycondition_DGModel2D_t @@ -494,49 +482,26 @@ subroutine setgradientboundarycondition_DGModel2D_t(this) class(DGModel2D_t),intent(inout) :: this ! local integer :: i,iEl,j,e2,bcid - real(prec) :: dsdx(1:this%nvar,1:2) - real(prec) :: nhat(1:2),x(1:2) - - do concurrent(j=1:4,iel=1:this%mesh%nElem) - - bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - x = this%geometry%x%boundary(i,j,iEl,1,1:2) - - this%solutiongradient%extBoundary(i,j,iEl,1:this%nvar,1:2) = & - this%pbc2d_Prescribed(x,this%t) - enddo - - elseif(bcid == SELF_BC_RADIATION) then - - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) - - dsdx = this%solutiongradient%boundary(i,j,iEl,1:this%nvar,1:2) - - this%solutiongradient%extBoundary(i,j,iEl,1:this%nvar,1:2) = & - this%pbc2d_Radiation(dsdx,nhat) - enddo - - elseif(bcid == SELF_BC_NONORMALFLOW) then - - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) - - dsdx = this%solutiongradient%boundary(i,j,iEl,1:this%nvar,1:2) - - this%solutiongradient%extBoundary(i,j,iEl,1:this%nvar,1:2) = & - this%pbc2d_NoNormalFlow(dsdx,nhat) - enddo - + real(prec) :: nhat(1:2),x(1:2),s(1:this%nvar),dsdx(1:this%nvar,1:2) + type(SELF_BoundaryCondition),pointer :: bc + + do iel = 1,this%mesh%nElem + do j = 1,4 + bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID + e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID + + if(e2 == 0) then + bc = this%boundaryconditions%GetNodeForBCID(bcid) + ! Get the boundary normals on cell edges from the mesh geometry + nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) + x = this%geometry%x%boundary(i,j,iEl,1,1:2) + s = this%solution%boundary(i,j,iEl,1:this%nvar) + dsdx = this%solutiongradient%boundary(i,j,iEl,1:this%nvar,1:2) + + this%solution%extBoundary(i,j,iEl,1:this%nvar) = & + bc%bcgFunc(s,dsdx,x,this%t,nhat) endif - endif - + enddo enddo endsubroutine setgradientboundarycondition_DGModel2D_t diff --git a/src/SELF_DGModel3D_t.f90 b/src/SELF_DGModel3D_t.f90 index dd6a303ef..b947d11c2 100644 --- a/src/SELF_DGModel3D_t.f90 +++ b/src/SELF_DGModel3D_t.f90 @@ -98,6 +98,7 @@ subroutine Init_DGModel3D_t(this,mesh,geometry) this%mesh => mesh this%geometry => geometry + this%ndim = 3 call this%SetNumberOfVariables() call this%solution%Init(geometry%x%interp,this%nvar,this%mesh%nElem) @@ -113,6 +114,8 @@ subroutine Init_DGModel3D_t(this,mesh,geometry) call this%flux%AssociateGeometry(geometry) call this%fluxDivergence%AssociateGeometry(geometry) + call this%boundaryconditions%Init() + call this%AdditionalInit() call this%SetMetadata() @@ -147,6 +150,7 @@ subroutine Free_DGModel3D_t(this) call this%flux%Free() call this%source%Free() call this%fluxDivergence%Free() + call this%boundaryconditions%Free() call this%AdditionalFree() endsubroutine Free_DGModel3D_t @@ -440,50 +444,30 @@ subroutine setboundarycondition_DGModel3D_t(this) class(DGModel3D_t),intent(inout) :: this ! local integer :: i,iEl,j,k,e2,bcid - real(prec) :: nhat(1:3),x(1:3) - - do concurrent(k=1:6,iel=1:this%mesh%nElem) - - bcid = this%mesh%sideInfo(5,k,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,k,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then + real(prec) :: nhat(1:3),x(1:3),s(1:this%nvar),dsdx(1:this%nvar,1:3) + type(SELF_BoundaryCondition),pointer :: bc - do j = 1,this%solution%interp%N+1 ! Loop over quadrature points - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - x = this%geometry%x%boundary(i,j,k,iEl,1,1:3) + do iel = 1,this%mesh%nElem + do k = 1,6 - this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & - this%hbc3d_Prescribed(x,this%t) - enddo - enddo - - elseif(bcid == SELF_BC_RADIATION) then - - do j = 1,this%solution%interp%N+1 ! Loop over quadrature points - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - - this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & - this%hbc3d_Radiation(this%solution%boundary(i,j,k,iEl,1:this%nvar),nhat) - enddo - enddo + bcid = this%mesh%sideInfo(5,k,iEl) ! Boundary Condition ID + e2 = this%mesh%sideInfo(3,k,iEl) ! Neighboring Element ID - elseif(bcid == SELF_BC_NONORMALFLOW) then + if(e2 == 0) then - do j = 1,this%solution%interp%N+1 ! Loop over quadrature points - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) + bc = this%boundaryconditions%GetNodeForBCID(bcid) + ! Get the boundary normals on cell edges from the mesh geometry + nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) + x = this%geometry%x%boundary(i,j,k,iEl,1,1:3) + s = this%solution%boundary(i,j,k,iEl,1:this%nvar) + dsdx = this%solutiongradient%boundary(i,j,k,iEl,1:this%nvar,1:3) - this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & - this%hbc3d_NoNormalFlow(this%solution%boundary(i,j,k,iEl,1:this%nvar),nhat) - enddo - enddo + this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & + bc%bcFunc(s,dsdx,x,this%t,nhat) endif - endif + enddo enddo endsubroutine setboundarycondition_DGModel3D_t @@ -496,8 +480,8 @@ subroutine setgradientboundarycondition_DGModel3D_t(this) class(DGModel3D_t),intent(inout) :: this ! local integer :: i,iEl,j,k,e2,bcid - real(prec) :: dsdx(1:this%nvar,1:3) - real(prec) :: nhat(1:3),x(1:3) + real(prec) :: nhat(1:3),x(1:3),s(1:this%nvar),dsdx(1:this%nvar,1:3) + type(SELF_BoundaryCondition),pointer :: bc do concurrent(k=1:6,iel=1:this%mesh%nElem) @@ -505,44 +489,15 @@ subroutine setgradientboundarycondition_DGModel3D_t(this) e2 = this%mesh%sideInfo(3,k,iEl) ! Neighboring Element ID if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - - do j = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - x = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - - this%solutiongradient%extBoundary(i,j,k,iEl,1:this%nvar,1:3) = & - this%pbc3d_Prescribed(x,this%t) - enddo - enddo - - elseif(bcid == SELF_BC_RADIATION) then - - do j = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - - dsdx = this%solutiongradient%boundary(i,j,k,iEl,1:this%nvar,1:3) - - this%solutiongradient%extBoundary(i,j,k,iEl,1:this%nvar,1:3) = & - this%pbc3d_Radiation(dsdx,nhat) - enddo - enddo - - elseif(bcid == SELF_BC_NONORMALFLOW) then - - do j = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - - dsdx = this%solutiongradient%boundary(i,j,k,iEl,1:this%nvar,1:3) - - this%solutiongradient%extBoundary(i,j,k,iEl,1:this%nvar,1:3) = & - this%pbc3d_NoNormalFlow(dsdx,nhat) - enddo - enddo - - endif + bc = this%boundaryconditions%GetNodeForBCID(bcid) + ! Get the boundary normals on cell edges from the mesh geometry + nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) + x = this%geometry%x%boundary(i,j,k,iEl,1,1:3) + s = this%solution%boundary(i,j,k,iEl,1:this%nvar) + dsdx = this%solutiongradient%boundary(i,j,k,iEl,1:this%nvar,1:3) + + this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & + bc%bcgFunc(s,dsdx,x,this%t,nhat) endif enddo diff --git a/src/SELF_Model.f90 b/src/SELF_Model.f90 index 3cdd8e7c4..9d5039643 100644 --- a/src/SELF_Model.f90 +++ b/src/SELF_Model.f90 @@ -90,6 +90,40 @@ module SELF_Model integer,parameter :: SELF_INTEGRATOR_LENGTH = 10 ! max length of integrator methods when specified as char integer,parameter :: SELF_EQUATION_LENGTH = 500 + integer,parameter :: SELF_BCNAME_LENGTH = 32 + + enum,bind(c) + enumerator :: SELF_BC_STATE_CONTEXT = 0 + enumerator :: SELF_BC_GRADIENT_CONTEXT = 1 + endenum + + type SELF_BoundaryCondition + procedure(SELF_BCFunction),pointer :: bcFunction => null() ! For state BCs + procedure(SELF_BCgFunction),pointer :: bcgFunction => null() ! For gradient BCs + integer :: bcid + character(SELF_BCNAME_LENGTH) :: bcname + integer :: context_enum + type(SELF_BoundaryCondition),pointer :: next => null() + type(SELF_BoundaryCondition),pointer :: prev => null() + endtype SELF_BoundaryCondition + + type SELF_BoundaryConditionList + type(SELF_BoundaryCondition),pointer :: current => null() + type(SELF_BoundaryCondition),pointer :: head => null() + type(SELF_BoundaryCondition),pointer :: tail => null() + integer :: nbc + + contains + procedure,private :: init => Init_BCList + procedure,private :: free => Free_BCList + procedure,private :: MoveNext + procedure,private :: rewind + procedure,public :: GetNodeForBCID + generic,public :: RegisterBoundaryCondition => RegisterBCFunction,RegisterBCGFunction + procedure,private :: RegisterBCFunction + procedure,private :: RegisterBCGFunction + + endtype SELF_BoundaryConditionList ! //////////////////////////////////////////////// ! ! Model Formulations @@ -100,6 +134,7 @@ module SELF_Model ! Time integration attributes procedure(SELF_timeIntegrator),pointer :: timeIntegrator => Euler_timeIntegrator + type(SELF_BoundaryConditionList) :: boundaryconditions real(prec) :: dt real(prec) :: t integer :: ioIterate = 0 @@ -107,6 +142,7 @@ module SELF_Model logical :: prescribed_bcs_enabled = .true. logical :: tecplot_enabled = .true. integer :: nvar + integer :: ndim ! Standard Diagnostics real(prec) :: entropy ! Mathematical entropy function for the model @@ -153,28 +189,6 @@ module SELF_Model procedure :: source2d => source2d_Model procedure :: source3d => source3d_Model - ! Boundary condition functions (hyperbolic) - procedure :: hbc1d_Prescribed => hbc1d_Prescribed_Model - procedure :: hbc1d_Radiation => hbc1d_Generic_Model - procedure :: hbc1d_NoNormalFlow => hbc1d_Generic_Model - procedure :: hbc2d_Prescribed => hbc2d_Prescribed_Model - procedure :: hbc2d_Radiation => hbc2d_Generic_Model - procedure :: hbc2d_NoNormalFlow => hbc2d_Generic_Model - procedure :: hbc3d_Prescribed => hbc3d_Prescribed_Model - procedure :: hbc3d_Radiation => hbc3d_Generic_Model - procedure :: hbc3d_NoNormalFlow => hbc3d_Generic_Model - - ! Boundary condition functions (parabolic) - procedure :: pbc1d_Prescribed => pbc1d_Prescribed_Model - procedure :: pbc1d_Radiation => pbc1d_Generic_Model - procedure :: pbc1d_NoNormalFlow => pbc1d_Generic_Model - procedure :: pbc2d_Prescribed => pbc2d_Prescribed_Model - procedure :: pbc2d_Radiation => pbc2d_Generic_Model - procedure :: pbc2d_NoNormalFlow => pbc2d_Generic_Model - procedure :: pbc3d_Prescribed => pbc3d_Prescribed_Model - procedure :: pbc3d_Radiation => pbc3d_Generic_Model - procedure :: pbc3d_NoNormalFlow => pbc3d_Generic_Model - procedure :: ReportEntropy => ReportEntropy_Model procedure :: ReportMetrics => ReportMetrics_Model procedure :: ReportUserMetrics => ReportUserMetrics_Model @@ -193,6 +207,35 @@ module SELF_Model procedure :: GetSimulationTime endtype Model + interface + pure function SELF_BCFunction(this,s,dsdx,x,t,nhat) result(extstate) + use SELF_Constants,only:prec + import Model + implicit none + class(Model),intent(inout) :: this + real(prec),intent(in) :: s(1:this%nvar) + real(prec),intent(in) :: dsdx(1:this%nvar,1:this%ndim) + real(prec),intent(in) :: x(1:this%ndim) + real(prec),intent(in) :: nhat(1:this%ndim) + real(prec),intent(in) :: t + real(prec) :: extstate(1:this%nvar) + endfunction SELF_BCFunction + endinterface + + interface + pure function SELF_BCGFunction(this,s,dsdx,x,t,nhat) result(extstate) + use SELF_Constants,only:prec + import Model + implicit none + class(Model),intent(inout) :: this + real(prec),intent(in) :: s(1:this%nvar) + real(prec),intent(in) :: dsdx(1:this%nvar,1:this%ndim) + real(prec),intent(in) :: x(1:this%ndim) + real(prec),intent(in) :: nhat(1:this%ndim) + real(prec),intent(in) :: t + real(prec) :: extstate(1:this%nvar,1:this%ndim) + endfunction SELF_BCGFunction + endinterface interface subroutine SELF_FreeModel(this) @@ -268,6 +311,167 @@ subroutine WriteTecplot(this,filename) contains +! //////////////////////////////////////////// ! +! Boundary Condition Methods +! ////////////////////////////////////////////// ! + + subroutine Init_BCList(list) + type(SELF_BoundaryConditionList),intent(inout) :: list + list%head => null() + list%tail => null() + list%current => null() + list%nbc = 0 + endsubroutine Init_BCList + + subroutine Free_BCList(list) + type(SELF_BoundaryConditionList),intent(inout) :: list + type(SELF_BoundaryCondition),pointer :: node,next_node + + node => list%head + do while(associated(node)) + next_node => node%next + nullify(node%bcFunction) + deallocate(node) + node => next_node + enddo + + call Init_BCList(list) + endsubroutine Free_BCList + + subroutine MoveNext(list) + type(SELF_BoundaryConditionList),intent(inout) :: list + if(associated(list%current%next)) then + list%current => list%current%next + else + nullify(list%current) + endif + endsubroutine MoveNext + + subroutine rewind(list) + type(SELF_BoundaryConditionList),intent(inout) :: list + list%current => list%head + endsubroutine rewind + + function GetNodeForBCID(list,bcid) result(node) + !! This function returns the node associated with the given bcid + !! and context. If the bcid is not found, a null pointer is returned. + type(SELF_BoundaryConditionList),intent(in) :: list + integer,intent(in) :: bcid + type(SELF_BoundaryCondition),pointer :: node + + bcFunc => null() + node => list%head + + do while(associated(node)) + if(node%bcid == bcid) then + return + endif + node => node%next + enddo + ! If we reach this point, the bcid was not found + ! and we return a null pointer + node => null() + + endfunction GetNodeForBCID + + subroutine RegisterBCFunction(list,bcid,bcname,bcfunc) + !! Register a boundary condition function + !! with the given bcid and bcname. If the bcid + !! is already registered, the function is updated. + !! The function is expected to be a pointer to a + !! SELF_BCFunction type. + type(SELF_BoundaryConditionList),intent(inout) :: list + integer,intent(in) :: bcid + character(*),intent(in) :: bcname + procedure(SELF_BCFunction),pointer,intent(in) :: bcfunc + ! Local + type(SELF_BoundaryCondition),pointer :: bc + + ! Check if bcid is registered + bc = list%GetNodeForBCID(bcid) + if(associated(bc)) then + ! If the bcid is already registered, we do not register it again + print*,"Boundary condition with ID ",bcid," is already registered." + print*,"Assigning new function to existing BC" + bc%bcFunction => bcfunc + else + allocate(bc) + bc%bcid = bcid + bc%bcname = trim(bcname) + bc%bcFunction => bcfunc + nullify(bc%next) + nullify(bc%prev) + + ! Insert at the tail + if(.not. associated(list%head)) then + ! First entry + list%head => bc + list%tail => bc + else + ! Append to tail + bc%prev => list%tail + list%tail%next => bc + list%tail => bc + endif + + list%nbc = list%nbc+1 + list%current => bc + + endif + + endsubroutine RegisterBCFunction + + subroutine RegisterBCGFunction(list,bcid,bcname,bcgfunc) + !! Register a boundary condition function + !! with the given bcid and bcname. If the bcid + !! is already registered, the function is updated. + !! The function is expected to be a pointer to a + !! SELF_BCGFunction type. + type(SELF_BoundaryConditionList),intent(inout) :: list + integer,intent(in) :: bcid + character(*),intent(in) :: bcname + procedure(SELF_BCGFunction),pointer,intent(in) :: bcgfunc + ! Local + type(SELF_BoundaryCondition),pointer :: bc + + ! Check if bcid is registered + bc = list%GetNodeForBCID(bcid) + if(associated(bc)) then + ! If the bcid is already registered, we do not register it again + print*,"Boundary condition with ID ",bcid," is already registered." + print*,"Assigning new function to existing BC" + bc%bcgFunction => bcgfunc + else + allocate(bc) + bc%bcid = bcid + bc%bcname = trim(bcname) + bc%bcFunction => bcfunc + nullify(bc%next) + nullify(bc%prev) + + ! Insert at the tail + if(.not. associated(list%head)) then + ! First entry + list%head => bc + list%tail => bc + else + ! Append to tail + bc%prev => list%tail + list%tail%next => bc + list%tail => bc + endif + + list%nbc = list%nbc+1 + list%current => bc + + endif + + endsubroutine RegisterBCGFunction + +! //////////////////////////////////////////// ! +! Model Methods +! ////////////////////////////////////////////// ! + subroutine IncrementIOCounter(this) implicit none class(Model),intent(inout) :: this @@ -468,174 +672,6 @@ pure function source3d_Model(this,s,dsdx) result(source) endfunction source3d_Model - pure function hbc1d_Generic_Model(this,s,nhat) result(exts) - class(Model),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec),intent(in) :: nhat - real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - exts(ivar) = 0.0_prec - enddo - - endfunction hbc1d_Generic_Model - - pure function hbc1d_Prescribed_Model(this,x,t) result(exts) - class(Model),intent(in) :: this - real(prec),intent(in) :: x - real(prec),intent(in) :: t - real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - exts(ivar) = 0.0_prec - enddo - - endfunction hbc1d_Prescribed_Model - - pure function hbc2d_Generic_Model(this,s,nhat) result(exts) - class(Model),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec),intent(in) :: nhat(1:2) - real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - exts(ivar) = 0.0_prec - enddo - - endfunction hbc2d_Generic_Model - - pure function hbc2d_Prescribed_Model(this,x,t) result(exts) - class(Model),intent(in) :: this - real(prec),intent(in) :: x(1:2) - real(prec),intent(in) :: t - real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - exts(ivar) = 0.0_prec - enddo - - endfunction hbc2d_Prescribed_Model - - pure function hbc3d_Generic_Model(this,s,nhat) result(exts) - class(Model),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec),intent(in) :: nhat(1:3) - real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - exts(ivar) = 0.0_prec - enddo - - endfunction hbc3d_Generic_Model - - pure function hbc3d_Prescribed_Model(this,x,t) result(exts) - class(Model),intent(in) :: this - real(prec),intent(in) :: x(1:3) - real(prec),intent(in) :: t - real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - exts(ivar) = 0.0_prec - enddo - - endfunction hbc3d_Prescribed_Model - - pure function pbc1d_Generic_Model(this,dsdx,nhat) result(extDsdx) - class(Model),intent(in) :: this - real(prec),intent(in) :: dsdx(1:this%nvar) - real(prec),intent(in) :: nhat - real(prec) :: extDsdx(1:this%nvar) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - extDsdx(ivar) = dsdx(ivar) - enddo - - endfunction pbc1d_Generic_Model - - pure function pbc1d_Prescribed_Model(this,x,t) result(extDsdx) - class(Model),intent(in) :: this - real(prec),intent(in) :: x - real(prec),intent(in) :: t - real(prec) :: extDsdx(1:this%nvar) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - extDsdx(ivar) = 0.0_prec - enddo - - endfunction pbc1d_Prescribed_Model - - pure function pbc2d_Generic_Model(this,dsdx,nhat) result(extDsdx) - class(Model),intent(in) :: this - real(prec),intent(in) :: dsdx(1:this%nvar,1:2) - real(prec),intent(in) :: nhat(1:2) - real(prec) :: extDsdx(1:this%nvar,1:2) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - extDsdx(ivar,1:2) = dsdx(ivar,1:2) - enddo - - endfunction pbc2d_Generic_Model - - pure function pbc2d_Prescribed_Model(this,x,t) result(extDsdx) - class(Model),intent(in) :: this - real(prec),intent(in) :: x(1:2) - real(prec),intent(in) :: t - real(prec) :: extDsdx(1:this%nvar,1:2) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - extDsdx(ivar,1:2) = 0.0_prec - enddo - - endfunction pbc2d_Prescribed_Model - - pure function pbc3d_Generic_Model(this,dsdx,nhat) result(extDsdx) - class(Model),intent(in) :: this - real(prec),intent(in) :: dsdx(1:this%nvar,1:3) - real(prec),intent(in) :: nhat(1:3) - real(prec) :: extDsdx(1:this%nvar,1:3) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - extDsdx(ivar,1:3) = dsdx(ivar,1:3) - enddo - - endfunction pbc3d_Generic_Model - - pure function pbc3d_Prescribed_Model(this,x,t) result(extDsdx) - class(Model),intent(in) :: this - real(prec),intent(in) :: x(1:3) - real(prec),intent(in) :: t - real(prec) :: extDsdx(1:this%nvar,1:3) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - extDsdx(ivar,1:3) = 0.0_prec - enddo - - endfunction pbc3d_Prescribed_Model - subroutine SetTimeIntegrator_withChar(this,integrator) !! Sets the time integrator method, using a character input !! diff --git a/src/gpu/SELF_DGModel1D.f90 b/src/gpu/SELF_DGModel1D.f90 index 55d42de39..6bb99c2c6 100644 --- a/src/gpu/SELF_DGModel1D.f90 +++ b/src/gpu/SELF_DGModel1D.f90 @@ -179,62 +179,12 @@ subroutine setboundarycondition_DGModel1D(this) ! on the gradient field implicit none class(DGModel1D),intent(inout) :: this - ! local - integer :: ivar - integer :: N,nelem - real(prec) :: x call gpuCheck(hipMemcpy(c_loc(this%solution%boundary), & this%solution%boundary_gpu,sizeof(this%solution%boundary), & hipMemcpyDeviceToHost)) - nelem = this%geometry%nelem ! number of elements in the mesh - N = this%solution%interp%N ! polynomial degree - ! left-most boundary - if(this%mesh%bcid(1) == SELF_BC_PRESCRIBED) then - - x = this%geometry%x%boundary(1,1,1) - this%solution%extBoundary(1,1,1:this%nvar) = & - this%hbc1d_Prescribed(x,this%t) - - elseif(this%mesh%bcid(1) == SELF_BC_RADIATION) then - - this%solution%extBoundary(1,1,1:this%nvar) = & - this%hbc1d_Radiation(this%solution%boundary(1,1,1:this%nvar),-1.0_prec) - - elseif(this%mesh%bcid(1) == SELF_BC_NONORMALFLOW) then - - this%solution%extBoundary(1,1,1:this%nvar) = & - this%hbc1d_NoNormalFlow(this%solution%boundary(1,1,1:this%nvar),-1.0_prec) - - else ! Periodic - - this%solution%extBoundary(1,1,1:this%nvar) = this%solution%boundary(2,nelem,1:this%nvar) - - endif - - ! right-most boundary - if(this%mesh%bcid(1) == SELF_BC_PRESCRIBED) then - - x = this%geometry%x%boundary(2,nelem,1) - this%solution%extBoundary(2,nelem,1:this%nvar) = & - this%hbc1d_Prescribed(x,this%t) - - elseif(this%mesh%bcid(1) == SELF_BC_RADIATION) then - - this%solution%extBoundary(2,nelem,1:this%nvar) = & - this%hbc1d_Radiation(this%solution%boundary(2,nelem,1:this%nvar),-1.0_prec) - - elseif(this%mesh%bcid(1) == SELF_BC_NONORMALFLOW) then - - this%solution%extBoundary(2,nelem,1:this%nvar) = & - this%hbc1d_NoNormalFlow(this%solution%boundary(2,nelem,1:this%nvar),-1.0_prec) - - else ! Periodic - - this%solution%extBoundary(2,nelem,1:this%nvar) = this%solution%boundary(1,1,1:this%nvar) - - endif + call setboundarycondition_DGModel1D_t(this) call gpuCheck(hipMemcpy(this%solution%extBoundary_gpu, & c_loc(this%solution%extBoundary), & @@ -251,62 +201,12 @@ subroutine setgradientboundarycondition_DGModel1D(this) ! Here, we use periodic boundary conditions implicit none class(DGModel1D),intent(inout) :: this - ! local - integer :: ivar - integer :: nelem - real(prec) :: x call gpuCheck(hipMemcpy(c_loc(this%solutiongradient%boundary), & this%solutiongradient%boundary_gpu,sizeof(this%solutiongradient%boundary), & hipMemcpyDeviceToHost)) - nelem = this%geometry%nelem ! number of elements in the mesh - - ! left-most boundary - if(this%mesh%bcid(1) == SELF_BC_PRESCRIBED) then - - x = this%geometry%x%boundary(1,1,1) - this%solutionGradient%extBoundary(1,1,1:this%nvar) = & - this%pbc1d_Prescribed(x,this%t) - - elseif(this%mesh%bcid(1) == SELF_BC_RADIATION) then - - this%solutionGradient%extBoundary(1,1,1:this%nvar) = & - this%pbc1d_Radiation(this%solutionGradient%boundary(1,1,1:this%nvar),-1.0_prec) - - elseif(this%mesh%bcid(1) == SELF_BC_NONORMALFLOW) then - - this%solutionGradient%extBoundary(1,1,1:this%nvar) = & - this%pbc1d_NoNormalFlow(this%solutionGradient%boundary(1,1,1:this%nvar),-1.0_prec) - - else ! Periodic - - this%solutionGradient%extBoundary(1,1,1:this%nvar) = this%solutionGradient%boundary(2,nelem,1:this%nvar) - - endif - - ! right-most boundary - if(this%mesh%bcid(1) == SELF_BC_PRESCRIBED) then - - x = this%geometry%x%boundary(2,nelem,1) - this%solutionGradient%extBoundary(2,nelem,1:this%nvar) = & - this%pbc1d_Prescribed(x,this%t) - - elseif(this%mesh%bcid(1) == SELF_BC_RADIATION) then - - this%solutionGradient%extBoundary(2,nelem,1:this%nvar) = & - this%pbc1d_Radiation(this%solutionGradient%boundary(2,nelem,1:this%nvar),-1.0_prec) - - elseif(this%mesh%bcid(1) == SELF_BC_NONORMALFLOW) then - - this%solutionGradient%extBoundary(2,nelem,1:this%nvar) = & - this%pbc1d_NoNormalFlow(this%solutionGradient%boundary(2,nelem,1:this%nvar),-1.0_prec) - - else ! Periodic - - this%solutionGradient%extBoundary(2,nelem,1:this%nvar) = this%solutionGradient%boundary(1,1,1:this%nvar) - - endif + call setgradientboundarycondition_DGModel1D_t(this) call gpuCheck(hipMemcpy(this%solutiongradient%extBoundary_gpu, & c_loc(this%solutiongradient%extBoundary), & diff --git a/src/gpu/SELF_DGModel2D.f90 b/src/gpu/SELF_DGModel2D.f90 index 0d5c00042..f0742ac98 100644 --- a/src/gpu/SELF_DGModel2D.f90 +++ b/src/gpu/SELF_DGModel2D.f90 @@ -296,9 +296,6 @@ subroutine setboundarycondition_DGModel2D(this) !! boundary conditions. implicit none class(DGModel2D),intent(inout) :: this - ! local - integer :: i,iEl,j,e2,bcid - real(prec) :: nhat(1:2),x(1:2) call gpuCheck(hipMemcpy(c_loc(this%solution%boundary), & this%solution%boundary_gpu,sizeof(this%solution%boundary), & @@ -308,43 +305,7 @@ subroutine setboundarycondition_DGModel2D(this) this%solution%extboundary_gpu,sizeof(this%solution%extboundary), & hipMemcpyDeviceToHost)) - do concurrent(j=1:4,iel=1:this%mesh%nElem) - - bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - x = this%geometry%x%boundary(i,j,iEl,1,1:2) - - this%solution%extBoundary(i,j,iEl,1:this%nvar) = & - this%hbc2d_Prescribed(x,this%t) - enddo - - elseif(bcid == SELF_BC_RADIATION) then - - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) - - this%solution%extBoundary(i,j,iEl,1:this%nvar) = & - this%hbc2d_Radiation(this%solution%boundary(i,j,iEl,1:this%nvar),nhat) - enddo - - elseif(bcid == SELF_BC_NONORMALFLOW) then - - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) - - this%solution%extBoundary(i,j,iEl,1:this%nvar) = & - this%hbc2d_NoNormalFlow(this%solution%boundary(i,j,iEl,1:this%nvar),nhat) - enddo - - endif - endif - - enddo + call setboundarycondition_DGModel2D_t(this) call gpuCheck(hipMemcpy(this%solution%extBoundary_gpu, & c_loc(this%solution%extBoundary), & @@ -359,10 +320,6 @@ subroutine setgradientboundarycondition_DGModel2D(this) !! boundary conditions. implicit none class(DGModel2D),intent(inout) :: this - ! local - integer :: i,iEl,j,e2,bcid - real(prec) :: dsdx(1:this%nvar,1:2) - real(prec) :: nhat(1:2),x(1:2) call gpuCheck(hipMemcpy(c_loc(this%solutiongradient%boundary), & this%solutiongradient%boundary_gpu,sizeof(this%solutiongradient%boundary), & @@ -372,47 +329,7 @@ subroutine setgradientboundarycondition_DGModel2D(this) this%solutiongradient%extboundary_gpu,sizeof(this%solutiongradient%extboundary), & hipMemcpyDeviceToHost)) - do concurrent(j=1:4,iel=1:this%mesh%nElem) - - bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - x = this%geometry%x%boundary(i,j,iEl,1,1:2) - - this%solutiongradient%extBoundary(i,j,iEl,1:this%nvar,1:2) = & - this%pbc2d_Prescribed(x,this%t) - enddo - - elseif(bcid == SELF_BC_RADIATION) then - - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) - - dsdx = this%solutiongradient%boundary(i,j,iEl,1:this%nvar,1:2) - - this%solutiongradient%extBoundary(i,j,iEl,1:this%nvar,1:2) = & - this%pbc2d_Radiation(dsdx,nhat) - enddo - - elseif(bcid == SELF_BC_NONORMALFLOW) then - - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) - - dsdx = this%solutiongradient%boundary(i,j,iEl,1:this%nvar,1:2) - - this%solutiongradient%extBoundary(i,j,iEl,1:this%nvar,1:2) = & - this%pbc2d_NoNormalFlow(dsdx,nhat) - enddo - - endif - endif - - enddo + call setgradientboundarycondition_DGModel2D_t(this) call gpuCheck(hipMemcpy(this%solutiongradient%extBoundary_gpu, & c_loc(this%solutiongradient%extBoundary), & diff --git a/src/gpu/SELF_DGModel3D.f90 b/src/gpu/SELF_DGModel3D.f90 index 2fe9378f5..1b429a38e 100644 --- a/src/gpu/SELF_DGModel3D.f90 +++ b/src/gpu/SELF_DGModel3D.f90 @@ -296,9 +296,6 @@ subroutine setboundarycondition_DGModel3D(this) !! boundary conditions. implicit none class(DGModel3D),intent(inout) :: this - ! local - integer :: i,iEl,j,k,e2,bcid - real(prec) :: nhat(1:3),x(1:3) call gpuCheck(hipMemcpy(c_loc(this%solution%boundary), & this%solution%boundary_gpu,sizeof(this%solution%boundary), & @@ -308,49 +305,7 @@ subroutine setboundarycondition_DGModel3D(this) this%solution%extboundary_gpu,sizeof(this%solution%extboundary), & hipMemcpyDeviceToHost)) - do concurrent(k=1:6,iel=1:this%mesh%nElem) - - bcid = this%mesh%sideInfo(5,k,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,k,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - - do j = 1,this%solution%interp%N+1 ! Loop over quadrature points - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - x = this%geometry%x%boundary(i,j,k,iEl,1,1:3) - - this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & - this%hbc3d_Prescribed(x,this%t) - enddo - enddo - - elseif(bcid == SELF_BC_RADIATION) then - - do j = 1,this%solution%interp%N+1 ! Loop over quadrature points - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - - this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & - this%hbc3d_Radiation(this%solution%boundary(i,j,k,iEl,1:this%nvar),nhat) - enddo - enddo - - elseif(bcid == SELF_BC_NONORMALFLOW) then - - do j = 1,this%solution%interp%N+1 ! Loop over quadrature points - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - - this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & - this%hbc3d_NoNormalFlow(this%solution%boundary(i,j,k,iEl,1:this%nvar),nhat) - enddo - enddo - - endif - endif - - enddo + call setboundarycondition_DGModel3D_t(this) call gpuCheck(hipMemcpy(this%solution%extBoundary_gpu, & c_loc(this%solution%extBoundary), & @@ -365,10 +320,6 @@ subroutine setgradientboundarycondition_DGModel3D(this) !! boundary conditions. implicit none class(DGModel3D),intent(inout) :: this - ! local - integer :: i,iEl,j,k,e2,bcid - real(prec) :: dsdx(1:this%nvar,1:3) - real(prec) :: nhat(1:3),x(1:3) call gpuCheck(hipMemcpy(c_loc(this%solutiongradient%boundary), & this%solutiongradient%boundary_gpu,sizeof(this%solutiongradient%boundary), & @@ -378,53 +329,7 @@ subroutine setgradientboundarycondition_DGModel3D(this) this%solutiongradient%extboundary_gpu,sizeof(this%solutiongradient%extboundary), & hipMemcpyDeviceToHost)) - do concurrent(k=1:6,iel=1:this%mesh%nElem) - - bcid = this%mesh%sideInfo(5,k,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,k,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - - do j = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - x = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - - this%solutiongradient%extBoundary(i,j,k,iEl,1:this%nvar,1:3) = & - this%pbc3d_Prescribed(x,this%t) - enddo - enddo - - elseif(bcid == SELF_BC_RADIATION) then - - do j = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - - dsdx = this%solutiongradient%boundary(i,j,k,iEl,1:this%nvar,1:3) - - this%solutiongradient%extBoundary(i,j,k,iEl,1:this%nvar,1:3) = & - this%pbc3d_Radiation(dsdx,nhat) - enddo - enddo - - elseif(bcid == SELF_BC_NONORMALFLOW) then - - do j = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - - dsdx = this%solutiongradient%boundary(i,j,k,iEl,1:this%nvar,1:3) - - this%solutiongradient%extBoundary(i,j,k,iEl,1:this%nvar,1:3) = & - this%pbc3d_NoNormalFlow(dsdx,nhat) - enddo - enddo - - endif - endif - - enddo + call setgradientboundarycondition_DGModel3D_t(this) call gpuCheck(hipMemcpy(this%solutiongradient%extBoundary_gpu, & c_loc(this%solutiongradient%extBoundary), & diff --git a/test/burgers1d_nonormalflow.f90 b/test/burgers1d_nonormalflow.f90 deleted file mode 100644 index ec41c05e5..000000000 --- a/test/burgers1d_nonormalflow.f90 +++ /dev/null @@ -1,110 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program burgers1d_constant - - use self_data - use self_burgers1d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'euler' - integer,parameter :: nelem = 50 - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: nu = 0.01_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-5) ! 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(burgers1d) :: modelobj - type(Lagrange),target :: interp - type(Mesh1D),target :: mesh - type(Geometry1D),target :: geometry - - ! Create a mesh using the built-in - ! uniform mesh generator. - ! The domain is set to x in [0,1] - ! We use `nelem` elements - call mesh%StructuredMesh(nElem=nelem, & - x=(/0.0_prec,1.0_prec/)) - call mesh%ResetBoundaryConditionType(SELF_BC_NONORMALFLOW,SELF_BC_NONORMALFLOW) - - ! 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 diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = 1.0') - call modelobj%solution%SetInteriorFromEquation(0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy ! Save the initial entropy - !Write the initial condition - call modelobj%WriteModel() - call modelobj%WriteTecplot() - call modelobj%IncrementIOCounter() - ! 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 burgers1d_constant diff --git a/test/burgers1d_prescribed.f90 b/test/burgers1d_prescribed.f90 index ef91b4f0b..9e3b16469 100644 --- a/test/burgers1d_prescribed.f90 +++ b/test/burgers1d_prescribed.f90 @@ -30,6 +30,7 @@ program burgers1d_constant use self_burgers1d implicit none + integer,parameter :: SELF_BC_PRESCRIBED = 1 ! Provide a parameter for tagging a prescribed boundary condition character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'euler' integer,parameter :: nelem = 50 integer,parameter :: controlDegree = 7 @@ -64,6 +65,11 @@ program burgers1d_constant ! Initialize the model call modelobj%Init(mesh,geometry) modelobj%gradient_enabled = .true. + + ! Register boundary conditions + call modelobj%boundaryconditions%RegisterBoundaryCondition(SELF_BC_PRESCRIBED,'prescribed',Burgers1d_prescribed) + call modelobj%boundaryconditions%RegisterBoundaryCondition(SELF_BC_PRESCRIBED,'prescribed',Burgers1d_gradient_prescribed) + !Set the diffusivity modelobj%nu = nu @@ -106,4 +112,44 @@ program burgers1d_constant call geometry%free() call interp%free() +contains + pure function Burgers1d_prescribed(this,s,dsdx,x,t,nhat) result(extstate) + !! This function is called to set the boundary condition + !! for the Burgers1D model. The function is called + !! at the boundary nodes of the mesh. The function + !! returns the value of the state variable at the + !! boundary nodes. + use SELF_Constants,only:prec + use self_Burgers1D + implicit none + class(self_Burgers1D),intent(inout) :: this + real(prec),intent(in) :: s(1:this%nvar) + real(prec),intent(in) :: dsdx(1:this%nvar,1:this%ndim) + real(prec),intent(in) :: x(1:this%ndim) + real(prec),intent(in) :: nhat(1:this%ndim) + real(prec),intent(in) :: t + real(prec) :: extstate(1:this%nvar) + + extstate(1:this%nvar) = 1.0_prec + + endfunction Burgers1d_prescribed + + pure function Burgers1d_gradient_prescribed(this,s,dsdx,x,t,nhat) result(extstate) + ! This function is used to set the gradient of the prescribed boundary condition + ! to zero. This is necessary for the prescribed boundary condition to work correctly. + use SELF_Constants,only:prec + use self_Burgers1D + implicit none + class(self_Burgers1D),intent(inout) :: this + real(prec),intent(in) :: s(1:this%nvar) + real(prec),intent(in) :: dsdx(1:this%nvar,1:this%ndim) + real(prec),intent(in) :: x(1:this%ndim) + real(prec),intent(in) :: nhat(1:this%ndim) + real(prec),intent(in) :: t + real(prec) :: extstate(1:this%nvar,1:this%ndim) + + extstate(1:this%nvar,1:this%ndim) = 0.0_prec + + endfunction Burgers1d_gradient_prescribed + endprogram burgers1d_constant diff --git a/test/burgers1d_radiation.f90 b/test/burgers1d_radiation.f90 deleted file mode 100644 index 9e2393cff..000000000 --- a/test/burgers1d_radiation.f90 +++ /dev/null @@ -1,110 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program burgers1d_constant - - use self_data - use self_burgers1d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'euler' - integer,parameter :: nelem = 50 - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: nu = 0.01_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-5) ! 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(burgers1d) :: modelobj - type(Lagrange),target :: interp - type(Mesh1D),target :: mesh - type(Geometry1D),target :: geometry - - ! Create a mesh using the built-in - ! uniform mesh generator. - ! The domain is set to x in [0,1] - ! We use `nelem` elements - call mesh%StructuredMesh(nElem=nelem, & - x=(/0.0_prec,1.0_prec/)) - call mesh%ResetBoundaryConditionType(SELF_BC_RADIATION,SELF_BC_RADIATION) - - ! 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 diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = 1.0') - call modelobj%solution%SetInteriorFromEquation(0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy ! Save the initial entropy - !Write the initial condition - call modelobj%WriteModel() - call modelobj%WriteTecplot() - call modelobj%IncrementIOCounter() - ! 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 burgers1d_constant From b3183a0aead386bc28853ca1a41a8fa5214ea8af Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Fri, 4 Jul 2025 14:50:22 -0400 Subject: [PATCH 14/17] Split BoundaryConditions into separate module --- src/SELF_BoundaryConditions.f90 | 258 ++++++++++++++++++++++++++++++++ src/SELF_Model.f90 | 221 +-------------------------- test/CMakeLists.txt | 24 ++- 3 files changed, 270 insertions(+), 233 deletions(-) create mode 100644 src/SELF_BoundaryConditions.f90 diff --git a/src/SELF_BoundaryConditions.f90 b/src/SELF_BoundaryConditions.f90 new file mode 100644 index 000000000..73dbd6f56 --- /dev/null +++ b/src/SELF_BoundaryConditions.f90 @@ -0,0 +1,258 @@ +! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! +! +! Maintainers : support@fluidnumerics.com +! Official Repository : https://github.com/FluidNumerics/self/ +! +! Copyright © 2024 Fluid Numerics LLC +! +! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in +! the documentation and/or other materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from +! this software without specific prior written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! + +module SELF_BoundaryConditions + + use SELF_SupportRoutines + use SELF_Metadata + + implicit none + integer,parameter :: SELF_BCNAME_LENGTH = 32 + + enum,bind(c) + enumerator :: SELF_BC_STATE_CONTEXT = 0 + enumerator :: SELF_BC_GRADIENT_CONTEXT = 1 + endenum + + type SELF_BoundaryCondition + procedure(SELF_BCFunction),pointer :: bcFunction => null() ! For state BCs + procedure(SELF_BCgFunction),pointer :: bcgFunction => null() ! For gradient BCs + integer :: bcid + character(SELF_BCNAME_LENGTH) :: bcname + integer :: context_enum + type(SELF_BoundaryCondition),pointer :: next => null() + type(SELF_BoundaryCondition),pointer :: prev => null() + endtype SELF_BoundaryCondition + + type SELF_BoundaryConditionList + type(SELF_BoundaryCondition),pointer :: current => null() + type(SELF_BoundaryCondition),pointer :: head => null() + type(SELF_BoundaryCondition),pointer :: tail => null() + integer :: nbc + + contains + procedure,public :: init => Init_BCList + procedure,public :: free => Free_BCList + procedure,private :: MoveNext + procedure,private :: rewind + procedure,public :: GetBCForID + generic,public :: RegisterBoundaryCondition => RegisterBCFunction,RegisterBCGFunction + procedure,private :: RegisterBCFunction + procedure,private :: RegisterBCGFunction + + endtype SELF_BoundaryConditionList + + interface + pure function SELF_BCFunction(this,s,dsdx,x,t,nhat,nvar,ndim) result(extstate) + use SELF_Constants,only:prec + import SELF_BoundaryCondition + implicit none + class(SELF_BoundaryCondition),intent(in) :: this + integer,intent(in) :: nvar,ndim + real(prec),intent(in) :: s(1:nvar) + real(prec),intent(in) :: dsdx(1:nvar,1:ndim) + real(prec),intent(in) :: x(1:ndim) + real(prec),intent(in) :: nhat(1:ndim) + real(prec),intent(in) :: t + real(prec) :: extstate(1:nvar) + endfunction SELF_BCFunction + endinterface + + interface + pure function SELF_BCGFunction(this,s,dsdx,x,t,nhat,nvar,ndim) result(extstate) + use SELF_Constants,only:prec + import SELF_BoundaryCondition + implicit none + class(SELF_BoundaryCondition),intent(in) :: this + integer,intent(in) :: nvar,ndim + real(prec),intent(in) :: s(1:nvar) + real(prec),intent(in) :: dsdx(1:nvar,1:ndim) + real(prec),intent(in) :: x(1:ndim) + real(prec),intent(in) :: nhat(1:ndim) + real(prec),intent(in) :: t + real(prec) :: extstate(1:nvar,1:ndim) + endfunction SELF_BCGFunction + endinterface + +contains + +! //////////////////////////////////////////// ! +! Boundary Condition Methods +! ////////////////////////////////////////////// ! + + subroutine Init_BCList(list) + class(SELF_BoundaryConditionList),intent(inout) :: list + list%head => null() + list%tail => null() + list%current => null() + list%nbc = 0 + endsubroutine Init_BCList + + subroutine Free_BCList(list) + class(SELF_BoundaryConditionList),intent(inout) :: list + type(SELF_BoundaryCondition),pointer :: node,next_node + + node => list%head + do while(associated(node)) + next_node => node%next + nullify(node%bcFunction) + deallocate(node) + node => next_node + enddo + + call Init_BCList(list) + endsubroutine Free_BCList + + subroutine MoveNext(list) + class(SELF_BoundaryConditionList),intent(inout) :: list + if(associated(list%current%next)) then + list%current => list%current%next + else + nullify(list%current) + endif + endsubroutine MoveNext + + subroutine rewind(list) + class(SELF_BoundaryConditionList),intent(inout) :: list + list%current => list%head + endsubroutine rewind + + function GetBCForID(list,bcid) result(node) + !! This function returns the node associated with the given bcid + !! and context. If the bcid is not found, a null pointer is returned. + class(SELF_BoundaryConditionList),intent(in) :: list + integer,intent(in) :: bcid + type(SELF_BoundaryCondition),pointer :: node + + node => list%head + + do while(associated(node)) + if(node%bcid == bcid) then + return + endif + node => node%next + enddo + ! If we reach this point, the bcid was not found + ! and we return a null pointer + node => null() + + endfunction GetBCForID + + subroutine RegisterBCFunction(list,bcid,bcname,bcfunc) + !! Register a boundary condition function + !! with the given bcid and bcname. If the bcid + !! is already registered, the function is updated. + !! The function is expected to be a pointer to a + !! SELF_BCFunction type. + class(SELF_BoundaryConditionList),intent(inout) :: list + integer,intent(in) :: bcid + character(*),intent(in) :: bcname + procedure(SELF_BCFunction),pointer,intent(in) :: bcfunc + ! Local + type(SELF_BoundaryCondition),pointer :: bc + + ! Check if bcid is registered + bc => list%GetBCForID(bcid) + if(associated(bc)) then + ! If the bcid is already registered, we do not register it again + print*,"Boundary condition with ID ",bcid," is already registered." + print*,"Assigning new function to existing BC" + bc%bcFunction => bcfunc + else + allocate(bc) + bc%bcid = bcid + bc%bcname = trim(bcname) + bc%bcFunction => bcfunc + nullify(bc%next) + nullify(bc%prev) + + ! Insert at the tail + if(.not. associated(list%head)) then + ! First entry + list%head => bc + list%tail => bc + else + ! Append to tail + bc%prev => list%tail + list%tail%next => bc + list%tail => bc + endif + + list%nbc = list%nbc+1 + list%current => bc + + endif + + endsubroutine RegisterBCFunction + + subroutine RegisterBCGFunction(list,bcid,bcname,bcgfunc) + !! Register a boundary condition function + !! with the given bcid and bcname. If the bcid + !! is already registered, the function is updated. + !! The function is expected to be a pointer to a + !! SELF_BCGFunction type. + class(SELF_BoundaryConditionList),intent(inout) :: list + integer,intent(in) :: bcid + character(*),intent(in) :: bcname + procedure(SELF_BCGFunction),pointer,intent(in) :: bcgfunc + ! Local + type(SELF_BoundaryCondition),pointer :: bc + + ! Check if bcid is registered + bc => list%GetBCForID(bcid) + if(associated(bc)) then + ! If the bcid is already registered, we do not register it again + print*,"Boundary condition with ID ",bcid," is already registered." + print*,"Assigning new function to existing BC" + bc%bcgFunction => bcgfunc + else + allocate(bc) + bc%bcid = bcid + bc%bcname = trim(bcname) + bc%bcgFunction => bcgfunc + nullify(bc%next) + nullify(bc%prev) + + ! Insert at the tail + if(.not. associated(list%head)) then + ! First entry + list%head => bc + list%tail => bc + else + ! Append to tail + bc%prev => list%tail + list%tail%next => bc + list%tail => bc + endif + + list%nbc = list%nbc+1 + list%current => bc + + endif + + endsubroutine RegisterBCGFunction + +endmodule SELF_BoundaryConditions diff --git a/src/SELF_Model.f90 b/src/SELF_Model.f90 index 9d5039643..8ed88d3cc 100644 --- a/src/SELF_Model.f90 +++ b/src/SELF_Model.f90 @@ -31,6 +31,7 @@ module SELF_Model use SELF_HDF5 use HDF5 use FEQParse + use SELF_BoundaryConditions #include "SELF_Macros.h" @@ -90,40 +91,6 @@ module SELF_Model integer,parameter :: SELF_INTEGRATOR_LENGTH = 10 ! max length of integrator methods when specified as char integer,parameter :: SELF_EQUATION_LENGTH = 500 - integer,parameter :: SELF_BCNAME_LENGTH = 32 - - enum,bind(c) - enumerator :: SELF_BC_STATE_CONTEXT = 0 - enumerator :: SELF_BC_GRADIENT_CONTEXT = 1 - endenum - - type SELF_BoundaryCondition - procedure(SELF_BCFunction),pointer :: bcFunction => null() ! For state BCs - procedure(SELF_BCgFunction),pointer :: bcgFunction => null() ! For gradient BCs - integer :: bcid - character(SELF_BCNAME_LENGTH) :: bcname - integer :: context_enum - type(SELF_BoundaryCondition),pointer :: next => null() - type(SELF_BoundaryCondition),pointer :: prev => null() - endtype SELF_BoundaryCondition - - type SELF_BoundaryConditionList - type(SELF_BoundaryCondition),pointer :: current => null() - type(SELF_BoundaryCondition),pointer :: head => null() - type(SELF_BoundaryCondition),pointer :: tail => null() - integer :: nbc - - contains - procedure,private :: init => Init_BCList - procedure,private :: free => Free_BCList - procedure,private :: MoveNext - procedure,private :: rewind - procedure,public :: GetNodeForBCID - generic,public :: RegisterBoundaryCondition => RegisterBCFunction,RegisterBCGFunction - procedure,private :: RegisterBCFunction - procedure,private :: RegisterBCGFunction - - endtype SELF_BoundaryConditionList ! //////////////////////////////////////////////// ! ! Model Formulations @@ -207,35 +174,6 @@ module SELF_Model procedure :: GetSimulationTime endtype Model - interface - pure function SELF_BCFunction(this,s,dsdx,x,t,nhat) result(extstate) - use SELF_Constants,only:prec - import Model - implicit none - class(Model),intent(inout) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec),intent(in) :: dsdx(1:this%nvar,1:this%ndim) - real(prec),intent(in) :: x(1:this%ndim) - real(prec),intent(in) :: nhat(1:this%ndim) - real(prec),intent(in) :: t - real(prec) :: extstate(1:this%nvar) - endfunction SELF_BCFunction - endinterface - - interface - pure function SELF_BCGFunction(this,s,dsdx,x,t,nhat) result(extstate) - use SELF_Constants,only:prec - import Model - implicit none - class(Model),intent(inout) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec),intent(in) :: dsdx(1:this%nvar,1:this%ndim) - real(prec),intent(in) :: x(1:this%ndim) - real(prec),intent(in) :: nhat(1:this%ndim) - real(prec),intent(in) :: t - real(prec) :: extstate(1:this%nvar,1:this%ndim) - endfunction SELF_BCGFunction - endinterface interface subroutine SELF_FreeModel(this) @@ -311,163 +249,6 @@ subroutine WriteTecplot(this,filename) contains -! //////////////////////////////////////////// ! -! Boundary Condition Methods -! ////////////////////////////////////////////// ! - - subroutine Init_BCList(list) - type(SELF_BoundaryConditionList),intent(inout) :: list - list%head => null() - list%tail => null() - list%current => null() - list%nbc = 0 - endsubroutine Init_BCList - - subroutine Free_BCList(list) - type(SELF_BoundaryConditionList),intent(inout) :: list - type(SELF_BoundaryCondition),pointer :: node,next_node - - node => list%head - do while(associated(node)) - next_node => node%next - nullify(node%bcFunction) - deallocate(node) - node => next_node - enddo - - call Init_BCList(list) - endsubroutine Free_BCList - - subroutine MoveNext(list) - type(SELF_BoundaryConditionList),intent(inout) :: list - if(associated(list%current%next)) then - list%current => list%current%next - else - nullify(list%current) - endif - endsubroutine MoveNext - - subroutine rewind(list) - type(SELF_BoundaryConditionList),intent(inout) :: list - list%current => list%head - endsubroutine rewind - - function GetNodeForBCID(list,bcid) result(node) - !! This function returns the node associated with the given bcid - !! and context. If the bcid is not found, a null pointer is returned. - type(SELF_BoundaryConditionList),intent(in) :: list - integer,intent(in) :: bcid - type(SELF_BoundaryCondition),pointer :: node - - bcFunc => null() - node => list%head - - do while(associated(node)) - if(node%bcid == bcid) then - return - endif - node => node%next - enddo - ! If we reach this point, the bcid was not found - ! and we return a null pointer - node => null() - - endfunction GetNodeForBCID - - subroutine RegisterBCFunction(list,bcid,bcname,bcfunc) - !! Register a boundary condition function - !! with the given bcid and bcname. If the bcid - !! is already registered, the function is updated. - !! The function is expected to be a pointer to a - !! SELF_BCFunction type. - type(SELF_BoundaryConditionList),intent(inout) :: list - integer,intent(in) :: bcid - character(*),intent(in) :: bcname - procedure(SELF_BCFunction),pointer,intent(in) :: bcfunc - ! Local - type(SELF_BoundaryCondition),pointer :: bc - - ! Check if bcid is registered - bc = list%GetNodeForBCID(bcid) - if(associated(bc)) then - ! If the bcid is already registered, we do not register it again - print*,"Boundary condition with ID ",bcid," is already registered." - print*,"Assigning new function to existing BC" - bc%bcFunction => bcfunc - else - allocate(bc) - bc%bcid = bcid - bc%bcname = trim(bcname) - bc%bcFunction => bcfunc - nullify(bc%next) - nullify(bc%prev) - - ! Insert at the tail - if(.not. associated(list%head)) then - ! First entry - list%head => bc - list%tail => bc - else - ! Append to tail - bc%prev => list%tail - list%tail%next => bc - list%tail => bc - endif - - list%nbc = list%nbc+1 - list%current => bc - - endif - - endsubroutine RegisterBCFunction - - subroutine RegisterBCGFunction(list,bcid,bcname,bcgfunc) - !! Register a boundary condition function - !! with the given bcid and bcname. If the bcid - !! is already registered, the function is updated. - !! The function is expected to be a pointer to a - !! SELF_BCGFunction type. - type(SELF_BoundaryConditionList),intent(inout) :: list - integer,intent(in) :: bcid - character(*),intent(in) :: bcname - procedure(SELF_BCGFunction),pointer,intent(in) :: bcgfunc - ! Local - type(SELF_BoundaryCondition),pointer :: bc - - ! Check if bcid is registered - bc = list%GetNodeForBCID(bcid) - if(associated(bc)) then - ! If the bcid is already registered, we do not register it again - print*,"Boundary condition with ID ",bcid," is already registered." - print*,"Assigning new function to existing BC" - bc%bcgFunction => bcgfunc - else - allocate(bc) - bc%bcid = bcid - bc%bcname = trim(bcname) - bc%bcFunction => bcfunc - nullify(bc%next) - nullify(bc%prev) - - ! Insert at the tail - if(.not. associated(list%head)) then - ! First entry - list%head => bc - list%tail => bc - else - ! Append to tail - bc%prev => list%tail - list%tail%next => bc - list%tail => bc - endif - - list%nbc = list%nbc+1 - list%current => bc - - endif - - endsubroutine RegisterBCGFunction - ! //////////////////////////////////////////// ! ! Model Methods ! ////////////////////////////////////////////// ! diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index ea5a18e9f..6bfd5969a 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -1,28 +1,28 @@ -# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -# +# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +# # Maintainers : support@fluidnumerics.com # Official Repository : https://github.com/FluidNumerics/self/ -# +# # Copyright © 2024 Fluid Numerics LLC -# +# # Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -# +# # 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -# +# # 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in # the documentation and/or other materials provided with the distribution. -# +# # 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from # this software without specific prior written permission. -# +# # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT # HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT # LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -# -# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +# +# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// CMAKE_MINIMUM_REQUIRED(VERSION 3.21) @@ -118,9 +118,7 @@ add_fortran_tests ( "advection_diffusion_1d_rk3.f90" "advection_diffusion_1d_rk4.f90" "burgers1d_constant.f90" - "burgers1d_nonormalflow.f90" "burgers1d_prescribed.f90" - "burgers1d_radiation.f90" "advection_diffusion_2d_euler.f90" "advection_diffusion_2d_rk2.f90" "advection_diffusion_2d_rk3.f90" @@ -146,4 +144,4 @@ add_mpi_fortran_tests( "mappedvectordgdivergence_2d_linear_mpi.f90" "advection_diffusion_2d_rk3_mpi.f90" "advection_diffusion_2d_rk3_pickup_mpi.f90" "advection_diffusion_3d_rk3_mpi.f90" - "advection_diffusion_3d_rk3_pickup_mpi.f90" ) \ No newline at end of file + "advection_diffusion_3d_rk3_pickup_mpi.f90" ) From 411f08affb3554b6a31ad651c7046594e898aded Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Fri, 4 Jul 2025 14:51:15 -0400 Subject: [PATCH 15/17] Use extensible bcs in DGModel1D_t --- src/SELF_DGModel1D_t.f90 | 33 +++++++++++++++++---------------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/src/SELF_DGModel1D_t.f90 b/src/SELF_DGModel1D_t.f90 index 84fd7448a..25cbf0d6a 100644 --- a/src/SELF_DGModel1D_t.f90 +++ b/src/SELF_DGModel1D_t.f90 @@ -336,22 +336,22 @@ subroutine setboundarycondition_DGModel1D_t(this) N = this%solution%interp%N ! polynomial degree ! Left boundary condition - bcFunc = this%boundaryconditions%GetNodeForBCID(this%mesh%bcid(1)) - x = this%geometry%x%boundary(1,1) + bc => this%boundaryconditions%GetBCForID(this%mesh%bcid(1)) + x = this%geometry%x%boundary(1,1,1) s = this%solution%boundary(1,1,1:this%nvar) - dsdx = this%solutionGradient%boundary(1,1,1:this%nvar) + dsdx(1:this%nvar,1) = this%solutionGradient%boundary(1,1,1:this%nvar) t = this%t nhat = -1.0_prec - this%solution%extBoundary(1,1,1:this%nvar) = bc%bcFunc(s,dsdx,x,t,nhat) + this%solution%extBoundary(1,1,1:this%nvar) = bc%bcFunction(s,dsdx,x,t,nhat,this%nvar,1) ! Right boundary condition - bcFunc = this%boundaryconditions%GetNodeForBCID(this%mesh%bcid(1)) - x = this%geometry%x%boundary(2,nelem) + bc => this%boundaryconditions%GetBCForID(this%mesh%bcid(1)) + x = this%geometry%x%boundary(2,nelem,1) s = this%solution%boundary(2,nelem,1:this%nvar) - dsdx = this%solutionGradient%boundary(2,nelem,1:this%nvar) + dsdx(1:this%nvar,1) = this%solutionGradient%boundary(2,nelem,1:this%nvar) t = this%t nhat = 1.0_prec - this%solution%extBoundary(2,nelem,1:this%nvar) = bc%bcFunc(s,dsdx,x,t,nhat) + this%solution%extBoundary(2,nelem,1:this%nvar) = bc%bcFunction(s,dsdx,x,t,nhat,this%nvar,1) endsubroutine setboundarycondition_DGModel1D_t @@ -367,26 +367,27 @@ subroutine setgradientboundarycondition_DGModel1D_t(this) real(prec) :: x(1),nhat(1),s(1:this%nvar),dsdx(1:this%nvar,1),t real(prec) :: exts(1:this%nvar,1) integer :: nelem + type(SELF_BoundaryCondition),pointer :: bc nelem = this%geometry%nelem ! number of elements in the mesh ! Left boundary condition - bcFunc = this%boundaryconditions%GetNodeForBCID(this%mesh%bcid(1)) - x = this%geometry%x%boundary(1,1) + bc => this%boundaryconditions%GetBCForID(this%mesh%bcid(1)) + x(1) = this%geometry%x%boundary(1,1,1) s = this%solution%boundary(1,1,1:this%nvar) - dsdx = this%solutionGradient%boundary(1,1,1:this%nvar) + dsdx(1:this%nvar,1) = this%solutionGradient%boundary(1,1,1:this%nvar) t = this%t nhat = -1.0_prec - exts = bc%bcFunc(s,dsdx,x,t,nhat) + exts = bc%bcgFunction(s,dsdx,x,t,nhat,this%nvar,1) this%solutiongradient%extBoundary(1,1,1:this%nvar) = exts(1:this%nvar,1) ! Right boundary condition - bcFunc = this%boundaryconditions%GetNodeForBCID(this%mesh%bcid(1)) - x = this%geometry%x%boundary(2,nelem) + bc => this%boundaryconditions%GetBCForID(this%mesh%bcid(1)) + x(1) = this%geometry%x%boundary(2,nelem,1) s = this%solution%boundary(2,nelem,1:this%nvar) - dsdx = this%solutionGradient%boundary(2,nelem,1:this%nvar) + dsdx(1:this%nvar,1) = this%solutionGradient%boundary(2,nelem,1:this%nvar) t = this%t nhat = 1.0_prec - exts = bc%bcFunc(s,dsdx,x,t,nhat) + exts = bc%bcgFunction(s,dsdx,x,t,nhat,this%nvar,1) this%solutiongradient%extBoundary(2,nelem,1:this%nvar) = exts(1:this%nvar,1) endsubroutine setgradientboundarycondition_DGModel1D_t From 4416e17bdef6dacc912eeeb6c9e954473438cd15 Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Sun, 31 Aug 2025 11:03:36 -0400 Subject: [PATCH 16/17] Split models out of this repository For testing, some models will be hard-defined in modules within the tests. Models willl be moved into their own separate repositories. Testing will need to be updated to pull those models and run their tests --- src/SELF_Burgers1D_t.f90 | 96 --- src/SELF_GFDLES3D_t.f90 | 610 ------------------ src/SELF_LinearEuler2D_t.f90 | 238 ------- src/SELF_LinearEuler3D_t.f90 | 269 -------- src/SELF_LinearShallowWater2D_t.f90 | 265 -------- src/SELF_advection_diffusion_1d_t.f90 | 94 --- src/SELF_advection_diffusion_2d_t.f90 | 99 --- src/SELF_advection_diffusion_3d_t.f90 | 103 --- src/cpu/SELF_Burgers1D.f90 | 36 -- src/cpu/SELF_GFDLES3D.f90 | 36 -- src/cpu/SELF_LinearEuler2D.f90 | 36 -- src/cpu/SELF_LinearEuler3D.f90 | 36 -- src/cpu/SELF_LinearShallowWater2D.f90 | 36 -- src/cpu/SELF_advection_diffusion_1d.f90 | 36 -- src/cpu/SELF_advection_diffusion_2d.f90 | 36 -- src/cpu/SELF_advection_diffusion_3d.f90 | 36 -- src/gpu/SELF_Burgers1D.f90 | 36 -- src/gpu/SELF_GFDLES3D.f90 | 151 ----- src/gpu/SELF_LinearEuler2D.cpp | 161 ----- src/gpu/SELF_LinearEuler2D.f90 | 161 ----- src/gpu/SELF_LinearEuler3D.cpp | 176 ----- src/gpu/SELF_LinearEuler3D.f90 | 151 ----- src/gpu/SELF_LinearShallowWater2D.cpp | 168 ----- src/gpu/SELF_LinearShallowWater2D.f90 | 176 ----- src/gpu/SELF_advection_diffusion_1d.cpp | 70 -- src/gpu/SELF_advection_diffusion_1d.f90 | 128 ---- src/gpu/SELF_advection_diffusion_2d.cpp | 128 ---- src/gpu/SELF_advection_diffusion_2d.f90 | 134 ---- src/gpu/SELF_advection_diffusion_3d.cpp | 134 ---- src/gpu/SELF_advection_diffusion_3d.f90 | 135 ---- test/advection_diffusion_1d_euler.f90 | 114 ---- test/advection_diffusion_1d_euler_pickup.f90 | 111 ---- test/advection_diffusion_1d_rk2.f90 | 108 ---- test/advection_diffusion_1d_rk3.f90 | 110 ---- test/advection_diffusion_1d_rk4.f90 | 107 --- test/advection_diffusion_2d_euler.f90 | 115 ---- test/advection_diffusion_2d_rk2.f90 | 106 --- test/advection_diffusion_2d_rk3.f90 | 107 --- test/advection_diffusion_2d_rk3_mpi.f90 | 107 --- test/advection_diffusion_2d_rk3_pickup.f90 | 105 --- .../advection_diffusion_2d_rk3_pickup_mpi.f90 | 105 --- test/advection_diffusion_2d_rk4.f90 | 106 --- test/advection_diffusion_3d_euler.f90 | 99 --- test/advection_diffusion_3d_rk2.f90 | 99 --- test/advection_diffusion_3d_rk3.f90 | 111 ---- test/advection_diffusion_3d_rk3_mpi.f90 | 111 ---- test/advection_diffusion_3d_rk3_pickup.f90 | 109 ---- .../advection_diffusion_3d_rk3_pickup_mpi.f90 | 109 ---- test/advection_diffusion_3d_rk4.f90 | 99 --- test/burgers1d_constant.f90 | 109 ---- test/burgers1d_prescribed.f90 | 155 ----- test/linear_shallow_water_2d_constant.f90 | 118 ---- test/linear_shallow_water_2d_nonormalflow.f90 | 105 --- test/linear_shallow_water_2d_radiation.f90 | 105 --- 54 files changed, 6601 deletions(-) delete mode 100644 src/SELF_Burgers1D_t.f90 delete mode 100644 src/SELF_GFDLES3D_t.f90 delete mode 100644 src/SELF_LinearEuler2D_t.f90 delete mode 100644 src/SELF_LinearEuler3D_t.f90 delete mode 100644 src/SELF_LinearShallowWater2D_t.f90 delete mode 100644 src/SELF_advection_diffusion_1d_t.f90 delete mode 100644 src/SELF_advection_diffusion_2d_t.f90 delete mode 100644 src/SELF_advection_diffusion_3d_t.f90 delete mode 100644 src/cpu/SELF_Burgers1D.f90 delete mode 100644 src/cpu/SELF_GFDLES3D.f90 delete mode 100644 src/cpu/SELF_LinearEuler2D.f90 delete mode 100644 src/cpu/SELF_LinearEuler3D.f90 delete mode 100644 src/cpu/SELF_LinearShallowWater2D.f90 delete mode 100644 src/cpu/SELF_advection_diffusion_1d.f90 delete mode 100644 src/cpu/SELF_advection_diffusion_2d.f90 delete mode 100644 src/cpu/SELF_advection_diffusion_3d.f90 delete mode 100644 src/gpu/SELF_Burgers1D.f90 delete mode 100644 src/gpu/SELF_GFDLES3D.f90 delete mode 100644 src/gpu/SELF_LinearEuler2D.cpp delete mode 100644 src/gpu/SELF_LinearEuler2D.f90 delete mode 100644 src/gpu/SELF_LinearEuler3D.cpp delete mode 100644 src/gpu/SELF_LinearEuler3D.f90 delete mode 100644 src/gpu/SELF_LinearShallowWater2D.cpp delete mode 100644 src/gpu/SELF_LinearShallowWater2D.f90 delete mode 100644 src/gpu/SELF_advection_diffusion_1d.cpp delete mode 100644 src/gpu/SELF_advection_diffusion_1d.f90 delete mode 100644 src/gpu/SELF_advection_diffusion_2d.cpp delete mode 100644 src/gpu/SELF_advection_diffusion_2d.f90 delete mode 100644 src/gpu/SELF_advection_diffusion_3d.cpp delete mode 100644 src/gpu/SELF_advection_diffusion_3d.f90 delete mode 100644 test/advection_diffusion_1d_euler.f90 delete mode 100644 test/advection_diffusion_1d_euler_pickup.f90 delete mode 100644 test/advection_diffusion_1d_rk2.f90 delete mode 100644 test/advection_diffusion_1d_rk3.f90 delete mode 100644 test/advection_diffusion_1d_rk4.f90 delete mode 100644 test/advection_diffusion_2d_euler.f90 delete mode 100644 test/advection_diffusion_2d_rk2.f90 delete mode 100644 test/advection_diffusion_2d_rk3.f90 delete mode 100644 test/advection_diffusion_2d_rk3_mpi.f90 delete mode 100644 test/advection_diffusion_2d_rk3_pickup.f90 delete mode 100644 test/advection_diffusion_2d_rk3_pickup_mpi.f90 delete mode 100644 test/advection_diffusion_2d_rk4.f90 delete mode 100644 test/advection_diffusion_3d_euler.f90 delete mode 100644 test/advection_diffusion_3d_rk2.f90 delete mode 100644 test/advection_diffusion_3d_rk3.f90 delete mode 100644 test/advection_diffusion_3d_rk3_mpi.f90 delete mode 100644 test/advection_diffusion_3d_rk3_pickup.f90 delete mode 100644 test/advection_diffusion_3d_rk3_pickup_mpi.f90 delete mode 100644 test/advection_diffusion_3d_rk4.f90 delete mode 100644 test/burgers1d_constant.f90 delete mode 100644 test/burgers1d_prescribed.f90 delete mode 100644 test/linear_shallow_water_2d_constant.f90 delete mode 100644 test/linear_shallow_water_2d_nonormalflow.f90 delete mode 100644 test/linear_shallow_water_2d_radiation.f90 diff --git a/src/SELF_Burgers1D_t.f90 b/src/SELF_Burgers1D_t.f90 deleted file mode 100644 index 2996d548e..000000000 --- a/src/SELF_Burgers1D_t.f90 +++ /dev/null @@ -1,96 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUsLESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARIsLG IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_Burgers1D_t - - use self_model - use self_dgmodel1d - use self_mesh - - implicit none - - type,extends(dgmodel1d) :: Burgers1D_t - ! Add any additional attributes here that are specific to your model - real(prec) :: nu = 0.0_prec ! Diffusivity/viscosity - - contains - procedure :: SetMetadata => SetMetadata_Burgers1D_t - procedure :: entropy_func => entropy_func_Burgers1D_t - procedure :: flux1d => flux1d_Burgers1D_t - procedure :: riemannflux1d => riemannflux1d_Burgers1D_t - - endtype Burgers1D_t - -contains - subroutine SetMetadata_Burgers1D_t(this) - implicit none - class(Burgers1D_t),intent(inout) :: this - - call this%solution%SetName(1,"s") - call this%solution%SetUnits(1,"[null]") - - endsubroutine SetMetadata_Burgers1D_t - - pure function entropy_func_Burgers1D_t(this,s) result(e) - class(Burgers1D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%solution%nvar) - real(prec) :: e - - e = 0.5_prec*s(1)*s(1) - - endfunction entropy_func_Burgers1D_t - - pure function flux1d_Burgers1D_t(this,s,dsdx) result(flux) - class(Burgers1D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%solution%nvar) - real(prec),intent(in) :: dsdx(1:this%solution%nvar) - real(prec) :: flux(1:this%solution%nvar) - - flux(1) = 0.5_prec*s(1)*s(1)-this%nu*dsdx(1) - - endfunction flux1d_Burgers1D_t - - pure function riemannflux1d_Burgers1D_t(this,sL,sR,dsdx,nhat) result(flux) - class(Burgers1D_t),intent(in) :: this - real(prec),intent(in) :: sL(1:this%solution%nvar) - real(prec),intent(in) :: sR(1:this%solution%nvar) - real(prec),intent(in) :: dsdx(1:this%solution%nvar) - real(prec),intent(in) :: nhat - real(prec) :: flux(1:this%solution%nvar) - ! Local - real(prec) :: fL,fR,cmax - - ! Local Lax-Friedrich's flux - fL = 0.5_prec*sL(1)*sL(1)*nhat - fR = 0.5_prec*sR(1)*sR(1)*nhat - cmax = max(abs(sL(1)*nhat),abs(sR(1)*nhat)) ! maximum wave speed - - flux(1) = 0.5_prec*(fL+fR)+cmax*(sL(1)-sR(1)) & ! advective flux - -this%nu*dsdx(1)*nhat - - endfunction riemannflux1d_Burgers1D_t - -endmodule self_Burgers1D_t diff --git a/src/SELF_GFDLES3D_t.f90 b/src/SELF_GFDLES3D_t.f90 deleted file mode 100644 index 6f96a9be7..000000000 --- a/src/SELF_GFDLES3D_t.f90 +++ /dev/null @@ -1,610 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUsLESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARIsLG IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_GFDLES3D_t -!! This module defines a class that can be used to solve the filtered -!! compressible navier-stokes equations in 3-D -!! -!! The conserved variables are -!! -!! \begin{equation} -!! \vec{s} = \begin{pmatrix} -!! \rho \\ -!! \rho u \\ -!! \rho v \\ -!! \rho w \\ -!! \rho \theta -!! \end{pmatrix} -!! \end{equation} -!! -!! The conservative flux is -!! -!! \begin{equation} -!! \overleftrightarrow{f} = \begin{pmatrix} -!! \rho u \hat{x} + \rho v \hat{y} + \rho w \hat{z} \\ -!! \vec{u} \rho u + \frac{p}{\rho_0} \hat{x} \\ -!! \vec{u} \rho v + \frac{p}{\rho_0} \hat{y} \\ -!! \vec{u} \rho w + \frac{p}{\rho_0} \hat{z} \\ -!! \vec{u} \rho \theta -!! \end{pmatrix} -!! \end{equation} -!! -!! and the source terms include the graviational acceleration, where -!! gravity is assumed a constant acting in the z-direction -!! -!! \begin{equation} -!! \overleftrightarrow{f} = \begin{pmatrix} -!! 0 \\ -!! 0 \\ -!! 0 \\ -!! -\rho g \\ -!! 0 -!! \end{pmatrix} -!! \end{equation} -!! -!! ...Subgrid-scale closure... -!! - use self_model - use self_dgmodel3D - use self_mesh - - implicit none - - type,extends(dgmodel3D) :: GFDLES3D_t - type(MappedScalar3D) :: primitive - type(MappedScalar3D) :: diagnostics - integer :: ndiagnostics - - ! Model parameters - real(prec) :: p0 = 10.0_prec**(5) ! Reference pressure for potential temperature () - real(prec) :: Cp = 1.005_prec*10.0_prec**(3) ! Specific heat at constant pressure (J/kg-K) - real(prec) :: Cv = 0.718_prec*10.0_prec**(3) ! Specific heat at constant volume (J/kg-K) - real(prec) :: R = 287.04_prec ! Gas constant (Cp - Cv) - real(prec) :: gamma = 1.399721448_prec ! Ratio of specific heats (Cp/Cv) - real(prec) :: nu = 0.0_prec ! Dynamic viscosity - real(prec) :: kappa = 0.0_prec ! Thermal diffusivity - real(prec) :: g = 9.81_prec ! gravitational acceleration (z-direction only) - - logical :: sgs_enabled = .false. - contains - - ! Setup / Book-keeping methods - procedure :: AdditionalInit => AdditionalInit_GFDLES3D_t - procedure :: AdditionalFree => AdditionalFree_GFDLES3D_t - procedure :: SetMetadata => SetMetadata_GFDLES3D_t - procedure :: SetNumberOfVariables => SetNumberOfVariables_GFDLES3D_t - - ! File IO methods - !procedure :: AdditionalOutput => AdditionalOutput_GFDLES3D_t - - ! Pre-tendency methods - procedure :: CalculateDiagnostics => CalculateDiagnostics_GFDLES3D_t - procedure :: ConservativeToPrimitive => ConservativeToPrimitive_GFDLES3D_t - procedure :: SetPrimitiveBoundaryCondition => setprimitiveboundarycondition_GFDLES3D_t - procedure :: PreTendency => PreTendency_GFDLES3D_t - - ! Model method overrides - !procedure :: hbc2d_NoNormalFlow => hbc2d_NoNormalFlow_GFDLES3D_t - !procedure :: pbc2d_NoNormalFlow => pbc2d_NoNormalFlow_GFDLES3D_t - - !procedure :: SourceMethod => sourcemethod_GFDLES3D_t - procedure :: entropy_func => entropy_func_GFDLES3D_t - procedure :: flux3D => flux3D_GFDLES3D_t - procedure :: riemannflux3D => riemannflux3D_GFDLES3D_t - - ! Additional support methods - procedure :: ReportUserMetrics => ReportUserMetrics_GFDLES3D_t - procedure :: PrimitiveToConservative => PrimitiveToConservative_GFDLES3D_t - procedure,private :: pressure - !procedure,private :: temperature - procedure,private :: speedofsound - - ! Example Initial Conditions - !procedure :: SphericalSoundWave => SphericalSoundWave_GFDLES3D_t - - endtype GFDLES3D_t - -contains - - subroutine AdditionalInit_GFDLES3D_t(this) - implicit none - class(GFDLES3D_t),intent(inout) :: this - - call this%primitive%Init(this%geometry%x%interp,this%nvar,this%mesh%nElem) - call this%primitive%AssociateGeometry(this%geometry) - call this%diagnostics%Init(this%geometry%x%interp,this%ndiagnostics,this%mesh%nElem) - - endsubroutine AdditionalInit_GFDLES3D_t - - subroutine AdditionalFree_GFDLES3D_t(this) - implicit none - class(GFDLES3D_t),intent(inout) :: this - - call this%primitive%Free() - !call this%primitiveGradient%Free() - call this%diagnostics%Free() - - endsubroutine AdditionalFree_GFDLES3D_t - - subroutine SetNumberOfVariables_GFDLES3D_t(this) - implicit none - class(GFDLES3D_t),intent(inout) :: this - - this%nvar = 5 - this%ndiagnostics = 4 - - endsubroutine SetNumberOfVariables_GFDLES3D_t - - subroutine SetMetadata_GFDLES3D_t(this) - implicit none - class(GFDLES3D_t),intent(inout) :: this - - call this%solution%SetName(1,"ρ") ! Density - call this%solution%SetDescription(1,"Density") ! Density - call this%solution%SetUnits(1,"kg⋅m⁻³") - - call this%solution%SetName(2,"ρu") ! x-momentum - call this%solution%SetDescription(2,"x-momentum") - call this%solution%SetUnits(2,"(kg⋅m⁻³)(m⋅s⁻¹)") - - call this%solution%SetName(3,"ρv") ! y-momentum - call this%solution%SetDescription(3,"y-momentum") - call this%solution%SetUnits(3,"(kg⋅m⁻³)(m⋅s⁻¹)") - - call this%solution%SetName(4,"ρw") ! z-momentum - call this%solution%SetDescription(4,"z-momentum") - call this%solution%SetUnits(4,"(kg⋅m⁻³)(m⋅s⁻¹)") - - call this%solution%SetName(5,"ρθ") ! Density weighted potential temperature - call this%solution%SetDescription(5,"Density weighted potential temperature") - call this%solution%SetUnits(5,"(kg⋅m⁻³)(m²⋅s⁻²)") - - call this%primitive%SetName(1,"ρ") ! Density - call this%primitive%SetDescription(1,"Density") ! Density - call this%primitive%SetUnits(1,"kg⋅m⁻³") - - call this%primitive%SetName(2,"u") ! x-velocity - call this%primitive%SetDescription(2,"x-velocity") - call this%primitive%SetUnits(2,"(m⋅s⁻¹)") - - call this%primitive%SetName(3,"v") ! y-momentum - call this%primitive%SetDescription(3,"y-velocity") - call this%primitive%SetUnits(3,"(m⋅s⁻¹)") - - call this%primitive%SetName(4,"w") ! z-momentum - call this%primitive%SetDescription(4,"z-velocity") - call this%primitive%SetUnits(4,"(m⋅s⁻¹)") - - call this%primitive%SetName(5,"θ") ! in-situ temperature - call this%primitive%SetDescription(5,"Potential temperature") - call this%primitive%SetUnits(5,"K") - - call this%diagnostics%SetName(1,"c") ! Speed of sound - call this%diagnostics%SetDescription(1,"Speed of sound") - call this%diagnostics%SetUnits(1,"m⋅s⁻¹") - - call this%diagnostics%SetName(2,"P") ! Pressure - call this%diagnostics%SetDescription(2,"Pressure") - call this%diagnostics%SetUnits(2,"kg⋅m⁻¹⋅s⁻²") - - call this%diagnostics%SetName(3,"ρK") ! kinetic energy - call this%diagnostics%SetDescription(3,"Kinetic energy") - call this%diagnostics%SetUnits(3,"(kg⋅m⁻³)(m²⋅s⁻²)") - - call this%diagnostics%SetName(4,"CFL-J") ! kinetic energy - call this%diagnostics%SetDescription(4,"CFL number using the |u|*dt/\sqrt{J}") - call this%diagnostics%SetUnits(4,"-") - - endsubroutine SetMetadata_GFDLES3D_t - - subroutine ReportUserMetrics_GFDLES3D_t(this) - !! Base method for reporting the entropy of a model - !! to stdout. Only override this procedure if additional - !! reporting is needed. Alternatively, if you think - !! additional reporting would be valuable for all models, - !! open a pull request with modifications to this base - !! method. - implicit none - class(GFDLES3D_t),intent(inout) :: this - ! Local - character(len=20) :: modelTime - character(len=20) :: minv,maxv - character(len=:),allocatable :: str - integer :: ivar - - call this%ConservativeToPrimitive() - call this%CalculateDiagnostics() - - ! Copy the time and entropy to a string - write(modelTime,"(ES16.7E3)") this%t - - do ivar = 1,this%nvar - write(maxv,"(ES16.7E3)") maxval(this%primitive%interior(:,:,:,:,ivar)) - write(minv,"(ES16.7E3)") minval(this%primitive%interior(:,:,:,:,ivar)) - - ! Write the output to STDOUT - open(output_unit,ENCODING='utf-8') - write(output_unit,'(1x, A," : ")',ADVANCE='no') __FILE__ - str = 'tᵢ ='//trim(modelTime) - write(output_unit,'(A)',ADVANCE='no') str - str = ' | min('//trim(this%primitive%meta(ivar)%name)//'), max('//trim(this%primitive%meta(ivar)%name)//') = '//minv//" , "//maxv - write(output_unit,'(A)',ADVANCE='yes') str - enddo - - do ivar = 1,this%ndiagnostics - write(maxv,"(ES16.7E3)") maxval(this%diagnostics%interior(:,:,:,:,ivar)) - write(minv,"(ES16.7E3)") minval(this%diagnostics%interior(:,:,:,:,ivar)) - - ! Write the output to STDOUT - open(output_unit,ENCODING='utf-8') - write(output_unit,'(1x,A," : ")',ADVANCE='no') __FILE__ - str = 'tᵢ ='//trim(modelTime) - write(output_unit,'(A)',ADVANCE='no') str - str = ' | min('//trim(this%diagnostics%meta(ivar)%name)//'), max('//trim(this%diagnostics%meta(ivar)%name)//') = '//minv//" , "//maxv - write(output_unit,'(A)',ADVANCE='yes') str - enddo - - endsubroutine ReportUserMetrics_GFDLES3D_t - - subroutine setprimitiveboundarycondition_GFDLES3D_t(this) - !! Boundary conditions for the solution are set to - !! 0 for the external state to provide radiation type - !! boundary conditions. - implicit none - class(GFDLES3D_t),intent(inout) :: this - ! local - integer :: i,j,k,iEl,e2,bcid - real(prec) :: nhat(1:3) - - do concurrent(k=1:6,iel=1:this%mesh%nElem) - - bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - ! To do : need to set different prescribed function for the primitive variables - do j = 1,this%solution%interp%N+1 ! Loop over quadrature points - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - - this%primitive%extBoundary(i,j,k,iEl,1:this%nvar) = & - this%hbc3d_Prescribed(this%primitive%boundary(i,j,k,iEl,1:this%nvar),this%t) - enddo - enddo - - elseif(bcid == SELF_BC_RADIATION) then - ! To do : need to set different prescribed function for the primitive variables - do j = 1,this%solution%interp%N+1 ! Loop over quadrature points - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - - this%primitive%extBoundary(i,j,k,iEl,1:this%nvar) = & - this%hbc3d_Radiation(this%primitive%boundary(i,j,k,iEl,1:this%nvar),nhat) - enddo - enddo - - elseif(bcid == SELF_BC_NONORMALFLOW) then - do j = 1,this%solution%interp%N+1 ! Loop over quadrature points - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - - this%primitive%extBoundary(i,j,k,iEl,1:this%nvar) = & - this%hbc3d_NoNormalFlow(this%primitive%boundary(i,j,k,iEl,1:this%nvar),nhat) - enddo - enddo - - endif - endif - - enddo - - endsubroutine setprimitiveboundarycondition_GFDLES3D_t - subroutine PreTendency_GFDLES3D_t(this) - implicit none - class(GFDLES3D_t),intent(inout) :: this - - if(this%sgs_enabled) then - call this%ConservativeToPrimitive() - call this%primitive%BoundaryInterp() - call this%primitive%SideExchange(this%mesh) - - call this%SetPrimitiveBoundaryCondition() - - call this%primitive%AverageSides() - - ! Compute the gradient of the primitive variables - ! and store the result in the solutionGradient property. - call this%primitive%MappedDGGradient(this%solutionGradient%interior) - call this%solutionGradient%BoundaryInterp() - call this%solutionGradient%SideExchange(this%mesh) - call this%SetGradientBoundaryCondition() - call this%solutionGradient%AverageSides() - endif - - endsubroutine PreTendency_GFDLES3D_t - - subroutine CalculateDiagnostics_GFDLES3D_t(this) - implicit none - class(GFDLES3D_t),intent(inout) :: this - ! Local - integer :: i,j,k,iEl - real(prec) :: c,e,ke - real(prec) :: s(1:this%nvar) - - do concurrent(i=1:this%diagnostics%N+1,j=1:this%diagnostics%N+1, & - k=1:this%diagnostics%N+1,iel=1:this%mesh%nElem) - s(1:this%nvar) = this%solution%interior(i,j,k,iEl,1:this%nvar) - c = this%speedofsound(s) - ke = 0.5_prec*(s(2)**2+s(3)**2+s(4)**2)/s(1) ! kinetic energy (kg⋅m²⋅s⁻²) - this%diagnostics%interior(i,j,k,iEl,1) = c ! Speed of sound - this%diagnostics%interior(i,j,k,iEl,2) = this%pressure(s) ! Pressure (total) - this%diagnostics%interior(i,j,k,iEl,3) = ke ! kinetic energy - this%diagnostics%interior(i,j,k,iEl,4) = (sqrt(ke)+c)*this%dt/sqrt(this%geometry%J%interior(i,j,k,iEl,1)) ! CFL number - enddo - - endsubroutine CalculateDiagnostics_GFDLES3D_t - - subroutine ConservativeToPrimitive_GFDLES3D_t(this) - implicit none - class(GFDLES3D_t),intent(inout) :: this - ! Local - integer :: i,j,k,iEl - real(prec) :: s(1:this%nvar) - - do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & - k=1:this%diagnostics%N+1,iel=1:this%mesh%nElem) - s(1:this%nvar) = this%solution%interior(i,j,k,iEl,1:this%nvar) - this%primitive%interior(i,j,k,iEl,1) = s(1) ! density - this%primitive%interior(i,j,k,iEl,2) = s(2)/s(1) ! x-velocity - this%primitive%interior(i,j,k,iEl,3) = s(3)/s(1) ! y-velocity - this%primitive%interior(i,j,k,iEl,4) = s(4)/s(1) ! z-velocity - this%primitive%interior(i,j,k,iEl,5) = s(5)/s(1) ! Potential temperature - enddo - - endsubroutine ConservativeToPrimitive_GFDLES3D_t - - subroutine PrimitiveToConservative_GFDLES3D_t(this) - implicit none - class(GFDLES3D_t),intent(inout) :: this - ! Local - integer :: i,j,k,iEl - real(prec) :: s(1:this%nvar) - - do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & - k=1:this%diagnostics%N+1,iel=1:this%mesh%nElem) - s(1:this%nvar) = this%primitive%interior(i,j,k,iEl,1:this%nvar) - this%solution%interior(i,j,k,iEl,1) = s(1) ! density - this%solution%interior(i,j,k,iEl,2) = s(2)*s(1) ! x-momentum - this%solution%interior(i,j,k,iEl,3) = s(3)*s(1) ! y-momentum - this%solution%interior(i,j,k,iEl,4) = s(4)*s(1) ! z-momentum - this%solution%interior(i,j,k,iEl,5) = s(5)*s(1) ! Density weighted Potential temperature - enddo - - endsubroutine PrimitiveToConservative_GFDLES3D_t - - pure function entropy_func_GFDLES3D_t(this,s) result(e) - !! The entropy function is the sum of kinetic and internal energy - !! For the linear model, this is - !! - !! \begin{equation} - !! e = \frac{1}{2} \left( \rho_0*( u^2 + v^2 ) + \frac{P^2}{\rho_0 c^2} \right) - class(GFDLES3D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec) :: e - ! Local - real(prec) :: ke,ie,pe - - ke = 0.5_prec*(s(2)*s(2)+s(3)*(3)+s(4)*s(4))/s(1) ! kinetic energy - !pe = s(1)*this%g*z Potential energy - ie = this%Cv*s(5)*(this%pressure(s)/this%p0)**(this%R/this%Cp) ! internal energy = rho*Cv*T - - e = ke+ie - endfunction entropy_func_GFDLES3D_t - - ! pure function hbc3D_NoNormalFlow_GFDLES3D_t(this,s,nhat) result(exts) - ! class(GFDLES3D_t),intent(in) :: this - ! real(prec),intent(in) :: s(1:this%nvar) - ! real(prec),intent(in) :: nhat(1:2) - ! real(prec) :: exts(1:this%nvar) - ! ! Local - ! integer :: ivar - - ! exts(1) = s(1) ! density - ! exts(2) = (nhat(2)**2-nhat(1)**2)*s(2)-2.0_prec*nhat(1)*nhat(2)*s(3) ! u - ! exts(3) = (nhat(1)**2-nhat(2)**2)*s(3)-2.0_prec*nhat(1)*nhat(2)*s(2) ! v - ! exts(4) = (nhat(1)**2-nhat(2)**2)*s(3)-2.0_prec*nhat(1)*nhat(2)*s(2) ! w - ! exts(5) = s(4) ! p - - ! endfunction hbc3D_NoNormalFlow_GFDLES3D_t - - pure function pressure(this,s) result(p) - class(GFDLES3D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec) :: p - - p = (this%R*s(5)*(this%p0)**(-this%R/this%Cp))**(this%gamma) - - endfunction pressure - - ! pure function temperature(this, s) result(t) - ! class(GFDLES3D_t), intent(in) :: this - ! real(prec), intent(in) :: s(1:this%nvar) - ! real(prec) :: t - - ! t = (s(4) - 0.5_prec*(s(2)**2 + s(3)**2)/s(1))/(s(1)*this%Cv) ! temperature = e/Cv - - ! end function temperature - - pure function speedofsound(this,s) result(c) - class(GFDLES3D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec) :: c - - c = sqrt(this%gamma*this%pressure(s)/s(1)) - - endfunction speedofsound - - pure function flux3d_GFDLES3D_t(this,s,dsdx) result(flux) - class(GFDLES3D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec),intent(in) :: dsdx(1:this%nvar,1:3) - real(prec) :: flux(1:this%nvar,1:3) - ! Local - real(prec) :: p,nu,kappa,u,v,w - real(prec) :: tau_11,tau_12,tau_13 - real(prec) :: tau_22,tau_23 - real(prec) :: tau_33 - - ! Computes the pressure for an ideal gas - p = this%pressure(s) - u = s(2)/s(1) - v = s(3)/s(1) - w = s(4)/s(1) - ! LEFT OFF HERE !! - flux(1,1) = s(2) ! density, x flux ; rho*u - flux(1,2) = s(3) ! density, y flux ; rho*v - flux(1,3) = s(3) ! density, z flux ; rho*w - - flux(2,1) = s(2)*u+p ! x-momentum, x flux; \rho*u*u + p - flux(2,2) = s(2)*v ! x-momentum, y flux; \rho*u*v - flux(3,1) = s(2)*u ! y-momentum, x flux; \rho*v*u - flux(3,2) = s(3)*v+p ! y-momentum, y flux; \rho*v*v + p - flux(4,1) = (s(4)+p)*s(2)/s(1) ! total energy, x flux : (\rho*E + p)*u - flux(4,2) = (s(4)+p)*s(3)/s(1) ! total energy, y flux : (\rho*E + p)*v - - if(this%sgs_enabled) then - ! Viscous and difussive terms - ! Recall that the solutionGradient now contains - ! the primitive variable gradients - ! Calculate the stress tensor - nu = this%nu - kappa = this%kappa - tau_11 = 4.0_prec*dsdx(2,1)/3.0_prec-2.0_prec*dsdx(3,2)/3.0_prec - tau_12 = dsdx(2,2)+dsdx(3,1) - !tau_21 = tau_12 - tau_22 = 4.0_prec*dsdx(3,2)/3.0_prec-2.0_prec*dsdx(2,1)/3.0_prec - - flux(2,1) = flux(2,1)-nu*tau_11 ! x-momentum, x flux - flux(2,2) = flux(2,2)-nu*tau_12 ! x-momentum, y flux (-tau_21*nu = -tau_12*nu) - flux(3,1) = flux(3,1)-nu*tau_12 ! y-momentum, x flux - flux(3,2) = flux(3,2)-nu*tau_22 ! y-momentum, y flux - flux(4,1) = flux(4,1)-(kappa*dsdx(4,1)+u*tau_11+v*tau_12) ! total energy, x flux = -(kappa*dTdx + u*tau_11 + v*tau_12) - flux(4,2) = flux(4,2)-(kappa*dsdx(4,2)+u*tau_11+v*tau_12) ! total energy, y flux = -(kappa*dTdy + u*tau_12 + v*tau_22) - endif - - endfunction flux3d_GFDLES3D_t - - pure function riemannflux3D_GFDLES3D_t(this,sL,sR,dsdx,nhat) result(flux) - !! Uses a local lax-friedrich's upwind flux - !! The max eigenvalue is taken as the sound speed - class(GFDLES3D_t),intent(in) :: this - real(prec),intent(in) :: sL(1:this%nvar) - real(prec),intent(in) :: sR(1:this%nvar) - real(prec),intent(in) :: dsdx(1:this%nvar,1:3) - real(prec),intent(in) :: nhat(1:3) - real(prec) :: flux(1:this%nvar) - ! Local - real(prec) :: fL(1:this%nvar) - real(prec) :: fR(1:this%nvar) - real(prec) :: u,v,w,p,c,rho0 - - u = sL(2) - v = sL(3) - w = sL(4) - p = sL(5) - rho0 = 1.0 !this%rho0 - c = 1.0 !this%c - fL(1) = rho0*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! density - fL(2) = p*nhat(1)/rho0 ! u - fL(3) = p*nhat(2)/rho0 ! v - fL(4) = p*nhat(3)/rho0 ! w - fL(5) = rho0*c*c*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! pressure - - u = sR(2) - v = sR(3) - w = sR(4) - p = sR(5) - fR(1) = rho0*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! density - fR(2) = p*nhat(1)/rho0 ! u - fR(3) = p*nhat(2)/rho0 ! v' - fR(4) = p*nhat(3)/rho0 ! w - fR(5) = rho0*c*c*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! pressure - - flux(1:5) = 0.5_prec*(fL(1:5)+fR(1:5))+c*(sL(1:5)-sR(1:5)) - - endfunction riemannflux3D_GFDLES3D_t - - ! subroutine SphericalSoundWave_GFDLES3D_t(this,rhoprime,Lr,x0,y0,z0) - ! !! This subroutine sets the initial condition for a weak blast wave - ! !! problem. The initial condition is given by - ! !! - ! !! \begin{equation} - ! !! \begin{aligned} - ! !! \rho &= \rho_0 + \rho' \exp\left( -\ln(2) \frac{(x-x_0)^2 + (y-y_0)^2}{L_r^2} \right) - ! !! u &= 0 \\ - ! !! v &= 0 \\ - ! !! E &= \frac{P_0}{\gamma - 1} + E \exp\left( -\ln(2) \frac{(x-x_0)^2 + (y-y_0)^2}{L_e^2} \right) - ! !! \end{aligned} - ! !! \end{equation} - ! !! - ! implicit none - ! class(GFDLES3D_t),intent(inout) :: this - ! real(prec),intent(in) :: rhoprime,Lr,x0,y0,z0 - ! ! Local - ! integer :: i,j,k,iEl - ! real(prec) :: x,y,z,rho,r,E - - ! print*,__FILE__," : Configuring weak blast wave initial condition. " - ! print*,__FILE__," : rhoprime = ",rhoprime - ! print*,__FILE__," : Lr = ",Lr - ! print*,__FILE__," : x0 = ",x0 - ! print*,__FILE__," : y0 = ",y0 - ! print*,__FILE__," : z0 = ",z0 - - ! do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & - ! k=1:this%solution%N+1,iel=1:this%mesh%nElem) - ! x = this%geometry%x%interior(i,j,k,iEl,1,1)-x0 - ! y = this%geometry%x%interior(i,j,k,iEl,1,2)-y0 - ! z = this%geometry%x%interior(i,j,k,iEl,1,3)-z0 - ! r = sqrt(x**2+y**2+z**2) - - ! rho = (rhoprime)*exp(-log(2.0_prec)*r**2/Lr**2) - - ! this%solution%interior(i,j,k,iEl,1) = rho - ! this%solution%interior(i,j,k,iEl,2) = 0.0_prec - ! this%solution%interior(i,j,k,iEl,3) = 0.0_prec - ! this%solution%interior(i,j,k,iEl,4) = 0.0_prec - ! this%solution%interior(i,j,k,iEl,5) = rho*this%c*this%c - - ! enddo - - ! call this%ReportMetrics() - ! call this%solution%UpdateDevice() - - ! endsubroutine SphericalSoundWave_GFDLES3D_t - -endmodule self_GFDLES3D_t diff --git a/src/SELF_LinearEuler2D_t.f90 b/src/SELF_LinearEuler2D_t.f90 deleted file mode 100644 index b716f30e9..000000000 --- a/src/SELF_LinearEuler2D_t.f90 +++ /dev/null @@ -1,238 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUsLESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARIsLG IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_LinearEuler2D_t -!! This module defines a class that can be used to solve the Linear Euler -!! equations in 2-D. The Linear Euler Equations, here, are the Euler equations -!! linearized about a motionless background state. -!! -!! The conserved variables are - -!! \begin{equation} -!! \vec{s} = \begin{pmatrix} -!! \rho \\ -!! u \\ -!! v \\ -!! p -!! \end{pmatrix} -!! \end{equation} -!! -!! The conservative flux is -!! -!! \begin{equation} -!! \overleftrightarrow{f} = \begin{pmatrix} -!! \rho_0 u \hat{x} + \rho_0 v \hat{y} \\ -!! \frac{p}{\rho_0} \hat{x} \\ -!! \frac{p}{\rho_0} \hat{y} \\ -!! c^2 \rho_0 ( u \hat{x} + v \hat{y} ) -!! \end{pmatrix} -!! \end{equation} -!! -!! and the source terms are null. -!! - - use self_model - use self_dgmodel2d - use self_mesh - - implicit none - - type,extends(dgmodel2d) :: LinearEuler2D_t - ! Add any additional attributes here that are specific to your model - real(prec) :: rho0 = 1.0_prec ! Reference density - real(prec) :: c = 1.0_prec ! Sound speed - real(prec) :: g = 0.0_prec ! gravitational acceleration (y-direction only) - - contains - procedure :: SetNumberOfVariables => SetNumberOfVariables_LinearEuler2D_t - procedure :: SetMetadata => SetMetadata_LinearEuler2D_t - procedure :: entropy_func => entropy_func_LinearEuler2D_t - procedure :: hbc2d_NoNormalFlow => hbc2d_NoNormalFlow_LinearEuler2D_t - procedure :: flux2d => flux2d_LinearEuler2D_t - procedure :: riemannflux2d => riemannflux2d_LinearEuler2D_t - !procedure :: source2d => source2d_LinearEuler2D_t - procedure :: SphericalSoundWave => SphericalSoundWave_LinearEuler2D_t - - endtype LinearEuler2D_t - -contains - - subroutine SetNumberOfVariables_LinearEuler2D_t(this) - implicit none - class(LinearEuler2D_t),intent(inout) :: this - - this%nvar = 4 - - endsubroutine SetNumberOfVariables_LinearEuler2D_t - - subroutine SetMetadata_LinearEuler2D_t(this) - implicit none - class(LinearEuler2D_t),intent(inout) :: this - - call this%solution%SetName(1,"rho") ! Density - call this%solution%SetUnits(1,"kg⋅m⁻³") - - call this%solution%SetName(2,"u") ! x-velocity component - call this%solution%SetUnits(2,"m⋅s⁻¹") - - call this%solution%SetName(3,"v") ! y-velocity component - call this%solution%SetUnits(3,"m⋅s⁻¹") - - call this%solution%SetName(4,"P") ! Pressure - call this%solution%SetUnits(4,"kg⋅m⁻¹⋅s⁻²") - - endsubroutine SetMetadata_LinearEuler2D_t - - pure function entropy_func_LinearEuler2D_t(this,s) result(e) - !! The entropy function is the sum of kinetic and internal energy - !! For the linear model, this is - !! - !! \begin{equation} - !! e = \frac{1}{2} \left( \rho_0*( u^2 + v^2 ) + \frac{P^2}{\rho_0 c^2} \right) - class(LinearEuler2D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec) :: e - - e = 0.5_prec*this%rho0*(s(2)*s(2)+s(3)*(3))+ & - 0.5_prec*(s(4)*s(4)/(this%rho0*this%c*this%c)) - - endfunction entropy_func_LinearEuler2D_t - - pure function hbc2d_NoNormalFlow_LinearEuler2D_t(this,s,nhat) result(exts) - class(LinearEuler2D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec),intent(in) :: nhat(1:2) - real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - - exts(1) = s(1) ! density - exts(2) = (nhat(2)**2-nhat(1)**2)*s(2)-2.0_prec*nhat(1)*nhat(2)*s(3) ! u - exts(3) = (nhat(1)**2-nhat(2)**2)*s(3)-2.0_prec*nhat(1)*nhat(2)*s(2) ! v - exts(4) = s(4) ! p - - endfunction hbc2d_NoNormalFlow_LinearEuler2D_t - - pure function flux2d_LinearEuler2D_t(this,s,dsdx) result(flux) - class(LinearEuler2D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec),intent(in) :: dsdx(1:this%nvar,1:2) - real(prec) :: flux(1:this%nvar,1:2) - - flux(1,1) = this%rho0*s(2) ! density, x flux ; rho0*u - flux(1,2) = this%rho0*s(3) ! density, y flux ; rho0*v - flux(2,1) = s(4)/this%rho0 ! x-velocity, x flux; p/rho0 - flux(2,2) = 0.0_prec ! x-velocity, y flux; 0 - flux(3,1) = 0.0_prec ! y-velocity, x flux; 0 - flux(3,2) = s(4)/this%rho0 ! y-velocity, y flux; p/rho0 - flux(4,1) = this%c*this%c*this%rho0*s(2) ! pressure, x flux : rho0*c^2*u - flux(4,2) = this%c*this%c*this%rho0*s(3) ! pressure, y flux : rho0*c^2*v - - endfunction flux2d_LinearEuler2D_t - - pure function riemannflux2d_LinearEuler2D_t(this,sL,sR,dsdx,nhat) result(flux) - !! Uses a local lax-friedrich's upwind flux - !! The max eigenvalue is taken as the sound speed - class(LinearEuler2D_t),intent(in) :: this - real(prec),intent(in) :: sL(1:this%nvar) - real(prec),intent(in) :: sR(1:this%nvar) - real(prec),intent(in) :: dsdx(1:this%nvar,1:2) - real(prec),intent(in) :: nhat(1:2) - real(prec) :: flux(1:this%nvar) - ! Local - real(prec) :: fL(1:this%nvar) - real(prec) :: fR(1:this%nvar) - real(prec) :: u,v,p,c,rho0 - - u = sL(2) - v = sL(3) - p = sL(4) - rho0 = this%rho0 - c = this%c - fL(1) = rho0*(u*nhat(1)+v*nhat(2)) ! density - fL(2) = p*nhat(1)/rho0 ! u - fL(3) = p*nhat(2)/rho0 ! v - fL(4) = rho0*c*c*(u*nhat(1)+v*nhat(2)) ! pressure - - u = sR(2) - v = sR(3) - p = sR(4) - fR(1) = rho0*(u*nhat(1)+v*nhat(2)) ! density - fR(2) = p*nhat(1)/rho0 ! u - fR(3) = p*nhat(2)/rho0 ! v - fR(4) = rho0*c*c*(u*nhat(1)+v*nhat(2)) ! pressure - - flux(1:4) = 0.5_prec*(fL(1:4)+fR(1:4))+c*(sL(1:4)-sR(1:4)) - - endfunction riemannflux2d_LinearEuler2D_t - - subroutine SphericalSoundWave_LinearEuler2D_t(this,rhoprime,Lr,x0,y0) - !! This subroutine sets the initial condition for a weak blast wave - !! problem. The initial condition is given by - !! - !! \begin{equation} - !! \begin{aligned} - !! \rho &= \rho_0 + \rho' \exp\left( -\ln(2) \frac{(x-x_0)^2 + (y-y_0)^2}{L_r^2} \right) - !! u &= 0 \\ - !! v &= 0 \\ - !! E &= \frac{P_0}{\gamma - 1} + E \exp\left( -\ln(2) \frac{(x-x_0)^2 + (y-y_0)^2}{L_e^2} \right) - !! \end{aligned} - !! \end{equation} - !! - implicit none - class(LinearEuler2D_t),intent(inout) :: this - real(prec),intent(in) :: rhoprime,Lr,x0,y0 - ! Local - integer :: i,j,iEl - real(prec) :: x,y,rho,r,E - - print*,__FILE__," : Configuring weak blast wave initial condition. " - print*,__FILE__," : rhoprime = ",rhoprime - print*,__FILE__," : Lr = ",Lr - print*,__FILE__," : x0 = ",x0 - print*,__FILE__," : y0 = ",y0 - - do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & - iel=1:this%mesh%nElem) - x = this%geometry%x%interior(i,j,iEl,1,1)-x0 - y = this%geometry%x%interior(i,j,iEl,1,2)-y0 - r = sqrt(x**2+y**2) - - rho = (rhoprime)*exp(-log(2.0_prec)*r**2/Lr**2) - - this%solution%interior(i,j,iEl,1) = rho - this%solution%interior(i,j,iEl,2) = 0.0_prec - this%solution%interior(i,j,iEl,3) = 0.0_prec - this%solution%interior(i,j,iEl,4) = rho*this%c*this%c - - enddo - - call this%ReportMetrics() - call this%solution%UpdateDevice() - - endsubroutine SphericalSoundWave_LinearEuler2D_t - -endmodule self_LinearEuler2D_t diff --git a/src/SELF_LinearEuler3D_t.f90 b/src/SELF_LinearEuler3D_t.f90 deleted file mode 100644 index cf059fdfb..000000000 --- a/src/SELF_LinearEuler3D_t.f90 +++ /dev/null @@ -1,269 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUsLESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARIsLG IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_LinearEuler3D_t -!! This module defines a class that can be used to solve the Linear Euler -!! equations in 3-D. The Linear Euler Equations, here, are the Euler equations -!! linearized about a motionless background state. -!! -!! The conserved variables are - -!! \begin{equation} -!! \vec{s} = \begin{pmatrix} -!! \rho \\ -!! u \\ -!! v \\ -!! w \\ -!! p -!! \end{pmatrix} -!! \end{equation} -!! -!! The conservative flux is -!! -!! \begin{equation} -!! \overleftrightarrow{f} = \begin{pmatrix} -!! \rho_0 u \hat{x} + \rho_0 v \hat{y} + \rho_0 w \hat{z} \\ -!! \frac{p}{\rho_0} \hat{x} \\ -!! \frac{p}{\rho_0} \hat{y} \\ -!! \frac{p}{\rho_0} \hat{z} \\ -!! c^2 \rho_0 ( u \hat{x} + v \hat{y} + w \hat{z}) -!! \end{pmatrix} -!! \end{equation} -!! -!! and the source terms are null. -!! - - use self_model - use self_dgmodel3D - use self_mesh - - implicit none - - type,extends(dgmodel3D) :: LinearEuler3D_t - ! Add any additional attributes here that are specific to your model - real(prec) :: rho0 = 1.0_prec ! Reference density - real(prec) :: c = 1.0_prec ! Sound speed - real(prec) :: g = 0.0_prec ! gravitational acceleration (y-direction only) - - contains - procedure :: SourceMethod => sourcemethod_LinearEuler3D_t - procedure :: SetNumberOfVariables => SetNumberOfVariables_LinearEuler3D_t - procedure :: SetMetadata => SetMetadata_LinearEuler3D_t - procedure :: entropy_func => entropy_func_LinearEuler3D_t - !procedure :: hbc3D_NoNormalFlow => hbc3D_NoNormalFlow_LinearEuler3D_t - procedure :: flux3D => flux3D_LinearEuler3D_t - procedure :: riemannflux3D => riemannflux3D_LinearEuler3D_t - procedure :: SphericalSoundWave => SphericalSoundWave_LinearEuler3D_t - - endtype LinearEuler3D_t - -contains - - subroutine SetNumberOfVariables_LinearEuler3D_t(this) - implicit none - class(LinearEuler3D_t),intent(inout) :: this - - this%nvar = 5 - - endsubroutine SetNumberOfVariables_LinearEuler3D_t - - subroutine SetMetadata_LinearEuler3D_t(this) - implicit none - class(LinearEuler3D_t),intent(inout) :: this - - call this%solution%SetName(1,"rho") ! Density - call this%solution%SetUnits(1,"kg⋅m⁻³") - - call this%solution%SetName(2,"u") ! x-velocity component - call this%solution%SetUnits(2,"m⋅s⁻¹") - - call this%solution%SetName(3,"v") ! y-velocity component - call this%solution%SetUnits(3,"m⋅s⁻¹") - - call this%solution%SetName(4,"w") ! z-velocity component - call this%solution%SetUnits(4,"m⋅s⁻¹") - - call this%solution%SetName(5,"P") ! Pressure - call this%solution%SetUnits(5,"kg⋅m⁻¹⋅s⁻²") - - endsubroutine SetMetadata_LinearEuler3D_t - - pure function entropy_func_LinearEuler3D_t(this,s) result(e) - !! The entropy function is the sum of kinetic and internal energy - !! For the linear model, this is - !! - !! \begin{equation} - !! e = \frac{1}{2} \left( \rho_0*( u^2 + v^2 ) + \frac{P^2}{\rho_0 c^2} \right) - class(LinearEuler3D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec) :: e - - e = 0.5_prec*this%rho0*(s(2)*s(2)+s(3)*(3)+s(4)*s(4))+ & - 0.5_prec*(s(5)*s(5)/(this%rho0*this%c*this%c)) - - endfunction entropy_func_LinearEuler3D_t - - ! pure function hbc3D_NoNormalFlow_LinearEuler3D_t(this,s,nhat) result(exts) - ! class(LinearEuler3D_t),intent(in) :: this - ! real(prec),intent(in) :: s(1:this%nvar) - ! real(prec),intent(in) :: nhat(1:2) - ! real(prec) :: exts(1:this%nvar) - ! ! Local - ! integer :: ivar - - ! exts(1) = s(1) ! density - ! exts(2) = (nhat(2)**2-nhat(1)**2)*s(2)-2.0_prec*nhat(1)*nhat(2)*s(3) ! u - ! exts(3) = (nhat(1)**2-nhat(2)**2)*s(3)-2.0_prec*nhat(1)*nhat(2)*s(2) ! v - ! exts(4) = (nhat(1)**2-nhat(2)**2)*s(3)-2.0_prec*nhat(1)*nhat(2)*s(2) ! w - ! exts(5) = s(4) ! p - - ! endfunction hbc3D_NoNormalFlow_LinearEuler3D_t - subroutine sourcemethod_LinearEuler3D_t(this) - implicit none - class(LinearEuler3D_t),intent(inout) :: this - - return - - endsubroutine sourcemethod_LinearEuler3D_t - - pure function flux3D_LinearEuler3D_t(this,s,dsdx) result(flux) - class(LinearEuler3D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec),intent(in) :: dsdx(1:this%nvar,1:3) - real(prec) :: flux(1:this%nvar,1:3) - - flux(1,1) = this%rho0*s(2) ! density, x flux ; rho0*u - flux(1,2) = this%rho0*s(3) ! density, y flux ; rho0*v - flux(1,3) = this%rho0*s(4) ! density, y flux ; rho0*w - - flux(2,1) = s(5)/this%rho0 ! x-velocity, x flux; p/rho0 - flux(2,2) = 0.0_prec ! x-velocity, y flux; 0 - flux(2,3) = 0.0_prec ! x-velocity, z flux; 0 - - flux(3,1) = 0.0_prec ! y-velocity, x flux; 0 - flux(3,2) = s(5)/this%rho0 ! y-velocity, y flux; p/rho0 - flux(3,3) = 0.0_prec ! y-velocity, z flux; 0 - - flux(4,1) = 0.0_prec ! z-velocity, x flux; 0 - flux(4,2) = 0.0_prec ! z-velocity, y flux; 0 - flux(4,3) = s(5)/this%rho0 ! z-velocity, z flux; p/rho0 - - flux(5,1) = this%c*this%c*this%rho0*s(2) ! pressure, x flux : rho0*c^2*u - flux(5,2) = this%c*this%c*this%rho0*s(3) ! pressure, y flux : rho0*c^2*v - flux(5,3) = this%c*this%c*this%rho0*s(4) ! pressure, y flux : rho0*c^2*w - - endfunction flux3D_LinearEuler3D_t - - pure function riemannflux3D_LinearEuler3D_t(this,sL,sR,dsdx,nhat) result(flux) - !! Uses a local lax-friedrich's upwind flux - !! The max eigenvalue is taken as the sound speed - class(LinearEuler3D_t),intent(in) :: this - real(prec),intent(in) :: sL(1:this%nvar) - real(prec),intent(in) :: sR(1:this%nvar) - real(prec),intent(in) :: dsdx(1:this%nvar,1:3) - real(prec),intent(in) :: nhat(1:3) - real(prec) :: flux(1:this%nvar) - ! Local - real(prec) :: fL(1:this%nvar) - real(prec) :: fR(1:this%nvar) - real(prec) :: u,v,w,p,c,rho0 - - u = sL(2) - v = sL(3) - w = sL(4) - p = sL(5) - rho0 = this%rho0 - c = this%c - fL(1) = rho0*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! density - fL(2) = p*nhat(1)/rho0 ! u - fL(3) = p*nhat(2)/rho0 ! v - fL(4) = p*nhat(3)/rho0 ! w - fL(5) = rho0*c*c*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! pressure - - u = sR(2) - v = sR(3) - w = sR(4) - p = sR(5) - fR(1) = rho0*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! density - fR(2) = p*nhat(1)/rho0 ! u - fR(3) = p*nhat(2)/rho0 ! v' - fR(4) = p*nhat(3)/rho0 ! w - fR(5) = rho0*c*c*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! pressure - - flux(1:5) = 0.5_prec*(fL(1:5)+fR(1:5))+c*(sL(1:5)-sR(1:5)) - - endfunction riemannflux3D_LinearEuler3D_t - - subroutine SphericalSoundWave_LinearEuler3D_t(this,rhoprime,Lr,x0,y0,z0) - !! This subroutine sets the initial condition for a weak blast wave - !! problem. The initial condition is given by - !! - !! \begin{equation} - !! \begin{aligned} - !! \rho &= \rho_0 + \rho' \exp\left( -\ln(2) \frac{(x-x_0)^2 + (y-y_0)^2}{L_r^2} \right) - !! u &= 0 \\ - !! v &= 0 \\ - !! E &= \frac{P_0}{\gamma - 1} + E \exp\left( -\ln(2) \frac{(x-x_0)^2 + (y-y_0)^2}{L_e^2} \right) - !! \end{aligned} - !! \end{equation} - !! - implicit none - class(LinearEuler3D_t),intent(inout) :: this - real(prec),intent(in) :: rhoprime,Lr,x0,y0,z0 - ! Local - integer :: i,j,k,iEl - real(prec) :: x,y,z,rho,r,E - - print*,__FILE__," : Configuring weak blast wave initial condition. " - print*,__FILE__," : rhoprime = ",rhoprime - print*,__FILE__," : Lr = ",Lr - print*,__FILE__," : x0 = ",x0 - print*,__FILE__," : y0 = ",y0 - print*,__FILE__," : z0 = ",z0 - - do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & - k=1:this%solution%N+1,iel=1:this%mesh%nElem) - x = this%geometry%x%interior(i,j,k,iEl,1,1)-x0 - y = this%geometry%x%interior(i,j,k,iEl,1,2)-y0 - z = this%geometry%x%interior(i,j,k,iEl,1,3)-z0 - r = sqrt(x**2+y**2+z**2) - - rho = (rhoprime)*exp(-log(2.0_prec)*r**2/Lr**2) - - this%solution%interior(i,j,k,iEl,1) = rho - this%solution%interior(i,j,k,iEl,2) = 0.0_prec - this%solution%interior(i,j,k,iEl,3) = 0.0_prec - this%solution%interior(i,j,k,iEl,4) = 0.0_prec - this%solution%interior(i,j,k,iEl,5) = rho*this%c*this%c - - enddo - - call this%ReportMetrics() - call this%solution%UpdateDevice() - - endsubroutine SphericalSoundWave_LinearEuler3D_t - -endmodule self_LinearEuler3D_t diff --git a/src/SELF_LinearShallowWater2D_t.f90 b/src/SELF_LinearShallowWater2D_t.f90 deleted file mode 100644 index eb4da93e8..000000000 --- a/src/SELF_LinearShallowWater2D_t.f90 +++ /dev/null @@ -1,265 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_LinearShallowWater2D_t - use self_model - use self_dgmodel2d - use self_mesh - - implicit none - - type,extends(dgmodel2d) :: LinearShallowWater2D_t - real(prec) :: H = 0.0_prec ! uniform resting depth - real(prec) :: g = 0.0_prec ! acceleration due to gravity - real(prec) :: f0 = 0.0_prec ! reference coriolis parameter (1/s) [for conveniently setting fCori] - real(prec) :: beta = 0.0_prec ! reference coriolis parameter variation with latitude (1/ms) [for conveniently setting fCori] - real(prec) :: Cd = 0.0_prec ! Linear drag coefficient (1/s) - type(MappedScalar2D) :: fCori ! The coriolis parameter - - contains - procedure :: AdditionalInit => AdditionalInit_LinearShallowWater2D_t - procedure :: AdditionalFree => AdditionalFree_LinearShallowWater2D_t - procedure :: SetNumberOfVariables => SetNumberOfVariables_LinearShallowWater2D_t - procedure :: SetMetadata => SetMetadata_LinearShallowWater2D_t - procedure :: entropy_func => entropy_func_LinearShallowWater2D_t - procedure :: flux2d => flux2d_LinearShallowWater2D_t - procedure :: riemannflux2d => riemannflux2d_LinearShallowWater2D_t - procedure :: hbc2d_NoNormalFlow => hbc2d_NoNormalFlow_LinearShallowWater2D_t - procedure :: sourcemethod => sourcemethod_LinearShallowWater2D_t - ! Custom methods - generic,public :: SetCoriolis => SetCoriolis_fplane_LinearShallowWater2D_t, & - SetCoriolis_betaplane_LinearShallowWater2D_t - procedure,private :: SetCoriolis_fplane_LinearShallowWater2D_t - procedure,private :: SetCoriolis_betaplane_LinearShallowWater2D_t - - procedure,public :: DiagnoseGeostrophicVelocity => DiagnoseGeostrophicVelocity_LinearShallowWater2D_t - - endtype LinearShallowWater2D_t - -contains - - subroutine AdditionalInit_LinearShallowWater2D_t(this) - implicit none - class(LinearShallowWater2D_t),intent(inout) :: this - - call this%fCori%Init(this%geometry%x%interp, & - 1,this%mesh%nElem) - - endsubroutine AdditionalInit_LinearShallowWater2D_t - - subroutine AdditionalFree_LinearShallowWater2D_t(this) - implicit none - class(LinearShallowWater2D_t),intent(inout) :: this - - call this%fCori%Free() - - endsubroutine AdditionalFree_LinearShallowWater2D_t - - subroutine SetNumberOfVariables_LinearShallowWater2D_t(this) - implicit none - class(LinearShallowWater2D_t),intent(inout) :: this - - this%nvar = 3 - - endsubroutine SetNumberOfVariables_LinearShallowWater2D_t - - subroutine SetCoriolis_fplane_LinearShallowWater2D_t(this,f0) - implicit none - class(LinearShallowWater2D_t),intent(inout) :: this - real(prec),intent(in) :: f0 - ! Local - integer :: iel - integer :: i - integer :: j - - do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & - iel=1:this%mesh%nElem) - this%fCori%interior(i,j,iel,1) = f0 - enddo - call this%fCori%UpdateDevice() - - endsubroutine SetCoriolis_fplane_LinearShallowWater2D_t - - subroutine SetCoriolis_betaplane_LinearShallowWater2D_t(this,f0,beta) - implicit none - class(LinearShallowWater2D_t),intent(inout) :: this - real(prec),intent(in) :: f0 - real(prec),intent(in) :: beta - ! Local - integer :: iel - integer :: i - integer :: j - real(prec) :: y - - do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & - iel=1:this%mesh%nElem) - y = this%geometry%x%interior(i,j,iel,1,2) - this%fCori%interior(i,j,iel,1) = f0+beta*y - enddo - call this%fCori%UpdateDevice() - - endsubroutine SetCoriolis_betaplane_LinearShallowWater2D_t - - subroutine DiagnoseGeostrophicVelocity_LinearShallowWater2D_t(this) - implicit none - class(LinearShallowWater2D_t),intent(inout) :: this - ! Local - integer :: iel - integer :: i - integer :: j - real(prec) :: dpdx,dpdy,f - - ! We assume here that the velocity field is identically zero - ! everywhere and the only field that is set is the free surface height - ! with a non-zero coriolis parameter. - ! In this case, we have that the tendency calculation will give - ! the gradient in the free surface, consistent with the DG approximation - this%solution%interior(:,:,:,1) = 0.0_prec ! Set u=0 - this%solution%interior(:,:,:,2) = 0.0_prec ! Set v=0 - call this%solution%UpdateDevice() - call this%CalculateTendency() - call this%dSdt%UpdateHost() - - do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & - iel=1:this%mesh%nElem) - - dpdx = -this%dSdt%interior(i,j,iel,1) - dpdy = -this%dSdt%interior(i,j,iel,2) - f = this%fCori%interior(i,j,iel,1) - this%solution%interior(i,j,iel,1) = -dpdy/f ! u - this%solution%interior(i,j,iel,2) = dpdx/f ! v - enddo - - call this%solution%UpdateDevice() - - endsubroutine DiagnoseGeostrophicVelocity_LinearShallowWater2D_t - - subroutine SetMetadata_LinearShallowWater2D_t(this) - implicit none - class(LinearShallowWater2D_t),intent(inout) :: this - - call this%solution%SetName(1,"u") - call this%solution%SetUnits(1,"m/s") - call this%solution%SetName(2,"v") - call this%solution%SetUnits(2,"m/s") - call this%solution%SetName(3,"eta") - call this%solution%SetUnits(3,"m") - call this%fCori%SetName(1,"f") - call this%fCori%SetUnits(1,"1/s") - - endsubroutine SetMetadata_LinearShallowWater2D_t - - pure function entropy_func_LinearShallowWater2D_t(this,s) result(e) - class(LinearShallowWater2D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%solution%nvar) - real(prec) :: e - - e = 0.5_prec*(this%H*s(1)*s(1)+ & - this%H*s(2)*s(2)+ & - this%g*s(3)*s(3)) - - endfunction entropy_func_LinearShallowWater2D_t - - pure function flux2d_LinearShallowWater2D_t(this,s,dsdx) result(flux) - class(LinearShallowWater2D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%solution%nvar) - real(prec),intent(in) :: dsdx(1:this%solution%nvar,1:2) - real(prec) :: flux(1:this%solution%nvar,1:2) - - flux(1,1) = this%g*s(3) - flux(1,2) = 0.0_prec - flux(2,1) = 0.0_prec - flux(2,2) = this%g*s(3) - flux(3,1) = this%H*s(1) - flux(3,2) = this%H*s(2) - - endfunction flux2d_LinearShallowWater2D_t - - pure function riemannflux2d_LinearShallowWater2D_t(this,sL,sR,dsdx,nhat) result(flux) - class(LinearShallowWater2D_t),intent(in) :: this - real(prec),intent(in) :: sL(1:this%solution%nVar) - real(prec),intent(in) :: sR(1:this%solution%nVar) - real(prec),intent(in) :: dsdx(1:this%solution%nVar,1:2) - real(prec),intent(in) :: nhat(1:2) - real(prec) :: flux(1:this%solution%nVar) - ! Local - real(prec) :: c - real(prec) :: unL - real(prec) :: unR - - c = sqrt(this%g*this%H) - - unL = sL(1)*nhat(1)+sL(2)*nhat(2) - unR = sR(1)*nhat(1)+sR(2)*nhat(2) - - flux(1) = 0.5_prec*(this%g*(sL(3)+sR(3))+c*(unL-unR))*nhat(1) - flux(2) = 0.5_prec*(this%g*(sL(3)+sR(3))+c*(unL-unR))*nhat(2) - flux(3) = 0.5_prec*(this%H*(unL+unR)+c*(sL(3)-sR(3))) - - endfunction riemannflux2d_LinearShallowWater2D_t - - pure function hbc2d_NoNormalFlow_LinearShallowWater2D_t(this,s,nhat) result(exts) - class(LinearShallowWater2D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec),intent(in) :: nhat(1:2) - real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - - exts(1) = (nhat(2)**2-nhat(1)**2)*s(1)-2.0_prec*nhat(1)*nhat(2)*s(2) ! u - exts(2) = (nhat(1)**2-nhat(2)**2)*s(2)-2.0_prec*nhat(1)*nhat(2)*s(1) ! v - exts(3) = s(3) ! eta - - endfunction hbc2d_NoNormalFlow_LinearShallowWater2D_t - - subroutine sourcemethod_LinearShallowWater2D_t(this) - implicit none - class(LinearShallowWater2D_t),intent(inout) :: this - ! Local - integer :: iel - integer :: i - integer :: j - real(prec) :: s(1:this%nvar) - - do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & - iel=1:this%mesh%nElem) - - s = this%solution%interior(i,j,iel,1:this%nvar) - - this%source%interior(i,j,iel,1) = this%fCori%interior(i,j,iel,1)*s(2)-this%Cd*s(1) ! du/dt = f*v - Cd*u - this%source%interior(i,j,iel,2) = -this%fCori%interior(i,j,iel,1)*s(1)-this%Cd*s(2) ! dv/dt = -f*u - Cd*v - - ! newsignal = 0.0 - ! do n = 1,nnotes - ! newsignal = newsignal + A(n)*exp( -( (x-this%xc(n))**2 +(y-this%yc(n))**2 )/(2.0*this%Lr(n)**2) ) - ! enddo - ! this%source%interior(i,j,iel,3) = w1*this%source%interior(i,j,iel,3)+ w2*newsignal - - enddo - - endsubroutine sourcemethod_LinearShallowWater2D_t - -endmodule self_LinearShallowWater2D_t diff --git a/src/SELF_advection_diffusion_1d_t.f90 b/src/SELF_advection_diffusion_1d_t.f90 deleted file mode 100644 index 591f0a0ee..000000000 --- a/src/SELF_advection_diffusion_1d_t.f90 +++ /dev/null @@ -1,94 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUsLESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARIsLG IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_advection_diffusion_1d_t - - use self_model - use self_dgmodel1d - use self_mesh - - implicit none - - type,extends(dgmodel1d) :: advection_diffusion_1d_t - real(prec) :: nu ! diffusion coefficient - real(prec) :: u ! constant velocity - - contains - procedure :: riemannflux1d => riemannflux1d_advection_diffusion_1d_t - procedure :: flux1d => flux1d_advection_diffusion_1d_t - procedure :: entropy_func => entropy_func_advection_diffusion_1d_t - - endtype advection_diffusion_1d_t - -contains - - pure function entropy_func_advection_diffusion_1d_t(this,s) result(e) - class(advection_diffusion_1d_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%solution%nvar) - real(prec) :: e - ! Local - integer :: ivar - - e = 0.0_prec - do ivar = 1,this%solution%nvar - e = e+0.5_prec*s(ivar)*s(ivar) - enddo - - endfunction entropy_func_advection_diffusion_1d_t - - pure function riemannflux1d_advection_diffusion_1d_t(this,sL,sR,dsdx,nhat) result(flux) - class(advection_diffusion_1d_t),intent(in) :: this - real(prec),intent(in) :: sL(1:this%solution%nvar) - real(prec),intent(in) :: sR(1:this%solution%nvar) - real(prec),intent(in) :: dsdx(1:this%solution%nvar) - real(prec),intent(in) :: nhat - real(prec) :: flux(1:this%solution%nvar) - ! Local - integer :: ivar - - do ivar = 1,this%solution%nvar - flux(ivar) = 0.5_prec*(this%u*nhat*(sL(ivar)+sR(ivar))+ & - abs(this%u*nhat)*(sL(ivar)-sR(ivar)))- & ! advective flux - this%nu*dsdx(ivar)*nhat ! diffusive flux - enddo - - endfunction riemannflux1d_advection_diffusion_1d_t - - pure function flux1d_advection_diffusion_1d_t(this,s,dsdx) result(flux) - class(advection_diffusion_1d_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%solution%nvar) - real(prec),intent(in) :: dsdx(1:this%solution%nvar) - real(prec) :: flux(1:this%solution%nvar) - ! Local - integer :: ivar - - do ivar = 1,this%solution%nvar - flux(ivar) = this%u*s(ivar)-this%nu*dsdx(ivar) ! advective flux + diffusive flux - enddo - - endfunction flux1d_advection_diffusion_1d_t - -endmodule self_advection_diffusion_1d_t diff --git a/src/SELF_advection_diffusion_2d_t.f90 b/src/SELF_advection_diffusion_2d_t.f90 deleted file mode 100644 index 596dff4be..000000000 --- a/src/SELF_advection_diffusion_2d_t.f90 +++ /dev/null @@ -1,99 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_advection_diffusion_2d_t - - use self_dgmodel2d - use self_mesh - - implicit none - - type,extends(dgmodel2d) :: advection_diffusion_2d_t - real(prec) :: nu ! diffusion coefficient - real(prec) :: u ! constant x-component of velocity - real(prec) :: v ! constant y-component of velocity - - contains - procedure :: riemannflux2d => riemannflux2d_advection_diffusion_2d_t - procedure :: flux2d => flux2d_advection_diffusion_2d_t - procedure :: entropy_func => entropy_func_advection_diffusion_2d_t - - endtype advection_diffusion_2d_t - -contains - - pure function entropy_func_advection_diffusion_2d_t(this,s) result(e) - class(advection_diffusion_2d_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%solution%nvar) - real(prec) :: e - ! Local - integer :: ivar - - e = 0.0_prec - do ivar = 1,this%solution%nvar - e = e+0.5_prec*s(ivar)*s(ivar) - enddo - - endfunction entropy_func_advection_diffusion_2d_t - - pure function flux2d_advection_diffusion_2d_t(this,s,dsdx) result(flux) - class(advection_diffusion_2d_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%solution%nvar) - real(prec),intent(in) :: dsdx(1:this%solution%nvar,1:2) - real(prec) :: flux(1:this%solution%nvar,1:2) - ! Local - integer :: ivar - - do ivar = 1,this%solution%nvar - flux(ivar,1) = this%u*s(ivar)-this%nu*dsdx(ivar,1) ! advective flux + diffusive flux - flux(ivar,2) = this%v*s(ivar)-this%nu*dsdx(ivar,2) ! advective flux + diffusive flux - enddo - - endfunction flux2d_advection_diffusion_2d_t - - pure function riemannflux2d_advection_diffusion_2d_t(this,sL,sR,dsdx,nhat) result(flux) - class(advection_diffusion_2d_t),intent(in) :: this - real(prec),intent(in) :: sL(1:this%nvar) - real(prec),intent(in) :: sR(1:this%nvar) - real(prec),intent(in) :: dsdx(1:this%nvar,1:2) - real(prec),intent(in) :: nhat(1:2) - real(prec) :: flux(1:this%nvar) - ! Local - integer :: ivar - real(prec) :: un,dsdn - - un = this%u*nhat(1)+this%v*nhat(2) - - do ivar = 1,this%nvar - dsdn = dsdx(ivar,1)*nhat(1)+dsdx(ivar,2)*nhat(2) - flux(ivar) = 0.5_prec*( & - (sL(ivar)+sR(ivar))+abs(un)*(sL(ivar)-sR(ivar)))- & ! advective flux - this%nu*dsdn - enddo - - endfunction riemannflux2d_advection_diffusion_2d_t - -endmodule self_advection_diffusion_2d_t diff --git a/src/SELF_advection_diffusion_3d_t.f90 b/src/SELF_advection_diffusion_3d_t.f90 deleted file mode 100644 index 92dd69244..000000000 --- a/src/SELF_advection_diffusion_3d_t.f90 +++ /dev/null @@ -1,103 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_advection_diffusion_3d_t - - use self_model - use self_dgmodel3d - use self_mesh - - implicit none - - type,extends(dgmodel3d) :: advection_diffusion_3d_t - real(prec) :: nu ! diffusion coefficient - real(prec) :: u ! constant x-component of velocity - real(prec) :: v ! constant y-component of velocity - real(prec) :: w ! constant z-component of velocity - - contains - - procedure :: riemannflux3d => riemannflux3d_advection_diffusion_3d_t - procedure :: flux3d => flux3d_advection_diffusion_3d_t - procedure :: entropy_func => entropy_func_advection_diffusion_3d_t - - endtype advection_diffusion_3d_t - -contains - - pure function entropy_func_advection_diffusion_3d_t(this,s) result(e) - class(advection_diffusion_3d_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%solution%nvar) - real(prec) :: e -! Local - integer :: ivar - - e = 0.0_prec - do ivar = 1,this%solution%nvar - e = e+0.5_prec*s(ivar)*s(ivar) - enddo - - endfunction entropy_func_advection_diffusion_3d_t - - pure function flux3d_advection_diffusion_3d_t(this,s,dsdx) result(flux) - class(advection_diffusion_3d_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%solution%nvar) - real(prec),intent(in) :: dsdx(1:this%solution%nvar,1:3) - real(prec) :: flux(1:this%solution%nvar,1:3) -! Local - integer :: ivar - - do ivar = 1,this%solution%nvar - flux(ivar,1) = this%u*s(ivar)-this%nu*dsdx(ivar,1) ! advective flux + diffusive flux - flux(ivar,2) = this%v*s(ivar)-this%nu*dsdx(ivar,2) ! advective flux + diffusive flux - flux(ivar,3) = this%w*s(ivar)-this%nu*dsdx(ivar,3) ! advective flux + diffusive flux - enddo - - endfunction flux3d_advection_diffusion_3d_t - - pure function riemannflux3d_advection_diffusion_3d_t(this,sL,sR,dsdx,nhat) result(flux) - class(advection_diffusion_3d_t),intent(in) :: this - real(prec),intent(in) :: sL(1:this%nvar) - real(prec),intent(in) :: sR(1:this%nvar) - real(prec),intent(in) :: dsdx(1:this%nvar,1:3) - real(prec),intent(in) :: nhat(1:3) - real(prec) :: flux(1:this%nvar) -! Local - integer :: ivar - real(prec) :: un,dsdn - - un = this%u*nhat(1)+this%v*nhat(2)+this%w*nhat(3) - - do ivar = 1,this%nvar - dsdn = dsdx(ivar,1)*nhat(1)+dsdx(ivar,2)*nhat(2)+dsdx(ivar,3)*nhat(3) - flux(ivar) = 0.5_prec*( & - (sL(ivar)+sR(ivar))+abs(un)*(sL(ivar)-sR(ivar)))- & ! advective flux - this%nu*dsdn - enddo - - endfunction riemannflux3d_advection_diffusion_3d_t - -endmodule self_advection_diffusion_3d_t diff --git a/src/cpu/SELF_Burgers1D.f90 b/src/cpu/SELF_Burgers1D.f90 deleted file mode 100644 index 569e88e43..000000000 --- a/src/cpu/SELF_Burgers1D.f90 +++ /dev/null @@ -1,36 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_Burgers1D - - use self_Burgers1D_t - - implicit none - - type,extends(Burgers1D_t) :: Burgers1D - endtype Burgers1D - -endmodule self_Burgers1D diff --git a/src/cpu/SELF_GFDLES3D.f90 b/src/cpu/SELF_GFDLES3D.f90 deleted file mode 100644 index 3eee2a673..000000000 --- a/src/cpu/SELF_GFDLES3D.f90 +++ /dev/null @@ -1,36 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_GFDLES3D - - use self_GFDLES3D_t - - implicit none - - type,extends(GFDLES3D_t) :: GFDLES3D - endtype GFDLES3D - -endmodule self_GFDLES3D diff --git a/src/cpu/SELF_LinearEuler2D.f90 b/src/cpu/SELF_LinearEuler2D.f90 deleted file mode 100644 index a69ae688d..000000000 --- a/src/cpu/SELF_LinearEuler2D.f90 +++ /dev/null @@ -1,36 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_LinearEuler2D - - use self_LinearEuler2D_t - - implicit none - - type,extends(LinearEuler2D_t) :: LinearEuler2D - endtype LinearEuler2D - -endmodule self_LinearEuler2D diff --git a/src/cpu/SELF_LinearEuler3D.f90 b/src/cpu/SELF_LinearEuler3D.f90 deleted file mode 100644 index 62102d1f2..000000000 --- a/src/cpu/SELF_LinearEuler3D.f90 +++ /dev/null @@ -1,36 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_LinearEuler3D - - use self_LinearEuler3D_t - - implicit none - - type,extends(LinearEuler3D_t) :: LinearEuler3D - endtype LinearEuler3D - -endmodule self_LinearEuler3D diff --git a/src/cpu/SELF_LinearShallowWater2D.f90 b/src/cpu/SELF_LinearShallowWater2D.f90 deleted file mode 100644 index 0203318e0..000000000 --- a/src/cpu/SELF_LinearShallowWater2D.f90 +++ /dev/null @@ -1,36 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_LinearShallowWater2D - - use self_LinearShallowWater2D_t - - implicit none - - type,extends(LinearShallowWater2D_t) :: LinearShallowWater2D - endtype LinearShallowWater2D - -endmodule self_LinearShallowWater2D diff --git a/src/cpu/SELF_advection_diffusion_1d.f90 b/src/cpu/SELF_advection_diffusion_1d.f90 deleted file mode 100644 index 0500ac4e4..000000000 --- a/src/cpu/SELF_advection_diffusion_1d.f90 +++ /dev/null @@ -1,36 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_advection_diffusion_1d - - use self_advection_diffusion_1d_t - - implicit none - - type,extends(advection_diffusion_1d_t) :: advection_diffusion_1d - endtype advection_diffusion_1d - -endmodule self_advection_diffusion_1d diff --git a/src/cpu/SELF_advection_diffusion_2d.f90 b/src/cpu/SELF_advection_diffusion_2d.f90 deleted file mode 100644 index 3d737b12b..000000000 --- a/src/cpu/SELF_advection_diffusion_2d.f90 +++ /dev/null @@ -1,36 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_advection_diffusion_2d - - use self_advection_diffusion_2d_t - - implicit none - - type,extends(advection_diffusion_2d_t) :: advection_diffusion_2d - endtype advection_diffusion_2d - -endmodule self_advection_diffusion_2d diff --git a/src/cpu/SELF_advection_diffusion_3d.f90 b/src/cpu/SELF_advection_diffusion_3d.f90 deleted file mode 100644 index 158a4f29c..000000000 --- a/src/cpu/SELF_advection_diffusion_3d.f90 +++ /dev/null @@ -1,36 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_advection_diffusion_3d - - use self_advection_diffusion_3d_t - - implicit none - - type,extends(advection_diffusion_3d_t) :: advection_diffusion_3d - endtype advection_diffusion_3d - -endmodule self_advection_diffusion_3d diff --git a/src/gpu/SELF_Burgers1D.f90 b/src/gpu/SELF_Burgers1D.f90 deleted file mode 100644 index 569e88e43..000000000 --- a/src/gpu/SELF_Burgers1D.f90 +++ /dev/null @@ -1,36 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_Burgers1D - - use self_Burgers1D_t - - implicit none - - type,extends(Burgers1D_t) :: Burgers1D - endtype Burgers1D - -endmodule self_Burgers1D diff --git a/src/gpu/SELF_GFDLES3D.f90 b/src/gpu/SELF_GFDLES3D.f90 deleted file mode 100644 index 59d0acc90..000000000 --- a/src/gpu/SELF_GFDLES3D.f90 +++ /dev/null @@ -1,151 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_GFDLES3D - - use self_GFDLES3D_t - - implicit none - - type,extends(GFDLES3D_t) :: GFDLES3D - contains - ! procedure :: setboundarycondition => setboundarycondition_GFDLES3D - ! procedure :: boundaryflux => boundaryflux_GFDLES3D - ! procedure :: fluxmethod => fluxmethod_GFDLES3D - - endtype GFDLES3D - - ! interface - ! subroutine setboundarycondition_GFDLES3D_gpu(extboundary,boundary,sideinfo,nhat,N,nel) & - ! bind(c,name="setboundarycondition_GFDLES3D_gpu") - ! use iso_c_binding - ! type(c_ptr),value :: extboundary,boundary,sideinfo,nhat - ! integer(c_int),value :: N,nel - ! endsubroutine setboundarycondition_GFDLES3D_gpu - ! endinterface - - ! interface - ! subroutine fluxmethod_GFDLES3D_gpu(solution,flux,rho0,c,N,nel,nvar) & - ! bind(c,name="fluxmethod_GFDLES3D_gpu") - ! use iso_c_binding - ! use SELF_Constants - ! type(c_ptr),value :: solution,flux - ! real(c_prec),value :: rho0,c - ! integer(c_int),value :: N,nel,nvar - ! endsubroutine fluxmethod_GFDLES3D_gpu - ! endinterface - - ! interface - ! subroutine boundaryflux_GFDLES3D_gpu(fb,fextb,nhat,nscale,flux,rho0,c,N,nel) & - ! bind(c,name="boundaryflux_GFDLES3D_gpu") - ! use iso_c_binding - ! use SELF_Constants - ! type(c_ptr),value :: fb,fextb,flux,nhat,nscale - ! real(c_prec),value :: rho0,c - ! integer(c_int),value :: N,nel - ! endsubroutine boundaryflux_GFDLES3D_gpu - ! endinterface - -contains - - ! subroutine boundaryflux_GFDLES3D(this) - ! implicit none - ! class(GFDLES3D),intent(inout) :: this - - ! call boundaryflux_GFDLES3D_gpu(this%solution%boundary_gpu, & - ! this%solution%extBoundary_gpu, & - ! this%geometry%nhat%boundary_gpu, & - ! this%geometry%nscale%boundary_gpu, & - ! this%flux%boundarynormal_gpu, & - ! this%rho0,this%c,this%solution%interp%N, & - ! this%solution%nelem) - - ! endsubroutine boundaryflux_GFDLES3D - - ! subroutine fluxmethod_GFDLES3D(this) - ! implicit none - ! class(GFDLES3D),intent(inout) :: this - - ! call fluxmethod_GFDLES3D_gpu(this%solution%interior_gpu, & - ! this%flux%interior_gpu, & - ! this%rho0,this%c,this%solution%interp%N,this%solution%nelem, & - ! this%solution%nvar) - - ! endsubroutine fluxmethod_GFDLES3D - - ! subroutine setboundarycondition_GFDLES3D(this) - ! !! Boundary conditions are set to periodic boundary conditions - ! implicit none - ! class(GFDLES3D),intent(inout) :: this - ! ! local - ! integer :: i,iEl,j,k,e2,bcid - ! real(prec) :: x(1:3) - - ! if(this%prescribed_bcs_enabled) then - ! call gpuCheck(hipMemcpy(c_loc(this%solution%extboundary), & - ! this%solution%extboundary_gpu,sizeof(this%solution%extboundary), & - ! hipMemcpyDeviceToHost)) - - ! ! Prescribed boundaries are still done on the CPU - ! do iEl = 1,this%solution%nElem ! Loop over all elements - ! do k = 1,6 ! Loop over all sides - - ! bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID - ! e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID - - ! if(e2 == 0) then - ! if(bcid == SELF_BC_PRESCRIBED) then - - ! do j = 1,this%solution%interp%N+1 ! Loop over quadrature points - ! do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - ! x = this%geometry%x%boundary(i,j,k,iEl,1,1:3) - - ! this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & - ! this%hbc3D_Prescribed(x,this%t) - ! enddo - ! enddo - - ! endif - ! endif - - ! enddo - ! enddo - - ! call gpuCheck(hipMemcpy(this%solution%extBoundary_gpu, & - ! c_loc(this%solution%extBoundary), & - ! sizeof(this%solution%extBoundary), & - ! hipMemcpyHostToDevice)) - ! endif - ! call setboundarycondition_GFDLES3D_gpu(this%solution%extboundary_gpu, & - ! this%solution%boundary_gpu, & - ! this%mesh%sideInfo_gpu, & - ! this%geometry%nhat%boundary_gpu, & - ! this%solution%interp%N, & - ! this%solution%nelem) - - ! endsubroutine setboundarycondition_GFDLES3D - -endmodule self_GFDLES3D diff --git a/src/gpu/SELF_LinearEuler2D.cpp b/src/gpu/SELF_LinearEuler2D.cpp deleted file mode 100644 index 2880ab2e3..000000000 --- a/src/gpu/SELF_LinearEuler2D.cpp +++ /dev/null @@ -1,161 +0,0 @@ -/* -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -*/ - -#include "SELF_GPU_Macros.h" - - -__global__ void boundaryflux_LinearEuler2D_kernel(real *fb, real *extfb, real *nhat, real *nmag, real *flux, real rho0, real c, int ndof){ - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - - if( idof < ndof ){ - - real fl[4]; - real nx = nhat[idof]; - real ny = nhat[idof+ndof]; - real un = fb[idof + ndof]*nx + fb[idof + 2*ndof]*ny; - real p = fb[idof + 3*ndof]; - - fl[0] = rho0*un; // density flux - fl[1] = p*nx/rho0; // x-momentum flux - fl[2] = p*ny/rho0; // y-momentum flux - fl[3] = rho0*c*c*un; // pressure flux - - real fr[4]; - un = extfb[idof + ndof]*nx + extfb[idof + 2*ndof]*ny; - p = extfb[idof + 3*ndof]; - - fr[0] = rho0*un; // density flux - fr[1] = p*nx/rho0; // x-momentum flux - fr[2] = p*ny/rho0; // y-momentum flux - fr[3] = rho0*c*c*un; // pressure flux - - real nm = nmag[idof]; - flux[idof] = (0.5*(fl[0]+fr[0])+c*(fb[idof]-extfb[idof]))*nm; // density - flux[idof+ndof] = (0.5*(fl[1]+fr[1])+c*(fb[idof+ndof]-extfb[idof+ndof]))*nm; // u - flux[idof+2*ndof] = (0.5*(fl[2]+fr[2])+c*(fb[idof+2*ndof]-extfb[idof+2*ndof]))*nm; // v - flux[idof+3*ndof] = (0.5*(fl[3]+fr[3])+c*(fb[idof+3*ndof]-extfb[idof+3*ndof]))*nm; // p - } -} - -extern "C" -{ - void boundaryflux_LinearEuler2D_gpu(real *fb, real *extfb,real *nhat, real *nmag, real *flux, real rho0, real c, int N, int nel, int nvar){ - int threads_per_block = 256; - uint32_t ndof = (N+1)*4*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,nvar,1); - dim3 nthreads(threads_per_block,1,1); - - boundaryflux_LinearEuler2D_kernel<<>>(fb,extfb,nhat,nmag,flux,rho0,c,ndof); - } -} - - __global__ void fluxmethod_LinearEuler2D_gpukernel(real *solution, real *flux, real rho0, real c, int ndof, int nvar){ - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - - if( idof < ndof ){ - real rho = solution[idof]; - real u = solution[idof + ndof]; - real v = solution[idof + 2*ndof]; - real p = solution[idof + 3*ndof]; - - flux[idof + ndof*(0 + nvar*0)] = rho0*u; // density, x flux ; rho0*u - flux[idof + ndof*(0 + nvar*1)] = rho0*v; // density, y flux ; rho0*v - - flux[idof + ndof*(1 + nvar*0)] = p/rho0; // x-velocity, x flux; p/rho0 - flux[idof + ndof*(1 + nvar*1)] = 0.0; // x-velocity, y flux; 0 - - flux[idof + ndof*(2 + nvar*0)] = 0.0; // y-velocity, x flux; 0 - flux[idof + ndof*(2 + nvar*1)] = p/rho0; // y-velocity, y flux; p/rho0 - - flux[idof + ndof*(3 + nvar*0)] = c*c*rho0*u; // pressure, x flux : rho0*c^2*u - flux[idof + ndof*(3 + nvar*1)] = c*c*rho0*v; // pressure, y flux : rho0*c^2*v - - } - -} -extern "C" -{ - void fluxmethod_LinearEuler2D_gpu(real *solution, real *flux, real rho0, real c, int N, int nel, int nvar){ - int ndof = (N+1)*(N+1)*nel; - int threads_per_block = 256; - int nblocks_x = ndof/threads_per_block +1; - fluxmethod_LinearEuler2D_gpukernel<<>>(solution,flux,rho0,c,ndof,nvar); - } - -} -__global__ void setboundarycondition_LinearEuler2D_gpukernel(real *extBoundary, real *boundary, int *sideInfo, real *nhat, int N, int nel, int nvar){ - - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - uint32_t ndof = (N+1)*4*nel; - - if(idof < ndof){ - uint32_t i = idof % (N+1); - uint32_t s1 = (idof/(N+1)) % 4; - uint32_t e1 = idof/(N+1)/4; - uint32_t e2 = sideInfo[INDEX3(2,s1,e1,5,4)]; - uint32_t bcid = sideInfo[INDEX3(4,s1,e1,5,4)]; - if( e2 == 0){ - if( bcid == SELF_BC_NONORMALFLOW ){ - - real u = boundary[SCB_2D_INDEX(i,s1,e1,1,N,nel)]; - real v = boundary[SCB_2D_INDEX(i,s1,e1,2,N,nel)]; - real nx = nhat[VEB_2D_INDEX(i,s1,e1,0,0,N,nel,1)]; - real ny = nhat[VEB_2D_INDEX(i,s1,e1,0,1,N,nel,1)]; - extBoundary[SCB_2D_INDEX(i,s1,e1,0,N,nel)] = boundary[SCB_2D_INDEX(i,s1,e1,0,N,nel)]; // density - extBoundary[SCB_2D_INDEX(i,s1,e1,1,N,nel)] = (ny*ny-nx*nx)*u-2.0*nx*ny*v; // u - extBoundary[SCB_2D_INDEX(i,s1,e1,2,N,nel)] = (nx*nx-ny*ny)*v-2.0*nx*ny*u; //v - extBoundary[SCB_2D_INDEX(i,s1,e1,3,N,nel)] = boundary[SCB_2D_INDEX(i,s1,e1,3,N,nel)]; // pressure - - } else if ( bcid == SELF_BC_RADIATION ){ - - extBoundary[SCB_2D_INDEX(i,s1,e1,0,N,nel)] = 0.0; - extBoundary[SCB_2D_INDEX(i,s1,e1,1,N,nel)] = 0.0; - extBoundary[SCB_2D_INDEX(i,s1,e1,2,N,nel)] = 0.0; - extBoundary[SCB_2D_INDEX(i,s1,e1,3,N,nel)] = 0.0; - - } - - } - } -} - -extern "C" -{ - void setboundarycondition_LinearEuler2D_gpu(real *extBoundary, real *boundary, int *sideInfo, real *nhat, int N, int nel, int nvar){ - int threads_per_block = 256; - int ndof = (N+1)*4*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,1,1); - dim3 nthreads(threads_per_block,1,1); - - setboundarycondition_LinearEuler2D_gpukernel<<>>(extBoundary,boundary,sideInfo,nhat,N,nel,nvar); - } -} diff --git a/src/gpu/SELF_LinearEuler2D.f90 b/src/gpu/SELF_LinearEuler2D.f90 deleted file mode 100644 index 54e0fbc0e..000000000 --- a/src/gpu/SELF_LinearEuler2D.f90 +++ /dev/null @@ -1,161 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_LinearEuler2D - - use self_LinearEuler2D_t - - implicit none - - type,extends(LinearEuler2D_t) :: LinearEuler2D - contains - procedure :: setboundarycondition => setboundarycondition_LinearEuler2D - procedure :: boundaryflux => boundaryflux_LinearEuler2D - procedure :: fluxmethod => fluxmethod_LinearEuler2D - procedure :: sourcemethod => sourcemethod_LinearEuler2D - - endtype LinearEuler2D - - interface - subroutine setboundarycondition_LinearEuler2D_gpu(extboundary,boundary,sideinfo,nhat,N,nel,nvar) & - bind(c,name="setboundarycondition_LinearEuler2D_gpu") - use iso_c_binding - type(c_ptr),value :: extboundary,boundary,sideinfo,nhat - integer(c_int),value :: N,nel,nvar - endsubroutine setboundarycondition_LinearEuler2D_gpu - endinterface - - interface - subroutine fluxmethod_LinearEuler2D_gpu(solution,flux,rho0,c,N,nel,nvar) & - bind(c,name="fluxmethod_LinearEuler2D_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: solution,flux - real(c_prec),value :: rho0,c - integer(c_int),value :: N,nel,nvar - endsubroutine fluxmethod_LinearEuler2D_gpu - endinterface - - interface - subroutine boundaryflux_LinearEuler2D_gpu(fb,fextb,nhat,nscale,flux,rho0,c,N,nel,nvar) & - bind(c,name="boundaryflux_LinearEuler2D_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: fb,fextb,flux,nhat,nscale - real(c_prec),value :: rho0,c - integer(c_int),value :: N,nel,nvar - endsubroutine boundaryflux_LinearEuler2D_gpu - endinterface - -contains - - subroutine sourcemethod_LinearEuler2D(this) - implicit none - class(LinearEuler2D),intent(inout) :: this - - return - - endsubroutine sourcemethod_LinearEuler2D - - subroutine boundaryflux_LinearEuler2D(this) - ! this method uses an linear upwind solver for the - ! advective flux and the bassi-rebay method for the - ! diffusive fluxes - implicit none - class(LinearEuler2D),intent(inout) :: this - - call boundaryflux_LinearEuler2D_gpu(this%solution%boundary_gpu, & - this%solution%extBoundary_gpu, & - this%geometry%nhat%boundary_gpu, & - this%geometry%nscale%boundary_gpu, & - this%flux%boundarynormal_gpu, & - this%rho0,this%c,this%solution%interp%N, & - this%solution%nelem,this%solution%nvar) - - endsubroutine boundaryflux_LinearEuler2D - - subroutine fluxmethod_LinearEuler2D(this) - implicit none - class(LinearEuler2D),intent(inout) :: this - - call fluxmethod_LinearEuler2D_gpu(this%solution%interior_gpu, & - this%flux%interior_gpu, & - this%rho0,this%c,this%solution%interp%N,this%solution%nelem, & - this%solution%nvar) - - endsubroutine fluxmethod_LinearEuler2D - - subroutine setboundarycondition_LinearEuler2D(this) - !! Boundary conditions are set to periodic boundary conditions - implicit none - class(LinearEuler2D),intent(inout) :: this - ! local - integer :: i,iEl,j,e2,bcid - real(prec) :: x(1:2) - - if(this%prescribed_bcs_enabled) then - call gpuCheck(hipMemcpy(c_loc(this%solution%extboundary), & - this%solution%extboundary_gpu,sizeof(this%solution%extboundary), & - hipMemcpyDeviceToHost)) - - ! Prescribed boundaries are still done on the GPU - do iEl = 1,this%solution%nElem ! Loop over all elements - do j = 1,4 ! Loop over all sides - - bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - x = this%geometry%x%boundary(i,j,iEl,1,1:2) - - this%solution%extBoundary(i,j,iEl,1:this%nvar) = & - this%hbc2d_Prescribed(x,this%t) - enddo - - endif - endif - - enddo - enddo - - call gpuCheck(hipMemcpy(this%solution%extBoundary_gpu, & - c_loc(this%solution%extBoundary), & - sizeof(this%solution%extBoundary), & - hipMemcpyHostToDevice)) - endif - call setboundarycondition_LinearEuler2D_gpu(this%solution%extboundary_gpu, & - this%solution%boundary_gpu, & - this%mesh%sideInfo_gpu, & - this%geometry%nhat%boundary_gpu, & - this%solution%interp%N, & - this%solution%nelem,this%solution%nvar) - - endsubroutine setboundarycondition_LinearEuler2D - -endmodule self_LinearEuler2D diff --git a/src/gpu/SELF_LinearEuler3D.cpp b/src/gpu/SELF_LinearEuler3D.cpp deleted file mode 100644 index c71c4b58f..000000000 --- a/src/gpu/SELF_LinearEuler3D.cpp +++ /dev/null @@ -1,176 +0,0 @@ -/* -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -*/ - -#include "SELF_GPU_Macros.h" - - -__global__ void boundaryflux_LinearEuler3D_kernel(real *fb, real *extfb, real *nhat, real *nmag, real *flux, real rho0, real c, int ndof){ - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - - if( idof < ndof ){ - - real fl[5]; - real nx = nhat[idof]; - real ny = nhat[idof+ndof]; - real nz = nhat[idof+2*ndof]; - real un = fb[idof + ndof]*nx + fb[idof + 2*ndof]*ny+fb[idof + 3*ndof]*nz; - real p = fb[idof + 4*ndof]; - - fl[0] = rho0*un; // density flux - fl[1] = p*nx/rho0; // x-momentum flux - fl[2] = p*ny/rho0; // y-momentum flux - fl[3] = p*nz/rho0; // z-momentum flux - fl[4] = rho0*c*c*un; // pressure flux - - real fr[5]; - un = extfb[idof + ndof]*nx + extfb[idof + 2*ndof]*ny+extfb[idof + 3*ndof]*nz; - p = extfb[idof + 4*ndof]; - - fr[0] = rho0*un; // density flux - fr[1] = p*nx/rho0; // x-momentum flux - fr[2] = p*ny/rho0; // y-momentum flux - fr[3] = p*nz/rho0; // y-momentum flux - fr[4] = rho0*c*c*un; // pressure flux - - real nm = nmag[idof]; - flux[idof] = (0.5*(fl[0]+fr[0])+c*(fb[idof]-extfb[idof]))*nm; // density - flux[idof+ndof] = (0.5*(fl[1]+fr[1])+c*(fb[idof+ndof]-extfb[idof+ndof]))*nm; // u - flux[idof+2*ndof] = (0.5*(fl[2]+fr[2])+c*(fb[idof+2*ndof]-extfb[idof+2*ndof]))*nm; // v - flux[idof+3*ndof] = (0.5*(fl[3]+fr[3])+c*(fb[idof+3*ndof]-extfb[idof+3*ndof]))*nm; // w - flux[idof+4*ndof] = (0.5*(fl[4]+fr[4])+c*(fb[idof+4*ndof]-extfb[idof+4*ndof]))*nm; // p - } -} - -extern "C" -{ - void boundaryflux_LinearEuler3D_gpu(real *fb, real *extfb,real *nhat, real *nmag, real *flux, real rho0, real c, int N, int nel){ - int threads_per_block = 256; - uint32_t ndof = (N+1)*(N+1)*6*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,1,1); - dim3 nthreads(threads_per_block,1,1); - - boundaryflux_LinearEuler3D_kernel<<>>(fb,extfb,nhat,nmag,flux,rho0,c,ndof); - } -} - - __global__ void fluxmethod_LinearEuler3D_gpukernel(real *solution, real *flux, real rho0, real c, int ndof, int nvar){ - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - - if( idof < ndof ){ - real u = solution[idof + ndof]; - real v = solution[idof + 2*ndof]; - real w = solution[idof + 3*ndof]; - real p = solution[idof + 4*ndof]; - - flux[idof + ndof*(0 + nvar*0)] = rho0*u; // density, x flux ; rho0*u - flux[idof + ndof*(0 + nvar*1)] = rho0*v; // density, y flux ; rho0*v - flux[idof + ndof*(0 + nvar*2)] = rho0*w; // density, z flux ; rho0*w - - flux[idof + ndof*(1 + nvar*0)] = p/rho0; // x-velocity, x flux; p/rho0 - flux[idof + ndof*(1 + nvar*1)] = 0.0; // x-velocity, y flux; 0 - flux[idof + ndof*(1 + nvar*2)] = 0.0; // x-velocity, z flux; 0 - - flux[idof + ndof*(2 + nvar*0)] = 0.0; // y-velocity, x flux; 0 - flux[idof + ndof*(2 + nvar*1)] = p/rho0; // y-velocity, y flux; p/rho0 - flux[idof + ndof*(2 + nvar*2)] = 0.0; // y-velocity, z flux; 0 - - flux[idof + ndof*(3 + nvar*0)] = 0.0; // z-velocity, x flux; 0 - flux[idof + ndof*(3 + nvar*1)] = 0.0; // z-velocity, y flux; 0 - flux[idof + ndof*(3 + nvar*2)] = p/rho0; // z-velocity, z flux; p/rho0 - - flux[idof + ndof*(4 + nvar*0)] = c*c*rho0*u; // pressure, x flux : rho0*c^2*u - flux[idof + ndof*(4 + nvar*1)] = c*c*rho0*v; // pressure, y flux : rho0*c^2*v - flux[idof + ndof*(4 + nvar*2)] = c*c*rho0*w; // pressure, z flux : rho0*c^2*w - - } - -} -extern "C" -{ - void fluxmethod_LinearEuler3D_gpu(real *solution, real *flux, real rho0, real c, int N, int nel, int nvar){ - int ndof = (N+1)*(N+1)*(N+1)*nel; - int threads_per_block = 256; - int nblocks_x = ndof/threads_per_block +1; - fluxmethod_LinearEuler3D_gpukernel<<>>(solution,flux,rho0,c,ndof,nvar); - } - -} -__global__ void setboundarycondition_LinearEuler3D_gpukernel(real *extBoundary, real *boundary, int *sideInfo, real *nhat, int N, int nel){ - - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - uint32_t ndof = (N+1)*(N+1)*6*nel; - - if(idof < ndof){ - uint32_t i = idof % (N+1); - uint32_t j = (idof/(N+1)) % (N+1); - uint32_t s1 = (idof/(N+1)/(N+1)) % 6; - uint32_t e1 = idof/(N+1)/(N+1)/6; - uint32_t e2 = sideInfo[INDEX3(2,s1,e1,5,4)]; - uint32_t bcid = sideInfo[INDEX3(4,s1,e1,5,4)]; - if( e2 == 0){ - // if( bcid == SELF_BC_NONORMALFLOW ){ - - // real u = boundary[SCB_3D_INDEX(i,s1,e1,1,N,nel)]; - // real v = boundary[SCB_3D_INDEX(i,s1,e1,2,N,nel)]; - // real nx = nhat[VEB_3D_INDEX(i,s1,e1,0,0,N,nel,1)]; - // real ny = nhat[VEB_3D_INDEX(i,s1,e1,0,1,N,nel,1)]; - // extBoundary[SCB_3D_INDEX(i,s1,e1,0,N,nel)] = boundary[SCB_3D_INDEX(i,s1,e1,0,N,nel)]; // density - // extBoundary[SCB_3D_INDEX(i,s1,e1,1,N,nel)] = (ny*ny-nx*nx)*u-2.0*nx*ny*v; // u - // extBoundary[SCB_3D_INDEX(i,s1,e1,2,N,nel)] = (nx*nx-ny*ny)*v-2.0*nx*ny*u; //v - // extBoundary[SCB_3D_INDEX(i,s1,e1,3,N,nel)] = boundary[SCB_3D_INDEX(i,s1,e1,3,N,nel)]; // pressure - - // } else - if ( bcid == SELF_BC_RADIATION ){ - - extBoundary[SCB_3D_INDEX(i,j,s1,e1,0,N,nel)] = 0.0; - extBoundary[SCB_3D_INDEX(i,j,s1,e1,1,N,nel)] = 0.0; - extBoundary[SCB_3D_INDEX(i,j,s1,e1,2,N,nel)] = 0.0; - extBoundary[SCB_3D_INDEX(i,j,s1,e1,3,N,nel)] = 0.0; - extBoundary[SCB_3D_INDEX(i,j,s1,e1,4,N,nel)] = 0.0; - - } - - } - } -} - -extern "C" -{ - void setboundarycondition_LinearEuler3D_gpu(real *extBoundary, real *boundary, int *sideInfo, real *nhat, int N, int nel){ - int threads_per_block = 256; - int ndof = (N+1)*(N+1)*6*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,1,1); - dim3 nthreads(threads_per_block,1,1); - - setboundarycondition_LinearEuler3D_gpukernel<<>>(extBoundary,boundary,sideInfo,nhat,N,nel); - } -} diff --git a/src/gpu/SELF_LinearEuler3D.f90 b/src/gpu/SELF_LinearEuler3D.f90 deleted file mode 100644 index 76190a383..000000000 --- a/src/gpu/SELF_LinearEuler3D.f90 +++ /dev/null @@ -1,151 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_LinearEuler3D - - use self_LinearEuler3D_t - - implicit none - - type,extends(LinearEuler3D_t) :: LinearEuler3D - contains - procedure :: setboundarycondition => setboundarycondition_LinearEuler3D - procedure :: boundaryflux => boundaryflux_LinearEuler3D - procedure :: fluxmethod => fluxmethod_LinearEuler3D - - endtype LinearEuler3D - - interface - subroutine setboundarycondition_LinearEuler3D_gpu(extboundary,boundary,sideinfo,nhat,N,nel) & - bind(c,name="setboundarycondition_LinearEuler3D_gpu") - use iso_c_binding - type(c_ptr),value :: extboundary,boundary,sideinfo,nhat - integer(c_int),value :: N,nel - endsubroutine setboundarycondition_LinearEuler3D_gpu - endinterface - - interface - subroutine fluxmethod_LinearEuler3D_gpu(solution,flux,rho0,c,N,nel,nvar) & - bind(c,name="fluxmethod_LinearEuler3D_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: solution,flux - real(c_prec),value :: rho0,c - integer(c_int),value :: N,nel,nvar - endsubroutine fluxmethod_LinearEuler3D_gpu - endinterface - - interface - subroutine boundaryflux_LinearEuler3D_gpu(fb,fextb,nhat,nscale,flux,rho0,c,N,nel) & - bind(c,name="boundaryflux_LinearEuler3D_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: fb,fextb,flux,nhat,nscale - real(c_prec),value :: rho0,c - integer(c_int),value :: N,nel - endsubroutine boundaryflux_LinearEuler3D_gpu - endinterface - -contains - - subroutine boundaryflux_LinearEuler3D(this) - implicit none - class(LinearEuler3D),intent(inout) :: this - - call boundaryflux_LinearEuler3D_gpu(this%solution%boundary_gpu, & - this%solution%extBoundary_gpu, & - this%geometry%nhat%boundary_gpu, & - this%geometry%nscale%boundary_gpu, & - this%flux%boundarynormal_gpu, & - this%rho0,this%c,this%solution%interp%N, & - this%solution%nelem) - - endsubroutine boundaryflux_LinearEuler3D - - subroutine fluxmethod_LinearEuler3D(this) - implicit none - class(LinearEuler3D),intent(inout) :: this - - call fluxmethod_LinearEuler3D_gpu(this%solution%interior_gpu, & - this%flux%interior_gpu, & - this%rho0,this%c,this%solution%interp%N,this%solution%nelem, & - this%solution%nvar) - - endsubroutine fluxmethod_LinearEuler3D - - subroutine setboundarycondition_LinearEuler3D(this) - !! Boundary conditions are set to periodic boundary conditions - implicit none - class(LinearEuler3D),intent(inout) :: this - ! local - integer :: i,iEl,j,k,e2,bcid - real(prec) :: x(1:3) - - if(this%prescribed_bcs_enabled) then - call gpuCheck(hipMemcpy(c_loc(this%solution%extboundary), & - this%solution%extboundary_gpu,sizeof(this%solution%extboundary), & - hipMemcpyDeviceToHost)) - - ! Prescribed boundaries are still done on the CPU - do iEl = 1,this%solution%nElem ! Loop over all elements - do k = 1,6 ! Loop over all sides - - bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - - do j = 1,this%solution%interp%N+1 ! Loop over quadrature points - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - x = this%geometry%x%boundary(i,j,k,iEl,1,1:3) - - this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & - this%hbc3D_Prescribed(x,this%t) - enddo - enddo - - endif - endif - - enddo - enddo - - call gpuCheck(hipMemcpy(this%solution%extBoundary_gpu, & - c_loc(this%solution%extBoundary), & - sizeof(this%solution%extBoundary), & - hipMemcpyHostToDevice)) - endif - call setboundarycondition_LinearEuler3D_gpu(this%solution%extboundary_gpu, & - this%solution%boundary_gpu, & - this%mesh%sideInfo_gpu, & - this%geometry%nhat%boundary_gpu, & - this%solution%interp%N, & - this%solution%nelem) - - endsubroutine setboundarycondition_LinearEuler3D - -endmodule self_LinearEuler3D diff --git a/src/gpu/SELF_LinearShallowWater2D.cpp b/src/gpu/SELF_LinearShallowWater2D.cpp deleted file mode 100644 index 7d68dbeab..000000000 --- a/src/gpu/SELF_LinearShallowWater2D.cpp +++ /dev/null @@ -1,168 +0,0 @@ -/* -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -*/ - -#include "SELF_GPU_Macros.h" - -__global__ void boundaryflux_LinearShallowWater2D_kernel(real *fb, real *extfb, real *nhat, real *nmag, real *flux, real g, real H, int ndof){ - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - - if( idof < ndof){ - - real nx = nhat[idof]; - real ny = nhat[idof+ndof]; - real nm = nmag[idof]; - - real fl[3]; - fl[0] = fb[idof]; // uL - fl[1] = fb[idof + ndof]; // vL - fl[2] = fb[idof + 2*ndof]; // etaL - - real fr[3]; - fr[0] = extfb[idof]; // uR - fr[1] = extfb[idof + ndof]; // vR - fr[2] = extfb[idof + 2*ndof]; // etaR - - real unL = fl[0] * nx + fl[1] * ny; - real unR = fr[0] * nx + fr[1] * ny; - - real c = sqrt(g * H); - - flux[idof] = 0.5 * (g * (fl[2] + fr[2]) + c * (unL - unR)) * nx * nm; - flux[idof + ndof] = 0.5 * (g * (fl[2] + fr[2]) + c * (unL - unR)) * ny * nm; - flux[idof + 2*ndof] = 0.5 * (H * (unL + unR) + c * (fl[2] - fr[2])) * nm; - } -} - -extern "C" -{ - void boundaryflux_LinearShallowWater2D_gpu(real *fb, real *extfb, real *nhat, real *nmag, real *flux, real g, real H, int N, int nel, int nvar){ - int threads_per_block = 256; - uint32_t ndof = (N+1)*4*nel; - int nblocks_x = ndof/threads_per_block + 1; - - dim3 nblocks(nblocks_x, nvar, 1); - dim3 nthreads(threads_per_block, 1, 1); - - boundaryflux_LinearShallowWater2D_kernel<<>>(fb,extfb,nhat,nmag,flux,g,H,ndof); - } -} - -__global__ void fluxmethod_LinearShallowWater2D_gpukernel(real *solution, real *flux, real g, real H, int ndof, int nvar){ - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - - if( idof < ndof ){ - real u = solution[idof]; - real v = solution[idof + ndof]; - real eta = solution[idof + 2*ndof]; - - flux[idof + ndof*(0 + nvar*0)] = g*eta; // x-component of u - flux[idof + ndof*(0 + nvar*1)] = 0.0; // y-component of u - flux[idof + ndof*(1 + nvar*0)] = 0.0; // x-component of v - flux[idof + ndof*(1 + nvar*1)] = g*eta; // y-component of v - flux[idof + ndof*(2 + nvar*0)] = H*u; // x-component of eta - flux[idof + ndof*(2 + nvar*1)] = H*v; // y-component of eta - - } - -} -extern "C" -{ - void fluxmethod_LinearShallowWater2D_gpu(real *solution, real *flux, real g, real H, int N, int nel, int nvar){ - int ndof = (N+1)*(N+1)*nel; - int threads_per_block = 256; - int nblocks_x = ndof/threads_per_block +1; - fluxmethod_LinearShallowWater2D_gpukernel<<>>(solution,flux,g,H,ndof,nvar); - } -} - -__global__ void setboundarycondition_LinearShallowWater2D_gpukernel(real *extBoundary, real *boundary, int *sideInfo, real *nhat, int N, int nEl, int nvar){ - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - uint32_t ndof = (N+1)*4*nEl; - - if(idof < ndof){ - uint32_t i = idof % (N+1); - uint32_t s1 = (idof/(N+1)) % 4; - uint32_t e1 = idof/(N+1)/4; - uint32_t e2 = sideInfo[INDEX3(2,s1,e1,5,4)]; - uint32_t bcid = sideInfo[INDEX3(4,s1,e1,5,4)]; - if( e2 == 0){ - if( bcid == SELF_BC_NONORMALFLOW){ - real u = boundary[SCB_2D_INDEX(i,s1,e1,0,N,nEl)]; - real v = boundary[SCB_2D_INDEX(i,s1,e1,1,N,nEl)]; - real eta = boundary[SCB_2D_INDEX(i,s1,e1,2,N,nEl)]; - real nx = nhat[VEB_2D_INDEX(i,s1,e1,0,0,N,nEl,1)]; - real ny = nhat[VEB_2D_INDEX(i,s1,e1,0,1,N,nEl,1)]; - - extBoundary[SCB_2D_INDEX(i,s1,e1,0,N,nEl)] = (ny * ny - nx * nx) * u - 2 * nx * ny * v; - extBoundary[SCB_2D_INDEX(i,s1,e1,1,N,nEl)] = (nx * nx - ny * ny) * v - 2 * nx * ny * u; - extBoundary[SCB_2D_INDEX(i,s1,e1,2,N,nEl)] = eta; - } else if ( bcid == SELF_BC_RADIATION){ - extBoundary[SCB_2D_INDEX(i,s1,e1,0,N,nEl)] = 0.0; - extBoundary[SCB_2D_INDEX(i,s1,e1,1,N,nEl)] = 0.0; - extBoundary[SCB_2D_INDEX(i,s1,e1,2,N,nEl)] = 0.0; - } - } - } -} - -extern "C" -{ - void setboundarycondition_LinearShallowWater2D_gpu(real *extBoundary, real *boundary, int *sideInfo, real *nhat, int N, int nel, int nvar){ - int threads_per_block = 256; - int ndof = (N+1)*4*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,1,1); - dim3 nthreads(threads_per_block,1,1); - - setboundarycondition_LinearShallowWater2D_gpukernel<<>>(extBoundary,boundary,sideInfo,nhat,N,nel,nvar); - } -} - -__global__ void sourcemethod_LinearShallowWater2D_gpukernel(real *solution, real *source, real *fCori, real Cd, int ndof){ - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - - if( idof < ndof ){ - real u = solution[idof]; - real v = solution[idof + ndof]; - - source[idof] = fCori[idof]*v - Cd*u; // du/dt = fv - Cd*u - source[idof+ndof] = -fCori[idof]*u - Cd*v; // dv/dt = -fu - Cd*v - - } - -} -extern "C" -{ - void sourcemethod_LinearShallowWater2D_gpu(real *solution, real *source, real *fCori, real Cd, int N, int nel, int nvar){ - int ndof = (N+1)*(N+1)*nel; - int threads_per_block = 256; - int nblocks_x = ndof/threads_per_block +1; - sourcemethod_LinearShallowWater2D_gpukernel<<>>(solution,source,fCori,Cd,ndof); - } -} \ No newline at end of file diff --git a/src/gpu/SELF_LinearShallowWater2D.f90 b/src/gpu/SELF_LinearShallowWater2D.f90 deleted file mode 100644 index 9ae072d4f..000000000 --- a/src/gpu/SELF_LinearShallowWater2D.f90 +++ /dev/null @@ -1,176 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_LinearShallowWater2D - - use self_LinearShallowWater2D_t - - implicit none - - type,extends(LinearShallowWater2D_t) :: LinearShallowWater2D - contains - procedure :: setboundarycondition => setboundarycondition_LinearShallowWater2D - procedure :: boundaryflux => boundaryflux_LinearShallowWater2D - procedure :: fluxmethod => fluxmethod_LinearShallowWater2D - procedure :: sourcemethod => sourcemethod_LinearShallowWater2D - - endtype LinearShallowWater2D - - interface - subroutine setboundarycondition_LinearShallowWater2D_gpu(extboundary,boundary,sideinfo,nhat,N,nel,nvar) & - bind(c,name="setboundarycondition_LinearShallowWater2D_gpu") - use iso_c_binding - type(c_ptr),value :: extboundary,boundary,sideinfo,nhat - integer(c_int),value :: N,nel,nvar - endsubroutine setboundarycondition_LinearShallowWater2D_gpu - endinterface - - interface - subroutine boundaryflux_LinearShallowWater2D_gpu(fb,fextb,nhat,nscale,flux,g,H,N,nel,nvar) & - bind(c,name="boundaryflux_LinearShallowWater2D_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: fb,fextb,flux,nhat,nscale - real(c_prec),value :: g,H - integer(c_int),value :: N,nel,nvar - endsubroutine boundaryflux_LinearShallowWater2D_gpu - endinterface - - interface - subroutine fluxmethod_LinearShallowWater2D_gpu(solution,flux,g,H,N,nel,nvar) & - bind(c,name="fluxmethod_LinearShallowWater2D_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: solution,flux - real(c_prec),value :: g,H - integer(c_int),value :: N,nel,nvar - endsubroutine fluxmethod_LinearShallowWater2D_gpu - endinterface - - interface - subroutine sourcemethod_LinearShallowWater2D_gpu(solution,source,fCori,Cd,N,nel,nvar) & - bind(c,name="sourcemethod_LinearShallowWater2D_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: solution,source,fCori - real(c_prec),value :: Cd - integer(c_int),value :: N,nel,nvar - endsubroutine sourcemethod_LinearShallowWater2D_gpu - endinterface - -contains - - subroutine boundaryflux_LinearShallowWater2D(this) - implicit none - class(LinearShallowWater2D),intent(inout) :: this - - call boundaryflux_LinearShallowWater2D_gpu(this%solution%boundary_gpu, & - this%solution%extBoundary_gpu, & - this%geometry%nhat%boundary_gpu, & - this%geometry%nscale%boundary_gpu, & - this%flux%boundaryNormal_gpu, & - this%g, & - this%H, & - this%solution%interp%N, & - this%solution%nelem, & - this%solution%nvar) - - endsubroutine boundaryflux_LinearShallowWater2D - - subroutine setboundarycondition_LinearShallowWater2D(this) - implicit none - class(LinearShallowWater2D),intent(inout) :: this - integer :: i,iel,j,e2,bcid - real(prec) :: x(1:2) - - if(this%prescribed_bcs_enabled) then - call gpuCheck(hipMemcpy(c_loc(this%solution%extBoundary), & - this%solution%extBoundary_gpu, & - sizeof(this%solution%extBoundary), & - hipMemcpyDeviceToHost)) - do iel = 1,this%solution%nelem - do j = 1,4 - bcid = this%mesh%sideinfo(5,j,iel) - e2 = this%mesh%sideinfo(3,j,iel) - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - do i = 1,this%solution%interp%N+1 - x = this%geometry%x%boundary(i,j,iel,1,1:2) - this%solution%extBoundary(i,j,iel,1:this%nvar) = & - this%hbc2d_Prescribed(x,this%t) - enddo - endif - endif - enddo - enddo - - call gpucheck(hipMemcpy(this%solution%extBoundary_gpu, & - c_loc(this%solution%extBoundary), & - sizeof(this%solution%extBoundary), & - hipMemcpyHostToDevice)) - - endif - - call setboundarycondition_LinearShallowWater2D_gpu(this%solution%extboundary_gpu, & - this%solution%boundary_gpu, & - this%mesh%sideInfo_gpu, & - this%geometry%nhat%boundary_gpu, & - this%solution%interp%N, & - this%solution%nelem, & - this%solution%nvar) - - endsubroutine setboundarycondition_LinearShallowWater2D - - subroutine fluxmethod_LinearShallowWater2D(this) - implicit none - class(LinearShallowWater2D),intent(inout) :: this - - call fluxmethod_LinearShallowWater2D_gpu(this%solution%interior_gpu, & - this%flux%interior_gpu, & - this%g, & - this%H, & - this%solution%interp%N, & - this%solution%nelem, & - this%solution%nvar) - - endsubroutine fluxmethod_LinearShallowWater2D - - subroutine sourcemethod_LinearShallowWater2D(this) - implicit none - class(LinearShallowWater2D),intent(inout) :: this - - call sourcemethod_LinearShallowWater2D_gpu(this%solution%interior_gpu, & - this%source%interior_gpu, & - this%fCori%interior_gpu, & - this%Cd, & - this%solution%interp%N, & - this%solution%nelem, & - this%solution%nvar) - - endsubroutine sourcemethod_LinearShallowWater2D - -endmodule self_LinearShallowWater2D diff --git a/src/gpu/SELF_advection_diffusion_1d.cpp b/src/gpu/SELF_advection_diffusion_1d.cpp deleted file mode 100644 index 7033cd5c2..000000000 --- a/src/gpu/SELF_advection_diffusion_1d.cpp +++ /dev/null @@ -1,70 +0,0 @@ -#include "SELF_GPU_Macros.h" - - -__global__ void setboundarycondition_advection_diffusion_1d_gpukernel(real *extBoundary, real *boundary, int nel, int nvar){ - - uint32_t ivar = threadIdx.x + blockIdx.x*blockDim.x; - if(ivar < nvar){ - extBoundary[SCB_1D_INDEX(0,0,ivar,nel)] = boundary[SCB_1D_INDEX(1,nel-1,ivar,nel)]; - extBoundary[SCB_1D_INDEX(1,nel-1,ivar,nel)] = boundary[SCB_1D_INDEX(0,0,ivar,nel)]; - } - -} - -extern "C" -{ - void setboundarycondition_advection_diffusion_1d_gpu(real *extBoundary, real *boundary, int nel, int nvar){ - int threads_per_block = 64; - int nblocks_x = nvar/threads_per_block +1; - setboundarycondition_advection_diffusion_1d_gpukernel<<>>(extBoundary,boundary,nel,nvar); - } -} - -__global__ void fluxmethod_advection_diffusion_1d_gpukernel(real *solution, real *solutiongradient, real *flux, real u, real nu, int ndof){ - uint32_t i = threadIdx.x + blockIdx.x*blockDim.x; - - if( i < ndof ){ - flux[i] = u*solution[i] - nu*solutiongradient[i]; - } - -} -extern "C" -{ - void fluxmethod_advection_diffusion_1d_gpu(real *solution, real *solutiongradient, real *flux, real u, real nu, int ndof){ - int threads_per_block = 256; - int nblocks_x = ndof/threads_per_block +1; - fluxmethod_advection_diffusion_1d_gpukernel<<>>(solution,solutiongradient,flux,u,nu,ndof); - } - -} - -__global__ void boundaryflux_advection_diffusion_1d_gpukernel(real *fb, real *fextb, real *dfavg, real *flux, real u, real nu, int ndof){ - uint32_t i = threadIdx.x + blockIdx.x*blockDim.x; - // when i is even, we are looking at the left side of the element and the boundary normal is negative - // when i is odd, we are looking at the right side of the element and boundary normal is positive - // - // i%2 is 0 when i is even - // 1 when i is odd - // - // 2*(i%2) is 0 when i is even - // 2 when i is odd - // - // 2*(i%2)-1 is -1 when i is even - // 1 when i is odd - real nhat = 2.0*(i%2)-1.0; - - if( i < ndof ){ - flux[i] = 0.5*(u*nhat*(fb[i]+fextb[i]) + fabsf(u*nhat)*(fb[i]-fextb[i])) - nu*dfavg[i]*nhat; - } - -} -extern "C" -{ - void boundaryflux_advection_diffusion_1d_gpu(real *fb, real *fextb, real *dfavg, real *flux, real u, real nu, int ndof){ - int threads_per_block = 256; - int nblocks_x = ndof/threads_per_block +1; - boundaryflux_advection_diffusion_1d_gpukernel<<>>(fb,fextb,dfavg,flux,u,nu,ndof); - } - -} - diff --git a/src/gpu/SELF_advection_diffusion_1d.f90 b/src/gpu/SELF_advection_diffusion_1d.f90 deleted file mode 100644 index 126408f1a..000000000 --- a/src/gpu/SELF_advection_diffusion_1d.f90 +++ /dev/null @@ -1,128 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_advection_diffusion_1d - - use self_dgmodel1d - use self_advection_diffusion_1d_t - use SELF_GPU - - implicit none - - type,extends(advection_diffusion_1d_t) :: advection_diffusion_1d - - contains - procedure :: setboundarycondition => setboundarycondition_advection_diffusion_1d - procedure :: setgradientboundarycondition => setgradientboundarycondition_advection_diffusion_1d - procedure :: boundaryflux => boundaryflux_advection_diffusion_1d - procedure :: fluxmethod => fluxmethod_advection_diffusion_1d - - endtype advection_diffusion_1d - - interface - subroutine setboundarycondition_advection_diffusion_1d_gpu(extboundary,boundary,nel,nvar) & - bind(c,name="setboundarycondition_advection_diffusion_1d_gpu") - use iso_c_binding - type(c_ptr),value :: extboundary,boundary - integer(c_int),value :: nel,nvar - endsubroutine setboundarycondition_advection_diffusion_1d_gpu - endinterface - - interface - subroutine fluxmethod_advection_diffusion_1d_gpu(solution,solutiongradient,flux,u,nu,ndof) & - bind(c,name="fluxmethod_advection_diffusion_1d_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: solution,solutiongradient,flux - real(c_prec),value :: u,nu - integer(c_int),value :: ndof - endsubroutine fluxmethod_advection_diffusion_1d_gpu - endinterface - - interface - subroutine boundaryflux_advection_diffusion_1d_gpu(fb,fextb,dfavg,flux,u,nu,ndof) & - bind(c,name="boundaryflux_advection_diffusion_1d_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: fb,fextb,dfavg,flux - real(c_prec),value :: u,nu - integer(c_int),value :: ndof - endsubroutine boundaryflux_advection_diffusion_1d_gpu - endinterface - -contains - - subroutine setboundarycondition_advection_diffusion_1d(this) - !! Boundary conditions are set to periodic boundary conditions - implicit none - class(advection_diffusion_1d),intent(inout) :: this - - call setboundarycondition_advection_diffusion_1d_gpu(this%solution%extboundary_gpu, & - this%solution%boundary_gpu,this%solution%nelem,this%solution%nvar) - - endsubroutine setboundarycondition_advection_diffusion_1d - - subroutine setgradientboundarycondition_advection_diffusion_1d(this) - !! Gradient boundary conditions are set to periodic boundary conditions - implicit none - class(advection_diffusion_1d),intent(inout) :: this - - call setboundarycondition_advection_diffusion_1d_gpu(this%solutiongradient%extboundary_gpu, & - this%solutiongradient%boundary_gpu,this%solution%nelem,this%solution%nvar) - - endsubroutine setgradientboundarycondition_advection_diffusion_1d - - subroutine fluxmethod_advection_diffusion_1d(this) - implicit none - class(advection_diffusion_1d),intent(inout) :: this - ! Local - integer :: ndof - - ndof = this%solution%nelem*this%solution%nvar*(this%solution%interp%N+1) - - call fluxmethod_advection_diffusion_1d_gpu(this%solution%interior_gpu, & - this%solutiongradient%interior_gpu,this%flux%interior_gpu, & - this%u,this%nu,ndof) - - endsubroutine fluxmethod_advection_diffusion_1d - - subroutine boundaryflux_advection_diffusion_1d(this) - ! this method uses an linear upwind solver for the - ! advective flux and the bassi-rebay method for the - ! diffusive fluxes - implicit none - class(advection_diffusion_1d),intent(inout) :: this - ! Local - integer :: ndof - - ndof = this%solution%nelem*this%solution%nvar*2 - call boundaryflux_advection_diffusion_1d_gpu(this%solution%boundary_gpu, & - this%solution%extBoundary_gpu,this%solutionGradient%avgBoundary_gpu, & - this%flux%boundarynormal_gpu,this%u,this%nu,ndof) - - endsubroutine boundaryflux_advection_diffusion_1d - -endmodule self_advection_diffusion_1d diff --git a/src/gpu/SELF_advection_diffusion_2d.cpp b/src/gpu/SELF_advection_diffusion_2d.cpp deleted file mode 100644 index b8175724a..000000000 --- a/src/gpu/SELF_advection_diffusion_2d.cpp +++ /dev/null @@ -1,128 +0,0 @@ -#include "SELF_GPU_Macros.h" - - -__global__ void setboundarycondition_advection_diffusion_2d_gpukernel(real *extBoundary, real *boundary, int *sideInfo, int N, int nel, int nvar){ - - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - uint32_t ndof = (N+1)*4*nel; - - if(idof < ndof){ - uint32_t i = idof % (N+1); - uint32_t s1 = (idof/(N+1)) % 4; - uint32_t e1 = idof/(N+1)/4; - uint32_t e2 = sideInfo[INDEX3(2,s1,e1,5,4)]; - if( e2 == 0){ - uint32_t ivar = blockIdx.y; - extBoundary[SCB_2D_INDEX(i,s1,e1,ivar,N,nel)] = 0.0; - } - } -} - -extern "C" -{ - void setboundarycondition_advection_diffusion_2d_gpu(real *extBoundary, real *boundary, int *sideInfo, int N, int nel, int nvar){ - int threads_per_block = 256; - int ndof = (N+1)*4*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,nvar,1); - dim3 nthreads(threads_per_block,1,1); - - setboundarycondition_advection_diffusion_2d_gpukernel<<>>(extBoundary,boundary,sideInfo,N,nel,nvar); - } -} - -__global__ void setgradientboundarycondition_advection_diffusion_2d_gpukernel(real *extBoundary, real *boundary, int *sideInfo, int N, int nel, int nvar){ - - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - uint32_t ndof = (N+1)*4*nel; - - if(idof < ndof){ - uint32_t i = idof%(N+1); - uint32_t s1 = (idof/(N+1))%4; - uint32_t e1 = idof/(N+1)/4; - uint32_t e2 = sideInfo[INDEX3(2,s1,e1,5,4)]; - if( e2 == 0){ - uint32_t ivar = blockIdx.y; - uint32_t idir = blockIdx.z; - extBoundary[VEB_2D_INDEX(i,s1,e1,ivar,idir,N,nel,nvar)] = boundary[VEB_2D_INDEX(i,s1,e1,ivar,idir,N,nel,nvar)]; - } - } -} - -extern "C" -{ - void setgradientboundarycondition_advection_diffusion_2d_gpu(real *extBoundary, real *boundary, int *sideInfo, int N, int nel, int nvar){ - int threads_per_block = 256; - int ndof = (N+1)*4*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,nvar,2); - dim3 nthreads(threads_per_block,1,1); - - setgradientboundarycondition_advection_diffusion_2d_gpukernel<<>>(extBoundary,boundary,sideInfo,N,nel,nvar); - } -} - -__global__ void fluxmethod_advection_diffusion_2d_gpukernel(real *solution, real *solutiongradient, real *flux, real u, real v, real nu, int ndof){ - uint32_t i = threadIdx.x + blockIdx.x*blockDim.x; - - if( i < ndof ){ - flux[i] = u*solution[i] - nu*solutiongradient[i]; - flux[i+ndof] = v*solution[i] - nu*solutiongradient[i+ndof]; - } - -} -extern "C" -{ - void fluxmethod_advection_diffusion_2d_gpu(real *solution, real *solutiongradient, real *flux, real u, real v, real nu, int N, int nel, int nvar){ - int ndof = (N+1)*(N+1)*nel*nvar; - int threads_per_block = 256; - int nblocks_x = ndof/threads_per_block +1; - fluxmethod_advection_diffusion_2d_gpukernel<<>>(solution,solutiongradient,flux,u,v,nu,ndof); - } - -} - -__global__ void boundaryflux_advection_diffusion_2d_gpukernel(real *fb, real *fextb, real *dfavg, real *nhat, real *nscale, real *flux, real u, real v, real nu, int N, int nel, int nvar){ - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - uint32_t ndof = (N+1)*4*nel; - - if( idof < ndof ){ - - uint32_t i = idof % (N+1); - uint32_t j = (idof/(N+1)) % 4; - uint32_t iel = idof/(N+1)/4; - uint32_t ivar = blockIdx.y; - - real nx = nhat[VEB_2D_INDEX(i,j,iel,0,0,N,nel,1)]; - real ny = nhat[VEB_2D_INDEX(i,j,iel,0,1,N,nel,1)]; - - real un = u*nx+v*ny; - - real dfdn = dfavg[VEB_2D_INDEX(i,j,iel,ivar,0,N,nel,nvar)]*nx+ - dfavg[VEB_2D_INDEX(i,j,iel,ivar,1,N,nel,nvar)]*ny; - - real nmag = nscale[SCB_2D_INDEX(i,j,iel,0,N,nel)]; - - flux[idof+ivar*ndof] = (0.5*(un*(fb[idof+ivar*ndof]+fextb[idof+ivar*ndof])+ - fabsf(un)*(fb[idof+ivar*ndof]-fextb[idof+ivar*ndof]))- - nu*dfdn)*nmag; - } - -} -extern "C" -{ - void boundaryflux_advection_diffusion_2d_gpu(real *fb, real *fextb, real *dfavg, real *nhat, real *nscale, real *flux, real u, real v, real nu, int N, int nel, int nvar){ - int threads_per_block = 256; - uint32_t ndof = (N+1)*4*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,nvar,1); - dim3 nthreads(threads_per_block,1,1); - - boundaryflux_advection_diffusion_2d_gpukernel<<>>(fb,fextb,dfavg,nhat,nscale,flux,u,v,nu,N,nel,nvar); - } - -} - diff --git a/src/gpu/SELF_advection_diffusion_2d.f90 b/src/gpu/SELF_advection_diffusion_2d.f90 deleted file mode 100644 index 681ddafe4..000000000 --- a/src/gpu/SELF_advection_diffusion_2d.f90 +++ /dev/null @@ -1,134 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_advection_diffusion_2d - - use self_advection_diffusion_2d_t - - implicit none - - type,extends(advection_diffusion_2d_t) :: advection_diffusion_2d - - contains - procedure :: setboundarycondition => setboundarycondition_advection_diffusion_2d - procedure :: setgradientboundarycondition => setgradientboundarycondition_advection_diffusion_2d - procedure :: boundaryflux => boundaryflux_advection_diffusion_2d - procedure :: fluxmethod => fluxmethod_advection_diffusion_2d - - endtype advection_diffusion_2d - - interface - subroutine setboundarycondition_advection_diffusion_2d_gpu(extboundary,boundary,sideinfo,N,nel,nvar) & - bind(c,name="setboundarycondition_advection_diffusion_2d_gpu") - use iso_c_binding - type(c_ptr),value :: extboundary,boundary,sideinfo - integer(c_int),value :: N,nel,nvar - endsubroutine setboundarycondition_advection_diffusion_2d_gpu - endinterface - - interface - subroutine setgradientboundarycondition_advection_diffusion_2d_gpu(extboundary,boundary,sideinfo,N,nel,nvar) & - bind(c,name="setgradientboundarycondition_advection_diffusion_2d_gpu") - use iso_c_binding - type(c_ptr),value :: extboundary,boundary,sideinfo - integer(c_int),value :: N,nel,nvar - endsubroutine setgradientboundarycondition_advection_diffusion_2d_gpu - endinterface - - interface - subroutine fluxmethod_advection_diffusion_2d_gpu(solution,solutiongradient,flux,u,v,nu,N,nel,nvar) & - bind(c,name="fluxmethod_advection_diffusion_2d_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: solution,solutiongradient,flux - real(c_prec),value :: u,v,nu - integer(c_int),value :: N,nel,nvar - endsubroutine fluxmethod_advection_diffusion_2d_gpu - endinterface - - interface - subroutine boundaryflux_advection_diffusion_2d_gpu(fb,fextb,dfavg,nhat,nscale,flux,u,v,nu,N,nel,nvar) & - bind(c,name="boundaryflux_advection_diffusion_2d_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: fb,fextb,dfavg,flux,nhat,nscale - real(c_prec),value :: u,v,nu - integer(c_int),value :: N,nel,nvar - endsubroutine boundaryflux_advection_diffusion_2d_gpu - endinterface - -contains - - subroutine setboundarycondition_advection_diffusion_2d(this) - !! Boundary conditions are set to periodic boundary conditions - implicit none - class(advection_diffusion_2d),intent(inout) :: this - - call setboundarycondition_advection_diffusion_2d_gpu(this%solution%extboundary_gpu, & - this%solution%boundary_gpu,this%mesh%sideInfo_gpu,this%solution%interp%N, & - this%solution%nelem,this%solution%nvar) - - endsubroutine setboundarycondition_advection_diffusion_2d - - subroutine setgradientboundarycondition_advection_diffusion_2d(this) - !! Gradient boundary conditions are set to periodic boundary conditions - implicit none - class(advection_diffusion_2d),intent(inout) :: this - - call setgradientboundarycondition_advection_diffusion_2d_gpu( & - this%solutiongradient%extboundary_gpu, & - this%solutiongradient%boundary_gpu,this%mesh%sideInfo_gpu, & - this%solution%interp%N,this%solution%nelem,this%solution%nvar) - - endsubroutine setgradientboundarycondition_advection_diffusion_2d - - subroutine fluxmethod_advection_diffusion_2d(this) - implicit none - class(advection_diffusion_2d),intent(inout) :: this - - call fluxmethod_advection_diffusion_2d_gpu(this%solution%interior_gpu, & - this%solutiongradient%interior_gpu,this%flux%interior_gpu, & - this%u,this%v,this%nu,this%solution%interp%N,this%solution%nelem, & - this%solution%nvar) - - endsubroutine fluxmethod_advection_diffusion_2d - - subroutine boundaryflux_advection_diffusion_2d(this) - ! this method uses an linear upwind solver for the - ! advective flux and the bassi-rebay method for the - ! diffusive fluxes - implicit none - class(advection_diffusion_2d),intent(inout) :: this - - call boundaryflux_advection_diffusion_2d_gpu(this%solution%boundary_gpu, & - this%solution%extBoundary_gpu,this%solutionGradient%avgBoundary_gpu, & - this%geometry%nhat%boundary_gpu,this%geometry%nscale%boundary_gpu, & - this%flux%boundarynormal_gpu,this%u,this%v,this%nu,this%solution%interp%N, & - this%solution%nelem,this%solution%nvar) - - endsubroutine boundaryflux_advection_diffusion_2d - -endmodule self_advection_diffusion_2d diff --git a/src/gpu/SELF_advection_diffusion_3d.cpp b/src/gpu/SELF_advection_diffusion_3d.cpp deleted file mode 100644 index daea4294e..000000000 --- a/src/gpu/SELF_advection_diffusion_3d.cpp +++ /dev/null @@ -1,134 +0,0 @@ -#include "SELF_GPU_Macros.h" - - -__global__ void setboundarycondition_advection_diffusion_3d_gpukernel(real *extBoundary, real *boundary, int *sideInfo, int N, int nel, int nvar){ - - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - uint32_t ndof = (N+1)*(N+1)*6*nel; - - if(idof < ndof){ - uint32_t i = idof % (N+1); - uint32_t j = (idof/(N+1)) % (N+1); - uint32_t s1 = (idof/(N+1)/(N+1)) % 6; - uint32_t e1 = idof/(N+1)/(N+1)/6; - uint32_t e2 = sideInfo[INDEX3(2,s1,e1,5,6)]; - if( e2 == 0){ - uint32_t ivar = blockIdx.y; - extBoundary[SCB_3D_INDEX(i,j,s1,e1,ivar,N,nel)] = 0.0; - } - } -} - -extern "C" -{ - void setboundarycondition_advection_diffusion_3d_gpu(real *extBoundary, real *boundary, int *sideInfo, int N, int nel, int nvar){ - int threads_per_block = 256; - int ndof = (N+1)*(N+1)*6*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,nvar,1); - dim3 nthreads(threads_per_block,1,1); - - setboundarycondition_advection_diffusion_3d_gpukernel<<>>(extBoundary,boundary,sideInfo,N,nel,nvar); - } -} - -__global__ void setgradientboundarycondition_advection_diffusion_3d_gpukernel(real *extBoundary, real *boundary, int *sideInfo, int N, int nel, int nvar){ - - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - uint32_t ndof = (N+1)*(N+1)*6*nel; - - if(idof < ndof){ - uint32_t i = idof % (N+1); - uint32_t j = (idof/(N+1)) % (N+1); - uint32_t s1 = (idof/(N+1)/(N+1)) % 6; - uint32_t e1 = idof/(N+1)/(N+1)/6; - uint32_t e2 = sideInfo[INDEX3(2,s1,e1,5,6)]; - if( e2 == 0){ - uint32_t ivar = blockIdx.y; - uint32_t idir = blockIdx.z; - extBoundary[VEB_3D_INDEX(i,j,s1,e1,ivar,idir,N,nel,nvar)] = boundary[VEB_3D_INDEX(i,j,s1,e1,ivar,idir,N,nel,nvar)]; - } - } -} - -extern "C" -{ - void setgradientboundarycondition_advection_diffusion_3d_gpu(real *extBoundary, real *boundary, int *sideInfo, int N, int nel, int nvar){ - int threads_per_block = 256; - int ndof = (N+1)*(N+1)*6*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,nvar,3); - dim3 nthreads(threads_per_block,1,1); - - setgradientboundarycondition_advection_diffusion_3d_gpukernel<<>>(extBoundary,boundary,sideInfo,N,nel,nvar); - } -} - -__global__ void fluxmethod_advection_diffusion_3d_gpukernel(real *solution, real *solutiongradient, real *flux, real u, real v, real w, real nu, int ndof){ - uint32_t i = threadIdx.x + blockIdx.x*blockDim.x; - - if( i < ndof ){ - flux[i] = u*solution[i] - nu*solutiongradient[i]; - flux[i+ndof] = v*solution[i] - nu*solutiongradient[i+ndof]; - flux[i+2*ndof] = w*solution[i] - nu*solutiongradient[i+2*ndof]; - } - -} -extern "C" -{ - void fluxmethod_advection_diffusion_3d_gpu(real *solution, real *solutiongradient, real *flux, real u, real v, real w, real nu, int N, int nel, int nvar){ - int ndof = (N+1)*(N+1)*(N+1)*nel*nvar; - int threads_per_block = 256; - int nblocks_x = ndof/threads_per_block +1; - fluxmethod_advection_diffusion_3d_gpukernel<<>>(solution,solutiongradient,flux,u,v,w,nu,ndof); - } - -} - -__global__ void boundaryflux_advection_diffusion_3d_gpukernel(real *fb, real *fextb, real *dfavg, real *nhat, real *nscale, real *flux, real u, real v, real w, real nu, int N, int nel, int nvar){ - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - uint32_t ndof = (N+1)*(N+1)*6*nel; - - if( idof < ndof ){ - - uint32_t i = idof % (N+1); - uint32_t j = (idof/(N+1)) % (N+1); - uint32_t k = (idof/(N+1)/(N+1)) % 6; - uint32_t iel = idof/(N+1)/(N+1)/6; - uint32_t ivar = blockIdx.y; - - real nx = nhat[VEB_3D_INDEX(i,j,k,iel,0,0,N,nel,1)]; - real ny = nhat[VEB_3D_INDEX(i,j,k,iel,0,1,N,nel,1)]; - real nz = nhat[VEB_3D_INDEX(i,j,k,iel,0,2,N,nel,1)]; - - real un = u*nx+v*ny+w*nz; - - real dfdn = dfavg[VEB_3D_INDEX(i,j,k,iel,ivar,0,N,nel,nvar)]*nx+ - dfavg[VEB_3D_INDEX(i,j,k,iel,ivar,1,N,nel,nvar)]*ny+ - dfavg[VEB_3D_INDEX(i,j,k,iel,ivar,2,N,nel,nvar)]*nz; - - real nmag = nscale[SCB_3D_INDEX(i,j,k,iel,0,N,nel)]; - - flux[idof+ivar*ndof] = (0.5*(un*(fb[idof+ivar*ndof]+fextb[idof+ivar*ndof])+ - fabsf(un)*(fb[idof+ivar*ndof]-fextb[idof+ivar*ndof]))- - nu*dfdn)*nmag; - } - -} -extern "C" -{ - void boundaryflux_advection_diffusion_3d_gpu(real *fb, real *fextb, real *dfavg, real *nhat, real *nscale, real *flux, real u, real v, real w, real nu, int N, int nel, int nvar){ - int threads_per_block = 256; - uint32_t ndof = (N+1)*(N+1)*6*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,nvar,1); - dim3 nthreads(threads_per_block,1,1); - - boundaryflux_advection_diffusion_3d_gpukernel<<>>(fb,fextb,dfavg,nhat,nscale,flux,u,v,w,nu,N,nel,nvar); - } - -} - diff --git a/src/gpu/SELF_advection_diffusion_3d.f90 b/src/gpu/SELF_advection_diffusion_3d.f90 deleted file mode 100644 index c470a12cd..000000000 --- a/src/gpu/SELF_advection_diffusion_3d.f90 +++ /dev/null @@ -1,135 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_advection_diffusion_3d - - use self_advection_diffusion_3d_t - - implicit none - - type,extends(advection_diffusion_3d_t) :: advection_diffusion_3d - contains - procedure :: setboundarycondition => setboundarycondition_advection_diffusion_3d - procedure :: setgradientboundarycondition => setgradientboundarycondition_advection_diffusion_3d - procedure :: boundaryflux => boundaryflux_advection_diffusion_3d - procedure :: fluxmethod => fluxmethod_advection_diffusion_3d - - endtype advection_diffusion_3d - - interface - subroutine setboundarycondition_advection_diffusion_3d_gpu(extboundary,boundary,sideinfo,N,nel,nvar) & - bind(c,name="setboundarycondition_advection_diffusion_3d_gpu") - use iso_c_binding - type(c_ptr),value :: extboundary,boundary,sideinfo - integer(c_int),value :: N,nel,nvar - endsubroutine setboundarycondition_advection_diffusion_3d_gpu - endinterface - - interface - subroutine setgradientboundarycondition_advection_diffusion_3d_gpu(extboundary,boundary,sideinfo,N,nel,nvar) & - bind(c,name="setgradientboundarycondition_advection_diffusion_3d_gpu") - use iso_c_binding - type(c_ptr),value :: extboundary,boundary,sideinfo - integer(c_int),value :: N,nel,nvar - endsubroutine setgradientboundarycondition_advection_diffusion_3d_gpu - endinterface - - interface - subroutine fluxmethod_advection_diffusion_3d_gpu(solution,solutiongradient,flux,u,v,w,nu,N,nel,nvar) & - bind(c,name="fluxmethod_advection_diffusion_3d_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: solution,solutiongradient,flux - real(c_prec),value :: u,v,w,nu - integer(c_int),value :: N,nel,nvar - endsubroutine fluxmethod_advection_diffusion_3d_gpu - endinterface - - interface - subroutine boundaryflux_advection_diffusion_3d_gpu(fb,fextb,dfavg,nhat,nscale,flux,u,v,w,nu,N,nel,nvar) & - bind(c,name="boundaryflux_advection_diffusion_3d_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: fb,fextb,dfavg,flux,nhat,nscale - real(c_prec),value :: u,v,w,nu - integer(c_int),value :: N,nel,nvar - endsubroutine boundaryflux_advection_diffusion_3d_gpu - endinterface - -contains - - subroutine setboundarycondition_advection_diffusion_3d(this) - !! Boundary conditions are set to periodic boundary conditions - implicit none - class(advection_diffusion_3d),intent(inout) :: this - - call setboundarycondition_advection_diffusion_3d_gpu(this%solution%extboundary_gpu, & - this%solution%boundary_gpu,this%mesh%sideInfo_gpu,this%solution%interp%N, & - this%solution%nelem,this%solution%nvar) - - endsubroutine setboundarycondition_advection_diffusion_3d - - subroutine setgradientboundarycondition_advection_diffusion_3d(this) - !! Gradient boundary conditions are set to periodic boundary conditions - implicit none - class(advection_diffusion_3d),intent(inout) :: this - - call setgradientboundarycondition_advection_diffusion_3d_gpu( & - this%solutiongradient%extboundary_gpu, & - this%solutiongradient%boundary_gpu,this%mesh%sideInfo_gpu, & - this%solution%interp%N,this%solution%nelem,this%solution%nvar) - - endsubroutine setgradientboundarycondition_advection_diffusion_3d - - subroutine fluxmethod_advection_diffusion_3d(this) - implicit none - class(advection_diffusion_3d),intent(inout) :: this - - call fluxmethod_advection_diffusion_3d_gpu(this%solution%interior_gpu, & - this%solutiongradient%interior_gpu,this%flux%interior_gpu, & - this%u,this%v,this%w,this%nu,this%solution%interp%N, & - this%solution%nelem, & - this%solution%nvar) - - endsubroutine fluxmethod_advection_diffusion_3d - - subroutine boundaryflux_advection_diffusion_3d(this) - ! this method uses an linear upwind solver for the - ! advective flux and the bassi-rebay method for the - ! diffusive fluxes - implicit none - class(advection_diffusion_3d),intent(inout) :: this - - call boundaryflux_advection_diffusion_3d_gpu(this%solution%boundary_gpu, & - this%solution%extBoundary_gpu,this%solutionGradient%avgBoundary_gpu, & - this%geometry%nhat%boundary_gpu,this%geometry%nscale%boundary_gpu, & - this%flux%boundarynormal_gpu,this%u,this%v,this%w, & - this%nu,this%solution%interp%N, & - this%solution%nelem,this%solution%nvar) - - endsubroutine boundaryflux_advection_diffusion_3d - -endmodule self_advection_diffusion_3d diff --git a/test/advection_diffusion_1d_euler.f90 b/test/advection_diffusion_1d_euler.f90 deleted file mode 100644 index 2bdceba42..000000000 --- a/test/advection_diffusion_1d_euler.f90 +++ /dev/null @@ -1,114 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_1d_euler - - use self_data - use self_advection_diffusion_1d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'euler' - integer,parameter :: nelem = 50 - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 1.0_prec ! velocity - 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.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(advection_diffusion_1d) :: modelobj - type(Lagrange),target :: interp - type(Mesh1D),target :: mesh - type(Geometry1D),target :: geometry - - ! Create a mesh using the built-in - ! uniform mesh generator. - ! The domain is set to x in [0,1] - ! We use `nelem` elements - call mesh%StructuredMesh(nElem=nelem, & - x=(/0.0_prec,1.0_prec/)) - - ! 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 - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 )/0.01 )') - call modelobj%solution%SetInteriorFromEquation(0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy ! Save the initial entropy - !Write the initial condition - call modelobj%WriteModel() - call modelobj%WriteTecplot() - call modelobj%IncrementIOCounter() - ! 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("advdiff1d-euler.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_1d_euler diff --git a/test/advection_diffusion_1d_euler_pickup.f90 b/test/advection_diffusion_1d_euler_pickup.f90 deleted file mode 100644 index bcf1531fe..000000000 --- a/test/advection_diffusion_1d_euler_pickup.f90 +++ /dev/null @@ -1,111 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_1d_euler - - use self_data - use self_advection_diffusion_1d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'euler' - integer,parameter :: nelem = 50 - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 1.0_prec ! velocity - 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.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(advection_diffusion_1d) :: modelobj - type(Lagrange),target :: interp - type(Mesh1D),target :: mesh - type(Geometry1D),target :: geometry - - ! Create a mesh using the built-in - ! uniform mesh generator. - ! The domain is set to x in [0,1] - ! We use `nelem` elements - call mesh%StructuredMesh(nElem=nelem, & - x=(/0.0_prec,1.0_prec/)) - - ! 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 - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition from a pickup file - call modelobj%ReadModel("advdiff1d-euler.pickup.h5") - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy ! Save the initial entropy - !Write the initial condition - call modelobj%WriteModel() - call modelobj%WriteTecplot() - call modelobj%IncrementIOCounter() - ! 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_1d_euler diff --git a/test/advection_diffusion_1d_rk2.f90 b/test/advection_diffusion_1d_rk2.f90 deleted file mode 100644 index f2109404e..000000000 --- a/test/advection_diffusion_1d_rk2.f90 +++ /dev/null @@ -1,108 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_1d_rk2 - - use self_data - use self_advection_diffusion_1d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk2' - integer,parameter :: nelem = 50 - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 1.0_prec ! velocity - 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 - integer,parameter :: stepsperio = 1000 - real(prec) :: e0,ef ! Initial and final entropy - type(advection_diffusion_1d) :: modelobj - type(Lagrange),target :: interp - type(Mesh1D),target :: mesh - type(Geometry1D),target :: geometry - - ! Create a mesh using the built-in - ! uniform mesh generator. - ! The domain is set to x in [0,1] - ! We use `nelem` elements - call mesh%StructuredMesh(nElem=nelem, & - x=(/0.0_prec,1.0_prec/)) - - ! 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 - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 )/0.01 )') - call modelobj%solution%SetInteriorFromEquation(0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy ! Save the initial 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_1d_rk2 diff --git a/test/advection_diffusion_1d_rk3.f90 b/test/advection_diffusion_1d_rk3.f90 deleted file mode 100644 index c94380f65..000000000 --- a/test/advection_diffusion_1d_rk3.f90 +++ /dev/null @@ -1,110 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_1d_rk3 - - use self_data - use self_advection_diffusion_1d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' - integer,parameter :: nelem = 50 - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 1.0_prec ! velocity - 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.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(advection_diffusion_1d) :: modelobj - type(Lagrange),target :: interp - type(Mesh1D),target :: mesh - type(Geometry1D),target :: geometry - - ! Create a mesh using the built-in - ! uniform mesh generator. - ! The domain is set to x in [0,1] - ! We use `nelem` elements - call mesh%StructuredMesh(nElem=nelem, & - x=(/0.0_prec,1.0_prec/)) - - ! 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 - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 )/0.01 )') - call modelobj%solution%SetInteriorFromEquation(0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy ! Save the initial entropy - !Write the initial condition - call modelobj%WriteModel() - call modelobj%WriteTecplot() - call modelobj%IncrementIOCounter() - ! 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_1d_rk3 diff --git a/test/advection_diffusion_1d_rk4.f90 b/test/advection_diffusion_1d_rk4.f90 deleted file mode 100644 index e86be5dc9..000000000 --- a/test/advection_diffusion_1d_rk4.f90 +++ /dev/null @@ -1,107 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_1d_rk4 - - use self_data - use self_advection_diffusion_1d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk4' - integer,parameter :: nelem = 50 - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 1.0_prec ! velocity - 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 - real(prec) :: e0,ef ! Initial and final entropy - type(advection_diffusion_1d) :: modelobj - type(Lagrange),target :: interp - type(Mesh1D),target :: mesh - type(Geometry1D),target :: geometry - - ! Create a mesh using the built-in - ! uniform mesh generator. - ! The domain is set to x in [0,1] - ! We use `nelem` elements - call mesh%StructuredMesh(nElem=nelem, & - x=(/0.0_prec,1.0_prec/)) - - ! 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 - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 )/0.01 )') - call modelobj%solution%SetInteriorFromEquation(0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy ! Save the initial 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_1d_rk4 diff --git a/test/advection_diffusion_2d_euler.f90 b/test/advection_diffusion_2d_euler.f90 deleted file mode 100644 index 1e3481874..000000000 --- a/test/advection_diffusion_2d_euler.f90 +++ /dev/null @@ -1,115 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_2d_euler - - use self_data - use self_advection_diffusion_2d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'euler' - 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 - - ! We create a domain decomposition. - - ! 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) - - ! 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 initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 + (y-0.5)^2 )/0.01 )') - call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) - - call modelobj%CalculateTendency() - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy - !Write the initial condition - call modelobj%WriteModel() - call modelobj%WriteTecplot() - call modelobj%IncrementIOCounter() - - ! 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 absmax greater than initial absmax! ",e0,ef - stop 1 - endif - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_2d_euler diff --git a/test/advection_diffusion_2d_rk2.f90 b/test/advection_diffusion_2d_rk2.f90 deleted file mode 100644 index 5c2783c03..000000000 --- a/test/advection_diffusion_2d_rk2.f90 +++ /dev/null @@ -1,106 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_2d_rk2 - - use self_data - use self_advection_diffusion_2d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk2' - 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 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 - !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) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = maxval(abs(modelobj%solution%interior)) - ! 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 = maxval(abs(modelobj%solution%interior)) - - 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() - -endprogram advection_diffusion_2d_rk2 diff --git a/test/advection_diffusion_2d_rk3.f90 b/test/advection_diffusion_2d_rk3.f90 deleted file mode 100644 index db061bcbf..000000000 --- a/test/advection_diffusion_2d_rk3.f90 +++ /dev/null @@ -1,107 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_2d_rk3 - - 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 - - ! 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) - - ! 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 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) - - 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.pickup.h5") - - 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() - -endprogram advection_diffusion_2d_rk3 diff --git a/test/advection_diffusion_2d_rk3_mpi.f90 b/test/advection_diffusion_2d_rk3_mpi.f90 deleted file mode 100644 index 5fa72b177..000000000 --- a/test/advection_diffusion_2d_rk3_mpi.f90 +++ /dev/null @@ -1,107 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_2d_rk3 - - 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 - - ! 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) - - ! 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 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) - - 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") - - 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() - -endprogram advection_diffusion_2d_rk3 diff --git a/test/advection_diffusion_2d_rk3_pickup.f90 b/test/advection_diffusion_2d_rk3_pickup.f90 deleted file mode 100644 index 2e22e1ad1..000000000 --- a/test/advection_diffusion_2d_rk3_pickup.f90 +++ /dev/null @@ -1,105 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_2d_rk3 - - 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 - - ! 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) - - ! 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 initial condition from pickup file - call modelobj%ReadModel("advdiff2d-rk3.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 absmax greater than initial absmax! ",e0,ef - stop 1 - endif - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -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 deleted file mode 100644 index 6f830bd39..000000000 --- a/test/advection_diffusion_2d_rk3_pickup_mpi.f90 +++ /dev/null @@ -1,105 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_2d_rk3 - - 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 - - ! 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) - - ! 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 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) - - 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 absmax greater than initial absmax! ",e0,ef - stop 1 - endif - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_2d_rk3 diff --git a/test/advection_diffusion_2d_rk4.f90 b/test/advection_diffusion_2d_rk4.f90 deleted file mode 100644 index 3b01f3dd4..000000000 --- a/test/advection_diffusion_2d_rk4.f90 +++ /dev/null @@ -1,106 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_2d_rk4 - - use self_data - use self_advection_diffusion_2d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk4' - 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 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 - !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) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = maxval(abs(modelobj%solution%interior)) - ! 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 = maxval(abs(modelobj%solution%interior)) - - 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() - -endprogram advection_diffusion_2d_rk4 diff --git a/test/advection_diffusion_3d_euler.f90 b/test/advection_diffusion_3d_euler.f90 deleted file mode 100644 index b87f98d51..000000000 --- a/test/advection_diffusion_3d_euler.f90 +++ /dev/null @@ -1,99 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_3d_euler - - use self_data - use self_advection_diffusion_3d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'euler' - 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 - - ! 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) - - ! 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) - - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_3d_euler diff --git a/test/advection_diffusion_3d_rk2.f90 b/test/advection_diffusion_3d_rk2.f90 deleted file mode 100644 index edc6b92c5..000000000 --- a/test/advection_diffusion_3d_rk2.f90 +++ /dev/null @@ -1,99 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_3d_rk2 - - use self_data - use self_advection_diffusion_3d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk2' - 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 - - ! 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) - - ! 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) - - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_3d_rk2 diff --git a/test/advection_diffusion_3d_rk3.f90 b/test/advection_diffusion_3d_rk3.f90 deleted file mode 100644 index d35c98754..000000000 --- a/test/advection_diffusion_3d_rk3.f90 +++ /dev/null @@ -1,111 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -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.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_mpi.f90 b/test/advection_diffusion_3d_rk3_mpi.f90 deleted file mode 100644 index 22479518b..000000000 --- a/test/advection_diffusion_3d_rk3_mpi.f90 +++ /dev/null @@ -1,111 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -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.f90 b/test/advection_diffusion_3d_rk3_pickup.f90 deleted file mode 100644 index 41789dc36..000000000 --- a/test/advection_diffusion_3d_rk3_pickup.f90 +++ /dev/null @@ -1,109 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -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.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/advection_diffusion_3d_rk3_pickup_mpi.f90 b/test/advection_diffusion_3d_rk3_pickup_mpi.f90 deleted file mode 100644 index 479a070a8..000000000 --- a/test/advection_diffusion_3d_rk3_pickup_mpi.f90 +++ /dev/null @@ -1,109 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -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/advection_diffusion_3d_rk4.f90 b/test/advection_diffusion_3d_rk4.f90 deleted file mode 100644 index 6bd7ef436..000000000 --- a/test/advection_diffusion_3d_rk4.f90 +++ /dev/null @@ -1,99 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_3d_rk4 - - use self_data - use self_advection_diffusion_3d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk4' - 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 - - ! 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) - - ! 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) - - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_3d_rk4 diff --git a/test/burgers1d_constant.f90 b/test/burgers1d_constant.f90 deleted file mode 100644 index 3cc5886f3..000000000 --- a/test/burgers1d_constant.f90 +++ /dev/null @@ -1,109 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program burgers1d_constant - - use self_data - use self_burgers1d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'euler' - integer,parameter :: nelem = 50 - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: nu = 0.01_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-5) ! 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(burgers1d) :: modelobj - type(Lagrange),target :: interp - type(Mesh1D),target :: mesh - type(Geometry1D),target :: geometry - - ! Create a mesh using the built-in - ! uniform mesh generator. - ! The domain is set to x in [0,1] - ! We use `nelem` elements - call mesh%StructuredMesh(nElem=nelem, & - x=(/0.0_prec,1.0_prec/)) - - ! 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 diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = 1.0') - call modelobj%solution%SetInteriorFromEquation(0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy ! Save the initial entropy - !Write the initial condition - call modelobj%WriteModel() - call modelobj%WriteTecplot() - call modelobj%IncrementIOCounter() - ! 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 burgers1d_constant diff --git a/test/burgers1d_prescribed.f90 b/test/burgers1d_prescribed.f90 deleted file mode 100644 index 9e3b16469..000000000 --- a/test/burgers1d_prescribed.f90 +++ /dev/null @@ -1,155 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program burgers1d_constant - - use self_data - use self_burgers1d - - implicit none - integer,parameter :: SELF_BC_PRESCRIBED = 1 ! Provide a parameter for tagging a prescribed boundary condition - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'euler' - integer,parameter :: nelem = 50 - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: nu = 0.01_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-5) ! 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(burgers1d) :: modelobj - type(Lagrange),target :: interp - type(Mesh1D),target :: mesh - type(Geometry1D),target :: geometry - - ! Create a mesh using the built-in - ! uniform mesh generator. - ! The domain is set to x in [0,1] - ! We use `nelem` elements - call mesh%StructuredMesh(nElem=nelem, & - x=(/0.0_prec,1.0_prec/)) - call mesh%ResetBoundaryConditionType(SELF_BC_PRESCRIBED,SELF_BC_PRESCRIBED) - ! 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. - - ! Register boundary conditions - call modelobj%boundaryconditions%RegisterBoundaryCondition(SELF_BC_PRESCRIBED,'prescribed',Burgers1d_prescribed) - call modelobj%boundaryconditions%RegisterBoundaryCondition(SELF_BC_PRESCRIBED,'prescribed',Burgers1d_gradient_prescribed) - - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = 1.0') - call modelobj%solution%SetInteriorFromEquation(0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy ! Save the initial entropy - !Write the initial condition - call modelobj%WriteModel() - call modelobj%WriteTecplot() - call modelobj%IncrementIOCounter() - ! 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() - -contains - pure function Burgers1d_prescribed(this,s,dsdx,x,t,nhat) result(extstate) - !! This function is called to set the boundary condition - !! for the Burgers1D model. The function is called - !! at the boundary nodes of the mesh. The function - !! returns the value of the state variable at the - !! boundary nodes. - use SELF_Constants,only:prec - use self_Burgers1D - implicit none - class(self_Burgers1D),intent(inout) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec),intent(in) :: dsdx(1:this%nvar,1:this%ndim) - real(prec),intent(in) :: x(1:this%ndim) - real(prec),intent(in) :: nhat(1:this%ndim) - real(prec),intent(in) :: t - real(prec) :: extstate(1:this%nvar) - - extstate(1:this%nvar) = 1.0_prec - - endfunction Burgers1d_prescribed - - pure function Burgers1d_gradient_prescribed(this,s,dsdx,x,t,nhat) result(extstate) - ! This function is used to set the gradient of the prescribed boundary condition - ! to zero. This is necessary for the prescribed boundary condition to work correctly. - use SELF_Constants,only:prec - use self_Burgers1D - implicit none - class(self_Burgers1D),intent(inout) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec),intent(in) :: dsdx(1:this%nvar,1:this%ndim) - real(prec),intent(in) :: x(1:this%ndim) - real(prec),intent(in) :: nhat(1:this%ndim) - real(prec),intent(in) :: t - real(prec) :: extstate(1:this%nvar,1:this%ndim) - - extstate(1:this%nvar,1:this%ndim) = 0.0_prec - - endfunction Burgers1d_gradient_prescribed - -endprogram burgers1d_constant diff --git a/test/linear_shallow_water_2d_constant.f90 b/test/linear_shallow_water_2d_constant.f90 deleted file mode 100644 index 5f896748c..000000000 --- a/test/linear_shallow_water_2d_constant.f90 +++ /dev/null @@ -1,118 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program LinearShallowWater2D_constant - use self_data - use self_LinearShallowWater2D - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' - - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: H = 1.0_prec ! uniform resting depth - real(prec),parameter :: g = 9.8_prec ! acceleration due to gravity - 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(LinearShallowWater2D) :: modelobj - type(Lagrange),target :: interp - type(Mesh2D),target :: mesh - integer :: bcids(1:4) - type(SEMQuad),target :: geometry - character(LEN=255) :: WORKSPACE - - ! Set boundary conditions - bcids(1:4) = [SELF_BC_PRESCRIBED, & ! South - SELF_BC_PRESCRIBED, & ! East - SELF_BC_PRESCRIBED, & ! North - SELF_BC_PRESCRIBED] ! West - - ! Create a uniform block mesh - call mesh%StructuredMesh(5,5,2,2,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) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - - ! Set the resting surface height and gravity - modelobj%H = H - modelobj%g = g - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = 1.0') - call modelobj%solution%SetEquation(2,'f = 1.0') - call modelobj%solution%SetEquation(3,'f = 1.0') - call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) - - call modelobj%CalculateTendency() - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - e0 = modelobj%entropy - - !Write the initial condition - call modelobj%WriteModel() - call modelobj%WriteTecplot() - call modelobj%IncrementIOCounter() - - ! 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 absmax greater than initial absmax! ",e0,ef - stop 1 - endif - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram LinearShallowWater2D_constant diff --git a/test/linear_shallow_water_2d_nonormalflow.f90 b/test/linear_shallow_water_2d_nonormalflow.f90 deleted file mode 100644 index e25e7020c..000000000 --- a/test/linear_shallow_water_2d_nonormalflow.f90 +++ /dev/null @@ -1,105 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program LinearShallowWater2D_nonormalflow - use self_data - use self_LinearShallowWater2D - use self_mesh_2d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' - - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: H = 1.0_prec ! uniform resting depth - real(prec),parameter :: g = 1.0_prec ! acceleration due to gravity - real(prec),parameter :: dt = 0.5_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(LinearShallowWater2D) :: modelobj - type(Lagrange),target :: interp - integer :: bcids(1:4) - type(Mesh2D),target :: mesh - type(SEMQuad),target :: geometry - character(LEN=255) :: WORKSPACE - - ! Set no normal flow boundary conditions - bcids(1:4) = [SELF_BC_NONORMALFLOW, & ! South - SELF_BC_NONORMALFLOW, & ! East - SELF_BC_NONORMALFLOW, & ! North - SELF_BC_NONORMALFLOW] ! West - - ! Create a uniform block mesh - call mesh%StructuredMesh(5,5,2,2,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) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - - ! Set the resting surface height and gravity - modelobj%H = H - modelobj%g = g - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = 0') - call modelobj%solution%SetEquation(2,'f = 0') - call modelobj%solution%SetEquation(3,'f = 0.001*exp( -( (x-0.5)^2 + (y-0.5)^2 )/0.01 )') - call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) - - call modelobj%CalculateEntropy() - 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) - - ef = modelobj%entropy - - if(ef > e0) then - ! print*,"Final entropy not a finite number.",e0,ef - 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 LinearShallowWater2D_nonormalflow diff --git a/test/linear_shallow_water_2d_radiation.f90 b/test/linear_shallow_water_2d_radiation.f90 deleted file mode 100644 index d037181a5..000000000 --- a/test/linear_shallow_water_2d_radiation.f90 +++ /dev/null @@ -1,105 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program LinearShallowWater2D_nonormalflow - use self_data - use self_LinearShallowWater2D - use self_mesh_2d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' - - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: H = 1.0_prec ! uniform resting depth - real(prec),parameter :: g = 1.0_prec ! acceleration due to gravity - real(prec),parameter :: dt = 0.5_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(LinearShallowWater2D) :: modelobj - type(Lagrange),target :: interp - integer :: bcids(1:4) - type(Mesh2D),target :: mesh - type(SEMQuad),target :: geometry - character(LEN=255) :: WORKSPACE - - ! Set radiation boundary conditions - bcids(1:4) = [SELF_BC_RADIATION, & ! South - SELF_BC_RADIATION, & ! East - SELF_BC_RADIATION, & ! North - SELF_BC_RADIATION] ! West - - ! Create a uniform block mesh - call mesh%StructuredMesh(5,5,2,2,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) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - - ! Set the resting surface height and gravity - modelobj%H = H - modelobj%g = g - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = 0') - call modelobj%solution%SetEquation(2,'f = 0') - call modelobj%solution%SetEquation(3,'f = 0.001*exp( -( (x-0.5)^2 + (y-0.5)^2 )/0.01 )') - call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) - - call modelobj%CalculateEntropy() - 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) - - ef = modelobj%entropy - - if(ef > e0) then - ! print*,"Final entropy not a finite number.",e0,ef - 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 LinearShallowWater2D_nonormalflow From ecfb4c78cfdd69c3d11acaaaf4956a1780019f56 Mon Sep 17 00:00:00 2001 From: Joe Schoonover Date: Sun, 5 Oct 2025 03:37:06 -0400 Subject: [PATCH 17/17] Remove distinction between gradient and state bc list * We'll set this up to where a state and a gradient boundary condition can be associated with a boundary condition item --- docs/MeshGeneration/BoundaryConditions.md | 5 ++ src/SELF_BoundaryConditions.f90 | 105 +++++++++------------- src/SELF_DGModel2D_t.f90 | 40 +++++---- src/SELF_DGModel3D_t.f90 | 53 +++++------ src/SELF_Mesh.f90 | 25 +++--- src/SELF_Mesh_1D.f90 | 30 ++----- src/SELF_Mesh_2D_t.f90 | 69 ++++++++++---- src/SELF_Model.f90 | 1 - 8 files changed, 169 insertions(+), 159 deletions(-) create mode 100644 docs/MeshGeneration/BoundaryConditions.md diff --git a/docs/MeshGeneration/BoundaryConditions.md b/docs/MeshGeneration/BoundaryConditions.md new file mode 100644 index 000000000..2bb28a51c --- /dev/null +++ b/docs/MeshGeneration/BoundaryConditions.md @@ -0,0 +1,5 @@ +# Boundary Conditions + +In most mesh generation software, you are given the ability to align a name (string/character) and an integer id with each face, node, or edge that lies on a physical boundary. This information is often used in physical modeling software, like SELF, to implement the appropriate boundary conditions for your model. SELF provides a flexible framework for mapping boundary condition names and integer ids to procedures that you can implement for specific boundary conditions. This section of the documentation provides an overview of how you can register custom boundary conditions for a model built with SELF. Additionally we'll cover how you will want to register boundary conditions in a way that is consistent with the meshes that you create in other external software (e.g. HOHQMesh). + +## How boundary conditions are registered in SELF diff --git a/src/SELF_BoundaryConditions.f90 b/src/SELF_BoundaryConditions.f90 index 73dbd6f56..598ebd731 100644 --- a/src/SELF_BoundaryConditions.f90 +++ b/src/SELF_BoundaryConditions.f90 @@ -28,29 +28,26 @@ module SELF_BoundaryConditions use SELF_SupportRoutines use SELF_Metadata + use SELF_Model implicit none integer,parameter :: SELF_BCNAME_LENGTH = 32 - enum,bind(c) - enumerator :: SELF_BC_STATE_CONTEXT = 0 - enumerator :: SELF_BC_GRADIENT_CONTEXT = 1 - endenum - - type SELF_BoundaryCondition - procedure(SELF_BCFunction),pointer :: bcFunction => null() ! For state BCs - procedure(SELF_BCgFunction),pointer :: bcgFunction => null() ! For gradient BCs + type BoundaryCondition + procedure(SELF_bcMethod),pointer :: bcMethod => null() ! integer :: bcid character(SELF_BCNAME_LENGTH) :: bcname - integer :: context_enum - type(SELF_BoundaryCondition),pointer :: next => null() - type(SELF_BoundaryCondition),pointer :: prev => null() - endtype SELF_BoundaryCondition - - type SELF_BoundaryConditionList - type(SELF_BoundaryCondition),pointer :: current => null() - type(SELF_BoundaryCondition),pointer :: head => null() - type(SELF_BoundaryCondition),pointer :: tail => null() + integer :: nBoundaries ! Number of boundaries this BC applies to + integer,allocatable :: elements(:) ! List of elements this BC applies to + integer,allocatable :: sides(:) ! List of local sides this BC applies to + type(BoundaryCondition),pointer :: next => null() + type(BoundaryCondition),pointer :: prev => null() + endtype BoundaryCondition + + type BoundaryConditionList + type(BoundaryCondition),pointer :: current => null() + type(BoundaryCondition),pointer :: head => null() + type(BoundaryCondition),pointer :: tail => null() integer :: nbc contains @@ -59,42 +56,20 @@ module SELF_BoundaryConditions procedure,private :: MoveNext procedure,private :: rewind procedure,public :: GetBCForID - generic,public :: RegisterBoundaryCondition => RegisterBCFunction,RegisterBCGFunction - procedure,private :: RegisterBCFunction - procedure,private :: RegisterBCGFunction - - endtype SELF_BoundaryConditionList + generic,public :: RegisterBoundaryCondition => RegisterbcMethod + procedure,private :: RegisterbcMethod - interface - pure function SELF_BCFunction(this,s,dsdx,x,t,nhat,nvar,ndim) result(extstate) - use SELF_Constants,only:prec - import SELF_BoundaryCondition - implicit none - class(SELF_BoundaryCondition),intent(in) :: this - integer,intent(in) :: nvar,ndim - real(prec),intent(in) :: s(1:nvar) - real(prec),intent(in) :: dsdx(1:nvar,1:ndim) - real(prec),intent(in) :: x(1:ndim) - real(prec),intent(in) :: nhat(1:ndim) - real(prec),intent(in) :: t - real(prec) :: extstate(1:nvar) - endfunction SELF_BCFunction - endinterface + endtype BoundaryConditionList interface - pure function SELF_BCGFunction(this,s,dsdx,x,t,nhat,nvar,ndim) result(extstate) + subroutine SELF_bcMethod(this,mymodel) use SELF_Constants,only:prec - import SELF_BoundaryCondition + use SELF_Model,only:Model + import BoundaryCondition implicit none - class(SELF_BoundaryCondition),intent(in) :: this - integer,intent(in) :: nvar,ndim - real(prec),intent(in) :: s(1:nvar) - real(prec),intent(in) :: dsdx(1:nvar,1:ndim) - real(prec),intent(in) :: x(1:ndim) - real(prec),intent(in) :: nhat(1:ndim) - real(prec),intent(in) :: t - real(prec) :: extstate(1:nvar,1:ndim) - endfunction SELF_BCGFunction + class(BoundaryCondition),intent(in) :: this + class(Model),intent(inout) :: mymodel + endsubroutine SELF_bcMethod endinterface contains @@ -104,7 +79,7 @@ pure function SELF_BCGFunction(this,s,dsdx,x,t,nhat,nvar,ndim) result(extstate) ! ////////////////////////////////////////////// ! subroutine Init_BCList(list) - class(SELF_BoundaryConditionList),intent(inout) :: list + class(BoundaryConditionList),intent(inout) :: list list%head => null() list%tail => null() list%current => null() @@ -112,13 +87,15 @@ subroutine Init_BCList(list) endsubroutine Init_BCList subroutine Free_BCList(list) - class(SELF_BoundaryConditionList),intent(inout) :: list + class(BoundaryConditionList),intent(inout) :: list type(SELF_BoundaryCondition),pointer :: node,next_node node => list%head do while(associated(node)) next_node => node%next - nullify(node%bcFunction) + nullify(node%bcMethod) + if allocated(node%elements) deallocate(node%elements) + if allocated(node%sides) deallocate(node%sides) deallocate(node) node => next_node enddo @@ -127,7 +104,7 @@ subroutine Free_BCList(list) endsubroutine Free_BCList subroutine MoveNext(list) - class(SELF_BoundaryConditionList),intent(inout) :: list + class(BoundaryConditionList),intent(inout) :: list if(associated(list%current%next)) then list%current => list%current%next else @@ -136,14 +113,14 @@ subroutine MoveNext(list) endsubroutine MoveNext subroutine rewind(list) - class(SELF_BoundaryConditionList),intent(inout) :: list + class(BoundaryConditionList),intent(inout) :: list list%current => list%head endsubroutine rewind function GetBCForID(list,bcid) result(node) !! This function returns the node associated with the given bcid !! and context. If the bcid is not found, a null pointer is returned. - class(SELF_BoundaryConditionList),intent(in) :: list + class(BoundaryConditionList),intent(in) :: list integer,intent(in) :: bcid type(SELF_BoundaryCondition),pointer :: node @@ -161,16 +138,17 @@ function GetBCForID(list,bcid) result(node) endfunction GetBCForID - subroutine RegisterBCFunction(list,bcid,bcname,bcfunc) + subroutine RegisterbcMethod(list,bcid,bcname,bcfunc,nboundaries) !! Register a boundary condition function !! with the given bcid and bcname. If the bcid !! is already registered, the function is updated. !! The function is expected to be a pointer to a - !! SELF_BCFunction type. - class(SELF_BoundaryConditionList),intent(inout) :: list + !! SELF_bcMethod type. + class(BoundaryConditionList),intent(inout) :: list integer,intent(in) :: bcid character(*),intent(in) :: bcname - procedure(SELF_BCFunction),pointer,intent(in) :: bcfunc + procedure(SELF_bcMethod),pointer,intent(in) :: bcfunc + integer,intent(in) :: nboundaries ! Local type(SELF_BoundaryCondition),pointer :: bc @@ -180,12 +158,15 @@ subroutine RegisterBCFunction(list,bcid,bcname,bcfunc) ! If the bcid is already registered, we do not register it again print*,"Boundary condition with ID ",bcid," is already registered." print*,"Assigning new function to existing BC" - bc%bcFunction => bcfunc + bc%bcMethod => bcfunc else allocate(bc) bc%bcid = bcid bc%bcname = trim(bcname) - bc%bcFunction => bcfunc + bc%bcMethod => bcfunc + allocate(bc%elements(1:nboundaries)) + allocate(bc%sides(1:nboundaries)) + bc%nBoundaries = nboundaries nullify(bc%next) nullify(bc%prev) @@ -206,7 +187,7 @@ subroutine RegisterBCFunction(list,bcid,bcname,bcfunc) endif - endsubroutine RegisterBCFunction + endsubroutine RegisterbcMethod subroutine RegisterBCGFunction(list,bcid,bcname,bcgfunc) !! Register a boundary condition function @@ -214,7 +195,7 @@ subroutine RegisterBCGFunction(list,bcid,bcname,bcgfunc) !! is already registered, the function is updated. !! The function is expected to be a pointer to a !! SELF_BCGFunction type. - class(SELF_BoundaryConditionList),intent(inout) :: list + class(BoundaryConditionList),intent(inout) :: list integer,intent(in) :: bcid character(*),intent(in) :: bcname procedure(SELF_BCGFunction),pointer,intent(in) :: bcgfunc diff --git a/src/SELF_DGModel2D_t.f90 b/src/SELF_DGModel2D_t.f90 index 6d2064afd..91944c49b 100644 --- a/src/SELF_DGModel2D_t.f90 +++ b/src/SELF_DGModel2D_t.f90 @@ -458,15 +458,17 @@ subroutine setboundarycondition_DGModel2D_t(this) e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID if(e2 == 0) then - bc = this%boundaryconditions%GetNodeForBCID(bcid) - ! Get the boundary normals on cell edges from the mesh geometry - nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) - x = this%geometry%x%boundary(i,j,iEl,1,1:2) - s = this%solution%boundary(i,j,iEl,1:this%nvar) - dsdx = this%solutiongradient%boundary(i,j,iEl,1:this%nvar,1:2) - - this%solution%extBoundary(i,j,iEl,1:this%nvar) = & - bc%bcFunc(s,dsdx,x,this%t,nhat) + bc => this%boundaryconditions%GetBCForID(bcid) + do concurrent(i=1:this%solution%N+1) + ! Get the boundary normals on cell edges from the mesh geometry + nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) + x = this%geometry%x%boundary(i,j,iEl,1,1:2) + s = this%solution%boundary(i,j,iEl,1:this%nvar) + dsdx = this%solutiongradient%boundary(i,j,iEl,1:this%nvar,1:2) + + this%solution%extBoundary(i,j,iEl,1:this%nvar) = & + bc%bcFunction(s,dsdx,x,this%t,nhat,this%nvar,2) + enddo endif enddo @@ -491,15 +493,17 @@ subroutine setgradientboundarycondition_DGModel2D_t(this) e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID if(e2 == 0) then - bc = this%boundaryconditions%GetNodeForBCID(bcid) - ! Get the boundary normals on cell edges from the mesh geometry - nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) - x = this%geometry%x%boundary(i,j,iEl,1,1:2) - s = this%solution%boundary(i,j,iEl,1:this%nvar) - dsdx = this%solutiongradient%boundary(i,j,iEl,1:this%nvar,1:2) - - this%solution%extBoundary(i,j,iEl,1:this%nvar) = & - bc%bcgFunc(s,dsdx,x,this%t,nhat) + bc => this%boundaryconditions%GetBCForID(bcid) + do concurrent(i=1:this%solution%N+1) + ! Get the boundary normals on cell edges from the mesh geometry + nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) + x = this%geometry%x%boundary(i,j,iEl,1,1:2) + s = this%solution%boundary(i,j,iEl,1:this%nvar) + dsdx = this%solutiongradient%boundary(i,j,iEl,1:this%nvar,1:2) + + this%solutiongradient%extBoundary(i,j,iEl,1:this%nvar,1:2) = & + bc%bcgFunction(s,dsdx,x,this%t,nhat,this%nvar,2) + enddo endif enddo enddo diff --git a/src/SELF_DGModel3D_t.f90 b/src/SELF_DGModel3D_t.f90 index b947d11c2..0bd98356c 100644 --- a/src/SELF_DGModel3D_t.f90 +++ b/src/SELF_DGModel3D_t.f90 @@ -454,17 +454,18 @@ subroutine setboundarycondition_DGModel3D_t(this) e2 = this%mesh%sideInfo(3,k,iEl) ! Neighboring Element ID if(e2 == 0) then + bc => this%boundaryconditions%GetBCForID(bcid) - bc = this%boundaryconditions%GetNodeForBCID(bcid) - ! Get the boundary normals on cell edges from the mesh geometry - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - x = this%geometry%x%boundary(i,j,k,iEl,1,1:3) - s = this%solution%boundary(i,j,k,iEl,1:this%nvar) - dsdx = this%solutiongradient%boundary(i,j,k,iEl,1:this%nvar,1:3) - - this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & - bc%bcFunc(s,dsdx,x,this%t,nhat) + do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1) + ! Get the boundary normals on cell edges from the mesh geometry + nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) + x = this%geometry%x%boundary(i,j,k,iEl,1,1:3) + s = this%solution%boundary(i,j,k,iEl,1:this%nvar) + dsdx = this%solutiongradient%boundary(i,j,k,iEl,1:this%nvar,1:3) + this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & + bc%bcFunction(s,dsdx,x,this%t,nhat,this%nvar,3) + enddo endif enddo @@ -483,23 +484,25 @@ subroutine setgradientboundarycondition_DGModel3D_t(this) real(prec) :: nhat(1:3),x(1:3),s(1:this%nvar),dsdx(1:this%nvar,1:3) type(SELF_BoundaryCondition),pointer :: bc - do concurrent(k=1:6,iel=1:this%mesh%nElem) - - bcid = this%mesh%sideInfo(5,k,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,k,iEl) ! Neighboring Element ID - - if(e2 == 0) then - bc = this%boundaryconditions%GetNodeForBCID(bcid) - ! Get the boundary normals on cell edges from the mesh geometry - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - x = this%geometry%x%boundary(i,j,k,iEl,1,1:3) - s = this%solution%boundary(i,j,k,iEl,1:this%nvar) - dsdx = this%solutiongradient%boundary(i,j,k,iEl,1:this%nvar,1:3) - - this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & - bc%bcgFunc(s,dsdx,x,this%t,nhat) - endif + do iel = 1,this%mesh%nElem + do k = 1,6 + bcid = this%mesh%sideInfo(5,k,iEl) ! Boundary Condition ID + e2 = this%mesh%sideInfo(3,k,iEl) ! Neighboring Element ID + if(e2 == 0) then + bc => this%boundaryconditions%GetBCForID(bcid) + do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1) + ! Get the boundary normals on cell edges from the mesh geometry + nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) + x = this%geometry%x%boundary(i,j,k,iEl,1,1:3) + s = this%solution%boundary(i,j,k,iEl,1:this%nvar) + dsdx = this%solutiongradient%boundary(i,j,k,iEl,1:this%nvar,1:3) + + this%solutiongradient%extBoundary(i,j,k,iEl,1:this%nvar,1:3) = & + bc%bcgFunction(s,dsdx,x,this%t,nhat,this%nvar,3) + enddo + endif + enddo enddo endsubroutine setgradientboundarycondition_DGModel3D_t diff --git a/src/SELF_Mesh.f90 b/src/SELF_Mesh.f90 index 94ff8f32d..a45d3a1f6 100644 --- a/src/SELF_Mesh.f90 +++ b/src/SELF_Mesh.f90 @@ -29,6 +29,7 @@ module SELF_Mesh use SELF_Constants use SELF_DomainDecomposition use iso_c_binding + use SELF_BoundaryConditions implicit none @@ -44,9 +45,12 @@ module SELF_Mesh integer :: nBCs integer :: quadrature type(DomainDecomposition) :: decomp + type(BoundaryConditionList) :: stateBCs + type(BoundaryConditionList) :: gradientBCs contains procedure(SELF_FreeMesh),deferred :: Free + procedure(SELF_EnumerateBoundaryConditions),deferred :: EnumerateBoundaryConditions endtype SEMMesh @@ -58,6 +62,14 @@ subroutine SELF_FreeMesh(this) endsubroutine SELF_FreeMesh endinterface + interface + subroutine SELF_EnumerateBoundaryConditions(this) + import SEMMesh + implicit none + class(SEMMesh),intent(inout) :: this + endsubroutine SELF_EnumerateBoundaryConditions + endinterface + ! Element Types - From Table 4.1 of https://www.hopr-project.org/externals/Meshformat.pdf integer,parameter :: selfLineLinear = 1 integer,parameter :: selfLineNonlinear = 2 @@ -88,17 +100,4 @@ subroutine SELF_FreeMesh(this) integer,parameter :: SELF_MESH_HOPR_2D = 3 integer,parameter :: SELF_MESH_HOPR_3D = 4 -! //////////////////////////////////////////////// ! -! Boundary Condition parameters -! - - ! Conditions on the solution - integer,parameter :: SELF_BC_PRESCRIBED = 100 - integer,parameter :: SELF_BC_RADIATION = 101 - integer,parameter :: SELF_BC_NONORMALFLOW = 102 - - ! Conditions on the solution gradients - integer,parameter :: SELF_BC_PRESCRIBED_STRESS = 200 - integer,parameter :: SELF_BC_NOSTRESS = 201 - endmodule SELF_Mesh diff --git a/src/SELF_Mesh_1D.f90 b/src/SELF_Mesh_1D.f90 index b9708b0c8..c415c98d3 100644 --- a/src/SELF_Mesh_1D.f90 +++ b/src/SELF_Mesh_1D.f90 @@ -45,16 +45,12 @@ module SELF_Mesh_1D 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 procedure,public :: Write_Mesh => Write_Mesh1D @@ -77,13 +73,12 @@ subroutine Init_Mesh1D(this,nElem,nNodes,nBCs) this%nUniqueNodes = 0 this%nBCs = nBCs this%bcid = 0 - + call this%stateBCs%init() + call this%gradientBCs%init() 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 @@ -97,11 +92,11 @@ subroutine Free_Mesh1D(this) this%nCornerNodes = 0 this%nUniqueNodes = 0 this%nBCs = 0 + call this%stateBCs%free() + call this%gradientBCs%free() deallocate(this%elemInfo) deallocate(this%nodeCoords) deallocate(this%globalNodeIDs) - deallocate(this%BCType) - deallocate(this%BCNames) call this%decomp%Free() endsubroutine Free_Mesh1D @@ -166,21 +161,6 @@ subroutine UniformBlockMesh_Mesh1D(this,nElem,x) 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 - - this%bcid(1) = leftbc - this%bcid(2) = rightbc - - endsubroutine ResetBoundaryConditionType_Mesh1D - subroutine Write_Mesh1D(this,meshFile) ! Writes mesh output in HOPR format (serial IO only) implicit none @@ -195,7 +175,7 @@ subroutine Write_Mesh1D(this,meshFile) 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) diff --git a/src/SELF_Mesh_2D_t.f90 b/src/SELF_Mesh_2D_t.f90 index b1ea9c4a2..1510996e3 100644 --- a/src/SELF_Mesh_2D_t.f90 +++ b/src/SELF_Mesh_2D_t.f90 @@ -103,7 +103,6 @@ module SELF_Mesh_2D_t integer,pointer,dimension(:,:) :: CGNSCornerMap integer,pointer,dimension(:,:) :: CGNSSideMap integer,pointer,dimension(:,:) :: BCType - character(LEN=255),allocatable :: BCNames(:) contains procedure,public :: Init => Init_Mesh2D_t @@ -113,6 +112,7 @@ module SELF_Mesh_2D_t generic,public :: StructuredMesh => UniformStructuredMesh_Mesh2D_t procedure,private :: UniformStructuredMesh_Mesh2D_t procedure,public :: ResetBoundaryConditionType => ResetBoundaryConditionType_Mesh2D_t + procedure,public :: RegisterBoundaryCondition => RegisterBoundaryCondition_Mesh2D_t procedure,public :: Read_HOPr => Read_HOPr_Mesh2D_t @@ -153,8 +153,6 @@ subroutine Init_Mesh2D_t(this,nGeo,nElem,nSides,nNodes,nBCs) 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/) @@ -188,7 +186,6 @@ subroutine Free_Mesh2D_t(this) deallocate(this%CGNSCornerMap) deallocate(this%CGNSSideMap) deallocate(this%BCType) - deallocate(this%BCNames) call this%decomp%Free() endsubroutine Free_Mesh2D_t @@ -484,7 +481,6 @@ subroutine Read_HOPr_Mesh2D_t(this,meshFile) integer,dimension(:,:),allocatable :: hopr_sideInfo real(prec),dimension(:,:),allocatable :: hopr_nodeCoords integer,dimension(:),allocatable :: hopr_globalNodeIDs - integer,dimension(:,:),allocatable :: bcType call this%decomp%init() @@ -505,16 +501,6 @@ subroutine Read_HOPr_Mesh2D_t(this,meshFile) 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) @@ -578,6 +564,12 @@ subroutine Read_HOPr_Mesh2D_t(this,meshFile) 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) + if(this%decomp%mpiEnabled) then + offset(:) = 0 + call ReadArray_HDF5(fileId,'BCType',this%bcType,offset) + else + call ReadArray_HDF5(fileId,'BCType',this%bcType) + endif this%nUniqueSides = nUniqueSides2D ! Store the number of sides in the global mesh ! Copy data from local arrays into this @@ -627,6 +619,53 @@ subroutine Read_HOPr_Mesh2D_t(this,meshFile) endsubroutine Read_HOPr_Mesh2D_t + subroutine RegisterBoundaryCondition_Mesh2D_t(mesh,bcid,bcname,bcfunc) + implicit none + class(Mesh2D_t),intent(inout) :: mesh + integer,intent(in) :: bcid + character(*),intent(in) :: bcname + procedure(SELF_bcMethod),pointer,intent(in) :: bcfunc + ! Local + integer :: iel,j + integer :: e2,localbcid,nsides + type(BoundaryCondition),pointer :: bc + + nsides = 0 + do iel = 1,mesh%nElem + do j = 1,4 + e2 = mesh%sideInfo(3,j,iel) ! Neighboring Element ID + localbcid = mesh%sideInfo(5,j,iel) ! Boundary Condition ID + if(e2 == 0 .and. localbcid == bcid) then + nsides = nsides+1 + endif + enddo + enddo + + if(nsides == 0) then + print*,"(RegisterBoundaryCondition) : WARNING : No sides found with BC ID ",bcid + else + print*,"(RegisterBoundaryCondition) : INFO : Registering BC ID ",bcid," named '",trim(bcname),"' with ",nsides," sides." + call mesh%stateBCs%RegisterBoundaryCondition(bcid,bcname,bcfunc,nsides) + endif + + ! Now, we capture the list of elements and local sides for this boundary condition + nsides = 0 + bc => this%stateBCs%GetBCForID(bcid) + do iel = 1,mesh%nElem + do j = 1,4 + e2 = mesh%sideInfo(3,j,iel) ! Neighboring Element ID + ! See comment from https://hopr.readthedocs.io/en/latest/userguide/meshformat.html#side-information-sideinfo + localbcid = mesh%sideInfo(5,j,iel) ! Boundary Condition ID ! TO DO: Verify that we don't need to get mesh%bctype(bcid) + if(e2 == 0 .and. localbcid == bcid) then + nsides = nsides+1 + bc%elements(nsides) = iel + bc%sides(nsides) = j + endif + enddo + enddo + + endsubroutine RegisterBoundaryCondition_Mesh2D_t + subroutine RecalculateFlip_Mesh2D_t(this) implicit none class(Mesh2D_t),intent(inout) :: this diff --git a/src/SELF_Model.f90 b/src/SELF_Model.f90 index 8ed88d3cc..ad397ba1e 100644 --- a/src/SELF_Model.f90 +++ b/src/SELF_Model.f90 @@ -101,7 +101,6 @@ module SELF_Model ! Time integration attributes procedure(SELF_timeIntegrator),pointer :: timeIntegrator => Euler_timeIntegrator - type(SELF_BoundaryConditionList) :: boundaryconditions real(prec) :: dt real(prec) :: t integer :: ioIterate = 0