Commit a27dbfc0 authored by rabgra's avatar rabgra
Browse files

Merge branch 'master' of git.math.uzh.ch:remi.abgrall/RD_public

parents 4f7fe35f 52a6e305
!!! 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 overloading
USE variable_def
use precision
IMPLICIT NONE
INTERFACE ASSIGNMENT (=)
MODULE PROCEDURE assign_var
MODULE PROCEDURE assign_var_real
MODULE PROCEDURE assign_var_vec
END INTERFACE ASSIGNMENT (=)
INTERFACE OPERATOR (+)
MODULE PROCEDURE addition_var
MODULE PROCEDURE addition_Vecvar
MODULE PROCEDURE addition_Vecvar_var
MODULE PROCEDURE addition_var_Vecvar
END INTERFACE OPERATOR (+)
INTERFACE OPERATOR (-)
MODULE PROCEDURE subtraction_var
MODULE PROCEDURE subtraction_Vecvar
MODULE PROCEDURE subtraction_Vecvar_var
MODULE PROCEDURE subtraction_var_Vecvar
END INTERFACE OPERATOR (-)
INTERFACE OPERATOR (*)
MODULE PROCEDURE multiple_var_var
MODULE PROCEDURE multiple_real_var
MODULE PROCEDURE multiple_var_real
MODULE PROCEDURE multiple_vec_tensor
MODULE PROCEDURE multiple_tensor_vec
MODULE PROCEDURE multiple_Vec_Vecvar
MODULE PROCEDURE multiple_Vecvar_Vec
MODULE PROCEDURE multiple_matrix_var
MODULE PROCEDURE multiple_Vecvar_real
MODULE PROCEDURE multiple_real_Vecvar
MODULE PROCEDURE multiple_var_realvec
MODULE PROCEDURE multiple_realvec_var
END INTERFACE OPERATOR (*)
INTERFACE OPERATOR (/)
MODULE PROCEDURE divide_var_real
MODULE PROCEDURE divide_Vecvar_Vecreal
END INTERFACE OPERATOR (/)
INTERFACE SUM
MODULE PROCEDURE pvar_sum
END INTERFACE SUM
CONTAINS
SUBROUTINE assign_var_vec( var_result, var)
TYPE(PVar), DIMENSION(:),INTENT(in) :: var
TYPE(PVar), DIMENSION(:),INTENT(out) :: var_result
INTEGER:: i
DO i=1, SIZE(Var,dim=1)
var_result(i)%NVars = var(i)%NVars
var_result(i)%u = var(i)%u
ENDDO
END SUBROUTINE assign_var_vec
ELEMENTAL SUBROUTINE assign_var( var_result, var)
TYPE(PVar), INTENT(in) :: var
TYPE(PVar), INTENT(out) :: var_result
var_result%NVars = var%NVars
var_result%u = var%u
END SUBROUTINE assign_var
ELEMENTAL SUBROUTINE assign_var_real( var_result, alpha)
REAL(dp), INTENT(IN) :: alpha
TYPE(PVar), INTENT(out) :: var_result
var_result%u(:) = alpha
END SUBROUTINE assign_var_real
FUNCTION addition_var(var1, var2) RESULT(add_var)
TYPE(PVar), INTENT(IN) :: var1
TYPE(PVar), INTENT(IN) :: var2
TYPE(PVar) :: add_var
add_var%u = var1%u + var2%u
END FUNCTION addition_var
FUNCTION addition_Vecvar(var1, var2) RESULT(add_var)
TYPE(PVar), DIMENSION(:), INTENT(IN) :: var1
TYPE(PVar), DIMENSION(:), INTENT(IN) :: var2
TYPE(PVar), DIMENSION(SIZE(var1)) :: add_var
INTEGER:: i
DO i=1, SIZE(var1)
add_var(i)%u(:) = var1(i)%u(:) + var2(i)%u(:)
ENDDO
END FUNCTION addition_Vecvar
FUNCTION addition_Vecvar_var(var1, var2) RESULT(add_vecvar_var)
TYPE(PVar), DIMENSION(:), INTENT(IN) :: var1
TYPE(PVar), INTENT(IN) :: var2
TYPE(PVar), DIMENSION(SIZE(var1)) :: add_vecvar_var
INTEGER:: l
DO l=1, SIZE(var1)
add_vecvar_var(l)%u = var1(l)%u + var2%u
ENDDO
END FUNCTION addition_Vecvar_var
FUNCTION addition_var_Vecvar(var1, var2) RESULT(add_vecvar_var)
TYPE(PVar), INTENT(IN) :: var1
TYPE(PVar), DIMENSION(:), INTENT(IN) :: var2
TYPE(PVar), DIMENSION(SIZE(var2)) :: add_vecvar_var
INTEGER:: l
DO l=1, SIZE(var2)
add_vecvar_var(l)%u = var1%u + var2(l)%u
ENDDO
END FUNCTION addition_var_Vecvar
FUNCTION subtraction_var(var1, var2) RESULT(subtract_var)
TYPE(PVar), INTENT(IN) :: var1
TYPE(PVar), INTENT(IN) :: var2
TYPE(PVar) :: subtract_var
subtract_var%u = var1%u - var2%u
END FUNCTION subtraction_var
FUNCTION subtraction_Vecvar(var1, var2) RESULT(subtract_var)
TYPE(PVar), DIMENSION(:), INTENT(IN) :: var1
TYPE(PVar), DIMENSION(:), INTENT(IN) :: var2
TYPE(PVar), DIMENSION(SIZE(var1)) :: subtract_var
INTEGER:: l
DO l=1, SIZE(var1)
subtract_var(l)%u = var1(l)%u - var2(l)%u
ENDDO
END FUNCTION subtraction_Vecvar
FUNCTION subtraction_Vecvar_var(var1, var2) RESULT(subtract_vecvar_var)
TYPE(PVar), DIMENSION(:), INTENT(IN) :: var1
TYPE(PVar), INTENT(IN) :: var2
TYPE(PVar), DIMENSION(SIZE(var1)) :: subtract_vecvar_var
INTEGER:: l
DO l=1, SIZE(var1)
subtract_vecvar_var(l)%u = var1(l)%u - var2%u
ENDDO
END FUNCTION subtraction_Vecvar_var
FUNCTION subtraction_var_Vecvar(var1, var2) RESULT(subtract_vecvar_var)
TYPE(PVar), INTENT(IN) :: var1
TYPE(PVar), DIMENSION(:), INTENT(IN) :: var2
TYPE(PVar), DIMENSION(SIZE(var2)) :: subtract_vecvar_var
INTEGER:: l
DO l=1, SIZE(var2)
subtract_vecvar_var(l)%u = var1%u - var2(l)%u
ENDDO
END FUNCTION subtraction_var_Vecvar
FUNCTION multiple_var_var(var1, var2) RESULT(mult_var_var)
TYPE(PVar), INTENT(IN) :: var1
TYPE(PVar), INTENT(IN) :: var2
TYPE(PVar) :: mult_var_var
mult_var_var%u = var1%u * var2%u
END FUNCTION multiple_var_var
FUNCTION multiple_Vec_Vecvar(var1, var2) RESULT(mult_var_var)
TYPE(PVar), DIMENSION(:), INTENT(IN) :: var1
REAL(dp), DIMENSION(:), INTENT(IN) :: var2
TYPE(PVar), DIMENSION(SIZE(var1)) :: mult_var_var
INTEGER:: i
DO i=1, SIZE(Var1)
mult_var_var(i)%u = var1(i)%u * var2(i)
ENDDO
END FUNCTION multiple_Vec_Vecvar
FUNCTION multiple_Vecvar_Vec(var1, var2) RESULT(mult_var_var)
TYPE(PVar), DIMENSION(:), INTENT(IN) :: var2
REAL(dp), DIMENSION(:), INTENT(IN) :: var1
TYPE(PVar), DIMENSION(SIZE(var1)) :: mult_var_var
INTEGER:: i
DO i=1, SIZE(Var1)
mult_var_var(i)%u = var2(i)%u * var1(i)
ENDDO
END FUNCTION multiple_Vecvar_Vec
FUNCTION multiple_real_var(alpha, var) RESULT(mult_real_var)
REAL(dp), INTENT(IN) :: alpha
TYPE(PVar), INTENT(IN) :: var
TYPE(PVar) :: mult_real_var
mult_real_var%u(:) = alpha * var%u(:)
END FUNCTION multiple_real_var
FUNCTION multiple_var_real(var,alpha) RESULT(mult_var_real)
REAL(dp), INTENT(IN) :: alpha
TYPE(PVar), INTENT(IN) :: var
TYPE(PVar) :: mult_var_real
mult_var_real%u(:) = alpha * var%u(:)
END FUNCTION multiple_var_real
FUNCTION multiple_Vecvar_real(var,alpha) RESULT(mult_var_real)
REAL(dp), INTENT(IN) :: alpha
TYPE(PVar), DIMENSION(:),INTENT(IN) :: var
TYPE(PVar),DIMENSION(SIZE(var)) :: mult_var_real
INTEGER:: l
DO l=1, SIZE(var)
mult_var_real(l)%u(:) = alpha * var(l)%u(:)
ENDDO
END FUNCTION multiple_Vecvar_real
FUNCTION multiple_real_Vecvar(alpha,var) RESULT(mult_var_real)
REAL(dp), INTENT(IN) :: alpha
TYPE(PVar), DIMENSION(:),INTENT(IN) :: var
TYPE(PVar),DIMENSION(SIZE(var)) :: mult_var_real
INTEGER:: l
DO l=1, SIZE(var)
mult_var_real(l)%u(:) = alpha * var(l)%u(:)
ENDDO
END FUNCTION multiple_real_Vecvar
FUNCTION multiple_var_realvec(var,alpha) RESULT(mult_var_vecreal)
REAL(dp), DIMENSION(:), INTENT(IN) :: alpha
TYPE(PVar), INTENT(IN) :: var
TYPE(PVar), DIMENSION(SIZE(alpha)) :: mult_var_vecreal
INTEGER :: l
DO l=1, SIZE(alpha)
mult_var_vecreal(l)%u(:) = alpha(l) * var%u(:)
ENDDO
END FUNCTION multiple_var_realvec
FUNCTION multiple_realvec_var(alpha,var) RESULT(mult_var_vecreal)
REAL(dp), DIMENSION(:), INTENT(IN) :: alpha
TYPE(PVar), INTENT(IN) :: var
TYPE(PVar), DIMENSION(SIZE(alpha)) :: mult_var_vecreal
INTEGER :: l
DO l=1, SIZE(alpha)
mult_var_vecreal(l)%u(:) = alpha(l) * var%u(:)
ENDDO
END FUNCTION multiple_realvec_var
FUNCTION divide_var_real(var,alpha) RESULT(div_var_real)
REAL(dp), INTENT(IN) :: alpha
TYPE(PVar), INTENT(IN) :: var
TYPE(PVar) :: div_var_real
div_var_real%u(:) = var%u(:)/alpha
END FUNCTION divide_var_real
FUNCTION divide_Vecvar_Vecreal(var,alpha) RESULT(div_var_real)
REAL(dp), DIMENSION(:), INTENT(IN) :: alpha
TYPE(PVar), DIMENSION(:), INTENT(IN) :: var
TYPE(PVar), DIMENSION(SIZE(var)) :: div_var_real
INTEGER:: i
DO i=1, SIZE(Var)
div_var_real(i)%u(:) = var(i)%u(:)/alpha(i)
ENDDO
END FUNCTION divide_Vecvar_Vecreal
FUNCTION multiple_vec_tensor(vec, tensor) RESULT (matrix)
REAL(dp), DIMENSION(N_vars, N_vars, N_dim), INTENT(IN) :: tensor
REAL(dp), DIMENSION(n_dim), INTENT(IN) :: vec
REAL(dp), DIMENSION(n_vars,n_vars) :: matrix
INTEGER:: i
matrix=0.0_dp
DO i=1, N_dim
matrix(:,:)= matrix(:,:)+vec(i) * tensor(:,:,i)
ENDDO
END FUNCTION multiple_vec_tensor
FUNCTION multiple_matrix_var(A,var1) RESULT(var2)
REAL, INTENT(in), DIMENSION(:,:):: A
TYPE(PVar), INTENT(in):: var1
TYPE(PVar):: var2
var2%u=MATMUL(A,var1%u)
END FUNCTION multiple_matrix_var
FUNCTION multiple_tensor_vec(tensor, vec) RESULT (matrix)
REAL, DIMENSION(N_vars, N_vars, N_dim), INTENT(IN) :: tensor
REAL, DIMENSION(n_dim), INTENT(IN) :: vec
REAL, DIMENSION(n_vars,n_vars) :: matrix
INTEGER:: i
matrix=0.0_dp
DO i=1, N_dim
matrix(:,:)= matrix(:,:) + vec(i) * tensor(:,:,i)
ENDDO
END FUNCTION multiple_tensor_vec
FUNCTION pvar_sum(pvar_array)
TYPE(PVar), DIMENSION(:), INTENT(in) :: pvar_array
TYPE(PVar) :: pvar_sum
INTEGER :: i
pvar_sum%u(:)=0.0_dp
DO i=1,SIZE(pvar_array)
pvar_sum%u(:) = pvar_sum%u(:) + pvar_array(i)%u(:)
END DO
END FUNCTION pvar_sum
!!!!-----------------------
END MODULE overloading
!!! 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 param2d
USE element_class
USE variable_def
USE arete_class
use precision
IMPLICIT NONE
REAL(dp), PARAMETER:: Pi=ACOS(-1.0)
TYPE maillage
INTEGER:: ndofs
INTEGER:: ns, nt
TYPE(element), DIMENSION(:),ALLOCATABLE:: e
REAL(dp),DIMENSION(:),ALLOCATABLE:: aires
INTEGER:: nsegmt
TYPE(arete), DIMENSION(:), ALLOCATABLE:: edge
END TYPE maillage
TYPE variables
REAL(dp):: dt
INTEGER:: Ncells
TYPE(PVar), DIMENSION(:,:),ALLOCATABLE:: ua, up
TYPE(Pvar), DIMENSION(:),ALLOCATABLE:: un
END TYPE variables
TYPE donnees
INTEGER:: iordret ! also defines the number of levels in the Dec
REAL(dp):: cfl
INTEGER:: ktmax
REAL(dp):: tmax
INTEGER:: ifre
INTEGER:: ischema
INTEGER:: iter
INTEGER:: nt, itype
REAL(dp):: Length, domain_left
REAL(dp):: temps
LOGICAL:: restart=.FALSE.
REAL(dp):: alpha_jump
REAL(dp):: alpha_jump2
INTEGER:: test
END TYPE donnees
END MODULE param2d
MODULE PRECISION
! USE, INTRINSIC :: iso_fortran_env
IMPLICIT NONE
INTEGER, PARAMETER :: sp = kind(1.0)!REAL32
INTEGER, PARAMETER :: dp = kind(1.d0)!REAL64
INTEGER, PARAMETER :: qp = 2*kind(1.d0)!REAL128
END MODULE PRECISION
9.305681557970262E-003 0.999956702462064 0.999956702457821
6.943184420297371E-004 0.999999758965203 0.999999758960960
6.699905217924282E-003 0.999977555719097 0.999977555718993
3.300094782075719E-003 0.999994554692260 0.999994554692157
......@@ -44,7 +44,7 @@ CONTAINS
TYPE(donnees), INTENT(in):: DATA
TYPE(Pvar),DIMENSION(e%nsommets,n_dim):: flux, flux_c
TYPE(Pvar),DIMENSION(e%nsommets,0:DATA%iordret-1):: u, up, u_p, up_p
TYPE(Pvar),DIMENSION(e%nsommets):: res, difference, uu,uu_c
TYPE(Pvar),DIMENSION(e%nsommets):: res, difference, uu,uu_c, source, source_c
INTEGER:: l, lp
DO l=1,e%nsommets
......@@ -62,15 +62,17 @@ CONTAINS
ENDDO
up_P=u_P
flux_c=0._dp; uu=0._dp
flux_c=0._dp; uu=0._dp; source_c=0._dp
DO l=1, e%nsommets
DO lp=0, n_theta(DATA%iordret)-1
flux_c(l,:)= flux_c(l,:)+ theta(lp,k-1,DATA%iordret)* up_P(l,lp)%flux((/e%coor(l)/))
uu(l) = uu(l) + theta(lp,k-1,DATA%iordret)* up (l,lp)
source_c(l)= source_c(l)+ theta(lp,k-1,DATA%iordret)* up_P(l,lp)%source((/e%coor(l)/),DATA%test)
ENDDO
#if (1==0)
! the pure Jacobi-like does not need this, only the
! the Gauss-Seidel like
......@@ -79,6 +81,9 @@ CONTAINS
flux_c(l,:)= flux_c(l,:)-&
&GAMMA(lp, DATA%iordret-1,DATA%iordret)*( up_P(l,lp)%flux( (/e%coor(l)/) )&
& -u_p(l,lp)%flux( (/e%coor(l)/) ) )
source_c(l)= source_c(l)-&
&GAMMA(lp, DATA%iordret-1,DATA%iordret)*( up_P(l,lp)%source( (/e%coor(l)/) ,DATA%test)&
& -u_p(l,lp)%source( (/e%coor(l)/),DATA%test ) )
uu(l)=uu(l) -GAMMA(lp,DATA%iordret-1,DATA%iordret)*( up(l,lp)-u(l,lp))
ENDDO
#endif
......@@ -87,8 +92,9 @@ CONTAINS
DO l=1, n_dim
flux(:,l)=Cons_to_control(flux_c(:,l),e)
ENDDO
source = Cons_to_control(source_c,e)
res=schema( DATA%ischema, e, uu, difference, flux, dt, jt,mesh)
res=schema( DATA%ischema, e, uu, difference, flux, source, dt, jt,mesh)
DO l=1, e%nsommets
Var%un(e%nu(l))=Var%un(e%nu(l))+res(l)
ENDDO
......@@ -128,6 +134,23 @@ CONTAINS
jt2 = ed%jt2
e2=Mesh%e(jt2)
IF (e1%type_flux==2&!4&
& .OR.e1%type_flux==1&!5 &
& .OR.e1%type_flux==4&!5 &
& .OR.e1%type_flux==5&!5 &
& .OR.e1%type_flux==6 &
& .OR.e1%type_flux==7 &
& .OR.e1%type_flux==9) THEN !(with jumps--> Burman'stuff on cell e1 )
!!$
IF (e2%type_flux==2&!4&
& .OR. e2%type_flux==1&!5 &
& .OR. e2%type_flux==4&!5 &
& .OR. e2%type_flux==5&!5 &
& .OR.e2%type_flux==6 &
& .OR.e2%type_flux==7 &
& .OR.e2%type_flux==9) THEN !(with jumps--> Burman'stuff on cell e2 )
ALLOCATE(u1(e1%nsommets), u2(e2%nsommets), resJ(e1%nsommets,2) )
ALLOCATE(ua1(e1%nsommets,0:DATA%iordret-1),&
& ua2(e2%nsommets,0:DATA%iordret-1),&
......@@ -195,11 +218,371 @@ CONTAINS
Var%un(e2%nu(l))=Var%un(e2%nu(l))+resJ(l,2) * dt
ENDDO
DEALLOCATE(resJ,u1,u2,ua1,ua2,up1,up2)
!!$
END IF
END IF
ENDDO
END SUBROUTINE edge_main_update
ENDDO
END SUBROUTINE edge_main_update
SUBROUTINE test(k_iter,Debug,Var, mesh, DATA, flux_mood)
IMPLICIT NONE
! tunable parameters:
REAL(8), PARAMETER:: cour_max=10000.
REAL:: eps1, eps2
REAL, PARAMETER:: coeff=1.!0.
! variables to be checked
INTEGER, PARAMETER:: n_list=1 !3
INTEGER, DIMENSION(n_list), PARAMETER:: list=(/1/)!,2,3/)
!
! emergency schemes
INTEGER, PARAMETER:: theflux=1,theflux2=0
!
!
INTEGER, INTENT(in):: k_iter
TYPE(maillage), INTENT(inout):: mesh
TYPE(variables), INTENT(in):: debug, Var
TYPE(donnees), INTENT(in):: DATA
INTEGER, INTENT(IN):: flux_mood
TYPE(arete):: ed
TYPE(pvar), DIMENSION(:),ALLOCATABLE:: deb
!REAL(8),DIMENSION(:),ALLOCATABLE:: coefficient!with Remi's version of u2
TYPE(element):: e, eL, eR
TYPE(pvar),DIMENSION(:),ALLOCATABLE:: coefficient !!with our version of u2
TYPE(pvar), DIMENSION(:),ALLOCATABLE:: coefficient1, coefficient2
TYPE(pvar), DIMENSION(:),ALLOCATABLE:: v_min, v_max,u2_min,u2_max, u2_minloc, u2_maxloc
REAL, DIMENSION(:),ALLOCATABLE:: w_min, w_max,vd_min, vd_max
TYPE(Pvar),DIMENSION(:), ALLOCATABLE::phys, phys_d,phys_control, phys_d_control
TYPE(Pvar),DIMENSION(:),ALLOCATABLE::temp
REAL(8),DIMENSION(:),ALLOCATABLE:: temp_min, temp_max
INTEGER:: jt, k, l, lk,diag, is, jseg, lkk,r
INTEGER:: jt1, jt2
REAL:: val_min,val_max,eps,xg,yg,val_min_n, val_max_n
REAL :: eps_i, absK
REAL:: ratio, alphaR, alphaL, smooth_sensor
TYPE(pvar),DIMENSION(:),ALLOCATABLE::u1_der, u1_derR, u1_derL
REAL,DIMENSION(:),ALLOCATABLE::u1_derL_mean, u1_der_mean,u1_derR_mean,coefficient_mean
REAL,DIMENSION(:),ALLOCATABLE:: vL_min,vL_max,vR_min,vR_max,vL,vR
INTEGER,PARAMETER :: plateau = 1
INTEGER,PARAMETER :: NAN_criteria = 2
INTEGER,PARAMETER :: PAD_criteria = 3
INTEGER,PARAMETER :: DMP_B1=4
INTEGER,PARAMETER :: DMP_nou2=5
INTEGER,PARAMETER ::DMP_u2_2=6
INTEGER,PARAMETER ::DMP_u2_1=7
! integer, dimension(2,e%nsommets-1):: nuloc
Mesh%e(:)%diag2= Mesh%e(:)%diag
Mesh%e(:)%diag=0
ALLOCATE(v_min(Mesh%nt), v_max(Mesh%nt),w_min(Mesh%nt), w_max(Mesh%nt))
ALLOCATE(vd_min(Mesh%nt), vd_max(Mesh%nt))
ALLOCATE(phys(Mesh%ndofs),phys_d(Mesh%ndofs))
ALLOCATE(phys_control(Mesh%ndofs),phys_d_control(Mesh%ndofs),u2_max(Mesh%nt),u2_min(Mesh%nt))
ALLOCATE(vL(Mesh%nt),vR(Mesh%nt),vL_min(Mesh%nt),vL_max(Mesh%nt),vR_min(Mesh%nt),vR_max(Mesh%nt))
ALLOCate(u1_der_mean(Mesh%nt),u1_derL_mean(Mesh%nt),u1_derR_mean(Mesh%nt),coefficient_mean(Mesh%nt))
!compute physical quantities from interpolated quantities.
! is this really usefull for Bezier thanks to the TV property?
! If not done : more strict condition since Bezier>0==> positive function