mld2p4-2:

mlprec/impl/mld_c_dec_map_bld.f90
 mlprec/impl/mld_caggrmat_biz_asb.f90
 mlprec/impl/mld_caggrmat_minnrg_asb.f90
 mlprec/impl/mld_caggrmat_smth_asb.f90
 mlprec/impl/mld_cmlprec_aply.f90
 mlprec/impl/mld_d_dec_map_bld.f90
 mlprec/impl/mld_daggrmat_biz_asb.f90
 mlprec/impl/mld_daggrmat_minnrg_asb.f90
 mlprec/impl/mld_daggrmat_smth_asb.f90
 mlprec/impl/mld_dmlprec_aply.f90
 mlprec/impl/mld_s_dec_map_bld.f90
 mlprec/impl/mld_saggrmat_biz_asb.f90
 mlprec/impl/mld_saggrmat_minnrg_asb.f90
 mlprec/impl/mld_saggrmat_smth_asb.f90
 mlprec/impl/mld_smlprec_aply.f90
 mlprec/impl/mld_z_dec_map_bld.f90
 mlprec/impl/mld_zaggrmat_biz_asb.f90
 mlprec/impl/mld_zaggrmat_minnrg_asb.f90
 mlprec/impl/mld_zaggrmat_smth_asb.f90
 mlprec/impl/mld_zmlprec_aply.f90
 mlprec/impl/smoother/mld_d_jac_smoother_bld.f90
 mlprec/impl/solver/mld_c_diag_solver_bld.f90
 mlprec/impl/solver/mld_d_diag_solver_bld.f90
 mlprec/impl/solver/mld_s_diag_solver_bld.f90
 mlprec/impl/solver/mld_z_diag_solver_bld.f90

New function form for get_diag.

mlprec/impl/mld_c_dec_map_bld.f90

@@ -83,14 +83,7 @@ subroutine mld_c_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info)
     goto 9999
   end if
 
-  allocate(diag(nr),stat=info)
-  if(info /= psb_success_) then
-    info=psb_err_alloc_request_
-    call psb_errpush(info,name,i_err=(/nr,izero,izero,izero,izero/),&
-         & a_err='complex(psb_spk_)')
-    goto 9999
-  end if
-  call a%get_diag(diag,info)
+  diag = a%get_diag(info)
   if(info /= psb_success_) then
     info=psb_err_from_subroutine_
     call psb_errpush(info,name,a_err='psb_sp_getdiag')

mlprec/impl/mld_caggrmat_biz_asb.f90

@@ -144,16 +144,10 @@ subroutine mld_caggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
-  allocate(adiag(ncol),stat=info)
-
-  if (info /= psb_success_) then 
-    info=psb_err_alloc_request_; ierr(1)=nrow;
-    call psb_errpush(info,name,i_err=ierr,a_err='complex(psb_spk_)')
-    goto 9999      
-  end if
-
   ! Get the diagonal D
-  call a%get_diag(adiag,info)
+  adiag =  a%get_diag(info)
+  if (info == psb_success_) &
+       & call psb_realloc(ncol,adiag,info)    
   if (info == psb_success_) &
        & call psb_halo(adiag,desc_a,info)
 

mlprec/impl/mld_caggrmat_minnrg_asb.f90

