fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Merge MLD stuf. Phase 2.

Browse Source
stopcriterion
Salvatore Filippone 18 years ago
parent 6fcab933e8
commit 4158c73b0d
40 changed files with 499 additions and 427 deletions
Show Stats Download Patch File Download Diff File

29
mld_daggrmap_bld.f90
Unescape Escape View File

@ -34,9 +34,9 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info) subroutine mld_daggrmap_bld(aggr_type,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_dgenaggrmap use psb_prec_mod, mld_protect_name => mld_daggrmap_bld
implicit none implicit none
integer, intent(in) :: aggr_type integer, intent(in) :: aggr_type
@ -57,7 +57,7 @@ subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
info=0 info=0
name = 'psb_dgenaggrmap' name = 'mld_daggrmap_bld'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
! !
! Note. At the time being we are ignoring aggr_type ! Note. At the time being we are ignoring aggr_type
@ -72,9 +72,10 @@ subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
nr = a%m nr = a%m
allocate(ilaggr(nr),neigh(nr),stat=info) allocate(ilaggr(nr),neigh(nr),stat=info)
if(info.ne.0) then if(info.ne.0) then
info=4000 info=4025
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,i_err=(/2*nr,0,0,0,0/),&
goto 9999 & a_err='integer')
goto 9999
end if end if
do i=1, nr do i=1, nr
@ -148,9 +149,10 @@ subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
! !
allocate(ils(naggr+10),stat=info) allocate(ils(naggr+10),stat=info)
if(info.ne.0) then if(info.ne.0) then
info=4000 info=4025
call psb_errpush(info,name) call psb_errpush(info,name,i_err=(/naggr+10,0,0,0,0/),&
goto 9999 & a_err='integer')
goto 9999
end if end if
do i=1, size(ils) do i=1, size(ils)
@ -270,9 +272,10 @@ subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
allocate(nlaggr(np),stat=info) allocate(nlaggr(np),stat=info)
if (info/=0) then if (info/=0) then
info=4000 info=4025
call psb_errpush(info,name) call psb_errpush(info,name,i_err=(/np,0,0,0,0/),&
goto 9999 & a_err='integer')
goto 9999
end if end if
nlaggr(:) = 0 nlaggr(:) = 0
@ -290,4 +293,4 @@ subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
end if end if
return return
end subroutine psb_dgenaggrmap end subroutine mld_daggrmap_bld

27
mld_daggrmat_asb.F90
Unescape Escape View File

@ -34,28 +34,30 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_dbldaggrmat(a,desc_a,ac,desc_ac,p,info) subroutine mld_daggrmat_asb(a,desc_a,ac,desc_ac,p,info)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_dbldaggrmat use psb_prec_mod, mld_protect_name => mld_daggrmat_asb
implicit none implicit none
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(in), target :: a
type(psb_dbaseprc_type), intent(inout), target :: p
type(psb_dspmat_type), intent(inout), target :: ac type(psb_dspmat_type), intent(inout), target :: ac
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_ac type(psb_desc_type), intent(inout) :: desc_ac
type(psb_dbaseprc_type), intent(inout), target :: p
integer, intent(out) :: info integer, intent(out) :: info
logical, parameter :: aggr_dump=.false. logical, parameter :: aggr_dump=.false.
integer ::ictxt,np,me, err_act integer ::ictxt,np,me, err_act, icomm
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dbldaggrmat' name='mld_daggrmat_asb'
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_cd_get_context(desc_a)
icomm = psb_cd_get_mpic(desc_a)
ictxt=psb_cd_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
@ -134,9 +136,10 @@ contains
naggr = p%nlaggr(me+1) naggr = p%nlaggr(me+1)
ntaggr = sum(p%nlaggr) ntaggr = sum(p%nlaggr)
allocate(nzbr(np), idisp(np),stat=info) allocate(nzbr(np), idisp(np),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/2*np,0,0,0,0/),&
& a_err='integer')
goto 9999 goto 9999
end if end if
@ -351,7 +354,9 @@ contains
allocate(nzbr(np), idisp(np),stat=info) allocate(nzbr(np), idisp(np),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/2*np,0,0,0,0/),&
& a_err='integer')
goto 9999 goto 9999
end if end if
@ -388,7 +393,9 @@ contains
! !
allocate(p%dorig(nrow),stat=info) allocate(p%dorig(nrow),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/nrow,0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
@ -958,4 +965,4 @@ contains
end subroutine smooth_aggregate end subroutine smooth_aggregate
end subroutine psb_dbldaggrmat end subroutine mld_daggrmat_asb

8
mld_dasmat_bld.f90
Unescape Escape View File

@ -51,10 +51,10 @@
!* * !* *
!* * !* *
!***************************************************************************** !*****************************************************************************
Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt) Subroutine mld_dasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_dasmatbld use psb_prec_mod, mld_protect_name => mld_dasmat_bld
Implicit None Implicit None
! .. Array Arguments .. ! .. Array Arguments ..
@ -78,7 +78,7 @@ Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
Logical,Parameter :: debug=.false., debugprt=.false. Logical,Parameter :: debug=.false., debugprt=.false.
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dasmatbld' name='mld_dasmat_bld'
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -234,5 +234,5 @@ Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
end if end if
Return Return
End Subroutine psb_dasmatbld End Subroutine mld_dasmat_bld

29
mld_dbaseprec_aply.f90
Unescape Escape View File

@ -34,14 +34,14 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) subroutine mld_dbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
! !
! Compute Y <- beta*Y + alpha*K^-1 X ! Compute Y <- beta*Y + alpha*K^-1 X
! where K is a a basic preconditioner stored in prec ! where K is a a basic preconditioner stored in prec
! !
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_dbaseprc_aply use psb_prec_mod, mld_protect_name => mld_dbaseprec_aply
implicit none implicit none
@ -62,7 +62,7 @@ subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
logical,parameter :: debug=.false., debugprt=.false. logical,parameter :: debug=.false., debugprt=.false.
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dbaseprc_aply' name='mld_dbaseprec_aply'
info = 0 info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -96,7 +96,7 @@ subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
else else
allocate(ww(size(x)),stat=info) allocate(ww(size(x)),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') call psb_errpush(4025,name,i_err=(/size(x),0,0,0,0/),a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
end if end if
@ -115,10 +115,10 @@ subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
case(bjac_) case(bjac_)
call psb_bjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) call mld_bjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_bjac_aply' ch_err='mld_bjac_aply'
goto 9999 goto 9999
end if end if
@ -126,7 +126,7 @@ subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
if (prec%iprcparm(n_ovr_)==0) then if (prec%iprcparm(n_ovr_)==0) then
! shortcut: this fixes performance for RAS(0) == BJA ! shortcut: this fixes performance for RAS(0) == BJA
call psb_bjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) call mld_bjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_bjacaply' ch_err='psb_bjacaply'
@ -148,7 +148,8 @@ subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
aux => work(1:) aux => work(1:)
allocate(ww(isz),tx(isz),ty(isz),stat=info) allocate(ww(isz),tx(isz),ty(isz),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') call psb_errpush(4025,name,i_err=(/3*isz,0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
else if ((3*isz) <= size(work)) then else if ((3*isz) <= size(work)) then
@ -157,7 +158,8 @@ subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
ty => work(2*isz+1:3*isz) ty => work(2*isz+1:3*isz)
allocate(aux(4*isz),stat=info) allocate(aux(4*isz),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') call psb_errpush(4025,name,i_err=(/4*isz,0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
@ -165,7 +167,8 @@ subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
allocate(ww(isz),tx(isz),ty(isz),& allocate(ww(isz),tx(isz),ty(isz),&
&aux(4*isz),stat=info) &aux(4*isz),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') call psb_errpush(4025,name,i_err=(/4*isz,0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
@ -198,10 +201,10 @@ subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if end if
endif endif
call psb_bjac_aply(done,prec,tx,dzero,ty,prec%desc_data,trans,aux,info) call mld_bjac_aply(done,prec,tx,dzero,ty,prec%desc_data,trans,aux,info)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_bjac_aply' ch_err='mld_bjac_aply'
goto 9999 goto 9999
end if end if
@ -264,5 +267,5 @@ subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if end if
return return
end subroutine psb_dbaseprc_aply end subroutine mld_dbaseprec_aply

20
mld_dbaseprec_bld.f90
Unescape Escape View File

@ -34,10 +34,10 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd) subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_dbaseprc_bld use psb_prec_mod, mld_protect_name => mld_dbaseprc_bld
Implicit None Implicit None
@ -63,7 +63,7 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
info=0 info=0
err=0 err=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
name = 'psb_dbaseprc_bld' name = 'mld_dbaseprc_bld'
if (debug) write(0,*) 'Entering baseprc_bld' if (debug) write(0,*) 'Entering baseprc_bld'
info = 0 info = 0
@ -110,11 +110,11 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
case (diag_) case (diag_)
call psb_diagsc_bld(a,desc_a,p,iupd,info) call mld_diag_bld(a,desc_a,p,iupd,info)
if(debug) write(0,*)me,': out of psb_diagsc_bld' if(debug) write(0,*)me,': out of mld_diag_bld'
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_diagsc_bld' ch_err='mld_diag_bld'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -137,13 +137,13 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
p%iprcparm(jac_sweeps_) = 1 p%iprcparm(jac_sweeps_) = 1
end if end if
if (debug) write(0,*)me, ': Calling PSB_BJAC_BLD' if (debug) write(0,*)me, ': Calling mld_bjac_bld'
if (debug) call psb_barrier(ictxt) if (debug) call psb_barrier(ictxt)
call psb_bjac_bld(a,desc_a,p,iupd,info) call mld_bjac_bld(a,desc_a,p,iupd,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
call psb_errpush(info,name,a_err='psb_bjac_bld') call psb_errpush(info,name,a_err='mld_bjac_bld')
goto 9999 goto 9999
end if end if
@ -169,5 +169,5 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
end if end if
return return
end subroutine psb_dbaseprc_bld end subroutine mld_dbaseprc_bld

36
mld_dbjac_aply.f90
Unescape Escape View File

@ -34,7 +34,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) subroutine mld_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
! !
! Compute Y <- beta*Y + alpha*K^-1 X ! Compute Y <- beta*Y + alpha*K^-1 X
! where K is a a Block Jacobi preconditioner stored in prec ! where K is a a Block Jacobi preconditioner stored in prec
@ -43,7 +43,7 @@ subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
! !
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_dbjac_aply use psb_prec_mod, mld_protect_name => mld_dbjac_aply
implicit none implicit none
@ -64,7 +64,7 @@ subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
logical,parameter :: debug=.false., debugprt=.false. logical,parameter :: debug=.false., debugprt=.false.
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dbjac_aply' name='mld_dbjac_aply'
info = 0 info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -90,7 +90,9 @@ subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
else else
allocate(aux(4*n_col),stat=info) allocate(aux(4*n_col),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/4*n_col,0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
@ -98,7 +100,9 @@ subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
else else
allocate(ww(n_col),aux(4*n_col),stat=info) allocate(ww(n_col),aux(4*n_col),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
endif endif
@ -138,9 +142,9 @@ subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
select case(toupper(trans)) select case(toupper(trans))
case('N') case('N')
call psb_dslu_solve(0,n_row,1,ww,n_row,prec%iprcparm(slu_ptr_),info) call mld_dslu_solve(0,n_row,1,ww,n_row,prec%iprcparm(slu_ptr_),info)
case('T','C') case('T','C')
call psb_dslu_solve(1,n_row,1,ww,n_row,prec%iprcparm(slu_ptr_),info) call mld_dslu_solve(1,n_row,1,ww,n_row,prec%iprcparm(slu_ptr_),info)
end select end select
if(info /=0) goto 9999 if(info /=0) goto 9999
@ -153,9 +157,9 @@ subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
select case(toupper(trans)) select case(toupper(trans))
case('N') case('N')
call psb_dsludist_solve(0,n_row,1,ww,n_row,prec%iprcparm(slud_ptr_),info) call mld_dsludist_solve(0,n_row,1,ww,n_row,prec%iprcparm(slud_ptr_),info)
case('T','C') case('T','C')
call psb_dsludist_solve(1,n_row,1,ww,n_row,prec%iprcparm(slud_ptr_),info) call mld_dsludist_solve(1,n_row,1,ww,n_row,prec%iprcparm(slud_ptr_),info)
end select end select
if(info /=0) goto 9999 if(info /=0) goto 9999
@ -166,9 +170,9 @@ subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
select case(toupper(trans)) select case(toupper(trans))
case('N') case('N')
call psb_dumf_solve(0,n_row,ww,x,n_row,prec%iprcparm(umf_numptr_),info) call mld_dumf_solve(0,n_row,ww,x,n_row,prec%iprcparm(umf_numptr_),info)
case('T','C') case('T','C')
call psb_dumf_solve(1,n_row,ww,x,n_row,prec%iprcparm(umf_numptr_),info) call mld_dumf_solve(1,n_row,ww,x,n_row,prec%iprcparm(umf_numptr_),info)
end select end select
if(info /=0) goto 9999 if(info /=0) goto 9999
@ -191,7 +195,9 @@ subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
allocate(tx(n_col),ty(n_col),stat=info) allocate(tx(n_col),ty(n_col),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/2*n_col,0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
@ -227,7 +233,7 @@ subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
& prec%desc_data,info,work=aux) & prec%desc_data,info,work=aux)
if(info /=0) goto 9999 if(info /=0) goto 9999
call psb_dslu_solve(0,n_row,1,ty,n_row,prec%iprcparm(slu_ptr_),info) call mld_dslu_solve(0,n_row,1,ty,n_row,prec%iprcparm(slu_ptr_),info)
if(info /=0) goto 9999 if(info /=0) goto 9999
tx(1:n_row) = ty(1:n_row) tx(1:n_row) = ty(1:n_row)
end do end do
@ -239,7 +245,7 @@ subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
& prec%desc_data,info,work=aux) & prec%desc_data,info,work=aux)
if(info /=0) goto 9999 if(info /=0) goto 9999
call psb_dumf_solve(0,n_row,ww,ty,n_row,& call mld_dumf_solve(0,n_row,ww,ty,n_row,&
& prec%iprcparm(umf_numptr_),info) & prec%iprcparm(umf_numptr_),info)
if(info /=0) goto 9999 if(info /=0) goto 9999
tx(1:n_row) = ww(1:n_row) tx(1:n_row) = ww(1:n_row)
@ -283,5 +289,5 @@ subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if end if
return return
end subroutine psb_dbjac_aply end subroutine mld_dbjac_aply

38
mld_dbjac_bld.f90
Unescape Escape View File

@ -49,9 +49,9 @@
!* * !* *
!* * !* *
!***************************************************************************** !*****************************************************************************
subroutine psb_dbjac_bld(a,desc_a,p,upd,info) subroutine mld_dbjac_bld(a,desc_a,p,upd,info)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_dbjac_bld use psb_prec_mod, mld_protect_name => mld_dbjac_bld
implicit none implicit none
! !
! .. Scalar Arguments .. ! .. Scalar Arguments ..
@ -77,7 +77,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
info=0 info=0
name='psb_dbjac_bld' name='mld_dbjac_bld'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_cd_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
@ -106,9 +106,9 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
t1= psb_wtime() t1= psb_wtime()
if(debug) write(0,*)me,': calling psb_asmatbld',p%iprcparm(p_type_),p%iprcparm(n_ovr_) if(debug) write(0,*)me,': calling mld_asmat_bld',p%iprcparm(p_type_),p%iprcparm(n_ovr_)
if (debug) call psb_barrier(ictxt) if (debug) call psb_barrier(ictxt)
call psb_asmatbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,& call mld_asmat_bld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
& blck,desc_a,upd,p%desc_data,info,outfmt=coofmt) & blck,desc_a,upd,p%desc_data,info,outfmt=coofmt)
if (debugprt) then if (debugprt) then
@ -121,12 +121,12 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
endif endif
if(info/=0) then if(info/=0) then
call psb_errpush(4010,name,a_err='psb_asmatbld') call psb_errpush(4010,name,a_err='mld_asmat_bld')
goto 9999 goto 9999
end if end if
t2= psb_wtime() t2= psb_wtime()
if (debug) write(0,*)me,': out of psb_asmatbld' if (debug) write(0,*)me,': out of mld_asmat_bld'
if (debug) call psb_barrier(ictxt) if (debug) call psb_barrier(ictxt)
@ -139,10 +139,10 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
! Done inside sp_renum. ! Done inside sp_renum.
! !
call psb_sp_renum(a,desc_a,blck,p,atmp,info) call mld_sp_renum(a,desc_a,blck,p,atmp,info)
if (info/=0) then if (info/=0) then
call psb_errpush(4010,name,a_err='psb_sp_renum') call psb_errpush(4010,name,a_err='mld_sp_renum')
goto 9999 goto 9999
end if end if
@ -190,10 +190,10 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
goto 9999 goto 9999
end if end if
call psb_ilu_bld(atmp,p%desc_data,p,upd,info) call mld_ilu_bld(atmp,p%desc_data,p,upd,info)
if (info/=0) then if (info/=0) then
call psb_errpush(4010,name,a_err='psb_ilu_bld') call psb_errpush(4010,name,a_err='mld_ilu_bld')
goto 9999 goto 9999
end if end if
@ -221,7 +221,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
goto 9999 goto 9999
end if end if
call psb_slu_bld(atmp,p%desc_data,p,info) call mld_slu_bld(atmp,p%desc_data,p,info)
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='slu_bld') call psb_errpush(4010,name,a_err='slu_bld')
goto 9999 goto 9999
@ -235,7 +235,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
goto 9999 goto 9999
end if end if
call psb_umf_bld(atmp,p%desc_data,p,info) call mld_umf_bld(atmp,p%desc_data,p,info)
if(debug) write(0,*)me,': Done umf_bld ',info if(debug) write(0,*)me,': Done umf_bld ',info
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='umf_bld') call psb_errpush(4010,name,a_err='umf_bld')
@ -312,10 +312,10 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
goto 9999 goto 9999
end if end if
call psb_ilu_bld(a,desc_a,p,upd,info,blck=blck) call mld_ilu_bld(a,desc_a,p,upd,info,blck=blck)
if(info/=0) then if(info/=0) then
call psb_errpush(4010,name,a_err='psb_ilu_bld') call psb_errpush(4010,name,a_err='mld_ilu_bld')
goto 9999 goto 9999
end if end if
@ -373,7 +373,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
endif endif
if (info == 0) call psb_ipcoo2csr(atmp,info) if (info == 0) call psb_ipcoo2csr(atmp,info)
if (info == 0) call psb_slu_bld(atmp,p%desc_data,p,info) if (info == 0) call mld_slu_bld(atmp,p%desc_data,p,info)
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='slu_bld') call psb_errpush(4010,name,a_err='slu_bld')
goto 9999 goto 9999
@ -426,7 +426,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
!!$ nztmp = psb_sp_get_nnzeros(atmp) !!$ nztmp = psb_sp_get_nnzeros(atmp)
!!$ call psb_loc_to_glob(atmp%ia2(1:nztmp),p%desc_data,info,iact='I') !!$ call psb_loc_to_glob(atmp%ia2(1:nztmp),p%desc_data,info,iact='I')
if (info == 0) call psb_ipcoo2csr(atmp,info) if (info == 0) call psb_ipcoo2csr(atmp,info)
if (info == 0) call psb_sludist_bld(atmp,p%desc_data,p,info) if (info == 0) call mld_sludist_bld(atmp,p%desc_data,p,info)
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='slu_bld') call psb_errpush(4010,name,a_err='slu_bld')
goto 9999 goto 9999
@ -484,7 +484,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
goto 9999 goto 9999
end if end if
call psb_umf_bld(atmp,p%desc_data,p,info) call mld_umf_bld(atmp,p%desc_data,p,info)
if(debug) write(0,*)me,': Done umf_bld ',info if(debug) write(0,*)me,': Done umf_bld ',info
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='umf_bld') call psb_errpush(4010,name,a_err='umf_bld')
@ -539,6 +539,6 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
return return
end subroutine psb_dbjac_bld end subroutine mld_dbjac_bld

