Improvements to DIAG build in OpenMP

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 

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 

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 

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