fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-19 04:12:11 +00:00
Code Issues Packages Projects Releases Wiki Activity

Fixed DIAG preconditioner to use getdiag.

Browse Source
This commit is contained in:
Salvatore Filippone
2007-12-03 10:36:04 +00:00
parent 5553dc45f0
commit a7ff60209f
2 changed files with 14 additions and 65 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/mld_ddiagsc_bld.f90
+5 -34
View File
@@ -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'
mlprec/mld_zdiagsc_bld.f90
+9 -31
View File
@@ -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'