17
mld_ddiagsc_bld.f90
Unescape Escape View File

@ -34,9 +34,9 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_ddiagsc_bld(a,desc_a,p,upd,info) subroutine mld_ddiag_bld(a,desc_a,p,upd,info)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_ddiagsc_bld use psb_prec_mod, mld_protect_name => mld_ddiag_bld
Implicit None Implicit None
type(psb_dspmat_type), target :: a type(psb_dspmat_type), target :: a
@ -61,7 +61,7 @@ subroutine psb_ddiagsc_bld(a,desc_a,p,upd,info)
info=0 info=0
err=0 err=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
name = 'psb_ddiagsc_bld' name = 'mld_ddiag_bld'
if (debug) write(0,*) 'Entering diagsc_bld' if (debug) write(0,*) 'Entering diagsc_bld'
info = 0 info = 0
@ -112,8 +112,9 @@ subroutine psb_ddiagsc_bld(a,desc_a,p,upd,info)
if (a%pl(1) /= 0) then if (a%pl(1) /= 0) then
allocate(work(n_row),stat=info) allocate(work(n_row),stat=info)
if (info /= 0) then if (info /= 0) then
info=4000 info=4025
call psb_errpush(info,name) call psb_errpush(info,name,i_err=(/n_row,0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
call psb_gelp('n',a%pl,p%d,desc_a,info) call psb_gelp('n',a%pl,p%d,desc_a,info)
@ -130,7 +131,9 @@ subroutine psb_ddiagsc_bld(a,desc_a,p,upd,info)
if (debug) then if (debug) then
allocate(gd(mglob),stat=info) allocate(gd(mglob),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/mglob,0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
@ -164,5 +167,5 @@ subroutine psb_ddiagsc_bld(a,desc_a,p,upd,info)
end if end if
return return
end subroutine psb_ddiagsc_bld end subroutine mld_ddiag_bld

12
mld_dilu_bld.f90
Unescape Escape View File

@ -49,9 +49,9 @@
!* * !* *
!* * !* *
!***************************************************************************** !*****************************************************************************
subroutine psb_dilu_bld(a,desc_a,p,upd,info,blck) subroutine mld_dilu_bld(a,desc_a,p,upd,info,blck)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_dilu_bld use psb_prec_mod, mld_protect_name => mld_dilu_bld
implicit none implicit none
! !
@ -77,7 +77,7 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info,blck)
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
info=0 info=0
name='psb_dilu_bld' name='mld_dilu_bld'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_cd_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
@ -149,10 +149,10 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info,blck)
! Ok, factor the matrix. ! Ok, factor the matrix.
! !
t5 = psb_wtime() t5 = psb_wtime()
call psb_ilu_fct(a,p%av(l_pr_),p%av(u_pr_),p%d,info,blck=blck) call mld_ilu_fct(a,p%av(l_pr_),p%av(u_pr_),p%d,info,blck=blck)
if(info/=0) then if(info/=0) then
info=4010 info=4010
ch_err='psb_ilu_fct' ch_err='mld_ilu_fct'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -206,6 +206,6 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info,blck)
return return
end subroutine psb_dilu_bld end subroutine mld_dilu_bld

16
mld_dilu_fct.f90
Unescape Escape View File

