From a7ff60209f79cb9601eb94673397155ca95677fa Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 3 Dec 2007 10:36:04 +0000 Subject: [PATCH] Fixed DIAG preconditioner to use getdiag. --- mlprec/mld_ddiagsc_bld.f90 | 39 +++++-------------------------------- mlprec/mld_zdiagsc_bld.f90 | 40 +++++++++----------------------------- 2 files changed, 14 insertions(+), 65 deletions(-) diff --git a/mlprec/mld_ddiagsc_bld.f90 b/mlprec/mld_ddiagsc_bld.f90 index 325be3e1..7df79b57 100644 --- a/mlprec/mld_ddiagsc_bld.f90 +++ b/mlprec/mld_ddiagsc_bld.f90 @@ -81,13 +81,14 @@ subroutine mld_ddiag_bld(a,desc_a,p,upd,info) goto 9999 end if - call psb_csrws(p%d,a,info,trans='N') + call psb_sp_getdiag(a,p%d,info) if(info /= 0) then info=4010 - ch_err='psb_csrws' + ch_err='psb_sp_getdiag' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if + call psb_cdcpy(desc_a,p%desc_Data,info) if (info /= 0) then call psb_errpush(4010,name,a_err='psb_cdcpy') @@ -96,19 +97,16 @@ subroutine mld_ddiag_bld(a,desc_a,p,upd,info) if (debug) write(ilout+me,*) 'VDIAG ',n_row do i=1,n_row - if (p%d(i).eq.dzero) then + if (p%d(i) == dzero) then p%d(i) = done else p%d(i) = done/p%d(i) endif if (debug) write(ilout+me,*) i,desc_a%loc_to_glob(i), p%d(i) - if (p%d(i).lt.0.d0) then - write(0,*) me,'Negative RWS? ',i,p%d(i) - endif end do + if (a%pl(1) /= 0) then - allocate(work(n_row),stat=info) if (info /= 0) then info=4025 call psb_errpush(info,name,i_err=(/n_row,0,0,0,0/),& @@ -122,35 +120,8 @@ subroutine mld_ddiag_bld(a,desc_a,p,upd,info) call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - - deallocate(work) endif - if (debug) then - allocate(gd(mglob),stat=info) - if (info /= 0) then - info=4025 - call psb_errpush(info,name,i_err=(/mglob,0,0,0,0/),& - & a_err='real(kind(1.d0))') - goto 9999 - end if - - call psb_gather(gd, p%d, desc_a, info, root=iroot) - if(info /= 0) then - info=4010 - ch_err='psb_dgatherm' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - if (me.eq.iroot) then - write(iout+np,*) 'VDIAG CHECK ',mglob - do i=1,mglob - write(iout+np,*) i,gd(i) - enddo - endif - deallocate(gd) - endif if (debug) write(*,*) 'Preconditioner DIAG computed OK' diff --git a/mlprec/mld_zdiagsc_bld.f90 b/mlprec/mld_zdiagsc_bld.f90 index 19daa41f..ea15a06a 100644 --- a/mlprec/mld_zdiagsc_bld.f90 +++ b/mlprec/mld_zdiagsc_bld.f90 @@ -84,14 +84,20 @@ subroutine mld_zdiag_bld(a,desc_a,p,upd,info) goto 9999 end if - call psb_csrws(p%d,a,info,trans='N') + call psb_sp_getdiag(a,p%d,info) if(info /= 0) then info=4010 - ch_err='psb_csrws' + ch_err='psb_sp_getdiag' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if + call psb_cdcpy(desc_a,p%desc_Data,info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='psb_cdcpy') + goto 9999 + end if + if (debug) write(ilout+me,*) 'VDIAG ',n_row do i=1,n_row if (p%d(i) == zzero) then @@ -101,12 +107,9 @@ subroutine mld_zdiag_bld(a,desc_a,p,upd,info) endif if (debug) write(ilout+me,*) i,desc_a%loc_to_glob(i), p%d(i) -!!$ if (p%d(i).lt.0.d0) then -!!$ write(0,*) me,'Negative RWS? ',i,p%d(i) -!!$ endif end do + if (a%pl(1) /= 0) then - allocate(work(n_row),stat=info) if (info /= 0) then info=4025 call psb_errpush(info,name,i_err=(/n_row,0,0,0,0/),& @@ -120,33 +123,8 @@ subroutine mld_zdiag_bld(a,desc_a,p,upd,info) call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - - deallocate(work) endif - if (debug) then - allocate(gd(mglob),stat=info) - if (info /= 0) then - call psb_errpush(4010,name,a_err='Allocate') - goto 9999 - end if - - call psb_gather(gd, p%d, desc_a, info, root=iroot) - if(info /= 0) then - info=4010 - ch_err='psb_zgatherm' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - if (me.eq.iroot) then - write(iout+np,*) 'VDIAG CHECK ',mglob - do i=1,mglob - write(iout+np,*) i,gd(i) - enddo - endif - deallocate(gd) - endif if (debug) write(*,*) 'Preconditioner DIAG computed OK'