fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 14:44:55 +00:00
Code Issues Packages Projects Releases Wiki Activity

Fixed interface changes from serial and sphalo.

Browse Source
This commit is contained in:
Salvatore Filippone
2007-09-28 15:43:16 +00:00
parent 6e1f6e2779
commit 15f2102d4a
12 changed files with 56 additions and 55 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mld_daggrmat_smth_asb.F90
+4 -2
View File
@@ -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')
mld_dasmat_bld.f90
+8 -6
View File
@@ -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
mld_dbaseprec_aply.f90
+4 -2
View File
@@ -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'
mld_dbjac_bld.f90
+6 -13
View File
@@ -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
!------------------------------------------------------------------
mld_ddiagsc_bld.f90
+1 -1
View File
@@ -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'
mld_dsp_renum.f90
+1 -1
View File
@@ -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
mld_zaggrmat_smth_asb.F90
+4 -2
View File
@@ -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')
mld_zasmat_bld.f90
+13 -9
View File
@@ -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
mld_zbaseprec_aply.f90
+4 -2
View File
@@ -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'
mld_zbjac_bld.f90
+9 -15
View File
@@ -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
!------------------------------------------------------------------
mld_zdiagsc_bld.f90
+1 -1
View File
@@ -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'
mld_zsp_renum.f90
+1 -1
View File
@@ -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