@ -34,7 +34,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_dilu_fct(a,l,u,d,info,blck) subroutine mld_dilu_fct(a,l,u,d,info,blck)
! !
! This routine copies and factors "on the fly" from A and BLCK ! This routine copies and factors "on the fly" from A and BLCK
@ -58,7 +58,7 @@ subroutine psb_dilu_fct(a,l,u,d,info,blck)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
name='psb_dilu_fct' name='mld_dilu_fct'
info = 0 info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
! .. Executable Statements .. ! .. Executable Statements ..
@ -86,11 +86,11 @@ subroutine psb_dilu_fct(a,l,u,d,info,blck)
endif endif
!!$ write(0,*) 'ilu_fct: ',size(l%ia2),size(u%ia2),a%m,blck_%m !!$ write(0,*) 'ilu_fct: ',size(l%ia2),size(u%ia2),a%m,blck_%m
call psb_dilu_fctint(m,a%m,a,blck_%m,blck_,& call mld_dilu_fctint(m,a%m,a,blck_%m,blck_,&
& d,l%aspk,l%ia1,l%ia2,u%aspk,u%ia1,u%ia2,l1,l2,info) & d,l%aspk,l%ia1,l%ia2,u%aspk,u%ia1,u%ia2,l1,l2,info)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_dilu_fctint' ch_err='mld_dilu_fctint'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -130,7 +130,7 @@ subroutine psb_dilu_fct(a,l,u,d,info,blck)
return return
contains contains
subroutine psb_dilu_fctint(m,ma,a,mb,b,& subroutine mld_dilu_fctint(m,ma,a,mb,b,&
& d,laspk,lia1,lia2,uaspk,uia1,uia2,l1,l2,info) & d,laspk,lia1,lia2,uaspk,uia1,uia2,l1,l2,info)
implicit none implicit none
@ -147,7 +147,7 @@ contains
integer :: int_err(5) integer :: int_err(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dilu_fctint' name='mld_dilu_fctint'
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -472,5 +472,5 @@ contains
return return
end if end if
return return
end subroutine psb_dilu_fctint end subroutine mld_dilu_fctint
end subroutine psb_dilu_fct end subroutine mld_dilu_fct

83
mld_dmlprec_aply.f90
Unescape Escape View File

@ -34,7 +34,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
! !
! Compute Y <- beta*Y + alpha*K^-1 X ! Compute Y <- beta*Y + alpha*K^-1 X
! where K is a multilevel preconditioner stored in baseprecv ! where K is a multilevel preconditioner stored in baseprecv
@ -55,7 +55,7 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
! as many subdomains as there are processes (except for the coarsest level where ! as many subdomains as there are processes (except for the coarsest level where
! we might have a replicated index space). Thus the sum apparently disappears ! we might have a replicated index space). Thus the sum apparently disappears
! from our code, but only apparently, because it is implicit in the call ! from our code, but only apparently, because it is implicit in the call
! to psb_baseprc_aply. ! to mld_baseprec_aply.
! !
! A bit of description of the baseprecv(:) data structure: ! A bit of description of the baseprecv(:) data structure:
! 1. Number of levels = NLEV = size(baseprecv(:)) ! 1. Number of levels = NLEV = size(baseprecv(:))
@ -84,7 +84,7 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
! !
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_dmlprc_aply use psb_prec_mod, mld_protect_name => mld_dmlprec_aply
implicit none implicit none
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
@ -112,11 +112,10 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
end type psb_mlprec_wrk_type end type psb_mlprec_wrk_type
type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:) type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:)
name='psb_dmlprc_aply' name='mld_dmlprec_aply'
info = 0 info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_cd_get_context(desc_data) ictxt = psb_cd_get_context(desc_data)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
@ -156,10 +155,17 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
! 1..NLEV <=> (j) <-> 0 ! 1..NLEV <=> (j) <-> 0
call psb_baseprc_aply(alpha,baseprecv(1),x,beta,y,& call mld_baseprec_aply(alpha,baseprecv(1),x,beta,y,&
& baseprecv(1)%base_desc,trans,work,info) & baseprecv(1)%base_desc,trans,work,info)
if(info /=0) goto 9999 if(info /=0) goto 9999
allocate(mlprec_wrk(1)%x2l(size(x)),mlprec_wrk(1)%y2l(size(y))) allocate(mlprec_wrk(1)%x2l(size(x)),mlprec_wrk(1)%y2l(size(y)), stat=info)
if (info /= 0) then
info=4025
call psb_errpush(info,name,i_err=(/size(x)+size(y),0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999
end if
mlprec_wrk(1)%x2l(:) = x(:) mlprec_wrk(1)%x2l(:) = x(:)
@ -172,7 +178,9 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
& mlprec_wrk(ilev)%tx(max(n_row,n_col)),& & mlprec_wrk(ilev)%tx(max(n_row,n_col)),&
& mlprec_wrk(ilev)%ty(max(n_row,n_col)), stat=info) & mlprec_wrk(ilev)%ty(max(n_row,n_col)), stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/2*(nc2l+max(n_row,n_col)),0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
@ -214,7 +222,7 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
write(0,*) 'Unknown value for baseprecv(2)%iprcparm(coarse_mat_) ',icm write(0,*) 'Unknown value for baseprecv(2)%iprcparm(coarse_mat_) ',icm
endif endif
call psb_baseprc_aply(done,baseprecv(ilev),& call mld_baseprec_aply(done,baseprecv(ilev),&
& mlprec_wrk(ilev)%x2l,dzero,mlprec_wrk(ilev)%y2l,& & mlprec_wrk(ilev)%x2l,dzero,mlprec_wrk(ilev)%y2l,&
& baseprecv(ilev)%desc_data, 'N',work,info) & baseprecv(ilev)%desc_data, 'N',work,info)
@ -260,7 +268,6 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
case(post_smooth_) case(post_smooth_)
! !
! Post smoothing. ! Post smoothing.
! 1. X(1) = Xext ! 1. X(1) = Xext
@ -288,7 +295,7 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
& mlprec_wrk(1)%tx(nc2l), stat=info) & mlprec_wrk(1)%tx(nc2l), stat=info)
mlprec_wrk(1)%x2l(:) = dzero mlprec_wrk(1)%x2l(:) = dzero
mlprec_wrk(1)%y2l(:) = dzero mlprec_wrk(1)%y2l(:) = dzero
mlprec_wrk(1)%tx(:) = dzero mlprec_wrk(1)%tx(:) = dzero
call psb_geaxpby(done,x,dzero,mlprec_wrk(1)%tx,& call psb_geaxpby(done,x,dzero,mlprec_wrk(1)%tx,&
& baseprecv(1)%base_desc,info) & baseprecv(1)%base_desc,info)
@ -313,7 +320,9 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
& mlprec_wrk(ilev)%x2l(nc2l), stat=info) & mlprec_wrk(ilev)%x2l(nc2l), stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/4*nc2l,0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
@ -370,7 +379,7 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
enddo enddo
call psb_baseprc_aply(done,baseprecv(nlev),mlprec_wrk(nlev)%x2l, & call mld_baseprec_aply(done,baseprecv(nlev),mlprec_wrk(nlev)%x2l, &
& dzero, mlprec_wrk(nlev)%y2l,baseprecv(nlev)%desc_data,'N',work,info) & dzero, mlprec_wrk(nlev)%y2l,baseprecv(nlev)%desc_data,'N',work,info)
if(info /=0) goto 9999 if(info /=0) goto 9999
@ -405,7 +414,7 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
if(info /=0) goto 9999 if(info /=0) goto 9999
call psb_baseprc_aply(done,baseprecv(ilev),mlprec_wrk(ilev)%tx,& call mld_baseprec_aply(done,baseprecv(ilev),mlprec_wrk(ilev)%tx,&
& done,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%base_desc, trans, work,info) & done,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%base_desc, trans, work,info)
if(info /=0) goto 9999 if(info /=0) goto 9999
@ -419,7 +428,6 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
case(pre_smooth_) case(pre_smooth_)
! !
! Pre smoothing. ! Pre smoothing.
! 1. X(1) = Xext ! 1. X(1) = Xext
@ -444,14 +452,16 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
allocate(mlprec_wrk(1)%x2l(nc2l),mlprec_wrk(1)%y2l(nc2l), & allocate(mlprec_wrk(1)%x2l(nc2l),mlprec_wrk(1)%y2l(nc2l), &
& mlprec_wrk(1)%tx(nc2l), stat=info) & mlprec_wrk(1)%tx(nc2l), stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/4*nc2l,0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
mlprec_wrk(1)%y2l(:) = dzero mlprec_wrk(1)%y2l(:) = dzero
mlprec_wrk(1)%x2l(:) = x mlprec_wrk(1)%x2l(:) = x
call psb_baseprc_aply(done,baseprecv(1),mlprec_wrk(1)%x2l,& call mld_baseprec_aply(done,baseprecv(1),mlprec_wrk(1)%x2l,&
& dzero,mlprec_wrk(1)%y2l,& & dzero,mlprec_wrk(1)%y2l,&
& baseprecv(1)%base_desc,& & baseprecv(1)%base_desc,&
& trans,work,info) & trans,work,info)
@ -474,10 +484,10 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),&
& mlprec_wrk(ilev)%x2l(nc2l), stat=info) & mlprec_wrk(ilev)%x2l(nc2l), stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/4*nc2l,0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
@ -517,7 +527,7 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
endif endif
call psb_baseprc_aply(done,baseprecv(ilev),mlprec_wrk(ilev)%x2l,& call mld_baseprec_aply(done,baseprecv(ilev),mlprec_wrk(ilev)%x2l,&
& dzero,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%desc_data, 'N',work,info) & dzero,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%desc_data, 'N',work,info)
if(info /=0) goto 9999 if(info /=0) goto 9999
@ -590,22 +600,24 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
allocate(mlprec_wrk(1)%x2l(nc2l),mlprec_wrk(1)%y2l(nc2l), & allocate(mlprec_wrk(1)%x2l(nc2l),mlprec_wrk(1)%y2l(nc2l), &
& mlprec_wrk(1)%ty(nc2l), mlprec_wrk(1)%tx(nc2l), stat=info) & mlprec_wrk(1)%ty(nc2l), mlprec_wrk(1)%tx(nc2l), stat=info)
if (info /= 0) then
info=4025
call psb_errpush(info,name,i_err=(/4*nc2l,0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999
end if
mlprec_wrk(1)%x2l(:) = dzero mlprec_wrk(1)%x2l(:) = dzero
mlprec_wrk(1)%y2l(:) = dzero mlprec_wrk(1)%y2l(:) = dzero
mlprec_wrk(1)%tx(:) = dzero mlprec_wrk(1)%tx(:) = dzero
mlprec_wrk(1)%ty(:) = dzero mlprec_wrk(1)%ty(:) = dzero
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
goto 9999
end if
call psb_geaxpby(done,x,dzero,mlprec_wrk(1)%x2l,& call psb_geaxpby(done,x,dzero,mlprec_wrk(1)%x2l,&
& baseprecv(1)%base_desc,info) & baseprecv(1)%base_desc,info)
call psb_geaxpby(done,x,dzero,mlprec_wrk(1)%tx,& call psb_geaxpby(done,x,dzero,mlprec_wrk(1)%tx,&
& baseprecv(1)%base_desc,info) & baseprecv(1)%base_desc,info)
call psb_baseprc_aply(done,baseprecv(1),mlprec_wrk(1)%x2l,& call mld_baseprec_aply(done,baseprecv(1),mlprec_wrk(1)%x2l,&
& dzero,mlprec_wrk(1)%y2l,& & dzero,mlprec_wrk(1)%y2l,&
& baseprecv(1)%base_desc,& & baseprecv(1)%base_desc,&
& trans,work,info) & trans,work,info)
@ -628,18 +640,19 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
allocate(mlprec_wrk(ilev)%ty(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& allocate(mlprec_wrk(ilev)%ty(nc2l),mlprec_wrk(ilev)%y2l(nc2l),&
& mlprec_wrk(ilev)%x2l(nc2l), stat=info) & mlprec_wrk(ilev)%x2l(nc2l), stat=info)
if (info /= 0) then
info=4025
call psb_errpush(info,name,i_err=(/4*nc2l,0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999
end if
mlprec_wrk(ilev)%x2l(:) = dzero mlprec_wrk(ilev)%x2l(:) = dzero
mlprec_wrk(ilev)%y2l(:) = dzero mlprec_wrk(ilev)%y2l(:) = dzero
mlprec_wrk(ilev)%tx(:) = dzero mlprec_wrk(ilev)%tx(:) = dzero
mlprec_wrk(ilev)%ty(:) = dzero mlprec_wrk(ilev)%ty(:) = dzero
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
goto 9999
end if
if (ismth /= no_smth_) then if (ismth /= no_smth_) then
! !
!Smoothed Aggregation !Smoothed Aggregation
@ -674,7 +687,7 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
& baseprecv(ilev)%base_desc,info) & baseprecv(ilev)%base_desc,info)
if(info /=0) goto 9999 if(info /=0) goto 9999
call psb_baseprc_aply(done,baseprecv(ilev),mlprec_wrk(ilev)%x2l,& call mld_baseprec_aply(done,baseprecv(ilev),mlprec_wrk(ilev)%x2l,&
& dzero,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%desc_data, 'N',work,info) & dzero,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%desc_data, 'N',work,info)
if(info /=0) goto 9999 if(info /=0) goto 9999
@ -715,7 +728,7 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
if(info /=0) goto 9999 if(info /=0) goto 9999
call psb_baseprc_aply(done,baseprecv(ilev),mlprec_wrk(ilev)%tx,& call mld_baseprec_aply(done,baseprecv(ilev),mlprec_wrk(ilev)%tx,&
& done,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%base_desc, trans, work,info) & done,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%base_desc, trans, work,info)
if(info /=0) goto 9999 if(info /=0) goto 9999
@ -775,5 +788,5 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!!$ end do !!$ end do
!!$ end subroutine mlprec_wrk_free !!$ end subroutine mlprec_wrk_free
end subroutine psb_dmlprc_aply end subroutine mld_dmlprec_aply

16
mld_dmlprec_bld.f90
Unescape Escape View File

@ -34,10 +34,10 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_dmlprc_bld(a,desc_a,p,info) subroutine mld_dmlprec_bld(a,desc_a,p,info)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_dmlprc_bld use psb_prec_mod, mld_protect_name => mld_dmlprec_bld
implicit none implicit none
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(in), target :: a
@ -94,7 +94,7 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info)
! Currently this is ignored by gen_aggrmap, but it could be ! Currently this is ignored by gen_aggrmap, but it could be
! changed in the future. Need to package nlaggr & mlia in a ! changed in the future. Need to package nlaggr & mlia in a
! private data structure? ! private data structure?
call psb_genaggrmap(p%iprcparm(aggr_alg_),a,desc_a,p%nlaggr,p%mlia,info) call mld_aggrmap_bld(p%iprcparm(aggr_alg_),a,desc_a,p%nlaggr,p%mlia,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_gen_aggrmap' ch_err='psb_gen_aggrmap'
@ -105,7 +105,7 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info)
if (debug) write(0,*) 'Out from genaggrmap',p%nlaggr if (debug) write(0,*) 'Out from genaggrmap',p%nlaggr
call psb_nullify_desc(desc_ac) call psb_nullify_desc(desc_ac)
call psb_bldaggrmat(a,desc_a,ac,desc_ac,p,info) call mld_aggrmat_asb(a,desc_a,ac,desc_ac,p,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_bld_aggrmat' ch_err='psb_bld_aggrmat'
@ -116,11 +116,11 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info)
call psb_baseprc_bld(ac,desc_ac,p,info) call mld_baseprc_bld(ac,desc_ac,p,info)
if (debug) write(0,*) 'Out from baseprcbld',info if (debug) write(0,*) 'Out from baseprcbld',info
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_baseprc_bld' ch_err='mld_baseprc_bld'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -128,7 +128,7 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info)
! !
! We have used a separate ac because: ! We have used a separate ac because:
! 1. We want to reuse the same routines psb_ilu_bld etc. ! 1. We want to reuse the same routines mld_ilu_bld etc.
! 2. We do NOT want to pass an argument twice to them ! 2. We do NOT want to pass an argument twice to them
! p%av(ac_) and p, as this would violate the Fortran standard ! p%av(ac_) and p, as this would violate the Fortran standard
! Hence a separate AC and a TRANSFER function at the end. ! Hence a separate AC and a TRANSFER function at the end.
@ -156,4 +156,4 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info)
end if end if
Return Return
end subroutine psb_dmlprc_bld end subroutine mld_dmlprec_bld

26
mld_dprec_aply.f90
Unescape Escape View File

@ -34,10 +34,10 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans, work) subroutine mld_dprec_aply(prec,x,y,desc_data,info,trans, work)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_dprc_aply use psb_prec_mod, mld_protect_name => mld_dprec_aply
implicit none implicit none
@ -74,7 +74,7 @@ subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans, work)
iwsz = max(1,4*psb_cd_get_local_cols(desc_data)) iwsz = max(1,4*psb_cd_get_local_cols(desc_data))
allocate(work_(iwsz),stat=info) allocate(work_(iwsz),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') call psb_errpush(4025,name,i_err=(/iwsz,0,0,0,0/),a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
@ -85,14 +85,14 @@ subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans, work)
end if end if
if (size(prec%baseprecv) >1) then if (size(prec%baseprecv) >1) then
if (debug) write(0,*) 'Into mlprc_aply',size(x),size(y) if (debug) write(0,*) 'Into mlprc_aply',size(x),size(y)
call psb_mlprc_aply(done,prec%baseprecv,x,dzero,y,desc_data,trans_,work_,info) call mld_mlprec_aply(done,prec%baseprecv,x,dzero,y,desc_data,trans_,work_,info)
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_dmlprc_aply') call psb_errpush(4010,name,a_err='mld_dmlprec_aply')
goto 9999 goto 9999
end if end if
else if (size(prec%baseprecv) == 1) then else if (size(prec%baseprecv) == 1) then
call psb_baseprc_aply(done,prec%baseprecv(1),x,dzero,y,desc_data,trans_, work_,info) call mld_baseprec_aply(done,prec%baseprecv(1),x,dzero,y,desc_data,trans_, work_,info)
else else
write(0,*) 'Inconsistent preconditioner: size of baseprecv???' write(0,*) 'Inconsistent preconditioner: size of baseprecv???'
endif endif
@ -113,7 +113,7 @@ subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans, work)
end if end if
return return
end subroutine psb_dprc_aply end subroutine mld_dprec_aply
!!$ !!$
@ -152,10 +152,10 @@ end subroutine psb_dprc_aply
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_dprc_aply1(prec,x,desc_data,info,trans) subroutine mld_dprec_aply1(prec,x,desc_data,info,trans)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_dprc_aply1 use psb_prec_mod, mld_protect_name => mld_dprec_aply1
implicit none implicit none
@ -187,11 +187,13 @@ subroutine psb_dprc_aply1(prec,x,desc_data,info,trans)
allocate(ww(size(x)),w1(size(x)),stat=info) allocate(ww(size(x)),w1(size(x)),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/2*size(x),0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
if (debug) write(0,*) 'Prc_aply1 Size(x) ',size(x), size(ww),size(w1) if (debug) write(0,*) 'Prc_aply1 Size(x) ',size(x), size(ww),size(w1)
call psb_dprc_aply(prec,x,ww,desc_data,info,trans_,work=w1) call mld_dprec_aply(prec,x,ww,desc_data,info,trans_,work=w1)
if(info /=0) goto 9999 if(info /=0) goto 9999
x(:) = ww(:) x(:) = ww(:)
deallocate(ww,W1) deallocate(ww,W1)
@ -207,4 +209,4 @@ subroutine psb_dprc_aply1(prec,x,desc_data,info,trans)
return return
end if end if
return return
end subroutine psb_dprc_aply1 end subroutine mld_dprec_aply1

10
mld_dslu_bld.f90
Unescape Escape View File

@ -34,9 +34,9 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_dslu_bld(a,desc_a,p,info) subroutine mld_dslu_bld(a,desc_a,p,info)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_dslu_bld use psb_prec_mod, mld_protect_name => mld_dslu_bld
implicit none implicit none
@ -51,7 +51,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
info=0 info=0
name='psb_dslu_bld' name='mld_dslu_bld'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_cd_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
@ -72,7 +72,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
call psb_barrier(ictxt) call psb_barrier(ictxt)
endif endif
call psb_dslu_factor(a%m,nzt,& call mld_dslu_factor(a%m,nzt,&
& a%aspk,a%ia2,a%ia1,p%iprcparm(slu_ptr_),info) & a%aspk,a%ia2,a%ia1,p%iprcparm(slu_ptr_),info)
if (info /= 0) then if (info /= 0) then
@ -97,5 +97,5 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
end if end if
return return
end subroutine psb_dslu_bld end subroutine mld_dslu_bld

10
mld_dslud_bld.f90
Unescape Escape View File

@ -34,9 +34,9 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_dsludist_bld(a,desc_a,p,info) subroutine mld_dsludist_bld(a,desc_a,p,info)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_dsludist_bld use psb_prec_mod, mld_protect_name => mld_dsludist_bld
implicit none implicit none
@ -52,7 +52,7 @@ subroutine psb_dsludist_bld(a,desc_a,p,info)
if (psb_get_errstatus().ne.0) return if (psb_get_errstatus().ne.0) return
info=0 info=0
name='psb_dslu_bld' name='mld_dslu_bld'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_cd_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
@ -85,7 +85,7 @@ subroutine psb_dsludist_bld(a,desc_a,p,info)
npc = 1 npc = 1
call psb_loc_to_glob(a%ia1(1:nzt),desc_a,info,iact='I') call psb_loc_to_glob(a%ia1(1:nzt),desc_a,info,iact='I')
call psb_dsludist_factor(mglob,nrow,nzt,ifrst,& call mld_dsludist_factor(mglob,nrow,nzt,ifrst,&
& a%aspk,a%ia2,a%ia1,p%iprcparm(slud_ptr_),& & a%aspk,a%ia2,a%ia1,p%iprcparm(slud_ptr_),&
& npr, npc, info) & npr, npc, info)
if (info /= 0) then if (info /= 0) then
@ -107,5 +107,5 @@ subroutine psb_dsludist_bld(a,desc_a,p,info)
end if end if
return return
end subroutine psb_dsludist_bld end subroutine mld_dsludist_bld

8
mld_dsp_renum.f90
Unescape Escape View File

@ -34,9 +34,9 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info) subroutine mld_dsp_renum(a,desc_a,blck,p,atmp,info)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_dsp_renum use psb_prec_mod, mld_protect_name => mld_dsp_renum
implicit none implicit none
@ -58,7 +58,7 @@ subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info)
if (psb_get_errstatus().ne.0) return if (psb_get_errstatus().ne.0) return
info=0 info=0
name='psb_dsp_renum' name='mld_dsp_renum'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_cd_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
@ -298,4 +298,4 @@ contains
end subroutine gps_reduction end subroutine gps_reduction
end subroutine psb_dsp_renum end subroutine mld_dsp_renum

