From 4158c73b0d8a18bdddcce49b0f5fa1303367f11a Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 28 May 2007 12:30:29 +0000 Subject: [PATCH] Merge MLD stuf. Phase 2. --- mld_daggrmap_bld.f90 | 29 ++++++++------- mld_daggrmat_asb.F90 | 27 +++++++++----- mld_dasmat_bld.f90 | 8 ++-- mld_dbaseprec_aply.f90 | 29 ++++++++------- mld_dbaseprec_bld.f90 | 20 +++++----- mld_dbjac_aply.f90 | 36 ++++++++++-------- mld_dbjac_bld.f90 | 38 +++++++++---------- mld_ddiagsc_bld.f90 | 17 +++++---- mld_dilu_bld.f90 | 12 +++--- mld_dilu_fct.f90 | 16 ++++---- mld_dmlprec_aply.f90 | 83 ++++++++++++++++++++++++------------------ mld_dmlprec_bld.f90 | 16 ++++---- mld_dprec_aply.f90 | 26 +++++++------ mld_dslu_bld.f90 | 10 ++--- mld_dslud_bld.f90 | 10 ++--- mld_dsp_renum.f90 | 8 ++-- mld_dumf_bld.f90 | 10 ++--- mld_slu_impl.c | 24 ++++++------ mld_slud_impl.c | 24 ++++++------ mld_umf_impl.c | 24 ++++++------ mld_zaggrmap_bld.f90 | 23 +++++++----- mld_zaggrmat_asb.F90 | 26 ++++++++----- mld_zasmat_bld.f90 | 13 +++---- mld_zbaseprec_aply.f90 | 18 ++++----- mld_zbaseprec_bld.f90 | 20 +++++----- mld_zbjac_aply.f90 | 42 ++++++++++++--------- mld_zbjac_bld.f90 | 38 +++++++++---------- mld_zdiagsc_bld.f90 | 13 ++++--- mld_zilu_bld.f90 | 12 +++--- mld_zilu_fct.f90 | 16 ++++---- mld_zmlprec_aply.f90 | 82 ++++++++++++++++++++++++----------------- mld_zmlprec_bld.f90 | 16 ++++---- mld_zprec_aply.f90 | 30 ++++++++------- mld_zslu_bld.f90 | 10 ++--- mld_zslu_impl.c | 24 ++++++------ mld_zslud_bld.f90 | 10 ++--- mld_zslud_impl.c | 24 ++++++------ mld_zsp_renum.f90 | 8 ++-- mld_zumf_bld.f90 | 10 ++--- mld_zumf_impl.c | 24 ++++++------ 40 files changed, 499 insertions(+), 427 deletions(-) diff --git a/mld_daggrmap_bld.f90 b/mld_daggrmap_bld.f90 index 5a4d44ea..105fb6ee 100644 --- a/mld_daggrmap_bld.f90 +++ b/mld_daggrmap_bld.f90 @@ -34,9 +34,9 @@ !!$ 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_prec_mod, mld_protect_name => psb_dgenaggrmap + use psb_prec_mod, mld_protect_name => mld_daggrmap_bld implicit none 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 info=0 - name = 'psb_dgenaggrmap' + name = 'mld_daggrmap_bld' call psb_erractionsave(err_act) ! ! 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 allocate(ilaggr(nr),neigh(nr),stat=info) if(info.ne.0) then - info=4000 - call psb_errpush(info,name,a_err=ch_err) - goto 9999 + info=4025 + call psb_errpush(info,name,i_err=(/2*nr,0,0,0,0/),& + & a_err='integer') + goto 9999 end if 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) if(info.ne.0) then - info=4000 - call psb_errpush(info,name) - goto 9999 + info=4025 + call psb_errpush(info,name,i_err=(/naggr+10,0,0,0,0/),& + & a_err='integer') + goto 9999 end if 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) if (info/=0) then - info=4000 - call psb_errpush(info,name) - goto 9999 + info=4025 + call psb_errpush(info,name,i_err=(/np,0,0,0,0/),& + & a_err='integer') + goto 9999 end if nlaggr(:) = 0 @@ -290,4 +293,4 @@ subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info) end if return -end subroutine psb_dgenaggrmap +end subroutine mld_daggrmap_bld diff --git a/mld_daggrmat_asb.F90 b/mld_daggrmat_asb.F90 index 8747c39d..25d6346d 100644 --- a/mld_daggrmat_asb.F90 +++ b/mld_daggrmat_asb.F90 @@ -34,28 +34,30 @@ !!$ 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_prec_mod, mld_protect_name => psb_dbldaggrmat + use psb_prec_mod, mld_protect_name => mld_daggrmat_asb implicit none 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_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(inout) :: desc_ac - type(psb_dbaseprc_type), intent(inout), target :: p integer, intent(out) :: info logical, parameter :: aggr_dump=.false. - integer ::ictxt,np,me, err_act + integer ::ictxt,np,me, err_act, icomm character(len=20) :: name, ch_err - name='psb_dbldaggrmat' + name='mld_daggrmat_asb' if(psb_get_errstatus().ne.0) return info=0 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) call psb_info(ictxt, me, np) @@ -134,9 +136,10 @@ contains naggr = p%nlaggr(me+1) ntaggr = sum(p%nlaggr) allocate(nzbr(np), idisp(np),stat=info) - 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 end if @@ -351,7 +354,9 @@ contains allocate(nzbr(np), idisp(np),stat=info) 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 end if @@ -388,7 +393,9 @@ contains ! allocate(p%dorig(nrow),stat=info) 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 end if @@ -958,4 +965,4 @@ contains end subroutine smooth_aggregate -end subroutine psb_dbldaggrmat +end subroutine mld_daggrmat_asb diff --git a/mld_dasmat_bld.f90 b/mld_dasmat_bld.f90 index 68c98a97..456add4b 100644 --- a/mld_dasmat_bld.f90 +++ b/mld_dasmat_bld.f90 @@ -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_prec_mod, mld_protect_name => psb_dasmatbld + use psb_prec_mod, mld_protect_name => mld_dasmat_bld Implicit None ! .. 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. character(len=20) :: name, ch_err - name='psb_dasmatbld' + name='mld_dasmat_bld' if(psb_get_errstatus().ne.0) return info=0 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 Return -End Subroutine psb_dasmatbld +End Subroutine mld_dasmat_bld diff --git a/mld_dbaseprec_aply.f90 b/mld_dbaseprec_aply.f90 index ad5bd1fd..102e3de7 100644 --- a/mld_dbaseprec_aply.f90 +++ b/mld_dbaseprec_aply.f90 @@ -34,14 +34,14 @@ !!$ 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 ! where K is a a basic preconditioner stored in prec ! 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 @@ -62,7 +62,7 @@ subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) logical,parameter :: debug=.false., debugprt=.false. character(len=20) :: name, ch_err - name='psb_dbaseprc_aply' + name='mld_dbaseprec_aply' info = 0 call psb_erractionsave(err_act) @@ -96,7 +96,7 @@ subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) else allocate(ww(size(x)),stat=info) 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 end if end if @@ -115,10 +115,10 @@ subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) 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 info=4010 - ch_err='psb_bjac_aply' + ch_err='mld_bjac_aply' goto 9999 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 ! 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 info=4010 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:) allocate(ww(isz),tx(isz),ty(isz),stat=info) 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 end if 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) allocate(aux(4*isz),stat=info) 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 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),& &aux(4*isz),stat=info) 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 end if @@ -198,10 +201,10 @@ subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) end if 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 info=4010 - ch_err='psb_bjac_aply' + ch_err='mld_bjac_aply' goto 9999 end if @@ -264,5 +267,5 @@ subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) end if return -end subroutine psb_dbaseprc_aply +end subroutine mld_dbaseprec_aply diff --git a/mld_dbaseprec_bld.f90 b/mld_dbaseprec_bld.f90 index 4ecc24ed..7898bd5c 100644 --- a/mld_dbaseprec_bld.f90 +++ b/mld_dbaseprec_bld.f90 @@ -34,10 +34,10 @@ !!$ 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_prec_mod, mld_protect_name => psb_dbaseprc_bld + use psb_prec_mod, mld_protect_name => mld_dbaseprc_bld Implicit None @@ -63,7 +63,7 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd) info=0 err=0 call psb_erractionsave(err_act) - name = 'psb_dbaseprc_bld' + name = 'mld_dbaseprc_bld' if (debug) write(0,*) 'Entering baseprc_bld' info = 0 @@ -110,11 +110,11 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd) case (diag_) - call psb_diagsc_bld(a,desc_a,p,iupd,info) - if(debug) write(0,*)me,': out of psb_diagsc_bld' + call mld_diag_bld(a,desc_a,p,iupd,info) + if(debug) write(0,*)me,': out of mld_diag_bld' if(info /= 0) then info=4010 - ch_err='psb_diagsc_bld' + ch_err='mld_diag_bld' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -137,13 +137,13 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd) p%iprcparm(jac_sweeps_) = 1 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) - call psb_bjac_bld(a,desc_a,p,iupd,info) + call mld_bjac_bld(a,desc_a,p,iupd,info) if(info /= 0) then info=4010 - call psb_errpush(info,name,a_err='psb_bjac_bld') + call psb_errpush(info,name,a_err='mld_bjac_bld') goto 9999 end if @@ -169,5 +169,5 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd) end if return -end subroutine psb_dbaseprc_bld +end subroutine mld_dbaseprc_bld diff --git a/mld_dbjac_aply.f90 b/mld_dbjac_aply.f90 index ddb2476e..ca0a232d 100644 --- a/mld_dbjac_aply.f90 +++ b/mld_dbjac_aply.f90 @@ -34,7 +34,7 @@ !!$ 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 ! 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_prec_mod, mld_protect_name => psb_dbjac_aply + use psb_prec_mod, mld_protect_name => mld_dbjac_aply 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. character(len=20) :: name, ch_err - name='psb_dbjac_aply' + name='mld_dbjac_aply' info = 0 call psb_erractionsave(err_act) @@ -90,7 +90,9 @@ subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) else allocate(aux(4*n_col),stat=info) 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 end if @@ -98,7 +100,9 @@ subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) else allocate(ww(n_col),aux(4*n_col),stat=info) 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 end if endif @@ -138,9 +142,9 @@ subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) select case(toupper(trans)) 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') - 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 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)) 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') - 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 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)) 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') - 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 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) 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 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) 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 tx(1:n_row) = ty(1:n_row) 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) 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) if(info /=0) goto 9999 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 return -end subroutine psb_dbjac_aply +end subroutine mld_dbjac_aply diff --git a/mld_dbjac_bld.f90 b/mld_dbjac_bld.f90 index f1e52379..2c55943e 100644 --- a/mld_dbjac_bld.f90 +++ b/mld_dbjac_bld.f90 @@ -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_prec_mod, mld_protect_name => psb_dbjac_bld + use psb_prec_mod, mld_protect_name => mld_dbjac_bld implicit none ! ! .. Scalar Arguments .. @@ -77,7 +77,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info) if(psb_get_errstatus().ne.0) return info=0 - name='psb_dbjac_bld' + name='mld_dbjac_bld' call psb_erractionsave(err_act) ictxt=psb_cd_get_context(desc_a) @@ -106,9 +106,9 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info) 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) - 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) if (debugprt) then @@ -121,12 +121,12 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info) endif 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 end if 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) @@ -139,10 +139,10 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info) ! 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 - call psb_errpush(4010,name,a_err='psb_sp_renum') + call psb_errpush(4010,name,a_err='mld_sp_renum') goto 9999 end if @@ -190,10 +190,10 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info) goto 9999 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 - call psb_errpush(4010,name,a_err='psb_ilu_bld') + call psb_errpush(4010,name,a_err='mld_ilu_bld') goto 9999 end if @@ -221,7 +221,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info) goto 9999 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 call psb_errpush(4010,name,a_err='slu_bld') goto 9999 @@ -235,7 +235,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info) goto 9999 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 (info /= 0) then 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 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 - call psb_errpush(4010,name,a_err='psb_ilu_bld') + call psb_errpush(4010,name,a_err='mld_ilu_bld') goto 9999 end if @@ -373,7 +373,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info) endif 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 call psb_errpush(4010,name,a_err='slu_bld') goto 9999 @@ -426,7 +426,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info) !!$ nztmp = psb_sp_get_nnzeros(atmp) !!$ 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_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 call psb_errpush(4010,name,a_err='slu_bld') goto 9999 @@ -484,7 +484,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info) goto 9999 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 (info /= 0) then call psb_errpush(4010,name,a_err='umf_bld') @@ -539,6 +539,6 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info) return -end subroutine psb_dbjac_bld +end subroutine mld_dbjac_bld diff --git a/mld_ddiagsc_bld.f90 b/mld_ddiagsc_bld.f90 index 2b8e0d3c..7e8503d3 100644 --- a/mld_ddiagsc_bld.f90 +++ b/mld_ddiagsc_bld.f90 @@ -34,9 +34,9 @@ !!$ 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_prec_mod, mld_protect_name => psb_ddiagsc_bld + use psb_prec_mod, mld_protect_name => mld_ddiag_bld Implicit None type(psb_dspmat_type), target :: a @@ -61,7 +61,7 @@ subroutine psb_ddiagsc_bld(a,desc_a,p,upd,info) info=0 err=0 call psb_erractionsave(err_act) - name = 'psb_ddiagsc_bld' + name = 'mld_ddiag_bld' if (debug) write(0,*) 'Entering diagsc_bld' info = 0 @@ -112,8 +112,9 @@ subroutine psb_ddiagsc_bld(a,desc_a,p,upd,info) if (a%pl(1) /= 0) then allocate(work(n_row),stat=info) if (info /= 0) then - info=4000 - call psb_errpush(info,name) + info=4025 + call psb_errpush(info,name,i_err=(/n_row,0,0,0,0/),& + & a_err='real(kind(1.d0))') goto 9999 end if 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 allocate(gd(mglob),stat=info) 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 end if @@ -164,5 +167,5 @@ subroutine psb_ddiagsc_bld(a,desc_a,p,upd,info) end if return -end subroutine psb_ddiagsc_bld +end subroutine mld_ddiag_bld diff --git a/mld_dilu_bld.f90 b/mld_dilu_bld.f90 index b714ee8a..7427bf48 100644 --- a/mld_dilu_bld.f90 +++ b/mld_dilu_bld.f90 @@ -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_prec_mod, mld_protect_name => psb_dilu_bld + use psb_prec_mod, mld_protect_name => mld_dilu_bld implicit none ! @@ -77,7 +77,7 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info,blck) if(psb_get_errstatus().ne.0) return info=0 - name='psb_dilu_bld' + name='mld_dilu_bld' call psb_erractionsave(err_act) 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. ! 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 info=4010 - ch_err='psb_ilu_fct' + ch_err='mld_ilu_fct' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -206,6 +206,6 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info,blck) return -end subroutine psb_dilu_bld +end subroutine mld_dilu_bld diff --git a/mld_dilu_fct.f90 b/mld_dilu_fct.f90 index bb25b0f2..354089e9 100644 --- a/mld_dilu_fct.f90 +++ b/mld_dilu_fct.f90 @@ -34,7 +34,7 @@ !!$ 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 @@ -58,7 +58,7 @@ subroutine psb_dilu_fct(a,l,u,d,info,blck) character(len=20) :: name, ch_err logical, parameter :: debug=.false. - name='psb_dilu_fct' + name='mld_dilu_fct' info = 0 call psb_erractionsave(err_act) ! .. Executable Statements .. @@ -86,11 +86,11 @@ subroutine psb_dilu_fct(a,l,u,d,info,blck) endif !!$ 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) if(info.ne.0) then info=4010 - ch_err='psb_dilu_fctint' + ch_err='mld_dilu_fctint' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -130,7 +130,7 @@ subroutine psb_dilu_fct(a,l,u,d,info,blck) return 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) implicit none @@ -147,7 +147,7 @@ contains integer :: int_err(5) character(len=20) :: name, ch_err - name='psb_dilu_fctint' + name='mld_dilu_fctint' if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) @@ -472,5 +472,5 @@ contains return end if return - end subroutine psb_dilu_fctint -end subroutine psb_dilu_fct + end subroutine mld_dilu_fctint +end subroutine mld_dilu_fct diff --git a/mld_dmlprec_aply.f90 b/mld_dmlprec_aply.f90 index 6e899128..bb307826 100644 --- a/mld_dmlprec_aply.f90 +++ b/mld_dmlprec_aply.f90 @@ -34,7 +34,7 @@ !!$ 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 ! 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 ! 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 - ! to psb_baseprc_aply. + ! to mld_baseprec_aply. ! ! A bit of description of the baseprecv(:) data structure: ! 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_prec_mod, mld_protect_name => psb_dmlprc_aply + use psb_prec_mod, mld_protect_name => mld_dmlprec_aply implicit none type(psb_desc_type),intent(in) :: desc_data @@ -112,10 +112,9 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) end type psb_mlprec_wrk_type type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:) - name='psb_dmlprc_aply' + name='mld_dmlprec_aply' info = 0 call psb_erractionsave(err_act) - ictxt = psb_cd_get_context(desc_data) 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 - 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) 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(:) @@ -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)%ty(max(n_row,n_col)), stat=info) 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 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 endif - call psb_baseprc_aply(done,baseprecv(ilev),& + call mld_baseprec_aply(done,baseprecv(ilev),& & mlprec_wrk(ilev)%x2l,dzero,mlprec_wrk(ilev)%y2l,& & 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_) - ! ! Post smoothing. ! 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)%x2l(:) = 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,& & 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) 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 end if @@ -370,7 +379,7 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) 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) 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 - 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) 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_) - ! ! Pre smoothing. ! 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), & & mlprec_wrk(1)%tx(nc2l), stat=info) 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 end if mlprec_wrk(1)%y2l(:) = dzero 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,& & baseprecv(1)%base_desc,& & 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),& & mlprec_wrk(ilev)%x2l(nc2l), stat=info) - - 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 end if @@ -517,7 +527,7 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) 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) 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), & & 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)%y2l(:) = dzero mlprec_wrk(1)%tx(:) = 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,& & baseprecv(1)%base_desc,info) call psb_geaxpby(done,x,dzero,mlprec_wrk(1)%tx,& & 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,& & baseprecv(1)%base_desc,& & 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),& & 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)%y2l(:) = dzero mlprec_wrk(ilev)%tx(:) = 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 ! !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) 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) 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 - 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) 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 subroutine mlprec_wrk_free -end subroutine psb_dmlprc_aply +end subroutine mld_dmlprec_aply diff --git a/mld_dmlprec_bld.f90 b/mld_dmlprec_bld.f90 index 7037ed38..75525efe 100644 --- a/mld_dmlprec_bld.f90 +++ b/mld_dmlprec_bld.f90 @@ -34,10 +34,10 @@ !!$ 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_prec_mod, mld_protect_name => psb_dmlprc_bld + use psb_prec_mod, mld_protect_name => mld_dmlprec_bld implicit none 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 ! changed in the future. Need to package nlaggr & mlia in a ! 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 info=4010 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 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 info=4010 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(info /= 0) then info=4010 - ch_err='psb_baseprc_bld' + ch_err='mld_baseprc_bld' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -128,7 +128,7 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info) ! ! 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 ! p%av(ac_) and p, as this would violate the Fortran standard ! 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 Return -end subroutine psb_dmlprc_bld +end subroutine mld_dmlprec_bld diff --git a/mld_dprec_aply.f90 b/mld_dprec_aply.f90 index 077e5b17..8ef06ead 100644 --- a/mld_dprec_aply.f90 +++ b/mld_dprec_aply.f90 @@ -34,10 +34,10 @@ !!$ 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_prec_mod, mld_protect_name => psb_dprc_aply + use psb_prec_mod, mld_protect_name => mld_dprec_aply 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)) allocate(work_(iwsz),stat=info) 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 end if @@ -85,14 +85,14 @@ subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans, work) end if if (size(prec%baseprecv) >1) then 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 - call psb_errpush(4010,name,a_err='psb_dmlprc_aply') + call psb_errpush(4010,name,a_err='mld_dmlprec_aply') goto 9999 end if 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 write(0,*) 'Inconsistent preconditioner: size of baseprecv???' endif @@ -113,7 +113,7 @@ subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans, work) end if return -end subroutine psb_dprc_aply +end subroutine mld_dprec_aply !!$ @@ -152,10 +152,10 @@ end subroutine psb_dprc_aply !!$ 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_prec_mod, mld_protect_name => psb_dprc_aply1 + use psb_prec_mod, mld_protect_name => mld_dprec_aply1 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) 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 end if 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 x(:) = ww(:) deallocate(ww,W1) @@ -207,4 +209,4 @@ subroutine psb_dprc_aply1(prec,x,desc_data,info,trans) return end if return -end subroutine psb_dprc_aply1 +end subroutine mld_dprec_aply1 diff --git a/mld_dslu_bld.f90 b/mld_dslu_bld.f90 index 7fc326ad..7b138d9c 100644 --- a/mld_dslu_bld.f90 +++ b/mld_dslu_bld.f90 @@ -34,9 +34,9 @@ !!$ 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_prec_mod, mld_protect_name => psb_dslu_bld + use psb_prec_mod, mld_protect_name => mld_dslu_bld implicit none @@ -51,7 +51,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info) if(psb_get_errstatus().ne.0) return info=0 - name='psb_dslu_bld' + name='mld_dslu_bld' call psb_erractionsave(err_act) ictxt = psb_cd_get_context(desc_a) @@ -72,7 +72,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info) call psb_barrier(ictxt) 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) if (info /= 0) then @@ -97,5 +97,5 @@ subroutine psb_dslu_bld(a,desc_a,p,info) end if return -end subroutine psb_dslu_bld +end subroutine mld_dslu_bld diff --git a/mld_dslud_bld.f90 b/mld_dslud_bld.f90 index ede73263..4d48c87e 100644 --- a/mld_dslud_bld.f90 +++ b/mld_dslud_bld.f90 @@ -34,9 +34,9 @@ !!$ 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_prec_mod, mld_protect_name => psb_dsludist_bld + use psb_prec_mod, mld_protect_name => mld_dsludist_bld implicit none @@ -52,7 +52,7 @@ subroutine psb_dsludist_bld(a,desc_a,p,info) if (psb_get_errstatus().ne.0) return info=0 - name='psb_dslu_bld' + name='mld_dslu_bld' call psb_erractionsave(err_act) ictxt = psb_cd_get_context(desc_a) @@ -85,7 +85,7 @@ subroutine psb_dsludist_bld(a,desc_a,p,info) npc = 1 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_),& & npr, npc, info) if (info /= 0) then @@ -107,5 +107,5 @@ subroutine psb_dsludist_bld(a,desc_a,p,info) end if return -end subroutine psb_dsludist_bld +end subroutine mld_dsludist_bld diff --git a/mld_dsp_renum.f90 b/mld_dsp_renum.f90 index aaaf493d..603c46a4 100644 --- a/mld_dsp_renum.f90 +++ b/mld_dsp_renum.f90 @@ -34,9 +34,9 @@ !!$ 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_prec_mod, mld_protect_name => psb_dsp_renum + use psb_prec_mod, mld_protect_name => mld_dsp_renum implicit none @@ -58,7 +58,7 @@ subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info) if (psb_get_errstatus().ne.0) return info=0 - name='psb_dsp_renum' + name='mld_dsp_renum' call psb_erractionsave(err_act) ictxt=psb_cd_get_context(desc_a) @@ -298,4 +298,4 @@ contains end subroutine gps_reduction -end subroutine psb_dsp_renum +end subroutine mld_dsp_renum diff --git a/mld_dumf_bld.f90 b/mld_dumf_bld.f90 index 88573d90..7dd0559d 100644 --- a/mld_dumf_bld.f90 +++ b/mld_dumf_bld.f90 @@ -34,9 +34,9 @@ !!$ 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_prec_mod, mld_protect_name => psb_dumf_bld + use psb_prec_mod, mld_protect_name => mld_dumf_bld implicit none @@ -52,7 +52,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info) character(len=20) :: name, ch_err info=0 - name='psb_dumf_bld' + name='mld_dumf_bld' call psb_erractionsave(err_act) ictxt = desc_A%matrix_data(psb_ctxt_) @@ -75,7 +75,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info) call psb_barrier(ictxt) endif - call psb_dumf_factor(a%m,nzt,& + call mld_dumf_factor(a%m,nzt,& & a%aspk,a%ia1,a%ia2,& & p%iprcparm(umf_symptr_),p%iprcparm(umf_numptr_),info) @@ -102,7 +102,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info) end if return -end subroutine psb_dumf_bld +end subroutine mld_dumf_bld diff --git a/mld_slu_impl.c b/mld_slu_impl.c index 8f30048c..b2153f31 100644 --- a/mld_slu_impl.c +++ b/mld_slu_impl.c @@ -112,26 +112,26 @@ typedef struct { #ifdef Add_ -#define psb_dslu_factor_ psb_dslu_factor_ -#define psb_dslu_solve_ psb_dslu_solve_ -#define psb_dslu_free_ psb_dslu_free_ +#define mld_dslu_factor_ mld_dslu_factor_ +#define mld_dslu_solve_ mld_dslu_solve_ +#define mld_dslu_free_ mld_dslu_free_ #endif #ifdef AddDouble_ -#define psb_dslu_factor_ psb_dslu_factor__ -#define psb_dslu_solve_ psb_dslu_solve__ -#define psb_dslu_free_ psb_dslu_free__ +#define mld_dslu_factor_ mld_dslu_factor__ +#define mld_dslu_solve_ mld_dslu_solve__ +#define mld_dslu_free_ mld_dslu_free__ #endif #ifdef NoChange -#define psb_dslu_factor_ psb_dslu_factor -#define psb_dslu_solve_ psb_dslu_solve -#define psb_dslu_free_ psb_dslu_free +#define mld_dslu_factor_ mld_dslu_factor +#define mld_dslu_solve_ mld_dslu_solve +#define mld_dslu_free_ mld_dslu_free #endif void -psb_dslu_factor_(int *n, int *nnz, +mld_dslu_factor_(int *n, int *nnz, double *values, int *rowptr, int *colind, #ifdef Have_SLU_ fptr *f_factors, /* a handle containing the address @@ -255,7 +255,7 @@ psb_dslu_factor_(int *n, int *nnz, void -psb_dslu_solve_(int *itrans, int *n, int *nrhs, +mld_dslu_solve_(int *itrans, int *n, int *nrhs, double *b, int *ldb, #ifdef Have_SLU_ fptr *f_factors, /* a handle containing the address @@ -321,7 +321,7 @@ psb_dslu_solve_(int *itrans, int *n, int *nrhs, void -psb_dslu_free_( +mld_dslu_free_( #ifdef Have_SLU_ fptr *f_factors, /* a handle containing the address pointing to the factored matrices */ diff --git a/mld_slud_impl.c b/mld_slud_impl.c index ff751a32..5f0f3ba6 100644 --- a/mld_slud_impl.c +++ b/mld_slud_impl.c @@ -112,26 +112,26 @@ typedef struct { #ifdef Add_ -#define psb_dsludist_factor_ psb_dsludist_factor_ -#define psb_dsludist_solve_ psb_dsludist_solve_ -#define psb_dsludist_free_ psb_dsludist_free_ +#define mld_dsludist_factor_ mld_dsludist_factor_ +#define mld_dsludist_solve_ mld_dsludist_solve_ +#define mld_dsludist_free_ mld_dsludist_free_ #endif #ifdef AddDouble_ -#define psb_dsludist_factor_ psb_dsludist_factor__ -#define psb_dsludist_solve_ psb_dsludist_solve__ -#define psb_dsludist_free_ psb_dsludist_free__ +#define mld_dsludist_factor_ mld_dsludist_factor__ +#define mld_dsludist_solve_ mld_dsludist_solve__ +#define mld_dsludist_free_ mld_dsludist_free__ #endif #ifdef NoChange -#define psb_dsludist_factor_ psb_dsludist_factor -#define psb_dsludist_solve_ psb_dsludist_solve -#define psb_dsludist_free_ psb_dsludist_free +#define mld_dsludist_factor_ mld_dsludist_factor +#define mld_dsludist_solve_ mld_dsludist_solve +#define mld_dsludist_free_ mld_dsludist_free #endif 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, #ifdef Have_SLUDist_ fptr *f_factors, /* a handle containing the address @@ -239,7 +239,7 @@ psb_dsludist_factor_(int *n, int *nl, int *nnzl, int *ffstr, void -psb_dsludist_solve_(int *itrans, int *n, int *nrhs, +mld_dsludist_solve_(int *itrans, int *n, int *nrhs, double *b, int *ldb, #ifdef Have_SLUDist_ fptr *f_factors, /* a handle containing the address @@ -322,7 +322,7 @@ psb_dsludist_solve_(int *itrans, int *n, int *nrhs, void -psb_dsludist_free_( +mld_dsludist_free_( #ifdef Have_SLUDist_ fptr *f_factors, /* a handle containing the address pointing to the factored matrices */ diff --git a/mld_umf_impl.c b/mld_umf_impl.c index 902ce1a3..37914bb1 100644 --- a/mld_umf_impl.c +++ b/mld_umf_impl.c @@ -73,19 +73,19 @@ Availability: #ifdef Add_ -#define psb_dumf_factor_ psb_dumf_factor_ -#define psb_dumf_solve_ psb_dumf_solve_ -#define psb_dumf_free_ psb_dumf_free_ +#define mld_dumf_factor_ mld_dumf_factor_ +#define mld_dumf_solve_ mld_dumf_solve_ +#define mld_dumf_free_ mld_dumf_free_ #endif #ifdef AddDouble_ -#define psb_dumf_factor_ psb_dumf_factor__ -#define psb_dumf_solve_ psb_dumf_solve__ -#define psb_dumf_free_ psb_dumf_free__ +#define mld_dumf_factor_ mld_dumf_factor__ +#define mld_dumf_solve_ mld_dumf_solve__ +#define mld_dumf_free_ mld_dumf_free__ #endif #ifdef NoChange -#define psb_dumf_factor_ psb_dumf_factor -#define psb_dumf_solve_ psb_dumf_solve -#define psb_dumf_free_ psb_dumf_free +#define mld_dumf_factor_ mld_dumf_factor +#define mld_dumf_solve_ mld_dumf_solve +#define mld_dumf_free_ mld_dumf_free #endif @@ -101,7 +101,7 @@ typedef int fptr; /* 32-bit by default */ #endif void -psb_dumf_factor_(int *n, int *nnz, +mld_dumf_factor_(int *n, int *nnz, double *values, int *rowind, int *colptr, #ifdef Have_UMF_ fptr *symptr, @@ -163,7 +163,7 @@ psb_dumf_factor_(int *n, int *nnz, void -psb_dumf_solve_(int *itrans, int *n, +mld_dumf_solve_(int *itrans, int *n, double *x, double *b, int *ldb, #ifdef Have_UMF_ fptr *numptr, @@ -204,7 +204,7 @@ psb_dumf_solve_(int *itrans, int *n, void -psb_dumf_free_( +mld_dumf_free_( #ifdef Have_UMF_ fptr *symptr, fptr *numptr, diff --git a/mld_zaggrmap_bld.f90 b/mld_zaggrmap_bld.f90 index 00b81c07..db2e79a4 100644 --- a/mld_zaggrmap_bld.f90 +++ b/mld_zaggrmap_bld.f90 @@ -34,9 +34,9 @@ !!$ 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_prec_mod, mld_protect_name => psb_zgenaggrmap + use psb_prec_mod, mld_protect_name => mld_zaggrmap_bld implicit none 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 info=0 - name = 'psb_zgenaggrmap' + name = 'mld_zaggrmap_bld' call psb_erractionsave(err_act) ! ! 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 allocate(ilaggr(nr),neigh(nr),stat=info) if(info.ne.0) then - info=4000 - call psb_errpush(info,name,a_err=ch_err) + info=4025 + call psb_errpush(info,name,i_err=(/2*nr,0,0,0,0/),& + & a_err='integer') goto 9999 end if @@ -148,8 +149,9 @@ subroutine psb_zgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info) ! allocate(ils(naggr+10),stat=info) if(info.ne.0) then - info=4000 - call psb_errpush(info,name) + info=4025 + call psb_errpush(info,name,i_err=(/naggr+10,0,0,0,0/),& + & a_err='integer') goto 9999 end if @@ -270,8 +272,9 @@ subroutine psb_zgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info) allocate(nlaggr(np),stat=info) if (info/=0) then - info=4000 - call psb_errpush(info,name) + info=4025 + call psb_errpush(info,name,i_err=(/np,0,0,0,0/),& + & a_err='integer') goto 9999 end if @@ -290,4 +293,4 @@ subroutine psb_zgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info) end if return -end subroutine psb_zgenaggrmap +end subroutine mld_zaggrmap_bld diff --git a/mld_zaggrmat_asb.F90 b/mld_zaggrmat_asb.F90 index dccd94e6..1e1e242a 100644 --- a/mld_zaggrmat_asb.F90 +++ b/mld_zaggrmat_asb.F90 @@ -34,9 +34,9 @@ !!$ 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_prec_mod, mld_protect_name => psb_zbldaggrmat + use psb_prec_mod, mld_protect_name => mld_zaggrmat_asb implicit none @@ -48,14 +48,16 @@ subroutine psb_zbldaggrmat(a,desc_a,ac,desc_ac,p,info) integer, intent(out) :: info logical, parameter :: aggr_dump=.false. - integer ::ictxt,np,me, err_act + integer ::ictxt,np,me, err_act,icomm character(len=20) :: name, ch_err - name='psb_zbldaggrmat' + name='mld_zaggrmat_asb' if(psb_get_errstatus().ne.0) return info=0 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) call psb_info(ictxt, me, np) @@ -133,9 +135,10 @@ contains naggr = p%nlaggr(me+1) ntaggr = sum(p%nlaggr) allocate(nzbr(np), idisp(np),stat=info) - 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 end if @@ -350,7 +353,9 @@ contains allocate(nzbr(np), idisp(np),stat=info) 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 end if @@ -387,7 +392,9 @@ contains ! allocate(p%dorig(nrow),stat=info) 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 end if @@ -893,6 +900,7 @@ contains goto 9999 end if + call psb_get_mpicomm(ictxt,icomm) do ip=1,np idisp(ip) = sum(nzbr(1:ip-1)) enddo @@ -956,4 +964,4 @@ contains -end subroutine psb_zbldaggrmat +end subroutine mld_zaggrmat_asb diff --git a/mld_zasmat_bld.f90 b/mld_zasmat_bld.f90 index 6c9322b0..b5cae64b 100644 --- a/mld_zasmat_bld.f90 +++ b/mld_zasmat_bld.f90 @@ -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_prec_mod, mld_protect_name => psb_zasmatbld + use psb_prec_mod, mld_protect_name => mld_zasmat_bld 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. character(len=20) :: name, ch_err - name='psb_zasmatbld' + name='mld_zasmat_bld' if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) If(debug) Write(0,*)'IN DASMATBLD ', upd - ictxt = psb_cd_get_context(desc_data) - icomm = psb_cd_get_mpic(desc_data) - + ictxt=desc_data%matrix_data(psb_ctxt_) Call psb_info(ictxt, me, np) tot_recv=0 @@ -170,6 +168,7 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt) return endif + call psb_get_mpicomm(ictxt,icomm) If(debug)Write(0,*)'BEGIN dasmatbld',me,upd,novr t1 = psb_wtime() @@ -235,5 +234,5 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt) end if Return -End Subroutine psb_zasmatbld +End Subroutine mld_zasmat_bld diff --git a/mld_zbaseprec_aply.f90 b/mld_zbaseprec_aply.f90 index 4f5101b1..6481f6e0 100644 --- a/mld_zbaseprec_aply.f90 +++ b/mld_zbaseprec_aply.f90 @@ -34,13 +34,13 @@ !!$ 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 ! where K is a a basic preconditioner stored in prec ! 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 @@ -61,7 +61,7 @@ subroutine psb_zbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) logical,parameter :: debug=.false., debugprt=.false. character(len=20) :: name, ch_err - name='psb_zbaseprc_aply' + name='mld_zbaseprec_aply' info = 0 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_) - 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 info=4010 - ch_err='psb_bjac_aply' + ch_err='mld_bjac_aply' goto 9999 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 ! 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 info=4010 ch_err='psb_bjacaply' @@ -197,10 +197,10 @@ subroutine psb_zbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) end if 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 info=4010 - ch_err='psb_bjac_aply' + ch_err='mld_bjac_aply' goto 9999 end if @@ -263,5 +263,5 @@ subroutine psb_zbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) end if return -end subroutine psb_zbaseprc_aply +end subroutine mld_zbaseprec_aply diff --git a/mld_zbaseprec_bld.f90 b/mld_zbaseprec_bld.f90 index 20dce0bf..73d6d222 100644 --- a/mld_zbaseprec_bld.f90 +++ b/mld_zbaseprec_bld.f90 @@ -34,10 +34,10 @@ !!$ 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_prec_mod, mld_protect_name => psb_zbaseprc_bld + use psb_prec_mod, mld_protect_name => mld_zbaseprc_bld Implicit None @@ -63,7 +63,7 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd) info=0 err=0 call psb_erractionsave(err_act) - name = 'psb_zbaseprc_bld' + name = 'mld_zbaseprc_bld' if (debug) write(0,*) 'Entering baseprc_bld' info = 0 @@ -110,11 +110,11 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd) case (diag_) - call psb_diagsc_bld(a,desc_a,p,iupd,info) - if(debug) write(0,*)me,': out of psb_diagsc_bld' + call mld_diag_bld(a,desc_a,p,iupd,info) + if(debug) write(0,*)me,': out of mld_diag_bld' if(info /= 0) then info=4010 - ch_err='psb_diagsc_bld' + ch_err='mld_diag_bld' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -137,13 +137,13 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd) p%iprcparm(jac_sweeps_) = 1 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) - call psb_bjac_bld(a,desc_a,p,iupd,info) + call mld_bjac_bld(a,desc_a,p,iupd,info) if(info /= 0) then info=4010 - call psb_errpush(info,name,a_err='psb_bjac_bld') + call psb_errpush(info,name,a_err='mld_bjac_bld') goto 9999 end if @@ -170,5 +170,5 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd) end if return -end subroutine psb_zbaseprc_bld +end subroutine mld_zbaseprc_bld diff --git a/mld_zbjac_aply.f90 b/mld_zbjac_aply.f90 index 91edbf9a..3424508a 100644 --- a/mld_zbjac_aply.f90 +++ b/mld_zbjac_aply.f90 @@ -34,7 +34,7 @@ !!$ 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 ! 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_prec_mod, mld_protect_name => psb_zbjac_aply + use psb_prec_mod, mld_protect_name => mld_zbjac_aply 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. character(len=20) :: name, ch_err - name='psb_zbjac_aply' + name='mld_zbjac_aply' info = 0 call psb_erractionsave(err_act) @@ -90,7 +90,9 @@ subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) else allocate(aux(4*n_col),stat=info) 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 end if @@ -98,7 +100,9 @@ subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) else allocate(ww(n_col),aux(4*n_col),stat=info) 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 end if endif @@ -136,11 +140,11 @@ subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) select case(toupper(trans)) 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') - 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') - 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 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)) 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') - 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') - 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 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)) 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') - 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') - 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 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) 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 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) 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 tx(1:n_row) = ty(1:n_row) 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) 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) if(info /=0) goto 9999 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 return -end subroutine psb_zbjac_aply +end subroutine mld_zbjac_aply diff --git a/mld_zbjac_bld.f90 b/mld_zbjac_bld.f90 index dff519bb..7954f381 100644 --- a/mld_zbjac_bld.f90 +++ b/mld_zbjac_bld.f90 @@ -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_prec_mod, mld_protect_name => psb_zbjac_bld + use psb_prec_mod, mld_protect_name => mld_zbjac_bld implicit none ! @@ -78,7 +78,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info) if(psb_get_errstatus().ne.0) return info=0 - name='psb_zbjac_bld' + name='mld_zbjac_bld' call psb_erractionsave(err_act) ictxt=psb_cd_get_context(desc_a) @@ -107,18 +107,18 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info) 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) - 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) 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 end if 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) @@ -131,10 +131,10 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info) ! 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 - call psb_errpush(4010,name,a_err='psb_sp_renum') + call psb_errpush(4010,name,a_err='mld_sp_renum') goto 9999 end if @@ -182,10 +182,10 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info) goto 9999 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 - call psb_errpush(4010,name,a_err='psb_ilu_bld') + call psb_errpush(4010,name,a_err='mld_ilu_bld') goto 9999 end if @@ -213,7 +213,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info) goto 9999 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 call psb_errpush(4010,name,a_err='slu_bld') goto 9999 @@ -227,7 +227,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info) goto 9999 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 (info /= 0) then 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 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 - call psb_errpush(4010,name,a_err='psb_ilu_bld') + call psb_errpush(4010,name,a_err='mld_ilu_bld') goto 9999 end if @@ -366,7 +366,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info) endif 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 call psb_errpush(4010,name,a_err='slu_bld') goto 9999 @@ -419,7 +419,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info) !!$ nztmp = psb_sp_get_nnzeros(atmp) !!$ 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_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 call psb_errpush(4010,name,a_err='slu_bld') goto 9999 @@ -477,7 +477,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info) goto 9999 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 (info /= 0) then call psb_errpush(4010,name,a_err='umf_bld') @@ -532,6 +532,6 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info) return -end subroutine psb_zbjac_bld +end subroutine mld_zbjac_bld diff --git a/mld_zdiagsc_bld.f90 b/mld_zdiagsc_bld.f90 index bd37d9e0..d364f6ad 100644 --- a/mld_zdiagsc_bld.f90 +++ b/mld_zdiagsc_bld.f90 @@ -34,10 +34,10 @@ !!$ 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_prec_mod, mld_protect_name => psb_zdiagsc_bld + use psb_prec_mod, mld_protect_name => mld_zdiag_bld Implicit None @@ -63,7 +63,7 @@ subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info) info=0 err=0 call psb_erractionsave(err_act) - name = 'psb_zdiagsc_bld' + name = 'mld_zdiag_bld' if (debug) write(0,*) 'Entering diagsc_bld' info = 0 @@ -109,8 +109,9 @@ subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info) if (a%pl(1) /= 0) then allocate(work(n_row),stat=info) if (info /= 0) then - info=4000 - call psb_errpush(info,name) + info=4025 + call psb_errpush(info,name,i_err=(/n_row,0,0,0,0/),& + & a_err='complex(kind(1.d0))') goto 9999 end if 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 return -end subroutine psb_zdiagsc_bld +end subroutine mld_zdiag_bld diff --git a/mld_zilu_bld.f90 b/mld_zilu_bld.f90 index fac0371f..29e11e96 100644 --- a/mld_zilu_bld.f90 +++ b/mld_zilu_bld.f90 @@ -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_prec_mod, mld_protect_name => psb_zilu_bld + use psb_prec_mod, mld_protect_name => mld_zilu_bld implicit none ! @@ -76,7 +76,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info,blck) if(psb_get_errstatus().ne.0) return info=0 - name='psb_zilu_bld' + name='mld_zilu_bld' call psb_erractionsave(err_act) 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. ! 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 info=4010 - ch_err='psb_ilu_fct' + ch_err='mld_ilu_fct' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -205,6 +205,6 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info,blck) return -end subroutine psb_zilu_bld +end subroutine mld_zilu_bld diff --git a/mld_zilu_fct.f90 b/mld_zilu_fct.f90 index 49ced412..d6e1c083 100644 --- a/mld_zilu_fct.f90 +++ b/mld_zilu_fct.f90 @@ -34,7 +34,7 @@ !!$ 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 @@ -55,7 +55,7 @@ subroutine psb_zilu_fct(a,l,u,d,info,blck) type(psb_zspmat_type), pointer :: blck_ character(len=20) :: name, ch_err - name='psb_zilu_fct' + name='mld_zilu_fct' info = 0 call psb_erractionsave(err_act) ! .. Executable Statements .. @@ -82,11 +82,11 @@ subroutine psb_zilu_fct(a,l,u,d,info,blck) blck_%m=0 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) if(info.ne.0) then info=4010 - ch_err='psb_zilu_fctint' + ch_err='mld_zilu_fctint' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -126,7 +126,7 @@ subroutine psb_zilu_fct(a,l,u,d,info,blck) return 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) implicit none @@ -143,7 +143,7 @@ contains integer :: int_err(5) character(len=20) :: name, ch_err - name='psb_zilu_fctint' + name='mld_zilu_fctint' if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) @@ -464,5 +464,5 @@ contains return end if return - end subroutine psb_zilu_fctint -end subroutine psb_zilu_fct + end subroutine mld_zilu_fctint +end subroutine mld_zilu_fct diff --git a/mld_zmlprec_aply.f90 b/mld_zmlprec_aply.f90 index e66c38ef..f3710267 100644 --- a/mld_zmlprec_aply.f90 +++ b/mld_zmlprec_aply.f90 @@ -34,7 +34,7 @@ !!$ 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 ! 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 ! 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 - ! to psb_baseprc_aply. + ! to mld_baseprec_aply. ! ! A bit of description of the baseprecv(:) data structure: ! 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_prec_mod, mld_protect_name => psb_zmlprc_aply + use psb_prec_mod, mld_protect_name => mld_zmlprec_aply 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 type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:) - name='psb_zmlprc_aply' + name='mld_zmlprec_aply' info = 0 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 - 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) 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(:) @@ -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)%ty(max(n_row,n_col)), stat=info) 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 end if @@ -188,8 +197,6 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) ! ! Smoothed aggregation ! - - call psb_halo(mlprec_wrk(ilev-1)%x2l,baseprecv(ilev-1)%base_desc,& & info,work=work) 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 endif - call psb_baseprc_aply(zone,baseprecv(ilev),& + call mld_baseprec_aply(zone,baseprecv(ilev),& & mlprec_wrk(ilev)%x2l,zzero,mlprec_wrk(ilev)%y2l,& & 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) 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 end if @@ -367,7 +376,7 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) 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) 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 - 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) 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), & & mlprec_wrk(1)%tx(nc2l), stat=info) if (info /= 0) then - call psb_errpush(4010,name,a_err='Allocate') - goto 9999 + 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)%y2l(:) = zzero 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,& & baseprecv(1)%base_desc,& & 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),& & mlprec_wrk(ilev)%x2l(nc2l), stat=info) - - 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 end if @@ -510,7 +521,7 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) 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) 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), & & 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)%y2l(:) = zzero mlprec_wrk(1)%tx(:) = 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,& & baseprecv(1)%base_desc,info) call psb_geaxpby(zone,x,zzero,mlprec_wrk(1)%tx,& & 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,& & baseprecv(1)%base_desc,& & 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),& & 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)%y2l(:) = zzero mlprec_wrk(ilev)%tx(:) = 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 ! !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) 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) 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 - 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) 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 subroutine mlprec_wrk_free -end subroutine psb_zmlprc_aply +end subroutine mld_zmlprec_aply diff --git a/mld_zmlprec_bld.f90 b/mld_zmlprec_bld.f90 index 98e6d888..d3aceb46 100644 --- a/mld_zmlprec_bld.f90 +++ b/mld_zmlprec_bld.f90 @@ -34,10 +34,10 @@ !!$ 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_prec_mod, mld_protect_name => psb_zmlprc_bld + use psb_prec_mod, mld_protect_name => mld_zmlprec_bld 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 ! changed in the future. Need to package nlaggr & mlia in a ! 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 info=4010 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 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 info=4010 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(info /= 0) then info=4010 - ch_err='psb_baseprc_bld' + ch_err='mld_baseprc_bld' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -129,7 +129,7 @@ subroutine psb_zmlprc_bld(a,desc_a,p,info) ! ! 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 ! p%av(ac_) and p, as this would violate the Fortran standard ! 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 Return -end subroutine psb_zmlprc_bld +end subroutine mld_zmlprec_bld diff --git a/mld_zprec_aply.f90 b/mld_zprec_aply.f90 index fa8e1c13..eb9052c1 100644 --- a/mld_zprec_aply.f90 +++ b/mld_zprec_aply.f90 @@ -34,10 +34,10 @@ !!$ 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_prec_mod, mld_protect_name => psb_zprc_aply + use psb_prec_mod, mld_protect_name => mld_zprec_aply implicit none @@ -55,7 +55,7 @@ subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans, work) logical,parameter :: debug=.false., debugprt=.false. character(len=20) :: name - name='psb_zprc_aply' + name='mld_zprec_aply' info = 0 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)) allocate(work_(iwsz),stat=info) 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 end if @@ -85,14 +87,14 @@ subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans, work) end if if (size(prec%baseprecv) >1) then 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 - call psb_errpush(4010,name,a_err='psb_zmlprc_aply') + call psb_errpush(4010,name,a_err='mld_zmlprec_aply') goto 9999 end if 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 write(0,*) 'Inconsistent preconditioner: size of baseprecv???' endif @@ -113,7 +115,7 @@ subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans, work) end if return -end subroutine psb_zprc_aply +end subroutine mld_zprec_aply !!$ @@ -152,9 +154,9 @@ end subroutine psb_zprc_aply !!$ 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_prec_mod, mld_protect_name => psb_zprc_aply1 + use psb_prec_mod, mld_protect_name => mld_zprec_aply1 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) 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 end if 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 x(:) = ww(:) deallocate(ww,W1) @@ -205,4 +209,4 @@ subroutine psb_zprc_aply1(prec,x,desc_data,info,trans) return end if return -end subroutine psb_zprc_aply1 +end subroutine mld_zprec_aply1 diff --git a/mld_zslu_bld.f90 b/mld_zslu_bld.f90 index 140b5dfc..8b9436f1 100644 --- a/mld_zslu_bld.f90 +++ b/mld_zslu_bld.f90 @@ -34,9 +34,9 @@ !!$ 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_prec_mod, mld_protect_name => psb_zslu_bld + use psb_prec_mod, mld_protect_name => mld_zslu_bld implicit none @@ -51,7 +51,7 @@ subroutine psb_zslu_bld(a,desc_a,p,info) if(psb_get_errstatus().ne.0) return info=0 - name='psb_zslu_bld' + name='mld_zslu_bld' call psb_erractionsave(err_act) ictxt = psb_cd_get_context(desc_a) @@ -72,7 +72,7 @@ subroutine psb_zslu_bld(a,desc_a,p,info) call psb_barrier(ictxt) 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) if (info /= 0) then @@ -97,5 +97,5 @@ subroutine psb_zslu_bld(a,desc_a,p,info) end if return -end subroutine psb_zslu_bld +end subroutine mld_zslu_bld diff --git a/mld_zslu_impl.c b/mld_zslu_impl.c index 09818515..f14a1ba0 100644 --- a/mld_zslu_impl.c +++ b/mld_zslu_impl.c @@ -111,26 +111,26 @@ typedef struct { #ifdef Add_ -#define psb_zslu_factor_ psb_zslu_factor_ -#define psb_zslu_solve_ psb_zslu_solve_ -#define psb_zslu_free_ psb_zslu_free_ +#define mld_zslu_factor_ mld_zslu_factor_ +#define mld_zslu_solve_ mld_zslu_solve_ +#define mld_zslu_free_ mld_zslu_free_ #endif #ifdef AddDouble_ -#define psb_zslu_factor_ psb_zslu_factor__ -#define psb_zslu_solve_ psb_zslu_solve__ -#define psb_zslu_free_ psb_zslu_free__ +#define mld_zslu_factor_ mld_zslu_factor__ +#define mld_zslu_solve_ mld_zslu_solve__ +#define mld_zslu_free_ mld_zslu_free__ #endif #ifdef NoChange -#define psb_zslu_factor_ psb_zslu_factor -#define psb_zslu_solve_ psb_zslu_solve -#define psb_zslu_free_ psb_zslu_free +#define mld_zslu_factor_ mld_zslu_factor +#define mld_zslu_solve_ mld_zslu_solve +#define mld_zslu_free_ mld_zslu_free #endif void -psb_zslu_factor_(int *n, int *nnz, +mld_zslu_factor_(int *n, int *nnz, #ifdef Have_SLU_ doublecomplex *values, int *colind, int *rowptr, fptr *f_factors, /* a handle containing the address @@ -255,7 +255,7 @@ psb_zslu_factor_(int *n, int *nnz, void -psb_zslu_solve_(int *itrans, int *n, int *nrhs, +mld_zslu_solve_(int *itrans, int *n, int *nrhs, #ifdef Have_SLU_ doublecomplex *b, int *ldb, fptr *f_factors, /* a handle containing the address @@ -327,7 +327,7 @@ psb_zslu_solve_(int *itrans, int *n, int *nrhs, void -psb_zslu_free_( +mld_zslu_free_( #ifdef Have_SLU_ fptr *f_factors, /* a handle containing the address pointing to the factored matrices */ diff --git a/mld_zslud_bld.f90 b/mld_zslud_bld.f90 index 87888eca..cbd3fb4b 100644 --- a/mld_zslud_bld.f90 +++ b/mld_zslud_bld.f90 @@ -34,9 +34,9 @@ !!$ 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_prec_mod, mld_protect_name => psb_zsludist_bld + use psb_prec_mod, mld_protect_name => mld_zsludist_bld implicit none @@ -52,7 +52,7 @@ subroutine psb_zsludist_bld(a,desc_a,p,info) if(psb_get_errstatus().ne.0) return info=0 - name='psb_zslu_bld' + name='mld_zslu_bld' call psb_erractionsave(err_act) ictxt = psb_cd_get_context(desc_a) @@ -96,7 +96,7 @@ subroutine psb_zsludist_bld(a,desc_a,p,info) ip = ip - 1 end do !!$ 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_),& & npr, npc, info) if (info /= 0) then @@ -118,5 +118,5 @@ subroutine psb_zsludist_bld(a,desc_a,p,info) end if return -end subroutine psb_zsludist_bld +end subroutine mld_zsludist_bld diff --git a/mld_zslud_impl.c b/mld_zslud_impl.c index 328eb67a..9c90b8aa 100644 --- a/mld_zslud_impl.c +++ b/mld_zslud_impl.c @@ -112,26 +112,26 @@ typedef struct { #ifdef Add_ -#define psb_zsludist_factor_ psb_zsludist_factor_ -#define psb_zsludist_solve_ psb_zsludist_solve_ -#define psb_zsludist_free_ psb_zsludist_free_ +#define mld_zsludist_factor_ mld_zsludist_factor_ +#define mld_zsludist_solve_ mld_zsludist_solve_ +#define mld_zsludist_free_ mld_zsludist_free_ #endif #ifdef AddDouble_ -#define psb_zsludist_factor_ psb_zsludist_factor__ -#define psb_zsludist_solve_ psb_zsludist_solve__ -#define psb_zsludist_free_ psb_zsludist_free__ +#define mld_zsludist_factor_ mld_zsludist_factor__ +#define mld_zsludist_solve_ mld_zsludist_solve__ +#define mld_zsludist_free_ mld_zsludist_free__ #endif #ifdef NoChange -#define psb_zsludist_factor_ psb_zsludist_factor -#define psb_zsludist_solve_ psb_zsludist_solve -#define psb_zsludist_free_ psb_zsludist_free +#define mld_zsludist_factor_ mld_zsludist_factor +#define mld_zsludist_solve_ mld_zsludist_solve +#define mld_zsludist_free_ mld_zsludist_free #endif 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_ doublecomplex *values, int *rowptr, int *colind, fptr *f_factors, /* a handle containing the address @@ -239,7 +239,7 @@ psb_zsludist_factor_(int *n, int *nl, int *nnzl, int *ffstr, void -psb_zsludist_solve_(int *itrans, int *n, int *nrhs, +mld_zsludist_solve_(int *itrans, int *n, int *nrhs, #ifdef Have_SLUDist_ doublecomplex *b, int *ldb, fptr *f_factors, /* a handle containing the address @@ -323,7 +323,7 @@ psb_zsludist_solve_(int *itrans, int *n, int *nrhs, void -psb_zsludist_free_( +mld_zsludist_free_( #ifdef Have_SLUDist_ fptr *f_factors, /* a handle containing the address pointing to the factored matrices */ diff --git a/mld_zsp_renum.f90 b/mld_zsp_renum.f90 index 30a1a25e..2b70df76 100644 --- a/mld_zsp_renum.f90 +++ b/mld_zsp_renum.f90 @@ -34,9 +34,9 @@ !!$ 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_prec_mod, mld_protect_name => psb_zsp_renum + use psb_prec_mod, mld_protect_name => mld_zsp_renum implicit none @@ -58,7 +58,7 @@ subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info) if (psb_get_errstatus().ne.0) return info=0 - name='psb_zsp_renum' + name='mld_zsp_renum' call psb_erractionsave(err_act) ictxt=psb_cd_get_context(desc_a) @@ -455,4 +455,4 @@ contains end subroutine gps_reduction -end subroutine psb_zsp_renum +end subroutine mld_zsp_renum diff --git a/mld_zumf_bld.f90 b/mld_zumf_bld.f90 index 0a0be9d7..9f06e75e 100644 --- a/mld_zumf_bld.f90 +++ b/mld_zumf_bld.f90 @@ -34,9 +34,9 @@ !!$ 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_prec_mod, mld_protect_name => psb_zumf_bld + use psb_prec_mod, mld_protect_name => mld_zumf_bld implicit none @@ -52,7 +52,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info) character(len=20) :: name, ch_err info=0 - name='psb_zumf_bld' + name='mld_zumf_bld' call psb_erractionsave(err_act) ictxt = desc_A%matrix_data(psb_ctxt_) @@ -75,7 +75,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info) call psb_barrier(ictxt) endif - call psb_zumf_factor(a%m,nzt,& + call mld_zumf_factor(a%m,nzt,& & a%aspk,a%ia1,a%ia2,& & p%iprcparm(umf_symptr_),p%iprcparm(umf_numptr_),info) @@ -102,7 +102,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info) end if return -end subroutine psb_zumf_bld +end subroutine mld_zumf_bld diff --git a/mld_zumf_impl.c b/mld_zumf_impl.c index 22173d9e..b2095f73 100644 --- a/mld_zumf_impl.c +++ b/mld_zumf_impl.c @@ -72,19 +72,19 @@ Availability: #ifdef Add_ -#define psb_zumf_factor_ psb_zumf_factor_ -#define psb_zumf_solve_ psb_zumf_solve_ -#define psb_zumf_free_ psb_zumf_free_ +#define mld_zumf_factor_ mld_zumf_factor_ +#define mld_zumf_solve_ mld_zumf_solve_ +#define mld_zumf_free_ mld_zumf_free_ #endif #ifdef AddDouble_ -#define psb_zumf_factor_ psb_zumf_factor__ -#define psb_zumf_solve_ psb_zumf_solve__ -#define psb_zumf_free_ psb_zumf_free__ +#define mld_zumf_factor_ mld_zumf_factor__ +#define mld_zumf_solve_ mld_zumf_solve__ +#define mld_zumf_free_ mld_zumf_free__ #endif #ifdef NoChange -#define psb_zumf_factor_ psb_zumf_factor -#define psb_zumf_solve_ psb_zumf_solve -#define psb_zumf_free_ psb_zumf_free +#define mld_zumf_factor_ mld_zumf_factor +#define mld_zumf_solve_ mld_zumf_solve +#define mld_zumf_free_ mld_zumf_free #endif @@ -100,7 +100,7 @@ typedef int fptr; /* 32-bit by default */ #endif void -psb_zumf_factor_(int *n, int *nnz, +mld_zumf_factor_(int *n, int *nnz, double *values, int *rowind, int *colptr, #ifdef Have_UMF_ fptr *symptr, @@ -162,7 +162,7 @@ psb_zumf_factor_(int *n, int *nnz, void -psb_zumf_solve_(int *itrans, int *n, +mld_zumf_solve_(int *itrans, int *n, double *x, double *b, int *ldb, #ifdef Have_UMF_ fptr *numptr, @@ -203,7 +203,7 @@ psb_zumf_solve_(int *itrans, int *n, void -psb_zumf_free_( +mld_zumf_free_( #ifdef Have_UMF_ fptr *symptr, fptr *numptr,