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_const_mod
use psb_base_mod, only :& use psb_base_mod, only :&
& psb_desc_type,& & 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_cdfree, psb_halo_, psb_none_, psb_sum_, psb_avg_, &
& psb_nohalo_, psb_square_root_, psb_toupper, psb_root_,& & psb_nohalo_, psb_square_root_, psb_toupper, psb_root_,&
& psb_sizeof_int, psb_sizeof_long_int, psb_sizeof_sp, psb_sizeof_dp, psb_sizeof,& & 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 ! Version numbers
! !
character(len=*), parameter :: mld_version_string_ = "2.0.0" character(len=*), parameter :: mld_version_string_ = "2.0.0"
integer, parameter :: mld_version_major_ = 2 integer(psb_ipk_), parameter :: mld_version_major_ = 2
integer, parameter :: mld_version_minor_ = 0 integer(psb_ipk_), parameter :: mld_version_minor_ = 0
integer, parameter :: mld_patchlevel_ = 0 integer(psb_ipk_), parameter :: mld_patchlevel_ = 0
type mld_aux_onelev_map_type type mld_aux_onelev_map_type
integer :: naggr integer(psb_ipk_) :: naggr
integer, allocatable :: ilaggr(:) integer(psb_ipk_), allocatable :: ilaggr(:)
end type mld_aux_onelev_map_type end type mld_aux_onelev_map_type
type mld_aux_map_type type mld_aux_map_type
@ -95,11 +95,11 @@ module mld_base_prec_type
end type mld_aux_map_type end type mld_aux_map_type
type mld_ml_parms type mld_ml_parms
integer :: sweeps, sweeps_pre, sweeps_post integer(psb_ipk_) :: sweeps, sweeps_pre, sweeps_post
integer :: ml_type, smoother_pos integer(psb_ipk_) :: ml_type, smoother_pos
integer :: aggr_alg, aggr_kind integer(psb_ipk_) :: aggr_alg, aggr_kind
integer :: aggr_omega_alg, aggr_eig, aggr_filter integer(psb_ipk_) :: aggr_omega_alg, aggr_eig, aggr_filter
integer :: coarse_mat, coarse_solve integer(psb_ipk_) :: coarse_mat, coarse_solve
contains contains
procedure, pass(pm) :: descr => ml_parms_descr procedure, pass(pm) :: descr => ml_parms_descr
procedure, pass(pm) :: mldescr => ml_parms_mldescr procedure, pass(pm) :: mldescr => ml_parms_mldescr
@ -128,166 +128,166 @@ module mld_base_prec_type
! !
! These are in baseprec ! These are in baseprec
! !
integer, parameter :: mld_smoother_type_ = 1 integer(psb_ipk_), parameter :: mld_smoother_type_ = 1
integer, parameter :: mld_sub_solve_ = 2 integer(psb_ipk_), parameter :: mld_sub_solve_ = 2
integer, parameter :: mld_sub_restr_ = 3 integer(psb_ipk_), parameter :: mld_sub_restr_ = 3
integer, parameter :: mld_sub_prol_ = 4 integer(psb_ipk_), parameter :: mld_sub_prol_ = 4
integer, parameter :: mld_sub_ren_ = 5 integer(psb_ipk_), parameter :: mld_sub_ren_ = 5
integer, parameter :: mld_sub_ovr_ = 6 integer(psb_ipk_), parameter :: mld_sub_ovr_ = 6
integer, parameter :: mld_sub_fillin_ = 7 integer(psb_ipk_), parameter :: mld_sub_fillin_ = 7
integer, parameter :: mld_ilu_scale_ = 8 integer(psb_ipk_), parameter :: mld_ilu_scale_ = 8
!! 2 ints for 64 bit versions !! 2 ints for 64 bit versions
integer, parameter :: mld_slu_ptr_ = 10 integer(psb_ipk_), parameter :: mld_slu_ptr_ = 10
integer, parameter :: mld_umf_symptr_ = 12 integer(psb_ipk_), parameter :: mld_umf_symptr_ = 12
integer, parameter :: mld_umf_numptr_ = 14 integer(psb_ipk_), parameter :: mld_umf_numptr_ = 14
integer, parameter :: mld_slud_ptr_ = 16 integer(psb_ipk_), parameter :: mld_slud_ptr_ = 16
integer, parameter :: mld_prec_status_ = 18 integer(psb_ipk_), parameter :: mld_prec_status_ = 18
! !
! These are in onelev ! These are in onelev
! !
integer, parameter :: mld_ml_type_ = 20 integer(psb_ipk_), parameter :: mld_ml_type_ = 20
integer, parameter :: mld_smoother_sweeps_pre_ = 21 integer(psb_ipk_), parameter :: mld_smoother_sweeps_pre_ = 21
integer, parameter :: mld_smoother_sweeps_post_ = 22 integer(psb_ipk_), parameter :: mld_smoother_sweeps_post_ = 22
integer, parameter :: mld_smoother_pos_ = 23 integer(psb_ipk_), parameter :: mld_smoother_pos_ = 23
integer, parameter :: mld_aggr_kind_ = 24 integer(psb_ipk_), parameter :: mld_aggr_kind_ = 24
integer, parameter :: mld_aggr_alg_ = 25 integer(psb_ipk_), parameter :: mld_aggr_alg_ = 25
integer, parameter :: mld_aggr_omega_alg_ = 26 integer(psb_ipk_), parameter :: mld_aggr_omega_alg_ = 26
integer, parameter :: mld_aggr_eig_ = 27 integer(psb_ipk_), parameter :: mld_aggr_eig_ = 27
integer, parameter :: mld_aggr_filter_ = 28 integer(psb_ipk_), parameter :: mld_aggr_filter_ = 28
integer, parameter :: mld_coarse_mat_ = 29 integer(psb_ipk_), parameter :: mld_coarse_mat_ = 29
integer, parameter :: mld_coarse_solve_ = 30 integer(psb_ipk_), parameter :: mld_coarse_solve_ = 30
integer, parameter :: mld_coarse_sweeps_ = 31 integer(psb_ipk_), parameter :: mld_coarse_sweeps_ = 31
integer, parameter :: mld_coarse_fillin_ = 32 integer(psb_ipk_), parameter :: mld_coarse_fillin_ = 32
integer, parameter :: mld_coarse_subsolve_ = 33 integer(psb_ipk_), parameter :: mld_coarse_subsolve_ = 33
integer, parameter :: mld_smoother_sweeps_ = 34 integer(psb_ipk_), parameter :: mld_smoother_sweeps_ = 34
integer, parameter :: mld_coarse_aggr_size_ = 35 integer(psb_ipk_), parameter :: mld_coarse_aggr_size_ = 35
integer, parameter :: mld_ifpsz_ = 36 integer(psb_ipk_), parameter :: mld_ifpsz_ = 36
! !
! Legal values for entry: mld_smoother_type_ ! Legal values for entry: mld_smoother_type_
! !
integer, parameter :: mld_min_prec_ = 0 integer(psb_ipk_), parameter :: mld_min_prec_ = 0
integer, parameter :: mld_noprec_ = 0 integer(psb_ipk_), parameter :: mld_noprec_ = 0
integer, parameter :: mld_jac_ = 1 integer(psb_ipk_), parameter :: mld_jac_ = 1
integer, parameter :: mld_bjac_ = 2 integer(psb_ipk_), parameter :: mld_bjac_ = 2
integer, parameter :: mld_as_ = 3 integer(psb_ipk_), parameter :: mld_as_ = 3
integer, parameter :: mld_max_prec_ = 3 integer(psb_ipk_), parameter :: mld_max_prec_ = 3
! !
! This is a quick&dirty fix, but I have nothing better now... ! This is a quick&dirty fix, but I have nothing better now...
! !
! Legal values for entry: mld_sub_solve_ ! Legal values for entry: mld_sub_solve_
! !
integer, parameter :: mld_slv_delta_ = mld_max_prec_+1 integer(psb_ipk_), parameter :: mld_slv_delta_ = mld_max_prec_+1
integer, parameter :: mld_f_none_ = mld_slv_delta_+0 integer(psb_ipk_), parameter :: mld_f_none_ = mld_slv_delta_+0
integer, parameter :: mld_diag_scale_ = mld_slv_delta_+1 integer(psb_ipk_), parameter :: mld_diag_scale_ = mld_slv_delta_+1
integer, parameter :: mld_ilu_n_ = mld_slv_delta_+2 integer(psb_ipk_), parameter :: mld_ilu_n_ = mld_slv_delta_+2
integer, parameter :: mld_milu_n_ = mld_slv_delta_+3 integer(psb_ipk_), parameter :: mld_milu_n_ = mld_slv_delta_+3
integer, parameter :: mld_ilu_t_ = mld_slv_delta_+4 integer(psb_ipk_), parameter :: mld_ilu_t_ = mld_slv_delta_+4
integer, parameter :: mld_slu_ = mld_slv_delta_+5 integer(psb_ipk_), parameter :: mld_slu_ = mld_slv_delta_+5
integer, parameter :: mld_umf_ = mld_slv_delta_+6 integer(psb_ipk_), parameter :: mld_umf_ = mld_slv_delta_+6
integer, parameter :: mld_sludist_ = mld_slv_delta_+7 integer(psb_ipk_), parameter :: mld_sludist_ = mld_slv_delta_+7
integer, parameter :: mld_max_sub_solve_= mld_slv_delta_+7 integer(psb_ipk_), parameter :: mld_max_sub_solve_= mld_slv_delta_+7
integer, parameter :: mld_min_sub_solve_= mld_diag_scale_ integer(psb_ipk_), parameter :: mld_min_sub_solve_= mld_diag_scale_
! !
! Legal values for entry: mld_sub_ren_ ! Legal values for entry: mld_sub_ren_
! !
integer, parameter :: mld_renum_none_=0 integer(psb_ipk_), parameter :: mld_renum_none_=0
integer, parameter :: mld_renum_glb_=1 integer(psb_ipk_), parameter :: mld_renum_glb_=1
integer, parameter :: mld_renum_gps_=2 integer(psb_ipk_), parameter :: mld_renum_gps_=2
! For the time being we are disabling GPS renumbering. ! 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_ ! Legal values for entry: mld_ilu_scale_
! !
integer, parameter :: mld_ilu_scale_none_ = 0 integer(psb_ipk_), parameter :: mld_ilu_scale_none_ = 0
integer, parameter :: mld_ilu_scale_maxval_ = 1 integer(psb_ipk_), parameter :: mld_ilu_scale_maxval_ = 1
integer, parameter :: mld_ilu_scale_diag_ = 2 integer(psb_ipk_), parameter :: mld_ilu_scale_diag_ = 2
integer, parameter :: mld_ilu_scale_arwsum_ = 3 integer(psb_ipk_), parameter :: mld_ilu_scale_arwsum_ = 3
integer, parameter :: mld_ilu_scale_aclsum_ = 4 integer(psb_ipk_), parameter :: mld_ilu_scale_aclsum_ = 4
integer, parameter :: mld_ilu_scale_arcsum_ = 5 integer(psb_ipk_), parameter :: mld_ilu_scale_arcsum_ = 5
! For the time being enable only maxval scale ! 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_ ! Legal values for entry: mld_ml_type_
! !
integer, parameter :: mld_no_ml_ = 0 integer(psb_ipk_), parameter :: mld_no_ml_ = 0
integer, parameter :: mld_add_ml_ = 1 integer(psb_ipk_), parameter :: mld_add_ml_ = 1
integer, parameter :: mld_mult_ml_ = 2 integer(psb_ipk_), parameter :: mld_mult_ml_ = 2
integer, parameter :: mld_new_ml_prec_ = 3 integer(psb_ipk_), parameter :: mld_new_ml_prec_ = 3
integer, parameter :: mld_max_ml_type_ = mld_mult_ml_ integer(psb_ipk_), parameter :: mld_max_ml_type_ = mld_mult_ml_
! !
! Legal values for entry: mld_smoother_pos_ ! Legal values for entry: mld_smoother_pos_
! !
integer, parameter :: mld_pre_smooth_=1 integer(psb_ipk_), parameter :: mld_pre_smooth_=1
integer, parameter :: mld_post_smooth_=2 integer(psb_ipk_), parameter :: mld_post_smooth_=2
integer, parameter :: mld_twoside_smooth_=3 integer(psb_ipk_), parameter :: mld_twoside_smooth_=3
integer, parameter :: mld_max_smooth_=mld_twoside_smooth_ integer(psb_ipk_), parameter :: mld_max_smooth_=mld_twoside_smooth_
! !
! Legal values for entry: mld_aggr_kind_ ! Legal values for entry: mld_aggr_kind_
! !
integer, parameter :: mld_no_smooth_ = 0 integer(psb_ipk_), parameter :: mld_no_smooth_ = 0
integer, parameter :: mld_smooth_prol_ = 1 integer(psb_ipk_), parameter :: mld_smooth_prol_ = 1
integer, parameter :: mld_min_energy_ = 2 integer(psb_ipk_), parameter :: mld_min_energy_ = 2
integer, parameter :: mld_biz_prol_ = 3 integer(psb_ipk_), parameter :: mld_biz_prol_ = 3
! Disabling biz_prol for the time being. ! 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_ ! Legal values for entry: mld_aggr_filter_
! !
integer, parameter :: mld_no_filter_mat_=0 integer(psb_ipk_), parameter :: mld_no_filter_mat_=0
integer, parameter :: mld_filter_mat_=1 integer(psb_ipk_), parameter :: mld_filter_mat_=1
integer, parameter :: mld_max_filter_mat_=mld_no_filter_mat_ integer(psb_ipk_), parameter :: mld_max_filter_mat_=mld_no_filter_mat_
! !
! Legal values for entry: mld_aggr_alg_ ! Legal values for entry: mld_aggr_alg_
! !
integer, parameter :: mld_dec_aggr_=0 integer(psb_ipk_), parameter :: mld_dec_aggr_=0
integer, parameter :: mld_sym_dec_aggr_=1 integer(psb_ipk_), parameter :: mld_sym_dec_aggr_=1
integer, parameter :: mld_glb_aggr_=2 integer(psb_ipk_), parameter :: mld_glb_aggr_=2
integer, parameter :: mld_new_dec_aggr_=3 integer(psb_ipk_), parameter :: mld_new_dec_aggr_=3
integer, parameter :: mld_new_glb_aggr_=4 integer(psb_ipk_), parameter :: mld_new_glb_aggr_=4
integer, parameter :: mld_max_aggr_alg_=mld_dec_aggr_ integer(psb_ipk_), parameter :: mld_max_aggr_alg_=mld_dec_aggr_
! !
! Legal values for entry: mld_aggr_omega_alg_ ! Legal values for entry: mld_aggr_omega_alg_
! !
integer, parameter :: mld_eig_est_=0 integer(psb_ipk_), parameter :: mld_eig_est_=0
integer, parameter :: mld_user_choice_=999 integer(psb_ipk_), parameter :: mld_user_choice_=999
! !
! Legal values for entry: mld_aggr_eig_ ! 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_ ! Legal values for entry: mld_coarse_mat_
! !
integer, parameter :: mld_distr_mat_=0 integer(psb_ipk_), parameter :: mld_distr_mat_=0
integer, parameter :: mld_repl_mat_=1 integer(psb_ipk_), parameter :: mld_repl_mat_=1
integer, parameter :: mld_max_coarse_mat_=mld_repl_mat_ integer(psb_ipk_), parameter :: mld_max_coarse_mat_=mld_repl_mat_
! !
! Legal values for entry: mld_prec_status_ ! 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 ! Entries in rprcparm: ILU(k,t) threshold, smoothed aggregation omega
! !
integer, parameter :: mld_sub_iluthrs_ = 1 integer(psb_ipk_), parameter :: mld_sub_iluthrs_ = 1
integer, parameter :: mld_aggr_omega_val_ = 2 integer(psb_ipk_), parameter :: mld_aggr_omega_val_ = 2
integer, parameter :: mld_aggr_thresh_ = 3 integer(psb_ipk_), parameter :: mld_aggr_thresh_ = 3
integer, parameter :: mld_coarse_iluthrs_ = 4 integer(psb_ipk_), parameter :: mld_coarse_iluthrs_ = 4
integer, parameter :: mld_rfpsz_ = 8 integer(psb_ipk_), parameter :: mld_rfpsz_ = 8
! !
! Fields for sparse matrices ensembles stored in av() ! Fields for sparse matrices ensembles stored in av()
! !
integer, parameter :: mld_l_pr_=1 integer(psb_ipk_), parameter :: mld_l_pr_=1
integer, parameter :: mld_u_pr_=2 integer(psb_ipk_), parameter :: mld_u_pr_=2
integer, parameter :: mld_bp_ilu_avsz_=2 integer(psb_ipk_), parameter :: mld_bp_ilu_avsz_=2
integer, parameter :: mld_ap_nd_=3 integer(psb_ipk_), parameter :: mld_ap_nd_=3
integer, parameter :: mld_ac_=4 integer(psb_ipk_), parameter :: mld_ac_=4
integer, parameter :: mld_sm_pr_t_=5 integer(psb_ipk_), parameter :: mld_sm_pr_t_=5
integer, parameter :: mld_sm_pr_=6 integer(psb_ipk_), parameter :: mld_sm_pr_=6
integer, parameter :: mld_smth_avsz_=6 integer(psb_ipk_), parameter :: mld_smth_avsz_=6
integer, parameter :: mld_max_avsz_=mld_smth_avsz_ integer(psb_ipk_), parameter :: mld_max_avsz_=mld_smth_avsz_
! !
! Character constants used by mld_file_prec_descr ! Character constants used by mld_file_prec_descr
@ -349,7 +349,7 @@ contains
implicit none implicit none
! Arguments ! Arguments
character(len=*), intent(in) :: string character(len=*), intent(in) :: string
integer, intent(out) :: val, info integer(psb_ipk_), intent(out) :: val, info
character(len=*), parameter :: name='mld_stringval' character(len=*), parameter :: name='mld_stringval'
info = psb_success_ info = psb_success_
@ -444,7 +444,7 @@ contains
subroutine ml_parms_printout(pm,iout) subroutine ml_parms_printout(pm,iout)
implicit none implicit none
class(mld_ml_parms), intent(in) :: pm 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,*) 'Sweeps: ',pm%sweeps,pm%sweeps_pre,pm%sweeps_post
write(iout,*) 'ML : ',pm%ml_type,pm%smoother_pos write(iout,*) 'ML : ',pm%ml_type,pm%smoother_pos
@ -457,7 +457,7 @@ contains
subroutine s_ml_parms_printout(pm,iout) subroutine s_ml_parms_printout(pm,iout)
implicit none implicit none
class(mld_sml_parms), intent(in) :: pm class(mld_sml_parms), intent(in) :: pm
integer, intent(in) :: iout integer(psb_ipk_), intent(in) :: iout
call pm%mld_ml_parms%printout(iout) call pm%mld_ml_parms%printout(iout)
write(iout,*) 'REAL : ',pm%aggr_omega_val,pm%aggr_thresh write(iout,*) 'REAL : ',pm%aggr_omega_val,pm%aggr_thresh
@ -467,7 +467,7 @@ contains
subroutine d_ml_parms_printout(pm,iout) subroutine d_ml_parms_printout(pm,iout)
implicit none implicit none
class(mld_dml_parms), intent(in) :: pm class(mld_dml_parms), intent(in) :: pm
integer, intent(in) :: iout integer(psb_ipk_), intent(in) :: iout
call pm%mld_ml_parms%printout(iout) call pm%mld_ml_parms%printout(iout)
write(iout,*) 'REAL : ',pm%aggr_omega_val,pm%aggr_thresh write(iout,*) 'REAL : ',pm%aggr_omega_val,pm%aggr_thresh
@ -484,8 +484,8 @@ contains
! Arguments ! Arguments
class(mld_ml_parms), intent(in) :: pm class(mld_ml_parms), intent(in) :: pm
integer, intent(in) :: iout integer(psb_ipk_), intent(in) :: iout
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = psb_success_ info = psb_success_
if (pm%ml_type>mld_no_ml_) then if (pm%ml_type>mld_no_ml_) then
@ -540,8 +540,8 @@ contains
! Arguments ! Arguments
class(mld_ml_parms), intent(in) :: pm class(mld_ml_parms), intent(in) :: pm
integer, intent(in) :: iout integer(psb_ipk_), intent(in) :: iout
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = psb_success_ info = psb_success_
write(iout,*) ' Coarsest matrix: ',& write(iout,*) ' Coarsest matrix: ',&
@ -563,8 +563,8 @@ contains
! Arguments ! Arguments
class(mld_ml_parms), intent(in) :: pm class(mld_ml_parms), intent(in) :: pm
integer, intent(in) :: iout integer(psb_ipk_), intent(in) :: iout
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
logical :: coarse_ logical :: coarse_
@ -589,8 +589,8 @@ contains
! Arguments ! Arguments
class(mld_sml_parms), intent(in) :: pm class(mld_sml_parms), intent(in) :: pm
integer, intent(in) :: iout integer(psb_ipk_), intent(in) :: iout
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
info = psb_success_ info = psb_success_
@ -611,8 +611,8 @@ contains
! Arguments ! Arguments
class(mld_dml_parms), intent(in) :: pm class(mld_dml_parms), intent(in) :: pm
integer, intent(in) :: iout integer(psb_ipk_), intent(in) :: iout
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
info = psb_success_ info = psb_success_
@ -634,7 +634,7 @@ contains
function is_legal_base_prec(ip) function is_legal_base_prec(ip)
implicit none implicit none
integer, intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_base_prec logical :: is_legal_base_prec
is_legal_base_prec = ((ip>=mld_noprec_).and.(ip<=mld_max_prec_)) is_legal_base_prec = ((ip>=mld_noprec_).and.(ip<=mld_max_prec_))
@ -642,7 +642,7 @@ contains
end function is_legal_base_prec end function is_legal_base_prec
function is_legal_n_ovr(ip) function is_legal_n_ovr(ip)
implicit none implicit none
integer, intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_n_ovr logical :: is_legal_n_ovr
is_legal_n_ovr = (ip >= 0) is_legal_n_ovr = (ip >= 0)
@ -650,21 +650,21 @@ contains
end function is_legal_n_ovr end function is_legal_n_ovr
function is_legal_renum(ip) function is_legal_renum(ip)
implicit none implicit none
integer, intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_renum logical :: is_legal_renum
is_legal_renum = ((ip >= 0).and.(ip <= mld_max_renum_)) is_legal_renum = ((ip >= 0).and.(ip <= mld_max_renum_))
return return
end function is_legal_renum end function is_legal_renum
function is_legal_ilu_scale(ip) function is_legal_ilu_scale(ip)
implicit none implicit none
integer, intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ilu_scale logical :: is_legal_ilu_scale
is_legal_ilu_scale = ((ip >= mld_ilu_scale_none_).and.(ip <= mld_max_ilu_scale_)) is_legal_ilu_scale = ((ip >= mld_ilu_scale_none_).and.(ip <= mld_max_ilu_scale_))
return return
end function is_legal_ilu_scale end function is_legal_ilu_scale
function is_legal_jac_sweeps(ip) function is_legal_jac_sweeps(ip)
implicit none implicit none
integer, intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_jac_sweeps logical :: is_legal_jac_sweeps
is_legal_jac_sweeps = (ip >= 1) is_legal_jac_sweeps = (ip >= 1)
@ -672,21 +672,21 @@ contains
end function is_legal_jac_sweeps end function is_legal_jac_sweeps
function is_legal_prolong(ip) function is_legal_prolong(ip)
implicit none implicit none
integer, intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_prolong logical :: is_legal_prolong
is_legal_prolong = ((ip>=psb_none_).and.(ip<=psb_square_root_)) is_legal_prolong = ((ip>=psb_none_).and.(ip<=psb_square_root_))
return return
end function is_legal_prolong end function is_legal_prolong
function is_legal_restrict(ip) function is_legal_restrict(ip)
implicit none implicit none
integer, intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_restrict logical :: is_legal_restrict
is_legal_restrict = ((ip == psb_nohalo_).or.(ip==psb_halo_)) is_legal_restrict = ((ip == psb_nohalo_).or.(ip==psb_halo_))
return return
end function is_legal_restrict end function is_legal_restrict
function is_legal_ml_type(ip) function is_legal_ml_type(ip)
implicit none implicit none
integer, intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_type logical :: is_legal_ml_type
is_legal_ml_type = ((ip>=mld_no_ml_).and.(ip<=mld_max_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 end function is_legal_ml_type
function is_legal_ml_aggr_alg(ip) function is_legal_ml_aggr_alg(ip)
implicit none implicit none
integer, intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_aggr_alg logical :: is_legal_ml_aggr_alg
is_legal_ml_aggr_alg = ((ip>=mld_dec_aggr_).and.(ip<=mld_max_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 end function is_legal_ml_aggr_alg
function is_legal_ml_aggr_omega_alg(ip) function is_legal_ml_aggr_omega_alg(ip)
implicit none implicit none
integer, intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_aggr_omega_alg logical :: is_legal_ml_aggr_omega_alg
is_legal_ml_aggr_omega_alg = ((ip == mld_eig_est_).or.(ip==mld_user_choice_)) 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 end function is_legal_ml_aggr_omega_alg
function is_legal_ml_aggr_eig(ip) function is_legal_ml_aggr_eig(ip)
implicit none implicit none
integer, intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_aggr_eig logical :: is_legal_ml_aggr_eig
is_legal_ml_aggr_eig = (ip == mld_max_norm_) is_legal_ml_aggr_eig = (ip == mld_max_norm_)
@ -718,7 +718,7 @@ contains
end function is_legal_ml_aggr_eig end function is_legal_ml_aggr_eig
function is_legal_ml_smooth_pos(ip) function is_legal_ml_smooth_pos(ip)
implicit none implicit none
integer, intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_smooth_pos logical :: is_legal_ml_smooth_pos
is_legal_ml_smooth_pos = ((ip>=mld_pre_smooth_).and.(ip<=mld_max_smooth_)) 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 end function is_legal_ml_smooth_pos
function is_legal_ml_aggr_kind(ip) function is_legal_ml_aggr_kind(ip)
implicit none implicit none
integer, intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_aggr_kind logical :: is_legal_ml_aggr_kind
is_legal_ml_aggr_kind = ((ip>=0).and.(ip<=mld_max_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 end function is_legal_ml_aggr_kind
function is_legal_ml_coarse_mat(ip) function is_legal_ml_coarse_mat(ip)
implicit none implicit none
integer, intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_coarse_mat logical :: is_legal_ml_coarse_mat
is_legal_ml_coarse_mat = ((ip>=0).and.(ip<=mld_max_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 end function is_legal_ml_coarse_mat
function is_legal_aggr_filter(ip) function is_legal_aggr_filter(ip)
implicit none implicit none
integer, intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_aggr_filter logical :: is_legal_aggr_filter
is_legal_aggr_filter = ((ip>=0).and.(ip<=mld_max_filter_mat_)) is_legal_aggr_filter = ((ip>=0).and.(ip<=mld_max_filter_mat_))
@ -750,7 +750,7 @@ contains
end function is_legal_aggr_filter end function is_legal_aggr_filter
function is_distr_ml_coarse_mat(ip) function is_distr_ml_coarse_mat(ip)
implicit none implicit none
integer, intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_distr_ml_coarse_mat logical :: is_distr_ml_coarse_mat
is_distr_ml_coarse_mat = (ip == mld_distr_mat_) is_distr_ml_coarse_mat = (ip == mld_distr_mat_)
@ -758,7 +758,7 @@ contains
end function is_distr_ml_coarse_mat end function is_distr_ml_coarse_mat
function is_legal_ml_fact(ip) function is_legal_ml_fact(ip)
implicit none implicit none
integer, intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_fact logical :: is_legal_ml_fact
! Here the minimum is really 1, mld_fact_none_ is not acceptable. ! Here the minimum is really 1, mld_fact_none_ is not acceptable.
is_legal_ml_fact = ((ip>=mld_min_sub_solve_)& is_legal_ml_fact = ((ip>=mld_min_sub_solve_)&
@ -767,7 +767,7 @@ contains
end function is_legal_ml_fact end function is_legal_ml_fact
function is_legal_ilu_fact(ip) function is_legal_ilu_fact(ip)
implicit none implicit none
integer, intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ilu_fact logical :: is_legal_ilu_fact
is_legal_ilu_fact = ((ip==mld_ilu_n_).or.& is_legal_ilu_fact = ((ip==mld_ilu_n_).or.&
@ -776,7 +776,7 @@ contains
end function is_legal_ilu_fact end function is_legal_ilu_fact
function is_legal_ml_lev(ip) function is_legal_ml_lev(ip)
implicit none implicit none
integer, intent(in) :: ip integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ml_lev logical :: is_legal_ml_lev
is_legal_ml_lev = (ip >= 0) is_legal_ml_lev = (ip >= 0)
@ -833,12 +833,13 @@ contains
subroutine mld_icheck_def(ip,name,id,is_legal) subroutine mld_icheck_def(ip,name,id,is_legal)
implicit none implicit none
integer, intent(inout) :: ip integer(psb_ipk_), intent(inout) :: ip
integer, intent(in) :: id integer(psb_ipk_), intent(in) :: id
character(len=*), intent(in) :: name character(len=*), intent(in) :: name
interface interface
function is_legal(i) function is_legal(i)
integer, intent(in) :: i import :: psb_ipk_
integer(psb_ipk_), intent(in) :: i
logical :: is_legal logical :: is_legal
end function is_legal end function is_legal
end interface end interface
@ -897,7 +898,7 @@ contains
function pr_to_str(iprec) function pr_to_str(iprec)
implicit none implicit none
integer, intent(in) :: iprec integer(psb_ipk_), intent(in) :: iprec
character(len=10) :: pr_to_str character(len=10) :: pr_to_str
select case(iprec) select case(iprec)
@ -916,9 +917,9 @@ contains
subroutine mld_ml_bcast(ictxt,dat,root) subroutine mld_ml_bcast(ictxt,dat,root)
implicit none implicit none
integer, intent(in) :: ictxt integer(psb_mpik_), intent(in) :: ictxt
type(mld_ml_parms), intent(inout) :: dat 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,root)
call psb_bcast(ictxt,dat%sweeps_pre,root) call psb_bcast(ictxt,dat%sweeps_pre,root)
@ -938,9 +939,9 @@ contains
subroutine mld_sml_bcast(ictxt,dat,root) subroutine mld_sml_bcast(ictxt,dat,root)
implicit none implicit none
integer, intent(in) :: ictxt integer(psb_mpik_), intent(in) :: ictxt
type(mld_sml_parms), intent(inout) :: dat 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%mld_ml_parms,root)
call psb_bcast(ictxt,dat%aggr_omega_val,root) call psb_bcast(ictxt,dat%aggr_omega_val,root)
@ -949,9 +950,9 @@ contains
subroutine mld_dml_bcast(ictxt,dat,root) subroutine mld_dml_bcast(ictxt,dat,root)
implicit none implicit none
integer, intent(in) :: ictxt integer(psb_mpik_), intent(in) :: ictxt
type(mld_dml_parms), intent(inout) :: dat 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%mld_ml_parms,root)
call psb_bcast(ictxt,dat%aggr_omega_val,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 !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ 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 !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -52,8 +52,8 @@ module mld_c_as_smoother
! class(mld_c_base_solver_type), allocatable :: sv ! class(mld_c_base_solver_type), allocatable :: sv
! !
type(psb_cspmat_type) :: nd type(psb_cspmat_type) :: nd
type(psb_desc_type) :: desc_data type(psb_desc_type) :: desc_data
integer :: novr, restr, prol, nd_nnz_tot integer(psb_ipk_) :: novr, restr, prol, nd_nnz_tot
contains contains
procedure, pass(sm) :: check => mld_c_as_smoother_check procedure, pass(sm) :: check => mld_c_as_smoother_check
procedure, pass(sm) :: dump => mld_c_as_smoother_dmp procedure, pass(sm) :: dump => mld_c_as_smoother_dmp
@ -83,41 +83,44 @@ module mld_c_as_smoother
interface interface
subroutine mld_c_as_smoother_check(sm,info) subroutine mld_c_as_smoother_check(sm,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & 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 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 subroutine mld_c_as_smoother_check
end interface end interface
interface interface
subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_c_as_smoother_type), intent(inout) :: sm class(mld_c_as_smoother_type), intent(inout) :: sm
type(psb_c_vect_type),intent(inout) :: x type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
complex(psb_spk_),target, intent(inout) :: work(:) complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_as_smoother_apply_vect end subroutine mld_c_as_smoother_apply_vect
end interface end interface
interface interface
subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_c_as_smoother_type), intent(in) :: sm class(mld_c_as_smoother_type), intent(in) :: sm
complex(psb_spk_),intent(inout) :: x(:) complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:) complex(psb_spk_),intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
complex(psb_spk_),target, intent(inout) :: work(:) 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 subroutine mld_c_as_smoother_apply
end interface 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) 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, & 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_spk_, mld_c_as_smoother_type, psb_long_int_k_, &
& psb_desc_type, psb_c_base_sparse_mat & psb_desc_type, psb_c_base_sparse_mat, psb_ipk_
type(psb_cspmat_type), intent(in), target :: a 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_as_smoother_type), intent(inout) :: sm class(mld_c_as_smoother_type), intent(inout) :: sm
character, intent(in) :: upd 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_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
end subroutine mld_c_as_smoother_bld end subroutine mld_c_as_smoother_bld
@ -139,52 +143,59 @@ module mld_c_as_smoother
interface interface
subroutine mld_c_as_smoother_seti(sm,what,val,info) subroutine mld_c_as_smoother_seti(sm,what,val,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & 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 class(mld_c_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_as_smoother_seti end subroutine mld_c_as_smoother_seti
end interface end interface
interface interface
subroutine mld_c_as_smoother_setc(sm,what,val,info) subroutine mld_c_as_smoother_setc(sm,what,val,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & 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 class(mld_c_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_as_smoother_setc end subroutine mld_c_as_smoother_setc
end interface end interface
interface interface
subroutine mld_c_as_smoother_setr(sm,what,val,info) subroutine mld_c_as_smoother_setr(sm,what,val,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & 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 class(mld_c_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_as_smoother_setr end subroutine mld_c_as_smoother_setr
end interface end interface
interface interface
subroutine mld_c_as_smoother_free(sm,info) subroutine mld_c_as_smoother_free(sm,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & 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 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 subroutine mld_c_as_smoother_free
end interface end interface
interface interface
subroutine mld_c_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) 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, & 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 class(mld_c_as_smoother_type), intent(in) :: sm
integer, intent(in) :: ictxt,level integer(psb_mpik_), intent(in) :: ictxt
integer, intent(out) :: info integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver
end subroutine mld_c_as_smoother_dmp end subroutine mld_c_as_smoother_dmp
@ -197,7 +208,7 @@ contains
! Arguments ! Arguments
class(mld_c_as_smoother_type), intent(in) :: sm class(mld_c_as_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = psb_sizeof_int val = psb_sizeof_int
if (allocated(sm%sv)) val = val + sm%sv%sizeof() if (allocated(sm%sv)) val = val + sm%sv%sizeof()
@ -210,7 +221,7 @@ contains
implicit none implicit none
class(mld_c_as_smoother_type), intent(in) :: sm class(mld_c_as_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sm%sv)) & if (allocated(sm%sv)) &
& val = sm%sv%get_nzeros() & val = sm%sv%get_nzeros()
@ -247,15 +258,14 @@ contains
! Arguments ! Arguments
class(mld_c_as_smoother_type), intent(in) :: sm class(mld_c_as_smoother_type), intent(in) :: sm
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_c_as_smoother_descr' character(len=20), parameter :: name='mld_c_as_smoother_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
logical :: coarse_ logical :: coarse_
call psb_erractionsave(err_act) 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 interface
subroutine mld_c_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_c_base_smoother_type), intent(in) :: sm class(mld_c_base_smoother_type), intent(in) :: sm
complex(psb_spk_),intent(inout) :: x(:) complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:) complex(psb_spk_),intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
complex(psb_spk_),target, intent(inout) :: work(:) 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 subroutine mld_c_base_smoother_apply
end interface 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,& subroutine mld_c_base_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
& trans,sweeps,work,info) & trans,sweeps,work,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_c_base_smoother_type), intent(inout) :: sm class(mld_c_base_smoother_type), intent(inout) :: sm
type(psb_c_vect_type),intent(inout) :: x type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
complex(psb_spk_),target, intent(inout) :: work(:) complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_smoother_apply_vect end subroutine mld_c_base_smoother_apply_vect
end interface end interface
interface interface
subroutine mld_c_base_smoother_check(sm,info) subroutine mld_c_base_smoother_check(sm,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & 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 ! Arguments
class(mld_c_base_smoother_type), intent(inout) :: sm 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 subroutine mld_c_base_smoother_check
end interface end interface
interface interface
subroutine mld_c_base_smoother_seti(sm,what,val,info) subroutine mld_c_base_smoother_seti(sm,what,val,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & 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 ! Arguments
class(mld_c_base_smoother_type), intent(inout) :: sm class(mld_c_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_smoother_seti end subroutine mld_c_base_smoother_seti
end interface end interface
interface interface
subroutine mld_c_base_smoother_setc(sm,what,val,info) subroutine mld_c_base_smoother_setc(sm,what,val,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & 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 class(mld_c_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_smoother_setc end subroutine mld_c_base_smoother_setc
end interface end interface
interface interface
subroutine mld_c_base_smoother_setr(sm,what,val,info) subroutine mld_c_base_smoother_setr(sm,what,val,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & 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 ! Arguments
class(mld_c_base_smoother_type), intent(inout) :: sm class(mld_c_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_smoother_setr end subroutine mld_c_base_smoother_setr
end interface end interface
interface interface
subroutine mld_c_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) 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, & 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 ! Arguments
type(psb_cspmat_type), intent(in), target :: a 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_smoother_type), intent(inout) :: sm class(mld_c_base_smoother_type), intent(inout) :: sm
character, intent(in) :: upd 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_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
end subroutine mld_c_base_smoother_bld end subroutine mld_c_base_smoother_bld
@ -211,32 +218,36 @@ module mld_c_base_smoother_mod
interface interface
subroutine mld_c_base_smoother_free(sm,info) subroutine mld_c_base_smoother_free(sm,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & 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 ! Arguments
class(mld_c_base_smoother_type), intent(inout) :: sm 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 subroutine mld_c_base_smoother_free
end interface end interface
interface interface
subroutine mld_c_base_smoother_descr(sm,info,iout,coarse) subroutine mld_c_base_smoother_descr(sm,info,iout,coarse)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & 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 ! Arguments
class(mld_c_base_smoother_type), intent(in) :: sm class(mld_c_base_smoother_type), intent(in) :: sm
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
end subroutine mld_c_base_smoother_descr end subroutine mld_c_base_smoother_descr
end interface end interface
interface interface
subroutine mld_c_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) 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, & 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 class(mld_c_base_smoother_type), intent(in) :: sm
integer, intent(in) :: ictxt,level integer(psb_mpik_), intent(in) :: ictxt
integer, intent(out) :: info integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver
end subroutine mld_c_base_smoother_dmp end subroutine mld_c_base_smoother_dmp
@ -252,7 +263,7 @@ contains
implicit none implicit none
class(mld_c_base_smoother_type), intent(in) :: sm class(mld_c_base_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sm%sv)) & if (allocated(sm%sv)) &
& val = sm%sv%get_nzeros() & val = sm%sv%get_nzeros()
@ -263,7 +274,7 @@ contains
! Arguments ! Arguments
class(mld_c_base_smoother_type), intent(in) :: sm class(mld_c_base_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sm%sv)) then if (allocated(sm%sv)) then

95
mlprec/mld_c_base_solver_mod.f90
Unescape Escape View File

@ -108,15 +108,17 @@ module mld_c_base_solver_mod
interface interface
subroutine mld_c_base_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_c_base_solver_type), intent(in) :: sv class(mld_c_base_solver_type), intent(in) :: sv
complex(psb_spk_),intent(inout) :: x(:) complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:) complex(psb_spk_),intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta 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(:) 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 subroutine mld_c_base_solver_apply
end interface end interface
@ -124,32 +126,33 @@ module mld_c_base_solver_mod
interface interface
subroutine mld_c_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_c_base_solver_type), intent(inout) :: sv class(mld_c_base_solver_type), intent(inout) :: sv
type(psb_c_vect_type),intent(inout) :: x type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta 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(:) complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_solver_apply_vect end subroutine mld_c_base_solver_apply_vect
end interface end interface
interface interface
subroutine mld_c_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) 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, & 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 Implicit None
! Arguments ! Arguments
type(psb_cspmat_type), intent(in), target :: a 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 class(mld_c_base_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type), intent(in), target, optional :: b type(psb_cspmat_type), intent(in), target, optional :: b
class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
@ -159,84 +162,85 @@ module mld_c_base_solver_mod
interface interface
subroutine mld_c_base_solver_check(sv,info) subroutine mld_c_base_solver_check(sv,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv 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 subroutine mld_c_base_solver_check
end interface end interface
interface interface
subroutine mld_c_base_solver_seti(sv,what,val,info) subroutine mld_c_base_solver_seti(sv,what,val,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv class(mld_c_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_solver_seti end subroutine mld_c_base_solver_seti
end interface end interface
interface interface
subroutine mld_c_base_solver_setc(sv,what,val,info) subroutine mld_c_base_solver_setc(sv,what,val,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv class(mld_c_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_solver_setc end subroutine mld_c_base_solver_setc
end interface end interface
interface interface
subroutine mld_c_base_solver_setr(sv,what,val,info) subroutine mld_c_base_solver_setr(sv,what,val,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv class(mld_c_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_solver_setr end subroutine mld_c_base_solver_setr
end interface end interface
interface interface
subroutine mld_c_base_solver_free(sv,info) subroutine mld_c_base_solver_free(sv,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv 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 subroutine mld_c_base_solver_free
end interface end interface
interface interface
subroutine mld_c_base_solver_descr(sv,info,iout,coarse) subroutine mld_c_base_solver_descr(sv,info,iout,coarse)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_c_base_solver_type), intent(in) :: sv class(mld_c_base_solver_type), intent(in) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
end subroutine mld_c_base_solver_descr end subroutine mld_c_base_solver_descr
end interface end interface
@ -244,12 +248,13 @@ module mld_c_base_solver_mod
interface interface
subroutine mld_c_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) 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, & 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 implicit none
class(mld_c_base_solver_type), intent(in) :: sv class(mld_c_base_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level integer(psb_mpik_), intent(in) :: ictxt
integer, intent(out) :: info integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver
end subroutine mld_c_base_solver_dmp end subroutine mld_c_base_solver_dmp
@ -269,7 +274,7 @@ contains
! Arguments ! Arguments
class(mld_c_base_solver_type), intent(in) :: sv class(mld_c_base_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
return return
@ -279,7 +284,7 @@ contains
implicit none implicit none
class(mld_c_base_solver_type), intent(in) :: sv class(mld_c_base_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
end function c_base_solver_get_nzeros 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 !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ 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 !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -73,42 +73,45 @@ module mld_c_diag_solver
interface interface
subroutine mld_c_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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_, &
type(psb_desc_type), intent(in) :: desc_data & mld_c_diag_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_diag_solver_type), intent(inout) :: sv class(mld_c_diag_solver_type), intent(inout) :: sv
type(psb_c_vect_type), intent(inout) :: x type(psb_c_vect_type), intent(inout) :: x
type(psb_c_vect_type), intent(inout) :: y type(psb_c_vect_type), intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta 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(:) complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_diag_solver_apply_vect end subroutine mld_c_diag_solver_apply_vect
end interface end interface
interface interface
subroutine mld_c_diag_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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_, &
type(psb_desc_type), intent(in) :: desc_data & mld_c_diag_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_diag_solver_type), intent(in) :: sv class(mld_c_diag_solver_type), intent(in) :: sv
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
complex(psb_spk_), intent(inout) :: y(:) complex(psb_spk_), intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta 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(:) 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 subroutine mld_c_diag_solver_apply
end interface end interface
interface interface
subroutine mld_c_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) 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, & 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_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 class(mld_c_diag_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type), intent(in), target, optional :: b type(psb_cspmat_type), intent(in), target, optional :: b
class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
@ -125,10 +128,10 @@ contains
! Arguments ! Arguments
class(mld_c_diag_solver_type), intent(inout) :: sv class(mld_c_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act Integer(Psb_ipk_) :: err_act
character(len=20) :: name='c_diag_solver_seti' character(len=20) :: name='c_diag_solver_seti'
info = psb_success_ info = psb_success_
@ -144,10 +147,10 @@ contains
! Arguments ! Arguments
class(mld_c_diag_solver_type), intent(inout) :: sv class(mld_c_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act, ival Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='c_diag_solver_setc' character(len=20) :: name='c_diag_solver_setc'
info = psb_success_ info = psb_success_
@ -161,10 +164,10 @@ contains
! Arguments ! Arguments
class(mld_c_diag_solver_type), intent(inout) :: sv class(mld_c_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act Integer(Psb_ipk_) :: err_act
character(len=20) :: name='c_diag_solver_setr' character(len=20) :: name='c_diag_solver_setr'
info = psb_success_ info = psb_success_
@ -179,9 +182,9 @@ contains
! Arguments ! Arguments
class(mld_c_diag_solver_type), intent(inout) :: sv class(mld_c_diag_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='c_diag_solver_free' character(len=20) :: name='c_diag_solver_free'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -215,15 +218,14 @@ contains
! Arguments ! Arguments
class(mld_c_diag_solver_type), intent(in) :: sv class(mld_c_diag_solver_type), intent(in) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_c_diag_solver_descr' character(len=20), parameter :: name='mld_c_diag_solver_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
info = psb_success_ info = psb_success_
if (present(iout)) then if (present(iout)) then
@ -243,7 +245,7 @@ contains
! Arguments ! Arguments
class(mld_c_diag_solver_type), intent(in) :: sv class(mld_c_diag_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sv%dv)) val = val + sv%dv%sizeof() if (allocated(sv%dv)) val = val + sv%dv%sizeof()
@ -256,7 +258,7 @@ contains
! Arguments ! Arguments
class(mld_c_diag_solver_type), intent(in) :: sv class(mld_c_diag_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sv%dv)) val = val + sv%dv%get_nrows() 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 !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ 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 !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -68,22 +68,24 @@ module mld_c_id_solver
interface interface
subroutine mld_c_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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_, &
type(psb_desc_type), intent(in) :: desc_data & mld_c_id_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_id_solver_type), intent(inout) :: sv class(mld_c_id_solver_type), intent(inout) :: sv
type(psb_c_vect_type),intent(inout) :: x type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta 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(:) complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_id_solver_apply_vect end subroutine mld_c_id_solver_apply_vect
end interface end interface
interface interface
subroutine mld_c_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_c_id_solver_type), intent(in) :: sv class(mld_c_id_solver_type), intent(in) :: sv
complex(psb_spk_),intent(inout) :: x(:) complex(psb_spk_),intent(inout) :: x(:)
@ -91,7 +93,7 @@ module mld_c_id_solver
complex(psb_spk_),intent(in) :: alpha,beta 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(:) 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 subroutine mld_c_id_solver_apply
end interface end interface
@ -104,17 +106,17 @@ contains
! Arguments ! Arguments
type(psb_cspmat_type), intent(in), target :: a 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 class(mld_c_id_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type), intent(in), target, optional :: b type(psb_cspmat_type), intent(in), target, optional :: b
class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
! Local variables ! 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(:) 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 character(len=20) :: name='c_id_solver_bld', ch_err
info=psb_success_ info=psb_success_
@ -129,11 +131,11 @@ contains
! Arguments ! Arguments
class(mld_c_id_solver_type), intent(inout) :: sv class(mld_c_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='c_id_solver_seti' character(len=20) :: name='c_id_solver_seti'
info = psb_success_ info = psb_success_
@ -147,11 +149,11 @@ contains
! Arguments ! Arguments
class(mld_c_id_solver_type), intent(inout) :: sv class(mld_c_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act, ival integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='c_id_solver_setc' character(len=20) :: name='c_id_solver_setc'
info = psb_success_ info = psb_success_
@ -164,11 +166,11 @@ contains
! Arguments ! Arguments
class(mld_c_id_solver_type), intent(inout) :: sv class(mld_c_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='c_id_solver_setr' character(len=20) :: name='c_id_solver_setr'
info = psb_success_ info = psb_success_
@ -182,9 +184,9 @@ contains
! Arguments ! Arguments
class(mld_c_id_solver_type), intent(inout) :: sv class(mld_c_id_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='c_id_solver_free' character(len=20) :: name='c_id_solver_free'
info = psb_success_ info = psb_success_
@ -197,15 +199,14 @@ contains
! Arguments ! Arguments
class(mld_c_id_solver_type), intent(in) :: sv class(mld_c_id_solver_type), intent(in) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_c_id_solver_descr' character(len=20), parameter :: name='mld_c_id_solver_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
info = psb_success_ info = psb_success_
if (present(iout)) then 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 !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ 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 !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -49,11 +49,11 @@ module mld_c_ilu_solver
use mld_c_ilu_fact_mod use mld_c_ilu_fact_mod
type, extends(mld_c_base_solver_type) :: mld_c_ilu_solver_type 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(:) complex(psb_spk_), allocatable :: d(:)
type(psb_c_vect_type) :: dv type(psb_c_vect_type) :: dv
integer :: fact_type, fill_in integer(psb_ipk_) :: fact_type, fill_in
real(psb_spk_) :: thresh real(psb_spk_) :: thresh
contains contains
procedure, pass(sv) :: dump => mld_c_ilu_solver_dmp procedure, pass(sv) :: dump => mld_c_ilu_solver_dmp
procedure, pass(sv) :: build => mld_c_ilu_solver_bld procedure, pass(sv) :: build => mld_c_ilu_solver_bld
@ -90,42 +90,45 @@ module mld_c_ilu_solver
interface interface
subroutine mld_c_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) 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_, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_c_ilu_solver_type), intent(inout) :: sv class(mld_c_ilu_solver_type), intent(inout) :: sv
type(psb_c_vect_type),intent(inout) :: x type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta 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(:) complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_ilu_solver_apply_vect end subroutine mld_c_ilu_solver_apply_vect
end interface end interface
interface interface
subroutine mld_c_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) 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_, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_c_ilu_solver_type), intent(in) :: sv class(mld_c_ilu_solver_type), intent(in) :: sv
complex(psb_spk_),intent(inout) :: x(:) complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:) complex(psb_spk_),intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta 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(:) 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 subroutine mld_c_ilu_solver_apply
end interface end interface
interface interface
subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) 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_, & 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_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 class(mld_c_ilu_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type), intent(in), target, optional :: b type(psb_cspmat_type), intent(in), target, optional :: b
class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
@ -135,12 +138,15 @@ module mld_c_ilu_solver
interface interface
subroutine mld_c_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) 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_, & 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 class(mld_c_ilu_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level integer(psb_mpik_), intent(in) :: ictxt
integer, intent(out) :: info integer(psb_ipk_), intent(in) :: level
character(len=*), intent(in), optional :: prefix, head integer(psb_ipk_), intent(out) :: info
logical, optional, intent(in) :: solver character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
end subroutine mld_c_ilu_solver_dmp end subroutine mld_c_ilu_solver_dmp
end interface end interface
@ -167,8 +173,8 @@ contains
! Arguments ! Arguments
class(mld_c_ilu_solver_type), intent(inout) :: sv class(mld_c_ilu_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='c_ilu_solver_check' character(len=20) :: name='c_ilu_solver_check'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -180,7 +186,7 @@ contains
select case(sv%fact_type) select case(sv%fact_type)
case(mld_ilu_n_,mld_milu_n_) case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(sv%fill_in,& call mld_check_def(sv%fill_in,&
& 'Level',0,is_legal_ml_lev) & 'Level',izero,is_legal_ml_lev)
case(mld_ilu_t_) case(mld_ilu_t_)
call mld_check_def(sv%thresh,& call mld_check_def(sv%thresh,&
& 'Eps',szero,is_legal_s_fact_thrs) & 'Eps',szero,is_legal_s_fact_thrs)
@ -207,10 +213,10 @@ contains
! Arguments ! Arguments
class(mld_c_ilu_solver_type), intent(inout) :: sv class(mld_c_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='c_ilu_solver_seti' character(len=20) :: name='c_ilu_solver_seti'
info = psb_success_ info = psb_success_
@ -244,10 +250,10 @@ contains
! Arguments ! Arguments
class(mld_c_ilu_solver_type), intent(inout) :: sv class(mld_c_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act, ival integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='c_ilu_solver_setc' character(len=20) :: name='c_ilu_solver_setc'
info = psb_success_ info = psb_success_
@ -280,10 +286,10 @@ contains
! Arguments ! Arguments
class(mld_c_ilu_solver_type), intent(inout) :: sv class(mld_c_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='c_ilu_solver_setr' character(len=20) :: name='c_ilu_solver_setr'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -316,8 +322,8 @@ contains
! Arguments ! Arguments
class(mld_c_ilu_solver_type), intent(inout) :: sv class(mld_c_ilu_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='c_ilu_solver_free' character(len=20) :: name='c_ilu_solver_free'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -353,15 +359,14 @@ contains
! Arguments ! Arguments
class(mld_c_ilu_solver_type), intent(in) :: sv class(mld_c_ilu_solver_type), intent(in) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_c_ilu_solver_descr' character(len=20), parameter :: name='mld_c_ilu_solver_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -399,7 +404,7 @@ contains
! Arguments ! Arguments
class(mld_c_ilu_solver_type), intent(in) :: sv class(mld_c_ilu_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
val = val + sv%dv%get_nrows() val = val + sv%dv%get_nrows()
@ -415,7 +420,7 @@ contains
! Arguments ! Arguments
class(mld_c_ilu_solver_type), intent(in) :: sv class(mld_c_ilu_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 2*psb_sizeof_int + (2*psb_sizeof_sp) val = 2*psb_sizeof_int + (2*psb_sizeof_sp)
val = val + sv%dv%sizeof() 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 interface mld_mlprec_bld
subroutine mld_cmlprec_bld(a,desc_a,prec,info, amold, vmold) subroutine mld_cmlprec_bld(a,desc_a,prec,info, amold, vmold)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, & 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 use mld_c_prec_type, only : mld_cprec_type
implicit none implicit none
type(psb_cspmat_type), intent(in), target :: a 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 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_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
!!$ character, intent(in),optional :: upd !!$ character, intent(in),optional :: upd
@ -66,78 +66,84 @@ module mld_c_inner_mod
interface mld_mlprec_aply interface mld_mlprec_aply
subroutine mld_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) 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 use mld_c_prec_type, only : mld_cprec_type
type(psb_desc_type),intent(in) :: desc_data implicit none
type(mld_cprec_type), intent(in) :: p 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(in) :: alpha,beta
complex(psb_spk_),intent(inout) :: x(:) complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:) complex(psb_spk_),intent(inout) :: y(:)
character,intent(in) :: trans character,intent(in) :: trans
complex(psb_spk_),target :: work(:) complex(psb_spk_),target :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_cmlprec_aply end subroutine mld_cmlprec_aply
subroutine mld_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) 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, & 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 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 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) :: x
type(psb_c_vect_type),intent(inout) :: y type(psb_c_vect_type),intent(inout) :: y
character,intent(in) :: trans character,intent(in) :: trans
complex(psb_spk_),target :: work(:) complex(psb_spk_),target :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_cmlprec_aply_vect end subroutine mld_cmlprec_aply_vect
end interface mld_mlprec_aply end interface mld_mlprec_aply
interface mld_coarse_bld interface mld_coarse_bld
subroutine mld_ccoarse_bld(a,desc_a,p,info) 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 use mld_c_prec_type, only : mld_c_onelev_type
type(psb_cspmat_type), intent(in), target :: a implicit none
type(psb_desc_type), intent(in), target :: desc_a 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 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 subroutine mld_ccoarse_bld
end interface mld_coarse_bld end interface mld_coarse_bld
interface mld_aggrmap_bld interface mld_aggrmap_bld
subroutine mld_caggrmap_bld(aggr_type,theta,a,desc_a,ilaggr,nlaggr,info) 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_ use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
integer, intent(in) :: aggr_type implicit none
real(psb_spk_), intent(in) :: theta integer(psb_ipk_), intent(in) :: aggr_type
real(psb_spk_), intent(in) :: theta
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:) integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_caggrmap_bld end subroutine mld_caggrmap_bld
end interface mld_aggrmap_bld end interface mld_aggrmap_bld
interface mld_dec_map_bld interface mld_dec_map_bld
subroutine mld_c_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) 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_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_), intent(in) :: theta real(psb_spk_), intent(in) :: theta
integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:) integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_dec_map_bld end subroutine mld_c_dec_map_bld
end interface mld_dec_map_bld end interface mld_dec_map_bld
interface mld_aggrmat_asb interface mld_aggrmat_asb
subroutine mld_caggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info) 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 use mld_c_prec_type, only : mld_c_onelev_type
implicit none
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(inout) :: ilaggr(:), nlaggr(:) integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_c_onelev_type), intent(inout), target :: p 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 subroutine mld_caggrmat_asb
end interface mld_aggrmat_asb end interface mld_aggrmat_asb
@ -145,14 +151,15 @@ module mld_c_inner_mod
abstract interface abstract interface
subroutine mld_caggrmat_var_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) 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 use mld_c_prec_type, only : mld_c_onelev_type, mld_sml_parms
implicit none
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(inout) :: ilaggr(:), nlaggr(:) integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_sml_parms), intent(inout) :: parms type(mld_sml_parms), intent(inout) :: parms
type(psb_cspmat_type), intent(out) :: ac,op_prol,op_restr 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 subroutine mld_caggrmat_var_asb
end interface end interface

81
mlprec/mld_c_jac_smoother.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ 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 !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -52,7 +52,7 @@ module mld_c_jac_smoother
! class(mld_c_base_solver_type), allocatable :: sv ! class(mld_c_base_solver_type), allocatable :: sv
! !
type(psb_cspmat_type) :: nd type(psb_cspmat_type) :: nd
integer :: nnz_nd_tot integer(psb_ipk_) :: nnz_nd_tot
contains contains
procedure, pass(sm) :: build => mld_c_jac_smoother_bld procedure, pass(sm) :: build => mld_c_jac_smoother_bld
procedure, pass(sm) :: apply_v => mld_c_jac_smoother_apply_vect procedure, pass(sm) :: apply_v => mld_c_jac_smoother_apply_vect
@ -76,45 +76,45 @@ module mld_c_jac_smoother
interface interface
subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) 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_, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_c_jac_smoother_type), intent(inout) :: sm class(mld_c_jac_smoother_type), intent(inout) :: sm
type(psb_c_vect_type),intent(inout) :: x type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
complex(psb_spk_),target, intent(inout) :: work(:) complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_jac_smoother_apply_vect end subroutine mld_c_jac_smoother_apply_vect
end interface end interface
interface interface
subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) 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_, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_c_jac_smoother_type), intent(in) :: sm class(mld_c_jac_smoother_type), intent(in) :: sm
complex(psb_spk_),intent(inout) :: x(:) complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:) complex(psb_spk_),intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
complex(psb_spk_),target, intent(inout) :: work(:) 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 subroutine mld_c_jac_smoother_apply
end interface end interface
interface interface
subroutine mld_c_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) 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_, & 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_cspmat_type), intent(in), target :: a 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_jac_smoother_type), intent(inout) :: sm class(mld_c_jac_smoother_type), intent(inout) :: sm
character, intent(in) :: upd 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_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
end subroutine mld_c_jac_smoother_bld end subroutine mld_c_jac_smoother_bld
@ -128,10 +128,10 @@ contains
! Arguments ! Arguments
class(mld_c_jac_smoother_type), intent(inout) :: sm class(mld_c_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act Integer(Psb_ipk_) :: err_act
character(len=20) :: name='c_jac_smoother_seti' character(len=20) :: name='c_jac_smoother_seti'
info = psb_success_ info = psb_success_
@ -164,10 +164,10 @@ contains
! Arguments ! Arguments
class(mld_c_jac_smoother_type), intent(inout) :: sm class(mld_c_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act, ival Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='c_jac_smoother_setc' character(len=20) :: name='c_jac_smoother_setc'
info = psb_success_ info = psb_success_
@ -196,15 +196,14 @@ contains
subroutine c_jac_smoother_setr(sm,what,val,info) subroutine c_jac_smoother_setr(sm,what,val,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_c_jac_smoother_type), intent(inout) :: sm class(mld_c_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='c_jac_smoother_setr' character(len=20) :: name='c_jac_smoother_setr'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -234,8 +233,8 @@ contains
! Arguments ! Arguments
class(mld_c_jac_smoother_type), intent(inout) :: sm class(mld_c_jac_smoother_type), intent(inout) :: sm
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='c_jac_smoother_free' character(len=20) :: name='c_jac_smoother_free'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -268,20 +267,18 @@ contains
subroutine c_jac_smoother_descr(sm,info,iout,coarse) subroutine c_jac_smoother_descr(sm,info,iout,coarse)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_c_jac_smoother_type), intent(in) :: sm class(mld_c_jac_smoother_type), intent(in) :: sm
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_c_jac_smoother_descr' character(len=20), parameter :: name='mld_c_jac_smoother_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
logical :: coarse_ logical :: coarse_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -323,7 +320,7 @@ contains
! Arguments ! Arguments
class(mld_c_jac_smoother_type), intent(in) :: sm class(mld_c_jac_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = psb_sizeof_int val = psb_sizeof_int
if (allocated(sm%sv)) val = val + sm%sv%sizeof() if (allocated(sm%sv)) val = val + sm%sv%sizeof()
@ -338,7 +335,7 @@ contains
! Arguments ! Arguments
class(mld_c_jac_smoother_type), intent(in) :: sm class(mld_c_jac_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sm%sv)) val = val + sm%sv%get_nzeros() 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_base_prec_type
use mld_c_base_smoother_mod use mld_c_base_smoother_mod
use psb_base_mod, only : psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & 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. ! Type: mld_Tonelev_type.
@ -154,86 +154,93 @@ module mld_c_onelev_mod
interface interface
subroutine mld_c_base_onelev_descr(lv,il,nl,info,iout) subroutine mld_c_base_onelev_descr(lv,il,nl,info,iout)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & 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 Implicit None
! Arguments ! Arguments
class(mld_c_onelev_type), intent(in) :: lv class(mld_c_onelev_type), intent(in) :: lv
integer, intent(in) :: il,nl integer(psb_ipk_), intent(in) :: il,nl
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
end subroutine mld_c_base_onelev_descr end subroutine mld_c_base_onelev_descr
end interface end interface
interface interface
subroutine mld_c_base_onelev_free(lv,info) subroutine mld_c_base_onelev_free(lv,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & 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 implicit none
class(mld_c_onelev_type), intent(inout) :: lv 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 subroutine mld_c_base_onelev_free
end interface end interface
interface interface
subroutine mld_c_base_onelev_check(lv,info) subroutine mld_c_base_onelev_check(lv,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & 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 Implicit None
! Arguments ! Arguments
class(mld_c_onelev_type), intent(inout) :: lv 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 subroutine mld_c_base_onelev_check
end interface end interface
interface interface
subroutine mld_c_base_onelev_seti(lv,what,val,info) subroutine mld_c_base_onelev_seti(lv,what,val,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & 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 Implicit None
! Arguments ! Arguments
class(mld_c_onelev_type), intent(inout) :: lv class(mld_c_onelev_type), intent(inout) :: lv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_onelev_seti end subroutine mld_c_base_onelev_seti
end interface end interface
interface interface
subroutine mld_c_base_onelev_setc(lv,what,val,info) subroutine mld_c_base_onelev_setc(lv,what,val,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & 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 Implicit None
! Arguments ! Arguments
class(mld_c_onelev_type), intent(inout) :: lv class(mld_c_onelev_type), intent(inout) :: lv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_onelev_setc end subroutine mld_c_base_onelev_setc
end interface end interface
interface interface
subroutine mld_c_base_onelev_setr(lv,what,val,info) subroutine mld_c_base_onelev_setr(lv,what,val,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & 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 Implicit None
class(mld_c_onelev_type), intent(inout) :: lv class(mld_c_onelev_type), intent(inout) :: lv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_onelev_setr end subroutine mld_c_base_onelev_setr
end interface end interface
interface interface
subroutine mld_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,solver) 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, & 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 implicit none
class(mld_c_onelev_type), intent(in) :: lv class(mld_c_onelev_type), intent(in) :: lv
integer, intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: ac, rp, smoother, solver logical, optional, intent(in) :: ac, rp, smoother, solver
end subroutine mld_c_base_onelev_dump end subroutine mld_c_base_onelev_dump
@ -253,7 +260,7 @@ contains
implicit none implicit none
class(mld_c_onelev_type), intent(in) :: lv class(mld_c_onelev_type), intent(in) :: lv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(lv%sm)) & if (allocated(lv%sm)) &
& val = lv%sm%get_nzeros() & val = lv%sm%get_nzeros()
@ -263,7 +270,7 @@ contains
implicit none implicit none
class(mld_c_onelev_type), intent(in) :: lv class(mld_c_onelev_type), intent(in) :: lv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
val = val + lv%desc_ac%sizeof() val = val + lv%desc_ac%sizeof()
@ -325,7 +332,7 @@ contains
use psb_base_mod use psb_base_mod
implicit none implicit none
type(mld_c_onelev_type), intent(inout) :: a, b type(mld_c_onelev_type), intent(inout) :: a, b
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
call b%free(info) call b%free(info)
b%parms = a%parms 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 interface mld_precinit
subroutine mld_cprecinit(p,ptype,info,nlev) 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 type(mld_cprec_type), intent(inout) :: p
character(len=*), intent(in) :: ptype character(len=*), intent(in) :: ptype
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: nlev integer(psb_ipk_), optional, intent(in) :: nlev
end subroutine mld_cprecinit end subroutine mld_cprecinit
end interface end interface
@ -65,46 +66,46 @@ module mld_c_prec_mod
interface mld_inner_precset interface mld_inner_precset
subroutine mld_cprecsetsm(p,val,info,ilev) subroutine mld_cprecsetsm(p,val,info,ilev)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, & import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
& mld_cprec_type, mld_c_base_smoother_type & mld_cprec_type, mld_c_base_smoother_type, psb_ipk_
type(mld_cprec_type), intent(inout) :: p type(mld_cprec_type), intent(inout) :: p
class(mld_c_base_smoother_type), intent(in) :: val class(mld_c_base_smoother_type), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_cprecsetsm end subroutine mld_cprecsetsm
subroutine mld_cprecsetsv(p,val,info,ilev) subroutine mld_cprecsetsv(p,val,info,ilev)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, & import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
& mld_cprec_type, mld_c_base_solver_type & mld_cprec_type, mld_c_base_solver_type, psb_ipk_
type(mld_cprec_type), intent(inout) :: p type(mld_cprec_type), intent(inout) :: p
class(mld_c_base_solver_type), intent(in) :: val class(mld_c_base_solver_type), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_cprecsetsv end subroutine mld_cprecsetsv
subroutine mld_cprecseti(p,what,val,info,ilev) subroutine mld_cprecseti(p,what,val,info,ilev)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, & import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
& mld_cprec_type & mld_cprec_type, psb_ipk_
type(mld_cprec_type), intent(inout) :: p type(mld_cprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_cprecseti end subroutine mld_cprecseti
subroutine mld_cprecsetr(p,what,val,info,ilev) subroutine mld_cprecsetr(p,what,val,info,ilev)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, & import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
& mld_cprec_type & mld_cprec_type, psb_ipk_
type(mld_cprec_type), intent(inout) :: p type(mld_cprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_cprecsetr end subroutine mld_cprecsetr
subroutine mld_cprecsetc(p,what,string,info,ilev) subroutine mld_cprecsetc(p,what,string,info,ilev)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, & import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
& mld_cprec_type & mld_cprec_type, psb_ipk_
type(mld_cprec_type), intent(inout) :: p type(mld_cprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: string character(len=*), intent(in) :: string
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_cprecsetc end subroutine mld_cprecsetc
end interface end interface
@ -112,12 +113,12 @@ module mld_c_prec_mod
subroutine mld_cprecbld(a,desc_a,prec,info,amold,vmold) subroutine mld_cprecbld(a,desc_a,prec,info,amold,vmold)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, & import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
& psb_c_base_sparse_mat, psb_c_base_vect_type, & & psb_c_base_sparse_mat, psb_c_base_vect_type, &
& mld_cprec_type & mld_cprec_type, psb_ipk_
implicit none implicit none
type(psb_cspmat_type), intent(in), target :: a 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 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_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
!!$ character, intent(in),optional :: upd !!$ character, intent(in),optional :: upd
@ -129,7 +130,7 @@ contains
subroutine mld_c_iprecsetsm(p,val,info) subroutine mld_c_iprecsetsm(p,val,info)
type(mld_cprec_type), intent(inout) :: p type(mld_cprec_type), intent(inout) :: p
class(mld_c_base_smoother_type), intent(in) :: val 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) call mld_inner_precset(p,val,info)
end subroutine mld_c_iprecsetsm end subroutine mld_c_iprecsetsm
@ -137,34 +138,34 @@ contains
subroutine mld_c_iprecsetsv(p,val,info) subroutine mld_c_iprecsetsv(p,val,info)
type(mld_cprec_type), intent(inout) :: p type(mld_cprec_type), intent(inout) :: p
class(mld_c_base_solver_type), intent(in) :: val 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) call mld_inner_precset(p,val,info)
end subroutine mld_c_iprecsetsv end subroutine mld_c_iprecsetsv
subroutine mld_c_iprecseti(p,what,val,info) subroutine mld_c_iprecseti(p,what,val,info)
type(mld_cprec_type), intent(inout) :: p type(mld_cprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info) call mld_inner_precset(p,what,val,info)
end subroutine mld_c_iprecseti end subroutine mld_c_iprecseti
subroutine mld_c_iprecsetr(p,what,val,info) subroutine mld_c_iprecsetr(p,what,val,info)
type(mld_cprec_type), intent(inout) :: p type(mld_cprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info) call mld_inner_precset(p,what,val,info)
end subroutine mld_c_iprecsetr end subroutine mld_c_iprecsetr
subroutine mld_c_iprecsetc(p,what,val,info) subroutine mld_c_iprecsetc(p,what,val,info)
type(mld_cprec_type), intent(inout) :: p type(mld_cprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info) call mld_inner_precset(p,what,val,info)
end subroutine mld_c_iprecsetc 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 type, extends(psb_cprec_type) :: mld_cprec_type
integer :: ictxt integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: coarse_aggr_size integer(psb_ipk_) :: coarse_aggr_size
real(psb_spk_) :: op_complexity=szero real(psb_spk_) :: op_complexity=szero
type(mld_c_onelev_type), allocatable :: precv(:) type(mld_c_onelev_type), allocatable :: precv(:)
@ -121,41 +121,41 @@ module mld_c_prec_type
interface mld_precaply interface mld_precaply
subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work) subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
import :: psb_cspmat_type, psb_desc_type, & 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(psb_desc_type),intent(in) :: desc_data
type(mld_cprec_type), intent(inout) :: prec type(mld_cprec_type), intent(inout) :: prec
type(psb_c_vect_type),intent(inout) :: x type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y type(psb_c_vect_type),intent(inout) :: y
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
complex(psb_spk_),intent(inout), optional, target :: work(:) complex(psb_spk_),intent(inout), optional, target :: work(:)
end subroutine mld_cprecaply2_vect end subroutine mld_cprecaply2_vect
subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work) subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work)
import :: psb_cspmat_type, psb_desc_type, & 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(psb_desc_type),intent(in) :: desc_data
type(mld_cprec_type), intent(inout) :: prec type(mld_cprec_type), intent(inout) :: prec
type(psb_c_vect_type),intent(inout) :: x type(psb_c_vect_type),intent(inout) :: x
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
complex(psb_spk_),intent(inout), optional, target :: work(:) complex(psb_spk_),intent(inout), optional, target :: work(:)
end subroutine mld_cprecaply1_vect end subroutine mld_cprecaply1_vect
subroutine mld_cprecaply(prec,x,y,desc_data,info,trans,work) 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(psb_desc_type),intent(in) :: desc_data
type(mld_cprec_type), intent(in) :: prec type(mld_cprec_type), intent(in) :: prec
complex(psb_spk_),intent(inout) :: x(:) complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:) complex(psb_spk_),intent(inout) :: y(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
complex(psb_spk_),intent(inout), optional, target :: work(:) complex(psb_spk_),intent(inout), optional, target :: work(:)
end subroutine mld_cprecaply end subroutine mld_cprecaply
subroutine mld_cprecaply1(prec,x,desc_data,info,trans) 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(psb_desc_type),intent(in) :: desc_data
type(mld_cprec_type), intent(in) :: prec type(mld_cprec_type), intent(in) :: prec
complex(psb_spk_),intent(inout) :: x(:) complex(psb_spk_),intent(inout) :: x(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
end subroutine mld_cprecaply1 end subroutine mld_cprecaply1
end interface end interface
@ -173,7 +173,7 @@ contains
implicit none implicit none
class(mld_cprec_type), intent(in) :: prec class(mld_cprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
do i=1, size(prec%precv) do i=1, size(prec%precv)
@ -186,7 +186,7 @@ contains
implicit none implicit none
class(mld_cprec_type), intent(in) :: prec class(mld_cprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
val = val + psb_sizeof_int val = val + psb_sizeof_int
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
@ -218,7 +218,8 @@ contains
class(mld_cprec_type), intent(inout) :: prec class(mld_cprec_type), intent(inout) :: prec
real(psb_spk_) :: num,den real(psb_spk_) :: num,den
integer :: ictxt, il integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: il
num = -done num = -done
den = done den = done
@ -264,15 +265,15 @@ contains
subroutine mld_cfile_prec_descr(p,info,iout) subroutine mld_cfile_prec_descr(p,info,iout)
implicit none implicit none
! Arguments ! Arguments
type(mld_cprec_type), intent(in) :: p type(mld_cprec_type), intent(in) :: p
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
! Local variables ! Local variables
integer :: ilev, nlev integer(psb_ipk_) :: ilev, nlev
integer :: ictxt, me, np integer(psb_mpik_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr' character(len=20), parameter :: name='mld_file_prec_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
info = psb_success_ info = psb_success_
if (present(iout)) then if (present(iout)) then
@ -370,10 +371,10 @@ contains
! Arguments ! Arguments
type(mld_cprec_type), intent(inout) :: p type(mld_cprec_type), intent(inout) :: p
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local variables ! Local variables
integer :: me,err_act,i integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name character(len=20) :: name
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
@ -413,10 +414,10 @@ contains
class(mld_cprec_type), intent(inout) :: prec class(mld_cprec_type), intent(inout) :: prec
type(psb_c_vect_type),intent(inout) :: x type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y type(psb_c_vect_type),intent(inout) :: y
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
complex(psb_spk_),intent(inout), optional, target :: work(:) complex(psb_spk_),intent(inout), optional, target :: work(:)
Integer :: err_act Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply' character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -445,13 +446,13 @@ contains
subroutine mld_c_apply1_vect(prec,x,desc_data,info,trans,work) subroutine mld_c_apply1_vect(prec,x,desc_data,info,trans,work)
implicit none 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 class(mld_cprec_type), intent(inout) :: prec
type(psb_c_vect_type),intent(inout) :: x type(psb_c_vect_type),intent(inout) :: x
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
complex(psb_spk_),intent(inout), optional, target :: work(:) complex(psb_spk_),intent(inout), optional, target :: work(:)
Integer :: err_act Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply' character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -485,10 +486,10 @@ contains
class(mld_cprec_type), intent(in) :: prec class(mld_cprec_type), intent(in) :: prec
complex(psb_spk_),intent(inout) :: x(:) complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:) complex(psb_spk_),intent(inout) :: y(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
complex(psb_spk_),intent(inout), optional, target :: work(:) complex(psb_spk_),intent(inout), optional, target :: work(:)
Integer :: err_act Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply' character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -520,9 +521,9 @@ contains
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
class(mld_cprec_type), intent(in) :: prec class(mld_cprec_type), intent(in) :: prec
complex(psb_spk_),intent(inout) :: x(:) complex(psb_spk_),intent(inout) :: x(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
Integer :: err_act Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply' character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -553,13 +554,13 @@ contains
subroutine mld_c_dump(prec,info,istart,iend,prefix,head,ac,rp,smoother,solver) subroutine mld_c_dump(prec,info,istart,iend,prefix,head,ac,rp,smoother,solver)
implicit none implicit none
class(mld_cprec_type), intent(in) :: prec class(mld_cprec_type), intent(in) :: prec
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: istart, iend integer(psb_ipk_), intent(in), optional :: istart, iend
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp logical, optional, intent(in) :: smoother, solver,ac, rp
integer :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np integer(psb_mpik_) :: icontxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_ ! len of prefix_
@ -588,8 +589,8 @@ contains
implicit none implicit none
type(mld_cprec_type), intent(inout) :: a type(mld_cprec_type), intent(inout) :: a
type(mld_cprec_type), intent(inout), target :: b type(mld_cprec_type), intent(inout), target :: b
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: i integer(psb_ipk_) :: i
if (allocated(b%precv)) then if (allocated(b%precv)) then
! This might not be required if FINAL procedures are available. ! 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 !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ 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 !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -52,8 +52,8 @@ module mld_d_as_smoother
! class(mld_d_base_solver_type), allocatable :: sv ! class(mld_d_base_solver_type), allocatable :: sv
! !
type(psb_dspmat_type) :: nd type(psb_dspmat_type) :: nd
type(psb_desc_type) :: desc_data type(psb_desc_type) :: desc_data
integer :: novr, restr, prol, nd_nnz_tot integer(psb_ipk_) :: novr, restr, prol, nd_nnz_tot
contains contains
procedure, pass(sm) :: check => mld_d_as_smoother_check procedure, pass(sm) :: check => mld_d_as_smoother_check
procedure, pass(sm) :: dump => mld_d_as_smoother_dmp procedure, pass(sm) :: dump => mld_d_as_smoother_dmp
@ -83,41 +83,44 @@ module mld_d_as_smoother
interface interface
subroutine mld_d_as_smoother_check(sm,info) subroutine mld_d_as_smoother_check(sm,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & 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 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 subroutine mld_d_as_smoother_check
end interface end interface
interface interface
subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_d_as_smoother_type), intent(inout) :: sm class(mld_d_as_smoother_type), intent(inout) :: sm
type(psb_d_vect_type),intent(inout) :: x type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:) real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_as_smoother_apply_vect end subroutine mld_d_as_smoother_apply_vect
end interface end interface
interface interface
subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_d_as_smoother_type), intent(in) :: sm class(mld_d_as_smoother_type), intent(in) :: sm
real(psb_dpk_),intent(inout) :: x(:) real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:) real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:) 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 subroutine mld_d_as_smoother_apply
end interface 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) 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, & 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_dpk_, mld_d_as_smoother_type, psb_long_int_k_, &
& psb_desc_type, psb_d_base_sparse_mat & psb_desc_type, psb_d_base_sparse_mat, psb_ipk_
type(psb_dspmat_type), intent(in), target :: a 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_as_smoother_type), intent(inout) :: sm class(mld_d_as_smoother_type), intent(inout) :: sm
character, intent(in) :: upd 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_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_d_base_vect_type), intent(in), optional :: vmold
end subroutine mld_d_as_smoother_bld end subroutine mld_d_as_smoother_bld
@ -139,52 +143,59 @@ module mld_d_as_smoother
interface interface
subroutine mld_d_as_smoother_seti(sm,what,val,info) subroutine mld_d_as_smoother_seti(sm,what,val,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & 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 class(mld_d_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_as_smoother_seti end subroutine mld_d_as_smoother_seti
end interface end interface
interface interface
subroutine mld_d_as_smoother_setc(sm,what,val,info) subroutine mld_d_as_smoother_setc(sm,what,val,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & 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 class(mld_d_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_as_smoother_setc end subroutine mld_d_as_smoother_setc
end interface end interface
interface interface
subroutine mld_d_as_smoother_setr(sm,what,val,info) subroutine mld_d_as_smoother_setr(sm,what,val,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & 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 class(mld_d_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_as_smoother_setr end subroutine mld_d_as_smoother_setr
end interface end interface
interface interface
subroutine mld_d_as_smoother_free(sm,info) subroutine mld_d_as_smoother_free(sm,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & 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 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 subroutine mld_d_as_smoother_free
end interface end interface
interface interface
subroutine mld_d_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) 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, & 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 class(mld_d_as_smoother_type), intent(in) :: sm
integer, intent(in) :: ictxt,level integer(psb_mpik_), intent(in) :: ictxt
integer, intent(out) :: info integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver
end subroutine mld_d_as_smoother_dmp end subroutine mld_d_as_smoother_dmp
@ -197,7 +208,7 @@ contains
! Arguments ! Arguments
class(mld_d_as_smoother_type), intent(in) :: sm class(mld_d_as_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = psb_sizeof_int val = psb_sizeof_int
if (allocated(sm%sv)) val = val + sm%sv%sizeof() if (allocated(sm%sv)) val = val + sm%sv%sizeof()
@ -210,7 +221,7 @@ contains
implicit none implicit none
class(mld_d_as_smoother_type), intent(in) :: sm class(mld_d_as_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sm%sv)) & if (allocated(sm%sv)) &
& val = sm%sv%get_nzeros() & val = sm%sv%get_nzeros()
@ -247,15 +258,14 @@ contains
! Arguments ! Arguments
class(mld_d_as_smoother_type), intent(in) :: sm class(mld_d_as_smoother_type), intent(in) :: sm
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_d_as_smoother_descr' character(len=20), parameter :: name='mld_d_as_smoother_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
logical :: coarse_ logical :: coarse_
call psb_erractionsave(err_act) 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 interface
subroutine mld_d_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_d_base_smoother_type), intent(in) :: sm class(mld_d_base_smoother_type), intent(in) :: sm
real(psb_dpk_),intent(inout) :: x(:) real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:) real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:) 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 subroutine mld_d_base_smoother_apply
end interface 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,& subroutine mld_d_base_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
& trans,sweeps,work,info) & trans,sweeps,work,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_d_base_smoother_type), intent(inout) :: sm class(mld_d_base_smoother_type), intent(inout) :: sm
type(psb_d_vect_type),intent(inout) :: x type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:) real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_smoother_apply_vect end subroutine mld_d_base_smoother_apply_vect
end interface end interface
interface interface
subroutine mld_d_base_smoother_check(sm,info) subroutine mld_d_base_smoother_check(sm,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & 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 ! Arguments
class(mld_d_base_smoother_type), intent(inout) :: sm 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 subroutine mld_d_base_smoother_check
end interface end interface
interface interface
subroutine mld_d_base_smoother_seti(sm,what,val,info) subroutine mld_d_base_smoother_seti(sm,what,val,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & 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 ! Arguments
class(mld_d_base_smoother_type), intent(inout) :: sm class(mld_d_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_smoother_seti end subroutine mld_d_base_smoother_seti
end interface end interface
interface interface
subroutine mld_d_base_smoother_setc(sm,what,val,info) subroutine mld_d_base_smoother_setc(sm,what,val,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & 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 class(mld_d_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_smoother_setc end subroutine mld_d_base_smoother_setc
end interface end interface
interface interface
subroutine mld_d_base_smoother_setr(sm,what,val,info) subroutine mld_d_base_smoother_setr(sm,what,val,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & 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 ! Arguments
class(mld_d_base_smoother_type), intent(inout) :: sm class(mld_d_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_smoother_setr end subroutine mld_d_base_smoother_setr
end interface end interface
interface interface
subroutine mld_d_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) 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, & 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 ! Arguments
type(psb_dspmat_type), intent(in), target :: a 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_smoother_type), intent(inout) :: sm class(mld_d_base_smoother_type), intent(inout) :: sm
character, intent(in) :: upd 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_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_d_base_vect_type), intent(in), optional :: vmold
end subroutine mld_d_base_smoother_bld end subroutine mld_d_base_smoother_bld
@ -211,32 +218,36 @@ module mld_d_base_smoother_mod
interface interface
subroutine mld_d_base_smoother_free(sm,info) subroutine mld_d_base_smoother_free(sm,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & 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 ! Arguments
class(mld_d_base_smoother_type), intent(inout) :: sm 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 subroutine mld_d_base_smoother_free
end interface end interface
interface interface
subroutine mld_d_base_smoother_descr(sm,info,iout,coarse) subroutine mld_d_base_smoother_descr(sm,info,iout,coarse)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & 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 ! Arguments
class(mld_d_base_smoother_type), intent(in) :: sm class(mld_d_base_smoother_type), intent(in) :: sm
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
end subroutine mld_d_base_smoother_descr end subroutine mld_d_base_smoother_descr
end interface end interface
interface interface
subroutine mld_d_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) 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, & 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 class(mld_d_base_smoother_type), intent(in) :: sm
integer, intent(in) :: ictxt,level integer(psb_mpik_), intent(in) :: ictxt
integer, intent(out) :: info integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver
end subroutine mld_d_base_smoother_dmp end subroutine mld_d_base_smoother_dmp
@ -252,7 +263,7 @@ contains
implicit none implicit none
class(mld_d_base_smoother_type), intent(in) :: sm class(mld_d_base_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sm%sv)) & if (allocated(sm%sv)) &
& val = sm%sv%get_nzeros() & val = sm%sv%get_nzeros()
@ -263,7 +274,7 @@ contains
! Arguments ! Arguments
class(mld_d_base_smoother_type), intent(in) :: sm class(mld_d_base_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sm%sv)) then if (allocated(sm%sv)) then

95
mlprec/mld_d_base_solver_mod.f90
Unescape Escape View File

@ -108,15 +108,17 @@ module mld_d_base_solver_mod
interface interface
subroutine mld_d_base_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_d_base_solver_type), intent(in) :: sv class(mld_d_base_solver_type), intent(in) :: sv
real(psb_dpk_),intent(inout) :: x(:) real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:) real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta 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(:) 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 subroutine mld_d_base_solver_apply
end interface end interface
@ -124,32 +126,33 @@ module mld_d_base_solver_mod
interface interface
subroutine mld_d_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_d_base_solver_type), intent(inout) :: sv class(mld_d_base_solver_type), intent(inout) :: sv
type(psb_d_vect_type),intent(inout) :: x type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta 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(:) real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_solver_apply_vect end subroutine mld_d_base_solver_apply_vect
end interface end interface
interface interface
subroutine mld_d_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) 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, & 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 Implicit None
! Arguments ! Arguments
type(psb_dspmat_type), intent(in), target :: a 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 class(mld_d_base_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_d_base_vect_type), intent(in), optional :: vmold
@ -159,84 +162,85 @@ module mld_d_base_solver_mod
interface interface
subroutine mld_d_base_solver_check(sv,info) subroutine mld_d_base_solver_check(sv,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv 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 subroutine mld_d_base_solver_check
end interface end interface
interface interface
subroutine mld_d_base_solver_seti(sv,what,val,info) subroutine mld_d_base_solver_seti(sv,what,val,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv class(mld_d_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_solver_seti end subroutine mld_d_base_solver_seti
end interface end interface
interface interface
subroutine mld_d_base_solver_setc(sv,what,val,info) subroutine mld_d_base_solver_setc(sv,what,val,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv class(mld_d_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_solver_setc end subroutine mld_d_base_solver_setc
end interface end interface
interface interface
subroutine mld_d_base_solver_setr(sv,what,val,info) subroutine mld_d_base_solver_setr(sv,what,val,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv class(mld_d_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_solver_setr end subroutine mld_d_base_solver_setr
end interface end interface
interface interface
subroutine mld_d_base_solver_free(sv,info) subroutine mld_d_base_solver_free(sv,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv 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 subroutine mld_d_base_solver_free
end interface end interface
interface interface
subroutine mld_d_base_solver_descr(sv,info,iout,coarse) subroutine mld_d_base_solver_descr(sv,info,iout,coarse)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_d_base_solver_type), intent(in) :: sv class(mld_d_base_solver_type), intent(in) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
end subroutine mld_d_base_solver_descr end subroutine mld_d_base_solver_descr
end interface end interface
@ -244,12 +248,13 @@ module mld_d_base_solver_mod
interface interface
subroutine mld_d_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) 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, & 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 implicit none
class(mld_d_base_solver_type), intent(in) :: sv class(mld_d_base_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level integer(psb_mpik_), intent(in) :: ictxt
integer, intent(out) :: info integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver
end subroutine mld_d_base_solver_dmp end subroutine mld_d_base_solver_dmp
@ -269,7 +274,7 @@ contains
! Arguments ! Arguments
class(mld_d_base_solver_type), intent(in) :: sv class(mld_d_base_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
return return
@ -279,7 +284,7 @@ contains
implicit none implicit none
class(mld_d_base_solver_type), intent(in) :: sv class(mld_d_base_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
end function d_base_solver_get_nzeros 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 !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ 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 !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -73,42 +73,45 @@ module mld_d_diag_solver
interface interface
subroutine mld_d_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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_, &
type(psb_desc_type), intent(in) :: desc_data & mld_d_diag_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_diag_solver_type), intent(inout) :: sv class(mld_d_diag_solver_type), intent(inout) :: sv
type(psb_d_vect_type), intent(inout) :: x type(psb_d_vect_type), intent(inout) :: x
type(psb_d_vect_type), intent(inout) :: y type(psb_d_vect_type), intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta 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(:) real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_diag_solver_apply_vect end subroutine mld_d_diag_solver_apply_vect
end interface end interface
interface interface
subroutine mld_d_diag_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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_, &
type(psb_desc_type), intent(in) :: desc_data & mld_d_diag_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_diag_solver_type), intent(in) :: sv class(mld_d_diag_solver_type), intent(in) :: sv
real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_), intent(inout) :: y(:) real(psb_dpk_), intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta 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(:) 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 subroutine mld_d_diag_solver_apply
end interface end interface
interface interface
subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) 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, & 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_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 class(mld_d_diag_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_d_base_vect_type), intent(in), optional :: vmold
@ -125,10 +128,10 @@ contains
! Arguments ! Arguments
class(mld_d_diag_solver_type), intent(inout) :: sv class(mld_d_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act Integer(Psb_ipk_) :: err_act
character(len=20) :: name='d_diag_solver_seti' character(len=20) :: name='d_diag_solver_seti'
info = psb_success_ info = psb_success_
@ -144,10 +147,10 @@ contains
! Arguments ! Arguments
class(mld_d_diag_solver_type), intent(inout) :: sv class(mld_d_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act, ival Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='d_diag_solver_setc' character(len=20) :: name='d_diag_solver_setc'
info = psb_success_ info = psb_success_
@ -161,10 +164,10 @@ contains
! Arguments ! Arguments
class(mld_d_diag_solver_type), intent(inout) :: sv class(mld_d_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act Integer(Psb_ipk_) :: err_act
character(len=20) :: name='d_diag_solver_setr' character(len=20) :: name='d_diag_solver_setr'
info = psb_success_ info = psb_success_
@ -179,9 +182,9 @@ contains
! Arguments ! Arguments
class(mld_d_diag_solver_type), intent(inout) :: sv class(mld_d_diag_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_diag_solver_free' character(len=20) :: name='d_diag_solver_free'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -215,15 +218,14 @@ contains
! Arguments ! Arguments
class(mld_d_diag_solver_type), intent(in) :: sv class(mld_d_diag_solver_type), intent(in) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_d_diag_solver_descr' character(len=20), parameter :: name='mld_d_diag_solver_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
info = psb_success_ info = psb_success_
if (present(iout)) then if (present(iout)) then
@ -243,7 +245,7 @@ contains
! Arguments ! Arguments
class(mld_d_diag_solver_type), intent(in) :: sv class(mld_d_diag_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sv%dv)) val = val + sv%dv%sizeof() if (allocated(sv%dv)) val = val + sv%dv%sizeof()
@ -256,7 +258,7 @@ contains
! Arguments ! Arguments
class(mld_d_diag_solver_type), intent(in) :: sv class(mld_d_diag_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sv%dv)) val = val + sv%dv%get_nrows() 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 !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ 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 !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -68,22 +68,24 @@ module mld_d_id_solver
interface interface
subroutine mld_d_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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_, &
type(psb_desc_type), intent(in) :: desc_data & mld_d_id_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_id_solver_type), intent(inout) :: sv class(mld_d_id_solver_type), intent(inout) :: sv
type(psb_d_vect_type),intent(inout) :: x type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta 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(:) real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_id_solver_apply_vect end subroutine mld_d_id_solver_apply_vect
end interface end interface
interface interface
subroutine mld_d_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_d_id_solver_type), intent(in) :: sv class(mld_d_id_solver_type), intent(in) :: sv
real(psb_dpk_),intent(inout) :: x(:) real(psb_dpk_),intent(inout) :: x(:)
@ -91,7 +93,7 @@ module mld_d_id_solver
real(psb_dpk_),intent(in) :: alpha,beta 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(:) 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 subroutine mld_d_id_solver_apply
end interface end interface
@ -104,17 +106,17 @@ contains
! Arguments ! Arguments
type(psb_dspmat_type), intent(in), target :: a 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 class(mld_d_id_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_d_base_vect_type), intent(in), optional :: vmold
! Local variables ! 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(:) 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 character(len=20) :: name='d_id_solver_bld', ch_err
info=psb_success_ info=psb_success_
@ -129,11 +131,11 @@ contains
! Arguments ! Arguments
class(mld_d_id_solver_type), intent(inout) :: sv class(mld_d_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_id_solver_seti' character(len=20) :: name='d_id_solver_seti'
info = psb_success_ info = psb_success_
@ -147,11 +149,11 @@ contains
! Arguments ! Arguments
class(mld_d_id_solver_type), intent(inout) :: sv class(mld_d_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act, ival integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='d_id_solver_setc' character(len=20) :: name='d_id_solver_setc'
info = psb_success_ info = psb_success_
@ -164,11 +166,11 @@ contains
! Arguments ! Arguments
class(mld_d_id_solver_type), intent(inout) :: sv class(mld_d_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_id_solver_setr' character(len=20) :: name='d_id_solver_setr'
info = psb_success_ info = psb_success_
@ -182,9 +184,9 @@ contains
! Arguments ! Arguments
class(mld_d_id_solver_type), intent(inout) :: sv class(mld_d_id_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_id_solver_free' character(len=20) :: name='d_id_solver_free'
info = psb_success_ info = psb_success_
@ -197,15 +199,14 @@ contains
! Arguments ! Arguments
class(mld_d_id_solver_type), intent(in) :: sv class(mld_d_id_solver_type), intent(in) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_d_id_solver_descr' character(len=20), parameter :: name='mld_d_id_solver_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
info = psb_success_ info = psb_success_
if (present(iout)) then 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 !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ 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 !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -49,11 +49,11 @@ module mld_d_ilu_solver
use mld_d_ilu_fact_mod use mld_d_ilu_fact_mod
type, extends(mld_d_base_solver_type) :: mld_d_ilu_solver_type 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(:) real(psb_dpk_), allocatable :: d(:)
type(psb_d_vect_type) :: dv type(psb_d_vect_type) :: dv
integer :: fact_type, fill_in integer(psb_ipk_) :: fact_type, fill_in
real(psb_dpk_) :: thresh real(psb_dpk_) :: thresh
contains contains
procedure, pass(sv) :: dump => mld_d_ilu_solver_dmp procedure, pass(sv) :: dump => mld_d_ilu_solver_dmp
procedure, pass(sv) :: build => mld_d_ilu_solver_bld procedure, pass(sv) :: build => mld_d_ilu_solver_bld
@ -90,42 +90,45 @@ module mld_d_ilu_solver
interface interface
subroutine mld_d_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) 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_, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_d_ilu_solver_type), intent(inout) :: sv class(mld_d_ilu_solver_type), intent(inout) :: sv
type(psb_d_vect_type),intent(inout) :: x type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta 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(:) real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_ilu_solver_apply_vect end subroutine mld_d_ilu_solver_apply_vect
end interface end interface
interface interface
subroutine mld_d_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) 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_, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_d_ilu_solver_type), intent(in) :: sv class(mld_d_ilu_solver_type), intent(in) :: sv
real(psb_dpk_),intent(inout) :: x(:) real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:) real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta 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(:) 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 subroutine mld_d_ilu_solver_apply
end interface end interface
interface interface
subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) 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_, & 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_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 class(mld_d_ilu_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_d_base_vect_type), intent(in), optional :: vmold
@ -135,12 +138,15 @@ module mld_d_ilu_solver
interface interface
subroutine mld_d_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) 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_, & 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 class(mld_d_ilu_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level integer(psb_mpik_), intent(in) :: ictxt
integer, intent(out) :: info integer(psb_ipk_), intent(in) :: level
character(len=*), intent(in), optional :: prefix, head integer(psb_ipk_), intent(out) :: info
logical, optional, intent(in) :: solver character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
end subroutine mld_d_ilu_solver_dmp end subroutine mld_d_ilu_solver_dmp
end interface end interface
@ -167,8 +173,8 @@ contains
! Arguments ! Arguments
class(mld_d_ilu_solver_type), intent(inout) :: sv class(mld_d_ilu_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_ilu_solver_check' character(len=20) :: name='d_ilu_solver_check'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -180,7 +186,7 @@ contains
select case(sv%fact_type) select case(sv%fact_type)
case(mld_ilu_n_,mld_milu_n_) case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(sv%fill_in,& call mld_check_def(sv%fill_in,&
& 'Level',0,is_legal_ml_lev) & 'Level',izero,is_legal_ml_lev)
case(mld_ilu_t_) case(mld_ilu_t_)
call mld_check_def(sv%thresh,& call mld_check_def(sv%thresh,&
& 'Eps',dzero,is_legal_d_fact_thrs) & 'Eps',dzero,is_legal_d_fact_thrs)
@ -207,10 +213,10 @@ contains
! Arguments ! Arguments
class(mld_d_ilu_solver_type), intent(inout) :: sv class(mld_d_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_ilu_solver_seti' character(len=20) :: name='d_ilu_solver_seti'
info = psb_success_ info = psb_success_
@ -244,10 +250,10 @@ contains
! Arguments ! Arguments
class(mld_d_ilu_solver_type), intent(inout) :: sv class(mld_d_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act, ival integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='d_ilu_solver_setc' character(len=20) :: name='d_ilu_solver_setc'
info = psb_success_ info = psb_success_
@ -280,10 +286,10 @@ contains
! Arguments ! Arguments
class(mld_d_ilu_solver_type), intent(inout) :: sv class(mld_d_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_ilu_solver_setr' character(len=20) :: name='d_ilu_solver_setr'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -316,8 +322,8 @@ contains
! Arguments ! Arguments
class(mld_d_ilu_solver_type), intent(inout) :: sv class(mld_d_ilu_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_ilu_solver_free' character(len=20) :: name='d_ilu_solver_free'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -353,15 +359,14 @@ contains
! Arguments ! Arguments
class(mld_d_ilu_solver_type), intent(in) :: sv class(mld_d_ilu_solver_type), intent(in) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_d_ilu_solver_descr' character(len=20), parameter :: name='mld_d_ilu_solver_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -399,7 +404,7 @@ contains
! Arguments ! Arguments
class(mld_d_ilu_solver_type), intent(in) :: sv class(mld_d_ilu_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
val = val + sv%dv%get_nrows() val = val + sv%dv%get_nrows()
@ -415,7 +420,7 @@ contains
! Arguments ! Arguments
class(mld_d_ilu_solver_type), intent(in) :: sv class(mld_d_ilu_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 2*psb_sizeof_int + psb_sizeof_dp val = 2*psb_sizeof_int + psb_sizeof_dp
val = val + sv%dv%sizeof() 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 interface mld_mlprec_bld
subroutine mld_dmlprec_bld(a,desc_a,prec,info, amold, vmold) subroutine mld_dmlprec_bld(a,desc_a,prec,info, amold, vmold)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, & 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 use mld_d_prec_type, only : mld_dprec_type
implicit none implicit none
type(psb_dspmat_type), intent(in), target :: a 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 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_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_d_base_vect_type), intent(in), optional :: vmold
!!$ character, intent(in),optional :: upd !!$ character, intent(in),optional :: upd
@ -66,78 +66,84 @@ module mld_d_inner_mod
interface mld_mlprec_aply interface mld_mlprec_aply
subroutine mld_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) 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 use mld_d_prec_type, only : mld_dprec_type
type(psb_desc_type),intent(in) :: desc_data implicit none
type(mld_dprec_type), intent(in) :: p 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(in) :: alpha,beta
real(psb_dpk_),intent(inout) :: x(:) real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:) real(psb_dpk_),intent(inout) :: y(:)
character,intent(in) :: trans character,intent(in) :: trans
real(psb_dpk_),target :: work(:) real(psb_dpk_),target :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_dmlprec_aply end subroutine mld_dmlprec_aply
subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) 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, & 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 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 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) :: x
type(psb_d_vect_type),intent(inout) :: y type(psb_d_vect_type),intent(inout) :: y
character,intent(in) :: trans character,intent(in) :: trans
real(psb_dpk_),target :: work(:) real(psb_dpk_),target :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_dmlprec_aply_vect end subroutine mld_dmlprec_aply_vect
end interface mld_mlprec_aply end interface mld_mlprec_aply
interface mld_coarse_bld interface mld_coarse_bld
subroutine mld_dcoarse_bld(a,desc_a,p,info) 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 use mld_d_prec_type, only : mld_d_onelev_type
type(psb_dspmat_type), intent(in), target :: a implicit none
type(psb_desc_type), intent(in), target :: desc_a 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 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 subroutine mld_dcoarse_bld
end interface mld_coarse_bld end interface mld_coarse_bld
interface mld_aggrmap_bld interface mld_aggrmap_bld
subroutine mld_daggrmap_bld(aggr_type,theta,a,desc_a,ilaggr,nlaggr,info) 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_ use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
integer, intent(in) :: aggr_type implicit none
real(psb_dpk_), intent(in) :: theta integer(psb_ipk_), intent(in) :: aggr_type
real(psb_dpk_), intent(in) :: theta
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:) integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_daggrmap_bld end subroutine mld_daggrmap_bld
end interface mld_aggrmap_bld end interface mld_aggrmap_bld
interface mld_dec_map_bld interface mld_dec_map_bld
subroutine mld_d_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) 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_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_), intent(in) :: theta real(psb_dpk_), intent(in) :: theta
integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:) integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_dec_map_bld end subroutine mld_d_dec_map_bld
end interface mld_dec_map_bld end interface mld_dec_map_bld
interface mld_aggrmat_asb interface mld_aggrmat_asb
subroutine mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info) 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 use mld_d_prec_type, only : mld_d_onelev_type
implicit none
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(inout) :: ilaggr(:), nlaggr(:) integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_d_onelev_type), intent(inout), target :: p 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 subroutine mld_daggrmat_asb
end interface mld_aggrmat_asb end interface mld_aggrmat_asb
@ -145,14 +151,15 @@ module mld_d_inner_mod
abstract interface abstract interface
subroutine mld_daggrmat_var_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) 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 use mld_d_prec_type, only : mld_d_onelev_type, mld_dml_parms
implicit none
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(inout) :: ilaggr(:), nlaggr(:) integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_dml_parms), intent(inout) :: parms type(mld_dml_parms), intent(inout) :: parms
type(psb_dspmat_type), intent(out) :: ac,op_prol,op_restr 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 subroutine mld_daggrmat_var_asb
end interface end interface

