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

Applied first batch of changes about bjac_ names.

Browse Source
stopcriterion
Salvatore Filippone 18 years ago
parent eca09293bb
commit 8040237a77
9 changed files with 42 additions and 42 deletions
Show Stats Download Patch File Download Diff File

2
psb_dasmatbld.f90
Unescape Escape View File

@ -94,7 +94,7 @@ Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
nhalo = n_col-nrow_a nhalo = n_col-nrow_a
If (ptype == bja_) Then If (ptype == bjac_) Then
! !
! Block Jacobi. Copy the descriptor, just in case we want to ! Block Jacobi. Copy the descriptor, just in case we want to
! do the renumbering. ! do the renumbering.

8
psb_dbaseprc_aply.f90
Unescape Escape View File

@ -101,7 +101,7 @@ subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
call psb_geaxpby(alpha,x,beta,y,desc_data,info) call psb_geaxpby(alpha,x,beta,y,desc_data,info)
case(diagsc_) case(diag_)
if (size(work) >= size(x)) then if (size(work) >= size(x)) then
ww => work ww => work
@ -125,7 +125,7 @@ subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if end if
end if end if
case(bja_) case(bjac_)
call psb_bjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) call psb_bjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
if(info.ne.0) then if(info.ne.0) then
@ -260,8 +260,8 @@ subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if end if
case default case default
write(0,*) 'Invalid PRE%PREC ',prec%iprcparm(p_type_),':',& write(0,*) 'Invalid PRE%PREC ',prec%iprcparm(p_type_),':',&
& min_prec_,noprec_,diagsc_,bja_,& & min_prec_,noprec_,diag_,bjac_,&
& asm_,ras_,ash_,rash_ & ras_,asm_,ash_,rash_
end select end select
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

10
psb_dbaseprc_bld.f90
Unescape Escape View File

@ -143,7 +143,7 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
! !
call psb_check_def(p%iprcparm(p_type_),'base_prec',& call psb_check_def(p%iprcparm(p_type_),'base_prec',&
& diagsc_,is_legal_base_prec) & diag_,is_legal_base_prec)
!!$ allocate(p%desc_data,stat=info) !!$ allocate(p%desc_data,stat=info)
!!$ if (info /= 0) then !!$ if (info /= 0) then
@ -164,7 +164,7 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
goto 9999 goto 9999
end if end if
case (diagsc_) case (diag_)
call psb_diagsc_bld(a,desc_a,p,iupd,info) call psb_diagsc_bld(a,desc_a,p,iupd,info)
if(debug) write(0,*)me,': out of psb_diagsc_bld' if(debug) write(0,*)me,': out of psb_diagsc_bld'
@ -175,7 +175,7 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
goto 9999 goto 9999
end if end if
case (bja_,asm_) case (bjac_,asm_)
call psb_check_def(p%iprcparm(n_ovr_),'overlap',& call psb_check_def(p%iprcparm(n_ovr_),'overlap',&
& 0,is_legal_n_ovr) & 0,is_legal_n_ovr)
@ -227,14 +227,14 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
end if end if
case(f_none_) case(f_none_)
write(0,*) 'Fact=None in BASEPRC_BLD Bja/ASM??' write(0,*) 'Fact=None in BASEPRC_BLD Bjac/ASM??'
info=4010 info=4010
ch_err='Inconsistent prec f_none_' ch_err='Inconsistent prec f_none_'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
case default case default
write(0,*) 'Unknown factor type in baseprc_bld bja/asm: ',& write(0,*) 'Unknown factor type in baseprc_bld bjac/asm: ',&
&p%iprcparm(f_type_) &p%iprcparm(f_type_)
info=4010 info=4010
ch_err='Unknown f_type_' ch_err='Unknown f_type_'

10
psb_dprecset.f90
Unescape Escape View File

@ -94,9 +94,9 @@ subroutine psb_dprecset(p,ptype,info,iv,rs,rv,ilev,nlev)
p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1
case ('DIAG','DIAGSC') case ('DIAG')
p%baseprecv(ilev_)%iprcparm(:) = 0 p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(p_type_) = diagsc_ p%baseprecv(ilev_)%iprcparm(p_type_) = diag_
p%baseprecv(ilev_)%iprcparm(f_type_) = f_none_ p%baseprecv(ilev_)%iprcparm(f_type_) = f_none_
p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_ p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_ p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_
@ -104,9 +104,9 @@ subroutine psb_dprecset(p,ptype,info,iv,rs,rv,ilev,nlev)
p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1
case ('BJA','ILU') case ('BJAC')
p%baseprecv(ilev_)%iprcparm(:) = 0 p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(p_type_) = bja_ p%baseprecv(ilev_)%iprcparm(p_type_) = bjac_
p%baseprecv(ilev_)%iprcparm(f_type_) = f_ilu_n_ p%baseprecv(ilev_)%iprcparm(f_type_) = f_ilu_n_
p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_ p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_ p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_
@ -142,7 +142,7 @@ subroutine psb_dprecset(p,ptype,info,iv,rs,rv,ilev,nlev)
p%baseprecv(ilev_)%iprcparm(:) = 0 p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(p_type_) = bja_ p%baseprecv(ilev_)%iprcparm(p_type_) = bjac_
p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_ p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_ p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(iren_) = 0 p%baseprecv(ilev_)%iprcparm(iren_) = 0

