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

Call psb_get_mpicomm ONLY in CDALL; afterwards, always get it from DESC.

Browse Source
stopcriterion
Salvatore Filippone 18 years ago
parent 206b19c1fc
commit 41b1ee0e1d
12 changed files with 46 additions and 99 deletions
Show Stats Download Patch File Download Diff File

4
Makefile
Unescape Escape View File

@ -12,13 +12,13 @@ MPFOBJS=psb_dbldaggrmat.o psb_zbldaggrmat.o
MPCOBJS=psb_slud_impl.o psb_zslud_impl.o
F90OBJS=psb_dasmatbld.o psb_dslu_bld.o psb_dumf_bld.o psb_dilu_fct.o\
psb_dmlprc_bld.o psb_dsp_renum.o psb_dbjac_bld.o psb_dilu_bld.o \
psb_dprecbld.o psb_dprecfree.o psb_dprecset.o \
psb_dprecbld.o psb_dprecfree.o psb_dprecinit.o psb_dprecset.o \
psb_dbaseprc_bld.o psb_ddiagsc_bld.o psb_dgenaggrmap.o \
psb_dprc_aply.o psb_dmlprc_aply.o psb_dslud_bld.o\
psb_dbaseprc_aply.o psb_dbjac_aply.o\
psb_zasmatbld.o psb_zslu_bld.o psb_zumf_bld.o psb_zilu_fct.o\
psb_zmlprc_bld.o psb_zsp_renum.o psb_zbjac_bld.o psb_zilu_bld.o \
psb_zprecbld.o psb_zprecfree.o psb_zprecset.o \
psb_zprecbld.o psb_zprecfree.o psb_zprecinit.o psb_zprecset.o \
psb_zbaseprc_bld.o psb_zdiagsc_bld.o psb_zgenaggrmap.o \
psb_zprc_aply.o psb_zmlprc_aply.o psb_zslud_bld.o\
psb_zbaseprc_aply.o psb_zbjac_aply.o\

5
psb_dasmatbld.f90
Unescape Escape View File

@ -84,7 +84,9 @@ Subroutine psb_dasmatbld(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_a)
icomm = psb_cd_get_mpic(desc_a)
Call psb_info(ictxt, me, np)
tot_recv=0
@ -167,7 +169,6 @@ Subroutine psb_dasmatbld(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()

5
psb_dbldaggrmat.F90
Unescape Escape View File

@ -125,6 +125,7 @@ contains
call psb_nullify_sp(b)
ictxt = psb_cd_get_context(desc_a)
icomm = psb_cd_get_mpic(desc_a)
call psb_info(ictxt, me, np)
nglob = psb_cd_get_global_rows(desc_a)
nrow = psb_cd_get_local_rows(desc_a)
@ -216,7 +217,6 @@ contains
goto 9999
end if
call psb_get_mpicomm(ictxt,icomm)
do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1))
enddo
@ -358,6 +358,7 @@ contains
call psb_erractionsave(err_act)
ictxt = psb_cd_get_context(desc_a)
icomm = psb_cd_get_mpic(desc_a)
call psb_info(ictxt, me, np)
@ -877,7 +878,6 @@ contains
if(info /= 0) goto 9999
call psb_get_mpicomm(ictxt,icomm)
do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1))
enddo
@ -962,7 +962,6 @@ contains
goto 9999
end if
call psb_get_mpicomm(ictxt,icomm)
do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1))
enddo

28
psb_dmlprc_aply.f90
Unescape Escape View File

