From d0a5ff989333c6ada5448aad4446a55dd6f7e63b Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 11 Mar 2022 14:12:33 +0100 Subject: [PATCH] Rework build --- base/modules/serial/psb_c_base_vect_mod.F90 | 10 +++---- base/modules/serial/psb_d_base_vect_mod.F90 | 10 +++---- base/modules/serial/psb_s_base_vect_mod.F90 | 10 +++---- base/modules/serial/psb_z_base_vect_mod.F90 | 10 +++---- base/serial/impl/psb_c_csr_impl.f90 | 8 ++--- base/serial/impl/psb_d_csr_impl.f90 | 8 ++--- base/serial/impl/psb_s_csr_impl.f90 | 8 ++--- base/serial/impl/psb_z_csr_impl.f90 | 8 ++--- cbind/base/psb_c_serial_cbind_mod.F90 | 33 --------------------- 9 files changed, 36 insertions(+), 69 deletions(-) diff --git a/base/modules/serial/psb_c_base_vect_mod.F90 b/base/modules/serial/psb_c_base_vect_mod.F90 index e68fef6c..22582e44 100644 --- a/base/modules/serial/psb_c_base_vect_mod.F90 +++ b/base/modules/serial/psb_c_base_vect_mod.F90 @@ -1208,7 +1208,7 @@ contains if (beta == cone) then return else - !$omp parallel do private(i) + !$omp parallel do private(i) shared(beta) do i=1, n z%v(i) = beta*z%v(i) end do @@ -1243,24 +1243,24 @@ contains z%v(i) = z%v(i) - y(i)*x(i) end do else - !$omp parallel do private(i) + !$omp parallel do private(i) shared(beta) do i=1, n z%v(i) = beta*z%v(i) - y(i)*x(i) end do end if else if (beta == czero) then - !$omp parallel do private(i) + !$omp parallel do private(i) shared(alpha) do i=1, n z%v(i) = alpha*y(i)*x(i) end do else if (beta == cone) then - !$omp parallel do private(i) + !$omp parallel do private(i) shared(alpha) do i=1, n z%v(i) = z%v(i) + alpha*y(i)*x(i) end do else - !$omp parallel do private(i) + !$omp parallel do private(i) shared(alpha, beta) do i=1, n z%v(i) = beta*z%v(i) + alpha*y(i)*x(i) end do diff --git a/base/modules/serial/psb_d_base_vect_mod.F90 b/base/modules/serial/psb_d_base_vect_mod.F90 index 09fd187b..ad64e6c9 100644 --- a/base/modules/serial/psb_d_base_vect_mod.F90 +++ b/base/modules/serial/psb_d_base_vect_mod.F90 @@ -1215,7 +1215,7 @@ contains if (beta == done) then return else - !$omp parallel do private(i) + !$omp parallel do private(i) shared(beta) do i=1, n z%v(i) = beta*z%v(i) end do @@ -1250,24 +1250,24 @@ contains z%v(i) = z%v(i) - y(i)*x(i) end do else - !$omp parallel do private(i) + !$omp parallel do private(i) shared(beta) do i=1, n z%v(i) = beta*z%v(i) - y(i)*x(i) end do end if else if (beta == dzero) then - !$omp parallel do private(i) + !$omp parallel do private(i) shared(alpha) do i=1, n z%v(i) = alpha*y(i)*x(i) end do else if (beta == done) then - !$omp parallel do private(i) + !$omp parallel do private(i) shared(alpha) do i=1, n z%v(i) = z%v(i) + alpha*y(i)*x(i) end do else - !$omp parallel do private(i) + !$omp parallel do private(i) shared(alpha, beta) do i=1, n z%v(i) = beta*z%v(i) + alpha*y(i)*x(i) end do diff --git a/base/modules/serial/psb_s_base_vect_mod.F90 b/base/modules/serial/psb_s_base_vect_mod.F90 index 231b1dc7..e3b1cbd5 100644 --- a/base/modules/serial/psb_s_base_vect_mod.F90 +++ b/base/modules/serial/psb_s_base_vect_mod.F90 @@ -1215,7 +1215,7 @@ contains if (beta == sone) then return else - !$omp parallel do private(i) + !$omp parallel do private(i) shared(beta) do i=1, n z%v(i) = beta*z%v(i) end do @@ -1250,24 +1250,24 @@ contains z%v(i) = z%v(i) - y(i)*x(i) end do else - !$omp parallel do private(i) + !$omp parallel do private(i) shared(beta) do i=1, n z%v(i) = beta*z%v(i) - y(i)*x(i) end do end if else if (beta == szero) then - !$omp parallel do private(i) + !$omp parallel do private(i) shared(alpha) do i=1, n z%v(i) = alpha*y(i)*x(i) end do else if (beta == sone) then - !$omp parallel do private(i) + !$omp parallel do private(i) shared(alpha) do i=1, n z%v(i) = z%v(i) + alpha*y(i)*x(i) end do else - !$omp parallel do private(i) + !$omp parallel do private(i) shared(alpha, beta) do i=1, n z%v(i) = beta*z%v(i) + alpha*y(i)*x(i) end do diff --git a/base/modules/serial/psb_z_base_vect_mod.F90 b/base/modules/serial/psb_z_base_vect_mod.F90 index 08cfb840..3a95a983 100644 --- a/base/modules/serial/psb_z_base_vect_mod.F90 +++ b/base/modules/serial/psb_z_base_vect_mod.F90 @@ -1208,7 +1208,7 @@ contains if (beta == zone) then return else - !$omp parallel do private(i) + !$omp parallel do private(i) shared(beta) do i=1, n z%v(i) = beta*z%v(i) end do @@ -1243,24 +1243,24 @@ contains z%v(i) = z%v(i) - y(i)*x(i) end do else - !$omp parallel do private(i) + !$omp parallel do private(i) shared(beta) do i=1, n z%v(i) = beta*z%v(i) - y(i)*x(i) end do end if else if (beta == zzero) then - !$omp parallel do private(i) + !$omp parallel do private(i) shared(alpha) do i=1, n z%v(i) = alpha*y(i)*x(i) end do else if (beta == zone) then - !$omp parallel do private(i) + !$omp parallel do private(i) shared(alpha) do i=1, n z%v(i) = z%v(i) + alpha*y(i)*x(i) end do else - !$omp parallel do private(i) + !$omp parallel do private(i) shared(alpha, beta) do i=1, n z%v(i) = beta*z%v(i) + alpha*y(i)*x(i) end do diff --git a/base/serial/impl/psb_c_csr_impl.f90 b/base/serial/impl/psb_c_csr_impl.f90 index c06d2755..69eb8ee1 100644 --- a/base/serial/impl/psb_c_csr_impl.f90 +++ b/base/serial/impl/psb_c_csr_impl.f90 @@ -2871,7 +2871,7 @@ subroutine psb_c_cp_csr_from_coo(a,b,info) call move_alloc(tmp%ia,itemp) call move_alloc(tmp%ja,a%ja) call move_alloc(tmp%val,a%val) - call psb_realloc(nr+1,a%irp,info) + call psb_realloc(max(nr+1,nc+1),a%irp,info) call tmp%free() else @@ -2889,8 +2889,8 @@ subroutine psb_c_cp_csr_from_coo(a,b,info) call psb_safe_ab_cpy(b%ia,itemp,info) if (info == psb_success_) call psb_safe_ab_cpy(b%ja,a%ja,info) if (info == psb_success_) call psb_safe_ab_cpy(b%val,a%val,info) - if (info == psb_success_) call psb_realloc(nr+1,a%irp,info) - + if (info == psb_success_) call psb_realloc(max(nr+1,nc+1),a%irp,info) + endif a%irp(:) = 0 @@ -3040,7 +3040,7 @@ subroutine psb_c_mv_csr_from_coo(a,b,info) call move_alloc(b%ia,itemp) call move_alloc(b%ja,a%ja) call move_alloc(b%val,a%val) - call psb_realloc(nr+1,a%irp,info) + call psb_realloc(max(nr+1,nc+1),a%irp,info) call b%free() diff --git a/base/serial/impl/psb_d_csr_impl.f90 b/base/serial/impl/psb_d_csr_impl.f90 index c251a2fd..ef8bda44 100644 --- a/base/serial/impl/psb_d_csr_impl.f90 +++ b/base/serial/impl/psb_d_csr_impl.f90 @@ -2871,7 +2871,7 @@ subroutine psb_d_cp_csr_from_coo(a,b,info) call move_alloc(tmp%ia,itemp) call move_alloc(tmp%ja,a%ja) call move_alloc(tmp%val,a%val) - call psb_realloc(nr+1,a%irp,info) + call psb_realloc(max(nr+1,nc+1),a%irp,info) call tmp%free() else @@ -2889,8 +2889,8 @@ subroutine psb_d_cp_csr_from_coo(a,b,info) call psb_safe_ab_cpy(b%ia,itemp,info) if (info == psb_success_) call psb_safe_ab_cpy(b%ja,a%ja,info) if (info == psb_success_) call psb_safe_ab_cpy(b%val,a%val,info) - if (info == psb_success_) call psb_realloc(nr+1,a%irp,info) - + if (info == psb_success_) call psb_realloc(max(nr+1,nc+1),a%irp,info) + endif a%irp(:) = 0 @@ -3040,7 +3040,7 @@ subroutine psb_d_mv_csr_from_coo(a,b,info) call move_alloc(b%ia,itemp) call move_alloc(b%ja,a%ja) call move_alloc(b%val,a%val) - call psb_realloc(nr+1,a%irp,info) + call psb_realloc(max(nr+1,nc+1),a%irp,info) call b%free() diff --git a/base/serial/impl/psb_s_csr_impl.f90 b/base/serial/impl/psb_s_csr_impl.f90 index 9a4bb3e1..d5295089 100644 --- a/base/serial/impl/psb_s_csr_impl.f90 +++ b/base/serial/impl/psb_s_csr_impl.f90 @@ -2871,7 +2871,7 @@ subroutine psb_s_cp_csr_from_coo(a,b,info) call move_alloc(tmp%ia,itemp) call move_alloc(tmp%ja,a%ja) call move_alloc(tmp%val,a%val) - call psb_realloc(nr+1,a%irp,info) + call psb_realloc(max(nr+1,nc+1),a%irp,info) call tmp%free() else @@ -2889,8 +2889,8 @@ subroutine psb_s_cp_csr_from_coo(a,b,info) call psb_safe_ab_cpy(b%ia,itemp,info) if (info == psb_success_) call psb_safe_ab_cpy(b%ja,a%ja,info) if (info == psb_success_) call psb_safe_ab_cpy(b%val,a%val,info) - if (info == psb_success_) call psb_realloc(nr+1,a%irp,info) - + if (info == psb_success_) call psb_realloc(max(nr+1,nc+1),a%irp,info) + endif a%irp(:) = 0 @@ -3040,7 +3040,7 @@ subroutine psb_s_mv_csr_from_coo(a,b,info) call move_alloc(b%ia,itemp) call move_alloc(b%ja,a%ja) call move_alloc(b%val,a%val) - call psb_realloc(nr+1,a%irp,info) + call psb_realloc(max(nr+1,nc+1),a%irp,info) call b%free() diff --git a/base/serial/impl/psb_z_csr_impl.f90 b/base/serial/impl/psb_z_csr_impl.f90 index bf9817ef..9a3b54de 100644 --- a/base/serial/impl/psb_z_csr_impl.f90 +++ b/base/serial/impl/psb_z_csr_impl.f90 @@ -2871,7 +2871,7 @@ subroutine psb_z_cp_csr_from_coo(a,b,info) call move_alloc(tmp%ia,itemp) call move_alloc(tmp%ja,a%ja) call move_alloc(tmp%val,a%val) - call psb_realloc(nr+1,a%irp,info) + call psb_realloc(max(nr+1,nc+1),a%irp,info) call tmp%free() else @@ -2889,8 +2889,8 @@ subroutine psb_z_cp_csr_from_coo(a,b,info) call psb_safe_ab_cpy(b%ia,itemp,info) if (info == psb_success_) call psb_safe_ab_cpy(b%ja,a%ja,info) if (info == psb_success_) call psb_safe_ab_cpy(b%val,a%val,info) - if (info == psb_success_) call psb_realloc(nr+1,a%irp,info) - + if (info == psb_success_) call psb_realloc(max(nr+1,nc+1),a%irp,info) + endif a%irp(:) = 0 @@ -3040,7 +3040,7 @@ subroutine psb_z_mv_csr_from_coo(a,b,info) call move_alloc(b%ia,itemp) call move_alloc(b%ja,a%ja) call move_alloc(b%val,a%val) - call psb_realloc(nr+1,a%irp,info) + call psb_realloc(max(nr+1,nc+1),a%irp,info) call b%free() diff --git a/cbind/base/psb_c_serial_cbind_mod.F90 b/cbind/base/psb_c_serial_cbind_mod.F90 index dba41b67..b298d84a 100644 --- a/cbind/base/psb_c_serial_cbind_mod.F90 +++ b/cbind/base/psb_c_serial_cbind_mod.F90 @@ -204,38 +204,5 @@ contains end function psb_c_cvect_set_vect - function psb_c_g2l(cdh,gindex,cowned) bind(c) result(lindex) - use psb_base_mod - implicit none - - integer(psb_c_lpk_), value :: gindex - logical(c_bool), value :: cowned - type(psb_c_descriptor) :: cdh - integer(psb_c_ipk_) :: lindex - - type(psb_desc_type), pointer :: descp - integer(psb_ipk_) :: info, localindex, ixb, iam, np - logical :: owned - - ixb = psb_c_get_index_base() - owned = cowned - lindex = -1 - if (c_associated(cdh%item)) then - call c_f_pointer(cdh%item,descp) - else - return - end if - - call psb_info(descp%get_context(),iam,np) - if (ixb == 1) then - call descp%indxmap%g2l(gindex,localindex,info,owned=owned) - lindex = localindex - else - call descp%indxmap%g2l(gindex+(1-ixb),localindex,info,owned=owned) - lindex = localindex-(1-ixb) - endif - - end function psb_c_g2l - end module psb_c_serial_cbind_mod