28
psb_prec_type.f90
Unescape Escape View File

@ -43,8 +43,8 @@ module psb_prec_type
! blows up on some systems. ! blows up on some systems.
use psb_base_mod, only : psb_dspmat_type, psb_zspmat_type, psb_desc_type use psb_base_mod, only : psb_dspmat_type, psb_zspmat_type, psb_desc_type
integer, parameter :: min_prec_=0, noprec_=0, diagsc_=1, bja_=2,& integer, parameter :: min_prec_=0, noprec_=0, diag_=1, bjac_=2,&
& asm_=3, ras_=5, ash_=4, rash_=6, ras2lv_=7, ras2lvm_=8,& & ras_=3,asm_=4, ash_=5, rash_=6, ras2lv_=7, ras2lvm_=8,&
& lv2mras_=9, lv2smth_=10, lv2lsm_=11, sl2sm_=12, superlu_=13,& & lv2mras_=9, lv2smth_=10, lv2lsm_=11, sl2sm_=12, superlu_=13,&
& new_loc_smth_=14, new_glb_smth_=15, ag2lsm_=16,& & new_loc_smth_=14, new_glb_smth_=15, ag2lsm_=16,&
& msy2l_=18, msy2g_=19, max_prec_=19 & msy2l_=18, msy2g_=19, max_prec_=19
@ -237,9 +237,9 @@ contains
select case(p%baseprecv(1)%iprcparm(p_type_)) select case(p%baseprecv(1)%iprcparm(p_type_))
case(noprec_) case(noprec_)
write(iout,*) 'No preconditioning' write(iout,*) 'No preconditioning'
case(diagsc_) case(diag_)
write(iout,*) 'Diagonal scaling' write(iout,*) 'Diagonal scaling'
case(bja_) case(bjac_)
write(iout,*) 'Block Jacobi with: ',& write(iout,*) 'Block Jacobi with: ',&
& fact_names(p%baseprecv(1)%iprcparm(f_type_)) & fact_names(p%baseprecv(1)%iprcparm(f_type_))
case(asm_,ras_,ash_,rash_) case(asm_,ras_,ash_,rash_)
@ -315,9 +315,9 @@ contains
!!$ select case(p%baseprecv(1)%iprcparm(p_type_)) !!$ select case(p%baseprecv(1)%iprcparm(p_type_))
!!$ case(noprec_) !!$ case(noprec_)
!!$ write(iout,*) 'No preconditioning' !!$ write(iout,*) 'No preconditioning'
!!$ case(diagsc_) !!$ case(diag_)
!!$ write(iout,*) 'Diagonal scaling' !!$ write(iout,*) 'Diagonal scaling'
!!$ case(bja_) !!$ case(bjac_)
!!$ write(iout,*) 'Block Jacobi with: ',& !!$ write(iout,*) 'Block Jacobi with: ',&
!!$ & fact_names(p%baseprecv(1)%iprcparm(f_type_)) !!$ & fact_names(p%baseprecv(1)%iprcparm(f_type_))
!!$ case(asm_,ras_,ash_,rash_) !!$ case(asm_,ras_,ash_,rash_)
@ -383,9 +383,9 @@ contains
select case(p%baseprecv(1)%iprcparm(p_type_)) select case(p%baseprecv(1)%iprcparm(p_type_))
case(noprec_) case(noprec_)
write(iout,*) 'No preconditioning' write(iout,*) 'No preconditioning'
case(diagsc_) case(diag_)
write(iout,*) 'Diagonal scaling' write(iout,*) 'Diagonal scaling'
case(bja_) case(bjac_)
write(iout,*) 'Block Jacobi with: ',& write(iout,*) 'Block Jacobi with: ',&
& fact_names(p%baseprecv(1)%iprcparm(f_type_)) & fact_names(p%baseprecv(1)%iprcparm(f_type_))
case(asm_,ras_,ash_,rash_) case(asm_,ras_,ash_,rash_)
@ -457,9 +457,9 @@ contains
!!$ select case(p%baseprecv(1)%iprcparm(p_type_)) !!$ select case(p%baseprecv(1)%iprcparm(p_type_))
!!$ case(noprec_) !!$ case(noprec_)
!!$ write(iout,*) 'No preconditioning' !!$ write(iout,*) 'No preconditioning'
!!$ case(diagsc_) !!$ case(diag_)
!!$ write(iout,*) 'Diagonal scaling' !!$ write(iout,*) 'Diagonal scaling'
!!$ case(bja_) !!$ case(bjac_)
!!$ write(iout,*) 'Block Jacobi with: ',& !!$ write(iout,*) 'Block Jacobi with: ',&
!!$ & fact_names(p%baseprecv(1)%iprcparm(f_type_)) !!$ & fact_names(p%baseprecv(1)%iprcparm(f_type_))
!!$ case(asm_,ras_,ash_,rash_) !!$ case(asm_,ras_,ash_,rash_)
@ -830,10 +830,10 @@ contains
select case(iprec) select case(iprec)
case(noprec_) case(noprec_)
pr_to_str='NOPREC' pr_to_str='NOPREC'
case(diagsc_) case(diag_)
pr_to_str='DIAGSC' pr_to_str='DIAG'
case(bja_) case(bjac_)
pr_to_str='BJA' pr_to_str='BJAC'
case(asm_) case(asm_)
pr_to_str='ASM' pr_to_str='ASM'
case(ash_) case(ash_)

