Fixed interface changes from serial and sphalo.

stopcriterion
Salvatore Filippone 18 years ago
parent 6e1f6e2779
commit 15f2102d4a

@ -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')

@ -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

@ -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'

@ -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
!------------------------------------------------------------------

@ -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'

@ -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

@ -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')

@ -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

@ -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'

@ -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,7 +282,7 @@ 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
@ -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
!------------------------------------------------------------------

@ -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'

@ -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

Loading…
Cancel
Save