@@ -178,7 +178,7 @@ subroutine mld_caggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
-  allocate(adiag(ncol),adinv(ncol),&
+  allocate(adinv(ncol),&
        & omf(ncol),omp(ntaggr),oden(ntaggr),omi(ncol),stat=info)
 
   if (info /= psb_success_) then 
@@ -188,7 +188,9 @@ subroutine mld_caggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
   end if
 
   ! Get the diagonal D
-  call a%get_diag(adiag,info)
+  adiag =  a%get_diag(info)
+  if (info == psb_success_) &
+       & call psb_realloc(ncol,adiag,info)    
   if (info == psb_success_) &
        & call psb_halo(adiag,desc_a,info)
 

mlprec/impl/mld_caggrmat_smth_asb.f90

@@ -158,16 +158,11 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
-  allocate(adiag(ncol),stat=info)
-
-  if (info /= psb_success_) then 
-    info=psb_err_alloc_request_; ierr(1)=nrow;
-    call psb_errpush(info,name,i_err=ierr,a_err='complex(psb_spk_)')
-    goto 9999      
-  end if
 
   ! Get the diagonal D
-  call a%get_diag(adiag,info)
+  adiag = a%get_diag(info)
+  if (info == psb_success_) &
+       & call psb_realloc(ncol,adiag,info)
   if (info == psb_success_) &
        & call psb_halo(adiag,desc_a,info)
 

mlprec/impl/mld_cmlprec_aply.f90

@@ -231,7 +231,7 @@
 !         b. Call recursively itself passing
 !            r(ilev) for transfer to the next level
 !            (r(ilev) matches x(ilev-1) in step 1)
-
+!
 !         c. Transfer y(ilev+1) to the current level:
 !            y(ilev) = y(ilev) + P(ilev+1)*y(ilev+1)
 !           

mlprec/impl/mld_d_dec_map_bld.f90

@@ -83,14 +83,7 @@ subroutine mld_d_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info)
     goto 9999
   end if
 
-  allocate(diag(nr),stat=info)
-  if(info /= psb_success_) then
-    info=psb_err_alloc_request_
-    call psb_errpush(info,name,i_err=(/nr,izero,izero,izero,izero/),&
-         & a_err='real(psb_dpk_)')
-    goto 9999
-  end if
-  call a%get_diag(diag,info)
+  diag = a%get_diag(info)
   if(info /= psb_success_) then
     info=psb_err_from_subroutine_
     call psb_errpush(info,name,a_err='psb_sp_getdiag')

mlprec/impl/mld_daggrmat_biz_asb.f90

@@ -144,16 +144,10 @@ subroutine mld_daggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
-  allocate(adiag(ncol),stat=info)
-
-  if (info /= psb_success_) then 
-    info=psb_err_alloc_request_; ierr(1)=nrow;
-    call psb_errpush(info,name,i_err=ierr,a_err='real(psb_dpk_)')
-    goto 9999      
-  end if
-
   ! Get the diagonal D
-  call a%get_diag(adiag,info)
+  adiag =  a%get_diag(info)
+  if (info == psb_success_) &
+       & call psb_realloc(ncol,adiag,info)    
   if (info == psb_success_) &
        & call psb_halo(adiag,desc_a,info)
 

mlprec/impl/mld_daggrmat_minnrg_asb.f90