@ -104,7 +104,7 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
real(kind(1.d0)) :: omega
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7
logical, parameter :: debug=.false., debugprt=.false.
integer :: ismth, nlev, ilev, icm, igs
integer :: ismth, nlev, ilev, icm
character(len=20) :: name, ch_err
type psb_mlprec_wrk_type
@ -183,21 +183,14 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
mlprec_wrk(ilev)%ty(:) = dzero
ismth = baseprecv(ilev)%iprcparm(smth_kind_)
igs = baseprecv(ilev)%iprcparm(glb_smth_)
icm = baseprecv(ilev)%iprcparm(coarse_mat_)
if (ismth /= no_smth_) then
!
! Smoothed aggregation
!
if (igs > 0) then
call psb_halo(mlprec_wrk(ilev-1)%x2l,baseprecv(ilev-1)%base_desc,&
& info,work=work)
if(info /=0) goto 9999
else
mlprec_wrk(ilev-1)%x2l(n_row+1:max(n_row,n_col)) = dzero
end if
call psb_csmm(done,baseprecv(ilev)%av(sm_pr_t_),mlprec_wrk(ilev-1)%x2l,&
& dzero,mlprec_wrk(ilev)%x2l,info)
@ -234,7 +227,6 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
ismth = baseprecv(ilev)%iprcparm(smth_kind_)
igs = baseprecv(ilev)%iprcparm(glb_smth_)
icm = baseprecv(ilev)%iprcparm(coarse_mat_)
if (ismth /= no_smth_) then
@ -311,7 +303,6 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
ismth = baseprecv(ilev)%iprcparm(smth_kind_)
igs = baseprecv(ilev)%iprcparm(glb_smth_)
icm = baseprecv(ilev)%iprcparm(coarse_mat_)
if (debug) write(0,*) me, 'mlpr_aply starting up sweep ',&
@ -333,15 +324,12 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
! Smoothed aggregation
!
if (igs >0) then
if (debug) write(0,*) me, 'mlpr_aply halo in up sweep ', ilev
call psb_halo(mlprec_wrk(ilev-1)%x2l,&
& baseprecv(ilev-1)%base_desc,info,work=work)
if(info /=0) goto 9999
else
mlprec_wrk(ilev-1)%x2l(n_row+1:max(n_row,n_col)) = dzero
end if
if (debug) write(0,*) me, 'mlpr_aply csmm in up sweep ', ilev
call psb_csmm(done,baseprecv(ilev)%av(sm_pr_t_),mlprec_wrk(ilev-1)%x2l, &
& dzero,mlprec_wrk(ilev)%x2l,info)
@ -482,7 +470,6 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
ismth = baseprecv(ilev)%iprcparm(smth_kind_)
igs = baseprecv(ilev)%iprcparm(glb_smth_)
icm = baseprecv(ilev)%iprcparm(coarse_mat_)
allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),&
@ -503,14 +490,9 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
!Smoothed Aggregation
!
if (igs > 0) then
call psb_halo(mlprec_wrk(ilev-1)%tx,baseprecv(ilev-1)%base_desc,&
& info,work=work)
if(info /=0) goto 9999
else
mlprec_wrk(ilev-1)%tx(n_row+1:max(n_row,n_col)) = dzero
end if
call psb_csmm(done,baseprecv(ilev)%av(sm_pr_t_),mlprec_wrk(ilev-1)%tx,dzero,&
& mlprec_wrk(ilev)%x2l,info)
@ -642,7 +624,6 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
ismth = baseprecv(ilev)%iprcparm(smth_kind_)
igs = baseprecv(ilev)%iprcparm(glb_smth_)
icm = baseprecv(ilev)%iprcparm(coarse_mat_)
allocate(mlprec_wrk(ilev)%ty(nc2l),mlprec_wrk(ilev)%y2l(nc2l),&
& mlprec_wrk(ilev)%x2l(nc2l), stat=info)
@ -663,14 +644,9 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
!Smoothed Aggregation
!
if (igs > 0) then
call psb_halo(mlprec_wrk(ilev-1)%ty,baseprecv(ilev-1)%base_desc,&
& info,work=work)
if(info /=0) goto 9999
else
mlprec_wrk(ilev-1)%ty(n_row+1:max(n_row,n_col)) = dzero
end if
call psb_csmm(done,baseprecv(ilev)%av(sm_pr_t_),mlprec_wrk(ilev-1)%ty,dzero,&
& mlprec_wrk(ilev)%x2l,info)

2
psb_dprecinit.f90
Unescape Escape View File

@ -161,7 +161,6 @@ subroutine psb_dprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(smth_kind_) = smth_omg_
p%baseprecv(ilev_)%iprcparm(coarse_mat_) = mat_distr_
p%baseprecv(ilev_)%iprcparm(smth_pos_) = post_smooth_
p%baseprecv(ilev_)%iprcparm(glb_smth_) = 1
p%baseprecv(ilev_)%iprcparm(om_choice_) = lib_choice_
p%baseprecv(ilev_)%iprcparm(f_type_) = f_ilu_n_
p%baseprecv(ilev_)%iprcparm(ilu_fill_in_) = 0
@ -182,7 +181,6 @@ subroutine psb_dprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(smth_kind_) = smth_omg_
p%baseprecv(ilev_)%iprcparm(coarse_mat_) = mat_distr_
p%baseprecv(ilev_)%iprcparm(smth_pos_) = post_smooth_
p%baseprecv(ilev_)%iprcparm(glb_smth_) = 1
p%baseprecv(ilev_)%iprcparm(om_choice_) = lib_choice_
p%baseprecv(ilev_)%iprcparm(f_type_) = f_umf_
p%baseprecv(ilev_)%iprcparm(ilu_fill_in_) = 0