10
mld_dumf_bld.f90
Unescape Escape View File

@ -34,9 +34,9 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_dumf_bld(a,desc_a,p,info) subroutine mld_dumf_bld(a,desc_a,p,info)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_dumf_bld use psb_prec_mod, mld_protect_name => mld_dumf_bld
implicit none implicit none
@ -52,7 +52,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
info=0 info=0
name='psb_dumf_bld' name='mld_dumf_bld'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_A%matrix_data(psb_ctxt_) ictxt = desc_A%matrix_data(psb_ctxt_)
@ -75,7 +75,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
call psb_barrier(ictxt) call psb_barrier(ictxt)
endif endif
call psb_dumf_factor(a%m,nzt,& call mld_dumf_factor(a%m,nzt,&
& a%aspk,a%ia1,a%ia2,& & a%aspk,a%ia1,a%ia2,&
& p%iprcparm(umf_symptr_),p%iprcparm(umf_numptr_),info) & p%iprcparm(umf_symptr_),p%iprcparm(umf_numptr_),info)
@ -102,7 +102,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
end if end if
return return
end subroutine psb_dumf_bld end subroutine mld_dumf_bld

24
mld_slu_impl.c
Unescape Escape View File

@ -112,26 +112,26 @@ typedef struct {
#ifdef Add_ #ifdef Add_
#define psb_dslu_factor_ psb_dslu_factor_ #define mld_dslu_factor_ mld_dslu_factor_
#define psb_dslu_solve_ psb_dslu_solve_ #define mld_dslu_solve_ mld_dslu_solve_
#define psb_dslu_free_ psb_dslu_free_ #define mld_dslu_free_ mld_dslu_free_
#endif #endif
#ifdef AddDouble_ #ifdef AddDouble_
#define psb_dslu_factor_ psb_dslu_factor__ #define mld_dslu_factor_ mld_dslu_factor__
#define psb_dslu_solve_ psb_dslu_solve__ #define mld_dslu_solve_ mld_dslu_solve__
#define psb_dslu_free_ psb_dslu_free__ #define mld_dslu_free_ mld_dslu_free__
#endif #endif
#ifdef NoChange #ifdef NoChange
#define psb_dslu_factor_ psb_dslu_factor #define mld_dslu_factor_ mld_dslu_factor
#define psb_dslu_solve_ psb_dslu_solve #define mld_dslu_solve_ mld_dslu_solve
#define psb_dslu_free_ psb_dslu_free #define mld_dslu_free_ mld_dslu_free
#endif #endif
void void
psb_dslu_factor_(int *n, int *nnz, mld_dslu_factor_(int *n, int *nnz,
double *values, int *rowptr, int *colind, double *values, int *rowptr, int *colind,
#ifdef Have_SLU_ #ifdef Have_SLU_
fptr *f_factors, /* a handle containing the address fptr *f_factors, /* a handle containing the address
@ -255,7 +255,7 @@ psb_dslu_factor_(int *n, int *nnz,
void void
psb_dslu_solve_(int *itrans, int *n, int *nrhs, mld_dslu_solve_(int *itrans, int *n, int *nrhs,
double *b, int *ldb, double *b, int *ldb,
#ifdef Have_SLU_ #ifdef Have_SLU_
fptr *f_factors, /* a handle containing the address fptr *f_factors, /* a handle containing the address
@ -321,7 +321,7 @@ psb_dslu_solve_(int *itrans, int *n, int *nrhs,
void void
psb_dslu_free_( mld_dslu_free_(
#ifdef Have_SLU_ #ifdef Have_SLU_
fptr *f_factors, /* a handle containing the address fptr *f_factors, /* a handle containing the address
pointing to the factored matrices */ pointing to the factored matrices */

24
mld_slud_impl.c
Unescape Escape View File

@ -112,26 +112,26 @@ typedef struct {
#ifdef Add_ #ifdef Add_
#define psb_dsludist_factor_ psb_dsludist_factor_ #define mld_dsludist_factor_ mld_dsludist_factor_
#define psb_dsludist_solve_ psb_dsludist_solve_ #define mld_dsludist_solve_ mld_dsludist_solve_
#define psb_dsludist_free_ psb_dsludist_free_ #define mld_dsludist_free_ mld_dsludist_free_
#endif #endif
#ifdef AddDouble_ #ifdef AddDouble_
#define psb_dsludist_factor_ psb_dsludist_factor__ #define mld_dsludist_factor_ mld_dsludist_factor__
#define psb_dsludist_solve_ psb_dsludist_solve__ #define mld_dsludist_solve_ mld_dsludist_solve__
#define psb_dsludist_free_ psb_dsludist_free__ #define mld_dsludist_free_ mld_dsludist_free__
#endif #endif
#ifdef NoChange #ifdef NoChange
#define psb_dsludist_factor_ psb_dsludist_factor #define mld_dsludist_factor_ mld_dsludist_factor
#define psb_dsludist_solve_ psb_dsludist_solve #define mld_dsludist_solve_ mld_dsludist_solve
#define psb_dsludist_free_ psb_dsludist_free #define mld_dsludist_free_ mld_dsludist_free
#endif #endif
void void
psb_dsludist_factor_(int *n, int *nl, int *nnzl, int *ffstr, mld_dsludist_factor_(int *n, int *nl, int *nnzl, int *ffstr,
double *values, int *rowptr, int *colind, double *values, int *rowptr, int *colind,
#ifdef Have_SLUDist_ #ifdef Have_SLUDist_
fptr *f_factors, /* a handle containing the address fptr *f_factors, /* a handle containing the address
@ -239,7 +239,7 @@ psb_dsludist_factor_(int *n, int *nl, int *nnzl, int *ffstr,
void void
psb_dsludist_solve_(int *itrans, int *n, int *nrhs, mld_dsludist_solve_(int *itrans, int *n, int *nrhs,
double *b, int *ldb, double *b, int *ldb,
#ifdef Have_SLUDist_ #ifdef Have_SLUDist_
fptr *f_factors, /* a handle containing the address fptr *f_factors, /* a handle containing the address
@ -322,7 +322,7 @@ psb_dsludist_solve_(int *itrans, int *n, int *nrhs,
void void
psb_dsludist_free_( mld_dsludist_free_(
#ifdef Have_SLUDist_ #ifdef Have_SLUDist_
fptr *f_factors, /* a handle containing the address fptr *f_factors, /* a handle containing the address
pointing to the factored matrices */ pointing to the factored matrices */

24
mld_umf_impl.c
Unescape Escape View File

@ -73,19 +73,19 @@ Availability:
#ifdef Add_ #ifdef Add_
#define psb_dumf_factor_ psb_dumf_factor_ #define mld_dumf_factor_ mld_dumf_factor_
#define psb_dumf_solve_ psb_dumf_solve_ #define mld_dumf_solve_ mld_dumf_solve_
#define psb_dumf_free_ psb_dumf_free_ #define mld_dumf_free_ mld_dumf_free_
#endif #endif
#ifdef AddDouble_ #ifdef AddDouble_
#define psb_dumf_factor_ psb_dumf_factor__ #define mld_dumf_factor_ mld_dumf_factor__
#define psb_dumf_solve_ psb_dumf_solve__ #define mld_dumf_solve_ mld_dumf_solve__
#define psb_dumf_free_ psb_dumf_free__ #define mld_dumf_free_ mld_dumf_free__
#endif #endif
#ifdef NoChange #ifdef NoChange
#define psb_dumf_factor_ psb_dumf_factor #define mld_dumf_factor_ mld_dumf_factor
#define psb_dumf_solve_ psb_dumf_solve #define mld_dumf_solve_ mld_dumf_solve
#define psb_dumf_free_ psb_dumf_free #define mld_dumf_free_ mld_dumf_free
#endif #endif
@ -101,7 +101,7 @@ typedef int fptr; /* 32-bit by default */
#endif #endif
void void
psb_dumf_factor_(int *n, int *nnz, mld_dumf_factor_(int *n, int *nnz,
double *values, int *rowind, int *colptr, double *values, int *rowind, int *colptr,
#ifdef Have_UMF_ #ifdef Have_UMF_
fptr *symptr, fptr *symptr,
@ -163,7 +163,7 @@ psb_dumf_factor_(int *n, int *nnz,
void void
psb_dumf_solve_(int *itrans, int *n, mld_dumf_solve_(int *itrans, int *n,
double *x, double *b, int *ldb, double *x, double *b, int *ldb,
#ifdef Have_UMF_ #ifdef Have_UMF_
fptr *numptr, fptr *numptr,
@ -204,7 +204,7 @@ psb_dumf_solve_(int *itrans, int *n,
void void
psb_dumf_free_( mld_dumf_free_(
#ifdef Have_UMF_ #ifdef Have_UMF_
fptr *symptr, fptr *symptr,
fptr *numptr, fptr *numptr,

23
mld_zaggrmap_bld.f90
Unescape Escape View File

@ -34,9 +34,9 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_zgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info) subroutine mld_zaggrmap_bld(aggr_type,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_zgenaggrmap use psb_prec_mod, mld_protect_name => mld_zaggrmap_bld
implicit none implicit none
integer, intent(in) :: aggr_type integer, intent(in) :: aggr_type
@ -57,7 +57,7 @@ subroutine psb_zgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
info=0 info=0
name = 'psb_zgenaggrmap' name = 'mld_zaggrmap_bld'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
! !
! Note. At the time being we are ignoring aggr_type ! Note. At the time being we are ignoring aggr_type
@ -72,8 +72,9 @@ subroutine psb_zgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
nr = a%m nr = a%m
allocate(ilaggr(nr),neigh(nr),stat=info) allocate(ilaggr(nr),neigh(nr),stat=info)
if(info.ne.0) then if(info.ne.0) then
info=4000 info=4025
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,i_err=(/2*nr,0,0,0,0/),&
& a_err='integer')
goto 9999 goto 9999
end if end if
@ -148,8 +149,9 @@ subroutine psb_zgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
! !
allocate(ils(naggr+10),stat=info) allocate(ils(naggr+10),stat=info)
if(info.ne.0) then if(info.ne.0) then
info=4000 info=4025
call psb_errpush(info,name) call psb_errpush(info,name,i_err=(/naggr+10,0,0,0,0/),&
& a_err='integer')
goto 9999 goto 9999
end if end if
@ -270,8 +272,9 @@ subroutine psb_zgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
allocate(nlaggr(np),stat=info) allocate(nlaggr(np),stat=info)
if (info/=0) then if (info/=0) then
info=4000 info=4025
call psb_errpush(info,name) call psb_errpush(info,name,i_err=(/np,0,0,0,0/),&
& a_err='integer')
goto 9999 goto 9999
end if end if
@ -290,4 +293,4 @@ subroutine psb_zgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
end if end if
return return
end subroutine psb_zgenaggrmap end subroutine mld_zaggrmap_bld

26
mld_zaggrmat_asb.F90
Unescape Escape View File

@ -34,9 +34,9 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_zbldaggrmat(a,desc_a,ac,desc_ac,p,info) subroutine mld_zaggrmat_asb(a,desc_a,ac,desc_ac,p,info)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_zbldaggrmat use psb_prec_mod, mld_protect_name => mld_zaggrmat_asb
implicit none implicit none
@ -48,14 +48,16 @@ subroutine psb_zbldaggrmat(a,desc_a,ac,desc_ac,p,info)
integer, intent(out) :: info integer, intent(out) :: info
logical, parameter :: aggr_dump=.false. logical, parameter :: aggr_dump=.false.
integer ::ictxt,np,me, err_act integer ::ictxt,np,me, err_act,icomm
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zbldaggrmat' name='mld_zaggrmat_asb'
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_cd_get_context(desc_a)
icomm = psb_cd_get_mpic(desc_a)
ictxt=psb_cd_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
@ -133,9 +135,10 @@ contains
naggr = p%nlaggr(me+1) naggr = p%nlaggr(me+1)
ntaggr = sum(p%nlaggr) ntaggr = sum(p%nlaggr)
allocate(nzbr(np), idisp(np),stat=info) allocate(nzbr(np), idisp(np),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/2*np,0,0,0,0/),&
& a_err='integer')
goto 9999 goto 9999
end if end if
@ -350,7 +353,9 @@ contains
allocate(nzbr(np), idisp(np),stat=info) allocate(nzbr(np), idisp(np),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/2*np,0,0,0,0/),&
& a_err='integer')
goto 9999 goto 9999
end if end if
@ -387,7 +392,9 @@ contains
! !
allocate(p%dorig(nrow),stat=info) allocate(p%dorig(nrow),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/nrow,0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
@ -893,6 +900,7 @@ contains
goto 9999 goto 9999
end if end if
call psb_get_mpicomm(ictxt,icomm)
do ip=1,np do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1)) idisp(ip) = sum(nzbr(1:ip-1))
enddo enddo
@ -956,4 +964,4 @@ contains
end subroutine psb_zbldaggrmat end subroutine mld_zaggrmat_asb

13
mld_zasmat_bld.f90
Unescape Escape View File

@ -51,10 +51,10 @@
!* * !* *
!* * !* *
!***************************************************************************** !*****************************************************************************
Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt) Subroutine mld_zasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_zasmatbld use psb_prec_mod, mld_protect_name => mld_zasmat_bld
Implicit None Implicit None
@ -79,15 +79,13 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
Logical,Parameter :: debug=.false., debugprt=.false. Logical,Parameter :: debug=.false., debugprt=.false.
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zasmatbld' name='mld_zasmat_bld'
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
If(debug) Write(0,*)'IN DASMATBLD ', upd If(debug) Write(0,*)'IN DASMATBLD ', upd
ictxt = psb_cd_get_context(desc_data) ictxt=desc_data%matrix_data(psb_ctxt_)
icomm = psb_cd_get_mpic(desc_data)
Call psb_info(ictxt, me, np) Call psb_info(ictxt, me, np)
tot_recv=0 tot_recv=0
@ -170,6 +168,7 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
return return
endif endif
call psb_get_mpicomm(ictxt,icomm)
If(debug)Write(0,*)'BEGIN dasmatbld',me,upd,novr If(debug)Write(0,*)'BEGIN dasmatbld',me,upd,novr
t1 = psb_wtime() t1 = psb_wtime()
@ -235,5 +234,5 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
end if end if
Return Return
End Subroutine psb_zasmatbld End Subroutine mld_zasmat_bld

18
mld_zbaseprec_aply.f90
Unescape Escape View File

@ -34,13 +34,13 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_zbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) subroutine mld_zbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
! !
! Compute Y <- beta*Y + alpha*K^-1 X ! Compute Y <- beta*Y + alpha*K^-1 X
! where K is a a basic preconditioner stored in prec ! where K is a a basic preconditioner stored in prec
! !
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_zbaseprc_aply use psb_prec_mod, mld_protect_name => mld_zbaseprec_aply
implicit none implicit none
@ -61,7 +61,7 @@ subroutine psb_zbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
logical,parameter :: debug=.false., debugprt=.false. logical,parameter :: debug=.false., debugprt=.false.
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zbaseprc_aply' name='mld_zbaseprec_aply'
info = 0 info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -114,10 +114,10 @@ subroutine psb_zbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
case(bjac_) case(bjac_)
call psb_bjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) call mld_bjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_bjac_aply' ch_err='mld_bjac_aply'
goto 9999 goto 9999
end if end if
@ -125,7 +125,7 @@ subroutine psb_zbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
if (prec%iprcparm(n_ovr_)==0) then if (prec%iprcparm(n_ovr_)==0) then
! shortcut: this fixes performance for RAS(0) == BJA ! shortcut: this fixes performance for RAS(0) == BJA
call psb_bjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) call mld_bjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_bjacaply' ch_err='psb_bjacaply'
@ -197,10 +197,10 @@ subroutine psb_zbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if end if
endif endif
call psb_bjac_aply(zone,prec,tx,zzero,ty,prec%desc_data,trans,aux,info) call mld_bjac_aply(zone,prec,tx,zzero,ty,prec%desc_data,trans,aux,info)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_bjac_aply' ch_err='mld_bjac_aply'
goto 9999 goto 9999
end if end if
@ -263,5 +263,5 @@ subroutine psb_zbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if end if
return return
end subroutine psb_zbaseprc_aply end subroutine mld_zbaseprec_aply

20
mld_zbaseprec_bld.f90
Unescape Escape View File

@ -34,10 +34,10 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd) subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_zbaseprc_bld use psb_prec_mod, mld_protect_name => mld_zbaseprc_bld
Implicit None Implicit None
@ -63,7 +63,7 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd)
info=0 info=0
err=0 err=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
name = 'psb_zbaseprc_bld' name = 'mld_zbaseprc_bld'
if (debug) write(0,*) 'Entering baseprc_bld' if (debug) write(0,*) 'Entering baseprc_bld'
info = 0 info = 0
@ -110,11 +110,11 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd)
case (diag_) case (diag_)
call psb_diagsc_bld(a,desc_a,p,iupd,info) call mld_diag_bld(a,desc_a,p,iupd,info)
if(debug) write(0,*)me,': out of psb_diagsc_bld' if(debug) write(0,*)me,': out of mld_diag_bld'
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_diagsc_bld' ch_err='mld_diag_bld'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -137,13 +137,13 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd)
p%iprcparm(jac_sweeps_) = 1 p%iprcparm(jac_sweeps_) = 1
end if end if
if (debug) write(0,*)me, ': Calling PSB_BJAC_BLD' if (debug) write(0,*)me, ': Calling mld_bjac_bld'
if (debug) call psb_barrier(ictxt) if (debug) call psb_barrier(ictxt)
call psb_bjac_bld(a,desc_a,p,iupd,info) call mld_bjac_bld(a,desc_a,p,iupd,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
call psb_errpush(info,name,a_err='psb_bjac_bld') call psb_errpush(info,name,a_err='mld_bjac_bld')
goto 9999 goto 9999
end if end if
@ -170,5 +170,5 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd)
end if end if
return return
end subroutine psb_zbaseprc_bld end subroutine mld_zbaseprc_bld

42
mld_zbjac_aply.f90
Unescape Escape View File

@ -34,7 +34,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) subroutine mld_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
! !
! Compute Y <- beta*Y + alpha*K^-1 X ! Compute Y <- beta*Y + alpha*K^-1 X
! where K is a a Block Jacobi preconditioner stored in prec ! where K is a a Block Jacobi preconditioner stored in prec
@ -43,7 +43,7 @@ subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
! !
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_zbjac_aply use psb_prec_mod, mld_protect_name => mld_zbjac_aply
implicit none implicit none
@ -64,7 +64,7 @@ subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
logical,parameter :: debug=.false., debugprt=.false. logical,parameter :: debug=.false., debugprt=.false.
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zbjac_aply' name='mld_zbjac_aply'
info = 0 info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -90,7 +90,9 @@ subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
else else
allocate(aux(4*n_col),stat=info) allocate(aux(4*n_col),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/4*n_col,0,0,0,0/),&
& a_err='complex(kind(1.d0))')
goto 9999 goto 9999
end if end if
@ -98,7 +100,9 @@ subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
else else
allocate(ww(n_col),aux(4*n_col),stat=info) allocate(ww(n_col),aux(4*n_col),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),&
& a_err='complex(kind(1.d0))')
goto 9999 goto 9999
end if end if
endif endif
@ -136,11 +140,11 @@ subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
select case(toupper(trans)) select case(toupper(trans))
case('N') case('N')
call psb_zslu_solve(0,n_row,1,ww,n_row,prec%iprcparm(slu_ptr_),info) call mld_zslu_solve(0,n_row,1,ww,n_row,prec%iprcparm(slu_ptr_),info)
case('T') case('T')
call psb_zslu_solve(1,n_row,1,ww,n_row,prec%iprcparm(slu_ptr_),info) call mld_zslu_solve(1,n_row,1,ww,n_row,prec%iprcparm(slu_ptr_),info)
case('C') case('C')
call psb_zslu_solve(2,n_row,1,ww,n_row,prec%iprcparm(slu_ptr_),info) call mld_zslu_solve(2,n_row,1,ww,n_row,prec%iprcparm(slu_ptr_),info)
end select end select
if(info /=0) goto 9999 if(info /=0) goto 9999
@ -153,11 +157,11 @@ subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
select case(toupper(trans)) select case(toupper(trans))
case('N') case('N')
call psb_zsludist_solve(0,n_row,1,ww,n_row,prec%iprcparm(slud_ptr_),info) call mld_zsludist_solve(0,n_row,1,ww,n_row,prec%iprcparm(slud_ptr_),info)
case('T') case('T')
call psb_zsludist_solve(1,n_row,1,ww,n_row,prec%iprcparm(slud_ptr_),info) call mld_zsludist_solve(1,n_row,1,ww,n_row,prec%iprcparm(slud_ptr_),info)
case('C') case('C')
call psb_zsludist_solve(2,n_row,1,ww,n_row,prec%iprcparm(slud_ptr_),info) call mld_zsludist_solve(2,n_row,1,ww,n_row,prec%iprcparm(slud_ptr_),info)
end select end select
if(info /=0) goto 9999 if(info /=0) goto 9999
@ -168,11 +172,11 @@ subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
select case(toupper(trans)) select case(toupper(trans))
case('N') case('N')
call psb_zumf_solve(0,n_row,ww,x,n_row,prec%iprcparm(umf_numptr_),info) call mld_zumf_solve(0,n_row,ww,x,n_row,prec%iprcparm(umf_numptr_),info)
case('T') case('T')
call psb_zumf_solve(1,n_row,ww,x,n_row,prec%iprcparm(umf_numptr_),info) call mld_zumf_solve(1,n_row,ww,x,n_row,prec%iprcparm(umf_numptr_),info)
case('C') case('C')
call psb_zumf_solve(2,n_row,ww,x,n_row,prec%iprcparm(umf_numptr_),info) call mld_zumf_solve(2,n_row,ww,x,n_row,prec%iprcparm(umf_numptr_),info)
end select end select
if(info /=0) goto 9999 if(info /=0) goto 9999
@ -195,7 +199,9 @@ subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
allocate(tx(n_col),ty(n_col),stat=info) allocate(tx(n_col),ty(n_col),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/2*n_col,0,0,0,0/),&
& a_err='complex(kind(1.d0))')
goto 9999 goto 9999
end if end if
@ -231,7 +237,7 @@ subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
& prec%desc_data,info,work=aux) & prec%desc_data,info,work=aux)
if(info /=0) goto 9999 if(info /=0) goto 9999
call psb_zslu_solve(0,n_row,1,ty,n_row,prec%iprcparm(slu_ptr_),info) call mld_zslu_solve(0,n_row,1,ty,n_row,prec%iprcparm(slu_ptr_),info)
if(info /=0) goto 9999 if(info /=0) goto 9999
tx(1:n_row) = ty(1:n_row) tx(1:n_row) = ty(1:n_row)
end do end do
@ -243,7 +249,7 @@ subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
& prec%desc_data,info,work=aux) & prec%desc_data,info,work=aux)
if(info /=0) goto 9999 if(info /=0) goto 9999
call psb_zumf_solve(0,n_row,ww,ty,n_row,& call mld_zumf_solve(0,n_row,ww,ty,n_row,&
& prec%iprcparm(umf_numptr_),info) & prec%iprcparm(umf_numptr_),info)
if(info /=0) goto 9999 if(info /=0) goto 9999
tx(1:n_row) = ww(1:n_row) tx(1:n_row) = ww(1:n_row)
@ -287,5 +293,5 @@ subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if end if
return return
end subroutine psb_zbjac_aply end subroutine mld_zbjac_aply