@@ -178,7 +178,7 @@ subroutine mld_daggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
-  allocate(adiag(ncol),adinv(ncol),&
+  allocate(adinv(ncol),&
        & omf(ncol),omp(ntaggr),oden(ntaggr),omi(ncol),stat=info)
 
   if (info /= psb_success_) then 
@@ -188,7 +188,9 @@ subroutine mld_daggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
   end if
 
   ! Get the diagonal D
-  call a%get_diag(adiag,info)
+  adiag =  a%get_diag(info)
+  if (info == psb_success_) &
+       & call psb_realloc(ncol,adiag,info)    
   if (info == psb_success_) &
        & call psb_halo(adiag,desc_a,info)
 

mlprec/impl/mld_daggrmat_smth_asb.f90

@@ -158,16 +158,11 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
-  allocate(adiag(ncol),stat=info)
-
-  if (info /= psb_success_) then 
-    info=psb_err_alloc_request_; ierr(1)=nrow;
-    call psb_errpush(info,name,i_err=ierr,a_err='real(psb_dpk_)')
-    goto 9999      
-  end if
 
   ! Get the diagonal D
-  call a%get_diag(adiag,info)
+  adiag = a%get_diag(info)
+  if (info == psb_success_) &
+       & call psb_realloc(ncol,adiag,info)
   if (info == psb_success_) &
        & call psb_halo(adiag,desc_a,info)
 

mlprec/impl/mld_dmlprec_aply.f90

@@ -231,7 +231,7 @@
 !         b. Call recursively itself passing
 !            r(ilev) for transfer to the next level
 !            (r(ilev) matches x(ilev-1) in step 1)
-
+!
 !         c. Transfer y(ilev+1) to the current level:
 !            y(ilev) = y(ilev) + P(ilev+1)*y(ilev+1)
 !           
@@ -1028,23 +1028,22 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
   end if
   level = 1
   do level = 1, nlev
-!!$     write(0,*) me, 'Allocating MLPREC_WRK at level ',level
     call psb_geasb(mlprec_wrk(level)%vx2l,&
          & p%precv(level)%base_desc,info,&
          & scratch=.true.,mold=x%v)
-    if (info == 0) call psb_geasb(mlprec_wrk(level)%vy2l,&
+    call psb_geasb(mlprec_wrk(level)%vy2l,&
          & p%precv(level)%base_desc,info,&
          & scratch=.true.,mold=x%v)
-    if (info == 0) call psb_geasb(mlprec_wrk(level)%vtx,&
+    call psb_geasb(mlprec_wrk(level)%vtx,&
          & p%precv(level)%base_desc,info,&
          & scratch=.true.,mold=x%v)
-    if (info == 0) call psb_geasb(mlprec_wrk(level)%vty,&
+    call psb_geasb(mlprec_wrk(level)%vty,&
          & p%precv(level)%base_desc,info,&
          & scratch=.true.,mold=x%v)
-    if ((info/=0).or.psb_errstatus_fatal()) then 
+    if (psb_errstatus_fatal()) then 
       nc2l = p%precv(level)%base_desc%get_local_cols()
       info=psb_err_alloc_request_
-      call psb_errpush(info,name,i_err=(/4*nc2l,izero,izero,izero,izero/),&
+      call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),&
            & a_err='real(psb_dpk_)')
       goto 9999      
     end if
@@ -1066,12 +1065,11 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
   call psb_geaxpby(alpha,mlprec_wrk(level)%vy2l,beta,y,&
        &   p%precv(level)%base_desc,info)
   do level = 1, nlev
-!!$     write(0,*) me, 'Freeing MLPREC_WRK at level ',level
-    if (info == 0) call mlprec_wrk(level)%vx2l%free(info)
-    if (info == 0) call mlprec_wrk(level)%vy2l%free(info)
-    if (info == 0) call mlprec_wrk(level)%vtx%free(info)
-    if (info == 0) call mlprec_wrk(level)%vty%free(info)
-    if ((info /= 0).or.psb_errstatus_fatal()) then 
+    call mlprec_wrk(level)%vx2l%free(info)
+    call mlprec_wrk(level)%vy2l%free(info)
+    call mlprec_wrk(level)%vtx%free(info)
+    call mlprec_wrk(level)%vty%free(info)
+    if (psb_errstatus_fatal()) then 
       info=psb_err_alloc_request_
       nc2l = p%precv(level)%base_desc%get_local_cols()
       call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),&
@@ -1216,7 +1214,6 @@ contains
 
         select case (trans_) 
         case('N')
-!!$           write(0,*) me,' Applying POST at level ',level
           if (level > 1) then 
             ! Apply the restriction
             call psb_map_X2Y(done,mlprec_wrk(level-1)%vx2l,&
@@ -1289,7 +1286,7 @@ contains
             end if
             
           end if
-!!$          write(0,*) me,' Done POST at level ',level
+
         case('T','C')
 
           ! Post-smoothing transpose is pre-smoothing

mlprec/impl/mld_s_dec_map_bld.f90

@@ -83,14 +83,7 @@ subroutine mld_s_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info)
     goto 9999
   end if
 
-  allocate(diag(nr),stat=info)
-  if(info /= psb_success_) then
-    info=psb_err_alloc_request_
-    call psb_errpush(info,name,i_err=(/nr,izero,izero,izero,izero/),&
-         & a_err='real(psb_spk_)')
-    goto 9999
-  end if
-  call a%get_diag(diag,info)
+  diag = a%get_diag(info)
   if(info /= psb_success_) then
     info=psb_err_from_subroutine_
     call psb_errpush(info,name,a_err='psb_sp_getdiag')

mlprec/impl/mld_saggrmat_biz_asb.f90

@@ -144,16 +144,10 @@ subroutine mld_saggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
-  allocate(adiag(ncol),stat=info)
-
-  if (info /= psb_success_) then 
-    info=psb_err_alloc_request_; ierr(1)=nrow;
-    call psb_errpush(info,name,i_err=ierr,a_err='real(psb_spk_)')
-    goto 9999      
-  end if
-
   ! Get the diagonal D
-  call a%get_diag(adiag,info)
+  adiag =  a%get_diag(info)
+  if (info == psb_success_) &
+       & call psb_realloc(ncol,adiag,info)    
   if (info == psb_success_) &
        & call psb_halo(adiag,desc_a,info)
 

mlprec/impl/mld_saggrmat_minnrg_asb.f90

@@ -178,7 +178,7 @@ subroutine mld_saggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
-  allocate(adiag(ncol),adinv(ncol),&
+  allocate(adinv(ncol),&
        & omf(ncol),omp(ntaggr),oden(ntaggr),omi(ncol),stat=info)
 
   if (info /= psb_success_) then 
@@ -188,7 +188,9 @@ subroutine mld_saggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
   end if
 
   ! Get the diagonal D
-  call a%get_diag(adiag,info)
+  adiag =  a%get_diag(info)
+  if (info == psb_success_) &
+       & call psb_realloc(ncol,adiag,info)    
   if (info == psb_success_) &
        & call psb_halo(adiag,desc_a,info)
 

mlprec/impl/mld_saggrmat_smth_asb.f90

@@ -158,16 +158,11 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
-  allocate(adiag(ncol),stat=info)
-
-  if (info /= psb_success_) then 
-    info=psb_err_alloc_request_; ierr(1)=nrow;
-    call psb_errpush(info,name,i_err=ierr,a_err='real(psb_spk_)')
-    goto 9999      
-  end if
 
   ! Get the diagonal D
-  call a%get_diag(adiag,info)
+  adiag = a%get_diag(info)
+  if (info == psb_success_) &
+       & call psb_realloc(ncol,adiag,info)
   if (info == psb_success_) &
        & call psb_halo(adiag,desc_a,info)
 

mlprec/impl/mld_smlprec_aply.f90

@@ -231,7 +231,7 @@
 !         b. Call recursively itself passing
 !            r(ilev) for transfer to the next level
 !            (r(ilev) matches x(ilev-1) in step 1)
-
+!
 !         c. Transfer y(ilev+1) to the current level:
 !            y(ilev) = y(ilev) + P(ilev+1)*y(ilev+1)
 !           

mlprec/impl/mld_z_dec_map_bld.f90

@@ -83,14 +83,7 @@ subroutine mld_z_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info)
     goto 9999
   end if
 
-  allocate(diag(nr),stat=info)
-  if(info /= psb_success_) then
-    info=psb_err_alloc_request_
-    call psb_errpush(info,name,i_err=(/nr,izero,izero,izero,izero/),&
-         & a_err='complex(psb_dpk_)')
-    goto 9999
-  end if
-  call a%get_diag(diag,info)
+  diag = a%get_diag(info)
   if(info /= psb_success_) then
     info=psb_err_from_subroutine_
     call psb_errpush(info,name,a_err='psb_sp_getdiag')

mlprec/impl/mld_zaggrmat_biz_asb.f90

@@ -144,16 +144,10 @@ subroutine mld_zaggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
-  allocate(adiag(ncol),stat=info)
-
-  if (info /= psb_success_) then 
-    info=psb_err_alloc_request_; ierr(1)=nrow;
-    call psb_errpush(info,name,i_err=ierr,a_err='complex(psb_dpk_)')
-    goto 9999      
-  end if
-
   ! Get the diagonal D
-  call a%get_diag(adiag,info)
+  adiag =  a%get_diag(info)
+  if (info == psb_success_) &
+       & call psb_realloc(ncol,adiag,info)    
   if (info == psb_success_) &
        & call psb_halo(adiag,desc_a,info)
 

mlprec/impl/mld_zaggrmat_minnrg_asb.f90

@@ -178,7 +178,7 @@ subroutine mld_zaggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
-  allocate(adiag(ncol),adinv(ncol),&
+  allocate(adinv(ncol),&
        & omf(ncol),omp(ntaggr),oden(ntaggr),omi(ncol),stat=info)
 
   if (info /= psb_success_) then 
@@ -188,7 +188,9 @@ subroutine mld_zaggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
   end if
 
   ! Get the diagonal D
-  call a%get_diag(adiag,info)
+  adiag =  a%get_diag(info)
+  if (info == psb_success_) &
+       & call psb_realloc(ncol,adiag,info)    
   if (info == psb_success_) &
        & call psb_halo(adiag,desc_a,info)
 

mlprec/impl/mld_zaggrmat_smth_asb.f90

@@ -158,16 +158,11 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
-  allocate(adiag(ncol),stat=info)
-
-  if (info /= psb_success_) then 
-    info=psb_err_alloc_request_; ierr(1)=nrow;
-    call psb_errpush(info,name,i_err=ierr,a_err='complex(psb_dpk_)')
-    goto 9999      
-  end if
 
   ! Get the diagonal D
-  call a%get_diag(adiag,info)
+  adiag = a%get_diag(info)
+  if (info == psb_success_) &
+       & call psb_realloc(ncol,adiag,info)
   if (info == psb_success_) &
        & call psb_halo(adiag,desc_a,info)
 

mlprec/impl/mld_zmlprec_aply.f90

@@ -231,7 +231,7 @@
 !         b. Call recursively itself passing
 !            r(ilev) for transfer to the next level
 !            (r(ilev) matches x(ilev-1) in step 1)
-
+!
 !         c. Transfer y(ilev+1) to the current level:
 !            y(ilev) = y(ilev) + P(ilev+1)*y(ilev+1)
 !           

mlprec/impl/solver/mld_c_diag_solver_bld.f90

@@ -56,6 +56,7 @@ subroutine mld_c_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold)
   ! Local variables
   integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
   complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
+  complex(psb_spk_), allocatable :: tdb(:)
   integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
   character(len=20) :: name='c_diag_solver_bld', ch_err
 
@@ -71,23 +72,13 @@ subroutine mld_c_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold)
 
   n_row  = desc_a%get_local_rows()
   nrow_a = a%get_nrows()
-  if (allocated(sv%d)) then 
-    if (size(sv%d) < n_row) then 
-      deallocate(sv%d)
-    endif
-  endif
-  if (.not.allocated(sv%d)) then 
-    allocate(sv%d(n_row),stat=info)
-    if (info /= psb_success_) then 
-      call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
-      goto 9999      
-    end if
-
-  endif
 
-  call a%get_diag(sv%d,info)
+  sv%d = a%get_diag(info)
+  if (info == psb_success_) call psb_realloc(n_row,sv%d,info)
   if (present(b)) then 
-    if (info == psb_success_) call b%get_diag(sv%d(nrow_a+1:), info)
+    tdb=b%get_diag(info)
+    if (size(tdb)+nrow_a > n_row) call psb_realloc(nrow_a+size(tdb),sv%d,info)
+    if (info == psb_success_) sv%d(nrow_a+1:nrow_a+size(tdb)) = tdb(:)
   end if
   if (info /= psb_success_) then 
     call psb_errpush(psb_err_from_subroutine_,name,a_err='get_diag')

mlprec/impl/solver/mld_d_diag_solver_bld.f90

@@ -56,6 +56,7 @@ subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold)
   ! Local variables
   integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
   real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
