Fix build of BJAC diagonal block factorization.

mlprec/impl/smoother/mld_c_jac_smoother_bld.f90

@@ -51,6 +51,7 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
   class(psb_c_base_vect_type), intent(in), optional  :: vmold
   class(psb_i_base_vect_type), intent(in), optional  :: imold
   ! Local variables
+  type(psb_cspmat_type) :: tmpa
   integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
   integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
   character(len=20) :: name='c_jac_smoother_bld', ch_err
@@ -77,12 +78,17 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
     call sm%nd%free()
     sm%pa => a
     sm%nd_nnz_tot = nztota
+    call psb_sum(ictxt,sm%nd_nnz_tot)
+    call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
 
   class default
     if (smsv%is_global()) then
       ! Do not put anything into SM%ND since the solver
       ! is acting globally.
+      call sm%nd%free()
       sm%nd_nnz_tot = 0
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+      call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
     else
       call a%csclip(sm%nd,info,&
            & jmin=nrow_a+1,rscale=.false.,cscale=.false.)
@@ -96,6 +102,10 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
         endif
       end if
       sm%nd_nnz_tot = sm%nd%get_nzeros()
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+      call a%csclip(tmpa,info,&
+           & jmax=nrow_a,rscale=.false.,cscale=.false.)
+      call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
     end if
   end select
   if (info /= psb_success_) then
@@ -103,15 +113,7 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
          & a_err='clip & psb_spcnv csr 4')
     goto 9999
   end if
-  call psb_sum(ictxt,sm%nd_nnz_tot)
 
-
-  call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,&
-         & a_err='solver build')
-    goto 9999
-  end if
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),' end'
 

mlprec/impl/smoother/mld_c_l1_jac_smoother_bld.f90

@@ -108,7 +108,9 @@ subroutine mld_c_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
       sm%nd_nnz_tot = sm%nd%get_nzeros()
       call psb_sum(ictxt,sm%nd_nnz_tot)
       arwsum = sm%nd%arwsum(info)
-      call a%cp_to(tmpcoo)
+      call a%csclip(tmpa,info,&
+           & jmax=nrow_a,rscale=.false.,cscale=.false.)
+      call tmpa%mv_to(tmpcoo)
       call tmpcoo%set_dupl(psb_dupl_add_)
       nz = tmpcoo%get_nzeros()
       call tmpcoo%reallocate(nz+n_row)

mlprec/impl/smoother/mld_d_jac_smoother_bld.f90

@@ -51,6 +51,7 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
   class(psb_d_base_vect_type), intent(in), optional  :: vmold
   class(psb_i_base_vect_type), intent(in), optional  :: imold
   ! Local variables
+  type(psb_dspmat_type) :: tmpa
   integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
   integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
   character(len=20) :: name='d_jac_smoother_bld', ch_err
@@ -77,12 +78,17 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
     call sm%nd%free()
     sm%pa => a
     sm%nd_nnz_tot = nztota
+    call psb_sum(ictxt,sm%nd_nnz_tot)
+    call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
 
   class default
     if (smsv%is_global()) then
       ! Do not put anything into SM%ND since the solver
       ! is acting globally.
+      call sm%nd%free()
       sm%nd_nnz_tot = 0
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+      call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
     else
       call a%csclip(sm%nd,info,&
            & jmin=nrow_a+1,rscale=.false.,cscale=.false.)
@@ -96,6 +102,10 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
         endif
       end if
       sm%nd_nnz_tot = sm%nd%get_nzeros()
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+      call a%csclip(tmpa,info,&
+           & jmax=nrow_a,rscale=.false.,cscale=.false.)
+      call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
     end if
   end select
   if (info /= psb_success_) then
@@ -103,15 +113,7 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
          & a_err='clip & psb_spcnv csr 4')
     goto 9999
   end if
-  call psb_sum(ictxt,sm%nd_nnz_tot)
 
-
-  call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,&
-         & a_err='solver build')
-    goto 9999
-  end if
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),' end'
 

mlprec/impl/smoother/mld_d_l1_jac_smoother_bld.f90

@@ -108,7 +108,9 @@ subroutine mld_d_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
       sm%nd_nnz_tot = sm%nd%get_nzeros()
       call psb_sum(ictxt,sm%nd_nnz_tot)
       arwsum = sm%nd%arwsum(info)
-      call a%cp_to(tmpcoo)
+      call a%csclip(tmpa,info,&
+           & jmax=nrow_a,rscale=.false.,cscale=.false.)
+      call tmpa%mv_to(tmpcoo)
       call tmpcoo%set_dupl(psb_dupl_add_)
       nz = tmpcoo%get_nzeros()
       call tmpcoo%reallocate(nz+n_row)

