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

mld2p4-2:

Browse Source 
Makefile
 mld_cmlprec_aply.f90
 mld_dmlprec_aply.f90
 mld_smlprec_aply.f90
 mld_zmlprec_aply.f90
 mld_zslud_bld.f90

Further advance on double complex.
stopcriterion
Salvatore Filippone 14 years ago
parent 84aa2586bc
commit 675993666f
6 changed files with 725 additions and 1170 deletions
Show Stats Download Patch File Download Diff File

1
mlprec/Makefile
Unescape Escape View File

@ -29,6 +29,7 @@ INNEROBJS= mld_dcoarse_bld.o mld_dmlprec_bld.o mld_dslu_bld.o mld_dumf_bld.o \
mld_cmlprec_aply.o mld_cslud_bld.o mld_caggrmat_asb.o \ mld_cmlprec_aply.o mld_cslud_bld.o mld_caggrmat_asb.o \
mld_zcoarse_bld.o mld_zmlprec_bld.o mld_zslu_bld.o mld_zumf_bld.o \ mld_zcoarse_bld.o mld_zmlprec_bld.o mld_zslu_bld.o mld_zumf_bld.o \
mld_zilu0_fact.o mld_ziluk_fact.o mld_zilut_fact.o mld_zaggrmap_bld.o \ mld_zilu0_fact.o mld_ziluk_fact.o mld_zilut_fact.o mld_zaggrmap_bld.o \
mld_zmlprec_aply.o mld_zslud_bld.o mld_zaggrmat_asb.o \
$(MPFOBJS) $(MPFOBJS)
# #

39
mlprec/mld_cmlprec_aply.f90
Unescape Escape View File

@ -357,7 +357,8 @@ subroutine mld_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
nlev = size(p%precv) nlev = size(p%precv)
allocate(mlprec_wrk(nlev),stat=info) allocate(mlprec_wrk(nlev),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='Allocate')
goto 9999 goto 9999
end if end if
level = 1 level = 1
@ -379,7 +380,8 @@ subroutine mld_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
call inner_ml_aply(level,p,mlprec_wrk,trans_,work,info) call inner_ml_aply(level,p,mlprec_wrk,trans_,work,info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Inner prec aply') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Inner prec aply')
goto 9999 goto 9999
end if end if
@ -387,7 +389,8 @@ subroutine mld_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
& p%precv(level)%base_desc,info) & p%precv(level)%base_desc,info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error final update') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error final update')
goto 9999 goto 9999
end if end if
@ -432,7 +435,8 @@ contains
nlev = size(p%precv) nlev = size(p%precv)
if ((level < 1) .or. (level > nlev)) then if ((level < 1) .or. (level > nlev)) then
call psb_errpush(psb_err_internal_error_,name,a_err='wrong call level to inner_ml') call psb_errpush(psb_err_internal_error_,name,&
& a_err='wrong call level to inner_ml')
goto 9999 goto 9999
end if end if
ictxt = psb_cd_get_context(p%precv(level)%base_desc) ictxt = psb_cd_get_context(p%precv(level)%base_desc)
@ -459,7 +463,8 @@ contains
! No preconditioning, should not really get here ! No preconditioning, should not really get here
! !
write(0,*) 'MLD_NO_ML_ in inner_ml ',level write(0,*) 'MLD_NO_ML_ in inner_ml ',level
call psb_errpush(psb_err_internal_error_,name,a_err='mld_no_ml_ in mlprc_aply?') call psb_errpush(psb_err_internal_error_,name,&
& a_err='mld_no_ml_ in mlprc_aply?')
goto 9999 goto 9999
case(mld_add_ml_) case(mld_add_ml_)
@ -474,7 +479,8 @@ contains
& p%precv(level)%map,info,work=work) & p%precv(level)%map,info,work=work)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
@ -523,7 +529,8 @@ contains
& p%precv(level)%map,info,work=work) & p%precv(level)%map,info,work=work)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
end if end if
@ -574,7 +581,8 @@ contains
& p%precv(level)%map,info,work=work) & p%precv(level)%map,info,work=work)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
@ -634,7 +642,8 @@ contains
& p%precv(level)%map,info,work=work) & p%precv(level)%map,info,work=work)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
@ -686,7 +695,8 @@ contains
& p%precv(level)%map,info,work=work) & p%precv(level)%map,info,work=work)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
@ -748,7 +758,8 @@ contains
& p%precv(level)%map,info,work=work) & p%precv(level)%map,info,work=work)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
end if end if
@ -791,7 +802,8 @@ contains
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_ ) then if (info /= psb_success_ ) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
@ -814,7 +826,8 @@ contains
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&
& sweeps,work,info) & sweeps,work,info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error: residual/baseprec_aply') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error: residual/baseprec_aply')
goto 9999 goto 9999
end if end if