+  real(psb_dpk_), allocatable :: tdb(:)
   integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
   character(len=20) :: name='d_diag_solver_bld', ch_err
 
@@ -71,23 +72,13 @@ subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold)
 
   n_row  = desc_a%get_local_rows()
   nrow_a = a%get_nrows()
-  if (allocated(sv%d)) then 
-    if (size(sv%d) < n_row) then 
-      deallocate(sv%d)
-    endif
-  endif
-  if (.not.allocated(sv%d)) then 
-    allocate(sv%d(n_row),stat=info)
-    if (info /= psb_success_) then 
-      call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
-      goto 9999      
-    end if
-
-  endif
 
-  call a%get_diag(sv%d,info)
+  sv%d = a%get_diag(info)
+  if (info == psb_success_) call psb_realloc(n_row,sv%d,info)
   if (present(b)) then 
-    if (info == psb_success_) call b%get_diag(sv%d(nrow_a+1:), info)
+    tdb=b%get_diag(info)
+    if (size(tdb)+nrow_a > n_row) call psb_realloc(nrow_a+size(tdb),sv%d,info)
+    if (info == psb_success_) sv%d(nrow_a+1:nrow_a+size(tdb)) = tdb(:)
   end if
   if (info /= psb_success_) then 
     call psb_errpush(psb_err_from_subroutine_,name,a_err='get_diag')