38
mld_zbjac_bld.f90
Unescape Escape View File

@ -49,9 +49,9 @@
!* * !* *
!* * !* *
!***************************************************************************** !*****************************************************************************
subroutine psb_zbjac_bld(a,desc_a,p,upd,info) subroutine mld_zbjac_bld(a,desc_a,p,upd,info)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_zbjac_bld use psb_prec_mod, mld_protect_name => mld_zbjac_bld
implicit none implicit none
! !
@ -78,7 +78,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
info=0 info=0
name='psb_zbjac_bld' name='mld_zbjac_bld'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_cd_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
@ -107,18 +107,18 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
t1= psb_wtime() t1= psb_wtime()
if(debug) write(0,*)me,': calling psb_asmatbld',p%iprcparm(p_type_),p%iprcparm(n_ovr_) if(debug) write(0,*)me,': calling mld_asmat_bld',p%iprcparm(p_type_),p%iprcparm(n_ovr_)
if (debug) call psb_barrier(ictxt) if (debug) call psb_barrier(ictxt)
call psb_asmatbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,& call mld_asmat_bld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
& blck,desc_a,upd,p%desc_data,info,outfmt=coofmt) & blck,desc_a,upd,p%desc_data,info,outfmt=coofmt)
if(info/=0) then if(info/=0) then
call psb_errpush(4010,name,a_err='psb_asmatbld') call psb_errpush(4010,name,a_err='mld_asmat_bld')
goto 9999 goto 9999
end if end if
t2= psb_wtime() t2= psb_wtime()
if (debug) write(0,*)me,': out of psb_asmatbld' if (debug) write(0,*)me,': out of mld_asmat_bld'
if (debug) call psb_barrier(ictxt) if (debug) call psb_barrier(ictxt)
@ -131,10 +131,10 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
! Done inside sp_renum. ! Done inside sp_renum.
! !
call psb_sp_renum(a,desc_a,blck,p,atmp,info) call mld_sp_renum(a,desc_a,blck,p,atmp,info)
if (info/=0) then if (info/=0) then
call psb_errpush(4010,name,a_err='psb_sp_renum') call psb_errpush(4010,name,a_err='mld_sp_renum')
goto 9999 goto 9999
end if end if
@ -182,10 +182,10 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
goto 9999 goto 9999
end if end if
call psb_ilu_bld(atmp,p%desc_data,p,upd,info) call mld_ilu_bld(atmp,p%desc_data,p,upd,info)
if (info/=0) then if (info/=0) then
call psb_errpush(4010,name,a_err='psb_ilu_bld') call psb_errpush(4010,name,a_err='mld_ilu_bld')
goto 9999 goto 9999
end if end if
@ -213,7 +213,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
goto 9999 goto 9999
end if end if
call psb_slu_bld(atmp,p%desc_data,p,info) call mld_slu_bld(atmp,p%desc_data,p,info)
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='slu_bld') call psb_errpush(4010,name,a_err='slu_bld')
goto 9999 goto 9999
@ -227,7 +227,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
goto 9999 goto 9999
end if end if
call psb_umf_bld(atmp,p%desc_data,p,info) call mld_umf_bld(atmp,p%desc_data,p,info)
if(debug) write(0,*)me,': Done umf_bld ',info if(debug) write(0,*)me,': Done umf_bld ',info
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='umf_bld') call psb_errpush(4010,name,a_err='umf_bld')
@ -305,10 +305,10 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
goto 9999 goto 9999
end if end if
call psb_ilu_bld(a,desc_a,p,upd,info,blck=blck) call mld_ilu_bld(a,desc_a,p,upd,info,blck=blck)
if(info/=0) then if(info/=0) then
call psb_errpush(4010,name,a_err='psb_ilu_bld') call psb_errpush(4010,name,a_err='mld_ilu_bld')
goto 9999 goto 9999
end if end if
@ -366,7 +366,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
endif endif
if (info == 0) call psb_ipcoo2csr(atmp,info) if (info == 0) call psb_ipcoo2csr(atmp,info)
if (info == 0) call psb_slu_bld(atmp,p%desc_data,p,info) if (info == 0) call mld_slu_bld(atmp,p%desc_data,p,info)
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='slu_bld') call psb_errpush(4010,name,a_err='slu_bld')
goto 9999 goto 9999
@ -419,7 +419,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
!!$ nztmp = psb_sp_get_nnzeros(atmp) !!$ nztmp = psb_sp_get_nnzeros(atmp)
!!$ call psb_loc_to_glob(atmp%ia2(1:nztmp),p%desc_data,info,iact='I') !!$ call psb_loc_to_glob(atmp%ia2(1:nztmp),p%desc_data,info,iact='I')
if (info == 0) call psb_ipcoo2csr(atmp,info) if (info == 0) call psb_ipcoo2csr(atmp,info)
if (info == 0) call psb_sludist_bld(atmp,p%desc_data,p,info) if (info == 0) call mld_sludist_bld(atmp,p%desc_data,p,info)
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='slu_bld') call psb_errpush(4010,name,a_err='slu_bld')
goto 9999 goto 9999
@ -477,7 +477,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
goto 9999 goto 9999
end if end if
call psb_umf_bld(atmp,p%desc_data,p,info) call mld_umf_bld(atmp,p%desc_data,p,info)
if(debug) write(0,*)me,': Done umf_bld ',info if(debug) write(0,*)me,': Done umf_bld ',info
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='umf_bld') call psb_errpush(4010,name,a_err='umf_bld')
@ -532,6 +532,6 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
return return
end subroutine psb_zbjac_bld end subroutine mld_zbjac_bld