3
psb_dprecset.f90
Unescape Escape View File

@ -87,8 +87,7 @@ subroutine psb_dprecseti(p,what,val,info,ilev)
else if (ilev_ > 1) then
select case(what)
case(p_type_,f_type_,restr_,prol_,iren_,n_ovr_,ilu_fill_in_,jac_sweeps_,&
& ml_type_,aggr_alg_,smth_kind_,coarse_mat_,smth_pos_,glb_smth_,&
& om_choice_)
& ml_type_,aggr_alg_,smth_kind_,coarse_mat_,smth_pos_,om_choice_)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'

2
psb_prec_type.f90
Unescape Escape View File

@ -68,7 +68,7 @@ module psb_prec_type
integer, parameter :: iren_=5, n_ovr_=6
integer, parameter :: ilu_fill_in_=8, jac_sweeps_=9, ml_type_=10
integer, parameter :: smth_pos_=11, aggr_alg_=12, smth_kind_=13
integer, parameter :: om_choice_=14, glb_smth_=15, coarse_mat_=16
integer, parameter :: om_choice_=14, coarse_mat_=16
!! 2 ints for 64 bit versions
integer, parameter :: slu_ptr_=17, umf_symptr_=17, umf_numptr_=19
integer, parameter :: slud_ptr_=21

5
psb_zasmatbld.f90
Unescape Escape View File

@ -85,7 +85,9 @@ Subroutine psb_zasmatbld(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_a)
icomm = psb_cd_get_mpic(desc_a)
Call psb_info(ictxt, me, np)
tot_recv=0
@ -168,7 +170,6 @@ 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()

5
psb_zbldaggrmat.F90
Unescape Escape View File

@ -124,6 +124,7 @@ contains
call psb_nullify_sp(b)
ictxt = psb_cd_get_context(desc_a)
icomm = psb_cd_get_mpic(desc_a)
call psb_info(ictxt, me, np)
nglob = psb_cd_get_global_rows(desc_a)
nrow = psb_cd_get_local_rows(desc_a)
@ -215,7 +216,6 @@ contains
goto 9999
end if
call psb_get_mpicomm(ictxt,icomm)
do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1))
enddo
@ -357,6 +357,7 @@ contains
call psb_erractionsave(err_act)
ictxt = psb_cd_get_context(desc_a)
icomm = psb_cd_get_mpic(desc_a)
call psb_info(ictxt, me, np)
@ -876,7 +877,6 @@ contains
if(info /= 0) goto 9999
call psb_get_mpicomm(ictxt,icomm)
do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1))
enddo
@ -959,7 +959,6 @@ contains
goto 9999
end if
call psb_get_mpicomm(ictxt,icomm)
do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1))
enddo

25
psb_zmlprc_aply.f90
Unescape Escape View File