36
mlprec/mld_dmlprec_aply.f90
Unescape Escape View File

@ -379,7 +379,8 @@ subroutine mld_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
call inner_ml_aply(level,p,mlprec_wrk,trans_,work,info) call inner_ml_aply(level,p,mlprec_wrk,trans_,work,info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Inner prec aply') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Inner prec aply')
goto 9999 goto 9999
end if end if
@ -387,7 +388,8 @@ subroutine mld_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
& p%precv(level)%base_desc,info) & p%precv(level)%base_desc,info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error final update') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error final update')
goto 9999 goto 9999
end if end if
@ -432,7 +434,8 @@ contains
nlev = size(p%precv) nlev = size(p%precv)
if ((level < 1) .or. (level > nlev)) then if ((level < 1) .or. (level > nlev)) then
call psb_errpush(psb_err_internal_error_,name,a_err='wrong call level to inner_ml') call psb_errpush(psb_err_internal_error_,name,&
& a_err='wrong call level to inner_ml')
goto 9999 goto 9999
end if end if
ictxt = psb_cd_get_context(p%precv(level)%base_desc) ictxt = psb_cd_get_context(p%precv(level)%base_desc)
@ -459,7 +462,8 @@ contains
! No preconditioning, should not really get here ! No preconditioning, should not really get here
! !
write(0,*) 'MLD_NO_ML_ in inner_ml ',level write(0,*) 'MLD_NO_ML_ in inner_ml ',level
call psb_errpush(psb_err_internal_error_,name,a_err='mld_no_ml_ in mlprc_aply?') call psb_errpush(psb_err_internal_error_,name,&
& a_err='mld_no_ml_ in mlprc_aply?')
goto 9999 goto 9999
case(mld_add_ml_) case(mld_add_ml_)
@ -474,7 +478,8 @@ contains
& p%precv(level)%map,info,work=work) & p%precv(level)%map,info,work=work)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
@ -524,7 +529,8 @@ contains
& p%precv(level)%map,info,work=work) & p%precv(level)%map,info,work=work)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
end if end if
@ -575,7 +581,8 @@ contains
& p%precv(level)%map,info,work=work) & p%precv(level)%map,info,work=work)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
@ -635,7 +642,8 @@ contains
& p%precv(level)%map,info,work=work) & p%precv(level)%map,info,work=work)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
@ -687,7 +695,8 @@ contains
& p%precv(level)%map,info,work=work) & p%precv(level)%map,info,work=work)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
@ -749,7 +758,8 @@ contains
& p%precv(level)%map,info,work=work) & p%precv(level)%map,info,work=work)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
end if end if
@ -792,7 +802,8 @@ contains
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_ ) then if (info /= psb_success_ ) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
@ -815,7 +826,8 @@ contains
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&
& sweeps,work,info) & sweeps,work,info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error: residual/baseprec_aply') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error: residual/baseprec_aply')
goto 9999 goto 9999
end if end if

36
mlprec/mld_smlprec_aply.f90
Unescape Escape View File

