From 776c75511245f35b3d23a9927ab1a18e51547c30 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 21 Nov 2022 05:46:18 -0500 Subject: [PATCH] Improvements to DIAG build in OpenMP --- prec/impl/psb_c_diagprec_impl.f90 | 10 ++++++++-- prec/impl/psb_d_diagprec_impl.f90 | 10 ++++++++-- prec/impl/psb_s_diagprec_impl.f90 | 10 ++++++++-- prec/impl/psb_z_diagprec_impl.f90 | 10 ++++++++-- 4 files changed, 32 insertions(+), 8 deletions(-) diff --git a/prec/impl/psb_c_diagprec_impl.f90 b/prec/impl/psb_c_diagprec_impl.f90 index 0b20c7ef..c16f9465 100644 --- a/prec/impl/psb_c_diagprec_impl.f90 +++ b/prec/impl/psb_c_diagprec_impl.f90 @@ -239,7 +239,7 @@ subroutine psb_c_diag_precbld(a,desc_a,prec,info,amold,vmold,imold) class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_i_base_vect_type), intent(in), optional :: imold - integer(psb_ipk_) :: err_act, nrow,i + integer(psb_ipk_) :: err_act, nrow,ncol,i character(len=20) :: name='c_diag_precbld' call psb_erractionsave(err_act) @@ -247,6 +247,7 @@ subroutine psb_c_diag_precbld(a,desc_a,prec,info,amold,vmold,imold) info = psb_success_ call prec%set_ctxt(desc_a%get_ctxt()) nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() prec%d=a%get_diag(info) if (info /= psb_success_) then @@ -255,7 +256,8 @@ subroutine psb_c_diag_precbld(a,desc_a,prec,info,amold,vmold,imold) goto 9999 end if - call psb_realloc(desc_a%get_local_cols(),prec%d,info,pad=cone) + call psb_realloc(ncol,prec%d,info) + !$omp parallel do private(i) do i=1,nrow if (prec%d(i) == dzero) then prec%d(i) = cone @@ -263,6 +265,10 @@ subroutine psb_c_diag_precbld(a,desc_a,prec,info,amold,vmold,imold) prec%d(i) = cone/prec%d(i) endif end do + !$omp parallel do private(i) + do i=nrow+1,ncol + prec%d(i) = cone + end do allocate(prec%dv,stat=info) if (info == 0) then diff --git a/prec/impl/psb_d_diagprec_impl.f90 b/prec/impl/psb_d_diagprec_impl.f90 index 8c7e560c..3a6e32f9 100644 --- a/prec/impl/psb_d_diagprec_impl.f90 +++ b/prec/impl/psb_d_diagprec_impl.f90 @@ -239,7 +239,7 @@ subroutine psb_d_diag_precbld(a,desc_a,prec,info,amold,vmold,imold) class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_i_base_vect_type), intent(in), optional :: imold - integer(psb_ipk_) :: err_act, nrow,i + integer(psb_ipk_) :: err_act, nrow,ncol,i character(len=20) :: name='d_diag_precbld' call psb_erractionsave(err_act) @@ -247,6 +247,7 @@ subroutine psb_d_diag_precbld(a,desc_a,prec,info,amold,vmold,imold) info = psb_success_ call prec%set_ctxt(desc_a%get_ctxt()) nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() prec%d=a%get_diag(info) if (info /= psb_success_) then @@ -255,7 +256,8 @@ subroutine psb_d_diag_precbld(a,desc_a,prec,info,amold,vmold,imold) goto 9999 end if - call psb_realloc(desc_a%get_local_cols(),prec%d,info,pad=done) + call psb_realloc(ncol,prec%d,info) + !$omp parallel do private(i) do i=1,nrow if (prec%d(i) == dzero) then prec%d(i) = done @@ -263,6 +265,10 @@ subroutine psb_d_diag_precbld(a,desc_a,prec,info,amold,vmold,imold) prec%d(i) = done/prec%d(i) endif end do + !$omp parallel do private(i) + do i=nrow+1,ncol + prec%d(i) = done + end do allocate(prec%dv,stat=info) if (info == 0) then diff --git a/prec/impl/psb_s_diagprec_impl.f90 b/prec/impl/psb_s_diagprec_impl.f90 index 29e2e1a7..4074cbff 100644 --- a/prec/impl/psb_s_diagprec_impl.f90 +++ b/prec/impl/psb_s_diagprec_impl.f90 @@ -239,7 +239,7 @@ subroutine psb_s_diag_precbld(a,desc_a,prec,info,amold,vmold,imold) class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_i_base_vect_type), intent(in), optional :: imold - integer(psb_ipk_) :: err_act, nrow,i + integer(psb_ipk_) :: err_act, nrow,ncol,i character(len=20) :: name='s_diag_precbld' call psb_erractionsave(err_act) @@ -247,6 +247,7 @@ subroutine psb_s_diag_precbld(a,desc_a,prec,info,amold,vmold,imold) info = psb_success_ call prec%set_ctxt(desc_a%get_ctxt()) nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() prec%d=a%get_diag(info) if (info /= psb_success_) then @@ -255,7 +256,8 @@ subroutine psb_s_diag_precbld(a,desc_a,prec,info,amold,vmold,imold) goto 9999 end if - call psb_realloc(desc_a%get_local_cols(),prec%d,info,pad=sone) + call psb_realloc(ncol,prec%d,info) + !$omp parallel do private(i) do i=1,nrow if (prec%d(i) == dzero) then prec%d(i) = sone @@ -263,6 +265,10 @@ subroutine psb_s_diag_precbld(a,desc_a,prec,info,amold,vmold,imold) prec%d(i) = sone/prec%d(i) endif end do + !$omp parallel do private(i) + do i=nrow+1,ncol + prec%d(i) = sone + end do allocate(prec%dv,stat=info) if (info == 0) then diff --git a/prec/impl/psb_z_diagprec_impl.f90 b/prec/impl/psb_z_diagprec_impl.f90 index 7a20006a..15776b52 100644 --- a/prec/impl/psb_z_diagprec_impl.f90 +++ b/prec/impl/psb_z_diagprec_impl.f90 @@ -239,7 +239,7 @@ subroutine psb_z_diag_precbld(a,desc_a,prec,info,amold,vmold,imold) class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold class(psb_i_base_vect_type), intent(in), optional :: imold - integer(psb_ipk_) :: err_act, nrow,i + integer(psb_ipk_) :: err_act, nrow,ncol,i character(len=20) :: name='z_diag_precbld' call psb_erractionsave(err_act) @@ -247,6 +247,7 @@ subroutine psb_z_diag_precbld(a,desc_a,prec,info,amold,vmold,imold) info = psb_success_ call prec%set_ctxt(desc_a%get_ctxt()) nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() prec%d=a%get_diag(info) if (info /= psb_success_) then @@ -255,7 +256,8 @@ subroutine psb_z_diag_precbld(a,desc_a,prec,info,amold,vmold,imold) goto 9999 end if - call psb_realloc(desc_a%get_local_cols(),prec%d,info,pad=zone) + call psb_realloc(ncol,prec%d,info) + !$omp parallel do private(i) do i=1,nrow if (prec%d(i) == dzero) then prec%d(i) = zone @@ -263,6 +265,10 @@ subroutine psb_z_diag_precbld(a,desc_a,prec,info,amold,vmold,imold) prec%d(i) = zone/prec%d(i) endif end do + !$omp parallel do private(i) + do i=nrow+1,ncol + prec%d(i) = zone + end do allocate(prec%dv,stat=info) if (info == 0) then