47 real(kind=
rp),
allocatable :: d(:,:,:,:)
48 type(c_ptr) :: d_d = c_null_ptr
49 type(
gs_t),
pointer :: gs_h
61 G11_d, G22_d, G33_d, G12_d, G13_d, G23_d, nelv, lx) &
62 bind(c, name=
'hip_jacobi_update')
63 use,
intrinsic :: iso_c_binding
64 type(c_ptr),
value :: d_d, dxt_d, dyt_d, dzt_d
65 type(c_ptr),
value :: G11_d, G22_d, G33_d, G12_d, G13_d, G23_d
66 integer(c_int) :: nelv, lx
72 G11_d, G22_d, G33_d, G12_d, G13_d, G23_d, nelv, lx) &
73 bind(c, name=
'cuda_jacobi_update')
74 use,
intrinsic :: iso_c_binding
75 type(c_ptr),
value :: d_d, dxt_d, dyt_d, dzt_d
76 type(c_ptr),
value :: G11_d, G22_d, G33_d, G12_d, G13_d, G23_d
77 integer(c_int) :: nelv, lx
83 G11_d, G22_d, G33_d, G12_d, G13_d, G23_d, nelv, lx) &
84 bind(c, name=
'opencl_jacobi_update')
85 use,
intrinsic :: iso_c_binding
86 type(c_ptr),
value :: d_d, dxt_d, dyt_d, dzt_d
87 type(c_ptr),
value :: G11_d, G22_d, G33_d, G12_d, G13_d, G23_d
88 integer(c_int) :: nelv, lx
96 type(
coef_t),
intent(inout),
target :: coef
97 type(
dofmap_t),
intent(inout),
target :: dof
98 type(
gs_t),
intent(inout),
target :: gs_h
106 allocate(this%d(dof%Xh%lx,dof%Xh%ly,dof%Xh%lz, dof%msh%nelv))
108 call device_map(this%d, this%d_d,
size(this%d))
117 if (c_associated(this%d_d))
then
119 this%d_d = c_null_ptr
122 if (
allocated(this%d))
then
134 integer,
intent(in) :: n
136 real(kind=
rp),
dimension(n),
intent(inout) :: z
137 real(kind=
rp),
dimension(n),
intent(inout) :: r
138 type(c_ptr) :: z_d, r_d
149 integer :: lz, ly, lx
150 associate(dof => this%dof, coef => this%coef, xh => this%dof%Xh, &
151 gs_h => this%gs_h, nelv => this%dof%msh%nelv)
159 coef%G11_d, coef%G22_d, coef%G33_d, &
160 coef%G12_d, coef%G13_d, coef%G23_d, &
164 coef%G11_d, coef%G22_d, coef%G33_d, &
165 coef%G12_d, coef%G13_d, coef%G23_d, &
169 coef%G11_d, coef%G22_d, coef%G33_d, &
170 coef%G12_d, coef%G13_d, coef%G23_d, &
174 call device_col2(this%d_d, coef%h1_d, coef%dof%size())
177 call device_addcol3(this%d_d, coef%h2_d, coef%B_d, coef%dof%size())
180 call gs_h%op(this%d, dof%size(), gs_op_add)
Return the device pointer for an associated Fortran array.
Map a Fortran array to a device (allocate and associate)
Jacobi preconditioner accelerator backend.
subroutine device_jacobi_free(this)
subroutine device_jacobi_init(this, coef, dof, gs_h)
subroutine device_jacobi_update(this)
subroutine device_jacobi_solve(this, z, r, n)
The jacobi preconditioner where .
subroutine, public device_addcol3(a_d, b_d, c_d, n)
Returns .
subroutine, public device_col2(a_d, b_d, n)
Vector multiplication .
subroutine, public device_invcol1(a_d, n)
Invert a vector .
subroutine, public device_col3(a_d, b_d, c_d, n)
Vector multiplication with 3 vectors .
Device abstraction, common interface for various accelerators.
subroutine, public device_free(x_d)
Deallocate memory on the device.
Defines a mapping of the degrees of freedom.
integer, parameter, public rp
Global precision used in computations.
Coefficients defined on a given (mesh, ) tuple. Arrays use indices (i,j,k,e): element e,...
Defines a jacobi preconditioner.
Defines a canonical Krylov preconditioner.