Applied first batch of changes about bjac_ names.

stopcriterion
Salvatore Filippone 18 years ago
parent eca09293bb
commit 8040237a77

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

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

@ -143,7 +143,7 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
!
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)
!!$ if (info /= 0) then
@ -164,7 +164,7 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
goto 9999
end if
case (diagsc_)
case (diag_)
call psb_diagsc_bld(a,desc_a,p,iupd,info)
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
end if
case (bja_,asm_)
case (bjac_,asm_)
call psb_check_def(p%iprcparm(n_ovr_),'overlap',&
& 0,is_legal_n_ovr)
@ -227,14 +227,14 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
end if
case(f_none_)
write(0,*) 'Fact=None in BASEPRC_BLD Bja/ASM??'
write(0,*) 'Fact=None in BASEPRC_BLD Bjac/ASM??'
info=4010
ch_err='Inconsistent prec f_none_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
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_)
info=4010
ch_err='Unknown f_type_'

@ -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(jac_sweeps_) = 1
case ('DIAG','DIAGSC')
case ('DIAG')
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(restr_) = 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(jac_sweeps_) = 1
case ('BJA','ILU')
case ('BJAC')
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(restr_) = 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(p_type_) = bja_
p%baseprecv(ilev_)%iprcparm(p_type_) = bjac_
p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(iren_) = 0

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

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

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

@ -138,7 +138,7 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd)
!
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)
!!$ if (info /= 0) then
@ -159,7 +159,7 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd)
goto 9999
end if
case (diagsc_)
case (diag_)
call psb_diagsc_bld(a,desc_a,p,iupd,info)
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
end if
case (bja_,asm_)
case (bjac_,asm_)
call psb_check_def(p%iprcparm(n_ovr_),'overlap',&
& 0,is_legal_n_ovr)

@ -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(jac_sweeps_) = 1
case ('DIAG','DIAGSC')
case ('DIAG')
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(restr_) = 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(jac_sweeps_) = 1
case ('BJA','ILU')
case ('BJAC')
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(restr_) = 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(p_type_) = bja_
p%baseprecv(ilev_)%iprcparm(p_type_) = bjac_
p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(iren_) = 0

Loading…
Cancel
Save