mlprec/impl/solver/mld_s_diag_solver_bld.f90

@@ -56,6 +56,7 @@ subroutine mld_s_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold)
   ! Local variables
   integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
   real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
+  real(psb_spk_), allocatable :: tdb(:)
   integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
   character(len=20) :: name='s_diag_solver_bld', ch_err
 
@@ -71,23 +72,13 @@ subroutine mld_s_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold)
 
   n_row  = desc_a%get_local_rows()
   nrow_a = a%get_nrows()
-  if (allocated(sv%d)) then 
-    if (size(sv%d) < n_row) then 
-      deallocate(sv%d)
-    endif
-  endif
-  if (.not.allocated(sv%d)) then 
-    allocate(sv%d(n_row),stat=info)
-    if (info /= psb_success_) then 
-      call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
-      goto 9999      
-    end if
-
-  endif
 
-  call a%get_diag(sv%d,info)
+  sv%d = a%get_diag(info)
+  if (info == psb_success_) call psb_realloc(n_row,sv%d,info)
   if (present(b)) then 
-    if (info == psb_success_) call b%get_diag(sv%d(nrow_a+1:), info)
+    tdb=b%get_diag(info)
+    if (size(tdb)+nrow_a > n_row) call psb_realloc(nrow_a+size(tdb),sv%d,info)
+    if (info == psb_success_) sv%d(nrow_a+1:nrow_a+size(tdb)) = tdb(:)
   end if
   if (info /= psb_success_) then 
     call psb_errpush(psb_err_from_subroutine_,name,a_err='get_diag')

