8 REAL(KIND=8),
DIMENSION(:,:,:),
INTENT(IN) :: field_in
9 REAL(KIND=8),
DIMENSION(:,:,:),
INTENT(INOUT) :: field_out
11 INTEGER,
POINTER,
DIMENSION(:) :: ifrom
13 REAL(KIND=8),
DIMENSION(SIZE(field_out,1), SIZE(field_out,2)) :: smb_rot_h
14 REAL(KIND=8),
DIMENSION(6) :: rot_h_loc
15 INTEGER,
DIMENSION(mesh_rot_h%gauss%n_w) :: i_loc
16 INTEGER :: i, mode, m, l, j, j_loc, k, nj
17 REAL(KIND=8) :: ray, drdthetadz
18 #include "petsc/finclude/petsc.h"
19 petscerrorcode :: ierr
23 param_rot_h%rel_tol=1.d-6
24 param_rot_h%abs_tol=1.d-10
25 param_rot_h%solver=
'GMRES'
26 param_rot_h%precond=
'MUMPS'
27 param_rot_h%verbose=.false.
29 IF (if_first_rot_h)
THEN
30 if_first_rot_h=.false.
33 CALL veccreateghost(vizu_grad_curl_comm(1), mesh_rot_h%dom_np, &
34 petsc_determine,
SIZE(ifrom), ifrom, vx_phi, ierr)
35 CALL vecghostgetlocalform(vx_phi, vx_phi_ghost, ierr)
36 CALL vecduplicate(vx_phi, vb_phi, ierr)
40 CALL
init_solver(param_rot_h,ksp_rot_h,mat_rot_h,vizu_grad_curl_comm(1),&
41 solver=
'GMRES',precond=
'MUMPS')
42 CALL matdestroy(mat_rot_h,ierr)
48 DO i = 1,
SIZE(vizu_list_mode)
49 mode = vizu_list_mode(i)
51 DO m = 1, mesh_rot_h%me
52 DO l = 1, mesh_rot_h%gauss%l_G
53 ray = sum(mesh_rot_h%rr(1,mesh_rot_h%jj(:,m))*mesh_rot_h%gauss%ww(:,l))
54 drdthetadz = mesh_rot_h%gauss%rj(l,m)
56 DO nj = 1,mesh_rot_h%gauss%n_w
57 j_loc = mesh_rot_h%jj(nj,m)
74 rot_h_loc(1) = rot_h_loc(1) + mode*field_in(j_loc,6,i) &
75 -field_in(j_loc,3,i)*mesh_rot_h%gauss%dw(2,nj,l,m)*ray
76 rot_h_loc(2) = rot_h_loc(2) - mode*field_in(j_loc,5,i) &
77 -field_in(j_loc,4,i)*mesh_rot_h%gauss%dw(2,nj,l,m)*ray
78 rot_h_loc(3) = rot_h_loc(3) + field_in(j_loc,1,i)*mesh_rot_h%gauss%dw(2,nj,l,m)*ray &
79 -field_in(j_loc,5,i)*mesh_rot_h%gauss%dw(1,nj,l,m)*ray
80 rot_h_loc(4) = rot_h_loc(4) + field_in(j_loc,2,i)*mesh_rot_h%gauss%dw(2,nj,l,m)*ray &
81 -field_in(j_loc,6,i)*mesh_rot_h%gauss%dw(1,nj,l,m)*ray
82 rot_h_loc(5) = rot_h_loc(5) + field_in(j_loc,3,i) &
83 +field_in(j_loc,3,i)*mesh_rot_h%gauss%dw(1,nj,l,m)*ray &
84 - mode*field_in(j_loc,2,i)
86 rot_h_loc(6) = rot_h_loc(6) + field_in(j_loc,4,i) &
87 +field_in(j_loc,4,i)*mesh_rot_h%gauss%dw(1,nj,l,m)*ray &
88 + mode*field_in(j_loc,1,i)
90 i_loc = mesh_rot_h%jj(:,m)
93 smb_rot_h(i_loc,k) = smb_rot_h(i_loc,k) + rot_h_loc(k)* &
94 mesh_rot_h%gauss%ww(:,l)*drdthetadz
100 CALL veczeroentries(vb_phi, ierr)
101 CALL vecsetvalues(vb_phi, mesh_rot_h%np, vizu_rot_h_la%loc_to_glob(1,:)-1, smb_rot_h(:,k), add_values, ierr)
102 CALL vecassemblybegin(vb_phi,ierr)
103 CALL vecassemblyend(vb_phi,ierr)
105 CALL
solver(ksp_rot_h,vb_phi,vx_phi,reinit=.false.,
verbose=.false.)
107 CALL vecghostupdatebegin(vx_phi,insert_values,scatter_forward,ierr)
108 CALL vecghostupdateend(vx_phi,insert_values,scatter_forward,ierr)
109 IF (mesh_rot_h%me/=0)
THEN
110 CALL
extract(vx_phi_ghost,1,1,vizu_rot_h_la,field_out(:,k,i))
115 field_out(:,2,i) = 0.d0
116 field_out(:,4,i) = 0.d0
117 field_out(:,6,i) = 0.d0
subroutine compute_rot_h(field_in, field_out)
subroutine, public create_my_ghost(mesh, LA, ifrom)
subroutine init_solver(my_par, my_ksp, matrix, communicator, solver, precond, opt_re_init)
subroutine qs_diff_mass_scal_m(mesh, LA, visco, mass, stab, mode, matrix)
subroutine solver(my_ksp, b, x, reinit, verbose)
subroutine, public extract(xghost, ks, ke, LA, phi)
subroutine create_local_petsc_matrix(communicator, LA, matrix, clean)