Model.f90 1.83 KB
Newer Older
rabgra's avatar
add 1D  
rabgra committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
!!!  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)
32
    CASE(1,3,4,7,11,12,13,14) ! Lagrange
rabgra's avatar
add 1D  
rabgra committed
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56

    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)
57
    CASE(1,3,4,7,11,12,13,14) ! Lagrange
rabgra's avatar
add 1D  
rabgra committed
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75


    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