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
select case(prec%iprcparm(f_type_))
case(f_ilu_n_,f_ilu_e_)
select case(prec%iprcparm(psb_f_type_))
case(psb_f_ilu_n_)
select case(trans_)
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)
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)
if(info /=0) goto 9999
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)
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)
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
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 (size(p%av) < bp_ilu_avsz) then
if (size(p%av) < psb_bp_ilu_avsz) then
do i=1,size(p%av)
call psb_sp_free(p%av(i),info)
if (info /= 0) then
@ -99,7 +99,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
endif
end if
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
call psb_errpush(4000,name)
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)
nhalo = n_col-nrow_a
n_row = p%desc_data%matrix_data(psb_n_row_)
p%av(l_pr_)%m = n_row
p%av(l_pr_)%k = n_row
p%av(u_pr_)%m = n_row
p%av(u_pr_)%k = n_row
call psb_sp_all(n_row,n_row,p%av(l_pr_),nztota,info)
if (info == 0) call psb_sp_all(n_row,n_row,p%av(u_pr_),nztota,info)
p%av(psb_l_pr_)%m = n_row
p%av(psb_l_pr_)%k = n_row
p%av(psb_u_pr_)%m = n_row
p%av(psb_u_pr_)%k = n_row
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(psb_u_pr_),nztota,info)
if(info/=0) then
info=4010
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
! 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
info=4010
ch_err='psb_ilu_fct'
@ -150,24 +150,24 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
goto 9999
end if
if (psb_sp_getifld(psb_upd_,p%av(u_pr_),info) /= psb_upd_perm_) then
call psb_sp_trim(p%av(u_pr_),info)
if (psb_sp_getifld(psb_upd_,p%av(psb_u_pr_),info) /= psb_upd_perm_) then
call psb_sp_trim(p%av(psb_u_pr_),info)
endif
if (psb_sp_getifld(psb_upd_,p%av(l_pr_),info) /= psb_upd_perm_) then
call psb_sp_trim(p%av(l_pr_),info)
if (psb_sp_getifld(psb_upd_,p%av(psb_l_pr_),info) /= psb_upd_perm_) then
call psb_sp_trim(p%av(psb_l_pr_),info)
endif
case(f_none_)
case(psb_f_none_)
info=4010
ch_err='Inconsistent prec f_none_'
ch_err='Inconsistent prec psb_f_none_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
case default
info=4010
ch_err='Unknown f_type_'
ch_err='Unknown psb_f_type_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
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
end select
select case(prec%iprcparm(p_type_))
select case(prec%iprcparm(psb_p_type_))
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.
!
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)
call psb_nullify_desc(p%desc_data)
select case(p%iprcparm(p_type_))
select case(p%iprcparm(psb_p_type_))
case (psb_noprec_)
! Do nothing.
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_)
call psb_check_def(p%iprcparm(f_type_),'fact',&
& f_ilu_n_,is_legal_ml_fact)
call psb_check_def(p%iprcparm(psb_f_type_),'fact',&
& psb_f_ilu_n_,is_legal_ml_fact)
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
info=4010
ch_err='Unknown p_type_'
ch_err='Unknown psb_p_type_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999

18
prec/psb_dprecinit.f90
Unescape Escape View File

