From 15f2102d4a170d39a05372c9f6fae9fe3d292c60 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 28 Sep 2007 15:43:16 +0000 Subject: [PATCH] Fixed interface changes from serial and sphalo. --- mld_daggrmat_smth_asb.F90 | 6 ++++-- mld_dasmat_bld.f90 | 14 ++++++++------ mld_dbaseprec_aply.f90 | 6 ++++-- mld_dbjac_bld.f90 | 19 ++++++------------- mld_ddiagsc_bld.f90 | 2 +- mld_dsp_renum.f90 | 2 +- mld_zaggrmat_smth_asb.F90 | 6 ++++-- mld_zasmat_bld.f90 | 22 +++++++++++++--------- mld_zbaseprec_aply.f90 | 6 ++++-- mld_zbjac_bld.f90 | 24 +++++++++--------------- mld_zdiagsc_bld.f90 | 2 +- mld_zsp_renum.f90 | 2 +- 12 files changed, 56 insertions(+), 55 deletions(-) diff --git a/mld_daggrmat_smth_asb.F90 b/mld_daggrmat_smth_asb.F90 index 261792e6..51f3b95a 100644 --- a/mld_daggrmat_smth_asb.F90 +++ b/mld_daggrmat_smth_asb.F90 @@ -329,7 +329,8 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) ! Now we have to gather the halo of am1, and add it to itself ! to multiply it by A, ! - call psb_sphalo(am1,desc_a,am4,info,clcnv=.false.) + call psb_sphalo(am1,desc_a,am4,info,& + & colcnv=.false.,rowscale=.true.) if(info /= 0) then call psb_errpush(4010,name,a_err='psb_sphalo') @@ -399,7 +400,8 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) if (p%iprcparm(aggr_kind_) == smooth_prol_) then ! am2 = ((i-wDA)Ptilde)^T - call psb_sphalo(am3,desc_a,am4,info,clcnv=.false.) + call psb_sphalo(am3,desc_a,am4,info,& + & colcnv=.false.,rowscale=.true.) if(info /= 0) then call psb_errpush(4010,name,a_err='psb_sphalo') diff --git a/mld_dasmat_bld.f90 b/mld_dasmat_bld.f90 index ea6846cc..21b0978f 100644 --- a/mld_dasmat_bld.f90 +++ b/mld_dasmat_bld.f90 @@ -59,8 +59,8 @@ Subroutine mld_dasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt) ! .. Array Arguments .. integer, intent(in) :: ptype,novr - Type(psb_dspmat_type), Intent(in) :: a - Type(psb_dspmat_type), Intent(inout) :: blk + Type(psb_dspmat_type), Intent(in) :: a + Type(psb_dspmat_type), Intent(inout) :: blk integer, intent(out) :: info Type(psb_desc_type), Intent(inout) :: desc_p Type(psb_desc_type), Intent(in) :: desc_data @@ -132,7 +132,6 @@ Subroutine mld_dasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt) ! ! - if (novr < 0) then info=3 int_err(1)=novr @@ -197,10 +196,12 @@ Subroutine mld_dasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt) if (present(outfmt)) then if(debug) write(0,*) me,': Calling outfmt SPHALO with ',size(blk%ia2) - Call psb_sphalo(a,desc_p,blk,info,outfmt=outfmt,data=psb_comm_ext_) + Call psb_sphalo(a,desc_p,blk,info,& + & outfmt=outfmt,data=psb_comm_ext_,rowscale=.true.) else if(debug) write(0,*) me,': Calling SPHALO with ',size(blk%ia2) - Call psb_sphalo(a,desc_p,blk,info,data=psb_comm_ext_) + Call psb_sphalo(a,desc_p,blk,info,& + & data=psb_comm_ext_,rowscale=.true.) end if @@ -211,7 +212,8 @@ Subroutine mld_dasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt) goto 9999 end if - if (debug) write(0,*) 'After psb_sphalo ',blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_) + if (debug) write(0,*) 'After psb_sphalo ',& + & blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_) t3 = psb_wtime() if (debugprt) then diff --git a/mld_dbaseprec_aply.f90 b/mld_dbaseprec_aply.f90 index 48074e4c..64d3dfa4 100644 --- a/mld_dbaseprec_aply.f90 +++ b/mld_dbaseprec_aply.f90 @@ -193,7 +193,8 @@ subroutine mld_dbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) end if if (prec%iprcparm(sub_ren_)>0) then - call dgelp('N',n_row,1,prec%perm,tx,isz,ww,isz,info) + call psb_gelp('n',prec%perm,tx,info) +!!$ call dgelp('N',n_row,1,prec%perm,tx,isz,ww,isz,info) if(info /=0) then info=4010 ch_err='psb_dgelp' @@ -209,7 +210,8 @@ subroutine mld_dbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) end if if (prec%iprcparm(sub_ren_)>0) then - call dgelp('N',n_row,1,prec%invperm,ty,isz,ww,isz,info) + call psb_gelp('n',prec%invperm,ty,info) +!!$ call dgelp('N',n_row,1,prec%invperm,ty,isz,ww,isz,info) if(info /=0) then info=4010 ch_err='psb_dgelp' diff --git a/mld_dbjac_bld.f90 b/mld_dbjac_bld.f90 index 69ca5051..e588e7ea 100644 --- a/mld_dbjac_bld.f90 +++ b/mld_dbjac_bld.f90 @@ -73,7 +73,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) & n_row, nrow_a,n_col, nhalo, ind, iind integer :: ictxt,np,me character(len=20) :: name, ch_err - character(len=5), parameter :: coofmt='COO' + character(len=5), parameter :: coofmt='COO', csrfmt='CSR' if(psb_get_errstatus().ne.0) return info=0 @@ -110,7 +110,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) & p%iprcparm(prec_type_),p%iprcparm(n_ovr_) if (debug) call psb_barrier(ictxt) call mld_asmat_bld(p%iprcparm(prec_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=csrfmt) if (debugprt) then open(60+me) @@ -281,7 +281,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) & jmin=nrow_a+1,rscale=.false.,cscale=.false.) call psb_sp_clip(blck,atmp,info,& & jmin=nrow_a+1,rscale=.false.,cscale=.false.) - call psb_rwextd(n_row,p%av(ap_nd_),info,b=atmp,rowscale=.false.) + call psb_rwextd(n_row,p%av(ap_nd_),info,b=atmp) call psb_spcnv(p%av(ap_nd_),info,afmt='csr',dupl=psb_dupl_add_) if(info /= 0) then @@ -301,12 +301,6 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) call psb_sp_free(atmp,info) end if - call psb_ipcoo2csr(blck,info,rwshr=.true.) - if(info/=0) then - call psb_errpush(4010,name,a_err='psb_ipcoo2csr') - goto 9999 - end if - call mld_ilu_bld(a,desc_a,p,upd,info,blck=blck) if(info/=0) then @@ -340,7 +334,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) n_row = psb_cd_get_local_rows(p%desc_data) n_col = psb_cd_get_local_cols(p%desc_data) - call psb_rwextd(n_row,atmp,info,b=blck,rowscale=.false.) + call psb_rwextd(n_row,atmp,info,b=blck) if (p%iprcparm(smooth_sweeps_) > 1) then !------------------------------------------------------------------ @@ -390,7 +384,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) n_row = psb_cd_get_local_rows(p%desc_data) n_col = psb_cd_get_local_cols(p%desc_data) - call psb_rwextd(n_row,atmp,info,b=blck,rowscale=.false.) + call psb_rwextd(n_row,atmp,info,b=blck) if (p%iprcparm(smooth_sweeps_) > 1) then !------------------------------------------------------------------ @@ -428,7 +422,6 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) call psb_errpush(4010,name,a_err='psb_sp_free') goto 9999 end if -!!$ case(umf_) @@ -441,7 +434,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) n_row = psb_cd_get_local_rows(p%desc_data) n_col = psb_cd_get_local_cols(p%desc_data) - call psb_rwextd(n_row,atmp,info,b=blck,rowscale=.false.) + call psb_rwextd(n_row,atmp,info,b=blck) if (p%iprcparm(smooth_sweeps_) > 1) then !------------------------------------------------------------------ diff --git a/mld_ddiagsc_bld.f90 b/mld_ddiagsc_bld.f90 index 73e6df0a..d4d5d896 100644 --- a/mld_ddiagsc_bld.f90 +++ b/mld_ddiagsc_bld.f90 @@ -117,7 +117,7 @@ subroutine mld_ddiag_bld(a,desc_a,p,upd,info) & a_err='real(kind(1.d0))') goto 9999 end if - call psb_gelp('n',a%pl,p%d,desc_a,info) + call psb_gelp('n',a%pl,p%d,info) if(info /= 0) then info=4010 ch_err='psb_dgelp' diff --git a/mld_dsp_renum.f90 b/mld_dsp_renum.f90 index 96e4c857..9503be49 100644 --- a/mld_dsp_renum.f90 +++ b/mld_dsp_renum.f90 @@ -74,7 +74,7 @@ subroutine mld_dsp_renum(a,desc_a,blck,p,atmp,info) nztota=psb_sp_get_nnzeros(a) nztotb=psb_sp_get_nnzeros(blck) call psb_spcnv(a,atmp,info,afmt='coo',dupl=psb_dupl_add_) - call psb_rwextd(a%m+blck%m,atmp,info,blck,rowscale=.false.) + call psb_rwextd(a%m+blck%m,atmp,info,blck) if (p%iprcparm(sub_ren_)==renum_glb_) then diff --git a/mld_zaggrmat_smth_asb.F90 b/mld_zaggrmat_smth_asb.F90 index c5d2bb15..f674124b 100644 --- a/mld_zaggrmat_smth_asb.F90 +++ b/mld_zaggrmat_smth_asb.F90 @@ -329,7 +329,8 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) ! Now we have to gather the halo of am1, and add it to itself ! to multiply it by A, ! - call psb_sphalo(am1,desc_a,am4,info,clcnv=.false.) + call psb_sphalo(am1,desc_a,am4,info,& + & colcnv=.false.,rowscale=.true.) if(info /= 0) then call psb_errpush(4010,name,a_err='psb_sphalo') @@ -399,7 +400,8 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) if (p%iprcparm(aggr_kind_) == smooth_prol_) then ! am2 = ((i-wDA)Ptilde)^T - call psb_sphalo(am3,desc_a,am4,info,clcnv=.false.) + call psb_sphalo(am3,desc_a,am4,info,& + & colcnv=.false.,rowscale=.true.) if(info /= 0) then call psb_errpush(4010,name,a_err='psb_sphalo') diff --git a/mld_zasmat_bld.f90 b/mld_zasmat_bld.f90 index 14a0f560..48a9d40b 100644 --- a/mld_zasmat_bld.f90 +++ b/mld_zasmat_bld.f90 @@ -60,8 +60,8 @@ Subroutine mld_zasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt) ! .. Array Arguments .. integer, intent(in) :: ptype,novr - Type(psb_zspmat_type), Intent(in) :: a - Type(psb_zspmat_type), Intent(inout) :: blk + Type(psb_zspmat_type), Intent(in) :: a + Type(psb_zspmat_type), Intent(inout) :: blk integer, intent(out) :: info Type(psb_desc_type), Intent(inout) :: desc_p Type(psb_desc_type), Intent(in) :: desc_data @@ -85,7 +85,9 @@ Subroutine mld_zasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt) call psb_erractionsave(err_act) If(debug) Write(0,*)'IN DASMATBLD ', upd - ictxt=desc_data%matrix_data(psb_ctxt_) + ictxt = psb_cd_get_context(desc_data) + icomm = psb_cd_get_mpic(desc_data) + Call psb_info(ictxt, me, np) tot_recv=0 @@ -151,8 +153,8 @@ Subroutine mld_zasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt) call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - blk%fida='COO' - blk%infoa(psb_nnz_)=0 + blk%fida = 'COO' + blk%infoa(psb_nnz_) = 0 if (debug) write(0,*) 'Calling desccpy' if (upd == 'F') then call psb_cdcpy(desc_data,desc_p,info) @@ -168,7 +170,6 @@ Subroutine mld_zasmat_bld(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() @@ -197,10 +198,12 @@ Subroutine mld_zasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt) if (present(outfmt)) then if(debug) write(0,*) me,': Calling outfmt SPHALO with ',size(blk%ia2) - Call psb_sphalo(a,desc_p,blk,info,outfmt=outfmt,data=psb_comm_ext_) + Call psb_sphalo(a,desc_p,blk,info,& + & outfmt=outfmt,data=psb_comm_ext_,rowscale=.true.) else if(debug) write(0,*) me,': Calling SPHALO with ',size(blk%ia2) - Call psb_sphalo(a,desc_p,blk,info,data=psb_comm_ext_) + Call psb_sphalo(a,desc_p,blk,info,& + & data=psb_comm_ext_,rowscale=.true.) end if @@ -211,7 +214,8 @@ Subroutine mld_zasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt) goto 9999 end if - if (debug) write(0,*) 'After psb_sphalo ',blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_) + if (debug) write(0,*) 'After psb_sphalo ',& + & blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_) t3 = psb_wtime() if (debugprt) then diff --git a/mld_zbaseprec_aply.f90 b/mld_zbaseprec_aply.f90 index fcb66d60..b92a9ea3 100644 --- a/mld_zbaseprec_aply.f90 +++ b/mld_zbaseprec_aply.f90 @@ -189,7 +189,8 @@ subroutine mld_zbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) end if if (prec%iprcparm(sub_ren_)>0) then - call zgelp('N',n_row,1,prec%perm,tx,isz,ww,isz,info) + call psb_gelp('n',prec%perm,tx,info) +!!$ call zgelp('N',n_row,1,prec%perm,tx,isz,ww,isz,info) if(info /=0) then info=4010 ch_err='psb_zgelp' @@ -205,7 +206,8 @@ subroutine mld_zbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) end if if (prec%iprcparm(sub_ren_)>0) then - call zgelp('N',n_row,1,prec%invperm,ty,isz,ww,isz,info) + call psb_gelp('n',prec%invperm,ty,info) +!!$ call zgelp('N',n_row,1,prec%invperm,ty,isz,ww,isz,info) if(info /=0) then info=4010 ch_err='psb_zgelp' diff --git a/mld_zbjac_bld.f90 b/mld_zbjac_bld.f90 index 1a7d42a0..4ad1d370 100644 --- a/mld_zbjac_bld.f90 +++ b/mld_zbjac_bld.f90 @@ -74,7 +74,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) & n_row, nrow_a,n_col, nhalo, ind, iind integer :: ictxt,np,me character(len=20) :: name, ch_err - character(len=5), parameter :: coofmt='COO' + character(len=5), parameter :: coofmt='COO', csrfmt='CSR' if(psb_get_errstatus().ne.0) return info=0 @@ -107,10 +107,11 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) t1= psb_wtime() - if(debug) write(0,*)me,': calling mld_asmat_bld',p%iprcparm(prec_type_),p%iprcparm(n_ovr_) + if(debug) write(0,*)me,': calling mld_asmat_bld',& + & p%iprcparm(prec_type_),p%iprcparm(n_ovr_) if (debug) call psb_barrier(ictxt) call mld_asmat_bld(p%iprcparm(prec_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=csrfmt) if (debugprt) then open(60+me) @@ -281,14 +282,14 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) & jmin=nrow_a+1,rscale=.false.,cscale=.false.) call psb_sp_clip(blck,atmp,info,& & jmin=nrow_a+1,rscale=.false.,cscale=.false.) - call psb_rwextd(n_row,p%av(ap_nd_),info,b=atmp,rowscale=.false.) + call psb_rwextd(n_row,p%av(ap_nd_),info,b=atmp) call psb_spcnv(p%av(ap_nd_),info,afmt='csr',dupl=psb_dupl_add_) if(info /= 0) then call psb_errpush(4010,name,a_err='psb_spcnv csr 4') goto 9999 end if - + k = psb_sp_get_nnzeros(p%av(ap_nd_)) call psb_sum(ictxt,k) @@ -301,12 +302,6 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) call psb_sp_free(atmp,info) end if - call psb_ipcoo2csr(blck,info,rwshr=.true.) - if(info/=0) then - call psb_errpush(4010,name,a_err='psb_ipcoo2csr') - goto 9999 - end if - call mld_ilu_bld(a,desc_a,p,upd,info,blck=blck) if(info/=0) then @@ -340,7 +335,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) n_row = psb_cd_get_local_rows(p%desc_data) n_col = psb_cd_get_local_cols(p%desc_data) - call psb_rwextd(n_row,atmp,info,b=blck,rowscale=.false.) + call psb_rwextd(n_row,atmp,info,b=blck) if (p%iprcparm(smooth_sweeps_) > 1) then !------------------------------------------------------------------ @@ -390,7 +385,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) n_row = psb_cd_get_local_rows(p%desc_data) n_col = psb_cd_get_local_cols(p%desc_data) - call psb_rwextd(n_row,atmp,info,b=blck,rowscale=.false.) + call psb_rwextd(n_row,atmp,info,b=blck) if (p%iprcparm(smooth_sweeps_) > 1) then !------------------------------------------------------------------ @@ -428,7 +423,6 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) call psb_errpush(4010,name,a_err='psb_sp_free') goto 9999 end if -!!$ case(umf_) @@ -441,7 +435,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) n_row = psb_cd_get_local_rows(p%desc_data) n_col = psb_cd_get_local_cols(p%desc_data) - call psb_rwextd(n_row,atmp,info,b=blck,rowscale=.false.) + call psb_rwextd(n_row,atmp,info,b=blck) if (p%iprcparm(smooth_sweeps_) > 1) then !------------------------------------------------------------------ diff --git a/mld_zdiagsc_bld.f90 b/mld_zdiagsc_bld.f90 index ecb5521f..628f75a8 100644 --- a/mld_zdiagsc_bld.f90 +++ b/mld_zdiagsc_bld.f90 @@ -114,7 +114,7 @@ subroutine mld_zdiag_bld(a,desc_a,p,upd,info) & a_err='complex(kind(1.d0))') goto 9999 end if - call psb_gelp('n',a%pl,p%d,desc_a,info) + call psb_gelp('n',a%pl,p%d,info) if(info /= 0) then info=4010 ch_err='psb_zgelp' diff --git a/mld_zsp_renum.f90 b/mld_zsp_renum.f90 index 7e9c0db8..c1f8ca45 100644 --- a/mld_zsp_renum.f90 +++ b/mld_zsp_renum.f90 @@ -74,7 +74,7 @@ subroutine mld_zsp_renum(a,desc_a,blck,p,atmp,info) nztota=psb_sp_get_nnzeros(a) nztotb=psb_sp_get_nnzeros(blck) call psb_spcnv(a,atmp,info,afmt='coo',dupl=psb_dupl_add_) - call psb_rwextd(a%m+blck%m,atmp,info,blck,rowscale=.false.) + call psb_rwextd(a%m+blck%m,atmp,info,blck) if (p%iprcparm(sub_ren_)==renum_glb_) then