Fix intent for ovrl

Poly-novrl
Salvatore Filippone 8 months ago
parent af3fda9690
commit fcbcb8bf10

@ -106,7 +106,7 @@ module amg_c_ainv_solver
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -230,7 +230,7 @@ module amg_c_as_smoother
& psb_desc_type, psb_c_base_sparse_mat, psb_ipk_,&
& psb_i_base_vect_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -237,7 +237,7 @@ module amg_c_base_smoother_mod
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_base_smoother_type, psb_ipk_, psb_i_base_vect_type
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -170,7 +170,7 @@ module amg_c_base_solver_mod
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -119,7 +119,7 @@ module amg_c_diag_solver
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_diag_solver_type, psb_ipk_, psb_i_base_vect_type
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@ -331,7 +331,7 @@ module amg_c_l1_diag_solver
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_l1_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -181,7 +181,7 @@ module amg_c_gs_solver
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_gs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@ -195,7 +195,7 @@ module amg_c_gs_solver
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_bwgs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -123,7 +123,7 @@ contains
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_id_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -144,7 +144,7 @@ module amg_c_ilu_solver
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_ilu_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -94,7 +94,7 @@ module amg_c_invk_solver
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_invk_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -94,7 +94,7 @@ module amg_c_invt_solver
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_invt_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -151,7 +151,7 @@ module amg_c_jac_smoother
import :: psb_desc_type, amg_c_jac_smoother_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
@ -274,7 +274,7 @@ module amg_c_jac_smoother
import :: psb_desc_type, amg_c_l1_jac_smoother_type, psb_c_vect_type, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_l1_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -143,7 +143,7 @@ module amg_c_jac_solver
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@ -160,7 +160,7 @@ module amg_c_jac_solver
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_l1_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -174,7 +174,7 @@ module amg_c_krm_solver
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_krm_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -163,7 +163,7 @@ module amg_c_mumps_solver
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_mumps_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -256,7 +256,7 @@ contains
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_slu_solver_type), intent(inout) :: sv
integer, intent(out) :: info

@ -106,7 +106,7 @@ module amg_d_ainv_solver
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -230,7 +230,7 @@ module amg_d_as_smoother
& psb_desc_type, psb_d_base_sparse_mat, psb_ipk_,&
& psb_i_base_vect_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -237,7 +237,7 @@ module amg_d_base_smoother_mod
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_base_smoother_type, psb_ipk_, psb_i_base_vect_type
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -170,7 +170,7 @@ module amg_d_base_solver_mod
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -119,7 +119,7 @@ module amg_d_diag_solver
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_diag_solver_type, psb_ipk_, psb_i_base_vect_type
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@ -331,7 +331,7 @@ module amg_d_l1_diag_solver
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_l1_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -181,7 +181,7 @@ module amg_d_gs_solver
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_gs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@ -195,7 +195,7 @@ module amg_d_gs_solver
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_bwgs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -123,7 +123,7 @@ contains
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_id_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -144,7 +144,7 @@ module amg_d_ilu_solver
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_ilu_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -94,7 +94,7 @@ module amg_d_invk_solver
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_invk_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -94,7 +94,7 @@ module amg_d_invt_solver
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_invt_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -151,7 +151,7 @@ module amg_d_jac_smoother
import :: psb_desc_type, amg_d_jac_smoother_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
@ -274,7 +274,7 @@ module amg_d_jac_smoother
import :: psb_desc_type, amg_d_l1_jac_smoother_type, psb_d_vect_type, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_l1_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -143,7 +143,7 @@ module amg_d_jac_solver
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@ -160,7 +160,7 @@ module amg_d_jac_solver
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_l1_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -174,7 +174,7 @@ module amg_d_krm_solver
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_krm_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -163,7 +163,7 @@ module amg_d_mumps_solver
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_mumps_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -140,7 +140,7 @@ module amg_d_poly_smoother
import :: psb_desc_type, amg_d_poly_smoother_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_poly_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -256,7 +256,7 @@ contains
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_slu_solver_type), intent(inout) :: sv
integer, intent(out) :: info

@ -259,7 +259,7 @@ contains
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_sludist_solver_type), intent(inout) :: sv
integer, intent(out) :: info

@ -259,7 +259,7 @@ contains
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_umf_solver_type), intent(inout) :: sv
integer, intent(out) :: info