@ -39,27 +39,27 @@ subroutine psb_dprecinit(p,ptype,info)
info = 0
call psb_realloc(ifpsz,p%iprcparm,info)
if (info == 0) call psb_realloc(dfpsz,p%dprcparm,info)
call psb_realloc(psb_ifpsz,p%iprcparm,info)
if (info == 0) call psb_realloc(psb_dfpsz,p%dprcparm,info)
if (info /= 0) return
p%iprcparm(:) = 0
select case(toupper(ptype(1:len_trim(ptype))))
case ('NONE','NOPREC')
p%iprcparm(:) = 0
p%iprcparm(p_type_) = psb_noprec_
p%iprcparm(f_type_) = f_none_
p%iprcparm(psb_p_type_) = psb_noprec_
p%iprcparm(psb_f_type_) = psb_f_none_
case ('DIAG')
p%iprcparm(:) = 0
p%iprcparm(p_type_) = psb_diag_
p%iprcparm(f_type_) = f_none_
p%iprcparm(psb_p_type_) = psb_diag_
p%iprcparm(psb_f_type_) = psb_f_none_
case ('BJAC')
p%iprcparm(:) = 0
p%iprcparm(p_type_) = psb_bjac_
p%iprcparm(f_type_) = f_ilu_n_
p%iprcparm(ilu_fill_in_) = 0
p%iprcparm(psb_p_type_) = psb_bjac_
p%iprcparm(psb_f_type_) = psb_f_ilu_n_
p%iprcparm(psb_ilu_fill_in_) = 0
case default
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
select case(what)
case (f_type_)
if (p%iprcparm(p_type_) /= psb_bjac_) then
write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(p_type_),&
case (psb_f_type_)
if (p%iprcparm(psb_p_type_) /= psb_bjac_) then
write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
p%iprcparm(f_type_) = val
p%iprcparm(psb_f_type_) = val
case (ilu_fill_in_)
if ((p%iprcparm(p_type_) /= psb_bjac_).or.(p%iprcparm(f_type_) /= f_ilu_n_)) then
write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(p_type_),&
case (psb_ilu_fill_in_)
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(psb_p_type_),&
& 'ignoring user specification'
return
endif
p%iprcparm(ilu_fill_in_) = val
p%iprcparm(psb_ilu_fill_in_) = val
case default
write(0,*) 'WHAT is invalid, ignoring user specification'
@ -80,21 +80,21 @@ subroutine psb_dprecsetd(p,what,val,info)
! factorization.
!
select case(what)
!!$ case (f_type_)
!!$ if (p%iprcparm(p_type_) /= bjac_) then
!!$ write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(p_type_),&
!!$ case (psb_f_type_)
!!$ if (p%iprcparm(psb_p_type_) /= psb_bjac_) then
!!$ write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(psb_p_type_),&
!!$ & 'ignoring user specification'
!!$ return
!!$ endif
!!$ p%iprcparm(f_type_) = val
!!$ p%iprcparm(psb_f_type_) = val
!!$
!!$ case (ilu_fill_in_)
!!$ if ((p%iprcparm(p_type_) /= bjac_).or.(p%iprcparm(f_type_) /= f_ilu_n_)) then
!!$ write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(p_type_),&
!!$ case (psb_ilu_fill_in_)
!!$ 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(psb_p_type_),&
!!$ & 'ignoring user specification'
!!$ return
!!$ endif
!!$ p%iprcparm(ilu_fill_in_) = val
!!$ p%iprcparm(psb_ilu_fill_in_) = val
case default
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,
! number of overlap layers, pointer to SuperLU factors,
! levels of fill in for ILU(N),
integer, parameter :: p_type_=1, f_type_=2
integer, parameter :: ilu_fill_in_=8
integer, parameter :: psb_p_type_=1, psb_f_type_=2
integer, parameter :: psb_ilu_fill_in_=8
!Renumbering. SEE BELOW
integer, parameter :: renum_none_=0, renum_glb_=1, renum_gps_=2
integer, parameter :: ifpsz=10
integer, parameter :: psb_renum_none_=0, psb_renum_glb_=1, psb_renum_gps_=2
integer, parameter :: psb_ifpsz=10
! Entries in dprcparm: ILU(E) epsilon, smoother omega
integer, parameter :: fact_eps_=1
integer, parameter :: dfpsz=4
integer, parameter :: psb_fact_eps_=1
integer, parameter :: psb_dfpsz=4
! 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:
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, max_avsz=smth_avsz
integer, parameter :: psb_l_pr_=1, psb_u_pr_=2, psb_bp_ilu_avsz=2
integer, parameter :: psb_max_avsz=psb_bp_ilu_avsz
type psb_dprec_type
@ -128,14 +127,14 @@ contains
type(psb_dprec_type), intent(in) :: p
write(iout,*) 'Preconditioner description'
select case(p%iprcparm(p_type_))
select case(p%iprcparm(psb_p_type_))
case(psb_noprec_)
write(iout,*) 'No preconditioning'
case(psb_diag_)
write(iout,*) 'Diagonal scaling'
case(psb_bjac_)
write(iout,*) 'Block Jacobi with: ',&
& fact_names(p%iprcparm(f_type_))
& fact_names(p%iprcparm(psb_f_type_))
end select
end subroutine psb_file_prec_descr
@ -146,14 +145,14 @@ contains
type(psb_zprec_type), intent(in) :: p
write(iout,*) 'Preconditioner description'
select case(p%iprcparm(p_type_))
select case(p%iprcparm(psb_p_type_))
case(psb_noprec_)
write(iout,*) 'No preconditioning'
case(psb_diag_)
write(iout,*) 'Diagonal scaling'
case(psb_bjac_)
write(iout,*) 'Block Jacobi with: ',&
& fact_names(p%iprcparm(f_type_))
& fact_names(p%iprcparm(psb_f_type_))
end select
end subroutine psb_zfile_prec_descr
@ -163,7 +162,7 @@ contains
integer, intent(in) :: ip
logical :: is_legal_prec
is_legal_prec = ((ip>=noprec_).and.(ip<=bjac_))
is_legal_prec = ((ip>=psb_noprec_).and.(ip<=psb_bjac_))
return
end function is_legal_prec
function is_legal_ml_fact(ip)
@ -171,7 +170,7 @@ contains
integer, intent(in) :: ip
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
end function is_legal_ml_fact
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
select case(prec%iprcparm(f_type_))
case(f_ilu_n_,f_ilu_e_)
select case(prec%iprcparm(psb_f_type_))
case(psb_f_ilu_n_)
select case(trans_)
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)
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)
if(info /=0) goto 9999
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)
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)
if(info /=0) goto 9999
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)
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)
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
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 (size(p%av) < bp_ilu_avsz) then
if (size(p%av) < psb_bp_ilu_avsz) then
do i=1,size(p%av)
call psb_sp_free(p%av(i),info)
if (info /= 0) then
@ -99,7 +99,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
endif
end if
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
call psb_errpush(4000,name)
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)
nhalo = n_col-nrow_a
n_row = p%desc_data%matrix_data(psb_n_row_)
p%av(l_pr_)%m = n_row
p%av(l_pr_)%k = n_row
p%av(u_pr_)%m = n_row
p%av(u_pr_)%k = n_row
call psb_sp_all(n_row,n_row,p%av(l_pr_),nztota,info)
if (info == 0) call psb_sp_all(n_row,n_row,p%av(u_pr_),nztota,info)
p%av(psb_l_pr_)%m = n_row
p%av(psb_l_pr_)%k = n_row
p%av(psb_u_pr_)%m = n_row
p%av(psb_u_pr_)%k = n_row
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(psb_u_pr_),nztota,info)
if(info/=0) then
info=4010
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
! 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
info=4010
ch_err='psb_ilu_fct'
@ -150,24 +150,24 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
goto 9999
end if
if (psb_sp_getifld(psb_upd_,p%av(u_pr_),info) /= psb_upd_perm_) then
call psb_sp_trim(p%av(u_pr_),info)
if (psb_sp_getifld(psb_upd_,p%av(psb_u_pr_),info) /= psb_upd_perm_) then
call psb_sp_trim(p%av(psb_u_pr_),info)
endif
if (psb_sp_getifld(psb_upd_,p%av(l_pr_),info) /= psb_upd_perm_) then
call psb_sp_trim(p%av(l_pr_),info)
if (psb_sp_getifld(psb_upd_,p%av(psb_l_pr_),info) /= psb_upd_perm_) then
call psb_sp_trim(p%av(psb_l_pr_),info)
endif
case(f_none_)
case(psb_f_none_)
info=4010
ch_err='Inconsistent prec f_none_'
ch_err='Inconsistent prec psb_f_none_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
case default
info=4010
ch_err='Unknown f_type_'
ch_err='Unknown psb_f_type_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
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
end select
select case(prec%iprcparm(p_type_))
select case(prec%iprcparm(psb_p_type_))
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.
!
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)
call psb_nullify_desc(p%desc_data)
select case(p%iprcparm(p_type_))
select case(p%iprcparm(psb_p_type_))
case (psb_noprec_)
! Do nothing.
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_)
call psb_check_def(p%iprcparm(f_type_),'fact',&
& f_ilu_n_,is_legal_ml_fact)
call psb_check_def(p%iprcparm(psb_f_type_),'fact',&
& psb_f_ilu_n_,is_legal_ml_fact)
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
info=4010
ch_err='Unknown p_type_'
ch_err='Unknown psb_p_type_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999