mlprec/impl/solver/mld_z_diag_solver_bld.f90

@@ -56,6 +56,7 @@ subroutine mld_z_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold)
   ! Local variables
   integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
   complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
+  complex(psb_dpk_), allocatable :: tdb(:)
   integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
   character(len=20) :: name='z_diag_solver_bld', ch_err
 
@@ -71,23 +72,13 @@ subroutine mld_z_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold)
 
   n_row  = desc_a%get_local_rows()
   nrow_a = a%get_nrows()
-  if (allocated(sv%d)) then 
-    if (size(sv%d) < n_row) then 
-      deallocate(sv%d)
-    endif
-  endif
-  if (.not.allocated(sv%d)) then 
-    allocate(sv%d(n_row),stat=info)
-    if (info /= psb_success_) then 
-      call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
-      goto 9999      
-    end if
-
-  endif
 
-  call a%get_diag(sv%d,info)
+  sv%d = a%get_diag(info)
+  if (info == psb_success_) call psb_realloc(n_row,sv%d,info)
   if (present(b)) then 
-    if (info == psb_success_) call b%get_diag(sv%d(nrow_a+1:), info)
+    tdb=b%get_diag(info)
+    if (size(tdb)+nrow_a > n_row) call psb_realloc(nrow_a+size(tdb),sv%d,info)
+    if (info == psb_success_) sv%d(nrow_a+1:nrow_a+size(tdb)) = tdb(:)
   end if
   if (info /= psb_success_) then 
     call psb_errpush(psb_err_from_subroutine_,name,a_err='get_diag')