@ -379,7 +379,8 @@ subroutine mld_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
call inner_ml_aply(level,p,mlprec_wrk,trans_,work,info) call inner_ml_aply(level,p,mlprec_wrk,trans_,work,info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Inner prec aply') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Inner prec aply')
goto 9999 goto 9999
end if end if
@ -387,7 +388,8 @@ subroutine mld_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
& p%precv(level)%base_desc,info) & p%precv(level)%base_desc,info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error final update') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error final update')
goto 9999 goto 9999
end if end if
@ -432,7 +434,8 @@ contains
nlev = size(p%precv) nlev = size(p%precv)
if ((level < 1) .or. (level > nlev)) then if ((level < 1) .or. (level > nlev)) then
call psb_errpush(psb_err_internal_error_,name,a_err='wrong call level to inner_ml') call psb_errpush(psb_err_internal_error_,name,&
& a_err='wrong call level to inner_ml')
goto 9999 goto 9999
end if end if
ictxt = psb_cd_get_context(p%precv(level)%base_desc) ictxt = psb_cd_get_context(p%precv(level)%base_desc)
@ -459,7 +462,8 @@ contains
! No preconditioning, should not really get here ! No preconditioning, should not really get here
! !
write(0,*) 'MLD_NO_ML_ in inner_ml ',level write(0,*) 'MLD_NO_ML_ in inner_ml ',level
call psb_errpush(psb_err_internal_error_,name,a_err='mld_no_ml_ in mlprc_aply?') call psb_errpush(psb_err_internal_error_,name,&
& a_err='mld_no_ml_ in mlprc_aply?')
goto 9999 goto 9999
case(mld_add_ml_) case(mld_add_ml_)
@ -474,7 +478,8 @@ contains
& p%precv(level)%map,info,work=work) & p%precv(level)%map,info,work=work)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
@ -524,7 +529,8 @@ contains
& p%precv(level)%map,info,work=work) & p%precv(level)%map,info,work=work)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
end if end if
@ -575,7 +581,8 @@ contains
& p%precv(level)%map,info,work=work) & p%precv(level)%map,info,work=work)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
@ -635,7 +642,8 @@ contains
& p%precv(level)%map,info,work=work) & p%precv(level)%map,info,work=work)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
@ -687,7 +695,8 @@ contains
& p%precv(level)%map,info,work=work) & p%precv(level)%map,info,work=work)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
@ -749,7 +758,8 @@ contains
& p%precv(level)%map,info,work=work) & p%precv(level)%map,info,work=work)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
end if end if
@ -792,7 +802,8 @@ contains
& p%precv(level+1)%map,info,work=work) & p%precv(level+1)%map,info,work=work)
if (info /= psb_success_ ) then if (info /= psb_success_ ) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error during restriction') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
goto 9999 goto 9999
end if end if
@ -815,7 +826,8 @@ contains
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&
& sweeps,work,info) & sweeps,work,info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error: residual/baseprec_aply') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error: residual/baseprec_aply')
goto 9999 goto 9999
end if end if

1506
mlprec/mld_zmlprec_aply.f90
View File

File diff suppressed because it is too large Load Diff

27
mlprec/mld_zslud_bld.f90
Unescape Escape View File

@ -93,11 +93,8 @@ subroutine mld_zsludist_bld(a,desc_a,p,info)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (psb_toupper(a%fida) /= 'CSR') then select type(aa=>a%a)
info=psb_err_unsupported_format_ type is (psb_z_csr_sparse_mat)
call psb_errpush(info,name,a_err=a%fida)
goto 9999
endif
! !
! WARN: we need to check for a BLOCK distribution (this is the ! WARN: we need to check for a BLOCK distribution (this is the
@ -112,20 +109,24 @@ subroutine mld_zsludist_bld(a,desc_a,p,info)
call psb_amx(ictxt,ibcheck) call psb_amx(ictxt,ibcheck)
if (ibcheck > 0) then if (ibcheck > 0) then
write(0,*) 'Warning: does not look like a BLOCK distribution' write(0,*) 'Warning: does not look like a BLOCK distribution'
info=psb_err_unsupported_format_
ch_err = aa%get_fmt()
call psb_errpush(info,name,a_err=ch_err)
goto 9999
endif endif
mglob = psb_cd_get_global_rows(desc_a) mglob = psb_cd_get_global_rows(desc_a)
nzt = psb_sp_get_nnzeros(a) nzt = aa%get_nzeros()
npr = np npr = np
npc = 1 npc = 1
call psb_loc_to_glob(a%ia1(1:nzt),desc_a,info,iact='I') call psb_loc_to_glob(aa%ja(1:nzt),desc_a,info,iact='I')
! !
! Compute the LU factorization ! Compute the LU factorization
! !
call mld_zsludist_fact(mglob,nrow,nzt,ifrst,& call mld_zsludist_fact(mglob,nrow,nzt,ifrst,&
& a%aspk,a%ia2,a%ia1,p%iprcparm(mld_slud_ptr_),& & aa%val,aa%irp,aa%ja,p%iprcparm(mld_slud_ptr_),&
& npr, npc, info) & npr, npc, info)
if (info /= psb_success_) then if (info /= psb_success_) then
ch_err='psb_sludist_fact' ch_err='psb_sludist_fact'
@ -133,7 +134,15 @@ subroutine mld_zsludist_bld(a,desc_a,p,info)
goto 9999 goto 9999
end if end if
call psb_glob_to_loc(a%ia1(1:nzt),desc_a,info,iact='I') call psb_glob_to_loc(aa%ja(1:nzt),desc_a,info,iact='I')
class default
info=psb_err_unsupported_format_
ch_err = aa%get_fmt()
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end select
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

Write Preview
Loading…
Cancel
Save