12 INTEGER,
DIMENSION(:),
POINTER :: js_d
13 LOGICAL,
DIMENSION(mesh%dom_np) :: virgin
14 INTEGER:: nn, ms, n, p, n_d, nws
15 REAL(kind=8) :: eps=1.d-10
17 nws =
SIZE(mesh%jjs,1)
20 DO ms = 1, mesh%dom_mes
21 IF (maxval(abs(mesh%rr(1,mesh%jjs(:,ms)))).GT.eps) cycle
24 IF (p>mesh%dom_np) cycle
37 DO ms = 1, mesh%dom_mes
38 IF (maxval(abs(mesh%rr(1,mesh%jjs(:,ms)))).GT.eps) cycle
41 IF (p>mesh%dom_np) cycle
45 js_d(nn) = mesh%jjs(n,ms)
56 INTEGER,
DIMENSION(:),
INTENT(IN) :: list_dirichlet_sides
57 INTEGER,
DIMENSION(:),
POINTER :: js_d
58 LOGICAL,
DIMENSION(:),
POINTER :: virgin
59 INTEGER:: nn, ms, n, p, n_d, nws
61 IF (
SIZE(list_dirichlet_sides)==0)
THEN
66 nws =
SIZE(mesh%jjs,1)
68 ALLOCATE(virgin(mesh%dom_np))
70 DO ms = 1, mesh%dom_mes
71 IF (minval(abs(mesh%sides(ms)-list_dirichlet_sides))/=0) cycle
74 IF (p>mesh%dom_np) cycle
85 DO ms = 1, mesh%dom_mes
86 IF (minval(abs(mesh%sides(ms)-list_dirichlet_sides))/=0) cycle
89 IF (p>mesh%dom_np) cycle
93 js_d(nn) = mesh%jjs(n,ms)
105 INTEGER,
DIMENSION(:),
INTENT(IN) :: list_dirichlet_sides
106 INTEGER,
DIMENSION(:),
POINTER :: js_d
107 LOGICAL,
DIMENSION(:),
POINTER :: virgin
108 INTEGER:: nn, ms, n, p, n_d, nws
110 IF (
SIZE(list_dirichlet_sides)==0)
THEN
115 nws =
SIZE(mesh%jjs,1)
117 ALLOCATE(virgin(mesh%np))
119 DO ms = 1, mesh%dom_mes
120 IF (minval(abs(mesh%sides(ms)-list_dirichlet_sides))/=0) cycle
123 IF (p>mesh%np) CALL
error_petsc(
'BUG in dirichlet_nodes_local')
134 DO ms = 1, mesh%dom_mes
135 IF (minval(abs(mesh%sides(ms)-list_dirichlet_sides))/=0) cycle
138 IF (p>mesh%np) CALL
error_petsc(
'BUG in dirichlet_nodes_local')
142 js_d(nn) = mesh%jjs(n,ms)
151 INTEGER,
DIMENSION(:),
INTENT(IN) :: glob_js_d
153 INTEGER,
DIMENSION(:),
POINTER :: bubu_test
154 #include "petsc/finclude/petsc.h"
156 petscerrorcode :: ierr
157 n_d =
SIZE(glob_js_d)
158 ALLOCATE(bubu_test(n_d))
160 bubu_test = glob_js_d-1
163 CALL matzerorows(matrix, n_d, bubu_test, 1.d0, petsc_null_object, petsc_null_object, ierr)
164 CALL matassemblybegin(matrix,mat_final_assembly,ierr)
165 CALL matassemblyend(matrix,mat_final_assembly,ierr)
167 DEALLOCATE(bubu_test)
173 INTEGER,
DIMENSION(:) :: js_d
174 REAL(KIND=8),
DIMENSION(:) :: bs_d
176 #include "petsc/finclude/petsc.h"
178 petscerrorcode :: ierr
181 CALL vecsetvalues(b, n_d, js_d, bs_d, insert_values, ierr)
183 CALL vecassemblybegin(b,ierr)
184 CALL vecassemblyend(b,ierr)
188 SUBROUTINE vector_glob_js_d(vv_mesh, list_mode, vv_3_LA, vv_list_dirichlet_sides, vv_js_D, vv_mode_global_js_D)
192 INTEGER,
DIMENSION(:),
INTENT(IN) :: list_mode
194 TYPE(dyn_int_line
),
DIMENSION(3),
INTENT(IN) :: vv_list_dirichlet_sides
195 TYPE(dyn_int_line
),
DIMENSION(:),
POINTER :: vv_mode_global_js_d
196 TYPE(dyn_int_line
),
DIMENSION(3),
INTENT(OUT):: vv_js_d
197 INTEGER,
DIMENSION(:),
POINTER :: vv_js_axis_d
198 INTEGER :: k, m_max_c, i, n1, n2, n3, n123, nalloc, nx
199 m_max_c =
SIZE(list_mode)
206 ALLOCATE(vv_mode_global_js_d(m_max_c))
208 n1 =
SIZE(vv_js_d(1)%DIL)
209 n2 =
SIZE(vv_js_d(2)%DIL)
210 n3 =
SIZE(vv_js_d(3)%DIL)
211 nx =
SIZE(vv_js_axis_d)
213 IF (list_mode(i)==0)
THEN
215 ELSE IF (list_mode(i)==1)
THEN
220 ALLOCATE(vv_mode_global_js_d(i)%DIL(nalloc))
221 vv_mode_global_js_d(i)%DIL(1:n1) = vv_3_la%loc_to_glob(1,vv_js_d(1)%DIL)
222 vv_mode_global_js_d(i)%DIL(n1+1:n1+n2) = vv_3_la%loc_to_glob(2,vv_js_d(2)%DIL)
223 vv_mode_global_js_d(i)%DIL(n1+n2+1:n123) = vv_3_la%loc_to_glob(3,vv_js_d(3)%DIL)
225 IF (list_mode(i)==0 .AND. nx>0)
THEN
226 vv_mode_global_js_d(i)%DIL(n123+1:n123+nx) = vv_3_la%loc_to_glob(1,vv_js_axis_d)
227 vv_mode_global_js_d(i)%DIL(n123+nx+1:) = vv_3_la%loc_to_glob(2,vv_js_axis_d)
228 ELSE IF (list_mode(i)==1 .AND. nx>0)
THEN
229 vv_mode_global_js_d(i)%DIL(n123+1:) = vv_3_la%loc_to_glob(3,vv_js_axis_d)
230 ELSE IF (list_mode(i).GE.2 .AND. nx>0)
THEN
231 vv_mode_global_js_d(i)%DIL(n123+1:n123+nx) = vv_3_la%loc_to_glob(1,vv_js_axis_d)
232 vv_mode_global_js_d(i)%DIL(n123+nx+1:n123+2*nx)= vv_3_la%loc_to_glob(2,vv_js_axis_d)
233 vv_mode_global_js_d(i)%DIL(n123+2*nx+1:) = vv_3_la%loc_to_glob(3,vv_js_axis_d)
243 INTEGER,
DIMENSION(:),
INTENT(IN) :: list_mode
245 TYPE(dyn_int_line
),
DIMENSION(:),
POINTER :: vv_mode_global_js_d
246 INTEGER,
DIMENSION(:),
POINTER :: vv_js_axis_d
247 INTEGER :: m_max_c, i, nalloc, nx
249 m_max_c =
SIZE(list_mode)
251 ALLOCATE(vv_mode_global_js_d(m_max_c))
253 nx =
SIZE(vv_js_axis_d)
254 IF (list_mode(i)==0)
THEN
256 ELSE IF (list_mode(i)==1)
THEN
261 ALLOCATE(vv_mode_global_js_d(i)%DIL(nalloc))
263 IF (list_mode(i)==0 .AND. nx>0)
THEN
264 vv_mode_global_js_d(i)%DIL(1:nx) = vv_3_la%loc_to_glob(1,vv_js_axis_d)
265 vv_mode_global_js_d(i)%DIL(nx+1:) = vv_3_la%loc_to_glob(2,vv_js_axis_d)
266 ELSE IF (list_mode(i)==1 .AND. nx>0)
THEN
267 vv_mode_global_js_d(i)%DIL = vv_3_la%loc_to_glob(3,vv_js_axis_d)
268 ELSE IF (list_mode(i).GE.2 .AND. nx>0)
THEN
269 vv_mode_global_js_d(i)%DIL(1:nx) = vv_3_la%loc_to_glob(1,vv_js_axis_d)
270 vv_mode_global_js_d(i)%DIL(nx+1:2*nx)= vv_3_la%loc_to_glob(2,vv_js_axis_d)
271 vv_mode_global_js_d(i)%DIL(2*nx+1:) = vv_3_la%loc_to_glob(3,vv_js_axis_d)
282 INTEGER,
DIMENSION(:),
INTENT(IN) :: list_mode
284 TYPE(dyn_int_line
),
DIMENSION(:),
POINTER :: pp_mode_global_js_d
285 INTEGER,
DIMENSION(:),
INTENT(IN) :: pp_js_d
286 INTEGER,
DIMENSION(:),
POINTER :: pp_js_axis_d
287 INTEGER :: m_max_c, i, n, nalloc, nx
289 m_max_c =
SIZE(list_mode)
292 ALLOCATE(pp_mode_global_js_d(m_max_c))
295 nx =
SIZE(pp_js_axis_d)
296 IF (list_mode(i)==0)
THEN
302 ALLOCATE(pp_mode_global_js_d(i)%DIL(nalloc))
303 pp_mode_global_js_d(i)%DIL(1:n) = pp_1_la%loc_to_glob(1,pp_js_d)
305 IF (list_mode(i).GE.1 .AND. nx>0)
THEN
306 pp_mode_global_js_d(i)%DIL(n+1:n+nx) = pp_1_la%loc_to_glob(1,pp_js_axis_d)
316 INTEGER,
DIMENSION(:),
INTENT(IN) :: list_mode
318 TYPE(dyn_int_line
),
DIMENSION(:),
POINTER :: pp_mode_global_js_d
319 INTEGER,
DIMENSION(:),
POINTER :: pp_js_axis_d
320 INTEGER :: m_max_c, i, nalloc, nx
322 m_max_c =
SIZE(list_mode)
324 ALLOCATE(pp_mode_global_js_d(m_max_c))
326 nx =
SIZE(pp_js_axis_d)
327 IF (list_mode(i)==0)
THEN
332 ALLOCATE(pp_mode_global_js_d(i)%DIL(nalloc))
333 IF (list_mode(i).GE.1 .AND. nx>0)
THEN
334 pp_mode_global_js_d(i)%DIL = pp_1_la%loc_to_glob(1,pp_js_axis_d)
subroutine dirichlet_rhs(js_D, bs_D, b)
subroutine vector_glob_js_d(vv_mesh, list_mode, vv_3_LA, vv_list_dirichlet_sides, vv_js_D, vv_mode_global_js_D)
subroutine scalar_glob_js_d(pp_mesh, list_mode, pp_1_LA, pp_mode_global_js_D)
subroutine dirichlet_nodes_parallel(mesh, list_dirichlet_sides, js_d)
subroutine dirichlet_m_parallel(matrix, glob_js_D)
subroutine dir_axis_nodes_parallel(mesh, js_d)
subroutine dirichlet_nodes_local(mesh, list_dirichlet_sides, js_d)
subroutine error_petsc(string)
subroutine scalar_with_bc_glob_js_d(pp_mesh, list_mode, pp_1_LA, pp_js_D, pp_mode_global_js_D)
subroutine vector_without_bc_glob_js_d(vv_mesh, list_mode, vv_3_LA, vv_mode_global_js_D)