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
# FICHIER DE CREATION D'OBJETS ET D'UN EXECUTABLE
# RANGEMENT PAR ORDRE ALPHABETIQUE
#
# VERSION DEBBUGGEUR -db
# VERSION OPTIMISEUR
F90=gfortran
OBJDIR = obj1D
MODDIR = mod1D
BINDIR = bin1D
SRC = ./
MODEL_VAR= variable_def_scalar_1D
FFLAGS = -DLINUX -J$(MODDIR) -I$(PETSC_DIR)/include -I/usr/lib/openmpi/include -cpp -c $(OPT) -ffree-line-length-none
LDFLAGS= -J$(MODDIR) -I$(PETSC_DIR)/include -I/usr/lib/openmpi/include -L/usr/lib -cpp $(OPT) -ffree-line-length-none
OBJS = $(addprefix $(OBJDIR)/, elements_1D.o param2d.o geometry.o algebra.o precision.o $(MODEL_VAR).o overloading.o aretes.o )
dec: $(MODDIR) $(OBJDIR) $(BINDIR) $(OBJS) $(SRC)/main.f90
$(F90) $(LDFLAGS) -o $(BINDIR)/main.out $(SRC)/main.f90 $(OBJS)
$(MODDIR):
mkdir -p $(MODDIR)
$(OBJDIR):
mkdir -p $(OBJDIR)
$(BINDIR):
mkdir -p $(BINDIR)
$(OBJDIR)/$(MODEL_VAR).o: $(OBJDIR)/algebra.o $(SRC)/$(MODEL_VAR).f90 $(OBJDIR)/precision.o $(OBJDIR)/aretes.o
$(F90) $(FFLAGS) -o $(OBJDIR)/$(MODEL_VAR).o $(SRC)/$(MODEL_VAR).f90
$(OBJDIR)/param2d.o: $(SRC)/param2d.f90 $(OBJDIR)/elements_1D.o $(OBJDIR)/precision.o
$(F90) $(FFLAGS) -o $(OBJDIR)/param2d.o $(SRC)/param2d.f90
$(OBJDIR)/geometry.o: $(SRC)/param2d.f90 $(OBJDIR)/elements_1D.o $(SRC)/geometry.f90 $(OBJDIR)/precision.o
$(F90) $(FFLAGS) -o $(OBJDIR)/geometry.o $(SRC)/geometry.f90
$(OBJDIR)/algebra.o: $(SRC)/algebra.f90 $(OBJDIR)/precision.o
$(F90) $(FFLAGS) -o $(OBJDIR)/algebra.o $(SRC)/algebra.f90
$(OBJDIR)/elements_1D.o: $(SRC)/elements_1D.f90 $(OBJDIR)/algebra.o $(OBJDIR)/precision.o $(OBJDIR)/$(MODEL_VAR).o $(OBJDIR)/overloading.o
$(F90) $(FFLAGS) -o $(OBJDIR)/elements_1D.o $(SRC)/elements_1D.f90
$(OBJDIR)/precision.o: $(SRC)/precision.f90
$(F90) $(FFLAGS) -o $(OBJDIR)/precision.o $(SRC)/precision.f90
$(OBJDIR)/overloading.o: $(SRC)/overloading.f90 $(OBJDIR)/$(MODEL_VAR).o $(OBJDIR)/precision.o
$(F90) $(FFLAGS) -o $(OBJDIR)/overloading.o $(SRC)/overloading.f90
$(OBJDIR)/aretes.o: $(SRC)/aretes.f90 $(OBJDIR)/precision.o
$(F90) $(FFLAGS) -o $(OBJDIR)/aretes.o $(SRC)/aretes.f90
clean:
rm -rf $(OBJDIR)
rm -rf $(MODDIR)
rm -rf $(BINDIR)
rm $(SRC)/*.f90~
rm *.mod
# FICHIER DE CREATION D'OBJETS ET D'UN EXECUTABLE
# RANGEMENT PAR ORDRE ALPHABETIQUE
#
# VERSION DEBBUGGEUR -db
# VERSION OPTIMISEUR
F90=ifort
OBJDIR = obj1D
MODDIR = mod1D
BINDIR = bin1D
SRC = ./
MODEL_VAR= variable_def_scalar_1D
FFLAGS = -c -fpp -pg # -C -check all -fltconsistency -fpe0 -ftrapuv -fpe-all=3 -ftrapuv -g -c -traceback -debug extended -ftz #-fast -c -p -fpp #-debug all #-fast -c -p -fpp #
LDFLAGS= -fpp -pg # -C -check all -fltconsistency -fpe-all=3 -ftrapuv -ftz -traceback -debug extended #-fpp -fast -p #-debug all # -fast -p #
OBJS = $(addprefix $(OBJDIR)/, elements_1D.o param2d.o geometry.o algebra.o precision.o $(MODEL_VAR).o overloading.o aretes.o )
dec: $(MODDIR) $(OBJDIR) $(BINDIR) $(OBJS) $(SRC)/main.f90
$(F90) $(LDFLAGS) -o $(BINDIR)/main.out $(SRC)/main.f90 $(OBJS)
$(MODDIR):
mkdir -p $(MODDIR)
$(OBJDIR):
mkdir -p $(OBJDIR)
$(BINDIR):
mkdir -p $(BINDIR)
$(OBJDIR)/$(MODEL_VAR).o: $(OBJDIR)/algebra.o $(SRC)/$(MODEL_VAR).f90 $(OBJDIR)/precision.o $(OBJDIR)/aretes.o
$(F90) $(FFLAGS) -o $(OBJDIR)/$(MODEL_VAR).o $(SRC)/$(MODEL_VAR).f90
$(OBJDIR)/param2d.o: $(SRC)/param2d.f90 $(OBJDIR)/elements_1D.o $(OBJDIR)/precision.o
$(F90) $(FFLAGS) -o $(OBJDIR)/param2d.o $(SRC)/param2d.f90
$(OBJDIR)/geometry.o: $(SRC)/param2d.f90 $(OBJDIR)/elements_1D.o $(SRC)/geometry.f90 $(OBJDIR)/precision.o
$(F90) $(FFLAGS) -o $(OBJDIR)/geometry.o $(SRC)/geometry.f90
$(OBJDIR)/algebra.o: $(SRC)/algebra.f90 $(OBJDIR)/precision.o
$(F90) $(FFLAGS) -o $(OBJDIR)/algebra.o $(SRC)/algebra.f90
$(OBJDIR)/elements_1D.o: $(SRC)/elements_1D.f90 $(OBJDIR)/algebra.o $(OBJDIR)/precision.o $(OBJDIR)/$(MODEL_VAR).o $(OBJDIR)/overloading.o
$(F90) $(FFLAGS) -o $(OBJDIR)/elements_1D.o $(SRC)/elements_1D.f90
$(OBJDIR)/precision.o: $(SRC)/precision.f90
$(F90) $(FFLAGS) -o $(OBJDIR)/precision.o $(SRC)/precision.f90
$(OBJDIR)/overloading.o: $(SRC)/overloading.f90 $(OBJDIR)/$(MODEL_VAR).o $(OBJDIR)/precision.o
$(F90) $(FFLAGS) -o $(OBJDIR)/overloading.o $(SRC)/overloading.f90
$(OBJDIR)/aretes.o: $(SRC)/aretes.f90 $(OBJDIR)/precision.o
$(F90) $(FFLAGS) -o $(OBJDIR)/aretes.o $(SRC)/aretes.f90
clean:
rm -rf $(OBJDIR)
rm -rf $(MODDIR)
rm -rf $(BINDIR)
rm $(SRC)/*.f90~
rm *.mod
# FICHIER DE CREATION D'OBJETS ET D'UN EXECUTABLE
# RANGEMENT PAR ORDRE ALPHABETIQUE
#
# VERSION DEBBUGGEUR -db
# VERSION OPTIMISEUR
F90=ifort
OBJDIR = obj1D
MODDIR = mod1D
BINDIR = bin1D
SRC = ./
MODEL_VAR= variable_def_scalar_1D
FFLAGS = -c -r8 -fpp -pg -C -check all -fltconsistency -fpe0 -ftrapuv -fpe-all=3 -ftrapuv -g -c -traceback -debug extended -ftz #-fast -c -p -fpp #-debug all #-fast -c -p -fpp #
LDFLAGS= -r8 -fpp -pg -C -check all -fltconsistency -fpe-all=3 -ftrapuv -ftz -traceback -debug extended #-fpp -fast -p #-debug all # -fast -p #
OBJS = $(addprefix $(OBJDIR)/, elements_1D.o param2d.o geometry.o algebra.o precision.o $(MODEL_VAR).o overloading.o aretes.o )
dec: $(MODDIR) $(OBJDIR) $(BINDIR) $(OBJS) $(SRC)/main.f90
$(F90) $(LDFLAGS) -o $(BINDIR)/main.out $(SRC)/main.f90 $(OBJS)
$(MODDIR):
mkdir -p $(MODDIR)
$(OBJDIR):
mkdir -p $(OBJDIR)
$(BINDIR):
mkdir -p $(BINDIR)
$(OBJDIR)/$(MODEL_VAR).o: $(OBJDIR)/algebra.o $(SRC)/$(MODEL_VAR).f90 $(OBJDIR)/precision.o $(OBJDIR)/aretes.o
$(F90) $(FFLAGS) -o $(OBJDIR)/$(MODEL_VAR).o $(SRC)/$(MODEL_VAR).f90
$(OBJDIR)/param2d.o: $(SRC)/param2d.f90 $(OBJDIR)/elements_1D.o $(OBJDIR)/precision.o
$(F90) $(FFLAGS) -o $(OBJDIR)/param2d.o $(SRC)/param2d.f90
$(OBJDIR)/geometry.o: $(SRC)/param2d.f90 $(OBJDIR)/elements_1D.o $(SRC)/geometry.f90 $(OBJDIR)/precision.o
$(F90) $(FFLAGS) -o $(OBJDIR)/geometry.o $(SRC)/geometry.f90
$(OBJDIR)/algebra.o: $(SRC)/algebra.f90 $(OBJDIR)/precision.o
$(F90) $(FFLAGS) -o $(OBJDIR)/algebra.o $(SRC)/algebra.f90
$(OBJDIR)/elements_1D.o: $(SRC)/elements_1D.f90 $(OBJDIR)/algebra.o $(OBJDIR)/precision.o $(OBJDIR)/$(MODEL_VAR).o $(OBJDIR)/overloading.o
$(F90) $(FFLAGS) -o $(OBJDIR)/elements_1D.o $(SRC)/elements_1D.f90
$(OBJDIR)/precision.o: $(SRC)/precision.f90
$(F90) $(FFLAGS) -o $(OBJDIR)/precision.o $(SRC)/precision.f90
$(OBJDIR)/overloading.o: $(SRC)/overloading.f90 $(OBJDIR)/$(MODEL_VAR).o $(OBJDIR)/precision.o
$(F90) $(FFLAGS) -o $(OBJDIR)/overloading.o $(SRC)/overloading.f90
$(OBJDIR)/aretes.o: $(SRC)/aretes.f90 $(OBJDIR)/precision.o
$(F90) $(FFLAGS) -o $(OBJDIR)/aretes.o $(SRC)/aretes.f90
clean:
rm -rf $(OBJDIR)
rm -rf $(MODDIR)
rm -rf $(BINDIR)
rm $(SRC)/*.f90~
rm *.mod
!!! 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
!!$ IF (module_debug) THEN
!!$ DO l = 1, Size(mat, 2)
!!$ DO zz = 1, Size(mat, 1)
!!$ PRINT fmt_prec2, mod_name, "Mat ", 10000 * zz + l, " ", mat(zz, l)
!!$ END DO
!!$ END DO
!!$ END IF
CALL ludcmp(mat2, Nsize, indx, d) !-- indx OUT
!!$ IF (module_debug) THEN
!!$ DO l = 1, Size(mat2, 2)
!!$ DO zz = 1, Size(mat2, 1)
!!$ PRINT fmt_prec2, mod_name, "mat2 ", 10000 * zz + l, " ", mat2(zz, l)
!!$ END DO
!!$ END DO
!!$ END IF
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
!!$ IF (module_debug) THEN
!!$ DO l = 1, Size(mat1, 2)
!!$ DO zz = 1, Size(mat1, 1)
!!$ PRINT fmt_prec2, mod_name, "mat1 ", 10000 * zz + l, " ", mat1(zz, l)
!!$ END DO
!!$ END DO
!!$ END IF
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
DO i = 1, Nsize
IF (optim1_plain) THEN
Big = MAXVAL(ABS(mat3(i, :)))
ELSE
Big = 0.0
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) THEN
WRITE( *, *) mod_name, " ERREUR : Matrice singuliere, i==", i
STOP
END IF
vv(i) = 1.0 / Big
END DO
!!$ IF (module_debug) THEN
!!$ DO zz = 1, Size(vv, 1)
!!$ PRINT fmt_prec2, mod_name, "vv ", zz, " ", vv(zz)
!!$ END DO
!!$ END IF
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
!!$ IF (module_debug) THEN
!!$ DO zz = 1, j - 1
!!$ PRINT fmt_prec2, mod_name, "mat3/a ", 10000 * zz + j, " ", mat3(zz, j)
!!$ END DO
!!$ END IF
Big = 0.0
imax = -1
DO i = j, Nsize
somme = mat3(i, j)
!!$ IF (module_debug) THEN
!!$ PRINT fmt_prec2, mod_name, "somme/a ", 10000 * i + j, " ", somme
!!$ END IF
DO k = 1, j -1
somme = somme - mat3(i, k) * mat3(k, j)
! IF (module_debug) THEN
! PRINT fmt_prec2, mod_name, "somme/b ", k, " ", somme
! END IF
END DO
!!$ IF (module_debug) THEN
!!$ PRINT fmt_prec2, mod_name, "somme ", 10000 * i + j, " ", somme
!!$ END IF
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 (module_debug) THEN
!!$ DO zz = j, Nsize
!!$ PRINT fmt_prec2, mod_name, "mat3/b ", 10000 * zz + j, " ", mat3(zz, j)
!!$ END DO
!!$ END IF
!!$ IF (imax < 0) THEN
!!$ PRINT *, mod_name, " :: ERREUR : imax non initialise"
!!$ stop
!!$ END IF
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
!!$ IF (module_debug) THEN
!!$ DO zz = 1, Nsize
!!$ PRINT fmt_prec2, mod_name, "mat3/c ", 10000 * zz + j, " ", mat3(zz, j)
!!$ END DO
!!$ END IF
indx(j) = imax
IF (ABS(mat3(j, j)) <= 1.0e-20) 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
!!$ IF (module_debug) THEN
!!$ DO zz = j + 1, Nsize
!!$ PRINT fmt_prec2, mod_name, "mat3/d ", 10000 * zz + j, " ", mat3(zz, j)
!!$ END DO
!!$ 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) 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
!!! 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
1000 nt
3 itype 1: P1, 2: B2, 3: P2, 4:P3, 5: B3