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

mld2p4-2:

Browse Source 
mlprec/mld_base_prec_type.F90
 mlprec/mld_c_as_smoother.f90
 mlprec/mld_c_base_smoother_mod.f90
 mlprec/mld_c_base_solver_mod.f90
 mlprec/mld_c_diag_solver.f90
 mlprec/mld_c_id_solver.f90
 mlprec/mld_c_ilu_solver.f90
 mlprec/mld_c_inner_mod.f90
 mlprec/mld_c_jac_smoother.f90
 mlprec/mld_c_onelev_mod.f90
 mlprec/mld_c_prec_mod.f90
 mlprec/mld_c_prec_type.f90
 mlprec/mld_d_as_smoother.f90
 mlprec/mld_d_base_smoother_mod.f90
 mlprec/mld_d_base_solver_mod.f90
 mlprec/mld_d_diag_solver.f90
 mlprec/mld_d_id_solver.f90
 mlprec/mld_d_ilu_solver.f90
 mlprec/mld_d_inner_mod.f90
 mlprec/mld_d_jac_smoother.f90
 mlprec/mld_d_onelev_mod.f90
 mlprec/mld_d_prec_mod.f90
 mlprec/mld_d_prec_type.f90
 mlprec/mld_s_as_smoother.f90
 mlprec/mld_s_base_smoother_mod.f90
 mlprec/mld_s_base_solver_mod.f90
 mlprec/mld_s_diag_solver.f90
 mlprec/mld_s_id_solver.f90
 mlprec/mld_s_ilu_solver.f90
 mlprec/mld_s_inner_mod.f90
 mlprec/mld_s_jac_smoother.f90
 mlprec/mld_s_onelev_mod.f90
 mlprec/mld_s_prec_mod.f90
 mlprec/mld_s_prec_type.f90
 mlprec/mld_z_as_smoother.f90
 mlprec/mld_z_base_smoother_mod.f90
 mlprec/mld_z_base_solver_mod.f90
 mlprec/mld_z_diag_solver.f90
 mlprec/mld_z_id_solver.f90
 mlprec/mld_z_ilu_solver.f90
 mlprec/mld_z_inner_mod.f90
 mlprec/mld_z_jac_smoother.f90
 mlprec/mld_z_onelev_mod.f90
 mlprec/mld_z_prec_mod.f90
 mlprec/mld_z_prec_type.f90

Step 1 of integer types parametrization for long integers.
stopcriterion
Salvatore Filippone 12 years ago
parent 88be17cba5
commit 8bb5a6011a
45 changed files with 2077 additions and 1888 deletions
Show Stats Download Patch File Download Diff File

313
mlprec/mld_base_prec_type.F90
Unescape Escape View File