mlprec/impl/smoother/mld_s_jac_smoother_bld.f90

@@ -51,6 +51,7 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
   class(psb_s_base_vect_type), intent(in), optional  :: vmold
   class(psb_i_base_vect_type), intent(in), optional  :: imold
   ! Local variables
+  type(psb_sspmat_type) :: tmpa
   integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
   integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
   character(len=20) :: name='s_jac_smoother_bld', ch_err
@@ -77,12 +78,17 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
     call sm%nd%free()
     sm%pa => a
     sm%nd_nnz_tot = nztota
+    call psb_sum(ictxt,sm%nd_nnz_tot)
+    call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
 
   class default
     if (smsv%is_global()) then
       ! Do not put anything into SM%ND since the solver
       ! is acting globally.
+      call sm%nd%free()
       sm%nd_nnz_tot = 0
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+      call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
     else
       call a%csclip(sm%nd,info,&
            & jmin=nrow_a+1,rscale=.false.,cscale=.false.)
@@ -96,6 +102,10 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
         endif
       end if
       sm%nd_nnz_tot = sm%nd%get_nzeros()
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+      call a%csclip(tmpa,info,&
+           & jmax=nrow_a,rscale=.false.,cscale=.false.)
+      call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
     end if
   end select
   if (info /= psb_success_) then
@@ -103,15 +113,7 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
          & a_err='clip & psb_spcnv csr 4')
     goto 9999
   end if
-  call psb_sum(ictxt,sm%nd_nnz_tot)
 
-
-  call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,&
-         & a_err='solver build')
-    goto 9999
-  end if
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),' end'
 

mlprec/impl/smoother/mld_s_l1_jac_smoother_bld.f90

@@ -108,7 +108,9 @@ subroutine mld_s_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
       sm%nd_nnz_tot = sm%nd%get_nzeros()
       call psb_sum(ictxt,sm%nd_nnz_tot)
       arwsum = sm%nd%arwsum(info)
-      call a%cp_to(tmpcoo)
+      call a%csclip(tmpa,info,&
+           & jmax=nrow_a,rscale=.false.,cscale=.false.)
+      call tmpa%mv_to(tmpcoo)
       call tmpcoo%set_dupl(psb_dupl_add_)
       nz = tmpcoo%get_nzeros()
       call tmpcoo%reallocate(nz+n_row)

mlprec/impl/smoother/mld_z_jac_smoother_bld.f90

@@ -51,6 +51,7 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
   class(psb_z_base_vect_type), intent(in), optional  :: vmold
   class(psb_i_base_vect_type), intent(in), optional  :: imold
   ! Local variables
+  type(psb_zspmat_type) :: tmpa
   integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
   integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
   character(len=20) :: name='z_jac_smoother_bld', ch_err
@@ -77,12 +78,17 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
     call sm%nd%free()
     sm%pa => a
     sm%nd_nnz_tot = nztota
+    call psb_sum(ictxt,sm%nd_nnz_tot)
+    call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
 
   class default
     if (smsv%is_global()) then
       ! Do not put anything into SM%ND since the solver
       ! is acting globally.
+      call sm%nd%free()
       sm%nd_nnz_tot = 0
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+      call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
     else
       call a%csclip(sm%nd,info,&
            & jmin=nrow_a+1,rscale=.false.,cscale=.false.)
@@ -96,6 +102,10 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
         endif
       end if
       sm%nd_nnz_tot = sm%nd%get_nzeros()
+      call psb_sum(ictxt,sm%nd_nnz_tot)
+      call a%csclip(tmpa,info,&
+           & jmax=nrow_a,rscale=.false.,cscale=.false.)
+      call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
     end if
   end select
   if (info /= psb_success_) then
@@ -103,15 +113,7 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
          & a_err='clip & psb_spcnv csr 4')
     goto 9999
   end if
-  call psb_sum(ictxt,sm%nd_nnz_tot)
 
-
-  call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,&
-         & a_err='solver build')
-    goto 9999
-  end if
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),' end'
 

mlprec/impl/smoother/mld_z_l1_jac_smoother_bld.f90

@@ -108,7 +108,9 @@ subroutine mld_z_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
       sm%nd_nnz_tot = sm%nd%get_nzeros()
       call psb_sum(ictxt,sm%nd_nnz_tot)
       arwsum = sm%nd%arwsum(info)
-      call a%cp_to(tmpcoo)
+      call a%csclip(tmpa,info,&
+           & jmax=nrow_a,rscale=.false.,cscale=.false.)
+      call tmpa%mv_to(tmpcoo)
       call tmpcoo%set_dupl(psb_dupl_add_)
       nz = tmpcoo%get_nzeros()
       call tmpcoo%reallocate(nz+n_row)