From 8f6000f940d1b42d0a32545630e553009e577890 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Mon, 20 Oct 2025 16:37:47 +0200 Subject: [PATCH] Fix OpenACC files --- openacc/psb_c_oacc_csr_mat_mod.F90 | 48 ++++++++++++++++------ openacc/psb_c_oacc_ell_mat_mod.F90 | 66 ++++++++++++++++++++++-------- openacc/psb_c_oacc_hll_mat_mod.F90 | 2 +- openacc/psb_c_oacc_vect_mod.F90 | 8 ++-- openacc/psb_d_oacc_csr_mat_mod.F90 | 48 ++++++++++++++++------ openacc/psb_d_oacc_ell_mat_mod.F90 | 64 +++++++++++++++++++++-------- openacc/psb_d_oacc_vect_mod.F90 | 4 +- openacc/psb_i_oacc_vect_mod.F90 | 1 + openacc/psb_l_oacc_vect_mod.F90 | 1 + openacc/psb_s_oacc_csr_mat_mod.F90 | 48 ++++++++++++++++------ openacc/psb_s_oacc_ell_mat_mod.F90 | 66 ++++++++++++++++++++++-------- openacc/psb_s_oacc_hll_mat_mod.F90 | 2 +- openacc/psb_s_oacc_vect_mod.F90 | 4 +- openacc/psb_z_oacc_csr_mat_mod.F90 | 48 ++++++++++++++++------ openacc/psb_z_oacc_ell_mat_mod.F90 | 66 ++++++++++++++++++++++-------- openacc/psb_z_oacc_hll_mat_mod.F90 | 2 +- openacc/psb_z_oacc_vect_mod.F90 | 8 ++-- 17 files changed, 360 insertions(+), 126 deletions(-) diff --git a/openacc/psb_c_oacc_csr_mat_mod.F90 b/openacc/psb_c_oacc_csr_mat_mod.F90 index c6461fe3..f138e4c9 100644 --- a/openacc/psb_c_oacc_csr_mat_mod.F90 +++ b/openacc/psb_c_oacc_csr_mat_mod.F90 @@ -144,9 +144,15 @@ contains ! but with size 0, then CREATE,UPDATE and DELETE ! will fail ! - if (psb_size(a%val)>0) call acc_delete_finalize(a%val) - if (psb_size(a%ja)>0) call acc_delete_finalize(a%ja) - if (psb_size(a%irp)>0) call acc_delete_finalize(a%irp) + if (psb_size(a%val)>0) then + !$acc exit data delete(a%val) finalize + end if + if (psb_size(a%ja)>0) then + !$acc exit data delete(a%ja) finalize + end if + if (psb_size(a%irp)>0) then + !$acc exit data delete(a%irp) finalize + end if return end subroutine c_oacc_csr_free_dev_space @@ -257,9 +263,15 @@ contains ! but with size 0, then CREATE,UPDATE and DELETE ! will fail ! - if (psb_size(a%val)>0) call acc_copyin(a%val) - if (psb_size(a%ja)>0) call acc_copyin(a%ja) - if (psb_size(a%irp)>0) call acc_copyin(a%irp) + if (psb_size(a%val)>0) then + !$acc enter data copyin(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc enter data copyin(a%ja) + end if + if (psb_size(a%irp)>0) then + !$acc enter data copyin(a%irp) + end if end subroutine c_oacc_csr_sync_dev_space subroutine c_oacc_csr_sync(a) @@ -275,13 +287,25 @@ contains ! will fail ! if (a%is_dev()) then - if (psb_size(a%val)>0) call acc_update_self(a%val) - if (psb_size(a%ja)>0) call acc_update_self(a%ja) - if (psb_size(a%irp)>0) call acc_update_self(a%irp) + if (psb_size(a%val)>0) then + !$acc update self(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc update self(a%ja) + end if + if (psb_size(a%irp)>0) then + !$acc update self(a%irp) + end if else if (a%is_host()) then - if (psb_size(a%val)>0) call acc_update_device(a%val) - if (psb_size(a%ja)>0) call acc_update_device(a%ja) - if (psb_size(a%irp)>0) call acc_update_device(a%irp) + if (psb_size(a%val)>0) then + !$acc update device(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc update device(a%ja) + end if + if (psb_size(a%irp)>0) then + !$acc update device(a%irp) + end if end if call tmpa%set_sync() end subroutine c_oacc_csr_sync diff --git a/openacc/psb_c_oacc_ell_mat_mod.F90 b/openacc/psb_c_oacc_ell_mat_mod.F90 index b2168646..30438011 100644 --- a/openacc/psb_c_oacc_ell_mat_mod.F90 +++ b/openacc/psb_c_oacc_ell_mat_mod.F90 @@ -143,10 +143,18 @@ contains ! but with size 0, then CREATE,UPDATE and DELETE ! will fail ! - if (psb_size(a%val)>0) call acc_delete_finalize(a%val) - if (psb_size(a%ja)>0) call acc_delete_finalize(a%ja) - if (psb_size(a%irn)>0) call acc_delete_finalize(a%irn) - if (psb_size(a%idiag)>0) call acc_delete_finalize(a%idiag) + if (psb_size(a%val)>0) then + !$acc exit data delete(a%val) finalize + end if + if (psb_size(a%ja)>0) then + !$acc exit data delete(a%ja) finalize + end if + if (psb_size(a%irn)>0) then + !$acc exit data delete(a%irn) finalize + end if + if (psb_size(a%idiag)>0) then + !$acc exit data delete(a%idiag) finalize + end if return end subroutine c_oacc_ell_free_dev_space @@ -170,7 +178,7 @@ contains if (a%is_dev()) call a%sync() res = 8 - res = res + psb_sizeof_dp * size(a%val) + res = res + (2*psb_sizeof_sp) * size(a%val) res = res + psb_sizeof_ip * size(a%ja) res = res + psb_sizeof_ip * size(a%irn) res = res + psb_sizeof_ip * size(a%idiag) @@ -186,10 +194,18 @@ contains ! but with size 0, then CREATE,UPDATE and DELETE ! will fail ! - if (psb_size(a%val)>0) call acc_copyin(a%val) - if (psb_size(a%ja)>0) call acc_copyin(a%ja) - if (psb_size(a%irn)>0) call acc_copyin(a%irn) - if (psb_size(a%idiag)>0) call acc_copyin(a%idiag) + if (psb_size(a%val)>0) then + !$acc enter data copyin(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc enter data copyin(a%ja) + end if + if (psb_size(a%irn)>0) then + !$acc enter data copyin(a%irn) + end if + if (psb_size(a%idiag)>0) then + !$acc enter data copyin(a%idiag) + end if end subroutine c_oacc_ell_sync_dev_space function c_oacc_ell_is_host(a) result(res) @@ -256,15 +272,31 @@ contains ! will fail ! if (a%is_dev()) then - if (psb_size(a%val)>0) call acc_update_self(a%val) - if (psb_size(a%ja)>0) call acc_update_self(a%ja) - if (psb_size(a%irn)>0) call acc_update_self(a%irn) - if (psb_size(a%idiag)>0) call acc_update_self(a%idiag) + if (psb_size(a%val)>0) then + !$acc update self(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc update self(a%ja) + end if + if (psb_size(a%irn)>0) then + !$acc update self(a%irn) + end if + if (psb_size(a%idiag)>0) then + !$acc update self(a%idiag) + end if else if (a%is_host()) then - if (psb_size(a%val)>0) call acc_update_device(a%val) - if (psb_size(a%ja)>0) call acc_update_device(a%ja) - if (psb_size(a%irn)>0) call acc_update_device(a%irn) - if (psb_size(a%idiag)>0) call acc_update_device(a%idiag) + if (psb_size(a%val)>0) then + !$acc update device(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc update device(a%ja) + end if + if (psb_size(a%irn)>0) then + !$acc update device(a%irn) + end if + if (psb_size(a%idiag)>0) then + !$acc update device(a%idiag) + end if end if call tmpa%set_sync() end subroutine c_oacc_ell_sync diff --git a/openacc/psb_c_oacc_hll_mat_mod.F90 b/openacc/psb_c_oacc_hll_mat_mod.F90 index f8c19275..5c9d9721 100644 --- a/openacc/psb_c_oacc_hll_mat_mod.F90 +++ b/openacc/psb_c_oacc_hll_mat_mod.F90 @@ -171,7 +171,7 @@ contains if (a%is_dev()) call a%sync() res = 8 - res = res + psb_sizeof_dp * size(a%val) + res = res + (2*psb_sizeof_sp) * size(a%val) res = res + psb_sizeof_ip * size(a%ja) res = res + psb_sizeof_ip * size(a%irn) res = res + psb_sizeof_ip * size(a%idiag) diff --git a/openacc/psb_c_oacc_vect_mod.F90 b/openacc/psb_c_oacc_vect_mod.F90 index 2aa11db9..18b900bb 100644 --- a/openacc/psb_c_oacc_vect_mod.F90 +++ b/openacc/psb_c_oacc_vect_mod.F90 @@ -829,9 +829,10 @@ contains complex(psb_spk_) :: res integer(psb_ipk_) :: i + res = czero !$acc parallel loop reduction(+:res) present(x, y) do i = 1, n - res = res + x(i) * y(i) + res = res + conjg(x(i)) * y(i) end do !$acc end parallel loop end function c_inner_oacc_dot @@ -843,10 +844,10 @@ contains complex(psb_spk_), intent(in) :: y(:) integer(psb_ipk_), intent(in) :: n complex(psb_spk_) :: res - complex(psb_spk_), external :: cdot + complex(psb_spk_), external :: cdotc if (x%is_dev()) call x%sync() - res = cdot(n, y, 1, x%v, 1) + res = cdotc(n, y, 1, x%v, 1) end function c_oacc_dot_a @@ -943,6 +944,7 @@ contains class(psb_c_vect_oacc), intent(out) :: x integer(psb_ipk_), intent(out) :: info + call x%free(info) call psb_realloc(n, x%v, info) if (info /= 0) then info = psb_err_alloc_request_ diff --git a/openacc/psb_d_oacc_csr_mat_mod.F90 b/openacc/psb_d_oacc_csr_mat_mod.F90 index 21907312..0c689f39 100644 --- a/openacc/psb_d_oacc_csr_mat_mod.F90 +++ b/openacc/psb_d_oacc_csr_mat_mod.F90 @@ -144,9 +144,15 @@ contains ! but with size 0, then CREATE,UPDATE and DELETE ! will fail ! - if (psb_size(a%val)>0) call acc_delete_finalize(a%val) - if (psb_size(a%ja)>0) call acc_delete_finalize(a%ja) - if (psb_size(a%irp)>0) call acc_delete_finalize(a%irp) + if (psb_size(a%val)>0) then + !$acc exit data delete(a%val) finalize + end if + if (psb_size(a%ja)>0) then + !$acc exit data delete(a%ja) finalize + end if + if (psb_size(a%irp)>0) then + !$acc exit data delete(a%irp) finalize + end if return end subroutine d_oacc_csr_free_dev_space @@ -257,9 +263,15 @@ contains ! but with size 0, then CREATE,UPDATE and DELETE ! will fail ! - if (psb_size(a%val)>0) call acc_copyin(a%val) - if (psb_size(a%ja)>0) call acc_copyin(a%ja) - if (psb_size(a%irp)>0) call acc_copyin(a%irp) + if (psb_size(a%val)>0) then + !$acc enter data copyin(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc enter data copyin(a%ja) + end if + if (psb_size(a%irp)>0) then + !$acc enter data copyin(a%irp) + end if end subroutine d_oacc_csr_sync_dev_space subroutine d_oacc_csr_sync(a) @@ -275,13 +287,25 @@ contains ! will fail ! if (a%is_dev()) then - if (psb_size(a%val)>0) call acc_update_self(a%val) - if (psb_size(a%ja)>0) call acc_update_self(a%ja) - if (psb_size(a%irp)>0) call acc_update_self(a%irp) + if (psb_size(a%val)>0) then + !$acc update self(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc update self(a%ja) + end if + if (psb_size(a%irp)>0) then + !$acc update self(a%irp) + end if else if (a%is_host()) then - if (psb_size(a%val)>0) call acc_update_device(a%val) - if (psb_size(a%ja)>0) call acc_update_device(a%ja) - if (psb_size(a%irp)>0) call acc_update_device(a%irp) + if (psb_size(a%val)>0) then + !$acc update device(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc update device(a%ja) + end if + if (psb_size(a%irp)>0) then + !$acc update device(a%irp) + end if end if call tmpa%set_sync() end subroutine d_oacc_csr_sync diff --git a/openacc/psb_d_oacc_ell_mat_mod.F90 b/openacc/psb_d_oacc_ell_mat_mod.F90 index 021face3..07ae88ae 100644 --- a/openacc/psb_d_oacc_ell_mat_mod.F90 +++ b/openacc/psb_d_oacc_ell_mat_mod.F90 @@ -143,10 +143,18 @@ contains ! but with size 0, then CREATE,UPDATE and DELETE ! will fail ! - if (psb_size(a%val)>0) call acc_delete_finalize(a%val) - if (psb_size(a%ja)>0) call acc_delete_finalize(a%ja) - if (psb_size(a%irn)>0) call acc_delete_finalize(a%irn) - if (psb_size(a%idiag)>0) call acc_delete_finalize(a%idiag) + if (psb_size(a%val)>0) then + !$acc exit data delete(a%val) finalize + end if + if (psb_size(a%ja)>0) then + !$acc exit data delete(a%ja) finalize + end if + if (psb_size(a%irn)>0) then + !$acc exit data delete(a%irn) finalize + end if + if (psb_size(a%idiag)>0) then + !$acc exit data delete(a%idiag) finalize + end if return end subroutine d_oacc_ell_free_dev_space @@ -186,10 +194,18 @@ contains ! but with size 0, then CREATE,UPDATE and DELETE ! will fail ! - if (psb_size(a%val)>0) call acc_copyin(a%val) - if (psb_size(a%ja)>0) call acc_copyin(a%ja) - if (psb_size(a%irn)>0) call acc_copyin(a%irn) - if (psb_size(a%idiag)>0) call acc_copyin(a%idiag) + if (psb_size(a%val)>0) then + !$acc enter data copyin(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc enter data copyin(a%ja) + end if + if (psb_size(a%irn)>0) then + !$acc enter data copyin(a%irn) + end if + if (psb_size(a%idiag)>0) then + !$acc enter data copyin(a%idiag) + end if end subroutine d_oacc_ell_sync_dev_space function d_oacc_ell_is_host(a) result(res) @@ -256,15 +272,31 @@ contains ! will fail ! if (a%is_dev()) then - if (psb_size(a%val)>0) call acc_update_self(a%val) - if (psb_size(a%ja)>0) call acc_update_self(a%ja) - if (psb_size(a%irn)>0) call acc_update_self(a%irn) - if (psb_size(a%idiag)>0) call acc_update_self(a%idiag) + if (psb_size(a%val)>0) then + !$acc update self(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc update self(a%ja) + end if + if (psb_size(a%irn)>0) then + !$acc update self(a%irn) + end if + if (psb_size(a%idiag)>0) then + !$acc update self(a%idiag) + end if else if (a%is_host()) then - if (psb_size(a%val)>0) call acc_update_device(a%val) - if (psb_size(a%ja)>0) call acc_update_device(a%ja) - if (psb_size(a%irn)>0) call acc_update_device(a%irn) - if (psb_size(a%idiag)>0) call acc_update_device(a%idiag) + if (psb_size(a%val)>0) then + !$acc update device(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc update device(a%ja) + end if + if (psb_size(a%irn)>0) then + !$acc update device(a%irn) + end if + if (psb_size(a%idiag)>0) then + !$acc update device(a%idiag) + end if end if call tmpa%set_sync() end subroutine d_oacc_ell_sync diff --git a/openacc/psb_d_oacc_vect_mod.F90 b/openacc/psb_d_oacc_vect_mod.F90 index 1e3f07d7..830b2216 100644 --- a/openacc/psb_d_oacc_vect_mod.F90 +++ b/openacc/psb_d_oacc_vect_mod.F90 @@ -829,9 +829,10 @@ contains real(psb_dpk_) :: res integer(psb_ipk_) :: i + res = dzero !$acc parallel loop reduction(+:res) present(x, y) do i = 1, n - res = res + x(i) * y(i) + res = res + (x(i)) * y(i) end do !$acc end parallel loop end function d_inner_oacc_dot @@ -943,6 +944,7 @@ contains class(psb_d_vect_oacc), intent(out) :: x integer(psb_ipk_), intent(out) :: info + call x%free(info) call psb_realloc(n, x%v, info) if (info /= 0) then info = psb_err_alloc_request_ diff --git a/openacc/psb_i_oacc_vect_mod.F90 b/openacc/psb_i_oacc_vect_mod.F90 index 344ad931..4494ba70 100644 --- a/openacc/psb_i_oacc_vect_mod.F90 +++ b/openacc/psb_i_oacc_vect_mod.F90 @@ -547,6 +547,7 @@ contains class(psb_i_vect_oacc), intent(out) :: x integer(psb_ipk_), intent(out) :: info + call x%free(info) call psb_realloc(n, x%v, info) if (info /= 0) then info = psb_err_alloc_request_ diff --git a/openacc/psb_l_oacc_vect_mod.F90 b/openacc/psb_l_oacc_vect_mod.F90 index 85b561a9..aeb1051c 100644 --- a/openacc/psb_l_oacc_vect_mod.F90 +++ b/openacc/psb_l_oacc_vect_mod.F90 @@ -549,6 +549,7 @@ contains class(psb_l_vect_oacc), intent(out) :: x integer(psb_ipk_), intent(out) :: info + call x%free(info) call psb_realloc(n, x%v, info) if (info /= 0) then info = psb_err_alloc_request_ diff --git a/openacc/psb_s_oacc_csr_mat_mod.F90 b/openacc/psb_s_oacc_csr_mat_mod.F90 index d66dca3b..ce721a77 100644 --- a/openacc/psb_s_oacc_csr_mat_mod.F90 +++ b/openacc/psb_s_oacc_csr_mat_mod.F90 @@ -144,9 +144,15 @@ contains ! but with size 0, then CREATE,UPDATE and DELETE ! will fail ! - if (psb_size(a%val)>0) call acc_delete_finalize(a%val) - if (psb_size(a%ja)>0) call acc_delete_finalize(a%ja) - if (psb_size(a%irp)>0) call acc_delete_finalize(a%irp) + if (psb_size(a%val)>0) then + !$acc exit data delete(a%val) finalize + end if + if (psb_size(a%ja)>0) then + !$acc exit data delete(a%ja) finalize + end if + if (psb_size(a%irp)>0) then + !$acc exit data delete(a%irp) finalize + end if return end subroutine s_oacc_csr_free_dev_space @@ -257,9 +263,15 @@ contains ! but with size 0, then CREATE,UPDATE and DELETE ! will fail ! - if (psb_size(a%val)>0) call acc_copyin(a%val) - if (psb_size(a%ja)>0) call acc_copyin(a%ja) - if (psb_size(a%irp)>0) call acc_copyin(a%irp) + if (psb_size(a%val)>0) then + !$acc enter data copyin(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc enter data copyin(a%ja) + end if + if (psb_size(a%irp)>0) then + !$acc enter data copyin(a%irp) + end if end subroutine s_oacc_csr_sync_dev_space subroutine s_oacc_csr_sync(a) @@ -275,13 +287,25 @@ contains ! will fail ! if (a%is_dev()) then - if (psb_size(a%val)>0) call acc_update_self(a%val) - if (psb_size(a%ja)>0) call acc_update_self(a%ja) - if (psb_size(a%irp)>0) call acc_update_self(a%irp) + if (psb_size(a%val)>0) then + !$acc update self(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc update self(a%ja) + end if + if (psb_size(a%irp)>0) then + !$acc update self(a%irp) + end if else if (a%is_host()) then - if (psb_size(a%val)>0) call acc_update_device(a%val) - if (psb_size(a%ja)>0) call acc_update_device(a%ja) - if (psb_size(a%irp)>0) call acc_update_device(a%irp) + if (psb_size(a%val)>0) then + !$acc update device(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc update device(a%ja) + end if + if (psb_size(a%irp)>0) then + !$acc update device(a%irp) + end if end if call tmpa%set_sync() end subroutine s_oacc_csr_sync diff --git a/openacc/psb_s_oacc_ell_mat_mod.F90 b/openacc/psb_s_oacc_ell_mat_mod.F90 index 600a08a7..c31f2bb9 100644 --- a/openacc/psb_s_oacc_ell_mat_mod.F90 +++ b/openacc/psb_s_oacc_ell_mat_mod.F90 @@ -143,10 +143,18 @@ contains ! but with size 0, then CREATE,UPDATE and DELETE ! will fail ! - if (psb_size(a%val)>0) call acc_delete_finalize(a%val) - if (psb_size(a%ja)>0) call acc_delete_finalize(a%ja) - if (psb_size(a%irn)>0) call acc_delete_finalize(a%irn) - if (psb_size(a%idiag)>0) call acc_delete_finalize(a%idiag) + if (psb_size(a%val)>0) then + !$acc exit data delete(a%val) finalize + end if + if (psb_size(a%ja)>0) then + !$acc exit data delete(a%ja) finalize + end if + if (psb_size(a%irn)>0) then + !$acc exit data delete(a%irn) finalize + end if + if (psb_size(a%idiag)>0) then + !$acc exit data delete(a%idiag) finalize + end if return end subroutine s_oacc_ell_free_dev_space @@ -170,7 +178,7 @@ contains if (a%is_dev()) call a%sync() res = 8 - res = res + psb_sizeof_dp * size(a%val) + res = res + psb_sizeof_sp * size(a%val) res = res + psb_sizeof_ip * size(a%ja) res = res + psb_sizeof_ip * size(a%irn) res = res + psb_sizeof_ip * size(a%idiag) @@ -186,10 +194,18 @@ contains ! but with size 0, then CREATE,UPDATE and DELETE ! will fail ! - if (psb_size(a%val)>0) call acc_copyin(a%val) - if (psb_size(a%ja)>0) call acc_copyin(a%ja) - if (psb_size(a%irn)>0) call acc_copyin(a%irn) - if (psb_size(a%idiag)>0) call acc_copyin(a%idiag) + if (psb_size(a%val)>0) then + !$acc enter data copyin(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc enter data copyin(a%ja) + end if + if (psb_size(a%irn)>0) then + !$acc enter data copyin(a%irn) + end if + if (psb_size(a%idiag)>0) then + !$acc enter data copyin(a%idiag) + end if end subroutine s_oacc_ell_sync_dev_space function s_oacc_ell_is_host(a) result(res) @@ -256,15 +272,31 @@ contains ! will fail ! if (a%is_dev()) then - if (psb_size(a%val)>0) call acc_update_self(a%val) - if (psb_size(a%ja)>0) call acc_update_self(a%ja) - if (psb_size(a%irn)>0) call acc_update_self(a%irn) - if (psb_size(a%idiag)>0) call acc_update_self(a%idiag) + if (psb_size(a%val)>0) then + !$acc update self(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc update self(a%ja) + end if + if (psb_size(a%irn)>0) then + !$acc update self(a%irn) + end if + if (psb_size(a%idiag)>0) then + !$acc update self(a%idiag) + end if else if (a%is_host()) then - if (psb_size(a%val)>0) call acc_update_device(a%val) - if (psb_size(a%ja)>0) call acc_update_device(a%ja) - if (psb_size(a%irn)>0) call acc_update_device(a%irn) - if (psb_size(a%idiag)>0) call acc_update_device(a%idiag) + if (psb_size(a%val)>0) then + !$acc update device(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc update device(a%ja) + end if + if (psb_size(a%irn)>0) then + !$acc update device(a%irn) + end if + if (psb_size(a%idiag)>0) then + !$acc update device(a%idiag) + end if end if call tmpa%set_sync() end subroutine s_oacc_ell_sync diff --git a/openacc/psb_s_oacc_hll_mat_mod.F90 b/openacc/psb_s_oacc_hll_mat_mod.F90 index 33033248..3c3f52de 100644 --- a/openacc/psb_s_oacc_hll_mat_mod.F90 +++ b/openacc/psb_s_oacc_hll_mat_mod.F90 @@ -171,7 +171,7 @@ contains if (a%is_dev()) call a%sync() res = 8 - res = res + psb_sizeof_dp * size(a%val) + res = res + psb_sizeof_sp * size(a%val) res = res + psb_sizeof_ip * size(a%ja) res = res + psb_sizeof_ip * size(a%irn) res = res + psb_sizeof_ip * size(a%idiag) diff --git a/openacc/psb_s_oacc_vect_mod.F90 b/openacc/psb_s_oacc_vect_mod.F90 index b8d9700d..e7edb998 100644 --- a/openacc/psb_s_oacc_vect_mod.F90 +++ b/openacc/psb_s_oacc_vect_mod.F90 @@ -829,9 +829,10 @@ contains real(psb_spk_) :: res integer(psb_ipk_) :: i + res = szero !$acc parallel loop reduction(+:res) present(x, y) do i = 1, n - res = res + x(i) * y(i) + res = res + (x(i)) * y(i) end do !$acc end parallel loop end function s_inner_oacc_dot @@ -943,6 +944,7 @@ contains class(psb_s_vect_oacc), intent(out) :: x integer(psb_ipk_), intent(out) :: info + call x%free(info) call psb_realloc(n, x%v, info) if (info /= 0) then info = psb_err_alloc_request_ diff --git a/openacc/psb_z_oacc_csr_mat_mod.F90 b/openacc/psb_z_oacc_csr_mat_mod.F90 index 3b66787a..2fef14a6 100644 --- a/openacc/psb_z_oacc_csr_mat_mod.F90 +++ b/openacc/psb_z_oacc_csr_mat_mod.F90 @@ -144,9 +144,15 @@ contains ! but with size 0, then CREATE,UPDATE and DELETE ! will fail ! - if (psb_size(a%val)>0) call acc_delete_finalize(a%val) - if (psb_size(a%ja)>0) call acc_delete_finalize(a%ja) - if (psb_size(a%irp)>0) call acc_delete_finalize(a%irp) + if (psb_size(a%val)>0) then + !$acc exit data delete(a%val) finalize + end if + if (psb_size(a%ja)>0) then + !$acc exit data delete(a%ja) finalize + end if + if (psb_size(a%irp)>0) then + !$acc exit data delete(a%irp) finalize + end if return end subroutine z_oacc_csr_free_dev_space @@ -257,9 +263,15 @@ contains ! but with size 0, then CREATE,UPDATE and DELETE ! will fail ! - if (psb_size(a%val)>0) call acc_copyin(a%val) - if (psb_size(a%ja)>0) call acc_copyin(a%ja) - if (psb_size(a%irp)>0) call acc_copyin(a%irp) + if (psb_size(a%val)>0) then + !$acc enter data copyin(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc enter data copyin(a%ja) + end if + if (psb_size(a%irp)>0) then + !$acc enter data copyin(a%irp) + end if end subroutine z_oacc_csr_sync_dev_space subroutine z_oacc_csr_sync(a) @@ -275,13 +287,25 @@ contains ! will fail ! if (a%is_dev()) then - if (psb_size(a%val)>0) call acc_update_self(a%val) - if (psb_size(a%ja)>0) call acc_update_self(a%ja) - if (psb_size(a%irp)>0) call acc_update_self(a%irp) + if (psb_size(a%val)>0) then + !$acc update self(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc update self(a%ja) + end if + if (psb_size(a%irp)>0) then + !$acc update self(a%irp) + end if else if (a%is_host()) then - if (psb_size(a%val)>0) call acc_update_device(a%val) - if (psb_size(a%ja)>0) call acc_update_device(a%ja) - if (psb_size(a%irp)>0) call acc_update_device(a%irp) + if (psb_size(a%val)>0) then + !$acc update device(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc update device(a%ja) + end if + if (psb_size(a%irp)>0) then + !$acc update device(a%irp) + end if end if call tmpa%set_sync() end subroutine z_oacc_csr_sync diff --git a/openacc/psb_z_oacc_ell_mat_mod.F90 b/openacc/psb_z_oacc_ell_mat_mod.F90 index abfb11e3..a79bebf5 100644 --- a/openacc/psb_z_oacc_ell_mat_mod.F90 +++ b/openacc/psb_z_oacc_ell_mat_mod.F90 @@ -143,10 +143,18 @@ contains ! but with size 0, then CREATE,UPDATE and DELETE ! will fail ! - if (psb_size(a%val)>0) call acc_delete_finalize(a%val) - if (psb_size(a%ja)>0) call acc_delete_finalize(a%ja) - if (psb_size(a%irn)>0) call acc_delete_finalize(a%irn) - if (psb_size(a%idiag)>0) call acc_delete_finalize(a%idiag) + if (psb_size(a%val)>0) then + !$acc exit data delete(a%val) finalize + end if + if (psb_size(a%ja)>0) then + !$acc exit data delete(a%ja) finalize + end if + if (psb_size(a%irn)>0) then + !$acc exit data delete(a%irn) finalize + end if + if (psb_size(a%idiag)>0) then + !$acc exit data delete(a%idiag) finalize + end if return end subroutine z_oacc_ell_free_dev_space @@ -170,7 +178,7 @@ contains if (a%is_dev()) call a%sync() res = 8 - res = res + psb_sizeof_dp * size(a%val) + res = res + (2*psb_sizeof_dp) * size(a%val) res = res + psb_sizeof_ip * size(a%ja) res = res + psb_sizeof_ip * size(a%irn) res = res + psb_sizeof_ip * size(a%idiag) @@ -186,10 +194,18 @@ contains ! but with size 0, then CREATE,UPDATE and DELETE ! will fail ! - if (psb_size(a%val)>0) call acc_copyin(a%val) - if (psb_size(a%ja)>0) call acc_copyin(a%ja) - if (psb_size(a%irn)>0) call acc_copyin(a%irn) - if (psb_size(a%idiag)>0) call acc_copyin(a%idiag) + if (psb_size(a%val)>0) then + !$acc enter data copyin(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc enter data copyin(a%ja) + end if + if (psb_size(a%irn)>0) then + !$acc enter data copyin(a%irn) + end if + if (psb_size(a%idiag)>0) then + !$acc enter data copyin(a%idiag) + end if end subroutine z_oacc_ell_sync_dev_space function z_oacc_ell_is_host(a) result(res) @@ -256,15 +272,31 @@ contains ! will fail ! if (a%is_dev()) then - if (psb_size(a%val)>0) call acc_update_self(a%val) - if (psb_size(a%ja)>0) call acc_update_self(a%ja) - if (psb_size(a%irn)>0) call acc_update_self(a%irn) - if (psb_size(a%idiag)>0) call acc_update_self(a%idiag) + if (psb_size(a%val)>0) then + !$acc update self(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc update self(a%ja) + end if + if (psb_size(a%irn)>0) then + !$acc update self(a%irn) + end if + if (psb_size(a%idiag)>0) then + !$acc update self(a%idiag) + end if else if (a%is_host()) then - if (psb_size(a%val)>0) call acc_update_device(a%val) - if (psb_size(a%ja)>0) call acc_update_device(a%ja) - if (psb_size(a%irn)>0) call acc_update_device(a%irn) - if (psb_size(a%idiag)>0) call acc_update_device(a%idiag) + if (psb_size(a%val)>0) then + !$acc update device(a%val) + end if + if (psb_size(a%ja)>0) then + !$acc update device(a%ja) + end if + if (psb_size(a%irn)>0) then + !$acc update device(a%irn) + end if + if (psb_size(a%idiag)>0) then + !$acc update device(a%idiag) + end if end if call tmpa%set_sync() end subroutine z_oacc_ell_sync diff --git a/openacc/psb_z_oacc_hll_mat_mod.F90 b/openacc/psb_z_oacc_hll_mat_mod.F90 index 4c9f1b11..2cce6e2d 100644 --- a/openacc/psb_z_oacc_hll_mat_mod.F90 +++ b/openacc/psb_z_oacc_hll_mat_mod.F90 @@ -171,7 +171,7 @@ contains if (a%is_dev()) call a%sync() res = 8 - res = res + psb_sizeof_dp * size(a%val) + res = res + (2*psb_sizeof_dp) * size(a%val) res = res + psb_sizeof_ip * size(a%ja) res = res + psb_sizeof_ip * size(a%irn) res = res + psb_sizeof_ip * size(a%idiag) diff --git a/openacc/psb_z_oacc_vect_mod.F90 b/openacc/psb_z_oacc_vect_mod.F90 index a119303d..88ba484b 100644 --- a/openacc/psb_z_oacc_vect_mod.F90 +++ b/openacc/psb_z_oacc_vect_mod.F90 @@ -829,9 +829,10 @@ contains complex(psb_dpk_) :: res integer(psb_ipk_) :: i + res = zzero !$acc parallel loop reduction(+:res) present(x, y) do i = 1, n - res = res + x(i) * y(i) + res = res + conjg(x(i)) * y(i) end do !$acc end parallel loop end function z_inner_oacc_dot @@ -843,10 +844,10 @@ contains complex(psb_dpk_), intent(in) :: y(:) integer(psb_ipk_), intent(in) :: n complex(psb_dpk_) :: res - complex(psb_dpk_), external :: zdot + complex(psb_dpk_), external :: zdotc if (x%is_dev()) call x%sync() - res = zdot(n, y, 1, x%v, 1) + res = zdotc(n, y, 1, x%v, 1) end function z_oacc_dot_a @@ -943,6 +944,7 @@ contains class(psb_z_vect_oacc), intent(out) :: x integer(psb_ipk_), intent(out) :: info + call x%free(info) call psb_realloc(n, x%v, info) if (info /= 0) then info = psb_err_alloc_request_