@ -106,7 +106,7 @@ module amg_s_ainv_solver
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -230,7 +230,7 @@ module amg_s_as_smoother
& psb_desc_type, psb_s_base_sparse_mat, psb_ipk_,&
& psb_i_base_vect_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -237,7 +237,7 @@ module amg_s_base_smoother_mod
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_base_smoother_type, psb_ipk_, psb_i_base_vect_type
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -170,7 +170,7 @@ module amg_s_base_solver_mod
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -119,7 +119,7 @@ module amg_s_diag_solver
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_diag_solver_type, psb_ipk_, psb_i_base_vect_type
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@ -331,7 +331,7 @@ module amg_s_l1_diag_solver
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_l1_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -181,7 +181,7 @@ module amg_s_gs_solver
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_gs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@ -195,7 +195,7 @@ module amg_s_gs_solver
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_bwgs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -123,7 +123,7 @@ contains
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_id_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -144,7 +144,7 @@ module amg_s_ilu_solver
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_ilu_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -94,7 +94,7 @@ module amg_s_invk_solver
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_invk_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -94,7 +94,7 @@ module amg_s_invt_solver
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_invt_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -151,7 +151,7 @@ module amg_s_jac_smoother
import :: psb_desc_type, amg_s_jac_smoother_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
@ -274,7 +274,7 @@ module amg_s_jac_smoother
import :: psb_desc_type, amg_s_l1_jac_smoother_type, psb_s_vect_type, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_l1_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -143,7 +143,7 @@ module amg_s_jac_solver
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@ -160,7 +160,7 @@ module amg_s_jac_solver
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_l1_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -174,7 +174,7 @@ module amg_s_krm_solver
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_krm_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -163,7 +163,7 @@ module amg_s_mumps_solver
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_mumps_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -140,7 +140,7 @@ module amg_s_poly_smoother
import :: psb_desc_type, amg_s_poly_smoother_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_poly_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -256,7 +256,7 @@ contains
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_slu_solver_type), intent(inout) :: sv
integer, intent(out) :: info

@ -106,7 +106,7 @@ module amg_z_ainv_solver
Implicit None
! Arguments
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -230,7 +230,7 @@ module amg_z_as_smoother
& psb_desc_type, psb_z_base_sparse_mat, psb_ipk_,&
& psb_i_base_vect_type
implicit none
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -237,7 +237,7 @@ module amg_z_base_smoother_mod
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& amg_z_base_smoother_type, psb_ipk_, psb_i_base_vect_type
! Arguments
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -170,7 +170,7 @@ module amg_z_base_solver_mod
Implicit None
! Arguments
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -119,7 +119,7 @@ module amg_z_diag_solver
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& amg_z_diag_solver_type, psb_ipk_, psb_i_base_vect_type
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@ -331,7 +331,7 @@ module amg_z_l1_diag_solver
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& amg_z_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_l1_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -181,7 +181,7 @@ module amg_z_gs_solver
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_gs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@ -195,7 +195,7 @@ module amg_z_gs_solver
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_bwgs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -123,7 +123,7 @@ contains
Implicit None
! Arguments
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_id_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -144,7 +144,7 @@ module amg_z_ilu_solver
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_ilu_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -94,7 +94,7 @@ module amg_z_invk_solver
Implicit None
! Arguments
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_invk_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -94,7 +94,7 @@ module amg_z_invt_solver
Implicit None
! Arguments
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_invt_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -151,7 +151,7 @@ module amg_z_jac_smoother
import :: psb_desc_type, amg_z_jac_smoother_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
@ -274,7 +274,7 @@ module amg_z_jac_smoother
import :: psb_desc_type, amg_z_l1_jac_smoother_type, psb_z_vect_type, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_l1_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -143,7 +143,7 @@ module amg_z_jac_solver
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@ -160,7 +160,7 @@ module amg_z_jac_solver
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_l1_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -174,7 +174,7 @@ module amg_z_krm_solver
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_krm_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -163,7 +163,7 @@ module amg_z_mumps_solver
Implicit None
! Arguments
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_mumps_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -256,7 +256,7 @@ contains
Implicit None
! Arguments
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_slu_solver_type), intent(inout) :: sv
integer, intent(out) :: info

@ -259,7 +259,7 @@ contains
Implicit None
! Arguments
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_sludist_solver_type), intent(inout) :: sv
integer, intent(out) :: info

@ -259,7 +259,7 @@ contains
Implicit None
! Arguments
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_umf_solver_type), intent(inout) :: sv
integer, intent(out) :: info

