Skip to content

GitLab

Commit 516db8be authored by rabgra's avatar rabgra
Browse files

add 1D

parent 71e4f795
Expand all Hide whitespace changes
Inline Side-by-side
Src1D/Model.f90 0 → 100755
View file @ 516db8be
!!! HIGH ORDER IN SPACE AND TIME DEFERRED CORRECTION (EXPLICIT)
!!! RESIDUAL DISTRIBUTION METHOD
!!! DESIGNED FOR THE SYSTEM GIVEN BY THE EULER EQUATIONS in 1D and 2D
!!!
!!! Authors:
!!! Remi Abgrall (University of Zurich),
!!! Paola Bacigaluppi (University of Zurich),
!!! Svetlana Tokareva (University of Zurich)
!!! Institute of Mathematics and Institute of Computational Sciences
!!! University of Zurich
!!! July 10, 2018
!!! Correspondance: remi.abgrall@math.uzh.ch
!!! ------------------------------------------
MODULE Model
! This module allows to pass from control to physical variables and viceversa
USE param2d
USE PRECISION
IMPLICIT NONE
CONTAINS
FUNCTION Control_to_Cons(u,e) RESULT (u_cons)
! crom control point, compute the values a physical dofs
TYPE(Pvar), DIMENSION(:), INTENT(in):: u
TYPE(element), INTENT(in):: e
TYPE(Pvar),DIMENSION(SIZE(u,dim=1)):: u_cons
INTEGER:: k,l
u_cons=u
SELECT CASE(e%itype)
CASE(1,3,4) ! Lagrange
CASE(2,5,6) ! Bezier
DO l=1, e%nsommets
u_cons(l) = e%eval_func(u(:),e%x(:,l))
ENDDO
CASE default
PRINT*, "erreur dans Model/Control_to_Cons"
STOP
END SELECT
END FUNCTION Control_to_cons
FUNCTION Cons_to_Control(u_cons,e) RESULT (u)
! from values at dofs, compute control points
TYPE(Pvar), DIMENSION(:), INTENT(in):: u_cons
TYPE(element), INTENT(in):: e
TYPE(Pvar),DIMENSION(SIZE(u_cons,dim=1)):: u
INTEGER:: l, k
u=u_cons
SELECT CASE(e%itype)
CASE(1,3,4) ! Lagrange
CASE(2,5,6)! cubic bezier
DO k=1, n_vars
u(:)%u(k) = MATMUL(e%base1,u_cons%u(k))
ENDDO
CASE default
PRINT*, "erreur dans Model/Control_to_Cons"
STOP
END SELECT
!enddo
END FUNCTION Cons_to_Control
END MODULE Model
Src1D/algebra.f90 0 → 100755
View file @ 516db8be
!!! HIGH ORDER IN SPACE AND TIME DEFERRED CORRECTION (EXPLICIT)
!!! RESIDUAL DISTRIBUTION METHOD
!!! DESIGNED FOR THE SYSTEM GIVEN BY THE EULER EQUATIONS in 1D and 2D
!!!
!!! Authors:
!!! Remi Abgrall (University of Zurich),
!!! Paola Bacigaluppi (University of Zurich),
!!! Svetlana Tokareva (University of Zurich)
!!! Institute of Mathematics and Institute of Computational Sciences
!!! University of Zurich
!!! July 10, 2018
!!! Correspondance: remi.abgrall@math.uzh.ch
!!! ------------------------------------------
MODULE algebra
USE PRECISION
IMPLICIT NONE
LOGICAL, SAVE, PRIVATE :: initialise = .FALSE.
LOGICAL, SAVE, PRIVATE :: module_debug = .FALSE.
LOGICAL, SAVE, PUBLIC :: optim1_plain = .FALSE.
LOGICAL, SAVE, PUBLIC :: optim2_plain = .FALSE.
LOGICAL, SAVE, PUBLIC :: optim3_plain = .FALSE.
LOGICAL, SAVE, PUBLIC :: optim4_plain = .FALSE.
LOGICAL, SAVE, PUBLIC :: optim5_plain = .FALSE.
CONTAINS
!------------------------------------------
!!-- Inversion d'une matrice carree par LU et pivot partiel par ligne
!!-- Ref : Numerical recipes in C
!------------------------------------------
FUNCTION Inverse( Mat) RESULT (Mat1)
CHARACTER(LEN = *), PARAMETER :: mod_name = "InverseLu"
REAL(DP), DIMENSION(:, : ), INTENT(IN) :: Mat
REAL(DP), DIMENSION(SIZE(Mat, dim = 1), SIZE( Mat, dim = 1)) :: Mat1, mat2
REAL(DP), DIMENSION(SIZE(Mat, dim = 1)) :: col
REAL(DP) :: d
INTEGER :: j, Nsize, l, zz
INTEGER, DIMENSION(SIZE(Mat, dim = 1)) :: indx !-- CCE R.B. 2008/10/21
IF (.NOT. initialise) THEN
optim1_plain = .FALSE.
optim2_plain = .TRUE.
optim3_plain = .TRUE. !-- celle là est particulièrement efficace
optim4_plain = .TRUE.
optim2_plain = .FALSE. !-- ces 2 optimisations là mettre MHD en l'air, et pourtant elles sont meilleures en précusion, ce qui ne saute pas aux yeux au niveau des résidus %%%%%%
optim4_plain = .FALSE.
optim3_plain = .FALSE. !-- cette optimisation met MHD en l'air uniquement en -O5, pas en -O2
END IF
Nsize = SIZE(Mat, dim=1)
mat2 = Mat
CALL ludcmp(mat2, Nsize, indx, d) !-- indx OUT
DO j = 1, Nsize
col = 0.0
col(j) = 1.0
CALL luksb(mat2, Nsize, indx, col) !-- col IN OUT; indx IN
Mat1(:, j) = col(: )
END DO
CONTAINS
SUBROUTINE ludcmp(mat3, Nsize, indx, d)
CHARACTER(LEN = *), PARAMETER :: mod_name = "ludcmp"
INTEGER, INTENT(IN) :: Nsize
REAL(DP), DIMENSION(Nsize, Nsize ), INTENT(INOUT) :: mat3 !-- Passer en :,: pose des pbs avec le -O5 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
INTEGER, DIMENSION(Nsize ), INTENT(OUT) :: indx !-- Passer en :,: pose des pbs avec le -O5 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
REAL(DP), INTENT(OUT) :: d
REAL(DP), DIMENSION(Nsize) :: vv
INTEGER :: i, j, k, imax, zz
REAL(DP) :: Big, dum, somme, temp
d = 1.0_dp
DO i = 1, Nsize
IF (optim1_plain) THEN
Big = MAXVAL(ABS(mat3(i, :)))
ELSE
Big = 0.0_dp
DO j = 1, Nsize
temp = ABS(mat3(i, j))
IF (temp > Big) THEN
Big = temp
END IF
END DO
END IF
IF (Big == 0.0_dp) THEN
WRITE( *, *) mod_name, " ERREUR : Matrice singuliere, i==", i
STOP
END IF
vv(i) = 1.0 / Big
END DO
DO j = 1, Nsize
DO i = 1, j -1
IF (optim2_plain) THEN
mat3(i, j) = mat3(i, j) - SUM(mat3(i, 1: i - 1) * mat3(1: i - 1, j))
ELSE
somme = mat3(i, j)
DO k = 1, i -1
somme = somme - mat3(i, k) * mat3(k, j)
END DO
mat3(i, j) = somme
END IF
END DO !-- boucle sur i
Big = 0.0_dp
imax = -1
DO i = j, Nsize
somme = mat3(i, j)
DO k = 1, j -1
somme = somme - mat3(i, k) * mat3(k, j)
END DO
mat3(i, j) = somme
dum = vv(i) * ABS(somme)
IF (dum >= Big) THEN
Big = dum
imax = i
END IF
END DO !-- boucle sur i
IF (j /= imax) THEN
DO k = 1, Nsize
dum = mat3(imax, k)
mat3(imax, k) = mat3(j, k)
mat3(j, k) = dum
END DO !-- boucle sur k
d = - d
vv(imax ) = vv(j)
END IF
indx(j) = imax
IF (ABS(mat3(j, j)) <= 1.0e-20_dp) THEN
mat3(j, j) = SIGN(1.0e-20_dp, mat3(j, j)) !-- CCE 2007/04/24 !-- CCE 2008/12/17
END IF
IF (j /= Nsize) THEN
DO i = j + 1, Nsize
mat3(i, j) = mat3(i, j) / mat3(j, j)
END DO !-- boucle sur i
END IF
END DO !-- boucle sur j
END SUBROUTINE ludcmp
SUBROUTINE luksb(mat2, Nsize, indx, col)
CHARACTER(LEN = *), PARAMETER :: mod_name = "luksb"
INTEGER, INTENT(IN) :: Nsize
REAL(DP), DIMENSION(Nsize, Nsize), INTENT(IN) :: mat2 !-- Passer en :,: pose des pbs avec le -O5 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
INTEGER, DIMENSION(Nsize), INTENT(IN) :: indx !-- Passer en :,: pose des pbs avec le -O5 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
REAL(DP), DIMENSION(Nsize), INTENT(INOUT) :: col !-- Passer en :,: pose des pbs avec le -O5 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
INTEGER :: i, ii, ip, j
REAL(DP) :: somme
ii = 1
DO i = 1, Nsize
ip = indx(i)
IF (ip <= 0 .OR. ip > SIZE(col)) THEN
PRINT *, mod_name, " ERREUR : indx(", i, ") invalide", ip
STOP
END IF
somme = col(ip)
col(ip) = col(i)
IF (ii > 0) THEN
IF (optim3_plain) THEN
somme = somme - SUM(mat2(i, ii: i -1) * col(ii: i -1))
ELSE
DO j = ii, i -1
somme = somme - mat2(i, j) * col(j)
END DO
END IF
ELSE
IF (somme == 0.0_dp) THEN
ii = i
END IF
END IF
col(i) = somme
END DO
DO i = Nsize, 1, -1
IF (optim4_plain) THEN
col(i) = (col(i) - SUM(mat2(i, i + 1: Nsize) * col(i + 1: Nsize))) / mat2(i, i)
ELSE
somme = col(i)
DO j = i + 1, Nsize
somme = somme - mat2(i, j) * col(j)
END DO
col(i) = somme / mat2(i, i)
END IF
END DO
END SUBROUTINE luksb
END FUNCTION Inverse
END MODULE algebra
Src1D/aretes.f90 0 → 100755
View file @ 516db8be
!!! HIGH ORDER IN SPACE AND TIME DEFERRED CORRECTION (EXPLICIT)
!!! RESIDUAL DISTRIBUTION METHOD
!!! DESIGNED FOR THE SYSTEM GIVEN BY THE EULER EQUATIONS in 1D and 2D
!!!
!!! Authors:
!!! Remi Abgrall (University of Zurich),
!!! Paola Bacigaluppi (University of Zurich),
!!! Svetlana Tokareva (University of Zurich)
!!! Institute of Mathematics and Institute of Computational Sciences
!!! University of Zurich
!!! July 10, 2018
!!! Correspondance: remi.abgrall@math.uzh.ch
!!! ------------------------------------------
MODULE arete_class
USE PRECISION
IMPLICIT NONE
TYPE, PUBLIC:: arete
INTEGER:: nsommets, itype, nvertex! nbre de dofs, type element: 1-> P1
! 2-> B2
!3->P2
! nombre de sommet dans cet element arete
LOGICAL:: bord
INTEGER:: jt1=-1, jt2 =-1 ! les deux elements de par et d'autre de l'arete.
INTEGER, DIMENSION(:,:), POINTER :: nu =>Null() ! nu( indice des elements, indice des voisins): on cherche a connaitre le numero local des
! points communs (puisque le maillage est confome) aux deux elements sur cette face dans chacun des elements jt1 et jt2
REAL(dp), DIMENSION(:,:), POINTER :: coor=>Null() ! il s'agit des coordonnees physique des dofs (communs) sur la face (commune)
REAL(dp) :: volume=0 !
REAL(dp) :: jump_flag=1.0 !(between 0 and 1 which gives the weight of the edge term
! for this one check if there is a discontinuity around and take the maximum value)
REAL(dp), DIMENSION(:), POINTER :: n =>Null() ! normales exterieures
INTEGER :: log ! logique
!!!! quadrature de surface !
REAL(dp), DIMENSION(:,:),POINTER :: quad =>Null() ! point de quadrature
REAL(dp), DIMENSION(:),POINTER :: weight=>Null() ! poids
INTEGER :: nquad ! nbre de points de quadrature
!!! quadrature bord (dimension -1)
REAL(dp), DIMENSION(:,:),POINTER :: quad_1 =>Null() ! point de quadrature
REAL(dp), DIMENSION(:),POINTER :: weight_1=>Null() ! poids
INTEGER :: nquad_1 ! nbre de points de quadrature
!!!
CONTAINS
PROCEDURE, PUBLIC:: aire=>aire_arete
PROCEDURE, PUBLIC:: quadrature=>quadrature_arete
PROCEDURE, PUBLIC:: normale=>normale_arete
!FINAL:: clean_arete
END TYPE arete
CONTAINS
REAL(dp) FUNCTION aire_arete(e)
CLASS(arete), INTENT(in):: e
REAL(dp), DIMENSION(2):: a
a= e%coor(:,2)-e%coor(:,1)
aire_arete=SQRT(a(1)**2+ a(2)**2 )
END FUNCTION aire_arete
FUNCTION normale_arete(e) RESULT(n)
CLASS(arete), INTENT(in)::e
REAL(dp), DIMENSION(2):: n
INTEGER:: l, k1, k2
INTEGER, DIMENSION(3), PARAMETER:: ip1=(/2,3,1/)
n(1)=e%coor(2,2)-e%coor(2,1)
n(2)=e%coor(1,1)-e%coor(1,2)
END FUNCTION normale_arete
SUBROUTINE quadrature_arete(e)
CLASS(arete), INTENT(inout):: e
REAL(dp):: w,zo,xo,s
INTEGER:: nquad
!Gaussia formula, exact for polynomials of degree 5
PRINT*, "quadrature_arete"
STOP
e%nquad=3
nquad=e%nquad
ALLOCATE(e%quad(2,e%nquad),e%weight(e%nquad))
s=SQRT(0.6d0)
e%quad(1,1)=0.5d0*(1.0d0 - s)
e%quad(2,1)=0.5d0*(1.0d0 + s)
e%weight(1) = 5.0d0/18.0d0
e%quad(1,2)=0.5d0*(1.0d0 + s)
e%quad(2,2)=0.5d0*(1.0d0 - s)
e%weight(2) = 5.0d0/18.0d0
e%quad(1,3)=0.5d0
e%quad(2,3)=0.5d0
e%weight(3)=8.0d0/18.0d0
END SUBROUTINE quadrature_arete
SUBROUTINE clean_arete(e)
TYPE(arete):: e
IF (ASSOCIATED(e%nu)) NULLIFY(e%nu)
IF (ASSOCIATED(e%coor)) NULLIFY(e%coor)
IF (ASSOCIATED(e%quad)) NULLIFY(e%quad)
IF (ASSOCIATED(e%weight)) NULLIFY(e%weight)
END SUBROUTINE clean_arete
END MODULE arete_class
Src1D/elements_1D.f90 0 → 100755
View file @ 516db8be
This diff is collapsed.
Src1D/geometry.f90 0 → 100755
View file @ 516db8be
!!! HIGH ORDER IN SPACE AND TIME DEFERRED CORRECTION (EXPLICIT)
!!! RESIDUAL DISTRIBUTION METHOD
!!! DESIGNED FOR THE SYSTEM GIVEN BY THE EULER EQUATIONS in 1D and 2D
!!!
!!! Authors:
!!! Remi Abgrall (University of Zurich),
!!! Paola Bacigaluppi (University of Zurich),
!!! Svetlana Tokareva (University of Zurich)
!!! Institute of Mathematics and Institute of Computational Sciences
!!! University of Zurich
!!! July 10, 2018
!!! Correspondance: remi.abgrall@math.uzh.ch
!!! ------------------------------------------
MODULE geometry
USE param2d
USE init_bc
USE PRECISION
IMPLICIT NONE
PRIVATE
PUBLIC:: geom
CONTAINS
SUBROUTINE geom(Mesh, DATA)
TYPE (maillage), INTENT(inout):: mesh
TYPE(donnees), INTENT(inout):: DATA
INTEGER, PARAMETER,DIMENSION(6)::loc_ndofs=(/2,3,3,4,4,5/)
REAL(dp):: dx, a
TYPE(element):: e
INTEGER:: nt, jt, itype, p1, p2, k
nt=DATA%nt; itype=DATA%itype
SELECT CASE(DATA%itype)
CASE(1)
Mesh%nt=DATA%nt
Mesh%ndofs=DATA%nt+1
CASE(2,3)
Mesh%nt=DATA%nt
Mesh%ndofs=2*DATA%nt+1
CASE(4,5)
mesh%nt=DATA%nt
Mesh%ndofs=nt+1+2*nt
CASE(6)
Mesh%nt=DATA%nt
Mesh%ndofs=nt+1+3*nt
CASE default
PRINT*, "Error: this element is not yet defined", DATA%itype
STOP
END SELECT
CALL init_geom(DATA)
dx=DATA%Length/REAL(nt)
a =DATA%domain_left
ALLOCATE(Mesh%e(nt))
k=0
DO jt=1, nt
ALLOCATE(Mesh%e(jt)%coor(loc_ndofs(itype)),Mesh%e(jt)%nu(loc_ndofs(itype)))
ALLOCATE(Mesh%e(jt)%x(2,loc_ndofs(itype)))
mesh%e(jt)%itype=itype
Mesh%e(jt)%nvertex = 2
mesh%e(jt)%nsommets=loc_ndofs(itype)
mesh%e(jt)%coor(1)=(jt-1)*dx+a
mesh%e(jt)%coor(2)=(jt )*dx+a
mesh%e(jt)%nu(1)=jt
mesh%e(jt)%nu(2)=jt+1
SELECT CASE(itype)
CASE(2,3)
k=k+1
mesh%e(jt)%coor(3)=mesh%e(jt)%coor(1)+dx/2.
mesh%e(jt)%nu(3)=nt+1+jt
CASE(4,5)
mesh%e(jt)%coor(3)=mesh%e(jt)%coor(1)+dx/3.
mesh%e(jt)%coor(4)=mesh%e(jt)%coor(1)+2.*dx/3.
k=k+1
mesh%e(jt)%nu(3)=nt+1+2*(jt-1)+1
k=k+1
mesh%e(jt)%nu(4)=nt+1+2*(jt-1)+2
CASE(6)
mesh%e(jt)%coor(3)=mesh%e(jt)%coor(1)+dx/4.
mesh%e(jt)%coor(4)=mesh%e(jt)%coor(1)+dx/2.
mesh%e(jt)%coor(5)=mesh%e(jt)%coor(1)+dx*0.75
mesh%e(jt)%nu(3)=nt+1+3*(jt-1)+1
mesh%e(jt)%nu(4)=nt+1+3*(jt-1)+2
mesh%e(jt)%nu(5)=nt+1+3*(jt-1)+3
END SELECT
mesh%e(jt)%volume=mesh%e(jt)%aire()
ALLOCATE(mesh%e(jt)%n(2))
mesh%e(jt)%n =mesh%e(jt)%normale()
CALL mesh%e(jt)%quadrature()
ALLOCATE(Mesh%e(jt)%base0(mesh%e(jt)%nsommets,mesh%e(jt)%nsommets))
ALLOCATE(Mesh%e(jt)%base1(mesh%e(jt)%nsommets,mesh%e(jt)%nsommets))
CALL mesh%e(jt)%base_ref()
call mesh%e(jt)%eval_coeff()
ENDDO
! connectivite: for each edge, we give the element before and after
Mesh%nsegmt=nt!+1 ! periodicite: the last edge is the first one, one should not count it twice
ALLOCATE(Mesh%edge(Mesh%nsegmt))
DO jt=2,Mesh%nsegmt!-1
Mesh%edge(jt)%jt1=jt-1
Mesh%edge(jt)%jt2=jt
Mesh%edge(jt)%bord=.FALSE.
ENDDO
SELECT CASE(DATA%test)
CASE(0,2,3,5)
! for periodic BCs
! here I take into account the periodicity of the mesh
Mesh%edge(1)%jt2= 1!Mesh%nt
Mesh%edge(1)%jt1=Mesh%nt !1
Mesh%edge(1)%bord=.FALSE.
Mesh%edge(mesh%nsegmt)%jt2=1 !added it to debug convergence
Mesh%edge(mesh%nsegmt)%jt1=Mesh%nt !added it to debug convergence
Mesh%edge(mesh%nsegmt)%bord=.FALSE.!added it to debug convergence
CASE default
! for outflow BCs
! here I take into account the periodicity of the mesh
Mesh%edge(1)%jt2= 1
Mesh%edge(1)%jt1= 1
Mesh%edge(1)%bord=.FALSE.
Mesh%edge(mesh%nsegmt)%jt2=Mesh%nt !added it to debug convergence
Mesh%edge(mesh%nsegmt)%jt1=Mesh%nt !added it to debug convergence
Mesh%edge(mesh%nsegmt)%bord=.FALSE.!added it to debug convergence
END SELECT
ALLOCATE(Mesh%aires(Mesh%ndofs))
Mesh%aires=0.0_dp
DO jt=1, nt
e=Mesh%e(jt)
Mesh%aires(e%nu)=Mesh%aires(e%nu)+e%volume/REAL(e%nsommets,dp)
ENDDO
! make the cells periodic.
! warning : the special numbering is a trap
p1=Mesh%e(1)%nu(1)
p2=Mesh%e(Mesh%nt)%nu(2)
mesh%aires(p1)=Mesh%aires(p1)+Mesh%aires(p2)
Mesh%aires(p2)=Mesh%aires(p1)
! this to avoid further divisions
Mesh%aires=1.0_dp/Mesh%aires
END SUBROUTINE geom
END MODULE geometry
Src1D/init_bc_euler.f90 0 → 100644
View file @ 516db8be
!!! HIGH ORDER IN SPACE AND TIME DEFERRED CORRECTION (EXPLICIT)
!!! RESIDUAL DISTRIBUTION METHOD
!!! DESIGNED FOR THE SYSTEM GIVEN BY THE EULER EQUATIONS in 1D and 2D
!!!
!!! Authors:
!!! Remi Abgrall (University of Zurich),
!!! Paola Bacigaluppi (University of Zurich),
!!! Svetlana Tokareva (University of Zurich)
!!! Institute of Mathematics and Institute of Computational Sciences
!!! University of Zurich
!!! July 10, 2018
!!! Correspondance: remi.abgrall@math.uzh.ch
!!! ------------------------------------------
MODULE init_bc
USE param2d
USE overloading
use precision
IMPLICIT NONE
CONTAINS
!---------------------------------------
! Setup domain
!---------------------------------------
SUBROUTINE init_geom(DATA)
TYPE(donnees), INTENT(inout):: DATA