mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-19 20:32:13 +00:00
Applied first batch of changes about bjac_ names.
This commit is contained in:
+1
-1
@@ -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_'
|
||||
|
||||
+5
-5
@@ -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
|
||||
|
||||
+14
-14
@@ -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_)
|
||||
|
||||
+1
-1
@@ -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)
|
||||
|
||||
+5
-5
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user