81
mlprec/mld_d_jac_smoother.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ 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 !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -52,7 +52,7 @@ module mld_d_jac_smoother
! class(mld_d_base_solver_type), allocatable :: sv ! class(mld_d_base_solver_type), allocatable :: sv
! !
type(psb_dspmat_type) :: nd type(psb_dspmat_type) :: nd
integer :: nnz_nd_tot integer(psb_ipk_) :: nnz_nd_tot
contains contains
procedure, pass(sm) :: build => mld_d_jac_smoother_bld procedure, pass(sm) :: build => mld_d_jac_smoother_bld
procedure, pass(sm) :: apply_v => mld_d_jac_smoother_apply_vect procedure, pass(sm) :: apply_v => mld_d_jac_smoother_apply_vect
@ -76,45 +76,45 @@ module mld_d_jac_smoother
interface interface
subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) 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_, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_d_jac_smoother_type), intent(inout) :: sm class(mld_d_jac_smoother_type), intent(inout) :: sm
type(psb_d_vect_type),intent(inout) :: x type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:) real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_jac_smoother_apply_vect end subroutine mld_d_jac_smoother_apply_vect
end interface end interface
interface interface
subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) 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_, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_d_jac_smoother_type), intent(in) :: sm class(mld_d_jac_smoother_type), intent(in) :: sm
real(psb_dpk_),intent(inout) :: x(:) real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:) real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:) 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 subroutine mld_d_jac_smoother_apply
end interface end interface
interface interface
subroutine mld_d_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) 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_, & 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_dspmat_type), intent(in), target :: a 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_jac_smoother_type), intent(inout) :: sm class(mld_d_jac_smoother_type), intent(inout) :: sm
character, intent(in) :: upd 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_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_d_base_vect_type), intent(in), optional :: vmold
end subroutine mld_d_jac_smoother_bld end subroutine mld_d_jac_smoother_bld
@ -128,10 +128,10 @@ contains
! Arguments ! Arguments
class(mld_d_jac_smoother_type), intent(inout) :: sm class(mld_d_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act Integer(Psb_ipk_) :: err_act
character(len=20) :: name='d_jac_smoother_seti' character(len=20) :: name='d_jac_smoother_seti'
info = psb_success_ info = psb_success_
@ -164,10 +164,10 @@ contains
! Arguments ! Arguments
class(mld_d_jac_smoother_type), intent(inout) :: sm class(mld_d_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act, ival Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='d_jac_smoother_setc' character(len=20) :: name='d_jac_smoother_setc'
info = psb_success_ info = psb_success_
@ -196,15 +196,14 @@ contains
subroutine d_jac_smoother_setr(sm,what,val,info) subroutine d_jac_smoother_setr(sm,what,val,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_d_jac_smoother_type), intent(inout) :: sm class(mld_d_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_jac_smoother_setr' character(len=20) :: name='d_jac_smoother_setr'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -234,8 +233,8 @@ contains
! Arguments ! Arguments
class(mld_d_jac_smoother_type), intent(inout) :: sm class(mld_d_jac_smoother_type), intent(inout) :: sm
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_jac_smoother_free' character(len=20) :: name='d_jac_smoother_free'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -268,20 +267,18 @@ contains
subroutine d_jac_smoother_descr(sm,info,iout,coarse) subroutine d_jac_smoother_descr(sm,info,iout,coarse)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_d_jac_smoother_type), intent(in) :: sm class(mld_d_jac_smoother_type), intent(in) :: sm
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_d_jac_smoother_descr' character(len=20), parameter :: name='mld_d_jac_smoother_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
logical :: coarse_ logical :: coarse_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -323,7 +320,7 @@ contains
! Arguments ! Arguments
class(mld_d_jac_smoother_type), intent(in) :: sm class(mld_d_jac_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = psb_sizeof_int val = psb_sizeof_int
if (allocated(sm%sv)) val = val + sm%sv%sizeof() if (allocated(sm%sv)) val = val + sm%sv%sizeof()
@ -338,7 +335,7 @@ contains
! Arguments ! Arguments
class(mld_d_jac_smoother_type), intent(in) :: sm class(mld_d_jac_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sm%sv)) val = val + sm%sv%get_nzeros() 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_base_prec_type
use mld_d_base_smoother_mod use mld_d_base_smoother_mod
use psb_base_mod, only : psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & 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. ! Type: mld_Tonelev_type.
@ -154,86 +154,93 @@ module mld_d_onelev_mod
interface interface
subroutine mld_d_base_onelev_descr(lv,il,nl,info,iout) subroutine mld_d_base_onelev_descr(lv,il,nl,info,iout)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & 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 Implicit None
! Arguments ! Arguments
class(mld_d_onelev_type), intent(in) :: lv class(mld_d_onelev_type), intent(in) :: lv
integer, intent(in) :: il,nl integer(psb_ipk_), intent(in) :: il,nl
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
end subroutine mld_d_base_onelev_descr end subroutine mld_d_base_onelev_descr
end interface end interface
interface interface
subroutine mld_d_base_onelev_free(lv,info) subroutine mld_d_base_onelev_free(lv,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & 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 implicit none
class(mld_d_onelev_type), intent(inout) :: lv 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 subroutine mld_d_base_onelev_free
end interface end interface
interface interface
subroutine mld_d_base_onelev_check(lv,info) subroutine mld_d_base_onelev_check(lv,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & 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 Implicit None
! Arguments ! Arguments
class(mld_d_onelev_type), intent(inout) :: lv 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 subroutine mld_d_base_onelev_check
end interface end interface
interface interface
subroutine mld_d_base_onelev_seti(lv,what,val,info) subroutine mld_d_base_onelev_seti(lv,what,val,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & 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 Implicit None
! Arguments ! Arguments
class(mld_d_onelev_type), intent(inout) :: lv class(mld_d_onelev_type), intent(inout) :: lv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_onelev_seti end subroutine mld_d_base_onelev_seti
end interface end interface
interface interface
subroutine mld_d_base_onelev_setc(lv,what,val,info) subroutine mld_d_base_onelev_setc(lv,what,val,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & 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 Implicit None
! Arguments ! Arguments
class(mld_d_onelev_type), intent(inout) :: lv class(mld_d_onelev_type), intent(inout) :: lv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_onelev_setc end subroutine mld_d_base_onelev_setc
end interface end interface
interface interface
subroutine mld_d_base_onelev_setr(lv,what,val,info) subroutine mld_d_base_onelev_setr(lv,what,val,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & 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 Implicit None
class(mld_d_onelev_type), intent(inout) :: lv class(mld_d_onelev_type), intent(inout) :: lv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_onelev_setr end subroutine mld_d_base_onelev_setr
end interface end interface
interface interface
subroutine mld_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,solver) 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, & 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 implicit none
class(mld_d_onelev_type), intent(in) :: lv class(mld_d_onelev_type), intent(in) :: lv
integer, intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: ac, rp, smoother, solver logical, optional, intent(in) :: ac, rp, smoother, solver
end subroutine mld_d_base_onelev_dump end subroutine mld_d_base_onelev_dump
@ -253,7 +260,7 @@ contains
implicit none implicit none
class(mld_d_onelev_type), intent(in) :: lv class(mld_d_onelev_type), intent(in) :: lv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(lv%sm)) & if (allocated(lv%sm)) &
& val = lv%sm%get_nzeros() & val = lv%sm%get_nzeros()
@ -263,7 +270,7 @@ contains
implicit none implicit none
class(mld_d_onelev_type), intent(in) :: lv class(mld_d_onelev_type), intent(in) :: lv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
val = val + lv%desc_ac%sizeof() val = val + lv%desc_ac%sizeof()
@ -325,7 +332,7 @@ contains
use psb_base_mod use psb_base_mod
implicit none implicit none
type(mld_d_onelev_type), intent(inout) :: a, b type(mld_d_onelev_type), intent(inout) :: a, b
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
call b%free(info) call b%free(info)
b%parms = a%parms 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 interface mld_precinit
subroutine mld_dprecinit(p,ptype,info,nlev) 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 type(mld_dprec_type), intent(inout) :: p
character(len=*), intent(in) :: ptype character(len=*), intent(in) :: ptype
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: nlev integer(psb_ipk_), optional, intent(in) :: nlev
end subroutine mld_dprecinit end subroutine mld_dprecinit
end interface end interface
@ -65,46 +66,46 @@ module mld_d_prec_mod
interface mld_inner_precset interface mld_inner_precset
subroutine mld_dprecsetsm(p,val,info,ilev) subroutine mld_dprecsetsm(p,val,info,ilev)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
& mld_dprec_type, mld_d_base_smoother_type & mld_dprec_type, mld_d_base_smoother_type, psb_ipk_
type(mld_dprec_type), intent(inout) :: p type(mld_dprec_type), intent(inout) :: p
class(mld_d_base_smoother_type), intent(in) :: val class(mld_d_base_smoother_type), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_dprecsetsm end subroutine mld_dprecsetsm
subroutine mld_dprecsetsv(p,val,info,ilev) subroutine mld_dprecsetsv(p,val,info,ilev)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
& mld_dprec_type, mld_d_base_solver_type & mld_dprec_type, mld_d_base_solver_type, psb_ipk_
type(mld_dprec_type), intent(inout) :: p type(mld_dprec_type), intent(inout) :: p
class(mld_d_base_solver_type), intent(in) :: val class(mld_d_base_solver_type), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_dprecsetsv end subroutine mld_dprecsetsv
subroutine mld_dprecseti(p,what,val,info,ilev) subroutine mld_dprecseti(p,what,val,info,ilev)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
& mld_dprec_type & mld_dprec_type, psb_ipk_
type(mld_dprec_type), intent(inout) :: p type(mld_dprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_dprecseti end subroutine mld_dprecseti
subroutine mld_dprecsetr(p,what,val,info,ilev) subroutine mld_dprecsetr(p,what,val,info,ilev)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
& mld_dprec_type & mld_dprec_type, psb_ipk_
type(mld_dprec_type), intent(inout) :: p type(mld_dprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_dprecsetr end subroutine mld_dprecsetr
subroutine mld_dprecsetc(p,what,string,info,ilev) subroutine mld_dprecsetc(p,what,string,info,ilev)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
& mld_dprec_type & mld_dprec_type, psb_ipk_
type(mld_dprec_type), intent(inout) :: p type(mld_dprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: string character(len=*), intent(in) :: string
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_dprecsetc end subroutine mld_dprecsetc
end interface end interface
@ -112,12 +113,12 @@ module mld_d_prec_mod
subroutine mld_dprecbld(a,desc_a,prec,info,amold,vmold) subroutine mld_dprecbld(a,desc_a,prec,info,amold,vmold)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
& psb_d_base_sparse_mat, psb_d_base_vect_type, & & psb_d_base_sparse_mat, psb_d_base_vect_type, &
& mld_dprec_type & mld_dprec_type, psb_ipk_
implicit none implicit none
type(psb_dspmat_type), intent(in), target :: a 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 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_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_d_base_vect_type), intent(in), optional :: vmold
!!$ character, intent(in),optional :: upd !!$ character, intent(in),optional :: upd
@ -129,7 +130,7 @@ contains
subroutine mld_d_iprecsetsm(p,val,info) subroutine mld_d_iprecsetsm(p,val,info)
type(mld_dprec_type), intent(inout) :: p type(mld_dprec_type), intent(inout) :: p
class(mld_d_base_smoother_type), intent(in) :: val 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) call mld_inner_precset(p,val,info)
end subroutine mld_d_iprecsetsm end subroutine mld_d_iprecsetsm
@ -137,34 +138,34 @@ contains
subroutine mld_d_iprecsetsv(p,val,info) subroutine mld_d_iprecsetsv(p,val,info)
type(mld_dprec_type), intent(inout) :: p type(mld_dprec_type), intent(inout) :: p
class(mld_d_base_solver_type), intent(in) :: val 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) call mld_inner_precset(p,val,info)
end subroutine mld_d_iprecsetsv end subroutine mld_d_iprecsetsv
subroutine mld_d_iprecseti(p,what,val,info) subroutine mld_d_iprecseti(p,what,val,info)
type(mld_dprec_type), intent(inout) :: p type(mld_dprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info) call mld_inner_precset(p,what,val,info)
end subroutine mld_d_iprecseti end subroutine mld_d_iprecseti
subroutine mld_d_iprecsetr(p,what,val,info) subroutine mld_d_iprecsetr(p,what,val,info)
type(mld_dprec_type), intent(inout) :: p type(mld_dprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info) call mld_inner_precset(p,what,val,info)
end subroutine mld_d_iprecsetr end subroutine mld_d_iprecsetr
subroutine mld_d_iprecsetc(p,what,val,info) subroutine mld_d_iprecsetc(p,what,val,info)
type(mld_dprec_type), intent(inout) :: p type(mld_dprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info) call mld_inner_precset(p,what,val,info)
end subroutine mld_d_iprecsetc 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 type, extends(psb_dprec_type) :: mld_dprec_type
integer :: ictxt integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: coarse_aggr_size integer(psb_ipk_) :: coarse_aggr_size
real(psb_dpk_) :: op_complexity=dzero real(psb_dpk_) :: op_complexity=dzero
type(mld_d_onelev_type), allocatable :: precv(:) type(mld_d_onelev_type), allocatable :: precv(:)
@ -121,41 +121,41 @@ module mld_d_prec_type
interface mld_precaply interface mld_precaply
subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work) subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
import :: psb_dspmat_type, psb_desc_type, & 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(psb_desc_type),intent(in) :: desc_data
type(mld_dprec_type), intent(inout) :: prec type(mld_dprec_type), intent(inout) :: prec
type(psb_d_vect_type),intent(inout) :: x type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y type(psb_d_vect_type),intent(inout) :: y
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
real(psb_dpk_),intent(inout), optional, target :: work(:) real(psb_dpk_),intent(inout), optional, target :: work(:)
end subroutine mld_dprecaply2_vect end subroutine mld_dprecaply2_vect
subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work) subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work)
import :: psb_dspmat_type, psb_desc_type, & 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(psb_desc_type),intent(in) :: desc_data
type(mld_dprec_type), intent(inout) :: prec type(mld_dprec_type), intent(inout) :: prec
type(psb_d_vect_type),intent(inout) :: x type(psb_d_vect_type),intent(inout) :: x
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
real(psb_dpk_),intent(inout), optional, target :: work(:) real(psb_dpk_),intent(inout), optional, target :: work(:)
end subroutine mld_dprecaply1_vect end subroutine mld_dprecaply1_vect
subroutine mld_dprecaply(prec,x,y,desc_data,info,trans,work) 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(psb_desc_type),intent(in) :: desc_data
type(mld_dprec_type), intent(in) :: prec type(mld_dprec_type), intent(in) :: prec
real(psb_dpk_),intent(inout) :: x(:) real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:) real(psb_dpk_),intent(inout) :: y(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
real(psb_dpk_),intent(inout), optional, target :: work(:) real(psb_dpk_),intent(inout), optional, target :: work(:)
end subroutine mld_dprecaply end subroutine mld_dprecaply
subroutine mld_dprecaply1(prec,x,desc_data,info,trans) 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(psb_desc_type),intent(in) :: desc_data
type(mld_dprec_type), intent(in) :: prec type(mld_dprec_type), intent(in) :: prec
real(psb_dpk_),intent(inout) :: x(:) real(psb_dpk_),intent(inout) :: x(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
end subroutine mld_dprecaply1 end subroutine mld_dprecaply1
end interface end interface
@ -173,7 +173,7 @@ contains
implicit none implicit none
class(mld_dprec_type), intent(in) :: prec class(mld_dprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
do i=1, size(prec%precv) do i=1, size(prec%precv)
@ -186,7 +186,7 @@ contains
implicit none implicit none
class(mld_dprec_type), intent(in) :: prec class(mld_dprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
val = val + psb_sizeof_int val = val + psb_sizeof_int
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
@ -218,7 +218,8 @@ contains
class(mld_dprec_type), intent(inout) :: prec class(mld_dprec_type), intent(inout) :: prec
real(psb_dpk_) :: num,den real(psb_dpk_) :: num,den
integer :: ictxt, il integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: il
num = -done num = -done
den = done den = done
@ -264,15 +265,15 @@ contains
subroutine mld_dfile_prec_descr(p,info,iout) subroutine mld_dfile_prec_descr(p,info,iout)
implicit none implicit none
! Arguments ! Arguments
type(mld_dprec_type), intent(in) :: p type(mld_dprec_type), intent(in) :: p
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
! Local variables ! Local variables
integer :: ilev, nlev integer(psb_ipk_) :: ilev, nlev
integer :: ictxt, me, np integer(psb_mpik_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr' character(len=20), parameter :: name='mld_file_prec_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
info = psb_success_ info = psb_success_
if (present(iout)) then if (present(iout)) then
@ -370,10 +371,10 @@ contains
! Arguments ! Arguments
type(mld_dprec_type), intent(inout) :: p type(mld_dprec_type), intent(inout) :: p
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local variables ! Local variables
integer :: me,err_act,i integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name character(len=20) :: name
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
@ -413,10 +414,10 @@ contains
class(mld_dprec_type), intent(inout) :: prec class(mld_dprec_type), intent(inout) :: prec
type(psb_d_vect_type),intent(inout) :: x type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y type(psb_d_vect_type),intent(inout) :: y
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
real(psb_dpk_),intent(inout), optional, target :: work(:) real(psb_dpk_),intent(inout), optional, target :: work(:)
Integer :: err_act Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply' character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -445,13 +446,13 @@ contains
subroutine mld_d_apply1_vect(prec,x,desc_data,info,trans,work) subroutine mld_d_apply1_vect(prec,x,desc_data,info,trans,work)
implicit none 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 class(mld_dprec_type), intent(inout) :: prec
type(psb_d_vect_type),intent(inout) :: x type(psb_d_vect_type),intent(inout) :: x
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
real(psb_dpk_),intent(inout), optional, target :: work(:) real(psb_dpk_),intent(inout), optional, target :: work(:)
Integer :: err_act Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply' character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -485,10 +486,10 @@ contains
class(mld_dprec_type), intent(in) :: prec class(mld_dprec_type), intent(in) :: prec
real(psb_dpk_),intent(inout) :: x(:) real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:) real(psb_dpk_),intent(inout) :: y(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
real(psb_dpk_),intent(inout), optional, target :: work(:) real(psb_dpk_),intent(inout), optional, target :: work(:)
Integer :: err_act Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply' character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -520,9 +521,9 @@ contains
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
class(mld_dprec_type), intent(in) :: prec class(mld_dprec_type), intent(in) :: prec
real(psb_dpk_),intent(inout) :: x(:) real(psb_dpk_),intent(inout) :: x(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
Integer :: err_act Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply' character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -553,13 +554,13 @@ contains
subroutine mld_d_dump(prec,info,istart,iend,prefix,head,ac,rp,smoother,solver) subroutine mld_d_dump(prec,info,istart,iend,prefix,head,ac,rp,smoother,solver)
implicit none implicit none
class(mld_dprec_type), intent(in) :: prec class(mld_dprec_type), intent(in) :: prec
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: istart, iend integer(psb_ipk_), intent(in), optional :: istart, iend
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp logical, optional, intent(in) :: smoother, solver,ac, rp
integer :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np integer(psb_mpik_) :: icontxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_ ! len of prefix_
@ -588,8 +589,8 @@ contains
implicit none implicit none
type(mld_dprec_type), intent(inout) :: a type(mld_dprec_type), intent(inout) :: a
type(mld_dprec_type), intent(inout), target :: b type(mld_dprec_type), intent(inout), target :: b
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: i integer(psb_ipk_) :: i
if (allocated(b%precv)) then if (allocated(b%precv)) then
! This might not be required if FINAL procedures are available. ! 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 !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ 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 !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -52,8 +52,8 @@ module mld_s_as_smoother
! class(mld_s_base_solver_type), allocatable :: sv ! class(mld_s_base_solver_type), allocatable :: sv
! !
type(psb_sspmat_type) :: nd type(psb_sspmat_type) :: nd
type(psb_desc_type) :: desc_data type(psb_desc_type) :: desc_data
integer :: novr, restr, prol, nd_nnz_tot integer(psb_ipk_) :: novr, restr, prol, nd_nnz_tot
contains contains
procedure, pass(sm) :: check => mld_s_as_smoother_check procedure, pass(sm) :: check => mld_s_as_smoother_check
procedure, pass(sm) :: dump => mld_s_as_smoother_dmp procedure, pass(sm) :: dump => mld_s_as_smoother_dmp
@ -83,41 +83,44 @@ module mld_s_as_smoother
interface interface
subroutine mld_s_as_smoother_check(sm,info) subroutine mld_s_as_smoother_check(sm,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & 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 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 subroutine mld_s_as_smoother_check
end interface end interface
interface interface
subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_s_as_smoother_type), intent(inout) :: sm class(mld_s_as_smoother_type), intent(inout) :: sm
type(psb_s_vect_type),intent(inout) :: x type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
real(psb_spk_),target, intent(inout) :: work(:) real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_as_smoother_apply_vect end subroutine mld_s_as_smoother_apply_vect
end interface end interface
interface interface
subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_s_as_smoother_type), intent(in) :: sm class(mld_s_as_smoother_type), intent(in) :: sm
real(psb_spk_),intent(inout) :: x(:) real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:) real(psb_spk_),intent(inout) :: y(:)
real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
real(psb_spk_),target, intent(inout) :: work(:) 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 subroutine mld_s_as_smoother_apply
end interface 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) 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, & 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_spk_, mld_s_as_smoother_type, psb_long_int_k_, &
& psb_desc_type, psb_s_base_sparse_mat & psb_desc_type, psb_s_base_sparse_mat, psb_ipk_
type(psb_sspmat_type), intent(in), target :: a 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_as_smoother_type), intent(inout) :: sm class(mld_s_as_smoother_type), intent(inout) :: sm
character, intent(in) :: upd 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_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_s_base_vect_type), intent(in), optional :: vmold
end subroutine mld_s_as_smoother_bld end subroutine mld_s_as_smoother_bld
@ -139,52 +143,59 @@ module mld_s_as_smoother
interface interface
subroutine mld_s_as_smoother_seti(sm,what,val,info) subroutine mld_s_as_smoother_seti(sm,what,val,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & 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 class(mld_s_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_as_smoother_seti end subroutine mld_s_as_smoother_seti
end interface end interface
interface interface
subroutine mld_s_as_smoother_setc(sm,what,val,info) subroutine mld_s_as_smoother_setc(sm,what,val,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & 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 class(mld_s_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_as_smoother_setc end subroutine mld_s_as_smoother_setc
end interface end interface
interface interface
subroutine mld_s_as_smoother_setr(sm,what,val,info) subroutine mld_s_as_smoother_setr(sm,what,val,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & 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 class(mld_s_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_as_smoother_setr end subroutine mld_s_as_smoother_setr
end interface end interface
interface interface
subroutine mld_s_as_smoother_free(sm,info) subroutine mld_s_as_smoother_free(sm,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & 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 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 subroutine mld_s_as_smoother_free
end interface end interface
interface interface
subroutine mld_s_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) 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, & 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 class(mld_s_as_smoother_type), intent(in) :: sm
integer, intent(in) :: ictxt,level integer(psb_mpik_), intent(in) :: ictxt
integer, intent(out) :: info integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver
end subroutine mld_s_as_smoother_dmp end subroutine mld_s_as_smoother_dmp
@ -197,7 +208,7 @@ contains
! Arguments ! Arguments
class(mld_s_as_smoother_type), intent(in) :: sm class(mld_s_as_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = psb_sizeof_int val = psb_sizeof_int
if (allocated(sm%sv)) val = val + sm%sv%sizeof() if (allocated(sm%sv)) val = val + sm%sv%sizeof()
@ -210,7 +221,7 @@ contains
implicit none implicit none
class(mld_s_as_smoother_type), intent(in) :: sm class(mld_s_as_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sm%sv)) & if (allocated(sm%sv)) &
& val = sm%sv%get_nzeros() & val = sm%sv%get_nzeros()
@ -247,15 +258,14 @@ contains
! Arguments ! Arguments
class(mld_s_as_smoother_type), intent(in) :: sm class(mld_s_as_smoother_type), intent(in) :: sm
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_s_as_smoother_descr' character(len=20), parameter :: name='mld_s_as_smoother_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
logical :: coarse_ logical :: coarse_
call psb_erractionsave(err_act) 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 interface
subroutine mld_s_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_s_base_smoother_type), intent(in) :: sm class(mld_s_base_smoother_type), intent(in) :: sm
real(psb_spk_),intent(inout) :: x(:) real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:) real(psb_spk_),intent(inout) :: y(:)
real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
real(psb_spk_),target, intent(inout) :: work(:) 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 subroutine mld_s_base_smoother_apply
end interface 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,& subroutine mld_s_base_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
& trans,sweeps,work,info) & trans,sweeps,work,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_s_base_smoother_type), intent(inout) :: sm class(mld_s_base_smoother_type), intent(inout) :: sm
type(psb_s_vect_type),intent(inout) :: x type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
real(psb_spk_),target, intent(inout) :: work(:) real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_smoother_apply_vect end subroutine mld_s_base_smoother_apply_vect
end interface end interface
interface interface
subroutine mld_s_base_smoother_check(sm,info) subroutine mld_s_base_smoother_check(sm,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & 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 ! Arguments
class(mld_s_base_smoother_type), intent(inout) :: sm 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 subroutine mld_s_base_smoother_check
end interface end interface
interface interface
subroutine mld_s_base_smoother_seti(sm,what,val,info) subroutine mld_s_base_smoother_seti(sm,what,val,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & 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 ! Arguments
class(mld_s_base_smoother_type), intent(inout) :: sm class(mld_s_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_smoother_seti end subroutine mld_s_base_smoother_seti
end interface end interface
interface interface
subroutine mld_s_base_smoother_setc(sm,what,val,info) subroutine mld_s_base_smoother_setc(sm,what,val,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & 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 class(mld_s_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_smoother_setc end subroutine mld_s_base_smoother_setc
end interface end interface
interface interface
subroutine mld_s_base_smoother_setr(sm,what,val,info) subroutine mld_s_base_smoother_setr(sm,what,val,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & 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 ! Arguments
class(mld_s_base_smoother_type), intent(inout) :: sm class(mld_s_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_smoother_setr end subroutine mld_s_base_smoother_setr
end interface end interface
interface interface
subroutine mld_s_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) 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, & 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 ! Arguments
type(psb_sspmat_type), intent(in), target :: a 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_smoother_type), intent(inout) :: sm class(mld_s_base_smoother_type), intent(inout) :: sm
character, intent(in) :: upd 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_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_s_base_vect_type), intent(in), optional :: vmold
end subroutine mld_s_base_smoother_bld end subroutine mld_s_base_smoother_bld
@ -211,32 +218,36 @@ module mld_s_base_smoother_mod
interface interface
subroutine mld_s_base_smoother_free(sm,info) subroutine mld_s_base_smoother_free(sm,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & 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 ! Arguments
class(mld_s_base_smoother_type), intent(inout) :: sm 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 subroutine mld_s_base_smoother_free
end interface end interface
interface interface
subroutine mld_s_base_smoother_descr(sm,info,iout,coarse) subroutine mld_s_base_smoother_descr(sm,info,iout,coarse)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & 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 ! Arguments
class(mld_s_base_smoother_type), intent(in) :: sm class(mld_s_base_smoother_type), intent(in) :: sm
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
end subroutine mld_s_base_smoother_descr end subroutine mld_s_base_smoother_descr
end interface end interface
interface interface
subroutine mld_s_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) 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, & 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 class(mld_s_base_smoother_type), intent(in) :: sm
integer, intent(in) :: ictxt,level integer(psb_mpik_), intent(in) :: ictxt
integer, intent(out) :: info integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver
end subroutine mld_s_base_smoother_dmp end subroutine mld_s_base_smoother_dmp
@ -252,7 +263,7 @@ contains
implicit none implicit none
class(mld_s_base_smoother_type), intent(in) :: sm class(mld_s_base_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sm%sv)) & if (allocated(sm%sv)) &
& val = sm%sv%get_nzeros() & val = sm%sv%get_nzeros()
@ -263,7 +274,7 @@ contains
! Arguments ! Arguments
class(mld_s_base_smoother_type), intent(in) :: sm class(mld_s_base_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sm%sv)) then if (allocated(sm%sv)) then

95
mlprec/mld_s_base_solver_mod.f90
Unescape Escape View File

@ -108,15 +108,17 @@ module mld_s_base_solver_mod
interface interface
subroutine mld_s_base_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_s_base_solver_type), intent(in) :: sv class(mld_s_base_solver_type), intent(in) :: sv
real(psb_spk_),intent(inout) :: x(:) real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:) real(psb_spk_),intent(inout) :: y(:)
real(psb_spk_),intent(in) :: alpha,beta 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(:) 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 subroutine mld_s_base_solver_apply
end interface end interface
@ -124,32 +126,33 @@ module mld_s_base_solver_mod
interface interface
subroutine mld_s_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_s_base_solver_type), intent(inout) :: sv class(mld_s_base_solver_type), intent(inout) :: sv
type(psb_s_vect_type),intent(inout) :: x type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta 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(:) real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_solver_apply_vect end subroutine mld_s_base_solver_apply_vect
end interface end interface
interface interface
subroutine mld_s_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) 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, & 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 Implicit None
! Arguments ! Arguments
type(psb_sspmat_type), intent(in), target :: a 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 class(mld_s_base_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type), intent(in), target, optional :: b type(psb_sspmat_type), intent(in), target, optional :: b
class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_s_base_vect_type), intent(in), optional :: vmold
@ -159,84 +162,85 @@ module mld_s_base_solver_mod
interface interface
subroutine mld_s_base_solver_check(sv,info) subroutine mld_s_base_solver_check(sv,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv 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 subroutine mld_s_base_solver_check
end interface end interface
interface interface
subroutine mld_s_base_solver_seti(sv,what,val,info) subroutine mld_s_base_solver_seti(sv,what,val,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv class(mld_s_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_solver_seti end subroutine mld_s_base_solver_seti
end interface end interface
interface interface
subroutine mld_s_base_solver_setc(sv,what,val,info) subroutine mld_s_base_solver_setc(sv,what,val,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv class(mld_s_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_solver_setc end subroutine mld_s_base_solver_setc
end interface end interface
interface interface
subroutine mld_s_base_solver_setr(sv,what,val,info) subroutine mld_s_base_solver_setr(sv,what,val,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv class(mld_s_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_solver_setr end subroutine mld_s_base_solver_setr
end interface end interface
interface interface
subroutine mld_s_base_solver_free(sv,info) subroutine mld_s_base_solver_free(sv,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv 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 subroutine mld_s_base_solver_free
end interface end interface
interface interface
subroutine mld_s_base_solver_descr(sv,info,iout,coarse) subroutine mld_s_base_solver_descr(sv,info,iout,coarse)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_s_base_solver_type), intent(in) :: sv class(mld_s_base_solver_type), intent(in) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
end subroutine mld_s_base_solver_descr end subroutine mld_s_base_solver_descr
end interface end interface
@ -244,12 +248,13 @@ module mld_s_base_solver_mod
interface interface
subroutine mld_s_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) 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, & 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 implicit none
class(mld_s_base_solver_type), intent(in) :: sv class(mld_s_base_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level integer(psb_mpik_), intent(in) :: ictxt
integer, intent(out) :: info integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver
end subroutine mld_s_base_solver_dmp end subroutine mld_s_base_solver_dmp
@ -269,7 +274,7 @@ contains
! Arguments ! Arguments
class(mld_s_base_solver_type), intent(in) :: sv class(mld_s_base_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
return return
@ -279,7 +284,7 @@ contains
implicit none implicit none
class(mld_s_base_solver_type), intent(in) :: sv class(mld_s_base_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
end function s_base_solver_get_nzeros 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 !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ 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 !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -73,42 +73,45 @@ module mld_s_diag_solver
interface interface
subroutine mld_s_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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_, &
type(psb_desc_type), intent(in) :: desc_data & mld_s_diag_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_diag_solver_type), intent(inout) :: sv class(mld_s_diag_solver_type), intent(inout) :: sv
type(psb_s_vect_type), intent(inout) :: x type(psb_s_vect_type), intent(inout) :: x
type(psb_s_vect_type), intent(inout) :: y type(psb_s_vect_type), intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta 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(:) real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_diag_solver_apply_vect end subroutine mld_s_diag_solver_apply_vect
end interface end interface
interface interface
subroutine mld_s_diag_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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_, &
type(psb_desc_type), intent(in) :: desc_data & mld_s_diag_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_diag_solver_type), intent(in) :: sv class(mld_s_diag_solver_type), intent(in) :: sv
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), intent(inout) :: y(:) real(psb_spk_), intent(inout) :: y(:)
real(psb_spk_),intent(in) :: alpha,beta 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(:) 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 subroutine mld_s_diag_solver_apply
end interface end interface
interface interface
subroutine mld_s_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) 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, & 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_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 class(mld_s_diag_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type), intent(in), target, optional :: b type(psb_sspmat_type), intent(in), target, optional :: b
class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_s_base_vect_type), intent(in), optional :: vmold
@ -125,10 +128,10 @@ contains
! Arguments ! Arguments
class(mld_s_diag_solver_type), intent(inout) :: sv class(mld_s_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act Integer(Psb_ipk_) :: err_act
character(len=20) :: name='s_diag_solver_seti' character(len=20) :: name='s_diag_solver_seti'
info = psb_success_ info = psb_success_
@ -144,10 +147,10 @@ contains
! Arguments ! Arguments
class(mld_s_diag_solver_type), intent(inout) :: sv class(mld_s_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act, ival Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='s_diag_solver_setc' character(len=20) :: name='s_diag_solver_setc'
info = psb_success_ info = psb_success_
@ -161,10 +164,10 @@ contains
! Arguments ! Arguments
class(mld_s_diag_solver_type), intent(inout) :: sv class(mld_s_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act Integer(Psb_ipk_) :: err_act
character(len=20) :: name='s_diag_solver_setr' character(len=20) :: name='s_diag_solver_setr'
info = psb_success_ info = psb_success_
@ -179,9 +182,9 @@ contains
! Arguments ! Arguments
class(mld_s_diag_solver_type), intent(inout) :: sv class(mld_s_diag_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='s_diag_solver_free' character(len=20) :: name='s_diag_solver_free'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -215,15 +218,14 @@ contains
! Arguments ! Arguments
class(mld_s_diag_solver_type), intent(in) :: sv class(mld_s_diag_solver_type), intent(in) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_s_diag_solver_descr' character(len=20), parameter :: name='mld_s_diag_solver_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
info = psb_success_ info = psb_success_
if (present(iout)) then if (present(iout)) then
@ -243,7 +245,7 @@ contains
! Arguments ! Arguments
class(mld_s_diag_solver_type), intent(in) :: sv class(mld_s_diag_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sv%dv)) val = val + sv%dv%sizeof() if (allocated(sv%dv)) val = val + sv%dv%sizeof()
@ -256,7 +258,7 @@ contains
! Arguments ! Arguments
class(mld_s_diag_solver_type), intent(in) :: sv class(mld_s_diag_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sv%dv)) val = val + sv%dv%get_nrows() 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 !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ 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 !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -68,22 +68,24 @@ module mld_s_id_solver
interface interface
subroutine mld_s_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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_, &
type(psb_desc_type), intent(in) :: desc_data & mld_s_id_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_id_solver_type), intent(inout) :: sv class(mld_s_id_solver_type), intent(inout) :: sv
type(psb_s_vect_type),intent(inout) :: x type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta 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(:) real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_id_solver_apply_vect end subroutine mld_s_id_solver_apply_vect
end interface end interface
interface interface
subroutine mld_s_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_s_id_solver_type), intent(in) :: sv class(mld_s_id_solver_type), intent(in) :: sv
real(psb_spk_),intent(inout) :: x(:) real(psb_spk_),intent(inout) :: x(:)
@ -91,7 +93,7 @@ module mld_s_id_solver
real(psb_spk_),intent(in) :: alpha,beta 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(:) 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 subroutine mld_s_id_solver_apply
end interface end interface
@ -104,17 +106,17 @@ contains
! Arguments ! Arguments
type(psb_sspmat_type), intent(in), target :: a 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 class(mld_s_id_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type), intent(in), target, optional :: b type(psb_sspmat_type), intent(in), target, optional :: b
class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_s_base_vect_type), intent(in), optional :: vmold
! Local variables ! 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(:) 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 character(len=20) :: name='s_id_solver_bld', ch_err
info=psb_success_ info=psb_success_
@ -129,11 +131,11 @@ contains
! Arguments ! Arguments
class(mld_s_id_solver_type), intent(inout) :: sv class(mld_s_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='s_id_solver_seti' character(len=20) :: name='s_id_solver_seti'
info = psb_success_ info = psb_success_
@ -147,11 +149,11 @@ contains
! Arguments ! Arguments
class(mld_s_id_solver_type), intent(inout) :: sv class(mld_s_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act, ival integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='s_id_solver_setc' character(len=20) :: name='s_id_solver_setc'
info = psb_success_ info = psb_success_
@ -164,11 +166,11 @@ contains
! Arguments ! Arguments
class(mld_s_id_solver_type), intent(inout) :: sv class(mld_s_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='s_id_solver_setr' character(len=20) :: name='s_id_solver_setr'
info = psb_success_ info = psb_success_
@ -182,9 +184,9 @@ contains
! Arguments ! Arguments
class(mld_s_id_solver_type), intent(inout) :: sv class(mld_s_id_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='s_id_solver_free' character(len=20) :: name='s_id_solver_free'
info = psb_success_ info = psb_success_
@ -197,15 +199,14 @@ contains
! Arguments ! Arguments
class(mld_s_id_solver_type), intent(in) :: sv class(mld_s_id_solver_type), intent(in) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_s_id_solver_descr' character(len=20), parameter :: name='mld_s_id_solver_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
info = psb_success_ info = psb_success_
if (present(iout)) then 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 !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ 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 !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -49,11 +49,11 @@ module mld_s_ilu_solver
use mld_s_ilu_fact_mod use mld_s_ilu_fact_mod
type, extends(mld_s_base_solver_type) :: mld_s_ilu_solver_type 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(:) real(psb_spk_), allocatable :: d(:)
type(psb_s_vect_type) :: dv type(psb_s_vect_type) :: dv
integer :: fact_type, fill_in integer(psb_ipk_) :: fact_type, fill_in
real(psb_spk_) :: thresh real(psb_spk_) :: thresh
contains contains
procedure, pass(sv) :: dump => mld_s_ilu_solver_dmp procedure, pass(sv) :: dump => mld_s_ilu_solver_dmp
procedure, pass(sv) :: build => mld_s_ilu_solver_bld procedure, pass(sv) :: build => mld_s_ilu_solver_bld
@ -90,42 +90,45 @@ module mld_s_ilu_solver
interface interface
subroutine mld_s_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) 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_, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_s_ilu_solver_type), intent(inout) :: sv class(mld_s_ilu_solver_type), intent(inout) :: sv
type(psb_s_vect_type),intent(inout) :: x type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta 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(:) real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_ilu_solver_apply_vect end subroutine mld_s_ilu_solver_apply_vect
end interface end interface
interface interface
subroutine mld_s_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) 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_, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_s_ilu_solver_type), intent(in) :: sv class(mld_s_ilu_solver_type), intent(in) :: sv
real(psb_spk_),intent(inout) :: x(:) real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:) real(psb_spk_),intent(inout) :: y(:)
real(psb_spk_),intent(in) :: alpha,beta 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(:) 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 subroutine mld_s_ilu_solver_apply
end interface end interface
interface interface
subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) 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_, & 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_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 class(mld_s_ilu_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type), intent(in), target, optional :: b type(psb_sspmat_type), intent(in), target, optional :: b
class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_s_base_vect_type), intent(in), optional :: vmold
@ -135,12 +138,15 @@ module mld_s_ilu_solver
interface interface
subroutine mld_s_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) 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_, & 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 class(mld_s_ilu_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level integer(psb_mpik_), intent(in) :: ictxt
integer, intent(out) :: info integer(psb_ipk_), intent(in) :: level
character(len=*), intent(in), optional :: prefix, head integer(psb_ipk_), intent(out) :: info
logical, optional, intent(in) :: solver character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
end subroutine mld_s_ilu_solver_dmp end subroutine mld_s_ilu_solver_dmp
end interface end interface
@ -167,8 +173,8 @@ contains
! Arguments ! Arguments
class(mld_s_ilu_solver_type), intent(inout) :: sv class(mld_s_ilu_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='s_ilu_solver_check' character(len=20) :: name='s_ilu_solver_check'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -180,7 +186,7 @@ contains
select case(sv%fact_type) select case(sv%fact_type)
case(mld_ilu_n_,mld_milu_n_) case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(sv%fill_in,& call mld_check_def(sv%fill_in,&
& 'Level',0,is_legal_ml_lev) & 'Level',izero,is_legal_ml_lev)
case(mld_ilu_t_) case(mld_ilu_t_)
call mld_check_def(sv%thresh,& call mld_check_def(sv%thresh,&
& 'Eps',szero,is_legal_s_fact_thrs) & 'Eps',szero,is_legal_s_fact_thrs)
@ -207,10 +213,10 @@ contains
! Arguments ! Arguments
class(mld_s_ilu_solver_type), intent(inout) :: sv class(mld_s_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='s_ilu_solver_seti' character(len=20) :: name='s_ilu_solver_seti'
info = psb_success_ info = psb_success_
@ -244,10 +250,10 @@ contains
! Arguments ! Arguments
class(mld_s_ilu_solver_type), intent(inout) :: sv class(mld_s_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act, ival integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='s_ilu_solver_setc' character(len=20) :: name='s_ilu_solver_setc'
info = psb_success_ info = psb_success_
@ -280,10 +286,10 @@ contains
! Arguments ! Arguments
class(mld_s_ilu_solver_type), intent(inout) :: sv class(mld_s_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='s_ilu_solver_setr' character(len=20) :: name='s_ilu_solver_setr'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -316,8 +322,8 @@ contains
! Arguments ! Arguments
class(mld_s_ilu_solver_type), intent(inout) :: sv class(mld_s_ilu_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='s_ilu_solver_free' character(len=20) :: name='s_ilu_solver_free'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -353,15 +359,14 @@ contains
! Arguments ! Arguments
class(mld_s_ilu_solver_type), intent(in) :: sv class(mld_s_ilu_solver_type), intent(in) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_s_ilu_solver_descr' character(len=20), parameter :: name='mld_s_ilu_solver_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -399,7 +404,7 @@ contains
! Arguments ! Arguments
class(mld_s_ilu_solver_type), intent(in) :: sv class(mld_s_ilu_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
val = val + sv%dv%get_nrows() val = val + sv%dv%get_nrows()
@ -415,7 +420,7 @@ contains
! Arguments ! Arguments
class(mld_s_ilu_solver_type), intent(in) :: sv class(mld_s_ilu_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 2*psb_sizeof_int + psb_sizeof_sp val = 2*psb_sizeof_int + psb_sizeof_sp
val = val + sv%dv%sizeof() 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 interface mld_mlprec_bld
subroutine mld_smlprec_bld(a,desc_a,prec,info, amold, vmold) subroutine mld_smlprec_bld(a,desc_a,prec,info, amold, vmold)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, & 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 use mld_s_prec_type, only : mld_sprec_type
implicit none implicit none
type(psb_sspmat_type), intent(in), target :: a 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 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_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_s_base_vect_type), intent(in), optional :: vmold
!!$ character, intent(in),optional :: upd !!$ character, intent(in),optional :: upd
@ -66,78 +66,84 @@ module mld_s_inner_mod
interface mld_mlprec_aply interface mld_mlprec_aply
subroutine mld_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) 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 use mld_s_prec_type, only : mld_sprec_type
type(psb_desc_type),intent(in) :: desc_data implicit none
type(mld_sprec_type), intent(in) :: p 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(in) :: alpha,beta
real(psb_spk_),intent(inout) :: x(:) real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:) real(psb_spk_),intent(inout) :: y(:)
character,intent(in) :: trans character,intent(in) :: trans
real(psb_spk_),target :: work(:) real(psb_spk_),target :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_smlprec_aply end subroutine mld_smlprec_aply
subroutine mld_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) 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, & 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 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 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) :: x
type(psb_s_vect_type),intent(inout) :: y type(psb_s_vect_type),intent(inout) :: y
character,intent(in) :: trans character,intent(in) :: trans
real(psb_spk_),target :: work(:) real(psb_spk_),target :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_smlprec_aply_vect end subroutine mld_smlprec_aply_vect
end interface mld_mlprec_aply end interface mld_mlprec_aply
interface mld_coarse_bld interface mld_coarse_bld
subroutine mld_scoarse_bld(a,desc_a,p,info) 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 use mld_s_prec_type, only : mld_s_onelev_type
type(psb_sspmat_type), intent(in), target :: a implicit none
type(psb_desc_type), intent(in), target :: desc_a 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 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 subroutine mld_scoarse_bld
end interface mld_coarse_bld end interface mld_coarse_bld
interface mld_aggrmap_bld interface mld_aggrmap_bld
subroutine mld_saggrmap_bld(aggr_type,theta,a,desc_a,ilaggr,nlaggr,info) 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_ use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
integer, intent(in) :: aggr_type implicit none
real(psb_spk_), intent(in) :: theta integer(psb_ipk_), intent(in) :: aggr_type
real(psb_spk_), intent(in) :: theta
type(psb_sspmat_type), intent(in) :: a type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:) integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_saggrmap_bld end subroutine mld_saggrmap_bld
end interface mld_aggrmap_bld end interface mld_aggrmap_bld
interface mld_dec_map_bld interface mld_dec_map_bld
subroutine mld_s_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) 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_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_), intent(in) :: theta real(psb_spk_), intent(in) :: theta
integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:) integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_dec_map_bld end subroutine mld_s_dec_map_bld
end interface mld_dec_map_bld end interface mld_dec_map_bld
interface mld_aggrmat_asb interface mld_aggrmat_asb
subroutine mld_saggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info) 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 use mld_s_prec_type, only : mld_s_onelev_type
implicit none
type(psb_sspmat_type), intent(in) :: a type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(inout) :: ilaggr(:), nlaggr(:) integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_s_onelev_type), intent(inout), target :: p 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 subroutine mld_saggrmat_asb
end interface mld_aggrmat_asb end interface mld_aggrmat_asb
@ -145,14 +151,15 @@ module mld_s_inner_mod
abstract interface abstract interface
subroutine mld_saggrmat_var_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) 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 use mld_s_prec_type, only : mld_s_onelev_type, mld_sml_parms
implicit none
type(psb_sspmat_type), intent(in) :: a type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(inout) :: ilaggr(:), nlaggr(:) integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_sml_parms), intent(inout) :: parms type(mld_sml_parms), intent(inout) :: parms
type(psb_sspmat_type), intent(out) :: ac,op_prol,op_restr 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 subroutine mld_saggrmat_var_asb
end interface end interface