13
mld_zdiagsc_bld.f90
Unescape Escape View File

@ -34,10 +34,10 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info) subroutine mld_zdiag_bld(a,desc_a,p,upd,info)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_zdiagsc_bld use psb_prec_mod, mld_protect_name => mld_zdiag_bld
Implicit None Implicit None
@ -63,7 +63,7 @@ subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info)
info=0 info=0
err=0 err=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
name = 'psb_zdiagsc_bld' name = 'mld_zdiag_bld'
if (debug) write(0,*) 'Entering diagsc_bld' if (debug) write(0,*) 'Entering diagsc_bld'
info = 0 info = 0
@ -109,8 +109,9 @@ subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info)
if (a%pl(1) /= 0) then if (a%pl(1) /= 0) then
allocate(work(n_row),stat=info) allocate(work(n_row),stat=info)
if (info /= 0) then if (info /= 0) then
info=4000 info=4025
call psb_errpush(info,name) call psb_errpush(info,name,i_err=(/n_row,0,0,0,0/),&
& a_err='complex(kind(1.d0))')
goto 9999 goto 9999
end if end if
call psb_gelp('n',a%pl,p%d,desc_a,info) call psb_gelp('n',a%pl,p%d,desc_a,info)
@ -161,5 +162,5 @@ subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info)
end if end if
return return
end subroutine psb_zdiagsc_bld end subroutine mld_zdiag_bld

12
mld_zilu_bld.f90
Unescape Escape View File

@ -49,9 +49,9 @@
!* * !* *
!* * !* *
!***************************************************************************** !*****************************************************************************
subroutine psb_zilu_bld(a,desc_a,p,upd,info,blck) subroutine mld_zilu_bld(a,desc_a,p,upd,info,blck)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_zilu_bld use psb_prec_mod, mld_protect_name => mld_zilu_bld
implicit none implicit none
! !
@ -76,7 +76,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info,blck)
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
info=0 info=0
name='psb_zilu_bld' name='mld_zilu_bld'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_cd_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
@ -148,10 +148,10 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info,blck)
! Ok, factor the matrix. ! Ok, factor the matrix.
! !
t5 = psb_wtime() t5 = psb_wtime()
call psb_ilu_fct(a,p%av(l_pr_),p%av(u_pr_),p%d,info,blck=blck) call mld_ilu_fct(a,p%av(l_pr_),p%av(u_pr_),p%d,info,blck=blck)
if(info/=0) then if(info/=0) then
info=4010 info=4010
ch_err='psb_ilu_fct' ch_err='mld_ilu_fct'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -205,6 +205,6 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info,blck)
return return
end subroutine psb_zilu_bld end subroutine mld_zilu_bld

16
mld_zilu_fct.f90
Unescape Escape View File

