From 5126b5553841c7e524458c308b1632490efbcc8e Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 8 Mar 2006 15:29:32 +0000 Subject: [PATCH] Changed order of operands in precbld, step to reorg with baseprc_bld. --- src/modules/psb_prec_mod.f90 | 6 +++--- src/modules/psb_prec_type.f90 | 2 +- src/prec/psb_dmlprc_bld.f90 | 13 +++---------- src/prec/psb_dprecbld.f90 | 19 ++++++++----------- src/prec/psb_dprecset.f90 | 6 +++++- test/Fileread/df_sample.f90 | 2 +- test/pargen/ppde90.f90 | 2 +- 7 files changed, 22 insertions(+), 28 deletions(-) diff --git a/src/modules/psb_prec_mod.f90 b/src/modules/psb_prec_mod.f90 index 00ad5ae0..23af25b1 100644 --- a/src/modules/psb_prec_mod.f90 +++ b/src/modules/psb_prec_mod.f90 @@ -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 diff --git a/src/modules/psb_prec_type.f90 b/src/modules/psb_prec_type.f90 index bf80ad96..128b2d29 100644 --- a/src/modules/psb_prec_type.f90 +++ b/src/modules/psb_prec_type.f90 @@ -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 diff --git a/src/prec/psb_dmlprc_bld.f90 b/src/prec/psb_dmlprc_bld.f90 index 8018d1a5..53073dd4 100644 --- a/src/prec/psb_dmlprc_bld.f90 +++ b/src/prec/psb_dmlprc_bld.f90 @@ -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) diff --git a/src/prec/psb_dprecbld.f90 b/src/prec/psb_dprecbld.f90 index aca6316f..4e8562db 100644 --- a/src/prec/psb_dprecbld.f90 +++ b/src/prec/psb_dprecbld.f90 @@ -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_) diff --git a/src/prec/psb_dprecset.f90 b/src/prec/psb_dprecset.f90 index e6eb23c9..9da2bece 100644 --- a/src/prec/psb_dprecset.f90 +++ b/src/prec/psb_dprecset.f90 @@ -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_ diff --git a/test/Fileread/df_sample.f90 b/test/Fileread/df_sample.f90 index fff6b58f..88256fbc 100644 --- a/test/Fileread/df_sample.f90 +++ b/test/Fileread/df_sample.f90 @@ -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') diff --git a/test/pargen/ppde90.f90 b/test/pargen/ppde90.f90 index d019b079..280c64eb 100644 --- a/test/pargen/ppde90.f90 +++ b/test/pargen/ppde90.f90 @@ -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'