@ -230,6 +230,7 @@ subroutine amg_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
character :: trans_
real(psb_dpk_) :: beta_
logical :: do_alloc_wrk
logical, parameter :: log_dbg=.false.
type(amg_dmlprec_wrk_type), allocatable, target :: mlprec_wrk(:)
name='amg_dmlprec_aply'
@ -273,6 +274,8 @@ subroutine amg_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
goto 9999
end if
if (log_dbg) write(debug_unit,*) 'mlprec 0:',&
& psb_genrm2(vx2l,base_desc,info)
do isweep = 1, p%outer_sweeps - 1
!
! With the current implementation, y2l is zeroed internally at first smoother.
@ -305,7 +308,9 @@ subroutine amg_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
! call p%wrk(level)%vy2l%zero()
!
call inner_ml_aply(level,p,trans_,work,info)
if (log_dbg) write(debug_unit,*) 'mlprec e:',&
& psb_genrm2(vy2l,base_desc,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Inner prec aply')
@ -591,6 +596,9 @@ contains
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
logical, parameter :: do_timings=.true.
logical, parameter :: log_dbg=.false.
integer(psb_ipk_), save :: ml_mlt_smth=-1, ml_mlt_rp=-1, ml_mlt_rsd=-1
name = 'inner_inner_mult'
info = psb_success_
@ -608,6 +616,12 @@ contains
if(debug_level > 1) then
write(debug_unit,*) me,' inner_mult at level ',level
end if
if ((do_timings).and.(ml_mlt_smth==-1)) &
& ml_mlt_smth = psb_get_timer_idx("ML-MLT: smoother ")
if ((do_timings).and.(ml_mlt_rp==-1)) &
& ml_mlt_rp = psb_get_timer_idx("ML-MLT: RestProl")
if ((do_timings).and.(ml_mlt_rsd==-1)) &
& ml_mlt_rsd = psb_get_timer_idx("ML-MLT: Residual")
sweeps_post = p%precv(level)%parms%sweeps_post
sweeps_pre = p%precv(level)%parms%sweeps_pre
@ -623,7 +637,10 @@ contains
! Apply the first smoother
! The residual has been prepared before the recursive call.
!
if (log_dbg) write(debug_unit,*) 'mlprec 1:',level,&
& psb_genrm2(vx2l,base_desc,info)
if (do_timings) call psb_tic(ml_mlt_smth)
if (pre) then
if (me >=0) then
!!$ write(0,*) me,'Applying smoother pre ', level
@ -646,10 +663,15 @@ contains
end if
end if
endif
if (do_timings) call psb_toc(ml_mlt_smth)
if (log_dbg) write(debug_unit,*) 'mlprec 2:',level,&
& psb_genrm2(vy2l,base_desc,info)
!
! Compute the residual for next level and call recursively
!
if (pre) then
if (do_timings) call psb_tic(ml_mlt_rsd)
call psb_geaxpby(done,vx2l,&
& dzero,vty,&
& base_desc,info)
@ -657,6 +679,12 @@ contains
if (info == psb_success_) call psb_spmm(-done,base_a,&
& vy2l,done,vty,&
& base_desc,info,work=work,trans=trans)
if (do_timings) call psb_toc(ml_mlt_rsd)
if (log_dbg) write(debug_unit,*) 'mlprec 3:',level,&
& psb_genrm2(vty,base_desc,info)
if (do_timings) call psb_tic(ml_mlt_rp)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
@ -671,7 +699,9 @@ contains
& a_err='Error during restriction')
goto 9999
end if
if (do_timings) call psb_toc(ml_mlt_rp)
else
if (do_timings) call psb_tic(ml_mlt_rp)
! Shortcut: just transfer x2l.
call p%precv(level+1)%map_rstr(done,vx2l,&
& dzero,p%precv(level+1)%wrk%vx2l,&
@ -682,6 +712,7 @@ contains
& a_err='Error during restriction')
goto 9999
end if
if (do_timings) call psb_toc(ml_mlt_rp)
endif
call inner_ml_aply(level+1,p,trans,work,info)
@ -689,18 +720,22 @@ contains
!
! Apply the prolongator
!
if (do_timings) call psb_tic(ml_mlt_rp)
call p%precv(level+1)%map_prol(done,&
& p%precv(level+1)%wrk%vy2l,done,vy2l,&
& info,work=work,&
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
if (do_timings) call psb_toc(ml_mlt_rp)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
if (log_dbg) write(debug_unit,*) 'mlprec 5:',level,&
& psb_genrm2(vy2l,base_desc,info)
if (p%precv(level)%parms%ml_cycle == amg_wcycle_ml_) then
if (do_timings) call psb_tic(ml_mlt_rsd)
if (me >=0) then
call psb_geaxpby(done,vx2l, dzero,vty,&
& base_desc,info)
@ -708,10 +743,13 @@ contains
& vy2l,done,vty,&
& base_desc,info,work=work,trans=trans)
end if
if (do_timings) call psb_toc(ml_mlt_rsd)
if (do_timings) call psb_tic(ml_mlt_rp)
if (info == psb_success_) &
& call p%precv(level+1)%map_rstr(done,vty,&
& dzero,p%precv(level+1)%wrk%vx2l,info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
if (do_timings) call psb_toc(ml_mlt_rp)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during W-cycle restriction')
@ -720,10 +758,12 @@ contains
call inner_ml_aply(level+1,p,trans,work,info)
if (do_timings) call psb_tic(ml_mlt_rp)
if (info == psb_success_) call p%precv(level+1)%map_prol(done, &
& p%precv(level+1)%wrk%vy2l,done,vy2l,&
& info,work=work,&
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
if (do_timings) call psb_toc(ml_mlt_rp)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
@ -736,6 +776,7 @@ contains
if (post) then
if (me >=0) then
if (do_timings) call psb_tic(ml_mlt_rsd)
call psb_geaxpby(done,vx2l,&
& dzero,vty,&
& base_desc,info)
@ -747,7 +788,9 @@ contains
& a_err='Error during residue')
goto 9999
end if
if (do_timings) call psb_toc(ml_mlt_rsd)
if (do_timings) call psb_tic(ml_mlt_smth)
!
! Apply the second smoother
!
@ -762,7 +805,10 @@ contains
& vty,done,vy2l, base_desc, trans,&
& sweeps,work,wv,info,init='Z')
end if
if (do_timings) call psb_toc(ml_mlt_smth)
end if
if (log_dbg) write(debug_unit,*) 'mlprec 6:',level,&
& psb_genrm2(vty,base_desc,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
@ -774,12 +820,16 @@ contains
else if (level == nlev) then
!!$ write(0,*) me,'Applying smoother at top level ',psb_errstatus_fatal()
if (do_timings) call psb_tic(ml_mlt_smth)
if (me >=0) then
sweeps = p%precv(level)%parms%sweeps_pre
if (info == psb_success_) call p%precv(level)%sm%apply(done,&
& vx2l,dzero,vy2l,base_desc, trans,&
& sweeps,work,wv,info)
end if
if (do_timings) call psb_toc(ml_mlt_smth)
if (log_dbg) write(debug_unit,*) 'mlprec 7:',level,&
& psb_genrm2(vy2l,base_desc,info)
!!$ write(0,*) me,' Done applying smoother at top level ',psb_errstatus_fatal()
else

@ -89,7 +89,7 @@ subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi
if (present(global)) then
global_ = global
else
global_ = .false.
global_ = .true.
end if
if (present(prefix)) then

@ -89,7 +89,7 @@ subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi
if (present(global)) then
global_ = global
else
global_ = .false.
global_ = .true.
end if
if (present(prefix)) then

@ -89,7 +89,7 @@ subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi
if (present(global)) then
global_ = global
else
global_ = .false.
global_ = .true.
end if
if (present(prefix)) then

@ -89,7 +89,7 @@ subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefi
if (present(global)) then
global_ = global
else
global_ = .false.
global_ = .true.
end if
if (present(prefix)) then

@ -42,7 +42,7 @@ subroutine amg_c_as_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -42,7 +42,7 @@ subroutine amg_c_base_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -43,7 +43,7 @@ subroutine amg_c_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -43,7 +43,7 @@ subroutine amg_c_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_l1_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -42,7 +42,7 @@ subroutine amg_d_as_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -42,7 +42,7 @@ subroutine amg_d_base_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -64,6 +64,7 @@ subroutine amg_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
character :: trans_, init_
real(psb_dpk_) :: res, resdenum
character(len=20) :: name='d_jac_smoother_apply_v'
logical, parameter :: log_dbg=.false.
call psb_erractionsave(err_act)
@ -159,6 +160,8 @@ subroutine amg_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
& a_err='wrong init to smoother_apply')
goto 9999
end select
if (log_dbg) write(0,*) 'smoother jac 1 :',&
& psb_genrm2(ty,desc_data,info)
do i=1, sweeps-1
!