@ -104,7 +104,7 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
real(kind(1.d0)) :: omega
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7
logical, parameter :: debug=.false., debugprt=.false.
integer :: ismth, nlev, ilev, icm, igs
integer :: ismth, nlev, ilev, icm
character(len=20) :: name, ch_err
type psb_mlprec_wrk_type
@ -183,7 +183,6 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
ismth = baseprecv(ilev)%iprcparm(smth_kind_)
igs = baseprecv(ilev)%iprcparm(glb_smth_)
icm = baseprecv(ilev)%iprcparm(coarse_mat_)
if (ismth /= no_smth_) then
!
@ -191,13 +190,9 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
if (igs > 0) then
call psb_halo(mlprec_wrk(ilev-1)%x2l,baseprecv(ilev-1)%base_desc,&
& info,work=work)
if(info /=0) goto 9999
else
mlprec_wrk(ilev-1)%x2l(n_row+1:max(n_row,n_col)) = zzero
end if
call psb_csmm(zone,baseprecv(ilev)%av(sm_pr_t_),mlprec_wrk(ilev-1)%x2l,&
& zzero,mlprec_wrk(ilev)%x2l,info)
@ -234,7 +229,6 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
ismth = baseprecv(ilev)%iprcparm(smth_kind_)
igs = baseprecv(ilev)%iprcparm(glb_smth_)
icm = baseprecv(ilev)%iprcparm(coarse_mat_)
if (ismth /= no_smth_) then
@ -310,7 +304,6 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
ismth = baseprecv(ilev)%iprcparm(smth_kind_)
igs = baseprecv(ilev)%iprcparm(glb_smth_)
icm = baseprecv(ilev)%iprcparm(coarse_mat_)
if (debug) write(0,*) me, 'mlpr_aply starting up sweep ',&
@ -332,15 +325,11 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
! Smoothed aggregation
!
if (igs >0) then
if (debug) write(0,*) me, 'mlpr_aply halo in up sweep ', ilev
call psb_halo(mlprec_wrk(ilev-1)%x2l,&
& baseprecv(ilev-1)%base_desc,info,work=work)
if(info /=0) goto 9999
else
mlprec_wrk(ilev-1)%x2l(n_row+1:max(n_row,n_col)) = zzero
end if
call psb_csmm(zone,baseprecv(ilev)%av(sm_pr_t_),mlprec_wrk(ilev-1)%x2l, &
& zzero,mlprec_wrk(ilev)%x2l,info)
@ -474,7 +463,6 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
ismth = baseprecv(ilev)%iprcparm(smth_kind_)
igs = baseprecv(ilev)%iprcparm(glb_smth_)
icm = baseprecv(ilev)%iprcparm(coarse_mat_)
allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),&
@ -495,14 +483,9 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
!Smoothed Aggregation
!
if (igs > 0) then
call psb_halo(mlprec_wrk(ilev-1)%tx,baseprecv(ilev-1)%base_desc,&
& info,work=work)
if(info /=0) goto 9999
else
mlprec_wrk(ilev-1)%tx(n_row+1:max(n_row,n_col)) = zzero
end if
call psb_csmm(zone,baseprecv(ilev)%av(sm_pr_t_),mlprec_wrk(ilev-1)%tx,zzero,&
& mlprec_wrk(ilev)%x2l,info)
@ -634,7 +617,6 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
ismth = baseprecv(ilev)%iprcparm(smth_kind_)
igs = baseprecv(ilev)%iprcparm(glb_smth_)
icm = baseprecv(ilev)%iprcparm(coarse_mat_)
allocate(mlprec_wrk(ilev)%ty(nc2l),mlprec_wrk(ilev)%y2l(nc2l),&
& mlprec_wrk(ilev)%x2l(nc2l), stat=info)
@ -655,14 +637,9 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
!Smoothed Aggregation
!
if (igs > 0) then
call psb_halo(mlprec_wrk(ilev-1)%ty,baseprecv(ilev-1)%base_desc,&
& info,work=work)
if(info /=0) goto 9999
else
mlprec_wrk(ilev-1)%ty(n_row+1:max(n_row,n_col)) = zzero
end if
call psb_csmm(zone,baseprecv(ilev)%av(sm_pr_t_),mlprec_wrk(ilev-1)%ty,zzero,&
& mlprec_wrk(ilev)%x2l,info)

2
psb_zprecinit.f90
Unescape Escape View File

@ -161,7 +161,6 @@ subroutine psb_zprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(smth_kind_) = smth_omg_
p%baseprecv(ilev_)%iprcparm(coarse_mat_) = mat_distr_
p%baseprecv(ilev_)%iprcparm(smth_pos_) = post_smooth_
p%baseprecv(ilev_)%iprcparm(glb_smth_) = 1
p%baseprecv(ilev_)%iprcparm(om_choice_) = lib_choice_
p%baseprecv(ilev_)%iprcparm(f_type_) = f_ilu_n_
p%baseprecv(ilev_)%iprcparm(ilu_fill_in_) = 0
@ -182,7 +181,6 @@ subroutine psb_zprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(smth_kind_) = smth_omg_
p%baseprecv(ilev_)%iprcparm(coarse_mat_) = mat_distr_
p%baseprecv(ilev_)%iprcparm(smth_pos_) = post_smooth_
p%baseprecv(ilev_)%iprcparm(glb_smth_) = 1
p%baseprecv(ilev_)%iprcparm(om_choice_) = lib_choice_
p%baseprecv(ilev_)%iprcparm(f_type_) = f_umf_
p%baseprecv(ilev_)%iprcparm(ilu_fill_in_) = 0

3
psb_zprecset.f90
Unescape Escape View File

@ -87,8 +87,7 @@ subroutine psb_zprecseti(p,what,val,info,ilev)
else if (ilev_ > 1) then
select case(what)
case(p_type_,f_type_,restr_,prol_,iren_,n_ovr_,ilu_fill_in_,jac_sweeps_,&
& ml_type_,aggr_alg_,smth_kind_,coarse_mat_,smth_pos_,glb_smth_,&
& om_choice_)
& ml_type_,aggr_alg_,smth_kind_,coarse_mat_,smth_pos_,om_choice_)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'

Write Preview
Loading…
Cancel
Save