@ -34,7 +34,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_zilu_fct(a,l,u,d,info,blck) subroutine mld_zilu_fct(a,l,u,d,info,blck)
! !
! This routine copies and factors "on the fly" from A and BLCK ! This routine copies and factors "on the fly" from A and BLCK
@ -55,7 +55,7 @@ subroutine psb_zilu_fct(a,l,u,d,info,blck)
type(psb_zspmat_type), pointer :: blck_ type(psb_zspmat_type), pointer :: blck_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zilu_fct' name='mld_zilu_fct'
info = 0 info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
! .. Executable Statements .. ! .. Executable Statements ..
@ -82,11 +82,11 @@ subroutine psb_zilu_fct(a,l,u,d,info,blck)
blck_%m=0 blck_%m=0
endif endif
call psb_zilu_fctint(m,a%m,a,blck_%m,blck_,& call mld_zilu_fctint(m,a%m,a,blck_%m,blck_,&
& d,l%aspk,l%ia1,l%ia2,u%aspk,u%ia1,u%ia2,l1,l2,info) & d,l%aspk,l%ia1,l%ia2,u%aspk,u%ia1,u%ia2,l1,l2,info)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_zilu_fctint' ch_err='mld_zilu_fctint'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -126,7 +126,7 @@ subroutine psb_zilu_fct(a,l,u,d,info,blck)
return return
contains contains
subroutine psb_zilu_fctint(m,ma,a,mb,b,& subroutine mld_zilu_fctint(m,ma,a,mb,b,&
& d,laspk,lia1,lia2,uaspk,uia1,uia2,l1,l2,info) & d,laspk,lia1,lia2,uaspk,uia1,uia2,l1,l2,info)
implicit none implicit none
@ -143,7 +143,7 @@ contains
integer :: int_err(5) integer :: int_err(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zilu_fctint' name='mld_zilu_fctint'
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -464,5 +464,5 @@ contains
return return
end if end if
return return
end subroutine psb_zilu_fctint end subroutine mld_zilu_fctint
end subroutine psb_zilu_fct end subroutine mld_zilu_fct

80
mld_zmlprec_aply.f90
Unescape Escape View File

@ -34,7 +34,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
! !
! Compute Y <- beta*Y + alpha*K^-1 X ! Compute Y <- beta*Y + alpha*K^-1 X
! where K is a multilevel preconditioner stored in baseprecv ! where K is a multilevel preconditioner stored in baseprecv
@ -55,7 +55,7 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
! as many subdomains as there are processes (except for the coarsest level where ! as many subdomains as there are processes (except for the coarsest level where
! we might have a replicated index space). Thus the sum apparently disappears ! we might have a replicated index space). Thus the sum apparently disappears
! from our code, but only apparently, because it is implicit in the call ! from our code, but only apparently, because it is implicit in the call
! to psb_baseprc_aply. ! to mld_baseprec_aply.
! !
! A bit of description of the baseprecv(:) data structure: ! A bit of description of the baseprecv(:) data structure:
! 1. Number of levels = NLEV = size(baseprecv(:)) ! 1. Number of levels = NLEV = size(baseprecv(:))
@ -84,7 +84,7 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
! !
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_zmlprc_aply use psb_prec_mod, mld_protect_name => mld_zmlprec_aply
implicit none implicit none
@ -112,7 +112,7 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
end type psb_mlprec_wrk_type end type psb_mlprec_wrk_type
type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:) type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:)
name='psb_zmlprc_aply' name='mld_zmlprec_aply'
info = 0 info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -155,10 +155,17 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
! 1..NLEV <=> (j) <-> 0 ! 1..NLEV <=> (j) <-> 0
call psb_baseprc_aply(alpha,baseprecv(1),x,beta,y,& call mld_baseprec_aply(alpha,baseprecv(1),x,beta,y,&
& baseprecv(1)%base_desc,trans,work,info) & baseprecv(1)%base_desc,trans,work,info)
if(info /=0) goto 9999 if(info /=0) goto 9999
allocate(mlprec_wrk(1)%x2l(size(x)),mlprec_wrk(1)%y2l(size(y))) allocate(mlprec_wrk(1)%x2l(size(x)),mlprec_wrk(1)%y2l(size(y)), stat=info)
if (info /= 0) then
info=4025
call psb_errpush(info,name,i_err=(/size(x)+size(y),0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999
end if
mlprec_wrk(1)%x2l(:) = x(:) mlprec_wrk(1)%x2l(:) = x(:)
@ -171,7 +178,9 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
& mlprec_wrk(ilev)%tx(max(n_row,n_col)),& & mlprec_wrk(ilev)%tx(max(n_row,n_col)),&
& mlprec_wrk(ilev)%ty(max(n_row,n_col)), stat=info) & mlprec_wrk(ilev)%ty(max(n_row,n_col)), stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/2*(nc2l+max(n_row,n_col)),0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
@ -188,8 +197,6 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
! !
! Smoothed aggregation ! Smoothed aggregation
! !
call psb_halo(mlprec_wrk(ilev-1)%x2l,baseprecv(ilev-1)%base_desc,& call psb_halo(mlprec_wrk(ilev-1)%x2l,baseprecv(ilev-1)%base_desc,&
& info,work=work) & info,work=work)
if(info /=0) goto 9999 if(info /=0) goto 9999
@ -216,7 +223,7 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
write(0,*) 'Unknown value for baseprecv(2)%iprcparm(coarse_mat_) ',icm write(0,*) 'Unknown value for baseprecv(2)%iprcparm(coarse_mat_) ',icm
endif endif
call psb_baseprc_aply(zone,baseprecv(ilev),& call mld_baseprec_aply(zone,baseprecv(ilev),&
& mlprec_wrk(ilev)%x2l,zzero,mlprec_wrk(ilev)%y2l,& & mlprec_wrk(ilev)%x2l,zzero,mlprec_wrk(ilev)%y2l,&
& baseprecv(ilev)%desc_data, 'N',work,info) & baseprecv(ilev)%desc_data, 'N',work,info)
@ -314,7 +321,9 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
& mlprec_wrk(ilev)%x2l(nc2l), stat=info) & mlprec_wrk(ilev)%x2l(nc2l), stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/4*nc2l,0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
@ -367,7 +376,7 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
enddo enddo
call psb_baseprc_aply(zone,baseprecv(nlev),mlprec_wrk(nlev)%x2l, & call mld_baseprec_aply(zone,baseprecv(nlev),mlprec_wrk(nlev)%x2l, &
& zzero, mlprec_wrk(nlev)%y2l,baseprecv(nlev)%desc_data,'N',work,info) & zzero, mlprec_wrk(nlev)%y2l,baseprecv(nlev)%desc_data,'N',work,info)
if(info /=0) goto 9999 if(info /=0) goto 9999
@ -399,7 +408,7 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
if(info /=0) goto 9999 if(info /=0) goto 9999
call psb_baseprc_aply(zone,baseprecv(ilev),mlprec_wrk(ilev)%tx,& call mld_baseprec_aply(zone,baseprecv(ilev),mlprec_wrk(ilev)%tx,&
& zone,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%base_desc, trans, work,info) & zone,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%base_desc, trans, work,info)
if(info /=0) goto 9999 if(info /=0) goto 9999
@ -437,14 +446,16 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
allocate(mlprec_wrk(1)%x2l(nc2l),mlprec_wrk(1)%y2l(nc2l), & allocate(mlprec_wrk(1)%x2l(nc2l),mlprec_wrk(1)%y2l(nc2l), &
& mlprec_wrk(1)%tx(nc2l), stat=info) & mlprec_wrk(1)%tx(nc2l), stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/4*nc2l,0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
mlprec_wrk(1)%y2l(:) = zzero mlprec_wrk(1)%y2l(:) = zzero
mlprec_wrk(1)%x2l(:) = x mlprec_wrk(1)%x2l(:) = x
call psb_baseprc_aply(zone,baseprecv(1),mlprec_wrk(1)%x2l,& call mld_baseprec_aply(zone,baseprecv(1),mlprec_wrk(1)%x2l,&
& zzero,mlprec_wrk(1)%y2l,& & zzero,mlprec_wrk(1)%y2l,&
& baseprecv(1)%base_desc,& & baseprecv(1)%base_desc,&
& trans,work,info) & trans,work,info)
@ -467,10 +478,10 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),&
& mlprec_wrk(ilev)%x2l(nc2l), stat=info) & mlprec_wrk(ilev)%x2l(nc2l), stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/4*nc2l,0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999 goto 9999
end if end if
@ -510,7 +521,7 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
endif endif
call psb_baseprc_aply(zone,baseprecv(ilev),mlprec_wrk(ilev)%x2l,& call mld_baseprec_aply(zone,baseprecv(ilev),mlprec_wrk(ilev)%x2l,&
& zzero,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%desc_data, 'N',work,info) & zzero,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%desc_data, 'N',work,info)
if(info /=0) goto 9999 if(info /=0) goto 9999
@ -583,22 +594,24 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
allocate(mlprec_wrk(1)%x2l(nc2l),mlprec_wrk(1)%y2l(nc2l), & allocate(mlprec_wrk(1)%x2l(nc2l),mlprec_wrk(1)%y2l(nc2l), &
& mlprec_wrk(1)%ty(nc2l), mlprec_wrk(1)%tx(nc2l), stat=info) & mlprec_wrk(1)%ty(nc2l), mlprec_wrk(1)%tx(nc2l), stat=info)
if (info /= 0) then
info=4025
call psb_errpush(info,name,i_err=(/4*nc2l,0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999
end if
mlprec_wrk(1)%x2l(:) = zzero mlprec_wrk(1)%x2l(:) = zzero
mlprec_wrk(1)%y2l(:) = zzero mlprec_wrk(1)%y2l(:) = zzero
mlprec_wrk(1)%tx(:) = zzero mlprec_wrk(1)%tx(:) = zzero
mlprec_wrk(1)%ty(:) = zzero mlprec_wrk(1)%ty(:) = zzero
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
goto 9999
end if
call psb_geaxpby(zone,x,zzero,mlprec_wrk(1)%x2l,& call psb_geaxpby(zone,x,zzero,mlprec_wrk(1)%x2l,&
& baseprecv(1)%base_desc,info) & baseprecv(1)%base_desc,info)
call psb_geaxpby(zone,x,zzero,mlprec_wrk(1)%tx,& call psb_geaxpby(zone,x,zzero,mlprec_wrk(1)%tx,&
& baseprecv(1)%base_desc,info) & baseprecv(1)%base_desc,info)
call psb_baseprc_aply(zone,baseprecv(1),mlprec_wrk(1)%x2l,& call mld_baseprec_aply(zone,baseprecv(1),mlprec_wrk(1)%x2l,&
& zzero,mlprec_wrk(1)%y2l,& & zzero,mlprec_wrk(1)%y2l,&
& baseprecv(1)%base_desc,& & baseprecv(1)%base_desc,&
& trans,work,info) & trans,work,info)
@ -621,18 +634,19 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
allocate(mlprec_wrk(ilev)%ty(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& allocate(mlprec_wrk(ilev)%ty(nc2l),mlprec_wrk(ilev)%y2l(nc2l),&
& mlprec_wrk(ilev)%x2l(nc2l), stat=info) & mlprec_wrk(ilev)%x2l(nc2l), stat=info)
if (info /= 0) then
info=4025
call psb_errpush(info,name,i_err=(/4*nc2l,0,0,0,0/),&
& a_err='real(kind(1.d0))')
goto 9999
end if
mlprec_wrk(ilev)%x2l(:) = zzero mlprec_wrk(ilev)%x2l(:) = zzero
mlprec_wrk(ilev)%y2l(:) = zzero mlprec_wrk(ilev)%y2l(:) = zzero
mlprec_wrk(ilev)%tx(:) = zzero mlprec_wrk(ilev)%tx(:) = zzero
mlprec_wrk(ilev)%ty(:) = zzero mlprec_wrk(ilev)%ty(:) = zzero
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
goto 9999
end if
if (ismth /= no_smth_) then if (ismth /= no_smth_) then
! !
!Smoothed Aggregation !Smoothed Aggregation
@ -667,7 +681,7 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
& baseprecv(ilev)%base_desc,info) & baseprecv(ilev)%base_desc,info)
if(info /=0) goto 9999 if(info /=0) goto 9999
call psb_baseprc_aply(zone,baseprecv(ilev),mlprec_wrk(ilev)%x2l,& call mld_baseprec_aply(zone,baseprecv(ilev),mlprec_wrk(ilev)%x2l,&
& zzero,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%desc_data, 'N',work,info) & zzero,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%desc_data, 'N',work,info)
if(info /=0) goto 9999 if(info /=0) goto 9999
@ -708,7 +722,7 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
if(info /=0) goto 9999 if(info /=0) goto 9999
call psb_baseprc_aply(zone,baseprecv(ilev),mlprec_wrk(ilev)%tx,& call mld_baseprec_aply(zone,baseprecv(ilev),mlprec_wrk(ilev)%tx,&
& zone,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%base_desc, trans, work,info) & zone,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%base_desc, trans, work,info)
if(info /=0) goto 9999 if(info /=0) goto 9999
@ -768,5 +782,5 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!!$ end do !!$ end do
!!$ end subroutine mlprec_wrk_free !!$ end subroutine mlprec_wrk_free
end subroutine psb_zmlprc_aply end subroutine mld_zmlprec_aply

16
mld_zmlprec_bld.f90
Unescape Escape View File

@ -34,10 +34,10 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_zmlprc_bld(a,desc_a,p,info) subroutine mld_zmlprec_bld(a,desc_a,p,info)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_zmlprc_bld use psb_prec_mod, mld_protect_name => mld_zmlprec_bld
implicit none implicit none
@ -95,7 +95,7 @@ subroutine psb_zmlprc_bld(a,desc_a,p,info)
! Currently this is ignored by gen_aggrmap, but it could be ! Currently this is ignored by gen_aggrmap, but it could be
! changed in the future. Need to package nlaggr & mlia in a ! changed in the future. Need to package nlaggr & mlia in a
! private data structure? ! private data structure?
call psb_genaggrmap(p%iprcparm(aggr_alg_),a,desc_a,p%nlaggr,p%mlia,info) call mld_aggrmap_bld(p%iprcparm(aggr_alg_),a,desc_a,p%nlaggr,p%mlia,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_gen_aggrmap' ch_err='psb_gen_aggrmap'
@ -106,7 +106,7 @@ subroutine psb_zmlprc_bld(a,desc_a,p,info)
if (debug) write(0,*) 'Out from genaggrmap',p%nlaggr if (debug) write(0,*) 'Out from genaggrmap',p%nlaggr
call psb_nullify_desc(desc_ac) call psb_nullify_desc(desc_ac)
call psb_bldaggrmat(a,desc_a,ac,desc_ac,p,info) call mld_aggrmat_asb(a,desc_a,ac,desc_ac,p,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_bld_aggrmat' ch_err='psb_bld_aggrmat'
@ -117,11 +117,11 @@ subroutine psb_zmlprc_bld(a,desc_a,p,info)
call psb_baseprc_bld(ac,desc_ac,p,info) call mld_baseprc_bld(ac,desc_ac,p,info)
if (debug) write(0,*) 'Out from baseprcbld',info if (debug) write(0,*) 'Out from baseprcbld',info
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_baseprc_bld' ch_err='mld_baseprc_bld'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
@ -129,7 +129,7 @@ subroutine psb_zmlprc_bld(a,desc_a,p,info)
! !
! We have used a separate ac because: ! We have used a separate ac because:
! 1. We want to reuse the same routines psb_ilu_bld etc. ! 1. We want to reuse the same routines mld_ilu_bld etc.
! 2. We do NOT want to pass an argument twice to them ! 2. We do NOT want to pass an argument twice to them
! p%av(ac_) and p, as this would violate the Fortran standard ! p%av(ac_) and p, as this would violate the Fortran standard
! Hence a separate AC and a TRANSFER function at the end. ! Hence a separate AC and a TRANSFER function at the end.
@ -157,4 +157,4 @@ subroutine psb_zmlprc_bld(a,desc_a,p,info)
end if end if
Return Return
end subroutine psb_zmlprc_bld end subroutine mld_zmlprec_bld

30
mld_zprec_aply.f90
Unescape Escape View File

@ -34,10 +34,10 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans, work) subroutine mld_zprec_aply(prec,x,y,desc_data,info,trans, work)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_zprc_aply use psb_prec_mod, mld_protect_name => mld_zprec_aply
implicit none implicit none
@ -55,7 +55,7 @@ subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans, work)
logical,parameter :: debug=.false., debugprt=.false. logical,parameter :: debug=.false., debugprt=.false.
character(len=20) :: name character(len=20) :: name
name='psb_zprc_aply' name='mld_zprec_aply'
info = 0 info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -74,7 +74,9 @@ subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans, work)
iwsz = max(1,4*psb_cd_get_local_cols(desc_data)) iwsz = max(1,4*psb_cd_get_local_cols(desc_data))
allocate(work_(iwsz),stat=info) allocate(work_(iwsz),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/iwsz,0,0,0,0/),&
& a_err='complex(kind(1.d0))')
goto 9999 goto 9999
end if end if
@ -85,14 +87,14 @@ subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans, work)
end if end if
if (size(prec%baseprecv) >1) then if (size(prec%baseprecv) >1) then
if (debug) write(0,*) 'Into mlprc_aply',size(x),size(y) if (debug) write(0,*) 'Into mlprc_aply',size(x),size(y)
call psb_mlprc_aply(zone,prec%baseprecv,x,zzero,y,desc_data,trans_,work_,info) call mld_mlprec_aply(zone,prec%baseprecv,x,zzero,y,desc_data,trans_,work_,info)
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_zmlprc_aply') call psb_errpush(4010,name,a_err='mld_zmlprec_aply')
goto 9999 goto 9999
end if end if
else if (size(prec%baseprecv) == 1) then else if (size(prec%baseprecv) == 1) then
call psb_baseprc_aply(zone,prec%baseprecv(1),x,zzero,y,desc_data,trans_, work_,info) call mld_baseprec_aply(zone,prec%baseprecv(1),x,zzero,y,desc_data,trans_, work_,info)
else else
write(0,*) 'Inconsistent preconditioner: size of baseprecv???' write(0,*) 'Inconsistent preconditioner: size of baseprecv???'
endif endif
@ -113,7 +115,7 @@ subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans, work)
end if end if
return return
end subroutine psb_zprc_aply end subroutine mld_zprec_aply
!!$ !!$
@ -152,9 +154,9 @@ end subroutine psb_zprc_aply
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_zprc_aply1(prec,x,desc_data,info,trans) subroutine mld_zprec_aply1(prec,x,desc_data,info,trans)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_zprc_aply1 use psb_prec_mod, mld_protect_name => mld_zprec_aply1
implicit none implicit none
@ -185,11 +187,13 @@ subroutine psb_zprc_aply1(prec,x,desc_data,info,trans)
allocate(ww(size(x)),w1(size(x)),stat=info) allocate(ww(size(x)),w1(size(x)),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') info=4025
call psb_errpush(info,name,i_err=(/2*size(x),0,0,0,0/),&
& a_err='complex(kind(1.d0))')
goto 9999 goto 9999
end if end if
if (debug) write(0,*) 'Prc_aply1 Size(x) ',size(x), size(ww),size(w1) if (debug) write(0,*) 'Prc_aply1 Size(x) ',size(x), size(ww),size(w1)
call psb_zprc_aply(prec,x,ww,desc_data,info,trans_,work=w1) call mld_zprec_aply(prec,x,ww,desc_data,info,trans_,work=w1)
if(info /=0) goto 9999 if(info /=0) goto 9999
x(:) = ww(:) x(:) = ww(:)
deallocate(ww,W1) deallocate(ww,W1)
@ -205,4 +209,4 @@ subroutine psb_zprc_aply1(prec,x,desc_data,info,trans)
return return
end if end if
return return
end subroutine psb_zprc_aply1 end subroutine mld_zprec_aply1

10
mld_zslu_bld.f90
Unescape Escape View File

@ -34,9 +34,9 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_zslu_bld(a,desc_a,p,info) subroutine mld_zslu_bld(a,desc_a,p,info)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_zslu_bld use psb_prec_mod, mld_protect_name => mld_zslu_bld
implicit none implicit none
@ -51,7 +51,7 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
info=0 info=0
name='psb_zslu_bld' name='mld_zslu_bld'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_cd_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
@ -72,7 +72,7 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
call psb_barrier(ictxt) call psb_barrier(ictxt)
endif endif
call psb_zslu_factor(a%m,nzt,& call mld_zslu_factor(a%m,nzt,&
& a%aspk,a%ia2,a%ia1,p%iprcparm(slu_ptr_),info) & a%aspk,a%ia2,a%ia1,p%iprcparm(slu_ptr_),info)
if (info /= 0) then if (info /= 0) then
@ -97,5 +97,5 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
end if end if
return return
end subroutine psb_zslu_bld end subroutine mld_zslu_bld

24
mld_zslu_impl.c
Unescape Escape View File

@ -111,26 +111,26 @@ typedef struct {
#ifdef Add_ #ifdef Add_
#define psb_zslu_factor_ psb_zslu_factor_ #define mld_zslu_factor_ mld_zslu_factor_
#define psb_zslu_solve_ psb_zslu_solve_ #define mld_zslu_solve_ mld_zslu_solve_
#define psb_zslu_free_ psb_zslu_free_ #define mld_zslu_free_ mld_zslu_free_
#endif #endif
#ifdef AddDouble_ #ifdef AddDouble_
#define psb_zslu_factor_ psb_zslu_factor__ #define mld_zslu_factor_ mld_zslu_factor__
#define psb_zslu_solve_ psb_zslu_solve__ #define mld_zslu_solve_ mld_zslu_solve__
#define psb_zslu_free_ psb_zslu_free__ #define mld_zslu_free_ mld_zslu_free__
#endif #endif
#ifdef NoChange #ifdef NoChange
#define psb_zslu_factor_ psb_zslu_factor #define mld_zslu_factor_ mld_zslu_factor
#define psb_zslu_solve_ psb_zslu_solve #define mld_zslu_solve_ mld_zslu_solve
#define psb_zslu_free_ psb_zslu_free #define mld_zslu_free_ mld_zslu_free
#endif #endif
void void
psb_zslu_factor_(int *n, int *nnz, mld_zslu_factor_(int *n, int *nnz,
#ifdef Have_SLU_ #ifdef Have_SLU_
doublecomplex *values, int *colind, int *rowptr, doublecomplex *values, int *colind, int *rowptr,
fptr *f_factors, /* a handle containing the address fptr *f_factors, /* a handle containing the address
@ -255,7 +255,7 @@ psb_zslu_factor_(int *n, int *nnz,
void void
psb_zslu_solve_(int *itrans, int *n, int *nrhs, mld_zslu_solve_(int *itrans, int *n, int *nrhs,
#ifdef Have_SLU_ #ifdef Have_SLU_
doublecomplex *b, int *ldb, doublecomplex *b, int *ldb,
fptr *f_factors, /* a handle containing the address fptr *f_factors, /* a handle containing the address
@ -327,7 +327,7 @@ psb_zslu_solve_(int *itrans, int *n, int *nrhs,
void void
psb_zslu_free_( mld_zslu_free_(
#ifdef Have_SLU_ #ifdef Have_SLU_
fptr *f_factors, /* a handle containing the address fptr *f_factors, /* a handle containing the address
pointing to the factored matrices */ pointing to the factored matrices */

10
mld_zslud_bld.f90
Unescape Escape View File

@ -34,9 +34,9 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_zsludist_bld(a,desc_a,p,info) subroutine mld_zsludist_bld(a,desc_a,p,info)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_zsludist_bld use psb_prec_mod, mld_protect_name => mld_zsludist_bld
implicit none implicit none
@ -52,7 +52,7 @@ subroutine psb_zsludist_bld(a,desc_a,p,info)
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
info=0 info=0
name='psb_zslu_bld' name='mld_zslu_bld'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = psb_cd_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
@ -96,7 +96,7 @@ subroutine psb_zsludist_bld(a,desc_a,p,info)
ip = ip - 1 ip = ip - 1
end do end do
!!$ write(0,*) 'Process grid : ',npr,npc !!$ write(0,*) 'Process grid : ',npr,npc
call psb_zsludist_factor(mglob,nrow,nzt,ifrst,& call mld_zsludist_factor(mglob,nrow,nzt,ifrst,&
& a%aspk,a%ia2,a%ia1,p%iprcparm(slud_ptr_),& & a%aspk,a%ia2,a%ia1,p%iprcparm(slud_ptr_),&
& npr, npc, info) & npr, npc, info)
if (info /= 0) then if (info /= 0) then
@ -118,5 +118,5 @@ subroutine psb_zsludist_bld(a,desc_a,p,info)
end if end if
return return
end subroutine psb_zsludist_bld end subroutine mld_zsludist_bld

24
mld_zslud_impl.c
Unescape Escape View File

@ -112,26 +112,26 @@ typedef struct {
#ifdef Add_ #ifdef Add_
#define psb_zsludist_factor_ psb_zsludist_factor_ #define mld_zsludist_factor_ mld_zsludist_factor_
#define psb_zsludist_solve_ psb_zsludist_solve_ #define mld_zsludist_solve_ mld_zsludist_solve_
#define psb_zsludist_free_ psb_zsludist_free_ #define mld_zsludist_free_ mld_zsludist_free_
#endif #endif
#ifdef AddDouble_ #ifdef AddDouble_
#define psb_zsludist_factor_ psb_zsludist_factor__ #define mld_zsludist_factor_ mld_zsludist_factor__
#define psb_zsludist_solve_ psb_zsludist_solve__ #define mld_zsludist_solve_ mld_zsludist_solve__
#define psb_zsludist_free_ psb_zsludist_free__ #define mld_zsludist_free_ mld_zsludist_free__
#endif #endif
#ifdef NoChange #ifdef NoChange
#define psb_zsludist_factor_ psb_zsludist_factor #define mld_zsludist_factor_ mld_zsludist_factor
#define psb_zsludist_solve_ psb_zsludist_solve #define mld_zsludist_solve_ mld_zsludist_solve
#define psb_zsludist_free_ psb_zsludist_free #define mld_zsludist_free_ mld_zsludist_free
#endif #endif
void void
psb_zsludist_factor_(int *n, int *nl, int *nnzl, int *ffstr, mld_zsludist_factor_(int *n, int *nl, int *nnzl, int *ffstr,
#ifdef Have_SLUDist_ #ifdef Have_SLUDist_
doublecomplex *values, int *rowptr, int *colind, doublecomplex *values, int *rowptr, int *colind,
fptr *f_factors, /* a handle containing the address fptr *f_factors, /* a handle containing the address
@ -239,7 +239,7 @@ psb_zsludist_factor_(int *n, int *nl, int *nnzl, int *ffstr,
void void
psb_zsludist_solve_(int *itrans, int *n, int *nrhs, mld_zsludist_solve_(int *itrans, int *n, int *nrhs,
#ifdef Have_SLUDist_ #ifdef Have_SLUDist_
doublecomplex *b, int *ldb, doublecomplex *b, int *ldb,
fptr *f_factors, /* a handle containing the address fptr *f_factors, /* a handle containing the address
@ -323,7 +323,7 @@ psb_zsludist_solve_(int *itrans, int *n, int *nrhs,
void void
psb_zsludist_free_( mld_zsludist_free_(
#ifdef Have_SLUDist_ #ifdef Have_SLUDist_
fptr *f_factors, /* a handle containing the address fptr *f_factors, /* a handle containing the address
pointing to the factored matrices */ pointing to the factored matrices */

8
mld_zsp_renum.f90
Unescape Escape View File

@ -34,9 +34,9 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info) subroutine mld_zsp_renum(a,desc_a,blck,p,atmp,info)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_zsp_renum use psb_prec_mod, mld_protect_name => mld_zsp_renum
implicit none implicit none
@ -58,7 +58,7 @@ subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info)
if (psb_get_errstatus().ne.0) return if (psb_get_errstatus().ne.0) return
info=0 info=0
name='psb_zsp_renum' name='mld_zsp_renum'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=psb_cd_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
@ -455,4 +455,4 @@ contains
end subroutine gps_reduction end subroutine gps_reduction
end subroutine psb_zsp_renum end subroutine mld_zsp_renum

10
mld_zumf_bld.f90
Unescape Escape View File

@ -34,9 +34,9 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_zumf_bld(a,desc_a,p,info) subroutine mld_zumf_bld(a,desc_a,p,info)
use psb_base_mod use psb_base_mod
use psb_prec_mod, mld_protect_name => psb_zumf_bld use psb_prec_mod, mld_protect_name => mld_zumf_bld
implicit none implicit none
@ -52,7 +52,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
info=0 info=0
name='psb_zumf_bld' name='mld_zumf_bld'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_A%matrix_data(psb_ctxt_) ictxt = desc_A%matrix_data(psb_ctxt_)
@ -75,7 +75,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info)
call psb_barrier(ictxt) call psb_barrier(ictxt)
endif endif
call psb_zumf_factor(a%m,nzt,& call mld_zumf_factor(a%m,nzt,&
& a%aspk,a%ia1,a%ia2,& & a%aspk,a%ia1,a%ia2,&
& p%iprcparm(umf_symptr_),p%iprcparm(umf_numptr_),info) & p%iprcparm(umf_symptr_),p%iprcparm(umf_numptr_),info)
@ -102,7 +102,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info)
end if end if
return return
end subroutine psb_zumf_bld end subroutine mld_zumf_bld

24
mld_zumf_impl.c
Unescape Escape View File

@ -72,19 +72,19 @@ Availability:
#ifdef Add_ #ifdef Add_
#define psb_zumf_factor_ psb_zumf_factor_ #define mld_zumf_factor_ mld_zumf_factor_
#define psb_zumf_solve_ psb_zumf_solve_ #define mld_zumf_solve_ mld_zumf_solve_
#define psb_zumf_free_ psb_zumf_free_ #define mld_zumf_free_ mld_zumf_free_
#endif #endif
#ifdef AddDouble_ #ifdef AddDouble_
#define psb_zumf_factor_ psb_zumf_factor__ #define mld_zumf_factor_ mld_zumf_factor__
#define psb_zumf_solve_ psb_zumf_solve__ #define mld_zumf_solve_ mld_zumf_solve__
#define psb_zumf_free_ psb_zumf_free__ #define mld_zumf_free_ mld_zumf_free__
#endif #endif
#ifdef NoChange #ifdef NoChange
#define psb_zumf_factor_ psb_zumf_factor #define mld_zumf_factor_ mld_zumf_factor
#define psb_zumf_solve_ psb_zumf_solve #define mld_zumf_solve_ mld_zumf_solve
#define psb_zumf_free_ psb_zumf_free #define mld_zumf_free_ mld_zumf_free
#endif #endif
@ -100,7 +100,7 @@ typedef int fptr; /* 32-bit by default */
#endif #endif
void void
psb_zumf_factor_(int *n, int *nnz, mld_zumf_factor_(int *n, int *nnz,
double *values, int *rowind, int *colptr, double *values, int *rowind, int *colptr,
#ifdef Have_UMF_ #ifdef Have_UMF_
fptr *symptr, fptr *symptr,
@ -162,7 +162,7 @@ psb_zumf_factor_(int *n, int *nnz,
void void
psb_zumf_solve_(int *itrans, int *n, mld_zumf_solve_(int *itrans, int *n,
double *x, double *b, int *ldb, double *x, double *b, int *ldb,
#ifdef Have_UMF_ #ifdef Have_UMF_
fptr *numptr, fptr *numptr,
@ -203,7 +203,7 @@ psb_zumf_solve_(int *itrans, int *n,
void void
psb_zumf_free_( mld_zumf_free_(
#ifdef Have_UMF_ #ifdef Have_UMF_
fptr *symptr, fptr *symptr,
fptr *numptr, fptr *numptr,

Write Preview
Loading…
Cancel
Save