@ -66,7 +66,7 @@ module mld_base_prec_type
use psb_const_mod
use psb_base_mod, only :&
& psb_desc_type,&
& psb_dpk_, psb_spk_, psb_long_int_k_, &
& psb_ipk_, psb_mpik_, psb_dpk_, psb_spk_, psb_long_int_k_, &
& psb_cdfree, psb_halo_, psb_none_, psb_sum_, psb_avg_, &
& psb_nohalo_, psb_square_root_, psb_toupper, psb_root_,&
& psb_sizeof_int, psb_sizeof_long_int, psb_sizeof_sp, psb_sizeof_dp, psb_sizeof,&
@ -80,14 +80,14 @@ module mld_base_prec_type
! Version numbers
!
character(len=*), parameter :: mld_version_string_ = "2.0.0"
integer, parameter :: mld_version_major_ = 2
integer, parameter :: mld_version_minor_ = 0
integer, parameter :: mld_patchlevel_ = 0
integer(psb_ipk_), parameter :: mld_version_major_ = 2
integer(psb_ipk_), parameter :: mld_version_minor_ = 0
integer(psb_ipk_), parameter :: mld_patchlevel_ = 0
type mld_aux_onelev_map_type
integer :: naggr
integer, allocatable :: ilaggr(:)
integer(psb_ipk_) :: naggr
integer(psb_ipk_), allocatable :: ilaggr(:)
end type mld_aux_onelev_map_type
type mld_aux_map_type
@ -95,11 +95,11 @@ module mld_base_prec_type
end type mld_aux_map_type
type mld_ml_parms
integer :: sweeps, sweeps_pre, sweeps_post
integer :: ml_type, smoother_pos
integer :: aggr_alg, aggr_kind
integer :: aggr_omega_alg, aggr_eig, aggr_filter
integer :: coarse_mat, coarse_solve
integer(psb_ipk_) :: sweeps, sweeps_pre, sweeps_post
integer(psb_ipk_) :: ml_type, smoother_pos
integer(psb_ipk_) :: aggr_alg, aggr_kind
integer(psb_ipk_) :: aggr_omega_alg, aggr_eig, aggr_filter
integer(psb_ipk_) :: coarse_mat, coarse_solve
contains
procedure, pass(pm) :: descr => ml_parms_descr
procedure, pass(pm) :: mldescr => ml_parms_mldescr
@ -128,166 +128,166 @@ module mld_base_prec_type
!
! These are in baseprec
!
integer, parameter :: mld_smoother_type_ = 1
integer, parameter :: mld_sub_solve_ = 2
integer, parameter :: mld_sub_restr_ = 3
integer, parameter :: mld_sub_prol_ = 4
integer, parameter :: mld_sub_ren_ = 5
integer, parameter :: mld_sub_ovr_ = 6
integer, parameter :: mld_sub_fillin_ = 7
integer, parameter :: mld_ilu_scale_ = 8
integer(psb_ipk_), parameter :: mld_smoother_type_ = 1
integer(psb_ipk_), parameter :: mld_sub_solve_ = 2
integer(psb_ipk_), parameter :: mld_sub_restr_ = 3
integer(psb_ipk_), parameter :: mld_sub_prol_ = 4
integer(psb_ipk_), parameter :: mld_sub_ren_ = 5
integer(psb_ipk_), parameter :: mld_sub_ovr_ = 6
integer(psb_ipk_), parameter :: mld_sub_fillin_ = 7
integer(psb_ipk_), parameter :: mld_ilu_scale_ = 8
!! 2 ints for 64 bit versions
integer, parameter :: mld_slu_ptr_ = 10
integer, parameter :: mld_umf_symptr_ = 12
integer, parameter :: mld_umf_numptr_ = 14
integer, parameter :: mld_slud_ptr_ = 16
integer, parameter :: mld_prec_status_ = 18
integer(psb_ipk_), parameter :: mld_slu_ptr_ = 10
integer(psb_ipk_), parameter :: mld_umf_symptr_ = 12
integer(psb_ipk_), parameter :: mld_umf_numptr_ = 14
integer(psb_ipk_), parameter :: mld_slud_ptr_ = 16
integer(psb_ipk_), parameter :: mld_prec_status_ = 18
!
! These are in onelev
!
integer, parameter :: mld_ml_type_ = 20
integer, parameter :: mld_smoother_sweeps_pre_ = 21
integer, parameter :: mld_smoother_sweeps_post_ = 22
integer, parameter :: mld_smoother_pos_ = 23
integer, parameter :: mld_aggr_kind_ = 24
integer, parameter :: mld_aggr_alg_ = 25
integer, parameter :: mld_aggr_omega_alg_ = 26
integer, parameter :: mld_aggr_eig_ = 27
integer, parameter :: mld_aggr_filter_ = 28
integer, parameter :: mld_coarse_mat_ = 29
integer, parameter :: mld_coarse_solve_ = 30
integer, parameter :: mld_coarse_sweeps_ = 31
integer, parameter :: mld_coarse_fillin_ = 32
integer, parameter :: mld_coarse_subsolve_ = 33
integer, parameter :: mld_smoother_sweeps_ = 34
integer, parameter :: mld_coarse_aggr_size_ = 35
integer, parameter :: mld_ifpsz_ = 36
integer(psb_ipk_), parameter :: mld_ml_type_ = 20
integer(psb_ipk_), parameter :: mld_smoother_sweeps_pre_ = 21
integer(psb_ipk_), parameter :: mld_smoother_sweeps_post_ = 22
integer(psb_ipk_), parameter :: mld_smoother_pos_ = 23
integer(psb_ipk_), parameter :: mld_aggr_kind_ = 24
integer(psb_ipk_), parameter :: mld_aggr_alg_ = 25
integer(psb_ipk_), parameter :: mld_aggr_omega_alg_ = 26
integer(psb_ipk_), parameter :: mld_aggr_eig_ = 27
integer(psb_ipk_), parameter :: mld_aggr_filter_ = 28
integer(psb_ipk_), parameter :: mld_coarse_mat_ = 29
integer(psb_ipk_), parameter :: mld_coarse_solve_ = 30
integer(psb_ipk_), parameter :: mld_coarse_sweeps_ = 31
integer(psb_ipk_), parameter :: mld_coarse_fillin_ = 32
integer(psb_ipk_), parameter :: mld_coarse_subsolve_ = 33
integer(psb_ipk_), parameter :: mld_smoother_sweeps_ = 34
integer(psb_ipk_), parameter :: mld_coarse_aggr_size_ = 35
integer(psb_ipk_), parameter :: mld_ifpsz_ = 36
!
! Legal values for entry: mld_smoother_type_
!
integer, parameter :: mld_min_prec_ = 0
integer, parameter :: mld_noprec_ = 0
integer, parameter :: mld_jac_ = 1
integer, parameter :: mld_bjac_ = 2
integer, parameter :: mld_as_ = 3
integer, parameter :: mld_max_prec_ = 3
integer(psb_ipk_), parameter :: mld_min_prec_ = 0
integer(psb_ipk_), parameter :: mld_noprec_ = 0
integer(psb_ipk_), parameter :: mld_jac_ = 1
integer(psb_ipk_), parameter :: mld_bjac_ = 2
integer(psb_ipk_), parameter :: mld_as_ = 3
integer(psb_ipk_), parameter :: mld_max_prec_ = 3
!
! This is a quick&dirty fix, but I have nothing better now...
!
! Legal values for entry: mld_sub_solve_
!
integer, parameter :: mld_slv_delta_ = mld_max_prec_+1
integer, parameter :: mld_f_none_ = mld_slv_delta_+0
integer, parameter :: mld_diag_scale_ = mld_slv_delta_+1
integer, parameter :: mld_ilu_n_ = mld_slv_delta_+2
integer, parameter :: mld_milu_n_ = mld_slv_delta_+3
integer, parameter :: mld_ilu_t_ = mld_slv_delta_+4
integer, parameter :: mld_slu_ = mld_slv_delta_+5
integer, parameter :: mld_umf_ = mld_slv_delta_+6
integer, parameter :: mld_sludist_ = mld_slv_delta_+7
integer, parameter :: mld_max_sub_solve_= mld_slv_delta_+7
integer, parameter :: mld_min_sub_solve_= mld_diag_scale_
integer(psb_ipk_), parameter :: mld_slv_delta_ = mld_max_prec_+1
integer(psb_ipk_), parameter :: mld_f_none_ = mld_slv_delta_+0
integer(psb_ipk_), parameter :: mld_diag_scale_ = mld_slv_delta_+1
integer(psb_ipk_), parameter :: mld_ilu_n_ = mld_slv_delta_+2
integer(psb_ipk_), parameter :: mld_milu_n_ = mld_slv_delta_+3
integer(psb_ipk_), parameter :: mld_ilu_t_ = mld_slv_delta_+4
integer(psb_ipk_), parameter :: mld_slu_ = mld_slv_delta_+5
integer(psb_ipk_), parameter :: mld_umf_ = mld_slv_delta_+6
integer(psb_ipk_), parameter :: mld_sludist_ = mld_slv_delta_+7
integer(psb_ipk_), parameter :: mld_max_sub_solve_= mld_slv_delta_+7
integer(psb_ipk_), parameter :: mld_min_sub_solve_= mld_diag_scale_
!
! Legal values for entry: mld_sub_ren_
!
integer, parameter :: mld_renum_none_=0
integer, parameter :: mld_renum_glb_=1
integer, parameter :: mld_renum_gps_=2
integer(psb_ipk_), parameter :: mld_renum_none_=0
integer(psb_ipk_), parameter :: mld_renum_glb_=1
integer(psb_ipk_), parameter :: mld_renum_gps_=2
! For the time being we are disabling GPS renumbering.
integer, parameter :: mld_max_renum_=1
integer(psb_ipk_), parameter :: mld_max_renum_=1
!
! Legal values for entry: mld_ilu_scale_
!
integer, parameter :: mld_ilu_scale_none_ = 0
integer, parameter :: mld_ilu_scale_maxval_ = 1
integer, parameter :: mld_ilu_scale_diag_ = 2
integer, parameter :: mld_ilu_scale_arwsum_ = 3
integer, parameter :: mld_ilu_scale_aclsum_ = 4
integer, parameter :: mld_ilu_scale_arcsum_ = 5
integer(psb_ipk_), parameter :: mld_ilu_scale_none_ = 0
integer(psb_ipk_), parameter :: mld_ilu_scale_maxval_ = 1
integer(psb_ipk_), parameter :: mld_ilu_scale_diag_ = 2
integer(psb_ipk_), parameter :: mld_ilu_scale_arwsum_ = 3
integer(psb_ipk_), parameter :: mld_ilu_scale_aclsum_ = 4
integer(psb_ipk_), parameter :: mld_ilu_scale_arcsum_ = 5
! For the time being enable only maxval scale
integer, parameter :: mld_max_ilu_scale_ = 1
integer(psb_ipk_), parameter :: mld_max_ilu_scale_ = 1
!
! Legal values for entry: mld_ml_type_
!
integer, parameter :: mld_no_ml_ = 0
integer, parameter :: mld_add_ml_ = 1
integer, parameter :: mld_mult_ml_ = 2
integer, parameter :: mld_new_ml_prec_ = 3
integer, parameter :: mld_max_ml_type_ = mld_mult_ml_
integer(psb_ipk_), parameter :: mld_no_ml_ = 0
integer(psb_ipk_), parameter :: mld_add_ml_ = 1
integer(psb_ipk_), parameter :: mld_mult_ml_ = 2
integer(psb_ipk_), parameter :: mld_new_ml_prec_ = 3
integer(psb_ipk_), parameter :: mld_max_ml_type_ = mld_mult_ml_
!
! Legal values for entry: mld_smoother_pos_
!
integer, parameter :: mld_pre_smooth_=1
integer, parameter :: mld_post_smooth_=2
integer, parameter :: mld_twoside_smooth_=3
integer, parameter :: mld_max_smooth_=mld_twoside_smooth_
integer(psb_ipk_), parameter :: mld_pre_smooth_=1
integer(psb_ipk_), parameter :: mld_post_smooth_=2
integer(psb_ipk_), parameter :: mld_twoside_smooth_=3
integer(psb_ipk_), parameter :: mld_max_smooth_=mld_twoside_smooth_
!
! Legal values for entry: mld_aggr_kind_
!
integer, parameter :: mld_no_smooth_ = 0
integer, parameter :: mld_smooth_prol_ = 1
integer, parameter :: mld_min_energy_ = 2
integer, parameter :: mld_biz_prol_ = 3
integer(psb_ipk_), parameter :: mld_no_smooth_ = 0
integer(psb_ipk_), parameter :: mld_smooth_prol_ = 1
integer(psb_ipk_), parameter :: mld_min_energy_ = 2
integer(psb_ipk_), parameter :: mld_biz_prol_ = 3
! Disabling biz_prol for the time being.
integer, parameter :: mld_max_aggr_kind_=mld_min_energy_
integer(psb_ipk_), parameter :: mld_max_aggr_kind_=mld_min_energy_
!
! Legal values for entry: mld_aggr_filter_
!
integer, parameter :: mld_no_filter_mat_=0
integer, parameter :: mld_filter_mat_=1
integer, parameter :: mld_max_filter_mat_=mld_no_filter_mat_
integer(psb_ipk_), parameter :: mld_no_filter_mat_=0
integer(psb_ipk_), parameter :: mld_filter_mat_=1
integer(psb_ipk_), parameter :: mld_max_filter_mat_=mld_no_filter_mat_
!
! Legal values for entry: mld_aggr_alg_
!
integer, parameter :: mld_dec_aggr_=0
integer, parameter :: mld_sym_dec_aggr_=1
integer, parameter :: mld_glb_aggr_=2
integer, parameter :: mld_new_dec_aggr_=3
integer, parameter :: mld_new_glb_aggr_=4
integer, parameter :: mld_max_aggr_alg_=mld_dec_aggr_
integer(psb_ipk_), parameter :: mld_dec_aggr_=0
integer(psb_ipk_), parameter :: mld_sym_dec_aggr_=1
integer(psb_ipk_), parameter :: mld_glb_aggr_=2
integer(psb_ipk_), parameter :: mld_new_dec_aggr_=3
integer(psb_ipk_), parameter :: mld_new_glb_aggr_=4
integer(psb_ipk_), parameter :: mld_max_aggr_alg_=mld_dec_aggr_
!
! Legal values for entry: mld_aggr_omega_alg_
!
integer, parameter :: mld_eig_est_=0
integer, parameter :: mld_user_choice_=999
integer(psb_ipk_), parameter :: mld_eig_est_=0
integer(psb_ipk_), parameter :: mld_user_choice_=999
!
! Legal values for entry: mld_aggr_eig_
!
integer, parameter :: mld_max_norm_=0
integer(psb_ipk_), parameter :: mld_max_norm_=0
!
! Legal values for entry: mld_coarse_mat_
!
integer, parameter :: mld_distr_mat_=0
integer, parameter :: mld_repl_mat_=1
integer, parameter :: mld_max_coarse_mat_=mld_repl_mat_
integer(psb_ipk_), parameter :: mld_distr_mat_=0
integer(psb_ipk_), parameter :: mld_repl_mat_=1
integer(psb_ipk_), parameter :: mld_max_coarse_mat_=mld_repl_mat_
!
! Legal values for entry: mld_prec_status_
!
integer, parameter :: mld_prec_built_=98765
integer(psb_ipk_), parameter :: mld_prec_built_=98765
!
! Entries in rprcparm: ILU(k,t) threshold, smoothed aggregation omega
!
integer, parameter :: mld_sub_iluthrs_ = 1
integer, parameter :: mld_aggr_omega_val_ = 2
integer, parameter :: mld_aggr_thresh_ = 3
integer, parameter :: mld_coarse_iluthrs_ = 4
integer, parameter :: mld_rfpsz_ = 8
integer(psb_ipk_), parameter :: mld_sub_iluthrs_ = 1
integer(psb_ipk_), parameter :: mld_aggr_omega_val_ = 2
integer(psb_ipk_), parameter :: mld_aggr_thresh_ = 3
integer(psb_ipk_), parameter :: mld_coarse_iluthrs_ = 4
integer(psb_ipk_), parameter :: mld_rfpsz_ = 8
!
! Fields for sparse matrices ensembles stored in av()
!
integer, parameter :: mld_l_pr_=1
integer, parameter :: mld_u_pr_=2
integer, parameter :: mld_bp_ilu_avsz_=2
integer, parameter :: mld_ap_nd_=3
integer, parameter :: mld_ac_=4
integer, parameter :: mld_sm_pr_t_=5
integer, parameter :: mld_sm_pr_=6
integer, parameter :: mld_smth_avsz_=6
integer, parameter :: mld_max_avsz_=mld_smth_avsz_
integer(psb_ipk_), parameter :: mld_l_pr_=1
integer(psb_ipk_), parameter :: mld_u_pr_=2
integer(psb_ipk_), parameter :: mld_bp_ilu_avsz_=2
integer(psb_ipk_), parameter :: mld_ap_nd_=3
integer(psb_ipk_), parameter :: mld_ac_=4
integer(psb_ipk_), parameter :: mld_sm_pr_t_=5
integer(psb_ipk_), parameter :: mld_sm_pr_=6
integer(psb_ipk_), parameter :: mld_smth_avsz_=6
integer(psb_ipk_), parameter :: mld_max_avsz_=mld_smth_avsz_
!
! Character constants used by mld_file_prec_descr
@ -349,7 +349,7 @@ contains
implicit none
! Arguments
character(len=*), intent(in) :: string
integer, intent(out) :: val, info
integer(psb_ipk_), intent(out) :: val, info
character(len=*), parameter :: name='mld_stringval'
info = psb_success_
@ -444,7 +444,7 @@ contains
subroutine ml_parms_printout(pm,iout)
implicit none
class(mld_ml_parms), intent(in) :: pm
integer, intent(in) :: iout
integer(psb_ipk_), intent(in) :: iout
write(iout,*) 'Sweeps: ',pm%sweeps,pm%sweeps_pre,pm%sweeps_post
write(iout,*) 'ML : ',pm%ml_type,pm%smoother_pos
@ -457,7 +457,7 @@ contains
subroutine s_ml_parms_printout(pm,iout)
implicit none
class(mld_sml_parms), intent(in) :: pm
integer, intent(in) :: iout
integer(psb_ipk_), intent(in) :: iout
call pm%mld_ml_parms%printout(iout)
write(iout,*) 'REAL : ',pm%aggr_omega_val,pm%aggr_thresh
@ -467,7 +467,7 @@ contains
subroutine d_ml_parms_printout(pm,iout)
implicit none
class(mld_dml_parms), intent(in) :: pm
integer, intent(in) :: iout
integer(psb_ipk_), intent(in) :: iout
call pm%mld_ml_parms%printout(iout)
write(iout,*) 'REAL : ',pm%aggr_omega_val,pm%aggr_thresh
@ -484,8 +484,8 @@ contains
! Arguments
class(mld_ml_parms), intent(in) :: pm
integer, intent(in) :: iout
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (pm%ml_type>mld_no_ml_) then
@ -540,8 +540,8 @@ contains
! Arguments
class(mld_ml_parms), intent(in) :: pm
integer, intent(in) :: iout
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
info = psb_success_
write(iout,*) ' Coarsest matrix: ',&
@ -563,8 +563,8 @@ contains
! Arguments
class(mld_ml_parms), intent(in) :: pm
integer, intent(in) :: iout
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
logical :: coarse_
@ -589,8 +589,8 @@ contains
! Arguments
class(mld_sml_parms), intent(in) :: pm
integer, intent(in) :: iout
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
info = psb_success_
@ -611,8 +611,8 @@ contains
! Arguments
class(mld_dml_parms), intent(in) :: pm
integer, intent(in) :: iout
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
info = psb_success_
@ -634,7 +634,7 @@ contains
function is_legal_base_prec(ip)
implicit none
integer, intent(in) :: ip
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_base_prec
is_legal_base_prec = ((ip>=mld_noprec_).and.(ip<=mld_max_prec_))
@ -642,7 +642,7 @@ contains
end function is_legal_base_prec
function is_legal_n_ovr(ip)
implicit none
integer, intent(in) :: ip
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_n_ovr
is_legal_n_ovr = (ip >= 0)
@ -650,21 +650,21 @@ contains
end function is_legal_n_ovr
function is_legal_renum(ip)
implicit none
integer, intent(in) :: ip
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_renum
is_legal_renum = ((ip >= 0).and.(ip <= mld_max_renum_))
return
end function is_legal_renum
function is_legal_ilu_scale(ip)
implicit none
integer, intent(in) :: ip
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ilu_scale
is_legal_ilu_scale = ((ip >= mld_ilu_scale_none_).and.(ip <= mld_max_ilu_scale_))
return
end function is_legal_ilu_scale
function is_legal_jac_sweeps(ip)
implicit none
integer, intent(in) :: ip
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_jac_sweeps
is_legal_jac_sweeps = (ip >= 1)
@ -672,21 +672,21 @@ contains
end function is_legal_jac_sweeps
function is_legal_prolong(ip)
implicit none
integer, intent(in) :: ip
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_prolong
is_legal_prolong = ((ip>=psb_none_).and.(ip<=psb_square_root_))
return
end function is_legal_prolong
function is_legal_restrict(ip)
implicit none
integer, intent(in) :: ip
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_restrict
is_legal_restrict = ((ip == psb_nohalo_).or.(ip==psb_halo_))
return
end function is_legal_restrict
function is_legal_ml_type(ip)
implicit none
integer, intent(in) :: ip
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_type
is_legal_ml_type = ((ip>=mld_no_ml_).and.(ip<=mld_max_ml_type_))
@ -694,7 +694,7 @@ contains
end function is_legal_ml_type
function is_legal_ml_aggr_alg(ip)
implicit none
integer, intent(in) :: ip
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_aggr_alg
is_legal_ml_aggr_alg = ((ip>=mld_dec_aggr_).and.(ip<=mld_max_aggr_alg_))
@ -702,7 +702,7 @@ contains
end function is_legal_ml_aggr_alg
function is_legal_ml_aggr_omega_alg(ip)
implicit none
integer, intent(in) :: ip
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_aggr_omega_alg
is_legal_ml_aggr_omega_alg = ((ip == mld_eig_est_).or.(ip==mld_user_choice_))
@ -710,7 +710,7 @@ contains
end function is_legal_ml_aggr_omega_alg
function is_legal_ml_aggr_eig(ip)
implicit none
integer, intent(in) :: ip
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_aggr_eig
is_legal_ml_aggr_eig = (ip == mld_max_norm_)
@ -718,7 +718,7 @@ contains
end function is_legal_ml_aggr_eig
function is_legal_ml_smooth_pos(ip)
implicit none
integer, intent(in) :: ip
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_smooth_pos
is_legal_ml_smooth_pos = ((ip>=mld_pre_smooth_).and.(ip<=mld_max_smooth_))
@ -726,7 +726,7 @@ contains
end function is_legal_ml_smooth_pos
function is_legal_ml_aggr_kind(ip)
implicit none
integer, intent(in) :: ip
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_aggr_kind
is_legal_ml_aggr_kind = ((ip>=0).and.(ip<=mld_max_aggr_kind_))
@ -734,7 +734,7 @@ contains
end function is_legal_ml_aggr_kind
function is_legal_ml_coarse_mat(ip)
implicit none
integer, intent(in) :: ip
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_coarse_mat
is_legal_ml_coarse_mat = ((ip>=0).and.(ip<=mld_max_coarse_mat_))
@ -742,7 +742,7 @@ contains
end function is_legal_ml_coarse_mat
function is_legal_aggr_filter(ip)
implicit none
integer, intent(in) :: ip
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_aggr_filter
is_legal_aggr_filter = ((ip>=0).and.(ip<=mld_max_filter_mat_))
@ -750,7 +750,7 @@ contains
end function is_legal_aggr_filter
function is_distr_ml_coarse_mat(ip)
implicit none
integer, intent(in) :: ip
integer(psb_ipk_), intent(in) :: ip
logical :: is_distr_ml_coarse_mat
is_distr_ml_coarse_mat = (ip == mld_distr_mat_)
@ -758,7 +758,7 @@ contains
end function is_distr_ml_coarse_mat
function is_legal_ml_fact(ip)
implicit none
integer, intent(in) :: ip
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_fact
! Here the minimum is really 1, mld_fact_none_ is not acceptable.
is_legal_ml_fact = ((ip>=mld_min_sub_solve_)&
@ -767,7 +767,7 @@ contains
end function is_legal_ml_fact
function is_legal_ilu_fact(ip)
implicit none
integer, intent(in) :: ip
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ilu_fact
is_legal_ilu_fact = ((ip==mld_ilu_n_).or.&
@ -776,7 +776,7 @@ contains
end function is_legal_ilu_fact
function is_legal_ml_lev(ip)
implicit none
integer, intent(in) :: ip
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_lev
is_legal_ml_lev = (ip >= 0)
@ -833,12 +833,13 @@ contains
subroutine mld_icheck_def(ip,name,id,is_legal)
implicit none
integer, intent(inout) :: ip
integer, intent(in) :: id
integer(psb_ipk_), intent(inout) :: ip
integer(psb_ipk_), intent(in) :: id
character(len=*), intent(in) :: name
interface
function is_legal(i)
integer, intent(in) :: i
import :: psb_ipk_
integer(psb_ipk_), intent(in) :: i
logical :: is_legal
end function is_legal
end interface
@ -897,7 +898,7 @@ contains
function pr_to_str(iprec)
implicit none
integer, intent(in) :: iprec
integer(psb_ipk_), intent(in) :: iprec
character(len=10) :: pr_to_str
select case(iprec)
@ -916,9 +917,9 @@ contains
subroutine mld_ml_bcast(ictxt,dat,root)
implicit none
integer, intent(in) :: ictxt
integer(psb_mpik_), intent(in) :: ictxt
type(mld_ml_parms), intent(inout) :: dat
integer, intent(in), optional :: root
integer(psb_mpik_), intent(in), optional :: root
call psb_bcast(ictxt,dat%sweeps,root)
call psb_bcast(ictxt,dat%sweeps_pre,root)
@ -938,9 +939,9 @@ contains
subroutine mld_sml_bcast(ictxt,dat,root)
implicit none
integer, intent(in) :: ictxt
integer(psb_mpik_), intent(in) :: ictxt
type(mld_sml_parms), intent(inout) :: dat
integer, intent(in), optional :: root
integer(psb_mpik_), intent(in), optional :: root
call psb_bcast(ictxt,dat%mld_ml_parms,root)
call psb_bcast(ictxt,dat%aggr_omega_val,root)
@ -949,9 +950,9 @@ contains
subroutine mld_dml_bcast(ictxt,dat,root)
implicit none
integer, intent(in) :: ictxt
integer(psb_mpik_), intent(in) :: ictxt
type(mld_dml_parms), intent(inout) :: dat
integer, intent(in), optional :: root
integer(psb_mpik_), intent(in), optional :: root
call psb_bcast(ictxt,dat%mld_ml_parms,root)
call psb_bcast(ictxt,dat%aggr_omega_val,root)

96
mlprec/mld_c_as_smoother.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010,2012
!!$ (C) Copyright 2008,2009,2010,2010,2012
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -52,8 +52,8 @@ module mld_c_as_smoother
! class(mld_c_base_solver_type), allocatable :: sv
!
type(psb_cspmat_type) :: nd
type(psb_desc_type) :: desc_data
integer :: novr, restr, prol, nd_nnz_tot
type(psb_desc_type) :: desc_data
integer(psb_ipk_) :: novr, restr, prol, nd_nnz_tot
contains
procedure, pass(sm) :: check => mld_c_as_smoother_check
procedure, pass(sm) :: dump => mld_c_as_smoother_dmp
@ -83,41 +83,44 @@ module mld_c_as_smoother
interface
subroutine mld_c_as_smoother_check(sm,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
class(mld_c_as_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_as_smoother_check
end interface
interface
subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_as_smoother_type), intent(inout) :: sm
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
complex(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_as_smoother_apply_vect
end interface
interface
subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_as_smoother_type), intent(in) :: sm
complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_as_smoother_apply
end interface
@ -125,12 +128,13 @@ module mld_c_as_smoother
subroutine mld_c_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, &
& psb_desc_type, psb_c_base_sparse_mat
type(psb_cspmat_type), intent(in), target :: a
& psb_desc_type, psb_c_base_sparse_mat, psb_ipk_
implicit none
type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_c_as_smoother_type), intent(inout) :: sm
class(mld_c_as_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
end subroutine mld_c_as_smoother_bld
@ -139,52 +143,59 @@ module mld_c_as_smoother
interface
subroutine mld_c_as_smoother_seti(sm,what,val,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
class(mld_c_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_as_smoother_seti
end interface
interface
subroutine mld_c_as_smoother_setc(sm,what,val,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
class(mld_c_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_as_smoother_setc
end interface
interface
subroutine mld_c_as_smoother_setr(sm,what,val,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
class(mld_c_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_as_smoother_setr
end interface
interface
subroutine mld_c_as_smoother_free(sm,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
class(mld_c_as_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_as_smoother_free
end interface
interface
subroutine mld_c_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type, &
& psb_ipk_, psb_mpik_
implicit none
class(mld_c_as_smoother_type), intent(in) :: sm
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver
end subroutine mld_c_as_smoother_dmp
@ -197,7 +208,7 @@ contains
! Arguments
class(mld_c_as_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = psb_sizeof_int
if (allocated(sm%sv)) val = val + sm%sv%sizeof()
@ -210,7 +221,7 @@ contains
implicit none
class(mld_c_as_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sm%sv)) &
& val = sm%sv%get_nzeros()
@ -247,15 +258,14 @@ contains
! Arguments
class(mld_c_as_smoother_type), intent(in) :: sm
integer, intent(out) :: info
integer, intent(in), optional :: iout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_c_as_smoother_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
logical :: coarse_
call psb_erractionsave(err_act)

91
mlprec/mld_c_base_smoother_mod.f90
Unescape Escape View File

@ -118,16 +118,17 @@ module mld_c_base_smoother_mod
interface
subroutine mld_c_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_base_smoother_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_smoother_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_base_smoother_type), intent(in) :: sm
complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_smoother_apply
end interface
@ -135,74 +136,80 @@ module mld_c_base_smoother_mod
subroutine mld_c_base_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
& trans,sweeps,work,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_base_smoother_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_smoother_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_base_smoother_type), intent(inout) :: sm
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
complex(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_smoother_apply_vect
end interface
interface
subroutine mld_c_base_smoother_check(sm,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_base_smoother_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_smoother_type, psb_ipk_
! Arguments
class(mld_c_base_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_smoother_check
end interface
interface
subroutine mld_c_base_smoother_seti(sm,what,val,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_base_smoother_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_smoother_type, psb_ipk_
! Arguments
class(mld_c_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_smoother_seti
end interface
interface
subroutine mld_c_base_smoother_setc(sm,what,val,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_base_smoother_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_smoother_type, psb_ipk_
class(mld_c_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_smoother_setc
end interface
interface
subroutine mld_c_base_smoother_setr(sm,what,val,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_base_smoother_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_smoother_type, psb_ipk_
! Arguments
class(mld_c_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_smoother_setr
end interface
interface
subroutine mld_c_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_base_smoother_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_smoother_type, psb_ipk_
! Arguments
type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_c_base_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
end subroutine mld_c_base_smoother_bld
@ -211,32 +218,36 @@ module mld_c_base_smoother_mod
interface
subroutine mld_c_base_smoother_free(sm,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_base_smoother_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_smoother_type, psb_ipk_
! Arguments
class(mld_c_base_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_smoother_free
end interface
interface
subroutine mld_c_base_smoother_descr(sm,info,iout,coarse)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_base_smoother_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_smoother_type, psb_ipk_
! Arguments
class(mld_c_base_smoother_type), intent(in) :: sm
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine mld_c_base_smoother_descr
end interface
interface
subroutine mld_c_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_base_smoother_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_smoother_type, psb_ipk_, psb_mpik_
class(mld_c_base_smoother_type), intent(in) :: sm
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver
end subroutine mld_c_base_smoother_dmp
@ -252,7 +263,7 @@ contains
implicit none
class(mld_c_base_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sm%sv)) &
& val = sm%sv%get_nzeros()
@ -263,7 +274,7 @@ contains
! Arguments
class(mld_c_base_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sm%sv)) then

97
mlprec/mld_c_base_solver_mod.f90
Unescape Escape View File

@ -108,15 +108,17 @@ module mld_c_base_solver_mod
interface
subroutine mld_c_base_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_base_solver_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_solver_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_base_solver_type), intent(in) :: sv
complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_solver_apply
end interface
@ -124,32 +126,33 @@ module mld_c_base_solver_mod
interface
subroutine mld_c_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_base_solver_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_solver_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_base_solver_type), intent(inout) :: sv
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_solver_apply_vect
end interface
interface
subroutine mld_c_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_base_solver_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_solver_type, psb_ipk_
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_c_base_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type), intent(in), target, optional :: b
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
@ -159,84 +162,85 @@ module mld_c_base_solver_mod
interface
subroutine mld_c_base_solver_check(sv,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_base_solver_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_solver_check
end interface
interface
subroutine mld_c_base_solver_seti(sv,what,val,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_base_solver_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_solver_seti
end interface
interface
subroutine mld_c_base_solver_setc(sv,what,val,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_base_solver_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_solver_setc
end interface
interface
subroutine mld_c_base_solver_setr(sv,what,val,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_base_solver_type
Implicit None
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_solver_setr
end interface
interface
subroutine mld_c_base_solver_free(sv,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_base_solver_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_solver_free
end interface
interface
subroutine mld_c_base_solver_descr(sv,info,iout,coarse)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_base_solver_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_c_base_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine mld_c_base_solver_descr
end interface
@ -244,12 +248,13 @@ module mld_c_base_solver_mod
interface
subroutine mld_c_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_base_solver_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_solver_type, psb_ipk_, psb_mpik_
implicit none
class(mld_c_base_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
end subroutine mld_c_base_solver_dmp
@ -269,7 +274,7 @@ contains
! Arguments
class(mld_c_base_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
return
@ -279,7 +284,7 @@ contains
implicit none
class(mld_c_base_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
end function c_base_solver_get_nzeros

78
mlprec/mld_c_diag_solver.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010,2012
!!$ (C) Copyright 2008,2009,2010,2010,2012
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -73,42 +73,45 @@ module mld_c_diag_solver
interface
subroutine mld_c_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_diag_solver_type
type(psb_desc_type), intent(in) :: desc_data
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_diag_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_diag_solver_type), intent(inout) :: sv
type(psb_c_vect_type), intent(inout) :: x
type(psb_c_vect_type), intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_diag_solver_apply_vect
end interface
interface
subroutine mld_c_diag_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_diag_solver_type
type(psb_desc_type), intent(in) :: desc_data
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_diag_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_diag_solver_type), intent(in) :: sv
complex(psb_spk_), intent(inout) :: x(:)
complex(psb_spk_), intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_diag_solver_apply
end interface
interface
subroutine mld_c_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_diag_solver_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_diag_solver_type, psb_ipk_
type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_c_diag_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type), intent(in), target, optional :: b
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
@ -125,10 +128,10 @@ contains
! Arguments
class(mld_c_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act
character(len=20) :: name='c_diag_solver_seti'
info = psb_success_
@ -144,10 +147,10 @@ contains
! Arguments
class(mld_c_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='c_diag_solver_setc'
info = psb_success_
@ -161,10 +164,10 @@ contains
! Arguments
class(mld_c_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act
character(len=20) :: name='c_diag_solver_setr'
info = psb_success_
@ -179,9 +182,9 @@ contains
! Arguments
class(mld_c_diag_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='c_diag_solver_free'
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_diag_solver_free'
call psb_erractionsave(err_act)
info = psb_success_
@ -215,15 +218,14 @@ contains
! Arguments
class(mld_c_diag_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_c_diag_solver_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
info = psb_success_
if (present(iout)) then
@ -243,7 +245,7 @@ contains
! Arguments
class(mld_c_diag_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sv%dv)) val = val + sv%dv%sizeof()
@ -256,7 +258,7 @@ contains
! Arguments
class(mld_c_diag_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sv%dv)) val = val + sv%dv%get_nrows()

75
mlprec/mld_c_id_solver.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010,2012
!!$ (C) Copyright 2008,2009,2010,2010,2012
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -68,22 +68,24 @@ module mld_c_id_solver
interface
subroutine mld_c_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_id_solver_type
type(psb_desc_type), intent(in) :: desc_data
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_id_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_id_solver_type), intent(inout) :: sv
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_id_solver_apply_vect
end interface
interface
subroutine mld_c_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, mld_c_id_solver_type
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_id_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_id_solver_type), intent(in) :: sv
complex(psb_spk_),intent(inout) :: x(:)
@ -91,7 +93,7 @@ module mld_c_id_solver
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_id_solver_apply
end interface
@ -104,17 +106,17 @@ contains
! Arguments
type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_c_id_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type), intent(in), target, optional :: b
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
! Local variables
integer :: n_row,n_col, nrow_a, nztota
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
character(len=20) :: name='c_id_solver_bld', ch_err
info=psb_success_
@ -129,11 +131,11 @@ contains
! Arguments
class(mld_c_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='c_id_solver_seti'
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_id_solver_seti'
info = psb_success_
@ -147,11 +149,11 @@ contains
! Arguments
class(mld_c_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
character(len=20) :: name='c_id_solver_setc'
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='c_id_solver_setc'
info = psb_success_
@ -164,11 +166,11 @@ contains
! Arguments
class(mld_c_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='c_id_solver_setr'
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_id_solver_setr'
info = psb_success_
@ -182,9 +184,9 @@ contains
! Arguments
class(mld_c_id_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='c_id_solver_free'
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_id_solver_free'
info = psb_success_
@ -197,15 +199,14 @@ contains
! Arguments
class(mld_c_id_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_c_id_solver_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
info = psb_success_
if (present(iout)) then

97
mlprec/mld_c_ilu_solver.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010,2012
!!$ (C) Copyright 2008,2009,2010,2010,2012
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -49,11 +49,11 @@ module mld_c_ilu_solver
use mld_c_ilu_fact_mod
type, extends(mld_c_base_solver_type) :: mld_c_ilu_solver_type
type(psb_cspmat_type) :: l, u
type(psb_cspmat_type) :: l, u
complex(psb_spk_), allocatable :: d(:)
type(psb_c_vect_type) :: dv
integer :: fact_type, fill_in
real(psb_spk_) :: thresh
type(psb_c_vect_type) :: dv
integer(psb_ipk_) :: fact_type, fill_in
real(psb_spk_) :: thresh
contains
procedure, pass(sv) :: dump => mld_c_ilu_solver_dmp
procedure, pass(sv) :: build => mld_c_ilu_solver_bld
@ -90,42 +90,45 @@ module mld_c_ilu_solver
interface
subroutine mld_c_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, mld_c_ilu_solver_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_ilu_solver_type), intent(inout) :: sv
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_ilu_solver_apply_vect
end interface
interface
subroutine mld_c_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, mld_c_ilu_solver_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_ilu_solver_type), intent(in) :: sv
complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_ilu_solver_apply
end interface
interface
subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
import :: psb_desc_type, mld_c_ilu_solver_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
implicit none
type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_c_ilu_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type), intent(in), target, optional :: b
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
@ -135,12 +138,15 @@ module mld_c_ilu_solver
interface
subroutine mld_c_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
import :: psb_desc_type, mld_c_ilu_solver_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, &
& psb_ipk_, psb_mpik_
implicit none
class(mld_c_ilu_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
end subroutine mld_c_ilu_solver_dmp
end interface
@ -167,8 +173,8 @@ contains
! Arguments
class(mld_c_ilu_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_ilu_solver_check'
call psb_erractionsave(err_act)
@ -180,7 +186,7 @@ contains
select case(sv%fact_type)
case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(sv%fill_in,&
& 'Level',0,is_legal_ml_lev)
& 'Level',izero,is_legal_ml_lev)
case(mld_ilu_t_)
call mld_check_def(sv%thresh,&
& 'Eps',szero,is_legal_s_fact_thrs)
@ -207,10 +213,10 @@ contains
! Arguments
class(mld_c_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_ilu_solver_seti'
info = psb_success_
@ -244,10 +250,10 @@ contains
! Arguments
class(mld_c_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='c_ilu_solver_setc'
info = psb_success_
@ -280,10 +286,10 @@ contains
! Arguments
class(mld_c_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_ilu_solver_setr'
call psb_erractionsave(err_act)
@ -316,8 +322,8 @@ contains
! Arguments
class(mld_c_ilu_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_ilu_solver_free'
call psb_erractionsave(err_act)
@ -353,15 +359,14 @@ contains
! Arguments
class(mld_c_ilu_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_c_ilu_solver_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
call psb_erractionsave(err_act)
info = psb_success_
@ -399,7 +404,7 @@ contains
! Arguments
class(mld_c_ilu_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
val = val + sv%dv%get_nrows()
@ -415,7 +420,7 @@ contains
! Arguments
class(mld_c_ilu_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 2*psb_sizeof_int + (2*psb_sizeof_sp)
val = val + sv%dv%sizeof()

79
mlprec/mld_c_inner_mod.f90
Unescape Escape View File

@ -50,13 +50,13 @@ module mld_c_inner_mod
interface mld_mlprec_bld
subroutine mld_cmlprec_bld(a,desc_a,prec,info, amold, vmold)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, &
& psb_spk_, psb_c_base_sparse_mat, psb_c_base_vect_type
& psb_spk_, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
use mld_c_prec_type, only : mld_cprec_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_cprec_type), intent(inout), target :: prec
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
!!$ character, intent(in),optional :: upd
@ -66,78 +66,84 @@ module mld_c_inner_mod
interface mld_mlprec_aply
subroutine mld_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
use mld_c_prec_type, only : mld_cprec_type
type(psb_desc_type),intent(in) :: desc_data
type(mld_cprec_type), intent(in) :: p
implicit none
type(psb_desc_type),intent(in) :: desc_data
type(mld_cprec_type), intent(in) :: p
complex(psb_spk_),intent(in) :: alpha,beta
complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
character,intent(in) :: trans
character,intent(in) :: trans
complex(psb_spk_),target :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_cmlprec_aply
subroutine mld_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, &
& psb_spk_, psb_c_vect_type
& psb_spk_, psb_c_vect_type, psb_ipk_
use mld_c_prec_type, only : mld_cprec_type
type(psb_desc_type),intent(in) :: desc_data
implicit none
type(psb_desc_type),intent(in) :: desc_data
type(mld_cprec_type), intent(inout) :: p
complex(psb_spk_),intent(in) :: alpha,beta
complex(psb_spk_),intent(in) :: alpha,beta
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
character,intent(in) :: trans
complex(psb_spk_),target :: work(:)
integer, intent(out) :: info
character,intent(in) :: trans
complex(psb_spk_),target :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_cmlprec_aply_vect
end interface mld_mlprec_aply
interface mld_coarse_bld
subroutine mld_ccoarse_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
use mld_c_prec_type, only : mld_c_onelev_type
type(psb_cspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_c_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_ccoarse_bld
end interface mld_coarse_bld
interface mld_aggrmap_bld
subroutine mld_caggrmap_bld(aggr_type,theta,a,desc_a,ilaggr,nlaggr,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
integer, intent(in) :: aggr_type
real(psb_spk_), intent(in) :: theta
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
implicit none
integer(psb_ipk_), intent(in) :: aggr_type
real(psb_spk_), intent(in) :: theta
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_caggrmap_bld
end interface mld_aggrmap_bld
interface mld_dec_map_bld
subroutine mld_c_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
implicit none
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_), intent(in) :: theta
integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_dec_map_bld
end interface mld_dec_map_bld
interface mld_aggrmat_asb
subroutine mld_caggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
use mld_c_prec_type, only : mld_c_onelev_type
implicit none
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_c_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_caggrmat_asb
end interface mld_aggrmat_asb
@ -145,14 +151,15 @@ module mld_c_inner_mod
abstract interface
subroutine mld_caggrmat_var_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
use mld_c_prec_type, only : mld_c_onelev_type, mld_sml_parms
implicit none
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_sml_parms), intent(inout) :: parms
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_sml_parms), intent(inout) :: parms
type(psb_cspmat_type), intent(out) :: ac,op_prol,op_restr
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_caggrmat_var_asb
end interface

83
mlprec/mld_c_jac_smoother.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010,2012
!!$ (C) Copyright 2008,2009,2010,2010,2012
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -52,7 +52,7 @@ module mld_c_jac_smoother
! class(mld_c_base_solver_type), allocatable :: sv
!
type(psb_cspmat_type) :: nd
integer :: nnz_nd_tot
integer(psb_ipk_) :: nnz_nd_tot
contains
procedure, pass(sm) :: build => mld_c_jac_smoother_bld
procedure, pass(sm) :: apply_v => mld_c_jac_smoother_apply_vect
@ -76,45 +76,45 @@ module mld_c_jac_smoother
interface
subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
import :: psb_desc_type, mld_c_jac_smoother_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type
type(psb_desc_type), intent(in) :: desc_data
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_jac_smoother_type), intent(inout) :: sm
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
complex(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_jac_smoother_apply_vect
end interface
interface
subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
import :: psb_desc_type, mld_c_jac_smoother_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_jac_smoother_type), intent(in) :: sm
complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_jac_smoother_apply
end interface
interface
subroutine mld_c_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
import :: psb_desc_type, mld_c_jac_smoother_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type
type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_c_jac_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_c_jac_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
end subroutine mld_c_jac_smoother_bld
@ -128,10 +128,10 @@ contains
! Arguments
class(mld_c_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act
character(len=20) :: name='c_jac_smoother_seti'
info = psb_success_
@ -164,10 +164,10 @@ contains
! Arguments
class(mld_c_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='c_jac_smoother_setc'
info = psb_success_
@ -196,15 +196,14 @@ contains
subroutine c_jac_smoother_setr(sm,what,val,info)
Implicit None
! Arguments
class(mld_c_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_jac_smoother_setr'
call psb_erractionsave(err_act)
@ -234,8 +233,8 @@ contains
! Arguments
class(mld_c_jac_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_jac_smoother_free'
call psb_erractionsave(err_act)
@ -268,20 +267,18 @@ contains
subroutine c_jac_smoother_descr(sm,info,iout,coarse)
Implicit None
! Arguments
class(mld_c_jac_smoother_type), intent(in) :: sm
integer, intent(out) :: info
integer, intent(in), optional :: iout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_c_jac_smoother_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
logical :: coarse_
call psb_erractionsave(err_act)
@ -323,7 +320,7 @@ contains
! Arguments
class(mld_c_jac_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = psb_sizeof_int
if (allocated(sm%sv)) val = val + sm%sv%sizeof()
@ -338,7 +335,7 @@ contains
! Arguments
class(mld_c_jac_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sm%sv)) val = val + sm%sv%get_nzeros()

61
mlprec/mld_c_onelev_mod.f90
Unescape Escape View File

@ -57,7 +57,7 @@ module mld_c_onelev_mod
use mld_base_prec_type
use mld_c_base_smoother_mod
use psb_base_mod, only : psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, psb_long_int_k_, psb_desc_type
& psb_clinmap_type, psb_spk_, psb_mpik_, psb_ipk_, psb_long_int_k_, psb_desc_type
!
!
! Type: mld_Tonelev_type.
@ -154,86 +154,93 @@ module mld_c_onelev_mod
interface
subroutine mld_c_base_onelev_descr(lv,il,nl,info,iout)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, mld_c_onelev_type, psb_long_int_k_, psb_desc_type
& psb_clinmap_type, psb_spk_, mld_c_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
! Arguments
class(mld_c_onelev_type), intent(in) :: lv
integer, intent(in) :: il,nl
integer, intent(out) :: info
integer, intent(in), optional :: iout
integer(psb_ipk_), intent(in) :: il,nl
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
end subroutine mld_c_base_onelev_descr
end interface
interface
subroutine mld_c_base_onelev_free(lv,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, mld_c_onelev_type, psb_long_int_k_, psb_desc_type
& psb_clinmap_type, psb_spk_, mld_c_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
implicit none
class(mld_c_onelev_type), intent(inout) :: lv
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_onelev_free
end interface
interface
subroutine mld_c_base_onelev_check(lv,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, mld_c_onelev_type, psb_long_int_k_, psb_desc_type
& psb_clinmap_type, psb_spk_, mld_c_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
! Arguments
class(mld_c_onelev_type), intent(inout) :: lv
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_onelev_check
end interface
interface
subroutine mld_c_base_onelev_seti(lv,what,val,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, mld_c_onelev_type, psb_long_int_k_, psb_desc_type
& psb_clinmap_type, psb_spk_, mld_c_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
! Arguments
class(mld_c_onelev_type), intent(inout) :: lv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_onelev_seti
end interface
interface
subroutine mld_c_base_onelev_setc(lv,what,val,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, mld_c_onelev_type, psb_long_int_k_, psb_desc_type
& psb_clinmap_type, psb_spk_, mld_c_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
! Arguments
class(mld_c_onelev_type), intent(inout) :: lv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_onelev_setc
end interface
interface
subroutine mld_c_base_onelev_setr(lv,what,val,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, mld_c_onelev_type, psb_long_int_k_, psb_desc_type
& psb_clinmap_type, psb_spk_, mld_c_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
class(mld_c_onelev_type), intent(inout) :: lv
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_onelev_setr
end interface
interface
subroutine mld_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,solver)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, mld_c_onelev_type, psb_long_int_k_, psb_desc_type
& psb_clinmap_type, psb_spk_, mld_c_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
implicit none
class(mld_c_onelev_type), intent(in) :: lv
integer, intent(in) :: level
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: ac, rp, smoother, solver
end subroutine mld_c_base_onelev_dump
@ -253,7 +260,7 @@ contains
implicit none
class(mld_c_onelev_type), intent(in) :: lv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(lv%sm)) &
& val = lv%sm%get_nzeros()
@ -263,7 +270,7 @@ contains
implicit none
class(mld_c_onelev_type), intent(in) :: lv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
val = val + lv%desc_ac%sizeof()
@ -325,7 +332,7 @@ contains
use psb_base_mod
implicit none
type(mld_c_onelev_type), intent(inout) :: a, b
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call b%free(info)
b%parms = a%parms

77
mlprec/mld_c_prec_mod.f90
Unescape Escape View File

@ -49,11 +49,12 @@ module mld_c_prec_mod
interface mld_precinit
subroutine mld_cprecinit(p,ptype,info,nlev)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, mld_cprec_type
import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
& mld_cprec_type, psb_ipk_
type(mld_cprec_type), intent(inout) :: p
character(len=*), intent(in) :: ptype
integer, intent(out) :: info
integer, optional, intent(in) :: nlev
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nlev
end subroutine mld_cprecinit
end interface
@ -65,46 +66,46 @@ module mld_c_prec_mod
interface mld_inner_precset
subroutine mld_cprecsetsm(p,val,info,ilev)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
& mld_cprec_type, mld_c_base_smoother_type
type(mld_cprec_type), intent(inout) :: p
& mld_cprec_type, mld_c_base_smoother_type, psb_ipk_
type(mld_cprec_type), intent(inout) :: p
class(mld_c_base_smoother_type), intent(in) :: val
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_cprecsetsm
subroutine mld_cprecsetsv(p,val,info,ilev)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
& mld_cprec_type, mld_c_base_solver_type
type(mld_cprec_type), intent(inout) :: p
& mld_cprec_type, mld_c_base_solver_type, psb_ipk_
type(mld_cprec_type), intent(inout) :: p
class(mld_c_base_solver_type), intent(in) :: val
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_cprecsetsv
subroutine mld_cprecseti(p,what,val,info,ilev)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
& mld_cprec_type
& mld_cprec_type, psb_ipk_
type(mld_cprec_type), intent(inout) :: p
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_cprecseti
subroutine mld_cprecsetr(p,what,val,info,ilev)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
& mld_cprec_type
& mld_cprec_type, psb_ipk_
type(mld_cprec_type), intent(inout) :: p
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_cprecsetr
subroutine mld_cprecsetc(p,what,string,info,ilev)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
& mld_cprec_type
& mld_cprec_type, psb_ipk_
type(mld_cprec_type), intent(inout) :: p
integer, intent(in) :: what
character(len=*), intent(in) :: string
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: string
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_cprecsetc
end interface
@ -112,12 +113,12 @@ module mld_c_prec_mod
subroutine mld_cprecbld(a,desc_a,prec,info,amold,vmold)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
& psb_c_base_sparse_mat, psb_c_base_vect_type, &
& mld_cprec_type
& mld_cprec_type, psb_ipk_
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_cprec_type), intent(inout), target :: prec
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
!!$ character, intent(in),optional :: upd
@ -129,7 +130,7 @@ contains
subroutine mld_c_iprecsetsm(p,val,info)
type(mld_cprec_type), intent(inout) :: p
class(mld_c_base_smoother_type), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,val,info)
end subroutine mld_c_iprecsetsm
@ -137,34 +138,34 @@ contains
subroutine mld_c_iprecsetsv(p,val,info)
type(mld_cprec_type), intent(inout) :: p
class(mld_c_base_solver_type), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,val,info)
end subroutine mld_c_iprecsetsv
subroutine mld_c_iprecseti(p,what,val,info)
type(mld_cprec_type), intent(inout) :: p
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info)
end subroutine mld_c_iprecseti
subroutine mld_c_iprecsetr(p,what,val,info)
type(mld_cprec_type), intent(inout) :: p
integer, intent(in) :: what
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info)
end subroutine mld_c_iprecsetr
subroutine mld_c_iprecsetc(p,what,val,info)
type(mld_cprec_type), intent(inout) :: p
integer, intent(in) :: what
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info)
end subroutine mld_c_iprecsetc

79
mlprec/mld_c_prec_type.f90
Unescape Escape View File

@ -80,7 +80,7 @@ module mld_c_prec_type
!
type, extends(psb_cprec_type) :: mld_cprec_type
integer :: ictxt
integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: coarse_aggr_size
real(psb_spk_) :: op_complexity=szero
type(mld_c_onelev_type), allocatable :: precv(:)
@ -121,41 +121,41 @@ module mld_c_prec_type
interface mld_precaply
subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
import :: psb_cspmat_type, psb_desc_type, &
& psb_spk_, psb_c_vect_type, mld_cprec_type
& psb_spk_, psb_c_vect_type, mld_cprec_type, psb_ipk_
type(psb_desc_type),intent(in) :: desc_data
type(mld_cprec_type), intent(inout) :: prec
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
complex(psb_spk_),intent(inout), optional, target :: work(:)
end subroutine mld_cprecaply2_vect
subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work)
import :: psb_cspmat_type, psb_desc_type, &
& psb_spk_, psb_c_vect_type, mld_cprec_type
& psb_spk_, psb_c_vect_type, mld_cprec_type, psb_ipk_
type(psb_desc_type),intent(in) :: desc_data
type(mld_cprec_type), intent(inout) :: prec
type(psb_c_vect_type),intent(inout) :: x
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
complex(psb_spk_),intent(inout), optional, target :: work(:)
end subroutine mld_cprecaply1_vect
subroutine mld_cprecaply(prec,x,y,desc_data,info,trans,work)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, mld_cprec_type
import :: psb_cspmat_type, psb_desc_type, psb_spk_, mld_cprec_type, psb_ipk_
type(psb_desc_type),intent(in) :: desc_data
type(mld_cprec_type), intent(in) :: prec
complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
complex(psb_spk_),intent(inout), optional, target :: work(:)
end subroutine mld_cprecaply
subroutine mld_cprecaply1(prec,x,desc_data,info,trans)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, mld_cprec_type
import :: psb_cspmat_type, psb_desc_type, psb_spk_, mld_cprec_type, psb_ipk_
type(psb_desc_type),intent(in) :: desc_data
type(mld_cprec_type), intent(in) :: prec
complex(psb_spk_),intent(inout) :: x(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
end subroutine mld_cprecaply1
end interface
@ -173,7 +173,7 @@ contains
implicit none
class(mld_cprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(prec%precv)) then
do i=1, size(prec%precv)
@ -186,7 +186,7 @@ contains
implicit none
class(mld_cprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
val = val + psb_sizeof_int
if (allocated(prec%precv)) then
@ -218,7 +218,8 @@ contains
class(mld_cprec_type), intent(inout) :: prec
real(psb_spk_) :: num,den
integer :: ictxt, il
integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: il
num = -done
den = done
@ -264,15 +265,15 @@ contains
subroutine mld_cfile_prec_descr(p,info,iout)
implicit none
! Arguments
type(mld_cprec_type), intent(in) :: p
integer, intent(out) :: info
integer, intent(in), optional :: iout
type(mld_cprec_type), intent(in) :: p
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
! Local variables
integer :: ilev, nlev
integer :: ictxt, me, np
integer(psb_ipk_) :: ilev, nlev
integer(psb_mpik_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
info = psb_success_
if (present(iout)) then
@ -370,10 +371,10 @@ contains
! Arguments
type(mld_cprec_type), intent(inout) :: p
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
! Local variables
integer :: me,err_act,i
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
@ -413,10 +414,10 @@ contains
class(mld_cprec_type), intent(inout) :: prec
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
integer, intent(out) :: info
character(len=1), optional :: trans
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
complex(psb_spk_),intent(inout), optional, target :: work(:)
Integer :: err_act
Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act)
@ -445,13 +446,13 @@ contains
subroutine mld_c_apply1_vect(prec,x,desc_data,info,trans,work)
implicit none
type(psb_desc_type),intent(in) :: desc_data
type(psb_desc_type),intent(in) :: desc_data
class(mld_cprec_type), intent(inout) :: prec
type(psb_c_vect_type),intent(inout) :: x
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
complex(psb_spk_),intent(inout), optional, target :: work(:)
Integer :: err_act
Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act)
@ -485,10 +486,10 @@ contains
class(mld_cprec_type), intent(in) :: prec
complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
complex(psb_spk_),intent(inout), optional, target :: work(:)
Integer :: err_act
Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act)
@ -520,9 +521,9 @@ contains
type(psb_desc_type),intent(in) :: desc_data
class(mld_cprec_type), intent(in) :: prec
complex(psb_spk_),intent(inout) :: x(:)
integer, intent(out) :: info
character(len=1), optional :: trans
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act)
@ -553,13 +554,13 @@ contains
subroutine mld_c_dump(prec,info,istart,iend,prefix,head,ac,rp,smoother,solver)
implicit none
class(mld_cprec_type), intent(in) :: prec
integer, intent(out) :: info
integer, intent(in), optional :: istart, iend
character(len=*), intent(in), optional :: prefix, head
class(mld_cprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: istart, iend
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp
integer :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_mpik_) :: icontxt,iam, np
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_
@ -588,8 +589,8 @@ contains
implicit none
type(mld_cprec_type), intent(inout) :: a
type(mld_cprec_type), intent(inout), target :: b
integer, intent(out) :: info
integer :: i
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i
if (allocated(b%precv)) then
! This might not be required if FINAL procedures are available.

96
mlprec/mld_d_as_smoother.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010,2012
!!$ (C) Copyright 2008,2009,2010,2010,2012
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -52,8 +52,8 @@ module mld_d_as_smoother
! class(mld_d_base_solver_type), allocatable :: sv
!
type(psb_dspmat_type) :: nd
type(psb_desc_type) :: desc_data
integer :: novr, restr, prol, nd_nnz_tot
type(psb_desc_type) :: desc_data
integer(psb_ipk_) :: novr, restr, prol, nd_nnz_tot
contains
procedure, pass(sm) :: check => mld_d_as_smoother_check
procedure, pass(sm) :: dump => mld_d_as_smoother_dmp
@ -83,41 +83,44 @@ module mld_d_as_smoother
interface
subroutine mld_d_as_smoother_check(sm,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
class(mld_d_as_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_as_smoother_check
end interface
interface
subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_as_smoother_type), intent(inout) :: sm
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_as_smoother_apply_vect
end interface
interface
subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_as_smoother_type), intent(in) :: sm
real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_as_smoother_apply
end interface
@ -125,12 +128,13 @@ module mld_d_as_smoother
subroutine mld_d_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, &
& psb_desc_type, psb_d_base_sparse_mat
type(psb_dspmat_type), intent(in), target :: a
& psb_desc_type, psb_d_base_sparse_mat, psb_ipk_
implicit none
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_d_as_smoother_type), intent(inout) :: sm
class(mld_d_as_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
end subroutine mld_d_as_smoother_bld
@ -139,52 +143,59 @@ module mld_d_as_smoother
interface
subroutine mld_d_as_smoother_seti(sm,what,val,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
class(mld_d_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_as_smoother_seti
end interface
interface
subroutine mld_d_as_smoother_setc(sm,what,val,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
class(mld_d_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_as_smoother_setc
end interface
interface
subroutine mld_d_as_smoother_setr(sm,what,val,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
class(mld_d_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_as_smoother_setr
end interface
interface
subroutine mld_d_as_smoother_free(sm,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
class(mld_d_as_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_as_smoother_free
end interface
interface
subroutine mld_d_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, &
& psb_ipk_, psb_mpik_
implicit none
class(mld_d_as_smoother_type), intent(in) :: sm
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver
end subroutine mld_d_as_smoother_dmp
@ -197,7 +208,7 @@ contains
! Arguments
class(mld_d_as_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = psb_sizeof_int
if (allocated(sm%sv)) val = val + sm%sv%sizeof()
@ -210,7 +221,7 @@ contains
implicit none
class(mld_d_as_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sm%sv)) &
& val = sm%sv%get_nzeros()
@ -247,15 +258,14 @@ contains
! Arguments
class(mld_d_as_smoother_type), intent(in) :: sm
integer, intent(out) :: info
integer, intent(in), optional :: iout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_d_as_smoother_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
logical :: coarse_
call psb_erractionsave(err_act)

91
mlprec/mld_d_base_smoother_mod.f90
Unescape Escape View File

@ -118,16 +118,17 @@ module mld_d_base_smoother_mod
interface
subroutine mld_d_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_base_smoother_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_smoother_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_base_smoother_type), intent(in) :: sm
real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_smoother_apply
end interface
@ -135,74 +136,80 @@ module mld_d_base_smoother_mod
subroutine mld_d_base_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
& trans,sweeps,work,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_base_smoother_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_smoother_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_base_smoother_type), intent(inout) :: sm
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_smoother_apply_vect
end interface
interface
subroutine mld_d_base_smoother_check(sm,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_base_smoother_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_smoother_type, psb_ipk_
! Arguments
class(mld_d_base_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_smoother_check
end interface
interface
subroutine mld_d_base_smoother_seti(sm,what,val,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_base_smoother_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_smoother_type, psb_ipk_
! Arguments
class(mld_d_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_smoother_seti
end interface
interface
subroutine mld_d_base_smoother_setc(sm,what,val,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_base_smoother_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_smoother_type, psb_ipk_
class(mld_d_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_smoother_setc
end interface
interface
subroutine mld_d_base_smoother_setr(sm,what,val,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_base_smoother_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_smoother_type, psb_ipk_
! Arguments
class(mld_d_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_smoother_setr
end interface
interface
subroutine mld_d_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_base_smoother_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_smoother_type, psb_ipk_
! Arguments
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_d_base_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
end subroutine mld_d_base_smoother_bld
@ -211,32 +218,36 @@ module mld_d_base_smoother_mod
interface
subroutine mld_d_base_smoother_free(sm,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_base_smoother_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_smoother_type, psb_ipk_
! Arguments
class(mld_d_base_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_smoother_free
end interface
interface
subroutine mld_d_base_smoother_descr(sm,info,iout,coarse)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_base_smoother_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_smoother_type, psb_ipk_
! Arguments
class(mld_d_base_smoother_type), intent(in) :: sm
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine mld_d_base_smoother_descr
end interface
interface
subroutine mld_d_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_base_smoother_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_smoother_type, psb_ipk_, psb_mpik_
class(mld_d_base_smoother_type), intent(in) :: sm
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver
end subroutine mld_d_base_smoother_dmp
@ -252,7 +263,7 @@ contains
implicit none
class(mld_d_base_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sm%sv)) &
& val = sm%sv%get_nzeros()
@ -263,7 +274,7 @@ contains
! Arguments
class(mld_d_base_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sm%sv)) then

97
mlprec/mld_d_base_solver_mod.f90
Unescape Escape View File

@ -108,15 +108,17 @@ module mld_d_base_solver_mod
interface
subroutine mld_d_base_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_base_solver_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_solver_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_base_solver_type), intent(in) :: sv
real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_solver_apply
end interface
@ -124,32 +126,33 @@ module mld_d_base_solver_mod
interface
subroutine mld_d_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_base_solver_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_solver_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_base_solver_type), intent(inout) :: sv
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_solver_apply_vect
end interface
interface
subroutine mld_d_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_base_solver_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_solver_type, psb_ipk_
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_d_base_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
@ -159,84 +162,85 @@ module mld_d_base_solver_mod
interface
subroutine mld_d_base_solver_check(sv,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_base_solver_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_solver_check
end interface
interface
subroutine mld_d_base_solver_seti(sv,what,val,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_base_solver_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_solver_seti
end interface
interface
subroutine mld_d_base_solver_setc(sv,what,val,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_base_solver_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_solver_setc
end interface
interface
subroutine mld_d_base_solver_setr(sv,what,val,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_base_solver_type
Implicit None
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_solver_setr
end interface
interface
subroutine mld_d_base_solver_free(sv,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_base_solver_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_solver_free
end interface
interface
subroutine mld_d_base_solver_descr(sv,info,iout,coarse)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_base_solver_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_d_base_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine mld_d_base_solver_descr
end interface
@ -244,12 +248,13 @@ module mld_d_base_solver_mod
interface
subroutine mld_d_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_base_solver_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_solver_type, psb_ipk_, psb_mpik_
implicit none
class(mld_d_base_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
end subroutine mld_d_base_solver_dmp
@ -269,7 +274,7 @@ contains
! Arguments
class(mld_d_base_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
return
@ -279,7 +284,7 @@ contains
implicit none
class(mld_d_base_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
end function d_base_solver_get_nzeros

78
mlprec/mld_d_diag_solver.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010,2012
!!$ (C) Copyright 2008,2009,2010,2010,2012
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -73,42 +73,45 @@ module mld_d_diag_solver
interface
subroutine mld_d_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_diag_solver_type
type(psb_desc_type), intent(in) :: desc_data
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_diag_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_diag_solver_type), intent(inout) :: sv
type(psb_d_vect_type), intent(inout) :: x
type(psb_d_vect_type), intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_diag_solver_apply_vect
end interface
interface
subroutine mld_d_diag_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_diag_solver_type
type(psb_desc_type), intent(in) :: desc_data
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_diag_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_diag_solver_type), intent(in) :: sv
real(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_), intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_diag_solver_apply
end interface
interface
subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_diag_solver_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_diag_solver_type, psb_ipk_
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_d_diag_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
@ -125,10 +128,10 @@ contains
! Arguments
class(mld_d_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act
character(len=20) :: name='d_diag_solver_seti'
info = psb_success_
@ -144,10 +147,10 @@ contains
! Arguments
class(mld_d_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='d_diag_solver_setc'
info = psb_success_
@ -161,10 +164,10 @@ contains
! Arguments
class(mld_d_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act
character(len=20) :: name='d_diag_solver_setr'
info = psb_success_
@ -179,9 +182,9 @@ contains
! Arguments
class(mld_d_diag_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='d_diag_solver_free'
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_diag_solver_free'
call psb_erractionsave(err_act)
info = psb_success_
@ -215,15 +218,14 @@ contains
! Arguments
class(mld_d_diag_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_d_diag_solver_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
info = psb_success_
if (present(iout)) then
@ -243,7 +245,7 @@ contains
! Arguments
class(mld_d_diag_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sv%dv)) val = val + sv%dv%sizeof()
@ -256,7 +258,7 @@ contains
! Arguments
class(mld_d_diag_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sv%dv)) val = val + sv%dv%get_nrows()

75
mlprec/mld_d_id_solver.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010,2012
!!$ (C) Copyright 2008,2009,2010,2010,2012
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -68,22 +68,24 @@ module mld_d_id_solver
interface
subroutine mld_d_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_id_solver_type
type(psb_desc_type), intent(in) :: desc_data
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_id_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_id_solver_type), intent(inout) :: sv
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_id_solver_apply_vect
end interface
interface
subroutine mld_d_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, mld_d_id_solver_type
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_id_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_id_solver_type), intent(in) :: sv
real(psb_dpk_),intent(inout) :: x(:)
@ -91,7 +93,7 @@ module mld_d_id_solver
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_id_solver_apply
end interface
@ -104,17 +106,17 @@ contains
! Arguments
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_d_id_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
! Local variables
integer :: n_row,n_col, nrow_a, nztota
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
character(len=20) :: name='d_id_solver_bld', ch_err
info=psb_success_
@ -129,11 +131,11 @@ contains
! Arguments
class(mld_d_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='d_id_solver_seti'
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_id_solver_seti'
info = psb_success_
@ -147,11 +149,11 @@ contains
! Arguments
class(mld_d_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
character(len=20) :: name='d_id_solver_setc'
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='d_id_solver_setc'
info = psb_success_
@ -164,11 +166,11 @@ contains
! Arguments
class(mld_d_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='d_id_solver_setr'
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_id_solver_setr'
info = psb_success_
@ -182,9 +184,9 @@ contains
! Arguments
class(mld_d_id_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='d_id_solver_free'
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_id_solver_free'
info = psb_success_
@ -197,15 +199,14 @@ contains
! Arguments
class(mld_d_id_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_d_id_solver_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
info = psb_success_
if (present(iout)) then

97
mlprec/mld_d_ilu_solver.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010,2012
!!$ (C) Copyright 2008,2009,2010,2010,2012
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -49,11 +49,11 @@ module mld_d_ilu_solver
use mld_d_ilu_fact_mod
type, extends(mld_d_base_solver_type) :: mld_d_ilu_solver_type
type(psb_dspmat_type) :: l, u
type(psb_dspmat_type) :: l, u
real(psb_dpk_), allocatable :: d(:)
type(psb_d_vect_type) :: dv
integer :: fact_type, fill_in
real(psb_dpk_) :: thresh
type(psb_d_vect_type) :: dv
integer(psb_ipk_) :: fact_type, fill_in
real(psb_dpk_) :: thresh
contains
procedure, pass(sv) :: dump => mld_d_ilu_solver_dmp
procedure, pass(sv) :: build => mld_d_ilu_solver_bld
@ -90,42 +90,45 @@ module mld_d_ilu_solver
interface
subroutine mld_d_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, mld_d_ilu_solver_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_ilu_solver_type), intent(inout) :: sv
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_ilu_solver_apply_vect
end interface
interface
subroutine mld_d_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, mld_d_ilu_solver_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_ilu_solver_type), intent(in) :: sv
real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_ilu_solver_apply
end interface
interface
subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
import :: psb_desc_type, mld_d_ilu_solver_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
implicit none
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_d_ilu_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
@ -135,12 +138,15 @@ module mld_d_ilu_solver
interface
subroutine mld_d_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
import :: psb_desc_type, mld_d_ilu_solver_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, &
& psb_ipk_, psb_mpik_
implicit none
class(mld_d_ilu_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
end subroutine mld_d_ilu_solver_dmp
end interface
@ -167,8 +173,8 @@ contains
! Arguments
class(mld_d_ilu_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_ilu_solver_check'
call psb_erractionsave(err_act)
@ -180,7 +186,7 @@ contains
select case(sv%fact_type)
case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(sv%fill_in,&
& 'Level',0,is_legal_ml_lev)
& 'Level',izero,is_legal_ml_lev)
case(mld_ilu_t_)
call mld_check_def(sv%thresh,&
& 'Eps',dzero,is_legal_d_fact_thrs)
@ -207,10 +213,10 @@ contains
! Arguments
class(mld_d_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_ilu_solver_seti'
info = psb_success_
@ -244,10 +250,10 @@ contains
! Arguments
class(mld_d_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='d_ilu_solver_setc'
info = psb_success_
@ -280,10 +286,10 @@ contains
! Arguments
class(mld_d_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_ilu_solver_setr'
call psb_erractionsave(err_act)
@ -316,8 +322,8 @@ contains
! Arguments
class(mld_d_ilu_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_ilu_solver_free'
call psb_erractionsave(err_act)
@ -353,15 +359,14 @@ contains
! Arguments
class(mld_d_ilu_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_d_ilu_solver_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
call psb_erractionsave(err_act)
info = psb_success_
@ -399,7 +404,7 @@ contains
! Arguments
class(mld_d_ilu_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
val = val + sv%dv%get_nrows()
@ -415,7 +420,7 @@ contains
! Arguments
class(mld_d_ilu_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 2*psb_sizeof_int + psb_sizeof_dp
val = val + sv%dv%sizeof()

79
mlprec/mld_d_inner_mod.f90
Unescape Escape View File

@ -50,13 +50,13 @@ module mld_d_inner_mod
interface mld_mlprec_bld
subroutine mld_dmlprec_bld(a,desc_a,prec,info, amold, vmold)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, &
& psb_dpk_, psb_d_base_sparse_mat, psb_d_base_vect_type
& psb_dpk_, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
use mld_d_prec_type, only : mld_dprec_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_dprec_type), intent(inout), target :: prec
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
!!$ character, intent(in),optional :: upd
@ -66,78 +66,84 @@ module mld_d_inner_mod
interface mld_mlprec_aply
subroutine mld_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
use mld_d_prec_type, only : mld_dprec_type
type(psb_desc_type),intent(in) :: desc_data
type(mld_dprec_type), intent(in) :: p
implicit none
type(psb_desc_type),intent(in) :: desc_data
type(mld_dprec_type), intent(in) :: p
real(psb_dpk_),intent(in) :: alpha,beta
real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
character,intent(in) :: trans
character,intent(in) :: trans
real(psb_dpk_),target :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_dmlprec_aply
subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, &
& psb_dpk_, psb_d_vect_type
& psb_dpk_, psb_d_vect_type, psb_ipk_
use mld_d_prec_type, only : mld_dprec_type
type(psb_desc_type),intent(in) :: desc_data
implicit none
type(psb_desc_type),intent(in) :: desc_data
type(mld_dprec_type), intent(inout) :: p
real(psb_dpk_),intent(in) :: alpha,beta
real(psb_dpk_),intent(in) :: alpha,beta
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
character,intent(in) :: trans
real(psb_dpk_),target :: work(:)
integer, intent(out) :: info
character,intent(in) :: trans
real(psb_dpk_),target :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_dmlprec_aply_vect
end interface mld_mlprec_aply
interface mld_coarse_bld
subroutine mld_dcoarse_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
use mld_d_prec_type, only : mld_d_onelev_type
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_d_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_dcoarse_bld
end interface mld_coarse_bld
interface mld_aggrmap_bld
subroutine mld_daggrmap_bld(aggr_type,theta,a,desc_a,ilaggr,nlaggr,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
integer, intent(in) :: aggr_type
real(psb_dpk_), intent(in) :: theta
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
implicit none
integer(psb_ipk_), intent(in) :: aggr_type
real(psb_dpk_), intent(in) :: theta
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_daggrmap_bld
end interface mld_aggrmap_bld
interface mld_dec_map_bld
subroutine mld_d_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
implicit none
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_), intent(in) :: theta
integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_dec_map_bld
end interface mld_dec_map_bld
interface mld_aggrmat_asb
subroutine mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
use mld_d_prec_type, only : mld_d_onelev_type
implicit none
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_d_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_daggrmat_asb
end interface mld_aggrmat_asb
@ -145,14 +151,15 @@ module mld_d_inner_mod
abstract interface
subroutine mld_daggrmat_var_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
use mld_d_prec_type, only : mld_d_onelev_type, mld_dml_parms
implicit none
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_dml_parms), intent(inout) :: parms
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_dml_parms), intent(inout) :: parms
type(psb_dspmat_type), intent(out) :: ac,op_prol,op_restr
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_daggrmat_var_asb
end interface

83
mlprec/mld_d_jac_smoother.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010,2012
!!$ (C) Copyright 2008,2009,2010,2010,2012
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -52,7 +52,7 @@ module mld_d_jac_smoother
! class(mld_d_base_solver_type), allocatable :: sv
!
type(psb_dspmat_type) :: nd
integer :: nnz_nd_tot
integer(psb_ipk_) :: nnz_nd_tot
contains
procedure, pass(sm) :: build => mld_d_jac_smoother_bld
procedure, pass(sm) :: apply_v => mld_d_jac_smoother_apply_vect
@ -76,45 +76,45 @@ module mld_d_jac_smoother
interface
subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
import :: psb_desc_type, mld_d_jac_smoother_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type
type(psb_desc_type), intent(in) :: desc_data
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_jac_smoother_type), intent(inout) :: sm
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_jac_smoother_apply_vect
end interface
interface
subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
import :: psb_desc_type, mld_d_jac_smoother_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_jac_smoother_type), intent(in) :: sm
real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_jac_smoother_apply
end interface
interface
subroutine mld_d_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
import :: psb_desc_type, mld_d_jac_smoother_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_d_jac_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_d_jac_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
end subroutine mld_d_jac_smoother_bld
@ -128,10 +128,10 @@ contains
! Arguments
class(mld_d_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act
character(len=20) :: name='d_jac_smoother_seti'
info = psb_success_
@ -164,10 +164,10 @@ contains
! Arguments
class(mld_d_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='d_jac_smoother_setc'
info = psb_success_
@ -196,15 +196,14 @@ contains
subroutine d_jac_smoother_setr(sm,what,val,info)
Implicit None
! Arguments
class(mld_d_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_jac_smoother_setr'
call psb_erractionsave(err_act)
@ -234,8 +233,8 @@ contains
! Arguments
class(mld_d_jac_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_jac_smoother_free'
call psb_erractionsave(err_act)
@ -268,20 +267,18 @@ contains
subroutine d_jac_smoother_descr(sm,info,iout,coarse)
Implicit None
! Arguments
class(mld_d_jac_smoother_type), intent(in) :: sm
integer, intent(out) :: info
integer, intent(in), optional :: iout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_d_jac_smoother_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
logical :: coarse_
call psb_erractionsave(err_act)
@ -323,7 +320,7 @@ contains
! Arguments
class(mld_d_jac_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = psb_sizeof_int
if (allocated(sm%sv)) val = val + sm%sv%sizeof()
@ -338,7 +335,7 @@ contains
! Arguments
class(mld_d_jac_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sm%sv)) val = val + sm%sv%get_nzeros()

61
mlprec/mld_d_onelev_mod.f90
Unescape Escape View File

@ -57,7 +57,7 @@ module mld_d_onelev_mod
use mld_base_prec_type
use mld_d_base_smoother_mod
use psb_base_mod, only : psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, psb_long_int_k_, psb_desc_type
& psb_dlinmap_type, psb_dpk_, psb_mpik_, psb_ipk_, psb_long_int_k_, psb_desc_type
!
!
! Type: mld_Tonelev_type.
@ -154,86 +154,93 @@ module mld_d_onelev_mod
interface
subroutine mld_d_base_onelev_descr(lv,il,nl,info,iout)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, psb_long_int_k_, psb_desc_type
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
! Arguments
class(mld_d_onelev_type), intent(in) :: lv
integer, intent(in) :: il,nl
integer, intent(out) :: info
integer, intent(in), optional :: iout
integer(psb_ipk_), intent(in) :: il,nl
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
end subroutine mld_d_base_onelev_descr
end interface
interface
subroutine mld_d_base_onelev_free(lv,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, psb_long_int_k_, psb_desc_type
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
implicit none
class(mld_d_onelev_type), intent(inout) :: lv
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_onelev_free
end interface
interface
subroutine mld_d_base_onelev_check(lv,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, psb_long_int_k_, psb_desc_type
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
! Arguments
class(mld_d_onelev_type), intent(inout) :: lv
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_onelev_check
end interface
interface
subroutine mld_d_base_onelev_seti(lv,what,val,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, psb_long_int_k_, psb_desc_type
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
! Arguments
class(mld_d_onelev_type), intent(inout) :: lv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_onelev_seti
end interface
interface
subroutine mld_d_base_onelev_setc(lv,what,val,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, psb_long_int_k_, psb_desc_type
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
! Arguments
class(mld_d_onelev_type), intent(inout) :: lv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_onelev_setc
end interface
interface
subroutine mld_d_base_onelev_setr(lv,what,val,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, psb_long_int_k_, psb_desc_type
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
class(mld_d_onelev_type), intent(inout) :: lv
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_onelev_setr
end interface
interface
subroutine mld_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,solver)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, psb_long_int_k_, psb_desc_type
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
implicit none
class(mld_d_onelev_type), intent(in) :: lv
integer, intent(in) :: level
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: ac, rp, smoother, solver
end subroutine mld_d_base_onelev_dump
@ -253,7 +260,7 @@ contains
implicit none
class(mld_d_onelev_type), intent(in) :: lv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(lv%sm)) &
& val = lv%sm%get_nzeros()
@ -263,7 +270,7 @@ contains
implicit none
class(mld_d_onelev_type), intent(in) :: lv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
val = val + lv%desc_ac%sizeof()
@ -325,7 +332,7 @@ contains
use psb_base_mod
implicit none
type(mld_d_onelev_type), intent(inout) :: a, b
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call b%free(info)
b%parms = a%parms

77
mlprec/mld_d_prec_mod.f90
Unescape Escape View File

@ -49,11 +49,12 @@ module mld_d_prec_mod
interface mld_precinit
subroutine mld_dprecinit(p,ptype,info,nlev)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, mld_dprec_type
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
& mld_dprec_type, psb_ipk_
type(mld_dprec_type), intent(inout) :: p
character(len=*), intent(in) :: ptype
integer, intent(out) :: info
integer, optional, intent(in) :: nlev
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nlev
end subroutine mld_dprecinit
end interface
@ -65,46 +66,46 @@ module mld_d_prec_mod
interface mld_inner_precset
subroutine mld_dprecsetsm(p,val,info,ilev)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
& mld_dprec_type, mld_d_base_smoother_type
type(mld_dprec_type), intent(inout) :: p
& mld_dprec_type, mld_d_base_smoother_type, psb_ipk_
type(mld_dprec_type), intent(inout) :: p
class(mld_d_base_smoother_type), intent(in) :: val
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_dprecsetsm
subroutine mld_dprecsetsv(p,val,info,ilev)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
& mld_dprec_type, mld_d_base_solver_type
type(mld_dprec_type), intent(inout) :: p
& mld_dprec_type, mld_d_base_solver_type, psb_ipk_
type(mld_dprec_type), intent(inout) :: p
class(mld_d_base_solver_type), intent(in) :: val
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_dprecsetsv
subroutine mld_dprecseti(p,what,val,info,ilev)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
& mld_dprec_type
& mld_dprec_type, psb_ipk_
type(mld_dprec_type), intent(inout) :: p
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_dprecseti
subroutine mld_dprecsetr(p,what,val,info,ilev)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
& mld_dprec_type
& mld_dprec_type, psb_ipk_
type(mld_dprec_type), intent(inout) :: p
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_dprecsetr
subroutine mld_dprecsetc(p,what,string,info,ilev)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
& mld_dprec_type
& mld_dprec_type, psb_ipk_
type(mld_dprec_type), intent(inout) :: p
integer, intent(in) :: what
character(len=*), intent(in) :: string
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: string
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_dprecsetc
end interface
@ -112,12 +113,12 @@ module mld_d_prec_mod
subroutine mld_dprecbld(a,desc_a,prec,info,amold,vmold)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
& psb_d_base_sparse_mat, psb_d_base_vect_type, &
& mld_dprec_type
& mld_dprec_type, psb_ipk_
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_dprec_type), intent(inout), target :: prec
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
!!$ character, intent(in),optional :: upd
@ -129,7 +130,7 @@ contains
subroutine mld_d_iprecsetsm(p,val,info)
type(mld_dprec_type), intent(inout) :: p
class(mld_d_base_smoother_type), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,val,info)
end subroutine mld_d_iprecsetsm
@ -137,34 +138,34 @@ contains
subroutine mld_d_iprecsetsv(p,val,info)
type(mld_dprec_type), intent(inout) :: p
class(mld_d_base_solver_type), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,val,info)
end subroutine mld_d_iprecsetsv
subroutine mld_d_iprecseti(p,what,val,info)
type(mld_dprec_type), intent(inout) :: p
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info)
end subroutine mld_d_iprecseti
subroutine mld_d_iprecsetr(p,what,val,info)
type(mld_dprec_type), intent(inout) :: p
integer, intent(in) :: what
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info)
end subroutine mld_d_iprecsetr
subroutine mld_d_iprecsetc(p,what,val,info)
type(mld_dprec_type), intent(inout) :: p
integer, intent(in) :: what
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info)
end subroutine mld_d_iprecsetc

79
mlprec/mld_d_prec_type.f90
Unescape Escape View File

@ -80,7 +80,7 @@ module mld_d_prec_type
!
type, extends(psb_dprec_type) :: mld_dprec_type
integer :: ictxt
integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: coarse_aggr_size
real(psb_dpk_) :: op_complexity=dzero
type(mld_d_onelev_type), allocatable :: precv(:)
@ -121,41 +121,41 @@ module mld_d_prec_type
interface mld_precaply
subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
import :: psb_dspmat_type, psb_desc_type, &
& psb_dpk_, psb_d_vect_type, mld_dprec_type
& psb_dpk_, psb_d_vect_type, mld_dprec_type, psb_ipk_
type(psb_desc_type),intent(in) :: desc_data
type(mld_dprec_type), intent(inout) :: prec
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
real(psb_dpk_),intent(inout), optional, target :: work(:)
end subroutine mld_dprecaply2_vect
subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work)
import :: psb_dspmat_type, psb_desc_type, &
& psb_dpk_, psb_d_vect_type, mld_dprec_type
& psb_dpk_, psb_d_vect_type, mld_dprec_type, psb_ipk_
type(psb_desc_type),intent(in) :: desc_data
type(mld_dprec_type), intent(inout) :: prec
type(psb_d_vect_type),intent(inout) :: x
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
real(psb_dpk_),intent(inout), optional, target :: work(:)
end subroutine mld_dprecaply1_vect
subroutine mld_dprecaply(prec,x,y,desc_data,info,trans,work)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, mld_dprec_type
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, mld_dprec_type, psb_ipk_
type(psb_desc_type),intent(in) :: desc_data
type(mld_dprec_type), intent(in) :: prec
real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
real(psb_dpk_),intent(inout), optional, target :: work(:)
end subroutine mld_dprecaply
subroutine mld_dprecaply1(prec,x,desc_data,info,trans)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, mld_dprec_type
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, mld_dprec_type, psb_ipk_
type(psb_desc_type),intent(in) :: desc_data
type(mld_dprec_type), intent(in) :: prec
real(psb_dpk_),intent(inout) :: x(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
end subroutine mld_dprecaply1
end interface
@ -173,7 +173,7 @@ contains
implicit none
class(mld_dprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(prec%precv)) then
do i=1, size(prec%precv)
@ -186,7 +186,7 @@ contains
implicit none
class(mld_dprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
val = val + psb_sizeof_int
if (allocated(prec%precv)) then
@ -218,7 +218,8 @@ contains
class(mld_dprec_type), intent(inout) :: prec
real(psb_dpk_) :: num,den
integer :: ictxt, il
integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: il
num = -done
den = done
@ -264,15 +265,15 @@ contains
subroutine mld_dfile_prec_descr(p,info,iout)
implicit none
! Arguments
type(mld_dprec_type), intent(in) :: p
integer, intent(out) :: info
integer, intent(in), optional :: iout
type(mld_dprec_type), intent(in) :: p
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
! Local variables
integer :: ilev, nlev
integer :: ictxt, me, np
integer(psb_ipk_) :: ilev, nlev
integer(psb_mpik_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
info = psb_success_
if (present(iout)) then
@ -370,10 +371,10 @@ contains
! Arguments
type(mld_dprec_type), intent(inout) :: p
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
! Local variables
integer :: me,err_act,i
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
@ -413,10 +414,10 @@ contains
class(mld_dprec_type), intent(inout) :: prec
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
integer, intent(out) :: info
character(len=1), optional :: trans
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
real(psb_dpk_),intent(inout), optional, target :: work(:)
Integer :: err_act
Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act)
@ -445,13 +446,13 @@ contains
subroutine mld_d_apply1_vect(prec,x,desc_data,info,trans,work)
implicit none
type(psb_desc_type),intent(in) :: desc_data
type(psb_desc_type),intent(in) :: desc_data
class(mld_dprec_type), intent(inout) :: prec
type(psb_d_vect_type),intent(inout) :: x
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
real(psb_dpk_),intent(inout), optional, target :: work(:)
Integer :: err_act
Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act)
@ -485,10 +486,10 @@ contains
class(mld_dprec_type), intent(in) :: prec
real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
real(psb_dpk_),intent(inout), optional, target :: work(:)
Integer :: err_act
Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act)
@ -520,9 +521,9 @@ contains
type(psb_desc_type),intent(in) :: desc_data
class(mld_dprec_type), intent(in) :: prec
real(psb_dpk_),intent(inout) :: x(:)
integer, intent(out) :: info
character(len=1), optional :: trans
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act)
@ -553,13 +554,13 @@ contains
subroutine mld_d_dump(prec,info,istart,iend,prefix,head,ac,rp,smoother,solver)
implicit none
class(mld_dprec_type), intent(in) :: prec
integer, intent(out) :: info
integer, intent(in), optional :: istart, iend
character(len=*), intent(in), optional :: prefix, head
class(mld_dprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: istart, iend
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp
integer :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_mpik_) :: icontxt,iam, np
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_
@ -588,8 +589,8 @@ contains
implicit none
type(mld_dprec_type), intent(inout) :: a
type(mld_dprec_type), intent(inout), target :: b
integer, intent(out) :: info
integer :: i
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i
if (allocated(b%precv)) then
! This might not be required if FINAL procedures are available.

96
mlprec/mld_s_as_smoother.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010,2012
!!$ (C) Copyright 2008,2009,2010,2010,2012
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -52,8 +52,8 @@ module mld_s_as_smoother
! class(mld_s_base_solver_type), allocatable :: sv
!
type(psb_sspmat_type) :: nd
type(psb_desc_type) :: desc_data
integer :: novr, restr, prol, nd_nnz_tot
type(psb_desc_type) :: desc_data
integer(psb_ipk_) :: novr, restr, prol, nd_nnz_tot
contains
procedure, pass(sm) :: check => mld_s_as_smoother_check
procedure, pass(sm) :: dump => mld_s_as_smoother_dmp
@ -83,41 +83,44 @@ module mld_s_as_smoother
interface
subroutine mld_s_as_smoother_check(sm,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
class(mld_s_as_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_as_smoother_check
end interface
interface
subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_as_smoother_type), intent(inout) :: sm
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
real(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_as_smoother_apply_vect
end interface
interface
subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_as_smoother_type), intent(in) :: sm
real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_as_smoother_apply
end interface
@ -125,12 +128,13 @@ module mld_s_as_smoother
subroutine mld_s_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, &
& psb_desc_type, psb_s_base_sparse_mat
type(psb_sspmat_type), intent(in), target :: a
& psb_desc_type, psb_s_base_sparse_mat, psb_ipk_
implicit none
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_s_as_smoother_type), intent(inout) :: sm
class(mld_s_as_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
end subroutine mld_s_as_smoother_bld
@ -139,52 +143,59 @@ module mld_s_as_smoother
interface
subroutine mld_s_as_smoother_seti(sm,what,val,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
class(mld_s_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_as_smoother_seti
end interface
interface
subroutine mld_s_as_smoother_setc(sm,what,val,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
class(mld_s_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_as_smoother_setc
end interface
interface
subroutine mld_s_as_smoother_setr(sm,what,val,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
class(mld_s_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_as_smoother_setr
end interface
interface
subroutine mld_s_as_smoother_free(sm,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
class(mld_s_as_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_as_smoother_free
end interface
interface
subroutine mld_s_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type, &
& psb_ipk_, psb_mpik_
implicit none
class(mld_s_as_smoother_type), intent(in) :: sm
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver
end subroutine mld_s_as_smoother_dmp
@ -197,7 +208,7 @@ contains
! Arguments
class(mld_s_as_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = psb_sizeof_int
if (allocated(sm%sv)) val = val + sm%sv%sizeof()
@ -210,7 +221,7 @@ contains
implicit none
class(mld_s_as_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sm%sv)) &
& val = sm%sv%get_nzeros()
@ -247,15 +258,14 @@ contains
! Arguments
class(mld_s_as_smoother_type), intent(in) :: sm
integer, intent(out) :: info
integer, intent(in), optional :: iout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_s_as_smoother_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
logical :: coarse_
call psb_erractionsave(err_act)

91
mlprec/mld_s_base_smoother_mod.f90
Unescape Escape View File

@ -118,16 +118,17 @@ module mld_s_base_smoother_mod
interface
subroutine mld_s_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_base_smoother_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_smoother_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_base_smoother_type), intent(in) :: sm
real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_smoother_apply
end interface
@ -135,74 +136,80 @@ module mld_s_base_smoother_mod
subroutine mld_s_base_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
& trans,sweeps,work,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_base_smoother_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_smoother_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_base_smoother_type), intent(inout) :: sm
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
real(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_smoother_apply_vect
end interface
interface
subroutine mld_s_base_smoother_check(sm,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_base_smoother_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_smoother_type, psb_ipk_
! Arguments
class(mld_s_base_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_smoother_check
end interface
interface
subroutine mld_s_base_smoother_seti(sm,what,val,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_base_smoother_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_smoother_type, psb_ipk_
! Arguments
class(mld_s_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_smoother_seti
end interface
interface
subroutine mld_s_base_smoother_setc(sm,what,val,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_base_smoother_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_smoother_type, psb_ipk_
class(mld_s_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_smoother_setc
end interface
interface
subroutine mld_s_base_smoother_setr(sm,what,val,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_base_smoother_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_smoother_type, psb_ipk_
! Arguments
class(mld_s_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_smoother_setr
end interface
interface
subroutine mld_s_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_base_smoother_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_smoother_type, psb_ipk_
! Arguments
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_s_base_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
end subroutine mld_s_base_smoother_bld
@ -211,32 +218,36 @@ module mld_s_base_smoother_mod
interface
subroutine mld_s_base_smoother_free(sm,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_base_smoother_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_smoother_type, psb_ipk_
! Arguments
class(mld_s_base_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_smoother_free
end interface
interface
subroutine mld_s_base_smoother_descr(sm,info,iout,coarse)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_base_smoother_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_smoother_type, psb_ipk_
! Arguments
class(mld_s_base_smoother_type), intent(in) :: sm
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine mld_s_base_smoother_descr
end interface
interface
subroutine mld_s_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_base_smoother_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_smoother_type, psb_ipk_, psb_mpik_
class(mld_s_base_smoother_type), intent(in) :: sm
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver
end subroutine mld_s_base_smoother_dmp
@ -252,7 +263,7 @@ contains
implicit none
class(mld_s_base_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sm%sv)) &
& val = sm%sv%get_nzeros()
@ -263,7 +274,7 @@ contains
! Arguments
class(mld_s_base_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sm%sv)) then

97
mlprec/mld_s_base_solver_mod.f90
Unescape Escape View File

@ -108,15 +108,17 @@ module mld_s_base_solver_mod
interface
subroutine mld_s_base_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_base_solver_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_solver_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_base_solver_type), intent(in) :: sv
real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_solver_apply
end interface
@ -124,32 +126,33 @@ module mld_s_base_solver_mod
interface
subroutine mld_s_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_base_solver_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_solver_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_base_solver_type), intent(inout) :: sv
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_solver_apply_vect
end interface
interface
subroutine mld_s_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_base_solver_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_solver_type, psb_ipk_
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_s_base_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type), intent(in), target, optional :: b
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
@ -159,84 +162,85 @@ module mld_s_base_solver_mod
interface
subroutine mld_s_base_solver_check(sv,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_base_solver_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_solver_check
end interface
interface
subroutine mld_s_base_solver_seti(sv,what,val,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_base_solver_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_solver_seti
end interface
interface
subroutine mld_s_base_solver_setc(sv,what,val,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_base_solver_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_solver_setc
end interface
interface
subroutine mld_s_base_solver_setr(sv,what,val,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_base_solver_type
Implicit None
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_solver_setr
end interface
interface
subroutine mld_s_base_solver_free(sv,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_base_solver_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_solver_free
end interface
interface
subroutine mld_s_base_solver_descr(sv,info,iout,coarse)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_base_solver_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_s_base_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine mld_s_base_solver_descr
end interface
@ -244,12 +248,13 @@ module mld_s_base_solver_mod
interface
subroutine mld_s_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_base_solver_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_solver_type, psb_ipk_, psb_mpik_
implicit none
class(mld_s_base_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
end subroutine mld_s_base_solver_dmp
@ -269,7 +274,7 @@ contains
! Arguments
class(mld_s_base_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
return
@ -279,7 +284,7 @@ contains
implicit none
class(mld_s_base_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
end function s_base_solver_get_nzeros

78
mlprec/mld_s_diag_solver.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010,2012
!!$ (C) Copyright 2008,2009,2010,2010,2012
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -73,42 +73,45 @@ module mld_s_diag_solver
interface
subroutine mld_s_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_diag_solver_type
type(psb_desc_type), intent(in) :: desc_data
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_diag_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_diag_solver_type), intent(inout) :: sv
type(psb_s_vect_type), intent(inout) :: x
type(psb_s_vect_type), intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_diag_solver_apply_vect
end interface
interface
subroutine mld_s_diag_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_diag_solver_type
type(psb_desc_type), intent(in) :: desc_data
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_diag_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_diag_solver_type), intent(in) :: sv
real(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), intent(inout) :: y(:)
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_diag_solver_apply
end interface
interface
subroutine mld_s_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_diag_solver_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_diag_solver_type, psb_ipk_
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_s_diag_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type), intent(in), target, optional :: b
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
@ -125,10 +128,10 @@ contains
! Arguments
class(mld_s_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act
character(len=20) :: name='s_diag_solver_seti'
info = psb_success_
@ -144,10 +147,10 @@ contains
! Arguments
class(mld_s_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='s_diag_solver_setc'
info = psb_success_
@ -161,10 +164,10 @@ contains
! Arguments
class(mld_s_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act
character(len=20) :: name='s_diag_solver_setr'
info = psb_success_
@ -179,9 +182,9 @@ contains
! Arguments
class(mld_s_diag_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='s_diag_solver_free'
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_diag_solver_free'
call psb_erractionsave(err_act)
info = psb_success_
@ -215,15 +218,14 @@ contains
! Arguments
class(mld_s_diag_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_s_diag_solver_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
info = psb_success_
if (present(iout)) then
@ -243,7 +245,7 @@ contains
! Arguments
class(mld_s_diag_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sv%dv)) val = val + sv%dv%sizeof()
@ -256,7 +258,7 @@ contains
! Arguments
class(mld_s_diag_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sv%dv)) val = val + sv%dv%get_nrows()

75
mlprec/mld_s_id_solver.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010,2012
!!$ (C) Copyright 2008,2009,2010,2010,2012
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -68,22 +68,24 @@ module mld_s_id_solver
interface
subroutine mld_s_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_id_solver_type
type(psb_desc_type), intent(in) :: desc_data
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_id_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_id_solver_type), intent(inout) :: sv
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_id_solver_apply_vect
end interface
interface
subroutine mld_s_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, mld_s_id_solver_type
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_id_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_id_solver_type), intent(in) :: sv
real(psb_spk_),intent(inout) :: x(:)
@ -91,7 +93,7 @@ module mld_s_id_solver
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_id_solver_apply
end interface
@ -104,17 +106,17 @@ contains
! Arguments
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_s_id_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type), intent(in), target, optional :: b
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
! Local variables
integer :: n_row,n_col, nrow_a, nztota
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
character(len=20) :: name='s_id_solver_bld', ch_err
info=psb_success_
@ -129,11 +131,11 @@ contains
! Arguments
class(mld_s_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='s_id_solver_seti'
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_id_solver_seti'
info = psb_success_
@ -147,11 +149,11 @@ contains
! Arguments
class(mld_s_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
character(len=20) :: name='s_id_solver_setc'
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='s_id_solver_setc'
info = psb_success_
@ -164,11 +166,11 @@ contains
! Arguments
class(mld_s_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='s_id_solver_setr'
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_id_solver_setr'
info = psb_success_
@ -182,9 +184,9 @@ contains
! Arguments
class(mld_s_id_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='s_id_solver_free'
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_id_solver_free'
info = psb_success_
@ -197,15 +199,14 @@ contains
! Arguments
class(mld_s_id_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_s_id_solver_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
info = psb_success_
if (present(iout)) then

97
mlprec/mld_s_ilu_solver.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010,2012
!!$ (C) Copyright 2008,2009,2010,2010,2012
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -49,11 +49,11 @@ module mld_s_ilu_solver
use mld_s_ilu_fact_mod
type, extends(mld_s_base_solver_type) :: mld_s_ilu_solver_type
type(psb_sspmat_type) :: l, u
type(psb_sspmat_type) :: l, u
real(psb_spk_), allocatable :: d(:)
type(psb_s_vect_type) :: dv
integer :: fact_type, fill_in
real(psb_spk_) :: thresh
type(psb_s_vect_type) :: dv
integer(psb_ipk_) :: fact_type, fill_in
real(psb_spk_) :: thresh
contains
procedure, pass(sv) :: dump => mld_s_ilu_solver_dmp
procedure, pass(sv) :: build => mld_s_ilu_solver_bld
@ -90,42 +90,45 @@ module mld_s_ilu_solver
interface
subroutine mld_s_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, mld_s_ilu_solver_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_ilu_solver_type), intent(inout) :: sv
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_ilu_solver_apply_vect
end interface
interface
subroutine mld_s_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, mld_s_ilu_solver_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_ilu_solver_type), intent(in) :: sv
real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_ilu_solver_apply
end interface
interface
subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
import :: psb_desc_type, mld_s_ilu_solver_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
implicit none
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_s_ilu_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type), intent(in), target, optional :: b
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
@ -135,12 +138,15 @@ module mld_s_ilu_solver
interface
subroutine mld_s_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
import :: psb_desc_type, mld_s_ilu_solver_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, &
& psb_ipk_, psb_mpik_
implicit none
class(mld_s_ilu_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
end subroutine mld_s_ilu_solver_dmp
end interface
@ -167,8 +173,8 @@ contains
! Arguments
class(mld_s_ilu_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_ilu_solver_check'
call psb_erractionsave(err_act)
@ -180,7 +186,7 @@ contains
select case(sv%fact_type)
case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(sv%fill_in,&
& 'Level',0,is_legal_ml_lev)
& 'Level',izero,is_legal_ml_lev)
case(mld_ilu_t_)
call mld_check_def(sv%thresh,&
& 'Eps',szero,is_legal_s_fact_thrs)
@ -207,10 +213,10 @@ contains
! Arguments
class(mld_s_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_ilu_solver_seti'
info = psb_success_
@ -244,10 +250,10 @@ contains
! Arguments
class(mld_s_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='s_ilu_solver_setc'
info = psb_success_
@ -280,10 +286,10 @@ contains
! Arguments
class(mld_s_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_ilu_solver_setr'
call psb_erractionsave(err_act)
@ -316,8 +322,8 @@ contains
! Arguments
class(mld_s_ilu_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_ilu_solver_free'
call psb_erractionsave(err_act)
@ -353,15 +359,14 @@ contains
! Arguments
class(mld_s_ilu_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_s_ilu_solver_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
call psb_erractionsave(err_act)
info = psb_success_
@ -399,7 +404,7 @@ contains
! Arguments
class(mld_s_ilu_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
val = val + sv%dv%get_nrows()
@ -415,7 +420,7 @@ contains
! Arguments
class(mld_s_ilu_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 2*psb_sizeof_int + psb_sizeof_sp
val = val + sv%dv%sizeof()

79
mlprec/mld_s_inner_mod.f90
Unescape Escape View File

@ -50,13 +50,13 @@ module mld_s_inner_mod
interface mld_mlprec_bld
subroutine mld_smlprec_bld(a,desc_a,prec,info, amold, vmold)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, &
& psb_spk_, psb_s_base_sparse_mat, psb_s_base_vect_type
& psb_spk_, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
use mld_s_prec_type, only : mld_sprec_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_sprec_type), intent(inout), target :: prec
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
!!$ character, intent(in),optional :: upd
@ -66,78 +66,84 @@ module mld_s_inner_mod
interface mld_mlprec_aply
subroutine mld_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
use mld_s_prec_type, only : mld_sprec_type
type(psb_desc_type),intent(in) :: desc_data
type(mld_sprec_type), intent(in) :: p
implicit none
type(psb_desc_type),intent(in) :: desc_data
type(mld_sprec_type), intent(in) :: p
real(psb_spk_),intent(in) :: alpha,beta
real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
character,intent(in) :: trans
character,intent(in) :: trans
real(psb_spk_),target :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_smlprec_aply
subroutine mld_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, &
& psb_spk_, psb_s_vect_type
& psb_spk_, psb_s_vect_type, psb_ipk_
use mld_s_prec_type, only : mld_sprec_type
type(psb_desc_type),intent(in) :: desc_data
implicit none
type(psb_desc_type),intent(in) :: desc_data
type(mld_sprec_type), intent(inout) :: p
real(psb_spk_),intent(in) :: alpha,beta
real(psb_spk_),intent(in) :: alpha,beta
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
character,intent(in) :: trans
real(psb_spk_),target :: work(:)
integer, intent(out) :: info
character,intent(in) :: trans
real(psb_spk_),target :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_smlprec_aply_vect
end interface mld_mlprec_aply
interface mld_coarse_bld
subroutine mld_scoarse_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
use mld_s_prec_type, only : mld_s_onelev_type
type(psb_sspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_s_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_scoarse_bld
end interface mld_coarse_bld
interface mld_aggrmap_bld
subroutine mld_saggrmap_bld(aggr_type,theta,a,desc_a,ilaggr,nlaggr,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
integer, intent(in) :: aggr_type
real(psb_spk_), intent(in) :: theta
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
implicit none
integer(psb_ipk_), intent(in) :: aggr_type
real(psb_spk_), intent(in) :: theta
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_saggrmap_bld
end interface mld_aggrmap_bld
interface mld_dec_map_bld
subroutine mld_s_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
implicit none
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_), intent(in) :: theta
integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_dec_map_bld
end interface mld_dec_map_bld
interface mld_aggrmat_asb
subroutine mld_saggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
use mld_s_prec_type, only : mld_s_onelev_type
implicit none
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_s_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_saggrmat_asb
end interface mld_aggrmat_asb
@ -145,14 +151,15 @@ module mld_s_inner_mod
abstract interface
subroutine mld_saggrmat_var_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
use mld_s_prec_type, only : mld_s_onelev_type, mld_sml_parms
implicit none
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_sml_parms), intent(inout) :: parms
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_sml_parms), intent(inout) :: parms
type(psb_sspmat_type), intent(out) :: ac,op_prol,op_restr
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_saggrmat_var_asb
end interface

83
mlprec/mld_s_jac_smoother.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010,2012
!!$ (C) Copyright 2008,2009,2010,2010,2012
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -52,7 +52,7 @@ module mld_s_jac_smoother
! class(mld_s_base_solver_type), allocatable :: sv
!
type(psb_sspmat_type) :: nd
integer :: nnz_nd_tot
integer(psb_ipk_) :: nnz_nd_tot
contains
procedure, pass(sm) :: build => mld_s_jac_smoother_bld
procedure, pass(sm) :: apply_v => mld_s_jac_smoother_apply_vect
@ -76,45 +76,45 @@ module mld_s_jac_smoother
interface
subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
import :: psb_desc_type, mld_s_jac_smoother_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type
type(psb_desc_type), intent(in) :: desc_data
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_jac_smoother_type), intent(inout) :: sm
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
real(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_jac_smoother_apply_vect
end interface
interface
subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
import :: psb_desc_type, mld_s_jac_smoother_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_jac_smoother_type), intent(in) :: sm
real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_jac_smoother_apply
end interface
interface
subroutine mld_s_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
import :: psb_desc_type, mld_s_jac_smoother_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_s_jac_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_s_jac_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
end subroutine mld_s_jac_smoother_bld
@ -128,10 +128,10 @@ contains
! Arguments
class(mld_s_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act
character(len=20) :: name='s_jac_smoother_seti'
info = psb_success_
@ -164,10 +164,10 @@ contains
! Arguments
class(mld_s_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='s_jac_smoother_setc'
info = psb_success_
@ -196,15 +196,14 @@ contains
subroutine s_jac_smoother_setr(sm,what,val,info)
Implicit None
! Arguments
class(mld_s_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_jac_smoother_setr'
call psb_erractionsave(err_act)
@ -234,8 +233,8 @@ contains
! Arguments
class(mld_s_jac_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_jac_smoother_free'
call psb_erractionsave(err_act)
@ -268,20 +267,18 @@ contains
subroutine s_jac_smoother_descr(sm,info,iout,coarse)
Implicit None
! Arguments
class(mld_s_jac_smoother_type), intent(in) :: sm
integer, intent(out) :: info
integer, intent(in), optional :: iout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_s_jac_smoother_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
logical :: coarse_
call psb_erractionsave(err_act)
@ -323,7 +320,7 @@ contains
! Arguments
class(mld_s_jac_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = psb_sizeof_int
if (allocated(sm%sv)) val = val + sm%sv%sizeof()
@ -338,7 +335,7 @@ contains
! Arguments
class(mld_s_jac_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sm%sv)) val = val + sm%sv%get_nzeros()

61
mlprec/mld_s_onelev_mod.f90
Unescape Escape View File

@ -57,7 +57,7 @@ module mld_s_onelev_mod
use mld_base_prec_type
use mld_s_base_smoother_mod
use psb_base_mod, only : psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, psb_long_int_k_, psb_desc_type
& psb_slinmap_type, psb_spk_, psb_mpik_, psb_ipk_, psb_long_int_k_, psb_desc_type
!
!
! Type: mld_Tonelev_type.
@ -154,86 +154,93 @@ module mld_s_onelev_mod
interface
subroutine mld_s_base_onelev_descr(lv,il,nl,info,iout)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, mld_s_onelev_type, psb_long_int_k_, psb_desc_type
& psb_slinmap_type, psb_spk_, mld_s_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
! Arguments
class(mld_s_onelev_type), intent(in) :: lv
integer, intent(in) :: il,nl
integer, intent(out) :: info
integer, intent(in), optional :: iout
integer(psb_ipk_), intent(in) :: il,nl
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
end subroutine mld_s_base_onelev_descr
end interface
interface
subroutine mld_s_base_onelev_free(lv,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, mld_s_onelev_type, psb_long_int_k_, psb_desc_type
& psb_slinmap_type, psb_spk_, mld_s_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
implicit none
class(mld_s_onelev_type), intent(inout) :: lv
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_onelev_free
end interface
interface
subroutine mld_s_base_onelev_check(lv,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, mld_s_onelev_type, psb_long_int_k_, psb_desc_type
& psb_slinmap_type, psb_spk_, mld_s_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
! Arguments
class(mld_s_onelev_type), intent(inout) :: lv
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_onelev_check
end interface
interface
subroutine mld_s_base_onelev_seti(lv,what,val,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, mld_s_onelev_type, psb_long_int_k_, psb_desc_type
& psb_slinmap_type, psb_spk_, mld_s_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
! Arguments
class(mld_s_onelev_type), intent(inout) :: lv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_onelev_seti
end interface
interface
subroutine mld_s_base_onelev_setc(lv,what,val,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, mld_s_onelev_type, psb_long_int_k_, psb_desc_type
& psb_slinmap_type, psb_spk_, mld_s_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
! Arguments
class(mld_s_onelev_type), intent(inout) :: lv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_onelev_setc
end interface
interface
subroutine mld_s_base_onelev_setr(lv,what,val,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, mld_s_onelev_type, psb_long_int_k_, psb_desc_type
& psb_slinmap_type, psb_spk_, mld_s_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
class(mld_s_onelev_type), intent(inout) :: lv
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_onelev_setr
end interface
interface
subroutine mld_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,solver)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, mld_s_onelev_type, psb_long_int_k_, psb_desc_type
& psb_slinmap_type, psb_spk_, mld_s_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
implicit none
class(mld_s_onelev_type), intent(in) :: lv
integer, intent(in) :: level
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: ac, rp, smoother, solver
end subroutine mld_s_base_onelev_dump
@ -253,7 +260,7 @@ contains
implicit none
class(mld_s_onelev_type), intent(in) :: lv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(lv%sm)) &
& val = lv%sm%get_nzeros()
@ -263,7 +270,7 @@ contains
implicit none
class(mld_s_onelev_type), intent(in) :: lv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
val = val + lv%desc_ac%sizeof()
@ -325,7 +332,7 @@ contains
use psb_base_mod
implicit none
type(mld_s_onelev_type), intent(inout) :: a, b
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call b%free(info)
b%parms = a%parms

77
mlprec/mld_s_prec_mod.f90
Unescape Escape View File

@ -49,11 +49,12 @@ module mld_s_prec_mod
interface mld_precinit
subroutine mld_sprecinit(p,ptype,info,nlev)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, mld_sprec_type
import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
& mld_sprec_type, psb_ipk_
type(mld_sprec_type), intent(inout) :: p
character(len=*), intent(in) :: ptype
integer, intent(out) :: info
integer, optional, intent(in) :: nlev
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nlev
end subroutine mld_sprecinit
end interface
@ -65,46 +66,46 @@ module mld_s_prec_mod
interface mld_inner_precset
subroutine mld_sprecsetsm(p,val,info,ilev)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
& mld_sprec_type, mld_s_base_smoother_type
type(mld_sprec_type), intent(inout) :: p
& mld_sprec_type, mld_s_base_smoother_type, psb_ipk_
type(mld_sprec_type), intent(inout) :: p
class(mld_s_base_smoother_type), intent(in) :: val
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_sprecsetsm
subroutine mld_sprecsetsv(p,val,info,ilev)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
& mld_sprec_type, mld_s_base_solver_type
type(mld_sprec_type), intent(inout) :: p
& mld_sprec_type, mld_s_base_solver_type, psb_ipk_
type(mld_sprec_type), intent(inout) :: p
class(mld_s_base_solver_type), intent(in) :: val
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_sprecsetsv
subroutine mld_sprecseti(p,what,val,info,ilev)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
& mld_sprec_type
& mld_sprec_type, psb_ipk_
type(mld_sprec_type), intent(inout) :: p
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_sprecseti
subroutine mld_sprecsetr(p,what,val,info,ilev)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
& mld_sprec_type
& mld_sprec_type, psb_ipk_
type(mld_sprec_type), intent(inout) :: p
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_sprecsetr
subroutine mld_sprecsetc(p,what,string,info,ilev)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
& mld_sprec_type
& mld_sprec_type, psb_ipk_
type(mld_sprec_type), intent(inout) :: p
integer, intent(in) :: what
character(len=*), intent(in) :: string
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: string
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_sprecsetc
end interface
@ -112,12 +113,12 @@ module mld_s_prec_mod
subroutine mld_sprecbld(a,desc_a,prec,info,amold,vmold)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
& psb_s_base_sparse_mat, psb_s_base_vect_type, &
& mld_sprec_type
& mld_sprec_type, psb_ipk_
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_sprec_type), intent(inout), target :: prec
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
!!$ character, intent(in),optional :: upd
@ -129,7 +130,7 @@ contains
subroutine mld_s_iprecsetsm(p,val,info)
type(mld_sprec_type), intent(inout) :: p
class(mld_s_base_smoother_type), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,val,info)
end subroutine mld_s_iprecsetsm
@ -137,34 +138,34 @@ contains
subroutine mld_s_iprecsetsv(p,val,info)
type(mld_sprec_type), intent(inout) :: p
class(mld_s_base_solver_type), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,val,info)
end subroutine mld_s_iprecsetsv
subroutine mld_s_iprecseti(p,what,val,info)
type(mld_sprec_type), intent(inout) :: p
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info)
end subroutine mld_s_iprecseti
subroutine mld_s_iprecsetr(p,what,val,info)
type(mld_sprec_type), intent(inout) :: p
integer, intent(in) :: what
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info)
end subroutine mld_s_iprecsetr
subroutine mld_s_iprecsetc(p,what,val,info)
type(mld_sprec_type), intent(inout) :: p
integer, intent(in) :: what
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info)
end subroutine mld_s_iprecsetc

79
mlprec/mld_s_prec_type.f90
Unescape Escape View File

@ -80,7 +80,7 @@ module mld_s_prec_type
!
type, extends(psb_sprec_type) :: mld_sprec_type
integer :: ictxt
integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: coarse_aggr_size
real(psb_spk_) :: op_complexity=szero
type(mld_s_onelev_type), allocatable :: precv(:)
@ -121,41 +121,41 @@ module mld_s_prec_type
interface mld_precaply
subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
import :: psb_sspmat_type, psb_desc_type, &
& psb_spk_, psb_s_vect_type, mld_sprec_type
& psb_spk_, psb_s_vect_type, mld_sprec_type, psb_ipk_
type(psb_desc_type),intent(in) :: desc_data
type(mld_sprec_type), intent(inout) :: prec
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
real(psb_spk_),intent(inout), optional, target :: work(:)
end subroutine mld_sprecaply2_vect
subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work)
import :: psb_sspmat_type, psb_desc_type, &
& psb_spk_, psb_s_vect_type, mld_sprec_type
& psb_spk_, psb_s_vect_type, mld_sprec_type, psb_ipk_
type(psb_desc_type),intent(in) :: desc_data
type(mld_sprec_type), intent(inout) :: prec
type(psb_s_vect_type),intent(inout) :: x
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
real(psb_spk_),intent(inout), optional, target :: work(:)
end subroutine mld_sprecaply1_vect
subroutine mld_sprecaply(prec,x,y,desc_data,info,trans,work)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, mld_sprec_type
import :: psb_sspmat_type, psb_desc_type, psb_spk_, mld_sprec_type, psb_ipk_
type(psb_desc_type),intent(in) :: desc_data
type(mld_sprec_type), intent(in) :: prec
real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
real(psb_spk_),intent(inout), optional, target :: work(:)
end subroutine mld_sprecaply
subroutine mld_sprecaply1(prec,x,desc_data,info,trans)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, mld_sprec_type
import :: psb_sspmat_type, psb_desc_type, psb_spk_, mld_sprec_type, psb_ipk_
type(psb_desc_type),intent(in) :: desc_data
type(mld_sprec_type), intent(in) :: prec
real(psb_spk_),intent(inout) :: x(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
end subroutine mld_sprecaply1
end interface
@ -173,7 +173,7 @@ contains
implicit none
class(mld_sprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(prec%precv)) then
do i=1, size(prec%precv)
@ -186,7 +186,7 @@ contains
implicit none
class(mld_sprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
val = val + psb_sizeof_int
if (allocated(prec%precv)) then
@ -218,7 +218,8 @@ contains
class(mld_sprec_type), intent(inout) :: prec
real(psb_spk_) :: num,den
integer :: ictxt, il
integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: il
num = -done
den = done
@ -264,15 +265,15 @@ contains
subroutine mld_sfile_prec_descr(p,info,iout)
implicit none
! Arguments
type(mld_sprec_type), intent(in) :: p
integer, intent(out) :: info
integer, intent(in), optional :: iout
type(mld_sprec_type), intent(in) :: p
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
! Local variables
integer :: ilev, nlev
integer :: ictxt, me, np
integer(psb_ipk_) :: ilev, nlev
integer(psb_mpik_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
info = psb_success_
if (present(iout)) then
@ -370,10 +371,10 @@ contains
! Arguments
type(mld_sprec_type), intent(inout) :: p
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
! Local variables
integer :: me,err_act,i
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
@ -413,10 +414,10 @@ contains
class(mld_sprec_type), intent(inout) :: prec
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
integer, intent(out) :: info
character(len=1), optional :: trans
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
real(psb_spk_),intent(inout), optional, target :: work(:)
Integer :: err_act
Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act)
@ -445,13 +446,13 @@ contains
subroutine mld_s_apply1_vect(prec,x,desc_data,info,trans,work)
implicit none
type(psb_desc_type),intent(in) :: desc_data
type(psb_desc_type),intent(in) :: desc_data
class(mld_sprec_type), intent(inout) :: prec
type(psb_s_vect_type),intent(inout) :: x
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
real(psb_spk_),intent(inout), optional, target :: work(:)
Integer :: err_act
Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act)
@ -485,10 +486,10 @@ contains
class(mld_sprec_type), intent(in) :: prec
real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
real(psb_spk_),intent(inout), optional, target :: work(:)
Integer :: err_act
Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act)
@ -520,9 +521,9 @@ contains
type(psb_desc_type),intent(in) :: desc_data
class(mld_sprec_type), intent(in) :: prec
real(psb_spk_),intent(inout) :: x(:)
integer, intent(out) :: info
character(len=1), optional :: trans
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act)
@ -553,13 +554,13 @@ contains
subroutine mld_s_dump(prec,info,istart,iend,prefix,head,ac,rp,smoother,solver)
implicit none
class(mld_sprec_type), intent(in) :: prec
integer, intent(out) :: info
integer, intent(in), optional :: istart, iend
character(len=*), intent(in), optional :: prefix, head
class(mld_sprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: istart, iend
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp
integer :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_mpik_) :: icontxt,iam, np
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_
@ -588,8 +589,8 @@ contains
implicit none
type(mld_sprec_type), intent(inout) :: a
type(mld_sprec_type), intent(inout), target :: b
integer, intent(out) :: info
integer :: i
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i
if (allocated(b%precv)) then
! This might not be required if FINAL procedures are available.

96
mlprec/mld_z_as_smoother.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010,2012
!!$ (C) Copyright 2008,2009,2010,2010,2012
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -52,8 +52,8 @@ module mld_z_as_smoother
! class(mld_z_base_solver_type), allocatable :: sv
!
type(psb_zspmat_type) :: nd
type(psb_desc_type) :: desc_data
integer :: novr, restr, prol, nd_nnz_tot
type(psb_desc_type) :: desc_data
integer(psb_ipk_) :: novr, restr, prol, nd_nnz_tot
contains
procedure, pass(sm) :: check => mld_z_as_smoother_check
procedure, pass(sm) :: dump => mld_z_as_smoother_dmp
@ -83,41 +83,44 @@ module mld_z_as_smoother
interface
subroutine mld_z_as_smoother_check(sm,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
class(mld_z_as_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_as_smoother_check
end interface
interface
subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_as_smoother_type), intent(inout) :: sm
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
complex(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_as_smoother_apply_vect
end interface
interface
subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_as_smoother_type), intent(in) :: sm
complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_as_smoother_apply
end interface
@ -125,12 +128,13 @@ module mld_z_as_smoother
subroutine mld_z_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, &
& psb_desc_type, psb_z_base_sparse_mat
type(psb_zspmat_type), intent(in), target :: a
& psb_desc_type, psb_z_base_sparse_mat, psb_ipk_
implicit none
type(psb_zspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_z_as_smoother_type), intent(inout) :: sm
class(mld_z_as_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold
end subroutine mld_z_as_smoother_bld
@ -139,52 +143,59 @@ module mld_z_as_smoother
interface
subroutine mld_z_as_smoother_seti(sm,what,val,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
class(mld_z_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_as_smoother_seti
end interface
interface
subroutine mld_z_as_smoother_setc(sm,what,val,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
class(mld_z_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_as_smoother_setc
end interface
interface
subroutine mld_z_as_smoother_setr(sm,what,val,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
class(mld_z_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_as_smoother_setr
end interface
interface
subroutine mld_z_as_smoother_free(sm,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_
implicit none
class(mld_z_as_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_as_smoother_free
end interface
interface
subroutine mld_z_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type
& psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type, &
& psb_ipk_, psb_mpik_
implicit none
class(mld_z_as_smoother_type), intent(in) :: sm
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver
end subroutine mld_z_as_smoother_dmp
@ -197,7 +208,7 @@ contains
! Arguments
class(mld_z_as_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = psb_sizeof_int
if (allocated(sm%sv)) val = val + sm%sv%sizeof()
@ -210,7 +221,7 @@ contains
implicit none
class(mld_z_as_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sm%sv)) &
& val = sm%sv%get_nzeros()
@ -247,15 +258,14 @@ contains
! Arguments
class(mld_z_as_smoother_type), intent(in) :: sm
integer, intent(out) :: info
integer, intent(in), optional :: iout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_z_as_smoother_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
logical :: coarse_
call psb_erractionsave(err_act)

91
mlprec/mld_z_base_smoother_mod.f90
Unescape Escape View File

@ -118,16 +118,17 @@ module mld_z_base_smoother_mod
interface
subroutine mld_z_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_base_smoother_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_smoother_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_base_smoother_type), intent(in) :: sm
complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_smoother_apply
end interface
@ -135,74 +136,80 @@ module mld_z_base_smoother_mod
subroutine mld_z_base_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
& trans,sweeps,work,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_base_smoother_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_smoother_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_base_smoother_type), intent(inout) :: sm
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
complex(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_smoother_apply_vect
end interface
interface
subroutine mld_z_base_smoother_check(sm,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_base_smoother_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_smoother_type, psb_ipk_
! Arguments
class(mld_z_base_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_smoother_check
end interface
interface
subroutine mld_z_base_smoother_seti(sm,what,val,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_base_smoother_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_smoother_type, psb_ipk_
! Arguments
class(mld_z_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_smoother_seti
end interface
interface
subroutine mld_z_base_smoother_setc(sm,what,val,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_base_smoother_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_smoother_type, psb_ipk_
class(mld_z_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_smoother_setc
end interface
interface
subroutine mld_z_base_smoother_setr(sm,what,val,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_base_smoother_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_smoother_type, psb_ipk_
! Arguments
class(mld_z_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_smoother_setr
end interface
interface
subroutine mld_z_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_base_smoother_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_smoother_type, psb_ipk_
! Arguments
type(psb_zspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
type(psb_zspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_z_base_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold
end subroutine mld_z_base_smoother_bld
@ -211,32 +218,36 @@ module mld_z_base_smoother_mod
interface
subroutine mld_z_base_smoother_free(sm,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_base_smoother_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_smoother_type, psb_ipk_
! Arguments
class(mld_z_base_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_smoother_free
end interface
interface
subroutine mld_z_base_smoother_descr(sm,info,iout,coarse)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_base_smoother_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_smoother_type, psb_ipk_
! Arguments
class(mld_z_base_smoother_type), intent(in) :: sm
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine mld_z_base_smoother_descr
end interface
interface
subroutine mld_z_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_base_smoother_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_smoother_type, psb_ipk_, psb_mpik_
class(mld_z_base_smoother_type), intent(in) :: sm
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver
end subroutine mld_z_base_smoother_dmp
@ -252,7 +263,7 @@ contains
implicit none
class(mld_z_base_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sm%sv)) &
& val = sm%sv%get_nzeros()
@ -263,7 +274,7 @@ contains
! Arguments
class(mld_z_base_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sm%sv)) then

97
mlprec/mld_z_base_solver_mod.f90
Unescape Escape View File

@ -108,15 +108,17 @@ module mld_z_base_solver_mod
interface
subroutine mld_z_base_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_base_solver_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_solver_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_base_solver_type), intent(in) :: sv
complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_solver_apply
end interface
@ -124,32 +126,33 @@ module mld_z_base_solver_mod
interface
subroutine mld_z_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_base_solver_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_solver_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_base_solver_type), intent(inout) :: sv
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_solver_apply_vect
end interface
interface
subroutine mld_z_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_base_solver_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_solver_type, psb_ipk_
Implicit None
! Arguments
type(psb_zspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_z_base_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type), intent(in), target, optional :: b
class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold
@ -159,84 +162,85 @@ module mld_z_base_solver_mod
interface
subroutine mld_z_base_solver_check(sv,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_base_solver_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_solver_check
end interface
interface
subroutine mld_z_base_solver_seti(sv,what,val,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_base_solver_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_solver_seti
end interface
interface
subroutine mld_z_base_solver_setc(sv,what,val,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_base_solver_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_solver_setc
end interface
interface
subroutine mld_z_base_solver_setr(sv,what,val,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_base_solver_type
Implicit None
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_solver_setr
end interface
interface
subroutine mld_z_base_solver_free(sv,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_base_solver_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_solver_free
end interface
interface
subroutine mld_z_base_solver_descr(sv,info,iout,coarse)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_base_solver_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_solver_type, psb_ipk_
Implicit None
! Arguments
class(mld_z_base_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine mld_z_base_solver_descr
end interface
@ -244,12 +248,13 @@ module mld_z_base_solver_mod
interface
subroutine mld_z_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_base_solver_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_solver_type, psb_ipk_, psb_mpik_
implicit none
class(mld_z_base_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
end subroutine mld_z_base_solver_dmp
@ -269,7 +274,7 @@ contains
! Arguments
class(mld_z_base_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
return
@ -279,7 +284,7 @@ contains
implicit none
class(mld_z_base_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
end function z_base_solver_get_nzeros

78
mlprec/mld_z_diag_solver.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010,2012
!!$ (C) Copyright 2008,2009,2010,2010,2012
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -73,42 +73,45 @@ module mld_z_diag_solver
interface
subroutine mld_z_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_diag_solver_type
type(psb_desc_type), intent(in) :: desc_data
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_diag_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_diag_solver_type), intent(inout) :: sv
type(psb_z_vect_type), intent(inout) :: x
type(psb_z_vect_type), intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_diag_solver_apply_vect
end interface
interface
subroutine mld_z_diag_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_diag_solver_type
type(psb_desc_type), intent(in) :: desc_data
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_diag_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_diag_solver_type), intent(in) :: sv
complex(psb_dpk_), intent(inout) :: x(:)
complex(psb_dpk_), intent(inout) :: y(:)
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_diag_solver_apply
end interface
interface
subroutine mld_z_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_diag_solver_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_diag_solver_type, psb_ipk_
type(psb_zspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_z_diag_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type), intent(in), target, optional :: b
class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold
@ -125,10 +128,10 @@ contains
! Arguments
class(mld_z_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act
character(len=20) :: name='z_diag_solver_seti'
info = psb_success_
@ -144,10 +147,10 @@ contains
! Arguments
class(mld_z_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='z_diag_solver_setc'
info = psb_success_
@ -161,10 +164,10 @@ contains
! Arguments
class(mld_z_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act
character(len=20) :: name='z_diag_solver_setr'
info = psb_success_
@ -179,9 +182,9 @@ contains
! Arguments
class(mld_z_diag_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='z_diag_solver_free'
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_diag_solver_free'
call psb_erractionsave(err_act)
info = psb_success_
@ -215,15 +218,14 @@ contains
! Arguments
class(mld_z_diag_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_z_diag_solver_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
info = psb_success_
if (present(iout)) then
@ -243,7 +245,7 @@ contains
! Arguments
class(mld_z_diag_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sv%dv)) val = val + sv%dv%sizeof()
@ -256,7 +258,7 @@ contains
! Arguments
class(mld_z_diag_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sv%dv)) val = val + sv%dv%get_nrows()

75
mlprec/mld_z_id_solver.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010,2012
!!$ (C) Copyright 2008,2009,2010,2010,2012
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -68,22 +68,24 @@ module mld_z_id_solver
interface
subroutine mld_z_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_id_solver_type
type(psb_desc_type), intent(in) :: desc_data
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_id_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_id_solver_type), intent(inout) :: sv
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_id_solver_apply_vect
end interface
interface
subroutine mld_z_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, mld_z_id_solver_type
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_id_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_id_solver_type), intent(in) :: sv
complex(psb_dpk_),intent(inout) :: x(:)
@ -91,7 +93,7 @@ module mld_z_id_solver
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_id_solver_apply
end interface
@ -104,17 +106,17 @@ contains
! Arguments
type(psb_zspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_z_id_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type), intent(in), target, optional :: b
class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold
! Local variables
integer :: n_row,n_col, nrow_a, nztota
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
character(len=20) :: name='z_id_solver_bld', ch_err
info=psb_success_
@ -129,11 +131,11 @@ contains
! Arguments
class(mld_z_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='z_id_solver_seti'
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_id_solver_seti'
info = psb_success_
@ -147,11 +149,11 @@ contains
! Arguments
class(mld_z_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
character(len=20) :: name='z_id_solver_setc'
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='z_id_solver_setc'
info = psb_success_
@ -164,11 +166,11 @@ contains
! Arguments
class(mld_z_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='z_id_solver_setr'
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_id_solver_setr'
info = psb_success_
@ -182,9 +184,9 @@ contains
! Arguments
class(mld_z_id_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='z_id_solver_free'
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_id_solver_free'
info = psb_success_
@ -197,15 +199,14 @@ contains
! Arguments
class(mld_z_id_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_z_id_solver_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
info = psb_success_
if (present(iout)) then

97
mlprec/mld_z_ilu_solver.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010,2012
!!$ (C) Copyright 2008,2009,2010,2010,2012
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -49,11 +49,11 @@ module mld_z_ilu_solver
use mld_z_ilu_fact_mod
type, extends(mld_z_base_solver_type) :: mld_z_ilu_solver_type
type(psb_zspmat_type) :: l, u
type(psb_zspmat_type) :: l, u
complex(psb_dpk_), allocatable :: d(:)
type(psb_z_vect_type) :: dv
integer :: fact_type, fill_in
real(psb_dpk_) :: thresh
type(psb_z_vect_type) :: dv
integer(psb_ipk_) :: fact_type, fill_in
real(psb_dpk_) :: thresh
contains
procedure, pass(sv) :: dump => mld_z_ilu_solver_dmp
procedure, pass(sv) :: build => mld_z_ilu_solver_bld
@ -90,42 +90,45 @@ module mld_z_ilu_solver
interface
subroutine mld_z_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, mld_z_ilu_solver_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_ilu_solver_type), intent(inout) :: sv
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_ilu_solver_apply_vect
end interface
interface
subroutine mld_z_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
import :: psb_desc_type, mld_z_ilu_solver_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_ilu_solver_type), intent(in) :: sv
complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_ilu_solver_apply
end interface
interface
subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
import :: psb_desc_type, mld_z_ilu_solver_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
implicit none
type(psb_zspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_z_ilu_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type), intent(in), target, optional :: b
class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold
@ -135,12 +138,15 @@ module mld_z_ilu_solver
interface
subroutine mld_z_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
import :: psb_desc_type, mld_z_ilu_solver_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, &
& psb_ipk_, psb_mpik_
implicit none
class(mld_z_ilu_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
end subroutine mld_z_ilu_solver_dmp
end interface
@ -167,8 +173,8 @@ contains
! Arguments
class(mld_z_ilu_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_ilu_solver_check'
call psb_erractionsave(err_act)
@ -180,7 +186,7 @@ contains
select case(sv%fact_type)
case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(sv%fill_in,&
& 'Level',0,is_legal_ml_lev)
& 'Level',izero,is_legal_ml_lev)
case(mld_ilu_t_)
call mld_check_def(sv%thresh,&
& 'Eps',dzero,is_legal_d_fact_thrs)
@ -207,10 +213,10 @@ contains
! Arguments
class(mld_z_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_ilu_solver_seti'
info = psb_success_
@ -244,10 +250,10 @@ contains
! Arguments
class(mld_z_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='z_ilu_solver_setc'
info = psb_success_
@ -280,10 +286,10 @@ contains
! Arguments
class(mld_z_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_ilu_solver_setr'
call psb_erractionsave(err_act)
@ -316,8 +322,8 @@ contains
! Arguments
class(mld_z_ilu_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_ilu_solver_free'
call psb_erractionsave(err_act)
@ -353,15 +359,14 @@ contains
! Arguments
class(mld_z_ilu_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_z_ilu_solver_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
call psb_erractionsave(err_act)
info = psb_success_
@ -399,7 +404,7 @@ contains
! Arguments
class(mld_z_ilu_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
val = val + sv%dv%get_nrows()
@ -415,7 +420,7 @@ contains
! Arguments
class(mld_z_ilu_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 2*psb_sizeof_int + (2*psb_sizeof_dp)
val = val + sv%dv%sizeof()

79
mlprec/mld_z_inner_mod.f90
Unescape Escape View File

@ -50,13 +50,13 @@ module mld_z_inner_mod
interface mld_mlprec_bld
subroutine mld_zmlprec_bld(a,desc_a,prec,info, amold, vmold)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, &
& psb_dpk_, psb_z_base_sparse_mat, psb_z_base_vect_type
& psb_dpk_, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
use mld_z_prec_type, only : mld_zprec_type
implicit none
type(psb_zspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_zprec_type), intent(inout), target :: prec
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold
!!$ character, intent(in),optional :: upd
@ -66,78 +66,84 @@ module mld_z_inner_mod
interface mld_mlprec_aply
subroutine mld_zmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
use mld_z_prec_type, only : mld_zprec_type
type(psb_desc_type),intent(in) :: desc_data
type(mld_zprec_type), intent(in) :: p
implicit none
type(psb_desc_type),intent(in) :: desc_data
type(mld_zprec_type), intent(in) :: p
complex(psb_dpk_),intent(in) :: alpha,beta
complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
character,intent(in) :: trans
character,intent(in) :: trans
complex(psb_dpk_),target :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_zmlprec_aply
subroutine mld_zmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, &
& psb_dpk_, psb_z_vect_type
& psb_dpk_, psb_z_vect_type, psb_ipk_
use mld_z_prec_type, only : mld_zprec_type
type(psb_desc_type),intent(in) :: desc_data
implicit none
type(psb_desc_type),intent(in) :: desc_data
type(mld_zprec_type), intent(inout) :: p
complex(psb_dpk_),intent(in) :: alpha,beta
complex(psb_dpk_),intent(in) :: alpha,beta
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
character,intent(in) :: trans
complex(psb_dpk_),target :: work(:)
integer, intent(out) :: info
character,intent(in) :: trans
complex(psb_dpk_),target :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_zmlprec_aply_vect
end interface mld_mlprec_aply
interface mld_coarse_bld
subroutine mld_zcoarse_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
use mld_z_prec_type, only : mld_z_onelev_type
type(psb_zspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
implicit none
type(psb_zspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_z_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_zcoarse_bld
end interface mld_coarse_bld
interface mld_aggrmap_bld
subroutine mld_zaggrmap_bld(aggr_type,theta,a,desc_a,ilaggr,nlaggr,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
integer, intent(in) :: aggr_type
real(psb_dpk_), intent(in) :: theta
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
implicit none
integer(psb_ipk_), intent(in) :: aggr_type
real(psb_dpk_), intent(in) :: theta
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_zaggrmap_bld
end interface mld_aggrmap_bld
interface mld_dec_map_bld
subroutine mld_z_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
implicit none
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_), intent(in) :: theta
integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_dec_map_bld
end interface mld_dec_map_bld
interface mld_aggrmat_asb
subroutine mld_zaggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
use mld_z_prec_type, only : mld_z_onelev_type
implicit none
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_z_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_zaggrmat_asb
end interface mld_aggrmat_asb
@ -145,14 +151,15 @@ module mld_z_inner_mod
abstract interface
subroutine mld_zaggrmat_var_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
use mld_z_prec_type, only : mld_z_onelev_type, mld_dml_parms
implicit none
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_dml_parms), intent(inout) :: parms
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_dml_parms), intent(inout) :: parms
type(psb_zspmat_type), intent(out) :: ac,op_prol,op_restr
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_zaggrmat_var_asb
end interface

83
mlprec/mld_z_jac_smoother.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010,2012
!!$ (C) Copyright 2008,2009,2010,2010,2012
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -52,7 +52,7 @@ module mld_z_jac_smoother
! class(mld_z_base_solver_type), allocatable :: sv
!
type(psb_zspmat_type) :: nd
integer :: nnz_nd_tot
integer(psb_ipk_) :: nnz_nd_tot
contains
procedure, pass(sm) :: build => mld_z_jac_smoother_bld
procedure, pass(sm) :: apply_v => mld_z_jac_smoother_apply_vect
@ -76,45 +76,45 @@ module mld_z_jac_smoother
interface
subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
import :: psb_desc_type, mld_z_jac_smoother_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type
type(psb_desc_type), intent(in) :: desc_data
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_jac_smoother_type), intent(inout) :: sm
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
complex(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_jac_smoother_apply_vect
end interface
interface
subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
import :: psb_desc_type, mld_z_jac_smoother_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_jac_smoother_type), intent(in) :: sm
complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_jac_smoother_apply
end interface
interface
subroutine mld_z_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
import :: psb_desc_type, mld_z_jac_smoother_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type
type(psb_zspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_z_jac_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
type(psb_zspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_z_jac_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold
end subroutine mld_z_jac_smoother_bld
@ -128,10 +128,10 @@ contains
! Arguments
class(mld_z_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act
character(len=20) :: name='z_jac_smoother_seti'
info = psb_success_
@ -164,10 +164,10 @@ contains
! Arguments
class(mld_z_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='z_jac_smoother_setc'
info = psb_success_
@ -196,15 +196,14 @@ contains
subroutine z_jac_smoother_setr(sm,what,val,info)
Implicit None
! Arguments
class(mld_z_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_jac_smoother_setr'
call psb_erractionsave(err_act)
@ -234,8 +233,8 @@ contains
! Arguments
class(mld_z_jac_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_jac_smoother_free'
call psb_erractionsave(err_act)
@ -268,20 +267,18 @@ contains
subroutine z_jac_smoother_descr(sm,info,iout,coarse)
Implicit None
! Arguments
class(mld_z_jac_smoother_type), intent(in) :: sm
integer, intent(out) :: info
integer, intent(in), optional :: iout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_z_jac_smoother_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
logical :: coarse_
call psb_erractionsave(err_act)
@ -323,7 +320,7 @@ contains
! Arguments
class(mld_z_jac_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = psb_sizeof_int
if (allocated(sm%sv)) val = val + sm%sv%sizeof()
@ -338,7 +335,7 @@ contains
! Arguments
class(mld_z_jac_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(sm%sv)) val = val + sm%sv%get_nzeros()

61
mlprec/mld_z_onelev_mod.f90
Unescape Escape View File

@ -57,7 +57,7 @@ module mld_z_onelev_mod
use mld_base_prec_type
use mld_z_base_smoother_mod
use psb_base_mod, only : psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_zlinmap_type, psb_dpk_, psb_long_int_k_, psb_desc_type
& psb_zlinmap_type, psb_dpk_, psb_mpik_, psb_ipk_, psb_long_int_k_, psb_desc_type
!
!
! Type: mld_Tonelev_type.
@ -154,86 +154,93 @@ module mld_z_onelev_mod
interface
subroutine mld_z_base_onelev_descr(lv,il,nl,info,iout)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, psb_long_int_k_, psb_desc_type
& psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
! Arguments
class(mld_z_onelev_type), intent(in) :: lv
integer, intent(in) :: il,nl
integer, intent(out) :: info
integer, intent(in), optional :: iout
integer(psb_ipk_), intent(in) :: il,nl
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
end subroutine mld_z_base_onelev_descr
end interface
interface
subroutine mld_z_base_onelev_free(lv,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, psb_long_int_k_, psb_desc_type
& psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
implicit none
class(mld_z_onelev_type), intent(inout) :: lv
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_onelev_free
end interface
interface
subroutine mld_z_base_onelev_check(lv,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, psb_long_int_k_, psb_desc_type
& psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
! Arguments
class(mld_z_onelev_type), intent(inout) :: lv
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_onelev_check
end interface
interface
subroutine mld_z_base_onelev_seti(lv,what,val,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, psb_long_int_k_, psb_desc_type
& psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
! Arguments
class(mld_z_onelev_type), intent(inout) :: lv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_onelev_seti
end interface
interface
subroutine mld_z_base_onelev_setc(lv,what,val,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, psb_long_int_k_, psb_desc_type
& psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
! Arguments
class(mld_z_onelev_type), intent(inout) :: lv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_onelev_setc
end interface
interface
subroutine mld_z_base_onelev_setr(lv,what,val,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, psb_long_int_k_, psb_desc_type
& psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
class(mld_z_onelev_type), intent(inout) :: lv
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_onelev_setr
end interface
interface
subroutine mld_z_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,solver)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, psb_long_int_k_, psb_desc_type
& psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
implicit none
class(mld_z_onelev_type), intent(in) :: lv
integer, intent(in) :: level
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: ac, rp, smoother, solver
end subroutine mld_z_base_onelev_dump
@ -253,7 +260,7 @@ contains
implicit none
class(mld_z_onelev_type), intent(in) :: lv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(lv%sm)) &
& val = lv%sm%get_nzeros()
@ -263,7 +270,7 @@ contains
implicit none
class(mld_z_onelev_type), intent(in) :: lv
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
val = val + lv%desc_ac%sizeof()
@ -325,7 +332,7 @@ contains
use psb_base_mod
implicit none
type(mld_z_onelev_type), intent(inout) :: a, b
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call b%free(info)
b%parms = a%parms

77
mlprec/mld_z_prec_mod.f90
Unescape Escape View File

@ -49,11 +49,12 @@ module mld_z_prec_mod
interface mld_precinit
subroutine mld_zprecinit(p,ptype,info,nlev)
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, mld_zprec_type
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
& mld_zprec_type, psb_ipk_
type(mld_zprec_type), intent(inout) :: p
character(len=*), intent(in) :: ptype
integer, intent(out) :: info
integer, optional, intent(in) :: nlev
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nlev
end subroutine mld_zprecinit
end interface
@ -65,46 +66,46 @@ module mld_z_prec_mod
interface mld_inner_precset
subroutine mld_zprecsetsm(p,val,info,ilev)
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
& mld_zprec_type, mld_z_base_smoother_type
type(mld_zprec_type), intent(inout) :: p
& mld_zprec_type, mld_z_base_smoother_type, psb_ipk_
type(mld_zprec_type), intent(inout) :: p
class(mld_z_base_smoother_type), intent(in) :: val
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_zprecsetsm
subroutine mld_zprecsetsv(p,val,info,ilev)
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
& mld_zprec_type, mld_z_base_solver_type
type(mld_zprec_type), intent(inout) :: p
& mld_zprec_type, mld_z_base_solver_type, psb_ipk_
type(mld_zprec_type), intent(inout) :: p
class(mld_z_base_solver_type), intent(in) :: val
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_zprecsetsv
subroutine mld_zprecseti(p,what,val,info,ilev)
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
& mld_zprec_type
& mld_zprec_type, psb_ipk_
type(mld_zprec_type), intent(inout) :: p
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_zprecseti
subroutine mld_zprecsetr(p,what,val,info,ilev)
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
& mld_zprec_type
& mld_zprec_type, psb_ipk_
type(mld_zprec_type), intent(inout) :: p
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_zprecsetr
subroutine mld_zprecsetc(p,what,string,info,ilev)
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
& mld_zprec_type
& mld_zprec_type, psb_ipk_
type(mld_zprec_type), intent(inout) :: p
integer, intent(in) :: what
character(len=*), intent(in) :: string
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: string
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_zprecsetc
end interface
@ -112,12 +113,12 @@ module mld_z_prec_mod
subroutine mld_zprecbld(a,desc_a,prec,info,amold,vmold)
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
& psb_z_base_sparse_mat, psb_z_base_vect_type, &
& mld_zprec_type
& mld_zprec_type, psb_ipk_
implicit none
type(psb_zspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_zprec_type), intent(inout), target :: prec
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold
!!$ character, intent(in),optional :: upd
@ -129,7 +130,7 @@ contains
subroutine mld_z_iprecsetsm(p,val,info)
type(mld_zprec_type), intent(inout) :: p
class(mld_z_base_smoother_type), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,val,info)
end subroutine mld_z_iprecsetsm
@ -137,34 +138,34 @@ contains
subroutine mld_z_iprecsetsv(p,val,info)
type(mld_zprec_type), intent(inout) :: p
class(mld_z_base_solver_type), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,val,info)
end subroutine mld_z_iprecsetsv
subroutine mld_z_iprecseti(p,what,val,info)
type(mld_zprec_type), intent(inout) :: p
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info)
end subroutine mld_z_iprecseti
subroutine mld_z_iprecsetr(p,what,val,info)
type(mld_zprec_type), intent(inout) :: p
integer, intent(in) :: what
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info)
end subroutine mld_z_iprecsetr
subroutine mld_z_iprecsetc(p,what,val,info)
type(mld_zprec_type), intent(inout) :: p
integer, intent(in) :: what
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info)
end subroutine mld_z_iprecsetc

79
mlprec/mld_z_prec_type.f90
Unescape Escape View File

@ -80,7 +80,7 @@ module mld_z_prec_type
!
type, extends(psb_zprec_type) :: mld_zprec_type
integer :: ictxt
integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: coarse_aggr_size
real(psb_dpk_) :: op_complexity=dzero
type(mld_z_onelev_type), allocatable :: precv(:)
@ -121,41 +121,41 @@ module mld_z_prec_type
interface mld_precaply
subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work)
import :: psb_zspmat_type, psb_desc_type, &
& psb_dpk_, psb_z_vect_type, mld_zprec_type
& psb_dpk_, psb_z_vect_type, mld_zprec_type, psb_ipk_
type(psb_desc_type),intent(in) :: desc_data
type(mld_zprec_type), intent(inout) :: prec
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
complex(psb_dpk_),intent(inout), optional, target :: work(:)
end subroutine mld_zprecaply2_vect
subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work)
import :: psb_zspmat_type, psb_desc_type, &
& psb_dpk_, psb_z_vect_type, mld_zprec_type
& psb_dpk_, psb_z_vect_type, mld_zprec_type, psb_ipk_
type(psb_desc_type),intent(in) :: desc_data
type(mld_zprec_type), intent(inout) :: prec
type(psb_z_vect_type),intent(inout) :: x
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
complex(psb_dpk_),intent(inout), optional, target :: work(:)
end subroutine mld_zprecaply1_vect
subroutine mld_zprecaply(prec,x,y,desc_data,info,trans,work)
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, mld_zprec_type
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, mld_zprec_type, psb_ipk_
type(psb_desc_type),intent(in) :: desc_data
type(mld_zprec_type), intent(in) :: prec
complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
complex(psb_dpk_),intent(inout), optional, target :: work(:)
end subroutine mld_zprecaply
subroutine mld_zprecaply1(prec,x,desc_data,info,trans)
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, mld_zprec_type
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, mld_zprec_type, psb_ipk_
type(psb_desc_type),intent(in) :: desc_data
type(mld_zprec_type), intent(in) :: prec
complex(psb_dpk_),intent(inout) :: x(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
end subroutine mld_zprecaply1
end interface
@ -173,7 +173,7 @@ contains
implicit none
class(mld_zprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
if (allocated(prec%precv)) then
do i=1, size(prec%precv)
@ -186,7 +186,7 @@ contains
implicit none
class(mld_zprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
integer(psb_ipk_) :: i
val = 0
val = val + psb_sizeof_int
if (allocated(prec%precv)) then
@ -218,7 +218,8 @@ contains
class(mld_zprec_type), intent(inout) :: prec
real(psb_dpk_) :: num,den
integer :: ictxt, il
integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: il
num = -done
den = done
@ -264,15 +265,15 @@ contains
subroutine mld_zfile_prec_descr(p,info,iout)
implicit none
! Arguments
type(mld_zprec_type), intent(in) :: p
integer, intent(out) :: info
integer, intent(in), optional :: iout
type(mld_zprec_type), intent(in) :: p
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
! Local variables
integer :: ilev, nlev
integer :: ictxt, me, np
integer(psb_ipk_) :: ilev, nlev
integer(psb_mpik_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr'
integer :: iout_
integer(psb_ipk_) :: iout_
info = psb_success_
if (present(iout)) then
@ -370,10 +371,10 @@ contains
! Arguments
type(mld_zprec_type), intent(inout) :: p
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
! Local variables
integer :: me,err_act,i
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
@ -413,10 +414,10 @@ contains
class(mld_zprec_type), intent(inout) :: prec
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
integer, intent(out) :: info
character(len=1), optional :: trans
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
complex(psb_dpk_),intent(inout), optional, target :: work(:)
Integer :: err_act
Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act)
@ -445,13 +446,13 @@ contains
subroutine mld_z_apply1_vect(prec,x,desc_data,info,trans,work)
implicit none
type(psb_desc_type),intent(in) :: desc_data
type(psb_desc_type),intent(in) :: desc_data
class(mld_zprec_type), intent(inout) :: prec
type(psb_z_vect_type),intent(inout) :: x
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
complex(psb_dpk_),intent(inout), optional, target :: work(:)
Integer :: err_act
Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act)
@ -485,10 +486,10 @@ contains
class(mld_zprec_type), intent(in) :: prec
complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
complex(psb_dpk_),intent(inout), optional, target :: work(:)
Integer :: err_act
Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act)
@ -520,9 +521,9 @@ contains
type(psb_desc_type),intent(in) :: desc_data
class(mld_zprec_type), intent(in) :: prec
complex(psb_dpk_),intent(inout) :: x(:)
integer, intent(out) :: info
character(len=1), optional :: trans
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans
Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act)
@ -553,13 +554,13 @@ contains
subroutine mld_z_dump(prec,info,istart,iend,prefix,head,ac,rp,smoother,solver)
implicit none
class(mld_zprec_type), intent(in) :: prec
integer, intent(out) :: info
integer, intent(in), optional :: istart, iend
character(len=*), intent(in), optional :: prefix, head
class(mld_zprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: istart, iend
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp
integer :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_mpik_) :: icontxt,iam, np
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_
@ -588,8 +589,8 @@ contains
implicit none
type(mld_zprec_type), intent(inout) :: a
type(mld_zprec_type), intent(inout), target :: b
integer, intent(out) :: info
integer :: i
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i
if (allocated(b%precv)) then
! This might not be required if FINAL procedures are available.

Write Preview
Loading…
Cancel
Save