81
mlprec/mld_s_jac_smoother.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ 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 !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -52,7 +52,7 @@ module mld_s_jac_smoother
! class(mld_s_base_solver_type), allocatable :: sv ! class(mld_s_base_solver_type), allocatable :: sv
! !
type(psb_sspmat_type) :: nd type(psb_sspmat_type) :: nd
integer :: nnz_nd_tot integer(psb_ipk_) :: nnz_nd_tot
contains contains
procedure, pass(sm) :: build => mld_s_jac_smoother_bld procedure, pass(sm) :: build => mld_s_jac_smoother_bld
procedure, pass(sm) :: apply_v => mld_s_jac_smoother_apply_vect procedure, pass(sm) :: apply_v => mld_s_jac_smoother_apply_vect
@ -76,45 +76,45 @@ module mld_s_jac_smoother
interface interface
subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) 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_, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_s_jac_smoother_type), intent(inout) :: sm class(mld_s_jac_smoother_type), intent(inout) :: sm
type(psb_s_vect_type),intent(inout) :: x type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
real(psb_spk_),target, intent(inout) :: work(:) real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_jac_smoother_apply_vect end subroutine mld_s_jac_smoother_apply_vect
end interface end interface
interface interface
subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) 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_, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_s_jac_smoother_type), intent(in) :: sm class(mld_s_jac_smoother_type), intent(in) :: sm
real(psb_spk_),intent(inout) :: x(:) real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:) real(psb_spk_),intent(inout) :: y(:)
real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
real(psb_spk_),target, intent(inout) :: work(:) 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 subroutine mld_s_jac_smoother_apply
end interface end interface
interface interface
subroutine mld_s_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) 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_, & 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_sspmat_type), intent(in), target :: a 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_jac_smoother_type), intent(inout) :: sm class(mld_s_jac_smoother_type), intent(inout) :: sm
character, intent(in) :: upd 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_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_s_base_vect_type), intent(in), optional :: vmold
end subroutine mld_s_jac_smoother_bld end subroutine mld_s_jac_smoother_bld
@ -128,10 +128,10 @@ contains
! Arguments ! Arguments
class(mld_s_jac_smoother_type), intent(inout) :: sm class(mld_s_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act Integer(Psb_ipk_) :: err_act
character(len=20) :: name='s_jac_smoother_seti' character(len=20) :: name='s_jac_smoother_seti'
info = psb_success_ info = psb_success_
@ -164,10 +164,10 @@ contains
! Arguments ! Arguments
class(mld_s_jac_smoother_type), intent(inout) :: sm class(mld_s_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act, ival Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='s_jac_smoother_setc' character(len=20) :: name='s_jac_smoother_setc'
info = psb_success_ info = psb_success_
@ -196,15 +196,14 @@ contains
subroutine s_jac_smoother_setr(sm,what,val,info) subroutine s_jac_smoother_setr(sm,what,val,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_s_jac_smoother_type), intent(inout) :: sm class(mld_s_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='s_jac_smoother_setr' character(len=20) :: name='s_jac_smoother_setr'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -234,8 +233,8 @@ contains
! Arguments ! Arguments
class(mld_s_jac_smoother_type), intent(inout) :: sm class(mld_s_jac_smoother_type), intent(inout) :: sm
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='s_jac_smoother_free' character(len=20) :: name='s_jac_smoother_free'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -268,20 +267,18 @@ contains
subroutine s_jac_smoother_descr(sm,info,iout,coarse) subroutine s_jac_smoother_descr(sm,info,iout,coarse)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_s_jac_smoother_type), intent(in) :: sm class(mld_s_jac_smoother_type), intent(in) :: sm
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_s_jac_smoother_descr' character(len=20), parameter :: name='mld_s_jac_smoother_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
logical :: coarse_ logical :: coarse_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -323,7 +320,7 @@ contains
! Arguments ! Arguments
class(mld_s_jac_smoother_type), intent(in) :: sm class(mld_s_jac_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = psb_sizeof_int val = psb_sizeof_int
if (allocated(sm%sv)) val = val + sm%sv%sizeof() if (allocated(sm%sv)) val = val + sm%sv%sizeof()
@ -338,7 +335,7 @@ contains
! Arguments ! Arguments
class(mld_s_jac_smoother_type), intent(in) :: sm class(mld_s_jac_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sm%sv)) val = val + sm%sv%get_nzeros() 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_base_prec_type
use mld_s_base_smoother_mod use mld_s_base_smoother_mod
use psb_base_mod, only : psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & 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. ! Type: mld_Tonelev_type.
@ -154,86 +154,93 @@ module mld_s_onelev_mod
interface interface
subroutine mld_s_base_onelev_descr(lv,il,nl,info,iout) subroutine mld_s_base_onelev_descr(lv,il,nl,info,iout)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & 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 Implicit None
! Arguments ! Arguments
class(mld_s_onelev_type), intent(in) :: lv class(mld_s_onelev_type), intent(in) :: lv
integer, intent(in) :: il,nl integer(psb_ipk_), intent(in) :: il,nl
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
end subroutine mld_s_base_onelev_descr end subroutine mld_s_base_onelev_descr
end interface end interface
interface interface
subroutine mld_s_base_onelev_free(lv,info) subroutine mld_s_base_onelev_free(lv,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & 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 implicit none
class(mld_s_onelev_type), intent(inout) :: lv 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 subroutine mld_s_base_onelev_free
end interface end interface
interface interface
subroutine mld_s_base_onelev_check(lv,info) subroutine mld_s_base_onelev_check(lv,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & 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 Implicit None
! Arguments ! Arguments
class(mld_s_onelev_type), intent(inout) :: lv 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 subroutine mld_s_base_onelev_check
end interface end interface
interface interface
subroutine mld_s_base_onelev_seti(lv,what,val,info) subroutine mld_s_base_onelev_seti(lv,what,val,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & 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 Implicit None
! Arguments ! Arguments
class(mld_s_onelev_type), intent(inout) :: lv class(mld_s_onelev_type), intent(inout) :: lv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_onelev_seti end subroutine mld_s_base_onelev_seti
end interface end interface
interface interface
subroutine mld_s_base_onelev_setc(lv,what,val,info) subroutine mld_s_base_onelev_setc(lv,what,val,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & 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 Implicit None
! Arguments ! Arguments
class(mld_s_onelev_type), intent(inout) :: lv class(mld_s_onelev_type), intent(inout) :: lv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_onelev_setc end subroutine mld_s_base_onelev_setc
end interface end interface
interface interface
subroutine mld_s_base_onelev_setr(lv,what,val,info) subroutine mld_s_base_onelev_setr(lv,what,val,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & 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 Implicit None
class(mld_s_onelev_type), intent(inout) :: lv class(mld_s_onelev_type), intent(inout) :: lv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_onelev_setr end subroutine mld_s_base_onelev_setr
end interface end interface
interface interface
subroutine mld_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,solver) 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, & 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 implicit none
class(mld_s_onelev_type), intent(in) :: lv class(mld_s_onelev_type), intent(in) :: lv
integer, intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: ac, rp, smoother, solver logical, optional, intent(in) :: ac, rp, smoother, solver
end subroutine mld_s_base_onelev_dump end subroutine mld_s_base_onelev_dump
@ -253,7 +260,7 @@ contains
implicit none implicit none
class(mld_s_onelev_type), intent(in) :: lv class(mld_s_onelev_type), intent(in) :: lv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(lv%sm)) & if (allocated(lv%sm)) &
& val = lv%sm%get_nzeros() & val = lv%sm%get_nzeros()
@ -263,7 +270,7 @@ contains
implicit none implicit none
class(mld_s_onelev_type), intent(in) :: lv class(mld_s_onelev_type), intent(in) :: lv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
val = val + lv%desc_ac%sizeof() val = val + lv%desc_ac%sizeof()
@ -325,7 +332,7 @@ contains
use psb_base_mod use psb_base_mod
implicit none implicit none
type(mld_s_onelev_type), intent(inout) :: a, b type(mld_s_onelev_type), intent(inout) :: a, b
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
call b%free(info) call b%free(info)
b%parms = a%parms 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 interface mld_precinit
subroutine mld_sprecinit(p,ptype,info,nlev) 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 type(mld_sprec_type), intent(inout) :: p
character(len=*), intent(in) :: ptype character(len=*), intent(in) :: ptype
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: nlev integer(psb_ipk_), optional, intent(in) :: nlev
end subroutine mld_sprecinit end subroutine mld_sprecinit
end interface end interface
@ -65,46 +66,46 @@ module mld_s_prec_mod
interface mld_inner_precset interface mld_inner_precset
subroutine mld_sprecsetsm(p,val,info,ilev) subroutine mld_sprecsetsm(p,val,info,ilev)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, & import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
& mld_sprec_type, mld_s_base_smoother_type & mld_sprec_type, mld_s_base_smoother_type, psb_ipk_
type(mld_sprec_type), intent(inout) :: p type(mld_sprec_type), intent(inout) :: p
class(mld_s_base_smoother_type), intent(in) :: val class(mld_s_base_smoother_type), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_sprecsetsm end subroutine mld_sprecsetsm
subroutine mld_sprecsetsv(p,val,info,ilev) subroutine mld_sprecsetsv(p,val,info,ilev)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, & import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
& mld_sprec_type, mld_s_base_solver_type & mld_sprec_type, mld_s_base_solver_type, psb_ipk_
type(mld_sprec_type), intent(inout) :: p type(mld_sprec_type), intent(inout) :: p
class(mld_s_base_solver_type), intent(in) :: val class(mld_s_base_solver_type), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_sprecsetsv end subroutine mld_sprecsetsv
subroutine mld_sprecseti(p,what,val,info,ilev) subroutine mld_sprecseti(p,what,val,info,ilev)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, & import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
& mld_sprec_type & mld_sprec_type, psb_ipk_
type(mld_sprec_type), intent(inout) :: p type(mld_sprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_sprecseti end subroutine mld_sprecseti
subroutine mld_sprecsetr(p,what,val,info,ilev) subroutine mld_sprecsetr(p,what,val,info,ilev)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, & import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
& mld_sprec_type & mld_sprec_type, psb_ipk_
type(mld_sprec_type), intent(inout) :: p type(mld_sprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_sprecsetr end subroutine mld_sprecsetr
subroutine mld_sprecsetc(p,what,string,info,ilev) subroutine mld_sprecsetc(p,what,string,info,ilev)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, & import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
& mld_sprec_type & mld_sprec_type, psb_ipk_
type(mld_sprec_type), intent(inout) :: p type(mld_sprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: string character(len=*), intent(in) :: string
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_sprecsetc end subroutine mld_sprecsetc
end interface end interface
@ -112,12 +113,12 @@ module mld_s_prec_mod
subroutine mld_sprecbld(a,desc_a,prec,info,amold,vmold) subroutine mld_sprecbld(a,desc_a,prec,info,amold,vmold)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, & import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
& psb_s_base_sparse_mat, psb_s_base_vect_type, & & psb_s_base_sparse_mat, psb_s_base_vect_type, &
& mld_sprec_type & mld_sprec_type, psb_ipk_
implicit none implicit none
type(psb_sspmat_type), intent(in), target :: a 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 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_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_s_base_vect_type), intent(in), optional :: vmold
!!$ character, intent(in),optional :: upd !!$ character, intent(in),optional :: upd
@ -129,7 +130,7 @@ contains
subroutine mld_s_iprecsetsm(p,val,info) subroutine mld_s_iprecsetsm(p,val,info)
type(mld_sprec_type), intent(inout) :: p type(mld_sprec_type), intent(inout) :: p
class(mld_s_base_smoother_type), intent(in) :: val 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) call mld_inner_precset(p,val,info)
end subroutine mld_s_iprecsetsm end subroutine mld_s_iprecsetsm
@ -137,34 +138,34 @@ contains
subroutine mld_s_iprecsetsv(p,val,info) subroutine mld_s_iprecsetsv(p,val,info)
type(mld_sprec_type), intent(inout) :: p type(mld_sprec_type), intent(inout) :: p
class(mld_s_base_solver_type), intent(in) :: val 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) call mld_inner_precset(p,val,info)
end subroutine mld_s_iprecsetsv end subroutine mld_s_iprecsetsv
subroutine mld_s_iprecseti(p,what,val,info) subroutine mld_s_iprecseti(p,what,val,info)
type(mld_sprec_type), intent(inout) :: p type(mld_sprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info) call mld_inner_precset(p,what,val,info)
end subroutine mld_s_iprecseti end subroutine mld_s_iprecseti
subroutine mld_s_iprecsetr(p,what,val,info) subroutine mld_s_iprecsetr(p,what,val,info)
type(mld_sprec_type), intent(inout) :: p type(mld_sprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info) call mld_inner_precset(p,what,val,info)
end subroutine mld_s_iprecsetr end subroutine mld_s_iprecsetr
subroutine mld_s_iprecsetc(p,what,val,info) subroutine mld_s_iprecsetc(p,what,val,info)
type(mld_sprec_type), intent(inout) :: p type(mld_sprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info) call mld_inner_precset(p,what,val,info)
end subroutine mld_s_iprecsetc 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 type, extends(psb_sprec_type) :: mld_sprec_type
integer :: ictxt integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: coarse_aggr_size integer(psb_ipk_) :: coarse_aggr_size
real(psb_spk_) :: op_complexity=szero real(psb_spk_) :: op_complexity=szero
type(mld_s_onelev_type), allocatable :: precv(:) type(mld_s_onelev_type), allocatable :: precv(:)
@ -121,41 +121,41 @@ module mld_s_prec_type
interface mld_precaply interface mld_precaply
subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work) subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
import :: psb_sspmat_type, psb_desc_type, & 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(psb_desc_type),intent(in) :: desc_data
type(mld_sprec_type), intent(inout) :: prec type(mld_sprec_type), intent(inout) :: prec
type(psb_s_vect_type),intent(inout) :: x type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y type(psb_s_vect_type),intent(inout) :: y
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
real(psb_spk_),intent(inout), optional, target :: work(:) real(psb_spk_),intent(inout), optional, target :: work(:)
end subroutine mld_sprecaply2_vect end subroutine mld_sprecaply2_vect
subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work) subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work)
import :: psb_sspmat_type, psb_desc_type, & 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(psb_desc_type),intent(in) :: desc_data
type(mld_sprec_type), intent(inout) :: prec type(mld_sprec_type), intent(inout) :: prec
type(psb_s_vect_type),intent(inout) :: x type(psb_s_vect_type),intent(inout) :: x
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
real(psb_spk_),intent(inout), optional, target :: work(:) real(psb_spk_),intent(inout), optional, target :: work(:)
end subroutine mld_sprecaply1_vect end subroutine mld_sprecaply1_vect
subroutine mld_sprecaply(prec,x,y,desc_data,info,trans,work) 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(psb_desc_type),intent(in) :: desc_data
type(mld_sprec_type), intent(in) :: prec type(mld_sprec_type), intent(in) :: prec
real(psb_spk_),intent(inout) :: x(:) real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:) real(psb_spk_),intent(inout) :: y(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
real(psb_spk_),intent(inout), optional, target :: work(:) real(psb_spk_),intent(inout), optional, target :: work(:)
end subroutine mld_sprecaply end subroutine mld_sprecaply
subroutine mld_sprecaply1(prec,x,desc_data,info,trans) 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(psb_desc_type),intent(in) :: desc_data
type(mld_sprec_type), intent(in) :: prec type(mld_sprec_type), intent(in) :: prec
real(psb_spk_),intent(inout) :: x(:) real(psb_spk_),intent(inout) :: x(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
end subroutine mld_sprecaply1 end subroutine mld_sprecaply1
end interface end interface
@ -173,7 +173,7 @@ contains
implicit none implicit none
class(mld_sprec_type), intent(in) :: prec class(mld_sprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
do i=1, size(prec%precv) do i=1, size(prec%precv)
@ -186,7 +186,7 @@ contains
implicit none implicit none
class(mld_sprec_type), intent(in) :: prec class(mld_sprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
val = val + psb_sizeof_int val = val + psb_sizeof_int
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
@ -218,7 +218,8 @@ contains
class(mld_sprec_type), intent(inout) :: prec class(mld_sprec_type), intent(inout) :: prec
real(psb_spk_) :: num,den real(psb_spk_) :: num,den
integer :: ictxt, il integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: il
num = -done num = -done
den = done den = done
@ -264,15 +265,15 @@ contains
subroutine mld_sfile_prec_descr(p,info,iout) subroutine mld_sfile_prec_descr(p,info,iout)
implicit none implicit none
! Arguments ! Arguments
type(mld_sprec_type), intent(in) :: p type(mld_sprec_type), intent(in) :: p
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
! Local variables ! Local variables
integer :: ilev, nlev integer(psb_ipk_) :: ilev, nlev
integer :: ictxt, me, np integer(psb_mpik_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr' character(len=20), parameter :: name='mld_file_prec_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
info = psb_success_ info = psb_success_
if (present(iout)) then if (present(iout)) then
@ -370,10 +371,10 @@ contains
! Arguments ! Arguments
type(mld_sprec_type), intent(inout) :: p type(mld_sprec_type), intent(inout) :: p
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local variables ! Local variables
integer :: me,err_act,i integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name character(len=20) :: name
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
@ -413,10 +414,10 @@ contains
class(mld_sprec_type), intent(inout) :: prec class(mld_sprec_type), intent(inout) :: prec
type(psb_s_vect_type),intent(inout) :: x type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y type(psb_s_vect_type),intent(inout) :: y
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
real(psb_spk_),intent(inout), optional, target :: work(:) real(psb_spk_),intent(inout), optional, target :: work(:)
Integer :: err_act Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply' character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -445,13 +446,13 @@ contains
subroutine mld_s_apply1_vect(prec,x,desc_data,info,trans,work) subroutine mld_s_apply1_vect(prec,x,desc_data,info,trans,work)
implicit none 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 class(mld_sprec_type), intent(inout) :: prec
type(psb_s_vect_type),intent(inout) :: x type(psb_s_vect_type),intent(inout) :: x
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
real(psb_spk_),intent(inout), optional, target :: work(:) real(psb_spk_),intent(inout), optional, target :: work(:)
Integer :: err_act Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply' character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -485,10 +486,10 @@ contains
class(mld_sprec_type), intent(in) :: prec class(mld_sprec_type), intent(in) :: prec
real(psb_spk_),intent(inout) :: x(:) real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:) real(psb_spk_),intent(inout) :: y(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
real(psb_spk_),intent(inout), optional, target :: work(:) real(psb_spk_),intent(inout), optional, target :: work(:)
Integer :: err_act Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply' character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -520,9 +521,9 @@ contains
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
class(mld_sprec_type), intent(in) :: prec class(mld_sprec_type), intent(in) :: prec
real(psb_spk_),intent(inout) :: x(:) real(psb_spk_),intent(inout) :: x(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
Integer :: err_act Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply' character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -553,13 +554,13 @@ contains
subroutine mld_s_dump(prec,info,istart,iend,prefix,head,ac,rp,smoother,solver) subroutine mld_s_dump(prec,info,istart,iend,prefix,head,ac,rp,smoother,solver)
implicit none implicit none
class(mld_sprec_type), intent(in) :: prec class(mld_sprec_type), intent(in) :: prec
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: istart, iend integer(psb_ipk_), intent(in), optional :: istart, iend
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp logical, optional, intent(in) :: smoother, solver,ac, rp
integer :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np integer(psb_mpik_) :: icontxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_ ! len of prefix_
@ -588,8 +589,8 @@ contains
implicit none implicit none
type(mld_sprec_type), intent(inout) :: a type(mld_sprec_type), intent(inout) :: a
type(mld_sprec_type), intent(inout), target :: b type(mld_sprec_type), intent(inout), target :: b
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: i integer(psb_ipk_) :: i
if (allocated(b%precv)) then if (allocated(b%precv)) then
! This might not be required if FINAL procedures are available. ! 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 !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ 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 !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -52,8 +52,8 @@ module mld_z_as_smoother
! class(mld_z_base_solver_type), allocatable :: sv ! class(mld_z_base_solver_type), allocatable :: sv
! !
type(psb_zspmat_type) :: nd type(psb_zspmat_type) :: nd
type(psb_desc_type) :: desc_data type(psb_desc_type) :: desc_data
integer :: novr, restr, prol, nd_nnz_tot integer(psb_ipk_) :: novr, restr, prol, nd_nnz_tot
contains contains
procedure, pass(sm) :: check => mld_z_as_smoother_check procedure, pass(sm) :: check => mld_z_as_smoother_check
procedure, pass(sm) :: dump => mld_z_as_smoother_dmp procedure, pass(sm) :: dump => mld_z_as_smoother_dmp
@ -83,41 +83,44 @@ module mld_z_as_smoother
interface interface
subroutine mld_z_as_smoother_check(sm,info) subroutine mld_z_as_smoother_check(sm,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & 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 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 subroutine mld_z_as_smoother_check
end interface end interface
interface interface
subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_z_as_smoother_type), intent(inout) :: sm class(mld_z_as_smoother_type), intent(inout) :: sm
type(psb_z_vect_type),intent(inout) :: x type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
complex(psb_dpk_),target, intent(inout) :: work(:) complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_as_smoother_apply_vect end subroutine mld_z_as_smoother_apply_vect
end interface end interface
interface interface
subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_z_as_smoother_type), intent(in) :: sm class(mld_z_as_smoother_type), intent(in) :: sm
complex(psb_dpk_),intent(inout) :: x(:) complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:) complex(psb_dpk_),intent(inout) :: y(:)
complex(psb_dpk_),intent(in) :: alpha,beta complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
complex(psb_dpk_),target, intent(inout) :: work(:) 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 subroutine mld_z_as_smoother_apply
end interface 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) 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, & 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_dpk_, mld_z_as_smoother_type, psb_long_int_k_, &
& psb_desc_type, psb_z_base_sparse_mat & psb_desc_type, psb_z_base_sparse_mat, psb_ipk_
type(psb_zspmat_type), intent(in), target :: a 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_as_smoother_type), intent(inout) :: sm class(mld_z_as_smoother_type), intent(inout) :: sm
character, intent(in) :: upd 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_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold class(psb_z_base_vect_type), intent(in), optional :: vmold
end subroutine mld_z_as_smoother_bld end subroutine mld_z_as_smoother_bld
@ -139,52 +143,59 @@ module mld_z_as_smoother
interface interface
subroutine mld_z_as_smoother_seti(sm,what,val,info) subroutine mld_z_as_smoother_seti(sm,what,val,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & 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 class(mld_z_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_as_smoother_seti end subroutine mld_z_as_smoother_seti
end interface end interface
interface interface
subroutine mld_z_as_smoother_setc(sm,what,val,info) subroutine mld_z_as_smoother_setc(sm,what,val,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & 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 class(mld_z_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_as_smoother_setc end subroutine mld_z_as_smoother_setc
end interface end interface
interface interface
subroutine mld_z_as_smoother_setr(sm,what,val,info) subroutine mld_z_as_smoother_setr(sm,what,val,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & 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 class(mld_z_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_as_smoother_setr end subroutine mld_z_as_smoother_setr
end interface end interface
interface interface
subroutine mld_z_as_smoother_free(sm,info) subroutine mld_z_as_smoother_free(sm,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & 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 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 subroutine mld_z_as_smoother_free
end interface end interface
interface interface
subroutine mld_z_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) 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, & 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 class(mld_z_as_smoother_type), intent(in) :: sm
integer, intent(in) :: ictxt,level integer(psb_mpik_), intent(in) :: ictxt
integer, intent(out) :: info integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver
end subroutine mld_z_as_smoother_dmp end subroutine mld_z_as_smoother_dmp
@ -197,7 +208,7 @@ contains
! Arguments ! Arguments
class(mld_z_as_smoother_type), intent(in) :: sm class(mld_z_as_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = psb_sizeof_int val = psb_sizeof_int
if (allocated(sm%sv)) val = val + sm%sv%sizeof() if (allocated(sm%sv)) val = val + sm%sv%sizeof()
@ -210,7 +221,7 @@ contains
implicit none implicit none
class(mld_z_as_smoother_type), intent(in) :: sm class(mld_z_as_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sm%sv)) & if (allocated(sm%sv)) &
& val = sm%sv%get_nzeros() & val = sm%sv%get_nzeros()
@ -247,15 +258,14 @@ contains
! Arguments ! Arguments
class(mld_z_as_smoother_type), intent(in) :: sm class(mld_z_as_smoother_type), intent(in) :: sm
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_z_as_smoother_descr' character(len=20), parameter :: name='mld_z_as_smoother_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
logical :: coarse_ logical :: coarse_
call psb_erractionsave(err_act) 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 interface
subroutine mld_z_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_z_base_smoother_type), intent(in) :: sm class(mld_z_base_smoother_type), intent(in) :: sm
complex(psb_dpk_),intent(inout) :: x(:) complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:) complex(psb_dpk_),intent(inout) :: y(:)
complex(psb_dpk_),intent(in) :: alpha,beta complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
complex(psb_dpk_),target, intent(inout) :: work(:) 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 subroutine mld_z_base_smoother_apply
end interface 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,& subroutine mld_z_base_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
& trans,sweeps,work,info) & trans,sweeps,work,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_z_base_smoother_type), intent(inout) :: sm class(mld_z_base_smoother_type), intent(inout) :: sm
type(psb_z_vect_type),intent(inout) :: x type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
complex(psb_dpk_),target, intent(inout) :: work(:) complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_smoother_apply_vect end subroutine mld_z_base_smoother_apply_vect
end interface end interface
interface interface
subroutine mld_z_base_smoother_check(sm,info) subroutine mld_z_base_smoother_check(sm,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & 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 ! Arguments
class(mld_z_base_smoother_type), intent(inout) :: sm 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 subroutine mld_z_base_smoother_check
end interface end interface
interface interface
subroutine mld_z_base_smoother_seti(sm,what,val,info) subroutine mld_z_base_smoother_seti(sm,what,val,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & 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 ! Arguments
class(mld_z_base_smoother_type), intent(inout) :: sm class(mld_z_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_smoother_seti end subroutine mld_z_base_smoother_seti
end interface end interface
interface interface
subroutine mld_z_base_smoother_setc(sm,what,val,info) subroutine mld_z_base_smoother_setc(sm,what,val,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & 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 class(mld_z_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_smoother_setc end subroutine mld_z_base_smoother_setc
end interface end interface
interface interface
subroutine mld_z_base_smoother_setr(sm,what,val,info) subroutine mld_z_base_smoother_setr(sm,what,val,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & 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 ! Arguments
class(mld_z_base_smoother_type), intent(inout) :: sm class(mld_z_base_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_smoother_setr end subroutine mld_z_base_smoother_setr
end interface end interface
interface interface
subroutine mld_z_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) 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, & 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 ! Arguments
type(psb_zspmat_type), intent(in), target :: a 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_smoother_type), intent(inout) :: sm class(mld_z_base_smoother_type), intent(inout) :: sm
character, intent(in) :: upd 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_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold class(psb_z_base_vect_type), intent(in), optional :: vmold
end subroutine mld_z_base_smoother_bld end subroutine mld_z_base_smoother_bld
@ -211,32 +218,36 @@ module mld_z_base_smoother_mod
interface interface
subroutine mld_z_base_smoother_free(sm,info) subroutine mld_z_base_smoother_free(sm,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & 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 ! Arguments
class(mld_z_base_smoother_type), intent(inout) :: sm 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 subroutine mld_z_base_smoother_free
end interface end interface
interface interface
subroutine mld_z_base_smoother_descr(sm,info,iout,coarse) subroutine mld_z_base_smoother_descr(sm,info,iout,coarse)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & 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 ! Arguments
class(mld_z_base_smoother_type), intent(in) :: sm class(mld_z_base_smoother_type), intent(in) :: sm
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
end subroutine mld_z_base_smoother_descr end subroutine mld_z_base_smoother_descr
end interface end interface
interface interface
subroutine mld_z_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) 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, & 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 class(mld_z_base_smoother_type), intent(in) :: sm
integer, intent(in) :: ictxt,level integer(psb_mpik_), intent(in) :: ictxt
integer, intent(out) :: info integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver logical, optional, intent(in) :: smoother, solver
end subroutine mld_z_base_smoother_dmp end subroutine mld_z_base_smoother_dmp
@ -252,7 +263,7 @@ contains
implicit none implicit none
class(mld_z_base_smoother_type), intent(in) :: sm class(mld_z_base_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sm%sv)) & if (allocated(sm%sv)) &
& val = sm%sv%get_nzeros() & val = sm%sv%get_nzeros()
@ -263,7 +274,7 @@ contains
! Arguments ! Arguments
class(mld_z_base_smoother_type), intent(in) :: sm class(mld_z_base_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sm%sv)) then if (allocated(sm%sv)) then

95
mlprec/mld_z_base_solver_mod.f90
Unescape Escape View File

@ -108,15 +108,17 @@ module mld_z_base_solver_mod
interface interface
subroutine mld_z_base_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_z_base_solver_type), intent(in) :: sv class(mld_z_base_solver_type), intent(in) :: sv
complex(psb_dpk_),intent(inout) :: x(:) complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:) complex(psb_dpk_),intent(inout) :: y(:)
complex(psb_dpk_),intent(in) :: alpha,beta 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(:) 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 subroutine mld_z_base_solver_apply
end interface end interface
@ -124,32 +126,33 @@ module mld_z_base_solver_mod
interface interface
subroutine mld_z_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_z_base_solver_type), intent(inout) :: sv class(mld_z_base_solver_type), intent(inout) :: sv
type(psb_z_vect_type),intent(inout) :: x type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta 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(:) complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_solver_apply_vect end subroutine mld_z_base_solver_apply_vect
end interface end interface
interface interface
subroutine mld_z_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) 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, & 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 Implicit None
! Arguments ! Arguments
type(psb_zspmat_type), intent(in), target :: a 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 class(mld_z_base_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type), intent(in), target, optional :: b type(psb_zspmat_type), intent(in), target, optional :: b
class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold class(psb_z_base_vect_type), intent(in), optional :: vmold
@ -159,84 +162,85 @@ module mld_z_base_solver_mod
interface interface
subroutine mld_z_base_solver_check(sv,info) subroutine mld_z_base_solver_check(sv,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv 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 subroutine mld_z_base_solver_check
end interface end interface
interface interface
subroutine mld_z_base_solver_seti(sv,what,val,info) subroutine mld_z_base_solver_seti(sv,what,val,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv class(mld_z_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_solver_seti end subroutine mld_z_base_solver_seti
end interface end interface
interface interface
subroutine mld_z_base_solver_setc(sv,what,val,info) subroutine mld_z_base_solver_setc(sv,what,val,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv class(mld_z_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_solver_setc end subroutine mld_z_base_solver_setc
end interface end interface
interface interface
subroutine mld_z_base_solver_setr(sv,what,val,info) subroutine mld_z_base_solver_setr(sv,what,val,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv class(mld_z_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_solver_setr end subroutine mld_z_base_solver_setr
end interface end interface
interface interface
subroutine mld_z_base_solver_free(sv,info) subroutine mld_z_base_solver_free(sv,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv 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 subroutine mld_z_base_solver_free
end interface end interface
interface interface
subroutine mld_z_base_solver_descr(sv,info,iout,coarse) subroutine mld_z_base_solver_descr(sv,info,iout,coarse)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & 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 Implicit None
! Arguments ! Arguments
class(mld_z_base_solver_type), intent(in) :: sv class(mld_z_base_solver_type), intent(in) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
end subroutine mld_z_base_solver_descr end subroutine mld_z_base_solver_descr
end interface end interface
@ -244,12 +248,13 @@ module mld_z_base_solver_mod
interface interface
subroutine mld_z_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) 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, & 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 implicit none
class(mld_z_base_solver_type), intent(in) :: sv class(mld_z_base_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level integer(psb_mpik_), intent(in) :: ictxt
integer, intent(out) :: info integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver
end subroutine mld_z_base_solver_dmp end subroutine mld_z_base_solver_dmp
@ -269,7 +274,7 @@ contains
! Arguments ! Arguments
class(mld_z_base_solver_type), intent(in) :: sv class(mld_z_base_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
return return
@ -279,7 +284,7 @@ contains
implicit none implicit none
class(mld_z_base_solver_type), intent(in) :: sv class(mld_z_base_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
end function z_base_solver_get_nzeros 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 !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ 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 !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -73,42 +73,45 @@ module mld_z_diag_solver
interface interface
subroutine mld_z_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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_, &
type(psb_desc_type), intent(in) :: desc_data & mld_z_diag_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_diag_solver_type), intent(inout) :: sv class(mld_z_diag_solver_type), intent(inout) :: sv
type(psb_z_vect_type), intent(inout) :: x type(psb_z_vect_type), intent(inout) :: x
type(psb_z_vect_type), intent(inout) :: y type(psb_z_vect_type), intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta 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(:) complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_diag_solver_apply_vect end subroutine mld_z_diag_solver_apply_vect
end interface end interface
interface interface
subroutine mld_z_diag_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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_, &
type(psb_desc_type), intent(in) :: desc_data & mld_z_diag_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_diag_solver_type), intent(in) :: sv class(mld_z_diag_solver_type), intent(in) :: sv
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
complex(psb_dpk_), intent(inout) :: y(:) complex(psb_dpk_), intent(inout) :: y(:)
complex(psb_dpk_),intent(in) :: alpha,beta 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(:) 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 subroutine mld_z_diag_solver_apply
end interface end interface
interface interface
subroutine mld_z_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) 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, & 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_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 class(mld_z_diag_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type), intent(in), target, optional :: b type(psb_zspmat_type), intent(in), target, optional :: b
class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold class(psb_z_base_vect_type), intent(in), optional :: vmold
@ -125,10 +128,10 @@ contains
! Arguments ! Arguments
class(mld_z_diag_solver_type), intent(inout) :: sv class(mld_z_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act Integer(Psb_ipk_) :: err_act
character(len=20) :: name='z_diag_solver_seti' character(len=20) :: name='z_diag_solver_seti'
info = psb_success_ info = psb_success_
@ -144,10 +147,10 @@ contains
! Arguments ! Arguments
class(mld_z_diag_solver_type), intent(inout) :: sv class(mld_z_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act, ival Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='z_diag_solver_setc' character(len=20) :: name='z_diag_solver_setc'
info = psb_success_ info = psb_success_
@ -161,10 +164,10 @@ contains
! Arguments ! Arguments
class(mld_z_diag_solver_type), intent(inout) :: sv class(mld_z_diag_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act Integer(Psb_ipk_) :: err_act
character(len=20) :: name='z_diag_solver_setr' character(len=20) :: name='z_diag_solver_setr'
info = psb_success_ info = psb_success_
@ -179,9 +182,9 @@ contains
! Arguments ! Arguments
class(mld_z_diag_solver_type), intent(inout) :: sv class(mld_z_diag_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='z_diag_solver_free' character(len=20) :: name='z_diag_solver_free'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -215,15 +218,14 @@ contains
! Arguments ! Arguments
class(mld_z_diag_solver_type), intent(in) :: sv class(mld_z_diag_solver_type), intent(in) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_z_diag_solver_descr' character(len=20), parameter :: name='mld_z_diag_solver_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
info = psb_success_ info = psb_success_
if (present(iout)) then if (present(iout)) then
@ -243,7 +245,7 @@ contains
! Arguments ! Arguments
class(mld_z_diag_solver_type), intent(in) :: sv class(mld_z_diag_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sv%dv)) val = val + sv%dv%sizeof() if (allocated(sv%dv)) val = val + sv%dv%sizeof()
@ -256,7 +258,7 @@ contains
! Arguments ! Arguments
class(mld_z_diag_solver_type), intent(in) :: sv class(mld_z_diag_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sv%dv)) val = val + sv%dv%get_nrows() 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 !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ 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 !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -68,22 +68,24 @@ module mld_z_id_solver
interface interface
subroutine mld_z_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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_, &
type(psb_desc_type), intent(in) :: desc_data & mld_z_id_solver_type, psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_id_solver_type), intent(inout) :: sv class(mld_z_id_solver_type), intent(inout) :: sv
type(psb_z_vect_type),intent(inout) :: x type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta 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(:) complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_id_solver_apply_vect end subroutine mld_z_id_solver_apply_vect
end interface end interface
interface interface
subroutine mld_z_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) 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, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_z_id_solver_type), intent(in) :: sv class(mld_z_id_solver_type), intent(in) :: sv
complex(psb_dpk_),intent(inout) :: x(:) complex(psb_dpk_),intent(inout) :: x(:)
@ -91,7 +93,7 @@ module mld_z_id_solver
complex(psb_dpk_),intent(in) :: alpha,beta 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(:) 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 subroutine mld_z_id_solver_apply
end interface end interface
@ -104,17 +106,17 @@ contains
! Arguments ! Arguments
type(psb_zspmat_type), intent(in), target :: a 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 class(mld_z_id_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type), intent(in), target, optional :: b type(psb_zspmat_type), intent(in), target, optional :: b
class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold class(psb_z_base_vect_type), intent(in), optional :: vmold
! Local variables ! 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(:) 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 character(len=20) :: name='z_id_solver_bld', ch_err
info=psb_success_ info=psb_success_
@ -129,11 +131,11 @@ contains
! Arguments ! Arguments
class(mld_z_id_solver_type), intent(inout) :: sv class(mld_z_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='z_id_solver_seti' character(len=20) :: name='z_id_solver_seti'
info = psb_success_ info = psb_success_
@ -147,11 +149,11 @@ contains
! Arguments ! Arguments
class(mld_z_id_solver_type), intent(inout) :: sv class(mld_z_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act, ival integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='z_id_solver_setc' character(len=20) :: name='z_id_solver_setc'
info = psb_success_ info = psb_success_
@ -164,11 +166,11 @@ contains
! Arguments ! Arguments
class(mld_z_id_solver_type), intent(inout) :: sv class(mld_z_id_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='z_id_solver_setr' character(len=20) :: name='z_id_solver_setr'
info = psb_success_ info = psb_success_
@ -182,9 +184,9 @@ contains
! Arguments ! Arguments
class(mld_z_id_solver_type), intent(inout) :: sv class(mld_z_id_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='z_id_solver_free' character(len=20) :: name='z_id_solver_free'
info = psb_success_ info = psb_success_
@ -197,15 +199,14 @@ contains
! Arguments ! Arguments
class(mld_z_id_solver_type), intent(in) :: sv class(mld_z_id_solver_type), intent(in) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_z_id_solver_descr' character(len=20), parameter :: name='mld_z_id_solver_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
info = psb_success_ info = psb_success_
if (present(iout)) then 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 !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ 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 !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -49,11 +49,11 @@ module mld_z_ilu_solver
use mld_z_ilu_fact_mod use mld_z_ilu_fact_mod
type, extends(mld_z_base_solver_type) :: mld_z_ilu_solver_type 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(:) complex(psb_dpk_), allocatable :: d(:)
type(psb_z_vect_type) :: dv type(psb_z_vect_type) :: dv
integer :: fact_type, fill_in integer(psb_ipk_) :: fact_type, fill_in
real(psb_dpk_) :: thresh real(psb_dpk_) :: thresh
contains contains
procedure, pass(sv) :: dump => mld_z_ilu_solver_dmp procedure, pass(sv) :: dump => mld_z_ilu_solver_dmp
procedure, pass(sv) :: build => mld_z_ilu_solver_bld procedure, pass(sv) :: build => mld_z_ilu_solver_bld
@ -90,42 +90,45 @@ module mld_z_ilu_solver
interface interface
subroutine mld_z_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) 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_, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_z_ilu_solver_type), intent(inout) :: sv class(mld_z_ilu_solver_type), intent(inout) :: sv
type(psb_z_vect_type),intent(inout) :: x type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta 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(:) complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_ilu_solver_apply_vect end subroutine mld_z_ilu_solver_apply_vect
end interface end interface
interface interface
subroutine mld_z_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) 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_, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_z_ilu_solver_type), intent(in) :: sv class(mld_z_ilu_solver_type), intent(in) :: sv
complex(psb_dpk_),intent(inout) :: x(:) complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:) complex(psb_dpk_),intent(inout) :: y(:)
complex(psb_dpk_),intent(in) :: alpha,beta 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(:) 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 subroutine mld_z_ilu_solver_apply
end interface end interface
interface interface
subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) 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_, & 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_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 class(mld_z_ilu_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type), intent(in), target, optional :: b type(psb_zspmat_type), intent(in), target, optional :: b
class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold class(psb_z_base_vect_type), intent(in), optional :: vmold
@ -135,12 +138,15 @@ module mld_z_ilu_solver
interface interface
subroutine mld_z_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) 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_, & 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 class(mld_z_ilu_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level integer(psb_mpik_), intent(in) :: ictxt
integer, intent(out) :: info integer(psb_ipk_), intent(in) :: level
character(len=*), intent(in), optional :: prefix, head integer(psb_ipk_), intent(out) :: info
logical, optional, intent(in) :: solver character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
end subroutine mld_z_ilu_solver_dmp end subroutine mld_z_ilu_solver_dmp
end interface end interface
@ -167,8 +173,8 @@ contains
! Arguments ! Arguments
class(mld_z_ilu_solver_type), intent(inout) :: sv class(mld_z_ilu_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='z_ilu_solver_check' character(len=20) :: name='z_ilu_solver_check'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -180,7 +186,7 @@ contains
select case(sv%fact_type) select case(sv%fact_type)
case(mld_ilu_n_,mld_milu_n_) case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(sv%fill_in,& call mld_check_def(sv%fill_in,&
& 'Level',0,is_legal_ml_lev) & 'Level',izero,is_legal_ml_lev)
case(mld_ilu_t_) case(mld_ilu_t_)
call mld_check_def(sv%thresh,& call mld_check_def(sv%thresh,&
& 'Eps',dzero,is_legal_d_fact_thrs) & 'Eps',dzero,is_legal_d_fact_thrs)
@ -207,10 +213,10 @@ contains
! Arguments ! Arguments
class(mld_z_ilu_solver_type), intent(inout) :: sv class(mld_z_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='z_ilu_solver_seti' character(len=20) :: name='z_ilu_solver_seti'
info = psb_success_ info = psb_success_
@ -244,10 +250,10 @@ contains
! Arguments ! Arguments
class(mld_z_ilu_solver_type), intent(inout) :: sv class(mld_z_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act, ival integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='z_ilu_solver_setc' character(len=20) :: name='z_ilu_solver_setc'
info = psb_success_ info = psb_success_
@ -280,10 +286,10 @@ contains
! Arguments ! Arguments
class(mld_z_ilu_solver_type), intent(inout) :: sv class(mld_z_ilu_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='z_ilu_solver_setr' character(len=20) :: name='z_ilu_solver_setr'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -316,8 +322,8 @@ contains
! Arguments ! Arguments
class(mld_z_ilu_solver_type), intent(inout) :: sv class(mld_z_ilu_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='z_ilu_solver_free' character(len=20) :: name='z_ilu_solver_free'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -353,15 +359,14 @@ contains
! Arguments ! Arguments
class(mld_z_ilu_solver_type), intent(in) :: sv class(mld_z_ilu_solver_type), intent(in) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_z_ilu_solver_descr' character(len=20), parameter :: name='mld_z_ilu_solver_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -399,7 +404,7 @@ contains
! Arguments ! Arguments
class(mld_z_ilu_solver_type), intent(in) :: sv class(mld_z_ilu_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
val = val + sv%dv%get_nrows() val = val + sv%dv%get_nrows()
@ -415,7 +420,7 @@ contains
! Arguments ! Arguments
class(mld_z_ilu_solver_type), intent(in) :: sv class(mld_z_ilu_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 2*psb_sizeof_int + (2*psb_sizeof_dp) val = 2*psb_sizeof_int + (2*psb_sizeof_dp)
val = val + sv%dv%sizeof() 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 interface mld_mlprec_bld
subroutine mld_zmlprec_bld(a,desc_a,prec,info, amold, vmold) subroutine mld_zmlprec_bld(a,desc_a,prec,info, amold, vmold)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, & 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 use mld_z_prec_type, only : mld_zprec_type
implicit none implicit none
type(psb_zspmat_type), intent(in), target :: a 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 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_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold class(psb_z_base_vect_type), intent(in), optional :: vmold
!!$ character, intent(in),optional :: upd !!$ character, intent(in),optional :: upd
@ -66,78 +66,84 @@ module mld_z_inner_mod
interface mld_mlprec_aply interface mld_mlprec_aply
subroutine mld_zmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) 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 use mld_z_prec_type, only : mld_zprec_type
type(psb_desc_type),intent(in) :: desc_data implicit none
type(mld_zprec_type), intent(in) :: p 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(in) :: alpha,beta
complex(psb_dpk_),intent(inout) :: x(:) complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:) complex(psb_dpk_),intent(inout) :: y(:)
character,intent(in) :: trans character,intent(in) :: trans
complex(psb_dpk_),target :: work(:) complex(psb_dpk_),target :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_zmlprec_aply end subroutine mld_zmlprec_aply
subroutine mld_zmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) 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, & 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 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 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) :: x
type(psb_z_vect_type),intent(inout) :: y type(psb_z_vect_type),intent(inout) :: y
character,intent(in) :: trans character,intent(in) :: trans
complex(psb_dpk_),target :: work(:) complex(psb_dpk_),target :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_zmlprec_aply_vect end subroutine mld_zmlprec_aply_vect
end interface mld_mlprec_aply end interface mld_mlprec_aply
interface mld_coarse_bld interface mld_coarse_bld
subroutine mld_zcoarse_bld(a,desc_a,p,info) 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 use mld_z_prec_type, only : mld_z_onelev_type
type(psb_zspmat_type), intent(in), target :: a implicit none
type(psb_desc_type), intent(in), target :: desc_a 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 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 subroutine mld_zcoarse_bld
end interface mld_coarse_bld end interface mld_coarse_bld
interface mld_aggrmap_bld interface mld_aggrmap_bld
subroutine mld_zaggrmap_bld(aggr_type,theta,a,desc_a,ilaggr,nlaggr,info) 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_ use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
integer, intent(in) :: aggr_type implicit none
real(psb_dpk_), intent(in) :: theta integer(psb_ipk_), intent(in) :: aggr_type
real(psb_dpk_), intent(in) :: theta
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:) integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_zaggrmap_bld end subroutine mld_zaggrmap_bld
end interface mld_aggrmap_bld end interface mld_aggrmap_bld
interface mld_dec_map_bld interface mld_dec_map_bld
subroutine mld_z_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info) 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_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_), intent(in) :: theta real(psb_dpk_), intent(in) :: theta
integer, allocatable, intent(out) :: ilaggr(:),nlaggr(:) integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_dec_map_bld end subroutine mld_z_dec_map_bld
end interface mld_dec_map_bld end interface mld_dec_map_bld
interface mld_aggrmat_asb interface mld_aggrmat_asb
subroutine mld_zaggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info) 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 use mld_z_prec_type, only : mld_z_onelev_type
implicit none
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(inout) :: ilaggr(:), nlaggr(:) integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_z_onelev_type), intent(inout), target :: p 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 subroutine mld_zaggrmat_asb
end interface mld_aggrmat_asb end interface mld_aggrmat_asb
@ -145,14 +151,15 @@ module mld_z_inner_mod
abstract interface abstract interface
subroutine mld_zaggrmat_var_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) 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 use mld_z_prec_type, only : mld_z_onelev_type, mld_dml_parms
implicit none
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(inout) :: ilaggr(:), nlaggr(:) integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_dml_parms), intent(inout) :: parms type(mld_dml_parms), intent(inout) :: parms
type(psb_zspmat_type), intent(out) :: ac,op_prol,op_restr 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 subroutine mld_zaggrmat_var_asb
end interface end interface

81
mlprec/mld_z_jac_smoother.f90
Unescape Escape View File

@ -4,7 +4,7 @@
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ 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 !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -52,7 +52,7 @@ module mld_z_jac_smoother
! class(mld_z_base_solver_type), allocatable :: sv ! class(mld_z_base_solver_type), allocatable :: sv
! !
type(psb_zspmat_type) :: nd type(psb_zspmat_type) :: nd
integer :: nnz_nd_tot integer(psb_ipk_) :: nnz_nd_tot
contains contains
procedure, pass(sm) :: build => mld_z_jac_smoother_bld procedure, pass(sm) :: build => mld_z_jac_smoother_bld
procedure, pass(sm) :: apply_v => mld_z_jac_smoother_apply_vect procedure, pass(sm) :: apply_v => mld_z_jac_smoother_apply_vect
@ -76,45 +76,45 @@ module mld_z_jac_smoother
interface interface
subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) 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_, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_z_jac_smoother_type), intent(inout) :: sm class(mld_z_jac_smoother_type), intent(inout) :: sm
type(psb_z_vect_type),intent(inout) :: x type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
complex(psb_dpk_),target, intent(inout) :: work(:) complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_jac_smoother_apply_vect end subroutine mld_z_jac_smoother_apply_vect
end interface end interface
interface interface
subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) 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_, & 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 type(psb_desc_type), intent(in) :: desc_data
class(mld_z_jac_smoother_type), intent(in) :: sm class(mld_z_jac_smoother_type), intent(in) :: sm
complex(psb_dpk_),intent(inout) :: x(:) complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:) complex(psb_dpk_),intent(inout) :: y(:)
complex(psb_dpk_),intent(in) :: alpha,beta complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps integer(psb_ipk_), intent(in) :: sweeps
complex(psb_dpk_),target, intent(inout) :: work(:) 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 subroutine mld_z_jac_smoother_apply
end interface end interface
interface interface
subroutine mld_z_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) 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_, & 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_zspmat_type), intent(in), target :: a 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_jac_smoother_type), intent(inout) :: sm class(mld_z_jac_smoother_type), intent(inout) :: sm
character, intent(in) :: upd 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_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold class(psb_z_base_vect_type), intent(in), optional :: vmold
end subroutine mld_z_jac_smoother_bld end subroutine mld_z_jac_smoother_bld
@ -128,10 +128,10 @@ contains
! Arguments ! Arguments
class(mld_z_jac_smoother_type), intent(inout) :: sm class(mld_z_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act Integer(Psb_ipk_) :: err_act
character(len=20) :: name='z_jac_smoother_seti' character(len=20) :: name='z_jac_smoother_seti'
info = psb_success_ info = psb_success_
@ -164,10 +164,10 @@ contains
! Arguments ! Arguments
class(mld_z_jac_smoother_type), intent(inout) :: sm class(mld_z_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act, ival Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='z_jac_smoother_setc' character(len=20) :: name='z_jac_smoother_setc'
info = psb_success_ info = psb_success_
@ -196,15 +196,14 @@ contains
subroutine z_jac_smoother_setr(sm,what,val,info) subroutine z_jac_smoother_setr(sm,what,val,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_z_jac_smoother_type), intent(inout) :: sm class(mld_z_jac_smoother_type), intent(inout) :: sm
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='z_jac_smoother_setr' character(len=20) :: name='z_jac_smoother_setr'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -234,8 +233,8 @@ contains
! Arguments ! Arguments
class(mld_z_jac_smoother_type), intent(inout) :: sm class(mld_z_jac_smoother_type), intent(inout) :: sm
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='z_jac_smoother_free' character(len=20) :: name='z_jac_smoother_free'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -268,20 +267,18 @@ contains
subroutine z_jac_smoother_descr(sm,info,iout,coarse) subroutine z_jac_smoother_descr(sm,info,iout,coarse)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_z_jac_smoother_type), intent(in) :: sm class(mld_z_jac_smoother_type), intent(in) :: sm
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_z_jac_smoother_descr' character(len=20), parameter :: name='mld_z_jac_smoother_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
logical :: coarse_ logical :: coarse_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -323,7 +320,7 @@ contains
! Arguments ! Arguments
class(mld_z_jac_smoother_type), intent(in) :: sm class(mld_z_jac_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = psb_sizeof_int val = psb_sizeof_int
if (allocated(sm%sv)) val = val + sm%sv%sizeof() if (allocated(sm%sv)) val = val + sm%sv%sizeof()
@ -338,7 +335,7 @@ contains
! Arguments ! Arguments
class(mld_z_jac_smoother_type), intent(in) :: sm class(mld_z_jac_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(sm%sv)) val = val + sm%sv%get_nzeros() 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_base_prec_type
use mld_z_base_smoother_mod use mld_z_base_smoother_mod
use psb_base_mod, only : psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & 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. ! Type: mld_Tonelev_type.
@ -154,86 +154,93 @@ module mld_z_onelev_mod
interface interface
subroutine mld_z_base_onelev_descr(lv,il,nl,info,iout) subroutine mld_z_base_onelev_descr(lv,il,nl,info,iout)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & 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 Implicit None
! Arguments ! Arguments
class(mld_z_onelev_type), intent(in) :: lv class(mld_z_onelev_type), intent(in) :: lv
integer, intent(in) :: il,nl integer(psb_ipk_), intent(in) :: il,nl
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
end subroutine mld_z_base_onelev_descr end subroutine mld_z_base_onelev_descr
end interface end interface
interface interface
subroutine mld_z_base_onelev_free(lv,info) subroutine mld_z_base_onelev_free(lv,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & 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 implicit none
class(mld_z_onelev_type), intent(inout) :: lv 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 subroutine mld_z_base_onelev_free
end interface end interface
interface interface
subroutine mld_z_base_onelev_check(lv,info) subroutine mld_z_base_onelev_check(lv,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & 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 Implicit None
! Arguments ! Arguments
class(mld_z_onelev_type), intent(inout) :: lv 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 subroutine mld_z_base_onelev_check
end interface end interface
interface interface
subroutine mld_z_base_onelev_seti(lv,what,val,info) subroutine mld_z_base_onelev_seti(lv,what,val,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & 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 Implicit None
! Arguments ! Arguments
class(mld_z_onelev_type), intent(inout) :: lv class(mld_z_onelev_type), intent(inout) :: lv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_onelev_seti end subroutine mld_z_base_onelev_seti
end interface end interface
interface interface
subroutine mld_z_base_onelev_setc(lv,what,val,info) subroutine mld_z_base_onelev_setc(lv,what,val,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & 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 Implicit None
! Arguments ! Arguments
class(mld_z_onelev_type), intent(inout) :: lv class(mld_z_onelev_type), intent(inout) :: lv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_onelev_setc end subroutine mld_z_base_onelev_setc
end interface end interface
interface interface
subroutine mld_z_base_onelev_setr(lv,what,val,info) subroutine mld_z_base_onelev_setr(lv,what,val,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & 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 Implicit None
class(mld_z_onelev_type), intent(inout) :: lv class(mld_z_onelev_type), intent(inout) :: lv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_onelev_setr end subroutine mld_z_base_onelev_setr
end interface end interface
interface interface
subroutine mld_z_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,solver) 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, & 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 implicit none
class(mld_z_onelev_type), intent(in) :: lv class(mld_z_onelev_type), intent(in) :: lv
integer, intent(in) :: level integer(psb_ipk_), intent(in) :: level
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: ac, rp, smoother, solver logical, optional, intent(in) :: ac, rp, smoother, solver
end subroutine mld_z_base_onelev_dump end subroutine mld_z_base_onelev_dump
@ -253,7 +260,7 @@ contains
implicit none implicit none
class(mld_z_onelev_type), intent(in) :: lv class(mld_z_onelev_type), intent(in) :: lv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(lv%sm)) & if (allocated(lv%sm)) &
& val = lv%sm%get_nzeros() & val = lv%sm%get_nzeros()
@ -263,7 +270,7 @@ contains
implicit none implicit none
class(mld_z_onelev_type), intent(in) :: lv class(mld_z_onelev_type), intent(in) :: lv
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
val = val + lv%desc_ac%sizeof() val = val + lv%desc_ac%sizeof()
@ -325,7 +332,7 @@ contains
use psb_base_mod use psb_base_mod
implicit none implicit none
type(mld_z_onelev_type), intent(inout) :: a, b type(mld_z_onelev_type), intent(inout) :: a, b
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
call b%free(info) call b%free(info)
b%parms = a%parms 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 interface mld_precinit
subroutine mld_zprecinit(p,ptype,info,nlev) 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 type(mld_zprec_type), intent(inout) :: p
character(len=*), intent(in) :: ptype character(len=*), intent(in) :: ptype
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: nlev integer(psb_ipk_), optional, intent(in) :: nlev
end subroutine mld_zprecinit end subroutine mld_zprecinit
end interface end interface
@ -65,46 +66,46 @@ module mld_z_prec_mod
interface mld_inner_precset interface mld_inner_precset
subroutine mld_zprecsetsm(p,val,info,ilev) subroutine mld_zprecsetsm(p,val,info,ilev)
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
& mld_zprec_type, mld_z_base_smoother_type & mld_zprec_type, mld_z_base_smoother_type, psb_ipk_
type(mld_zprec_type), intent(inout) :: p type(mld_zprec_type), intent(inout) :: p
class(mld_z_base_smoother_type), intent(in) :: val class(mld_z_base_smoother_type), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_zprecsetsm end subroutine mld_zprecsetsm
subroutine mld_zprecsetsv(p,val,info,ilev) subroutine mld_zprecsetsv(p,val,info,ilev)
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
& mld_zprec_type, mld_z_base_solver_type & mld_zprec_type, mld_z_base_solver_type, psb_ipk_
type(mld_zprec_type), intent(inout) :: p type(mld_zprec_type), intent(inout) :: p
class(mld_z_base_solver_type), intent(in) :: val class(mld_z_base_solver_type), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_zprecsetsv end subroutine mld_zprecsetsv
subroutine mld_zprecseti(p,what,val,info,ilev) subroutine mld_zprecseti(p,what,val,info,ilev)
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
& mld_zprec_type & mld_zprec_type, psb_ipk_
type(mld_zprec_type), intent(inout) :: p type(mld_zprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_zprecseti end subroutine mld_zprecseti
subroutine mld_zprecsetr(p,what,val,info,ilev) subroutine mld_zprecsetr(p,what,val,info,ilev)
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
& mld_zprec_type & mld_zprec_type, psb_ipk_
type(mld_zprec_type), intent(inout) :: p type(mld_zprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_zprecsetr end subroutine mld_zprecsetr
subroutine mld_zprecsetc(p,what,string,info,ilev) subroutine mld_zprecsetc(p,what,string,info,ilev)
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
& mld_zprec_type & mld_zprec_type, psb_ipk_
type(mld_zprec_type), intent(inout) :: p type(mld_zprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: string character(len=*), intent(in) :: string
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, optional, intent(in) :: ilev integer(psb_ipk_), optional, intent(in) :: ilev
end subroutine mld_zprecsetc end subroutine mld_zprecsetc
end interface end interface
@ -112,12 +113,12 @@ module mld_z_prec_mod
subroutine mld_zprecbld(a,desc_a,prec,info,amold,vmold) subroutine mld_zprecbld(a,desc_a,prec,info,amold,vmold)
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
& psb_z_base_sparse_mat, psb_z_base_vect_type, & & psb_z_base_sparse_mat, psb_z_base_vect_type, &
& mld_zprec_type & mld_zprec_type, psb_ipk_
implicit none implicit none
type(psb_zspmat_type), intent(in), target :: a 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 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_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold class(psb_z_base_vect_type), intent(in), optional :: vmold
!!$ character, intent(in),optional :: upd !!$ character, intent(in),optional :: upd
@ -129,7 +130,7 @@ contains
subroutine mld_z_iprecsetsm(p,val,info) subroutine mld_z_iprecsetsm(p,val,info)
type(mld_zprec_type), intent(inout) :: p type(mld_zprec_type), intent(inout) :: p
class(mld_z_base_smoother_type), intent(in) :: val 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) call mld_inner_precset(p,val,info)
end subroutine mld_z_iprecsetsm end subroutine mld_z_iprecsetsm
@ -137,34 +138,34 @@ contains
subroutine mld_z_iprecsetsv(p,val,info) subroutine mld_z_iprecsetsv(p,val,info)
type(mld_zprec_type), intent(inout) :: p type(mld_zprec_type), intent(inout) :: p
class(mld_z_base_solver_type), intent(in) :: val 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) call mld_inner_precset(p,val,info)
end subroutine mld_z_iprecsetsv end subroutine mld_z_iprecsetsv
subroutine mld_z_iprecseti(p,what,val,info) subroutine mld_z_iprecseti(p,what,val,info)
type(mld_zprec_type), intent(inout) :: p type(mld_zprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info) call mld_inner_precset(p,what,val,info)
end subroutine mld_z_iprecseti end subroutine mld_z_iprecseti
subroutine mld_z_iprecsetr(p,what,val,info) subroutine mld_z_iprecsetr(p,what,val,info)
type(mld_zprec_type), intent(inout) :: p type(mld_zprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info) call mld_inner_precset(p,what,val,info)
end subroutine mld_z_iprecsetr end subroutine mld_z_iprecsetr
subroutine mld_z_iprecsetc(p,what,val,info) subroutine mld_z_iprecsetc(p,what,val,info)
type(mld_zprec_type), intent(inout) :: p type(mld_zprec_type), intent(inout) :: p
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
call mld_inner_precset(p,what,val,info) call mld_inner_precset(p,what,val,info)
end subroutine mld_z_iprecsetc 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 type, extends(psb_zprec_type) :: mld_zprec_type
integer :: ictxt integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: coarse_aggr_size integer(psb_ipk_) :: coarse_aggr_size
real(psb_dpk_) :: op_complexity=dzero real(psb_dpk_) :: op_complexity=dzero
type(mld_z_onelev_type), allocatable :: precv(:) type(mld_z_onelev_type), allocatable :: precv(:)
@ -121,41 +121,41 @@ module mld_z_prec_type
interface mld_precaply interface mld_precaply
subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work) subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work)
import :: psb_zspmat_type, psb_desc_type, & 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(psb_desc_type),intent(in) :: desc_data
type(mld_zprec_type), intent(inout) :: prec type(mld_zprec_type), intent(inout) :: prec
type(psb_z_vect_type),intent(inout) :: x type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y type(psb_z_vect_type),intent(inout) :: y
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
complex(psb_dpk_),intent(inout), optional, target :: work(:) complex(psb_dpk_),intent(inout), optional, target :: work(:)
end subroutine mld_zprecaply2_vect end subroutine mld_zprecaply2_vect
subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work) subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work)
import :: psb_zspmat_type, psb_desc_type, & 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(psb_desc_type),intent(in) :: desc_data
type(mld_zprec_type), intent(inout) :: prec type(mld_zprec_type), intent(inout) :: prec
type(psb_z_vect_type),intent(inout) :: x type(psb_z_vect_type),intent(inout) :: x
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
complex(psb_dpk_),intent(inout), optional, target :: work(:) complex(psb_dpk_),intent(inout), optional, target :: work(:)
end subroutine mld_zprecaply1_vect end subroutine mld_zprecaply1_vect
subroutine mld_zprecaply(prec,x,y,desc_data,info,trans,work) 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(psb_desc_type),intent(in) :: desc_data
type(mld_zprec_type), intent(in) :: prec type(mld_zprec_type), intent(in) :: prec
complex(psb_dpk_),intent(inout) :: x(:) complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:) complex(psb_dpk_),intent(inout) :: y(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
complex(psb_dpk_),intent(inout), optional, target :: work(:) complex(psb_dpk_),intent(inout), optional, target :: work(:)
end subroutine mld_zprecaply end subroutine mld_zprecaply
subroutine mld_zprecaply1(prec,x,desc_data,info,trans) 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(psb_desc_type),intent(in) :: desc_data
type(mld_zprec_type), intent(in) :: prec type(mld_zprec_type), intent(in) :: prec
complex(psb_dpk_),intent(inout) :: x(:) complex(psb_dpk_),intent(inout) :: x(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
end subroutine mld_zprecaply1 end subroutine mld_zprecaply1
end interface end interface
@ -173,7 +173,7 @@ contains
implicit none implicit none
class(mld_zprec_type), intent(in) :: prec class(mld_zprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
do i=1, size(prec%precv) do i=1, size(prec%precv)
@ -186,7 +186,7 @@ contains
implicit none implicit none
class(mld_zprec_type), intent(in) :: prec class(mld_zprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer(psb_ipk_) :: i
val = 0 val = 0
val = val + psb_sizeof_int val = val + psb_sizeof_int
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
@ -218,7 +218,8 @@ contains
class(mld_zprec_type), intent(inout) :: prec class(mld_zprec_type), intent(inout) :: prec
real(psb_dpk_) :: num,den real(psb_dpk_) :: num,den
integer :: ictxt, il integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: il
num = -done num = -done
den = done den = done
@ -264,15 +265,15 @@ contains
subroutine mld_zfile_prec_descr(p,info,iout) subroutine mld_zfile_prec_descr(p,info,iout)
implicit none implicit none
! Arguments ! Arguments
type(mld_zprec_type), intent(in) :: p type(mld_zprec_type), intent(in) :: p
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
! Local variables ! Local variables
integer :: ilev, nlev integer(psb_ipk_) :: ilev, nlev
integer :: ictxt, me, np integer(psb_mpik_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr' character(len=20), parameter :: name='mld_file_prec_descr'
integer :: iout_ integer(psb_ipk_) :: iout_
info = psb_success_ info = psb_success_
if (present(iout)) then if (present(iout)) then
@ -370,10 +371,10 @@ contains
! Arguments ! Arguments
type(mld_zprec_type), intent(inout) :: p type(mld_zprec_type), intent(inout) :: p
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local variables ! Local variables
integer :: me,err_act,i integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name character(len=20) :: name
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
@ -413,10 +414,10 @@ contains
class(mld_zprec_type), intent(inout) :: prec class(mld_zprec_type), intent(inout) :: prec
type(psb_z_vect_type),intent(inout) :: x type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y type(psb_z_vect_type),intent(inout) :: y
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
complex(psb_dpk_),intent(inout), optional, target :: work(:) complex(psb_dpk_),intent(inout), optional, target :: work(:)
Integer :: err_act Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply' character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -445,13 +446,13 @@ contains
subroutine mld_z_apply1_vect(prec,x,desc_data,info,trans,work) subroutine mld_z_apply1_vect(prec,x,desc_data,info,trans,work)
implicit none 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 class(mld_zprec_type), intent(inout) :: prec
type(psb_z_vect_type),intent(inout) :: x type(psb_z_vect_type),intent(inout) :: x
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
complex(psb_dpk_),intent(inout), optional, target :: work(:) complex(psb_dpk_),intent(inout), optional, target :: work(:)
Integer :: err_act Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply' character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -485,10 +486,10 @@ contains
class(mld_zprec_type), intent(in) :: prec class(mld_zprec_type), intent(in) :: prec
complex(psb_dpk_),intent(inout) :: x(:) complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:) complex(psb_dpk_),intent(inout) :: y(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
complex(psb_dpk_),intent(inout), optional, target :: work(:) complex(psb_dpk_),intent(inout), optional, target :: work(:)
Integer :: err_act Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply' character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -520,9 +521,9 @@ contains
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
class(mld_zprec_type), intent(in) :: prec class(mld_zprec_type), intent(in) :: prec
complex(psb_dpk_),intent(inout) :: x(:) complex(psb_dpk_),intent(inout) :: x(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=1), optional :: trans character(len=1), optional :: trans
Integer :: err_act Integer(psb_ipk_) :: err_act
character(len=20) :: name='d_prec_apply' character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -553,13 +554,13 @@ contains
subroutine mld_z_dump(prec,info,istart,iend,prefix,head,ac,rp,smoother,solver) subroutine mld_z_dump(prec,info,istart,iend,prefix,head,ac,rp,smoother,solver)
implicit none implicit none
class(mld_zprec_type), intent(in) :: prec class(mld_zprec_type), intent(in) :: prec
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: istart, iend integer(psb_ipk_), intent(in), optional :: istart, iend
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp logical, optional, intent(in) :: smoother, solver,ac, rp
integer :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np integer(psb_mpik_) :: icontxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_ ! len of prefix_
@ -588,8 +589,8 @@ contains
implicit none implicit none
type(mld_zprec_type), intent(inout) :: a type(mld_zprec_type), intent(inout) :: a
type(mld_zprec_type), intent(inout), target :: b type(mld_zprec_type), intent(inout), target :: b
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: i integer(psb_ipk_) :: i
if (allocated(b%precv)) then if (allocated(b%precv)) then
! This might not be required if FINAL procedures are available. ! This might not be required if FINAL procedures are available.

Write Preview
Loading…
Cancel
Save