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

Fixed constant naming scheme.

Browse Source
psblas3-type-indexed
Salvatore Filippone 17 years ago
parent da113e34d4
commit 2922fcba6e
13 changed files with 127 additions and 128 deletions
Show Stats Download Patch File Download Diff File

12
prec/psb_dbjac_aply.f90
Unescape Escape View File

@ -100,24 +100,24 @@ subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
endif endif
select case(prec%iprcparm(f_type_)) select case(prec%iprcparm(psb_f_type_))
case(f_ilu_n_,f_ilu_e_) case(psb_f_ilu_n_)
select case(trans_) select case(trans_)
case('N') case('N')
call psb_spsm(done,prec%av(l_pr_),x,dzero,ww,desc_data,info,& call psb_spsm(done,prec%av(psb_l_pr_),x,dzero,ww,desc_data,info,&
& trans=trans_,unit='L',diag=prec%d,choice=psb_none_,work=aux) & trans=trans_,unit='L',diag=prec%d,choice=psb_none_,work=aux)
if(info /=0) goto 9999 if(info /=0) goto 9999
call psb_spsm(alpha,prec%av(u_pr_),ww,beta,y,desc_data,info,& call psb_spsm(alpha,prec%av(psb_u_pr_),ww,beta,y,desc_data,info,&
& trans=trans_,unit='U',choice=psb_none_, work=aux) & trans=trans_,unit='U',choice=psb_none_, work=aux)
if(info /=0) goto 9999 if(info /=0) goto 9999
case('T','C') case('T','C')
call psb_spsm(done,prec%av(u_pr_),x,dzero,ww,desc_data,info,& call psb_spsm(done,prec%av(psb_u_pr_),x,dzero,ww,desc_data,info,&
& trans=trans_,unit='L',diag=prec%d,choice=psb_none_, work=aux) & trans=trans_,unit='L',diag=prec%d,choice=psb_none_, work=aux)
if(info /=0) goto 9999 if(info /=0) goto 9999
call psb_spsm(alpha,prec%av(l_pr_),ww,beta,y,desc_data,info,& call psb_spsm(alpha,prec%av(psb_l_pr_),ww,beta,y,desc_data,info,&
& trans=trans_,unit='U',choice=psb_none_,work=aux) & trans=trans_,unit='U',choice=psb_none_,work=aux)
if(info /=0) goto 9999 if(info /=0) goto 9999

36
prec/psb_dbjac_bld.f90
Unescape Escape View File