@ -43,7 +43,7 @@ subroutine amg_d_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -43,7 +43,7 @@ subroutine amg_d_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_l1_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -36,7 +36,7 @@
!
!
subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
& sweeps,work,wv,info,init,initu)
& sweeps,work,wv,info,init,initu)
use psb_base_mod
use amg_d_diag_solver
@ -55,6 +55,10 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu
! Timers
logical, parameter :: do_timings=.true.
integer(psb_ipk_), save :: poly_1=-1, poly_2=-1, poly_3=-1
integer(psb_ipk_), save :: poly_mv=-1, poly_sv=-1, poly_vect=-1
!
integer(psb_ipk_) :: n_row,n_col
type(psb_d_vect_type) :: tx, ty, tz, r
@ -92,7 +96,19 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
call psb_errpush(info,name)
goto 9999
end if
if ((do_timings).and.(poly_1==-1)) &
& poly_1 = psb_get_timer_idx("POLY: Chebychev4")
if ((do_timings).and.(poly_2==-1)) &
& poly_2 = psb_get_timer_idx("POLY: OptChebychev4")
if ((do_timings).and.(poly_3==-1)) &
& poly_3 = psb_get_timer_idx("POLY: OptChebychev1")
if ((do_timings).and.(poly_mv==-1)) &
& poly_mv = psb_get_timer_idx("POLY: spMV")
if ((do_timings).and.(poly_vect==-1)) &
& poly_vect = psb_get_timer_idx("POLY: Vectors")
if ((do_timings).and.(poly_sv==-1)) &
& poly_sv = psb_get_timer_idx("POLY: solver")
n_row = desc_data%get_local_rows()
n_col = desc_data%get_local_cols()
@ -125,38 +141,39 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
select case(sm%variant)
case(amg_poly_lottes_)
if (do_timings) call psb_tic(poly_1)
block
real(psb_dpk_) :: cz, cr
! b == x
! x == tx
!
do i=1, sm%pdegree
do i=1, sm%pdegree-1
! B r_{k-1}
call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
if (do_timings) call psb_tic(poly_sv)
call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z') ! ty = M^{-1} r
if (do_timings) call psb_toc(poly_sv)
cz = (2*i*done-3)/(2*i*done+done)
cr = (8*i*done-4)/((2*i*done+done)*sm%rho_ba)
if (.false.) then
! z_k = cz z_{k-1} + cr ty = cz z_{k-1} + cr Br_{k-1}
call psb_geaxpby(cr,ty,cz,tz,desc_data,info)
! r_k = b-Ax_k = x -A tx
call psb_geaxpby(done,tz,done,tx,desc_data,info)
else
call psb_abgdxyz(cr,cz,done,done,ty,tz,tx,desc_data,info)
end if
if (.false.) then
call psb_geaxpby(done,x,dzero,r,desc_data,info)
call psb_spmm(-done,sm%pa,tx,done,r,desc_data,info,work=aux,trans=trans_)
else
call psb_spmm(-done,sm%pa,tz,done,r,desc_data,info,work=aux,trans=trans_)
end if
!!$ res = psb_genrm2(r,desc_data,info)
!!$ write(0,*) 'Polynomial smoother LOTTES',i,res
! x_k = x_{k-1} + z_k
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz(cr,cz,done,done,ty,tz,tx,desc_data,info) ! zk = cz * zk-1 + cr * rk-1
if (do_timings) call psb_toc(poly_vect)
if (do_timings) call psb_tic(poly_mv)
call psb_spmm(-done,sm%pa,tz,done,r,desc_data,info,work=aux,trans=trans_)
if (do_timings) call psb_toc(poly_mv)
end do
if (do_timings) call psb_tic(poly_sv)
call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z') ! ty = M^{-1} r
if (do_timings) call psb_toc(poly_sv)
cz = (2*sm%pdegree*done-3)/(2*sm%pdegree*done+done)
cr = (8*sm%pdegree*done-4)/((2*sm%pdegree*done+done)*sm%rho_ba)
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz(cr,cz,done,done,ty,tz,tx,desc_data,info)
if (do_timings) call psb_toc(poly_vect)
end block
if (do_timings) call psb_toc(poly_1)
case(amg_poly_lottes_beta_)
if (do_timings) call psb_tic(poly_2)
block
real(psb_dpk_) :: cz, cr
! b == x
@ -170,32 +187,30 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
sm%poly_beta(1:sm%pdegree) = amg_d_poly_beta_mat(1:sm%pdegree,sm%pdegree)
end if
do i=1, sm%pdegree
do i=1, sm%pdegree-1
! B r_{k-1}
if (do_timings) call psb_tic(poly_sv)
call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
if (do_timings) call psb_toc(poly_sv)
cz = (2*i*done-3)/(2*i*done+done)
cr = (8*i*done-4)/((2*i*done+done)*sm%rho_ba)
if (.false.) then
! z_k = cz z_{k-1} + cr ty = cz z_{k-1} + cr Br_{k-1}
call psb_geaxpby(cr,ty,cz,tz,desc_data,info)
! r_k = b-Ax_k = x -A tx
call psb_geaxpby(sm%poly_beta(i),tz,done,tx,desc_data,info)
else
call psb_abgdxyz(cr,cz,sm%poly_beta(i),done,ty,tz,tx,desc_data,info)
end if
if (.false.) then
call psb_geaxpby(done,x,dzero,r,desc_data,info)
call psb_spmm(-done,sm%pa,tx,done,r,desc_data,info,work=aux,trans=trans_)
else
call psb_spmm(-done,sm%pa,tz,done,r,desc_data,info,work=aux,trans=trans_)
end if
!!$ res = psb_genrm2(r,desc_data,info)
!!$ write(0,*) 'Polynomial smoother LOTTES_BETA',i,res
! x_k = x_{k-1} + z_k
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz(cr,cz,sm%poly_beta(i),done,ty,tz,tx,desc_data,info)
if (do_timings) call psb_toc(poly_vect)
if (do_timings) call psb_tic(poly_mv)
call psb_spmm(-done,sm%pa,tz,done,r,desc_data,info,work=aux,trans=trans_)
if (do_timings) call psb_toc(poly_mv)
end do
call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
cz = (2*sm%pdegree*done-3)/(2*sm%pdegree*done+done)
cr = (8*sm%pdegree*done-4)/((2*sm%pdegree*done+done)*sm%rho_ba)
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz(cr,cz,sm%poly_beta(sm%pdegree),done,ty,tz,tx,desc_data,info)
if (do_timings) call psb_toc(poly_vect)
end block
if (do_timings) call psb_toc(poly_2)
case(amg_poly_new_)
if (do_timings) call psb_tic(poly_3)
block
real(psb_dpk_) :: sigma, theta, delta, rho_old, rho
! b == x
@ -206,40 +221,35 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
delta = (done-sm%cf_a)/2
sigma = theta/delta
rho_old = done/sigma
if (do_timings) call psb_tic(poly_sv)
call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
if (do_timings) call psb_toc(poly_sv)
call psb_geaxpby((done/sm%rho_ba),ty,dzero,r,desc_data,info)
if (.false.) then
call psb_geaxpby((done/theta),r,dzero,tz,desc_data,info)
call psb_geaxpby(done,tz,done,tx,desc_data,info)
else
call psb_abgdxyz((done/theta),dzero,done,done,r,tz,tx,desc_data,info)
end if
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz((done/theta),dzero,done,done,r,tz,tx,desc_data,info)
if (do_timings) call psb_toc(poly_vect)
! tz == d
do i=1, sm%pdegree-1
!
!
!
! r_{k-1} = r_k - (1/rho(BA)) B A d_k
if (do_timings) call psb_tic(poly_mv)
call psb_spmm(done,sm%pa,tz,dzero,ty,desc_data,info,work=aux,trans=trans_)
if (do_timings) call psb_toc(poly_mv)
if (do_timings) call psb_tic(poly_sv)
call sm%sv%apply(-(done/sm%rho_ba),ty,done,r,desc_data,trans_,aux,wv(5:),info,init='Z')
if (do_timings) call psb_toc(poly_sv)
!
! d_{k+1} = (rho rho_old) d_k + 2(rho/delta) r_{k+1}
rho = done/(2*sigma - rho_old)
if (.false.) then
call psb_geaxpby((2*rho/delta),r,(rho*rho_old),tz,desc_data,info)
call psb_geaxpby(done,tz,done,tx,desc_data,info)
else
call psb_abgdxyz((2*rho/delta),(rho*rho_old),done,done,r,tz,tx,desc_data,info)
end if
!!$ res = psb_genrm2(r,desc_data,info)
!!$ write(0,*) 'Polynomial smoother NEW ',i,res
! x_k = x_{k-1} + z_k
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz((2*rho/delta),(rho*rho_old),done,done,r,tz,tx,desc_data,info)
if (do_timings) call psb_toc(poly_vect)
rho_old = rho
end do
end block
if (do_timings) call psb_toc(poly_3)
case default
info=psb_err_internal_error_
call psb_errpush(info,name,&

@ -45,7 +45,7 @@ subroutine amg_d_poly_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_poly_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -42,7 +42,7 @@ subroutine amg_s_as_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -42,7 +42,7 @@ subroutine amg_s_base_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -43,7 +43,7 @@ subroutine amg_s_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -43,7 +43,7 @@ subroutine amg_s_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_l1_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -36,7 +36,7 @@
!
!
subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
& sweeps,work,wv,info,init,initu)
& sweeps,work,wv,info,init,initu)
use psb_base_mod
use amg_s_diag_solver
@ -55,6 +55,10 @@ subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_s_vect_type),intent(inout), optional :: initu
! Timers
logical, parameter :: do_timings=.true.
integer(psb_ipk_), save :: poly_1=-1, poly_2=-1, poly_3=-1
integer(psb_ipk_), save :: poly_mv=-1, poly_sv=-1, poly_vect=-1
!
integer(psb_ipk_) :: n_row,n_col
type(psb_s_vect_type) :: tx, ty, tz, r
@ -92,7 +96,19 @@ subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
call psb_errpush(info,name)
goto 9999
end if
if ((do_timings).and.(poly_1==-1)) &
& poly_1 = psb_get_timer_idx("POLY: Chebychev4")
if ((do_timings).and.(poly_2==-1)) &
& poly_2 = psb_get_timer_idx("POLY: OptChebychev4")
if ((do_timings).and.(poly_3==-1)) &
& poly_3 = psb_get_timer_idx("POLY: OptChebychev1")
if ((do_timings).and.(poly_mv==-1)) &
& poly_mv = psb_get_timer_idx("POLY: spMV")
if ((do_timings).and.(poly_vect==-1)) &
& poly_vect = psb_get_timer_idx("POLY: Vectors")
if ((do_timings).and.(poly_sv==-1)) &
& poly_sv = psb_get_timer_idx("POLY: solver")
n_row = desc_data%get_local_rows()
n_col = desc_data%get_local_cols()
@ -125,38 +141,39 @@ subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
select case(sm%variant)
case(amg_poly_lottes_)
if (do_timings) call psb_tic(poly_1)
block
real(psb_spk_) :: cz, cr
! b == x
! x == tx
!
do i=1, sm%pdegree
do i=1, sm%pdegree-1
! B r_{k-1}
call sm%sv%apply(sone,r,szero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
if (do_timings) call psb_tic(poly_sv)
call sm%sv%apply(sone,r,szero,ty,desc_data,trans_,aux,wv(5:),info,init='Z') ! ty = M^{-1} r
if (do_timings) call psb_toc(poly_sv)
cz = (2*i*sone-3)/(2*i*sone+sone)
cr = (8*i*sone-4)/((2*i*sone+sone)*sm%rho_ba)
if (.false.) then
! z_k = cz z_{k-1} + cr ty = cz z_{k-1} + cr Br_{k-1}
call psb_geaxpby(cr,ty,cz,tz,desc_data,info)
! r_k = b-Ax_k = x -A tx
call psb_geaxpby(sone,tz,sone,tx,desc_data,info)
else
call psb_abgdxyz(cr,cz,sone,sone,ty,tz,tx,desc_data,info)
end if
if (.false.) then
call psb_geaxpby(sone,x,szero,r,desc_data,info)
call psb_spmm(-sone,sm%pa,tx,sone,r,desc_data,info,work=aux,trans=trans_)
else
call psb_spmm(-sone,sm%pa,tz,sone,r,desc_data,info,work=aux,trans=trans_)
end if
!!$ res = psb_genrm2(r,desc_data,info)
!!$ write(0,*) 'Polynomial smoother LOTTES',i,res
! x_k = x_{k-1} + z_k
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz(cr,cz,sone,sone,ty,tz,tx,desc_data,info) ! zk = cz * zk-1 + cr * rk-1
if (do_timings) call psb_toc(poly_vect)
if (do_timings) call psb_tic(poly_mv)
call psb_spmm(-sone,sm%pa,tz,sone,r,desc_data,info,work=aux,trans=trans_)
if (do_timings) call psb_toc(poly_mv)
end do
if (do_timings) call psb_tic(poly_sv)
call sm%sv%apply(sone,r,szero,ty,desc_data,trans_,aux,wv(5:),info,init='Z') ! ty = M^{-1} r
if (do_timings) call psb_toc(poly_sv)
cz = (2*sm%pdegree*sone-3)/(2*sm%pdegree*sone+sone)
cr = (8*sm%pdegree*sone-4)/((2*sm%pdegree*sone+sone)*sm%rho_ba)
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz(cr,cz,sone,sone,ty,tz,tx,desc_data,info)
if (do_timings) call psb_toc(poly_vect)
end block
if (do_timings) call psb_toc(poly_1)
case(amg_poly_lottes_beta_)
if (do_timings) call psb_tic(poly_2)
block
real(psb_spk_) :: cz, cr
! b == x
@ -170,32 +187,30 @@ subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
sm%poly_beta(1:sm%pdegree) = amg_d_poly_beta_mat(1:sm%pdegree,sm%pdegree)
end if
do i=1, sm%pdegree
do i=1, sm%pdegree-1
! B r_{k-1}
if (do_timings) call psb_tic(poly_sv)
call sm%sv%apply(sone,r,szero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
if (do_timings) call psb_toc(poly_sv)
cz = (2*i*sone-3)/(2*i*sone+sone)
cr = (8*i*sone-4)/((2*i*sone+sone)*sm%rho_ba)
if (.false.) then
! z_k = cz z_{k-1} + cr ty = cz z_{k-1} + cr Br_{k-1}
call psb_geaxpby(cr,ty,cz,tz,desc_data,info)
! r_k = b-Ax_k = x -A tx
call psb_geaxpby(sm%poly_beta(i),tz,sone,tx,desc_data,info)
else
call psb_abgdxyz(cr,cz,sm%poly_beta(i),sone,ty,tz,tx,desc_data,info)
end if
if (.false.) then
call psb_geaxpby(sone,x,szero,r,desc_data,info)
call psb_spmm(-sone,sm%pa,tx,sone,r,desc_data,info,work=aux,trans=trans_)
else
call psb_spmm(-sone,sm%pa,tz,sone,r,desc_data,info,work=aux,trans=trans_)
end if
!!$ res = psb_genrm2(r,desc_data,info)
!!$ write(0,*) 'Polynomial smoother LOTTES_BETA',i,res
! x_k = x_{k-1} + z_k
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz(cr,cz,sm%poly_beta(i),sone,ty,tz,tx,desc_data,info)
if (do_timings) call psb_toc(poly_vect)
if (do_timings) call psb_tic(poly_mv)
call psb_spmm(-sone,sm%pa,tz,sone,r,desc_data,info,work=aux,trans=trans_)
if (do_timings) call psb_toc(poly_mv)
end do
call sm%sv%apply(sone,r,szero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
cz = (2*sm%pdegree*sone-3)/(2*sm%pdegree*sone+sone)
cr = (8*sm%pdegree*sone-4)/((2*sm%pdegree*sone+sone)*sm%rho_ba)
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz(cr,cz,sm%poly_beta(sm%pdegree),sone,ty,tz,tx,desc_data,info)
if (do_timings) call psb_toc(poly_vect)
end block
if (do_timings) call psb_toc(poly_2)
case(amg_poly_new_)
if (do_timings) call psb_tic(poly_3)
block
real(psb_spk_) :: sigma, theta, delta, rho_old, rho
! b == x
@ -206,40 +221,35 @@ subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
delta = (sone-sm%cf_a)/2
sigma = theta/delta
rho_old = sone/sigma
if (do_timings) call psb_tic(poly_sv)
call sm%sv%apply(sone,r,szero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
if (do_timings) call psb_toc(poly_sv)
call psb_geaxpby((sone/sm%rho_ba),ty,szero,r,desc_data,info)
if (.false.) then
call psb_geaxpby((sone/theta),r,szero,tz,desc_data,info)
call psb_geaxpby(sone,tz,sone,tx,desc_data,info)
else
call psb_abgdxyz((sone/theta),szero,sone,sone,r,tz,tx,desc_data,info)
end if
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz((sone/theta),szero,sone,sone,r,tz,tx,desc_data,info)
if (do_timings) call psb_toc(poly_vect)
! tz == d
do i=1, sm%pdegree-1
!
!
!
! r_{k-1} = r_k - (1/rho(BA)) B A d_k
if (do_timings) call psb_tic(poly_mv)
call psb_spmm(sone,sm%pa,tz,szero,ty,desc_data,info,work=aux,trans=trans_)
if (do_timings) call psb_toc(poly_mv)
if (do_timings) call psb_tic(poly_sv)
call sm%sv%apply(-(sone/sm%rho_ba),ty,sone,r,desc_data,trans_,aux,wv(5:),info,init='Z')
if (do_timings) call psb_toc(poly_sv)
!
! d_{k+1} = (rho rho_old) d_k + 2(rho/delta) r_{k+1}
rho = sone/(2*sigma - rho_old)
if (.false.) then
call psb_geaxpby((2*rho/delta),r,(rho*rho_old),tz,desc_data,info)
call psb_geaxpby(sone,tz,sone,tx,desc_data,info)
else
call psb_abgdxyz((2*rho/delta),(rho*rho_old),sone,sone,r,tz,tx,desc_data,info)
end if
!!$ res = psb_genrm2(r,desc_data,info)
!!$ write(0,*) 'Polynomial smoother NEW ',i,res
! x_k = x_{k-1} + z_k
if (do_timings) call psb_tic(poly_vect)
call psb_abgdxyz((2*rho/delta),(rho*rho_old),sone,sone,r,tz,tx,desc_data,info)
if (do_timings) call psb_toc(poly_vect)
rho_old = rho
end do
end block
if (do_timings) call psb_toc(poly_3)
case default
info=psb_err_internal_error_
call psb_errpush(info,name,&

@ -45,7 +45,7 @@ subroutine amg_s_poly_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_poly_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -42,7 +42,7 @@ subroutine amg_z_as_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
Implicit None
! Arguments
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -42,7 +42,7 @@ subroutine amg_z_base_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
Implicit None
! Arguments
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -43,7 +43,7 @@ subroutine amg_z_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
Implicit None
! Arguments
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -43,7 +43,7 @@ subroutine amg_z_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
Implicit None
! Arguments
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_l1_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info

@ -45,7 +45,7 @@ subroutine amg_c_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -41,7 +41,7 @@ subroutine amg_c_base_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
use amg_c_base_solver_mod, amg_protect_name => amg_c_base_solver_bld
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -43,7 +43,7 @@ subroutine amg_c_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_bwgs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -43,7 +43,7 @@ subroutine amg_c_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@ -122,7 +122,7 @@ subroutine amg_c_l1_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_l1_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -43,7 +43,7 @@ subroutine amg_c_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_gs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -43,7 +43,7 @@ subroutine amg_c_ilu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_ilu_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -46,7 +46,7 @@ subroutine amg_c_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_invk_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

@ -44,7 +44,7 @@ subroutine amg_c_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_invt_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info

Some files were not shown because too many files have changed in this diff Show More

Loading…
Cancel
Save