SFEMaNS  version 4.1 (work in progress)
Reference documentation for SFEMaNS
 All Classes Files Functions Variables Groups Pages
test_23.f90
Go to the documentation of this file.
1 MODULE test_23
2  IMPLICIT NONE
3  !TEST 23
4  REAL (kind=8),PARAMETER, PUBLIC :: ratio_mu_T23 = 50.0d0 ! the variation of mu1
5  REAL (kind=8), PUBLIC :: b_factor_T23 = (1.d0/0.00016) * (ratio_mu_T23 - 1.d0)/(ratio_mu_T23 +1.d0)
6  REAL (kind=8), PUBLIC :: lambda_mu_T23 = 1.d0
7  INTEGER, PUBLIC :: mode_mu_T23 = 3
8 
9 CONTAINS
10 
11  FUNCTION s_test_t23(r,z) RESULT(vv)
12  IMPLICIT NONE
13  REAL(KIND=8) :: r, z
14  REAL(KIND=8) :: vv
15  vv = b_factor_t23*( r*(r-1.d0)*(r-2.d0)*(z-0.25)*(z-1.d0) )**3
16  RETURN
17  END FUNCTION s_test_t23
18 
19  FUNCTION ds_test_t23(r,z) RESULT(vv)
20  IMPLICIT NONE
21  REAL(KIND=8) :: r, z
22  REAL(KIND=8),DIMENSION(2) :: vv
23  vv(1) = b_factor_t23*((z-0.25)*(z-1.d0))**3 * &
24  ( 3*( r*(r-1.d0)*(r-2.d0) )**2*( r*( (r-1)+(r-2) ) + (r-1)*(r-2) ) )
25 
26  vv(2) = b_factor_t23*( r*(r-1.d0)*(r-2.d0))**3 * &
27  ( 3* (z-0.25)*(z-1.d0) )**2 *( (z-1.d0) + (z-0.25) )
28  RETURN
29  END FUNCTION ds_test_t23
30 
31  FUNCTION mu_bar_in_fourier_space_anal_t23(H_mesh,nb,ne,pts,pts_ids) RESULT(vv)
32  USE def_type_mesh
33  USE input_data
34  USE my_util
35  IMPLICIT NONE
36  TYPE(mesh_type) :: h_mesh
37  REAL(KIND=8), DIMENSION(ne-nb+1) :: vv
38  INTEGER :: nb, ne
39  REAL(KIND=8),DIMENSION(2,ne-nb+1),OPTIONAL :: pts
40  INTEGER,DIMENSION(ne-nb+1),OPTIONAL :: pts_ids
41  INTEGER, DIMENSION(H_mesh%np) :: global_ids
42  INTEGER, DIMENSION(ne-nb+1) :: local_ids
43  INTEGER :: n,m
44  REAL(KIND=8),DIMENSION(ne-nb+1) :: r,z
45  REAL(KIND=8) :: s
46 
47  IF( present(pts) .AND. present(pts_ids) ) THEN !Computing mu at pts
48  r=pts(1,nb:ne)
49  z=pts(2,nb:ne)
50  local_ids=pts_ids
51  ELSE
52  r=h_mesh%rr(1,nb:ne) !Computing mu at nodes
53  z=h_mesh%rr(2,nb:ne)
54  DO m = 1, h_mesh%me
55  global_ids(h_mesh%jj(:,m)) = h_mesh%i_d(m)
56  END DO
57  local_ids=global_ids(nb:ne)
58  END IF
59 
60  DO n = 1, ne - nb + 1
61  s = s_test_t23(r(n),z(n))
62  IF(local_ids(n)==1) THEN
63  vv(n) = 1.d0/(1.d0 + abs(s)) !mu1_bar, DCQ: If you change mu1_bar, you have to change
64  !Jexact_gauss() as well
65  ELSE
66  vv(n) = 1.d0/( (1.d0 + abs(s)))*(1.d0 + lambda_mu_t23/z(n)) !mu2_bar
67  END IF
68  END DO
69  RETURN
71 
72  !===Analytical grad_mu_in_fourier_space (if needed)
73  FUNCTION grad_mu_bar_in_fourier_space_anal_t23(pt,pt_id) RESULT(vv)
74  USE input_data
75  USE my_util
76  IMPLICIT NONE
77  REAL(KIND=8),DIMENSION(2) :: vv
78  REAL(KIND=8),DIMENSION(2) :: pt
79  INTEGER,DIMENSION(1) :: pt_id
80  REAL(KIND=8) :: r,z,sign,s
81  REAL(KIND=8),DIMENSION(2) :: tmp
82 
83  r=pt(1)
84  z=pt(2)
85 
86  s=s_test_t23(r,z)
87  IF (s .GE. 0.d0 ) THEN
88  sign =1.0
89  ELSE
90  sign =-1.0
91  END IF
92 
93  tmp=ds_test_t23(r,z)!derivative
94 
95  IF(pt_id(1)==1) THEN !grad_mu_1
96  vv(1)=-sign*tmp(1)/(1.d0 +abs(s))**2
97  vv(2)=-sign*tmp(2)/(1.d0 +abs(s))**2
98  ELSE !grad_mu_2
99  vv(1)=-sign*tmp(1)/(1.d0 +abs(s))**2*(1+lambda_mu_t23/z)
100  vv(2)=-sign*tmp(2)/(1.d0 +abs(s))**2*(1+lambda_mu_t23/z) + 1.d0/(1.d0+abs(s))*(-lambda_mu_t23/z**2)
101  END IF
102  RETURN
104 
105  FUNCTION mu_in_real_space_anal_t23(H_mesh,angles,nb_angles,nb,ne) RESULT(vv)
106  USE def_type_mesh
107  IMPLICIT NONE
108  TYPE(mesh_type) :: h_mesh
109  REAL(KIND=8), DIMENSION(:) :: angles
110  INTEGER :: nb_angles
111  INTEGER :: nb, ne
112  REAL(KIND=8), DIMENSION(nb_angles,ne-nb+1) :: vv
113  INTEGER :: ang, n_loc, m, n
114  REAL(KIND=8) :: tmp
115  INTEGER, DIMENSION(H_mesh%np) :: id
116  DO m = 1, h_mesh%me
117  id(h_mesh%jj(:,m)) = h_mesh%i_d(m) !DCQ: Speed Efficient but requires more memory
118  END DO
119  DO n = nb, ne
120  n_loc = n - nb + 1
121  tmp = s_test_t23(h_mesh%rr(1,n),h_mesh%rr(2,n))
122  DO ang = 1, nb_angles
123 
124  IF (id(n)==1) THEN
125  vv(ang,n_loc) = 1.d0/(1.d0 + tmp*cos(mode_mu_t23*angles(ang)) )!mu_1
126  ELSE
127  vv(ang,n_loc) = 1.d0/( 1.d0 + tmp*cos(mode_mu_t23*angles(ang)) ) &
128  *( 1.d0 + lambda_mu_t23/(h_mesh%rr(2,n)) ) !mu_2
129  ENDIF
130  END DO
131  END DO
132  END FUNCTION mu_in_real_space_anal_t23
133 
134 END MODULE test_23
real(kind=8) function s_test_t23(r, z)
Definition: test_23.f90:11
real(kind=8) function, dimension(2) ds_test_t23(r, z)
Definition: test_23.f90:19
real(kind=8) function, dimension(ne-nb+1) mu_bar_in_fourier_space_anal_t23(H_mesh, nb, ne, pts, pts_ids)
Definition: test_23.f90:31
real(kind=8) function, dimension(2) grad_mu_bar_in_fourier_space_anal_t23(pt, pt_id)
Definition: test_23.f90:73
real(kind=8) function, dimension(nb_angles, ne-nb+1) mu_in_real_space_anal_t23(H_mesh, angles, nb_angles, nb, ne)
Definition: test_23.f90:105
section doc_intro_frame_work_num_app Numerical approximation subsection doc_intro_fram_work_num_app_Fourier_FEM Fourier Finite element representation The SFEMaNS code uses a hybrid Fourier Finite element formulation The Fourier decomposition allows to approximate the problem’s solutions for each Fourier mode modulo nonlinear terms that are made explicit The variables are then approximated on a meridian section of the domain with a finite element method The numerical approximation of a function f $f f is written in the following generic z
Definition: doc_intro.h:193