@ -81,12 +81,12 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
end if end if
select case(p%iprcparm(f_type_)) select case(p%iprcparm(psb_f_type_))
case(f_ilu_n_,f_ilu_e_) case(psb_f_ilu_n_)
if (allocated(p%av)) then if (allocated(p%av)) then
if (size(p%av) < bp_ilu_avsz) then if (size(p%av) < psb_bp_ilu_avsz) then
do i=1,size(p%av) do i=1,size(p%av)
call psb_sp_free(p%av(i),info) call psb_sp_free(p%av(i),info)
if (info /= 0) then if (info /= 0) then
@ -99,7 +99,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
endif endif
end if end if
if (.not.allocated(p%av)) then if (.not.allocated(p%av)) then
allocate(p%av(max_avsz),stat=info) allocate(p%av(psb_max_avsz),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4000,name) call psb_errpush(4000,name)
goto 9999 goto 9999
@ -112,12 +112,12 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
n_col = psb_cd_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
nhalo = n_col-nrow_a nhalo = n_col-nrow_a
n_row = p%desc_data%matrix_data(psb_n_row_) n_row = p%desc_data%matrix_data(psb_n_row_)
p%av(l_pr_)%m = n_row p%av(psb_l_pr_)%m = n_row
p%av(l_pr_)%k = n_row p%av(psb_l_pr_)%k = n_row
p%av(u_pr_)%m = n_row p%av(psb_u_pr_)%m = n_row
p%av(u_pr_)%k = n_row p%av(psb_u_pr_)%k = n_row
call psb_sp_all(n_row,n_row,p%av(l_pr_),nztota,info) call psb_sp_all(n_row,n_row,p%av(psb_l_pr_),nztota,info)
if (info == 0) call psb_sp_all(n_row,n_row,p%av(u_pr_),nztota,info) if (info == 0) call psb_sp_all(n_row,n_row,p%av(psb_u_pr_),nztota,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010
ch_err='psb_sp_all' ch_err='psb_sp_all'
@ -142,7 +142,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
! This is where we have mo renumbering, thus no need ! This is where we have mo renumbering, thus no need
! for ATMP ! for ATMP
call psb_ilu_fct(a,p%av(l_pr_),p%av(u_pr_),p%d,info) call psb_ilu_fct(a,p%av(psb_l_pr_),p%av(psb_u_pr_),p%d,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010
ch_err='psb_ilu_fct' ch_err='psb_ilu_fct'
@ -150,24 +150,24 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
goto 9999 goto 9999
end if end if
if (psb_sp_getifld(psb_upd_,p%av(u_pr_),info) /= psb_upd_perm_) then if (psb_sp_getifld(psb_upd_,p%av(psb_u_pr_),info) /= psb_upd_perm_) then
call psb_sp_trim(p%av(u_pr_),info) call psb_sp_trim(p%av(psb_u_pr_),info)
endif endif
if (psb_sp_getifld(psb_upd_,p%av(l_pr_),info) /= psb_upd_perm_) then if (psb_sp_getifld(psb_upd_,p%av(psb_l_pr_),info) /= psb_upd_perm_) then
call psb_sp_trim(p%av(l_pr_),info) call psb_sp_trim(p%av(psb_l_pr_),info)
endif endif
case(f_none_) case(psb_f_none_)
info=4010 info=4010
ch_err='Inconsistent prec f_none_' ch_err='Inconsistent prec psb_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
info=4010 info=4010
ch_err='Unknown f_type_' ch_err='Unknown psb_f_type_'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end select end select

2
prec/psb_dgprec_aply.f90
Unescape Escape View File

@ -73,7 +73,7 @@ subroutine psb_dgprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
goto 9999 goto 9999
end select end select
select case(prec%iprcparm(p_type_)) select case(prec%iprcparm(psb_p_type_))
case(psb_noprec_) case(psb_noprec_)

10
prec/psb_dprecbld.f90
Unescape Escape View File

@ -80,12 +80,12 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
! ALso should define symbolic names for the preconditioners. ! ALso should define symbolic names for the preconditioners.
! !
call psb_check_def(p%iprcparm(p_type_),'base_prec',& call psb_check_def(p%iprcparm(psb_p_type_),'base_prec',&
& psb_diag_,is_legal_prec) & psb_diag_,is_legal_prec)
call psb_nullify_desc(p%desc_data) call psb_nullify_desc(p%desc_data)
select case(p%iprcparm(p_type_)) select case(p%iprcparm(psb_p_type_))
case (psb_noprec_) case (psb_noprec_)
! Do nothing. ! Do nothing.
call psb_cdcpy(desc_a,p%desc_data,info) call psb_cdcpy(desc_a,p%desc_data,info)
@ -108,8 +108,8 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
case (psb_bjac_) case (psb_bjac_)
call psb_check_def(p%iprcparm(f_type_),'fact',& call psb_check_def(p%iprcparm(psb_f_type_),'fact',&
& f_ilu_n_,is_legal_ml_fact) & psb_f_ilu_n_,is_legal_ml_fact)
call psb_bjac_bld(a,desc_a,p,upd_,info) call psb_bjac_bld(a,desc_a,p,upd_,info)
@ -120,7 +120,7 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
case default case default
info=4010 info=4010
ch_err='Unknown p_type_' ch_err='Unknown psb_p_type_'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999

18
prec/psb_dprecinit.f90
Unescape Escape View File

@ -39,27 +39,27 @@ subroutine psb_dprecinit(p,ptype,info)
info = 0 info = 0
call psb_realloc(ifpsz,p%iprcparm,info) call psb_realloc(psb_ifpsz,p%iprcparm,info)
if (info == 0) call psb_realloc(dfpsz,p%dprcparm,info) if (info == 0) call psb_realloc(psb_dfpsz,p%dprcparm,info)
if (info /= 0) return if (info /= 0) return
p%iprcparm(:) = 0 p%iprcparm(:) = 0
select case(toupper(ptype(1:len_trim(ptype)))) select case(toupper(ptype(1:len_trim(ptype))))
case ('NONE','NOPREC') case ('NONE','NOPREC')
p%iprcparm(:) = 0 p%iprcparm(:) = 0
p%iprcparm(p_type_) = psb_noprec_ p%iprcparm(psb_p_type_) = psb_noprec_
p%iprcparm(f_type_) = f_none_ p%iprcparm(psb_f_type_) = psb_f_none_
case ('DIAG') case ('DIAG')
p%iprcparm(:) = 0 p%iprcparm(:) = 0
p%iprcparm(p_type_) = psb_diag_ p%iprcparm(psb_p_type_) = psb_diag_
p%iprcparm(f_type_) = f_none_ p%iprcparm(psb_f_type_) = psb_f_none_
case ('BJAC') case ('BJAC')
p%iprcparm(:) = 0 p%iprcparm(:) = 0
p%iprcparm(p_type_) = psb_bjac_ p%iprcparm(psb_p_type_) = psb_bjac_
p%iprcparm(f_type_) = f_ilu_n_ p%iprcparm(psb_f_type_) = psb_f_ilu_n_
p%iprcparm(ilu_fill_in_) = 0 p%iprcparm(psb_ilu_fill_in_) = 0
case default case default
write(0,*) 'Unknown preconditioner type request "',ptype,'"' write(0,*) 'Unknown preconditioner type request "',ptype,'"'

32
prec/psb_dprecset.f90
Unescape Escape View File

@ -40,21 +40,21 @@ subroutine psb_dprecseti(p,what,val,info)
info = 0 info = 0
select case(what) select case(what)
case (f_type_) case (psb_f_type_)
if (p%iprcparm(p_type_) /= psb_bjac_) then if (p%iprcparm(psb_p_type_) /= psb_bjac_) then
write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(p_type_),& write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(psb_p_type_),&
& 'ignoring user specification' & 'ignoring user specification'
return return
endif endif
p%iprcparm(f_type_) = val p%iprcparm(psb_f_type_) = val
case (ilu_fill_in_) case (psb_ilu_fill_in_)
if ((p%iprcparm(p_type_) /= psb_bjac_).or.(p%iprcparm(f_type_) /= f_ilu_n_)) then if ((p%iprcparm(psb_p_type_) /= psb_bjac_).or.(p%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then
write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(p_type_),& write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(psb_p_type_),&
& 'ignoring user specification' & 'ignoring user specification'
return return
endif endif
p%iprcparm(ilu_fill_in_) = val p%iprcparm(psb_ilu_fill_in_) = val
case default case default
write(0,*) 'WHAT is invalid, ignoring user specification' write(0,*) 'WHAT is invalid, ignoring user specification'
@ -80,21 +80,21 @@ subroutine psb_dprecsetd(p,what,val,info)
! factorization. ! factorization.
! !
select case(what) select case(what)
!!$ case (f_type_) !!$ case (psb_f_type_)
!!$ if (p%iprcparm(p_type_) /= bjac_) then !!$ if (p%iprcparm(psb_p_type_) /= psb_bjac_) then
!!$ write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(p_type_),& !!$ write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(psb_p_type_),&
!!$ & 'ignoring user specification' !!$ & 'ignoring user specification'
!!$ return !!$ return
!!$ endif !!$ endif
!!$ p%iprcparm(f_type_) = val !!$ p%iprcparm(psb_f_type_) = val
!!$ !!$
!!$ case (ilu_fill_in_) !!$ case (psb_ilu_fill_in_)
!!$ if ((p%iprcparm(p_type_) /= bjac_).or.(p%iprcparm(f_type_) /= f_ilu_n_)) then !!$ if ((p%iprcparm(psb_p_type_) /= psb_bjac_).or.(p%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then
!!$ write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(p_type_),& !!$ write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(psb_p_type_),&
!!$ & 'ignoring user specification' !!$ & 'ignoring user specification'
!!$ return !!$ return
!!$ endif !!$ endif
!!$ p%iprcparm(ilu_fill_in_) = val !!$ p%iprcparm(psb_ilu_fill_in_) = val
case default case default
write(0,*) 'WHAT is invalid, ignoring user specification' write(0,*) 'WHAT is invalid, ignoring user specification'

31
prec/psb_prec_type.f90
Unescape Escape View File

@ -46,20 +46,19 @@ module psb_prec_type
! prolongation type, restriction type, renumbering algorithm, ! prolongation type, restriction type, renumbering algorithm,
! number of overlap layers, pointer to SuperLU factors, ! number of overlap layers, pointer to SuperLU factors,
! levels of fill in for ILU(N), ! levels of fill in for ILU(N),
integer, parameter :: p_type_=1, f_type_=2 integer, parameter :: psb_p_type_=1, psb_f_type_=2
integer, parameter :: ilu_fill_in_=8 integer, parameter :: psb_ilu_fill_in_=8
!Renumbering. SEE BELOW !Renumbering. SEE BELOW
integer, parameter :: renum_none_=0, renum_glb_=1, renum_gps_=2 integer, parameter :: psb_renum_none_=0, psb_renum_glb_=1, psb_renum_gps_=2
integer, parameter :: ifpsz=10 integer, parameter :: psb_ifpsz=10
! Entries in dprcparm: ILU(E) epsilon, smoother omega ! Entries in dprcparm: ILU(E) epsilon, smoother omega
integer, parameter :: fact_eps_=1 integer, parameter :: psb_fact_eps_=1
integer, parameter :: dfpsz=4 integer, parameter :: psb_dfpsz=4
! Factorization types: none, ILU(N), ILU(E) ! Factorization types: none, ILU(N), ILU(E)
integer, parameter :: f_none_=0,f_ilu_n_=1,f_ilu_e_=2 integer, parameter :: psb_f_none_=0,psb_f_ilu_n_=1
! Fields for sparse matrices ensembles: ! Fields for sparse matrices ensembles:
integer, parameter :: l_pr_=1, u_pr_=2, bp_ilu_avsz=2 integer, parameter :: psb_l_pr_=1, psb_u_pr_=2, psb_bp_ilu_avsz=2
integer, parameter :: ap_nd_=3, ac_=4, sm_pr_t_=5, sm_pr_=6 integer, parameter :: psb_max_avsz=psb_bp_ilu_avsz
integer, parameter :: smth_avsz=6, max_avsz=smth_avsz
type psb_dprec_type type psb_dprec_type
@ -128,14 +127,14 @@ contains
type(psb_dprec_type), intent(in) :: p type(psb_dprec_type), intent(in) :: p
write(iout,*) 'Preconditioner description' write(iout,*) 'Preconditioner description'
select case(p%iprcparm(p_type_)) select case(p%iprcparm(psb_p_type_))
case(psb_noprec_) case(psb_noprec_)
write(iout,*) 'No preconditioning' write(iout,*) 'No preconditioning'
case(psb_diag_) case(psb_diag_)
write(iout,*) 'Diagonal scaling' write(iout,*) 'Diagonal scaling'
case(psb_bjac_) case(psb_bjac_)
write(iout,*) 'Block Jacobi with: ',& write(iout,*) 'Block Jacobi with: ',&
& fact_names(p%iprcparm(f_type_)) & fact_names(p%iprcparm(psb_f_type_))
end select end select
end subroutine psb_file_prec_descr end subroutine psb_file_prec_descr
@ -146,14 +145,14 @@ contains
type(psb_zprec_type), intent(in) :: p type(psb_zprec_type), intent(in) :: p
write(iout,*) 'Preconditioner description' write(iout,*) 'Preconditioner description'
select case(p%iprcparm(p_type_)) select case(p%iprcparm(psb_p_type_))
case(psb_noprec_) case(psb_noprec_)
write(iout,*) 'No preconditioning' write(iout,*) 'No preconditioning'
case(psb_diag_) case(psb_diag_)
write(iout,*) 'Diagonal scaling' write(iout,*) 'Diagonal scaling'
case(psb_bjac_) case(psb_bjac_)
write(iout,*) 'Block Jacobi with: ',& write(iout,*) 'Block Jacobi with: ',&
& fact_names(p%iprcparm(f_type_)) & fact_names(p%iprcparm(psb_f_type_))
end select end select
end subroutine psb_zfile_prec_descr end subroutine psb_zfile_prec_descr
@ -163,7 +162,7 @@ contains
integer, intent(in) :: ip integer, intent(in) :: ip
logical :: is_legal_prec logical :: is_legal_prec
is_legal_prec = ((ip>=noprec_).and.(ip<=bjac_)) is_legal_prec = ((ip>=psb_noprec_).and.(ip<=psb_bjac_))
return return
end function is_legal_prec end function is_legal_prec
function is_legal_ml_fact(ip) function is_legal_ml_fact(ip)
@ -171,7 +170,7 @@ contains
integer, intent(in) :: ip integer, intent(in) :: ip
logical :: is_legal_ml_fact logical :: is_legal_ml_fact
is_legal_ml_fact = ((ip>=f_ilu_n_).and.(ip<=f_ilu_e_)) is_legal_ml_fact = (ip==psb_f_ilu_n_)
return return
end function is_legal_ml_fact end function is_legal_ml_fact
function is_legal_ml_eps(ip) function is_legal_ml_eps(ip)

16
prec/psb_zbjac_aply.f90
Unescape Escape View File

@ -100,32 +100,32 @@ subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
endif endif
select case(prec%iprcparm(f_type_)) select case(prec%iprcparm(psb_f_type_))
case(f_ilu_n_,f_ilu_e_) case(psb_f_ilu_n_)
select case(trans_) select case(trans_)
case('N') case('N')
call psb_spsm(zone,prec%av(l_pr_),x,zzero,ww,desc_data,info,& call psb_spsm(zone,prec%av(psb_l_pr_),x,zzero,ww,desc_data,info,&
& trans=trans_,unit='L',diag=prec%d,choice=psb_none_,work=aux) & trans=trans_,unit='L',diag=prec%d,choice=psb_none_,work=aux)
if(info /=0) goto 9999 if(info /=0) goto 9999
call psb_spsm(alpha,prec%av(u_pr_),ww,beta,y,desc_data,info,& call psb_spsm(alpha,prec%av(psb_u_pr_),ww,beta,y,desc_data,info,&
& trans=trans_,unit='U',choice=psb_none_, work=aux) & trans=trans_,unit='U',choice=psb_none_, work=aux)
if(info /=0) goto 9999 if(info /=0) goto 9999
case('T') case('T')
call psb_spsm(zone,prec%av(u_pr_),x,zzero,ww,desc_data,info,& call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,ww,desc_data,info,&
& trans=trans_,unit='L',diag=prec%d,choice=psb_none_, work=aux) & trans=trans_,unit='L',diag=prec%d,choice=psb_none_, work=aux)
if(info /=0) goto 9999 if(info /=0) goto 9999
call psb_spsm(alpha,prec%av(l_pr_),ww,beta,y,desc_data,info,& call psb_spsm(alpha,prec%av(psb_l_pr_),ww,beta,y,desc_data,info,&
& trans=trans_,unit='U',choice=psb_none_,work=aux) & trans=trans_,unit='U',choice=psb_none_,work=aux)
if(info /=0) goto 9999 if(info /=0) goto 9999
case('C') case('C')
call psb_spsm(zone,prec%av(u_pr_),x,zzero,ww,desc_data,info,& call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,ww,desc_data,info,&
& trans=trans_,unit='L',diag=conjg(prec%d),choice=psb_none_, work=aux) & trans=trans_,unit='L',diag=conjg(prec%d),choice=psb_none_, work=aux)
if(info /=0) goto 9999 if(info /=0) goto 9999
call psb_spsm(alpha,prec%av(l_pr_),ww,beta,y,desc_data,info,& call psb_spsm(alpha,prec%av(psb_l_pr_),ww,beta,y,desc_data,info,&
& trans=trans_,unit='U',choice=psb_none_,work=aux) & trans=trans_,unit='U',choice=psb_none_,work=aux)
if(info /=0) goto 9999 if(info /=0) goto 9999

36
prec/psb_zbjac_bld.f90
Unescape Escape View File

@ -81,12 +81,12 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
end if end if
select case(p%iprcparm(f_type_)) select case(p%iprcparm(psb_f_type_))
case(f_ilu_n_,f_ilu_e_) case(psb_f_ilu_n_)
if (allocated(p%av)) then if (allocated(p%av)) then
if (size(p%av) < bp_ilu_avsz) then if (size(p%av) < psb_bp_ilu_avsz) then
do i=1,size(p%av) do i=1,size(p%av)
call psb_sp_free(p%av(i),info) call psb_sp_free(p%av(i),info)
if (info /= 0) then if (info /= 0) then
@ -99,7 +99,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
endif endif
end if end if
if (.not.allocated(p%av)) then if (.not.allocated(p%av)) then
allocate(p%av(max_avsz),stat=info) allocate(p%av(psb_max_avsz),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4000,name) call psb_errpush(4000,name)
goto 9999 goto 9999
@ -112,12 +112,12 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
n_col = psb_cd_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
nhalo = n_col-nrow_a nhalo = n_col-nrow_a
n_row = p%desc_data%matrix_data(psb_n_row_) n_row = p%desc_data%matrix_data(psb_n_row_)
p%av(l_pr_)%m = n_row p%av(psb_l_pr_)%m = n_row
p%av(l_pr_)%k = n_row p%av(psb_l_pr_)%k = n_row
p%av(u_pr_)%m = n_row p%av(psb_u_pr_)%m = n_row
p%av(u_pr_)%k = n_row p%av(psb_u_pr_)%k = n_row
call psb_sp_all(n_row,n_row,p%av(l_pr_),nztota,info) call psb_sp_all(n_row,n_row,p%av(psb_l_pr_),nztota,info)
if (info == 0) call psb_sp_all(n_row,n_row,p%av(u_pr_),nztota,info) if (info == 0) call psb_sp_all(n_row,n_row,p%av(psb_u_pr_),nztota,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010
ch_err='psb_sp_all' ch_err='psb_sp_all'
@ -142,7 +142,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
! This is where we have mo renumbering, thus no need ! This is where we have mo renumbering, thus no need
! for ATMP ! for ATMP
call psb_ilu_fct(a,p%av(l_pr_),p%av(u_pr_),p%d,info) call psb_ilu_fct(a,p%av(psb_l_pr_),p%av(psb_u_pr_),p%d,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010
ch_err='psb_ilu_fct' ch_err='psb_ilu_fct'
@ -150,24 +150,24 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
goto 9999 goto 9999
end if end if
if (psb_sp_getifld(psb_upd_,p%av(u_pr_),info) /= psb_upd_perm_) then if (psb_sp_getifld(psb_upd_,p%av(psb_u_pr_),info) /= psb_upd_perm_) then
call psb_sp_trim(p%av(u_pr_),info) call psb_sp_trim(p%av(psb_u_pr_),info)
endif endif
if (psb_sp_getifld(psb_upd_,p%av(l_pr_),info) /= psb_upd_perm_) then if (psb_sp_getifld(psb_upd_,p%av(psb_l_pr_),info) /= psb_upd_perm_) then
call psb_sp_trim(p%av(l_pr_),info) call psb_sp_trim(p%av(psb_l_pr_),info)
endif endif
case(f_none_) case(psb_f_none_)
info=4010 info=4010
ch_err='Inconsistent prec f_none_' ch_err='Inconsistent prec psb_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
info=4010 info=4010
ch_err='Unknown f_type_' ch_err='Unknown psb_f_type_'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end select end select

2
prec/psb_zgprec_aply.f90
Unescape Escape View File

@ -74,7 +74,7 @@ subroutine psb_zgprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
goto 9999 goto 9999
end select end select
select case(prec%iprcparm(p_type_)) select case(prec%iprcparm(psb_p_type_))
case(psb_noprec_) case(psb_noprec_)

10
prec/psb_zprecbld.f90
Unescape Escape View File

@ -81,12 +81,12 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd)
! ALso should define symbolic names for the preconditioners. ! ALso should define symbolic names for the preconditioners.
! !
call psb_check_def(p%iprcparm(p_type_),'base_prec',& call psb_check_def(p%iprcparm(psb_p_type_),'base_prec',&
& psb_diag_,is_legal_prec) & psb_diag_,is_legal_prec)
call psb_nullify_desc(p%desc_data) call psb_nullify_desc(p%desc_data)
select case(p%iprcparm(p_type_)) select case(p%iprcparm(psb_p_type_))
case (psb_noprec_) case (psb_noprec_)
! Do nothing. ! Do nothing.
call psb_cdcpy(desc_a,p%desc_data,info) call psb_cdcpy(desc_a,p%desc_data,info)
@ -109,8 +109,8 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd)
case (psb_bjac_) case (psb_bjac_)
call psb_check_def(p%iprcparm(f_type_),'fact',& call psb_check_def(p%iprcparm(psb_f_type_),'fact',&
& f_ilu_n_,is_legal_ml_fact) & psb_f_ilu_n_,is_legal_ml_fact)
call psb_bjac_bld(a,desc_a,p,upd_,info) call psb_bjac_bld(a,desc_a,p,upd_,info)
@ -121,7 +121,7 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd)
case default case default
info=4010 info=4010
ch_err='Unknown p_type_' ch_err='Unknown psb_p_type_'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999

18
prec/psb_zprecinit.f90
Unescape Escape View File

@ -40,27 +40,27 @@ subroutine psb_zprecinit(p,ptype,info)
info = 0 info = 0
call psb_realloc(ifpsz,p%iprcparm,info) call psb_realloc(psb_ifpsz,p%iprcparm,info)
if (info == 0) call psb_realloc(dfpsz,p%dprcparm,info) if (info == 0) call psb_realloc(psb_dfpsz,p%dprcparm,info)
if (info /= 0) return if (info /= 0) return
p%iprcparm(:) = 0 p%iprcparm(:) = 0
select case(toupper(ptype(1:len_trim(ptype)))) select case(toupper(ptype(1:len_trim(ptype))))
case ('NONE','NOPREC') case ('NONE','NOPREC')
p%iprcparm(:) = 0 p%iprcparm(:) = 0
p%iprcparm(p_type_) = psb_noprec_ p%iprcparm(psb_p_type_) = psb_noprec_
p%iprcparm(f_type_) = f_none_ p%iprcparm(psb_f_type_) = psb_f_none_
case ('DIAG') case ('DIAG')
p%iprcparm(:) = 0 p%iprcparm(:) = 0
p%iprcparm(p_type_) = psb_diag_ p%iprcparm(psb_p_type_) = psb_diag_
p%iprcparm(f_type_) = f_none_ p%iprcparm(psb_f_type_) = psb_f_none_
case ('BJAC') case ('BJAC')
p%iprcparm(:) = 0 p%iprcparm(:) = 0
p%iprcparm(p_type_) = psb_bjac_ p%iprcparm(psb_p_type_) = psb_bjac_
p%iprcparm(f_type_) = f_ilu_n_ p%iprcparm(psb_f_type_) = psb_f_ilu_n_
p%iprcparm(ilu_fill_in_) = 0 p%iprcparm(psb_ilu_fill_in_) = 0
case default case default
write(0,*) 'Unknown preconditioner type request "',ptype,'"' write(0,*) 'Unknown preconditioner type request "',ptype,'"'

32
prec/psb_zprecset.f90
Unescape Escape View File

@ -40,21 +40,21 @@ subroutine psb_zprecseti(p,what,val,info)
info = 0 info = 0
select case(what) select case(what)
case (f_type_) case (psb_f_type_)
if (p%iprcparm(p_type_) /= psb_bjac_) then if (p%iprcparm(psb_p_type_) /= psb_bjac_) then
write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(p_type_),& write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(psb_p_type_),&
& 'ignoring user specification' & 'ignoring user specification'
return return
endif endif
p%iprcparm(f_type_) = val p%iprcparm(psb_f_type_) = val
case (ilu_fill_in_) case (psb_ilu_fill_in_)
if ((p%iprcparm(p_type_) /= psb_bjac_).or.(p%iprcparm(f_type_) /= f_ilu_n_)) then if ((p%iprcparm(psb_p_type_) /= psb_bjac_).or.(p%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then
write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(p_type_),& write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(psb_p_type_),&
& 'ignoring user specification' & 'ignoring user specification'
return return
endif endif
p%iprcparm(ilu_fill_in_) = val p%iprcparm(psb_ilu_fill_in_) = val
case default case default
write(0,*) 'WHAT is invalid, ignoring user specification' write(0,*) 'WHAT is invalid, ignoring user specification'
@ -80,21 +80,21 @@ subroutine psb_zprecsetd(p,what,val,info)
! factorization. ! factorization.
! !
select case(what) select case(what)
!!$ case (f_type_) !!$ case (psb_f_type_)
!!$ if (p%iprcparm(p_type_) /= bjac_) then !!$ if (p%iprcparm(psb_p_type_) /= psb_bjac_) then
!!$ write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(p_type_),& !!$ write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(psb_p_type_),&
!!$ & 'ignoring user specification' !!$ & 'ignoring user specification'
!!$ return !!$ return
!!$ endif !!$ endif
!!$ p%iprcparm(f_type_) = val !!$ p%iprcparm(psb_f_type_) = val
!!$ !!$
!!$ case (ilu_fill_in_) !!$ case (psb_ilu_fill_in_)
!!$ if ((p%iprcparm(p_type_) /= bjac_).or.(p%iprcparm(f_type_) /= f_ilu_n_)) then !!$ if ((p%iprcparm(psb_p_type_) /= psb_bjac_).or.(p%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then
!!$ write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(p_type_),& !!$ write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(psb_p_type_),&
!!$ & 'ignoring user specification' !!$ & 'ignoring user specification'
!!$ return !!$ return
!!$ endif !!$ endif
!!$ p%iprcparm(ilu_fill_in_) = val !!$ p%iprcparm(psb_ilu_fill_in_) = val
case default case default
write(0,*) 'WHAT is invalid, ignoring user specification' write(0,*) 'WHAT is invalid, ignoring user specification'

Write Preview
Loading…
Cancel
Save