18
prec/psb_zprecinit.f90
Unescape Escape View File

@ -40,27 +40,27 @@ subroutine psb_zprecinit(p,ptype,info)
info = 0
call psb_realloc(ifpsz,p%iprcparm,info)
if (info == 0) call psb_realloc(dfpsz,p%dprcparm,info)
call psb_realloc(psb_ifpsz,p%iprcparm,info)
if (info == 0) call psb_realloc(psb_dfpsz,p%dprcparm,info)
if (info /= 0) return
p%iprcparm(:) = 0
select case(toupper(ptype(1:len_trim(ptype))))
case ('NONE','NOPREC')
p%iprcparm(:) = 0
p%iprcparm(p_type_) = psb_noprec_
p%iprcparm(f_type_) = f_none_
p%iprcparm(psb_p_type_) = psb_noprec_
p%iprcparm(psb_f_type_) = psb_f_none_
case ('DIAG')
p%iprcparm(:) = 0
p%iprcparm(p_type_) = psb_diag_
p%iprcparm(f_type_) = f_none_
p%iprcparm(psb_p_type_) = psb_diag_
p%iprcparm(psb_f_type_) = psb_f_none_
case ('BJAC')
p%iprcparm(:) = 0
p%iprcparm(p_type_) = psb_bjac_
p%iprcparm(f_type_) = f_ilu_n_
p%iprcparm(ilu_fill_in_) = 0
p%iprcparm(psb_p_type_) = psb_bjac_
p%iprcparm(psb_f_type_) = psb_f_ilu_n_
p%iprcparm(psb_ilu_fill_in_) = 0
case default
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
select case(what)
case (f_type_)
if (p%iprcparm(p_type_) /= psb_bjac_) then
write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(p_type_),&
case (psb_f_type_)
if (p%iprcparm(psb_p_type_) /= psb_bjac_) then
write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
p%iprcparm(f_type_) = val
p%iprcparm(psb_f_type_) = val
case (ilu_fill_in_)
if ((p%iprcparm(p_type_) /= psb_bjac_).or.(p%iprcparm(f_type_) /= f_ilu_n_)) then
write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(p_type_),&
case (psb_ilu_fill_in_)
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(psb_p_type_),&
& 'ignoring user specification'
return
endif
p%iprcparm(ilu_fill_in_) = val
p%iprcparm(psb_ilu_fill_in_) = val
case default
write(0,*) 'WHAT is invalid, ignoring user specification'
@ -80,21 +80,21 @@ subroutine psb_zprecsetd(p,what,val,info)
! factorization.
!
select case(what)
!!$ case (f_type_)
!!$ if (p%iprcparm(p_type_) /= bjac_) then
!!$ write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(p_type_),&
!!$ case (psb_f_type_)
!!$ if (p%iprcparm(psb_p_type_) /= psb_bjac_) then
!!$ write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(psb_p_type_),&
!!$ & 'ignoring user specification'
!!$ return
!!$ endif
!!$ p%iprcparm(f_type_) = val
!!$ p%iprcparm(psb_f_type_) = val
!!$
!!$ case (ilu_fill_in_)
!!$ if ((p%iprcparm(p_type_) /= bjac_).or.(p%iprcparm(f_type_) /= f_ilu_n_)) then
!!$ write(0,*) 'WHAT is invalid for current preconditioner ',p%iprcparm(p_type_),&
!!$ case (psb_ilu_fill_in_)
!!$ 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(psb_p_type_),&
!!$ & 'ignoring user specification'
!!$ return
!!$ endif
!!$ p%iprcparm(ilu_fill_in_) = val
!!$ p%iprcparm(psb_ilu_fill_in_) = val
case default
write(0,*) 'WHAT is invalid, ignoring user specification'

Write Preview
Loading…
Cancel
Save