2
psb_zasmatbld.f90
Unescape Escape View File

@ -92,7 +92,7 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
nhalo = n_col-nrow_a nhalo = n_col-nrow_a
If (ptype == bja_) Then If (ptype == bjac_) Then
! !
! Block Jacobi. Copy the descriptor, just in case we want to ! Block Jacobi. Copy the descriptor, just in case we want to
! do the renumbering. ! do the renumbering.

8
psb_zbaseprc_aply.f90
Unescape Escape View File

@ -100,7 +100,7 @@ subroutine psb_zbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
call psb_geaxpby(alpha,x,beta,y,desc_data,info) call psb_geaxpby(alpha,x,beta,y,desc_data,info)
case(diagsc_) case(diag_)
if (size(work) >= size(x)) then if (size(work) >= size(x)) then
ww => work ww => work
@ -124,7 +124,7 @@ subroutine psb_zbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if end if
end if end if
case(bja_) case(bjac_)
call psb_bjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) call psb_bjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
if(info.ne.0) then if(info.ne.0) then
@ -259,8 +259,8 @@ subroutine psb_zbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if end if
case default case default
write(0,*) 'Invalid PRE%PREC ',prec%iprcparm(p_type_),':',& write(0,*) 'Invalid PRE%PREC ',prec%iprcparm(p_type_),':',&
& min_prec_,noprec_,diagsc_,bja_,& & min_prec_,noprec_,diag_,bjac_,&
& asm_,ras_,ash_,rash_ & ras_,asm_,ash_,rash_
end select end select
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

6
psb_zbaseprc_bld.f90
Unescape Escape View File

@ -138,7 +138,7 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd)
! !
call psb_check_def(p%iprcparm(p_type_),'base_prec',& call psb_check_def(p%iprcparm(p_type_),'base_prec',&
& diagsc_,is_legal_base_prec) & diag_,is_legal_base_prec)
!!$ allocate(p%desc_data,stat=info) !!$ allocate(p%desc_data,stat=info)
!!$ if (info /= 0) then !!$ if (info /= 0) then
@ -159,7 +159,7 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd)
goto 9999 goto 9999
end if end if
case (diagsc_) case (diag_)
call psb_diagsc_bld(a,desc_a,p,iupd,info) call psb_diagsc_bld(a,desc_a,p,iupd,info)
if(debug) write(0,*)me,': out of psb_diagsc_bld' if(debug) write(0,*)me,': out of psb_diagsc_bld'
@ -170,7 +170,7 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd)
goto 9999 goto 9999
end if end if
case (bja_,asm_) case (bjac_,asm_)
call psb_check_def(p%iprcparm(n_ovr_),'overlap',& call psb_check_def(p%iprcparm(n_ovr_),'overlap',&
& 0,is_legal_n_ovr) & 0,is_legal_n_ovr)

10
psb_zprecset.f90
Unescape Escape View File

@ -95,9 +95,9 @@ subroutine psb_zprecset(p,ptype,info,iv,rs,rv,ilev,nlev)
p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1
case ('DIAG','DIAGSC') case ('DIAG')
p%baseprecv(ilev_)%iprcparm(:) = 0 p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(p_type_) = diagsc_ p%baseprecv(ilev_)%iprcparm(p_type_) = diag_
p%baseprecv(ilev_)%iprcparm(f_type_) = f_none_ p%baseprecv(ilev_)%iprcparm(f_type_) = f_none_
p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_ p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_ p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_
@ -105,9 +105,9 @@ subroutine psb_zprecset(p,ptype,info,iv,rs,rv,ilev,nlev)
p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1
case ('BJA','ILU') case ('BJAC')
p%baseprecv(ilev_)%iprcparm(:) = 0 p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(p_type_) = bja_ p%baseprecv(ilev_)%iprcparm(p_type_) = bjac_
p%baseprecv(ilev_)%iprcparm(f_type_) = f_ilu_n_ p%baseprecv(ilev_)%iprcparm(f_type_) = f_ilu_n_
p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_ p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_ p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_
@ -142,7 +142,7 @@ subroutine psb_zprecset(p,ptype,info,iv,rs,rv,ilev,nlev)
p%baseprecv(ilev_)%iprcparm(:) = 0 p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(p_type_) = bja_ p%baseprecv(ilev_)%iprcparm(p_type_) = bjac_
p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_ p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_ p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(iren_) = 0 p%baseprecv(ilev_)%iprcparm(iren_) = 0

Write Preview
Loading…
Cancel
Save