Changed order of operands in precbld, step to reorg with baseprc_bld.

psblas3-type-indexed
Salvatore Filippone 19 years ago
parent 67b7449bb6
commit 5126b55538

@ -61,14 +61,14 @@ interface psb_genaggrmap
end interface
interface psb_precbld
subroutine psb_dprecbld(a,prec,desc_a,ierr,upd)
subroutine psb_dprecbld(a,desc_a,prec,info,upd)
use psb_descriptor_type
use psb_prec_type
implicit none
integer, intent(out) :: ierr
type(psb_dspmat_type), intent(in), target :: a
type(psb_dprec_type), intent(inout) :: prec
type(psb_desc_type), intent(in) :: desc_a
type(psb_dprec_type), intent(inout) :: prec
integer, intent(out) :: info
character, intent(in),optional :: upd
end subroutine psb_dprecbld
end interface

@ -79,7 +79,7 @@ module psb_prec_type
! Fields for sparse matrices ensembles:
integer, parameter :: l_pr_=1, u_pr_=2, bp_ilu_avsz=2
integer, parameter :: ap_nd_=3, ac_=4, sm_pr_t_=5, sm_pr_=6
integer, parameter :: smth_avsz=6
integer, parameter :: smth_avsz=6, max_avsz=smth_avsz
type psb_dbase_prec

@ -145,21 +145,14 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info)
call psb_nullify_sp(ac)
p%aorig => a
allocate(p%av(smth_avsz),stat=info)
allocate(p%av(max_avsz),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
goto 9999
end if
do i=1, smth_avsz
do i=1, size(p%av)
call psb_nullify_sp(p%av(i))
call psb_spall(0,0,p%av(i),1,info)
if(info /= 0) then
info=4010
ch_err='psb_spall'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end do
nullify(p%d)

@ -33,7 +33,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine psb_dprecbld(a,p,desc_a,info,upd)
subroutine psb_dprecbld(a,desc_a,p,info,upd)
use psb_serial_mod
Use psb_spmat_type
@ -46,10 +46,10 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd)
use psb_error_mod
Implicit None
integer, intent(out) :: info
type(psb_dspmat_type), target :: a
type(psb_dprec_type),intent(inout) :: p
type(psb_desc_type), intent(in) :: desc_a
type(psb_dprec_type),intent(inout) :: p
integer, intent(out) :: info
character, intent(in), optional :: upd
interface psb_ilu_bld
@ -264,7 +264,8 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd)
if (debug) write(0,*)me, ': Calling PSB_ILU_BLD'
allocate(p%baseprecv(1)%av(bp_ilu_avsz),stat=info)
!!$ allocate(p%baseprecv(1)%av(bp_ilu_avsz),stat=info)
allocate(p%baseprecv(1)%av(max_avsz),stat=info)
do k=1,size(p%baseprecv(1)%av)
call psb_nullify_sp(p%baseprecv(1)%av(k))
end do
@ -321,6 +322,8 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd)
call psb_errpush(info,name)
goto 9999
endif
call psb_check_def(p%baseprecv(2)%iprcparm(ml_type_),'Multilevel type',&
& mult_ml_prec_,is_legal_ml_type)
call psb_check_def(p%baseprecv(2)%iprcparm(aggr_alg_),'aggregation',&
& loc_aggr_,is_legal_ml_aggr_kind)
call psb_check_def(p%baseprecv(2)%iprcparm(smth_kind_),'Smoother kind',&
@ -331,13 +334,7 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd)
& pre_smooth_,is_legal_ml_smooth_pos)
call psb_check_def(p%baseprecv(2)%iprcparm(f_type_),'fact',f_ilu_n_,is_legal_ml_fact)
!!$ allocate(p%baseprecv(2)%desc_data,stat=info)
!!$ if (info /= 0) then
!!$ call psb_errpush(4010,name,a_err='Allocate')
!!$ goto 9999
!!$ end if
!!$
!!$ call psb_nullify_desc(p%baseprecv(2)%desc_data)
nullify(p%baseprecv(2)%desc_data)
select case(p%baseprecv(2)%iprcparm(f_type_))
case(f_ilu_n_)

@ -68,6 +68,7 @@ subroutine psb_dprecset(p,ptype,iv,rs,rv,info)
select case(toupper(ptype(1:len_trim(ptype))))
case ('NONE','NOPREC')
p%baseprecv(1)%iprcparm(:) = 0
p%baseprecv(1)%iprcparm(p_type_) = noprec_
p%baseprecv(1)%iprcparm(f_type_) = f_none_
p%baseprecv(1)%iprcparm(restr_) = psb_none_
@ -77,6 +78,7 @@ subroutine psb_dprecset(p,ptype,iv,rs,rv,info)
p%baseprecv(1)%iprcparm(jac_sweeps_) = 1
case ('DIAG','DIAGSC')
p%baseprecv(1)%iprcparm(:) = 0
p%baseprecv(1)%iprcparm(p_type_) = diagsc_
p%baseprecv(1)%iprcparm(f_type_) = f_none_
p%baseprecv(1)%iprcparm(restr_) = psb_none_
@ -86,6 +88,7 @@ subroutine psb_dprecset(p,ptype,iv,rs,rv,info)
p%baseprecv(1)%iprcparm(jac_sweeps_) = 1
case ('BJA','ILU')
p%baseprecv(1)%iprcparm(:) = 0
p%baseprecv(1)%iprcparm(p_type_) = bja_
p%baseprecv(1)%iprcparm(f_type_) = f_ilu_n_
p%baseprecv(1)%iprcparm(restr_) = psb_none_
@ -96,6 +99,7 @@ subroutine psb_dprecset(p,ptype,iv,rs,rv,info)
p%baseprecv(1)%iprcparm(jac_sweeps_) = 1
case ('ASM','AS')
p%baseprecv(1)%iprcparm(:) = 0
! Defaults first
p%baseprecv(1)%iprcparm(p_type_) = asm_
p%baseprecv(1)%iprcparm(f_type_) = f_ilu_n_
@ -148,7 +152,7 @@ subroutine psb_dprecset(p,ptype,iv,rs,rv,info)
write(0,*)'Precset Memory Failure 2l:3',err
endif
p%baseprecv(2)%iprcparm(:) = 0
p%baseprecv(2)%iprcparm(p_type_) = bja_
p%baseprecv(2)%iprcparm(restr_) = psb_none_

@ -264,7 +264,7 @@ program df_sample
! building the preconditioner
t1 = mpi_wtime()
call psb_precbld(a,pre,desc_a,info)
call psb_precbld(a,desc_a,pre,info)
tprec = mpi_wtime()-t1
if (info /= 0) then
call psb_errpush(4010,name,a_err='psb_precbld')

@ -191,7 +191,7 @@ program pde90
call blacs_barrier(icontxt,'ALL')
t1 = mpi_wtime()
call psb_precbld(a,pre,desc_a,info)
call psb_precbld(a,desc_a,pre,info)
if(info.ne.0) then
info=4010
ch_err='psb_precbld'

Loading…
Cancel
Save