diff --git a/mlprec/mld_cmlprec_aply.f90 b/mlprec/mld_cmlprec_aply.f90 index 6398678b..de543166 100644 --- a/mlprec/mld_cmlprec_aply.f90 +++ b/mlprec/mld_cmlprec_aply.f90 @@ -78,41 +78,41 @@ ! Arguments: ! alpha - complex(psb_spk_), input. ! The scalar alpha. -! precv - type(mld_conelev_type), dimension(:), input. +! p - type(mld_cprec_type), input. ! The array of one-level preconditioner data structures containing the ! local parts of the preconditioners to be applied at each level. -! Note that nlev = size(precv) = number of levels. -! precv(ilev)%prec - type(psb_cbaseprec_type) +! Note that nlev = size(p%precv) = number of levels. +! p%precv(ilev)%prec - type(psb_cbaseprec_type) ! The "base" preconditioner for the current level -! precv(ilev)%ac - type(psb_cspmat_type) +! p%precv(ilev)%ac - type(psb_cspmat_type) ! The local part of the matrix A(ilev). -! precv(ilev)%desc_ac - type(psb_desc_type). +! p%precv(ilev)%desc_ac - type(psb_desc_type). ! The communication descriptor associated to the sparse ! matrix A(ilev) -! precv(ilev)%map - type(psb_inter_desc_type) +! p%precv(ilev)%map - type(psb_inter_desc_type) ! Stores the linear operators mapping between levels ! (ilev-1) and (ilev). These are the restriction and ! prolongation operators described in the sequel. -! precv(ilev)%iprcparm - integer, dimension(:), allocatable. +! p%precv(ilev)%iprcparm - integer, dimension(:), allocatable. ! The integer parameters defining the multilevel ! strategy -! precv(ilev)%rprcparm - real(psb_spk_), dimension(:), allocatable. +! p%precv(ilev)%rprcparm - real(psb_spk_), dimension(:), allocatable. ! The real parameters defining the multilevel strategy -! precv(ilev)%mlia - integer, dimension(:), allocatable. +! p%precv(ilev)%mlia - integer, dimension(:), allocatable. ! The aggregation map (ilev-1) --> (ilev). ! In case of non-smoothed aggregation, it is used ! instead of mld_sm_pr_. -! precv(ilev)%nlaggr - integer, dimension(:), allocatable. +! p%precv(ilev)%nlaggr - integer, dimension(:), allocatable. ! The number of aggregates (rows of A(ilev)) on the ! various processes. -! precv(ilev)%base_a - type(psb_cspmat_type), pointer. +! p%precv(ilev)%base_a - type(psb_cspmat_type), pointer. ! Pointer (really a pointer!) to the base matrix of ! the current level, i.e. the local part of A(ilev); ! so we have a unified treatment of residuals. We ! need this to avoid passing explicitly the matrix ! A(ilev) to the routine which applies the ! preconditioner. -! precv(ilev)%base_desc - type(psb_desc_type), pointer. +! p%precv(ilev)%base_desc - type(psb_desc_type), pointer. ! Pointer to the communication descriptor associated ! to the sparse matrix pointed by base_a. ! @@ -136,10 +136,10 @@ ! Note that when the LU factorization of the matrix A(ilev) is computed instead of ! the ILU one, by using UMFPACK or SuperLU, the corresponding L and U factors ! are stored in data structures provided by UMFPACK or SuperLU and pointed by -! precv(ilev)%prec%iprcparm(mld_umf_ptr) or precv(ilev)%prec%iprcparm(mld_slu_ptr), +! p%precv(ilev)%prec%iprcparm(mld_umf_ptr) or p%precv(ilev)%prec%iprcparm(mld_slu_ptr), ! respectively. ! -subroutine mld_cmlprec_aply(alpha,precv,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 use mld_inner_mod, mld_protect_name => mld_cmlprec_aply @@ -147,14 +147,14 @@ subroutine mld_cmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_conelev_type), intent(in) :: precv(:) + 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) :: x(:) complex(psb_spk_),intent(inout) :: y(:) - character, intent(in) :: trans + character, intent(in) :: trans complex(psb_spk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info ! Local variables integer :: ictxt, np, me, err_act @@ -173,11 +173,11 @@ subroutine mld_cmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),& - & ' Entry ', size(precv) + & ' Entry ', size(p%precv) trans_ = psb_toupper(trans) - select case(precv(2)%iprcparm(mld_ml_type_)) + select case(p%precv(2)%iprcparm(mld_ml_type_)) case(mld_no_ml_) ! @@ -191,7 +191,7 @@ subroutine mld_cmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) ! Additive multilevel ! - call add_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call add_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case(mld_mult_ml_) ! @@ -202,15 +202,15 @@ subroutine mld_cmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) ! Note that the transpose switches pre <-> post. ! - select case(precv(2)%iprcparm(mld_smoother_pos_)) + select case(p%precv(2)%iprcparm(mld_smoother_pos_)) case(mld_post_smooth_) select case (trans_) case('N') - call mlt_post_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call mlt_post_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case('T','C') - call mlt_pre_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call mlt_pre_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case default info = 4001 call psb_errpush(info,name,a_err='invalid trans') @@ -221,9 +221,9 @@ subroutine mld_cmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) select case (trans_) case('N') - call mlt_pre_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call mlt_pre_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case('T','C') - call mlt_post_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call mlt_post_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case default info = 4001 call psb_errpush(info,name,a_err='invalid trans') @@ -232,12 +232,12 @@ subroutine mld_cmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) case(mld_twoside_smooth_) - call mlt_twoside_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call mlt_twoside_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case default info = 4013 call psb_errpush(info,name,a_err='invalid smooth_pos',& - & i_Err=(/precv(2)%iprcparm(mld_smoother_pos_),0,0,0,0/)) + & i_Err=(/p%precv(2)%iprcparm(mld_smoother_pos_),0,0,0,0/)) goto 9999 end select @@ -245,7 +245,7 @@ subroutine mld_cmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) case default info = 4013 call psb_errpush(info,name,a_err='invalid mltype',& - & i_Err=(/precv(2)%iprcparm(mld_ml_type_),0,0,0,0/)) + & i_Err=(/p%precv(2)%iprcparm(mld_ml_type_),0,0,0,0/)) goto 9999 end select @@ -272,7 +272,7 @@ contains ! Y = beta*Y + alpha*op(M^(-1))*X, ! where ! - M is an additive multilevel domain decomposition (Schwarz) preconditioner - ! associated to a certain matrix A and stored in the array precv, + ! associated to a certain matrix A and stored in the array p%precv, ! - op(M^(-1)) is M^(-1) or its (conjugate) transpose, according to ! the value of trans, ! - X and Y are vectors, @@ -287,7 +287,7 @@ contains ! ! The multilevel preconditioner M is regarded as an array of 'one-level preconditioners', ! each representing the part of the preconditioner associated to a certain level. - ! For each level ilev, the base preconditioner K(ilev) is stored in precv(ilev) + ! For each level ilev, the base preconditioner K(ilev) is stored in p%precv(ilev) ! and is associated to a matrix A(ilev), obtained by 'tranferring' the original ! matrix A (i.e. the matrix to be preconditioned) to the level ilev, through smoothed ! aggregation. @@ -335,19 +335,19 @@ contains ! ! 4. Yext = beta*Yext + alpha*Y(1) ! - subroutine add_ml_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) + subroutine add_ml_aply(alpha,p,x,beta,y,desc_data,trans,work,info) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_conelev_type), intent(in) :: precv(:) + 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) :: x(:) complex(psb_spk_),intent(inout) :: y(:) - character, intent(in) :: trans + character, intent(in) :: trans complex(psb_spk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info ! Local variables integer :: ictxt,np,me,i, nr2l,nc2l,err_act @@ -371,9 +371,9 @@ contains if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),& - & ' Entry ', size(precv) + & ' Entry ', size(p%precv) - nlev = size(precv) + nlev = size(p%precv) allocate(mlprec_wrk(nlev),stat=info) if (info /= 0) then call psb_errpush(4010,name,a_err='Allocate') @@ -396,8 +396,8 @@ contains mlprec_wrk(1)%x2l(:) = x(:) mlprec_wrk(1)%y2l(:) = czero - call mld_baseprec_aply(alpha,precv(1)%prec,x,beta,y,& - & precv(1)%base_desc,trans,work,info) + call mld_baseprec_aply(alpha,p%precv(1)%prec,x,beta,y,& + & p%precv(1)%base_desc,trans,work,info) if (info /=0) then call psb_errpush(4010,name,a_err='baseprec_aply') goto 9999 @@ -408,8 +408,8 @@ contains ! For each level except the finest one ... ! do ilev = 2, nlev - nc2l = psb_cd_get_local_cols(precv(ilev)%base_desc) - nr2l = psb_cd_get_local_rows(precv(ilev)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(ilev)%base_desc) + nr2l = psb_cd_get_local_rows(p%precv(ilev)%base_desc) allocate(mlprec_wrk(ilev)%x2l(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& & stat=info) if (info /= 0) then @@ -422,7 +422,7 @@ contains ! Apply prolongator transpose, i.e. restriction call psb_map_X2Y(cone,mlprec_wrk(ilev-1)%x2l,& & czero,mlprec_wrk(ilev)%x2l,& - & precv(ilev)%map,info,work=work) + & p%precv(ilev)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during restriction') @@ -432,9 +432,9 @@ contains ! ! Apply the base preconditioner ! - call mld_baseprec_aply(cone,precv(ilev)%prec,& + call mld_baseprec_aply(cone,p%precv(ilev)%prec,& & mlprec_wrk(ilev)%x2l,czero,mlprec_wrk(ilev)%y2l,& - & precv(ilev)%base_desc,trans,work,info) + & p%precv(ilev)%base_desc,trans,work,info) enddo @@ -445,15 +445,15 @@ contains ! do ilev =nlev,2,-1 - nc2l = psb_cd_get_local_cols(precv(ilev)%base_desc) - nr2l = psb_cd_get_local_rows(precv(ilev)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(ilev)%base_desc) + nr2l = psb_cd_get_local_rows(p%precv(ilev)%base_desc) ! ! Apply prolongator ! call psb_map_Y2X(cone,mlprec_wrk(ilev)%y2l,& & cone,mlprec_wrk(ilev-1)%y2l,& - & precv(ilev)%map,info,work=work) + & p%precv(ilev)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during prolongation') @@ -466,7 +466,7 @@ contains ! ! Compute the output vector Y ! - call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,cone,y,precv(1)%base_desc,info) + call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,cone,y,p%precv(1)%base_desc,info) if (info /= 0) then call psb_errpush(4001,name,a_err='Error on final update') goto 9999 @@ -500,7 +500,7 @@ contains ! Y = beta*Y + alpha*op(M^(-1))*X, ! where ! - M is a hybrid multilevel domain decomposition (Schwarz) preconditioner - ! associated to a certain matrix A and stored in the array precv, + ! associated to a certain matrix A and stored in the array p%precv, ! - op(M^(-1)) is M^(-1) or its (conjugate) transpose, according to ! the value of trans, ! - X and Y are vectors, @@ -515,7 +515,7 @@ contains ! ! The multilevel preconditioner M is regarded as an array of 'one-level preconditioners', ! each representing the part of the preconditioner associated to a certain level. - ! For each level ilev, the base preconditioner K(ilev) is stored in precv(ilev) + ! For each level ilev, the base preconditioner K(ilev) is stored in p%precv(ilev) ! and is associated to a matrix A(ilev), obtained by 'tranferring' the original ! matrix A (i.e. the matrix to be preconditioned) to the level ilev, through smoothed ! aggregation. @@ -571,19 +571,19 @@ contains ! 6. Yext = beta*Yext + alpha*Y(1) ! ! - subroutine mlt_pre_ml_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) + subroutine mlt_pre_ml_aply(alpha,p,x,beta,y,desc_data,trans,work,info) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_conelev_type), intent(in) :: precv(:) + 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) :: x(:) complex(psb_spk_),intent(inout) :: y(:) - character, intent(in) :: trans + character, intent(in) :: trans complex(psb_spk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info ! Local variables integer :: ictxt,np,me,i, nr2l,nc2l,err_act @@ -607,9 +607,9 @@ contains if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),& - & ' Entry ', size(precv) + & ' Entry ', size(p%precv) - nlev = size(precv) + nlev = size(p%precv) allocate(mlprec_wrk(nlev),stat=info) if (info /= 0) then call psb_errpush(4010,name,a_err='Allocate') @@ -621,7 +621,7 @@ contains ! ! Copy the input vector X ! - nc2l = psb_cd_get_local_cols(precv(1)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(1)%base_desc) allocate(mlprec_wrk(1)%x2l(nc2l),mlprec_wrk(1)%y2l(nc2l), & & mlprec_wrk(1)%tx(nc2l), stat=info) @@ -638,8 +638,8 @@ contains ! ! Apply the base preconditioner at the finest level ! - call mld_baseprec_aply(cone,precv(1)%prec,mlprec_wrk(1)%x2l,& - & czero,mlprec_wrk(1)%y2l,precv(1)%base_desc,& + call mld_baseprec_aply(cone,p%precv(1)%prec,mlprec_wrk(1)%x2l,& + & czero,mlprec_wrk(1)%y2l,p%precv(1)%base_desc,& & trans,work,info) if (info /=0) then call psb_errpush(4010,name,a_err=' baseprec_aply') @@ -653,8 +653,8 @@ contains ! mlprec_wrk(1)%tx = mlprec_wrk(1)%x2l - call psb_spmm(-cone,precv(1)%base_a,mlprec_wrk(1)%y2l,& - & cone,mlprec_wrk(1)%tx,precv(1)%base_desc,info,& + call psb_spmm(-cone,p%precv(1)%base_a,mlprec_wrk(1)%y2l,& + & cone,mlprec_wrk(1)%tx,p%precv(1)%base_desc,info,& & work=work,trans=trans) if (info /=0) then call psb_errpush(4001,name,a_err=' fine level residual') @@ -668,8 +668,8 @@ contains ! do ilev = 2, nlev - nc2l = psb_cd_get_local_cols(precv(ilev)%base_desc) - nr2l = psb_cd_get_local_rows(precv(ilev)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(ilev)%base_desc) + nr2l = psb_cd_get_local_rows(p%precv(ilev)%base_desc) allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& & mlprec_wrk(ilev)%x2l(nc2l), stat=info) @@ -683,7 +683,7 @@ contains ! Apply prolongator transpose, i.e. restriction call psb_map_X2Y(cone,mlprec_wrk(ilev-1)%tx,& & czero,mlprec_wrk(ilev)%x2l,& - & precv(ilev)%map,info,work=work) + & p%precv(ilev)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during restriction') @@ -693,17 +693,17 @@ contains ! ! Apply the base preconditioner ! - call mld_baseprec_aply(cone,precv(ilev)%prec,mlprec_wrk(ilev)%x2l,& - & czero,mlprec_wrk(ilev)%y2l,precv(ilev)%base_desc,trans,work,info) + call mld_baseprec_aply(cone,p%precv(ilev)%prec,mlprec_wrk(ilev)%x2l,& + & czero,mlprec_wrk(ilev)%y2l,p%precv(ilev)%base_desc,trans,work,info) ! ! Compute the residual (at all levels but the coarsest one) ! if (ilev < nlev) then mlprec_wrk(ilev)%tx = mlprec_wrk(ilev)%x2l - if (info == 0) call psb_spmm(-cone,precv(ilev)%base_a,& + if (info == 0) call psb_spmm(-cone,p%precv(ilev)%base_a,& & mlprec_wrk(ilev)%y2l,cone,mlprec_wrk(ilev)%tx,& - & precv(ilev)%base_desc,info,work=work,trans=trans) + & p%precv(ilev)%base_desc,info,work=work,trans=trans) endif if (info /=0) then call psb_errpush(4001,name,a_err='Error on up sweep residual') @@ -722,7 +722,7 @@ contains ! call psb_map_Y2X(cone,mlprec_wrk(ilev+1)%y2l,& & cone,mlprec_wrk(ilev)%y2l,& - & precv(ilev+1)%map,info,work=work) + & p%precv(ilev+1)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during prolongation') @@ -736,7 +736,7 @@ contains ! Compute the output vector Y ! call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,beta,y,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) if (info /=0) then call psb_errpush(4001,name,a_err='Error on final update') goto 9999 @@ -769,7 +769,7 @@ contains ! Y = beta*Y + alpha*op(M^(-1))*X, ! where ! - M is a hybrid multilevel domain decomposition (Schwarz) preconditioner - ! associated to a certain matrix A and stored in the array precv, + ! associated to a certain matrix A and stored in the array p%precv, ! - op(M^(-1)) is M^(-1) or its (conjugate) transpose, according to ! the value of trans, ! - X and Y are vectors, @@ -784,7 +784,7 @@ contains ! ! The multilevel preconditioner M is regarded as an array of 'one-level preconditioners', ! each representing the part of the preconditioner associated to a certain level. - ! For each level ilev, the base preconditioner K(ilev) is stored in precv(ilev) + ! For each level ilev, the base preconditioner K(ilev) is stored in p%precv(ilev) ! and is associated to a matrix A(ilev), obtained by 'tranferring' the original ! matrix A (i.e. the matrix to be preconditioned) to the level ilev, through smoothed ! aggregation. @@ -831,19 +831,19 @@ contains ! 5. Yext = beta*Yext + alpha*Y(1) ! ! - subroutine mlt_post_ml_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) + subroutine mlt_post_ml_aply(alpha,p,x,beta,y,desc_data,trans,work,info) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_conelev_type), intent(in) :: precv(:) + 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) :: x(:) complex(psb_spk_),intent(inout) :: y(:) - character, intent(in) :: trans + character, intent(in) :: trans complex(psb_spk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info ! Local variables integer :: ictxt,np,me,i, nr2l,nc2l,err_act @@ -867,9 +867,9 @@ contains if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),& - & ' Entry ', size(precv) + & ' Entry ', size(p%precv) - nlev = size(precv) + nlev = size(p%precv) allocate(mlprec_wrk(nlev),stat=info) if (info /= 0) then call psb_errpush(4010,name,a_err='Allocate') @@ -885,7 +885,7 @@ contains & write(debug_unit,*) me,' ',trim(name),& & ' desc_data status',allocated(desc_data%matrix_data) - nc2l = psb_cd_get_local_cols(precv(1)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(1)%base_desc) allocate(mlprec_wrk(1)%x2l(nc2l),mlprec_wrk(1)%y2l(nc2l), & & mlprec_wrk(1)%tx(nc2l), stat=info) @@ -897,9 +897,9 @@ contains end if call psb_geaxpby(cone,x,czero,mlprec_wrk(1)%tx,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) call psb_geaxpby(cone,x,czero,mlprec_wrk(1)%x2l,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) ! ! STEP 2 @@ -908,13 +908,13 @@ contains ! do ilev=2, nlev - nc2l = psb_cd_get_local_cols(precv(ilev)%base_desc) - nr2l = psb_cd_get_local_rows(precv(ilev)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(ilev)%base_desc) + nr2l = psb_cd_get_local_rows(p%precv(ilev)%base_desc) if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name), & & ' starting up sweep ',& - & ilev,allocated(precv(ilev)%iprcparm),nc2l, nr2l + & ilev,allocated(p%precv(ilev)%iprcparm),nc2l, nr2l allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& & mlprec_wrk(ilev)%x2l(nc2l), stat=info) @@ -929,7 +929,7 @@ contains ! Apply prolongator transpose, i.e. restriction call psb_map_X2Y(cone,mlprec_wrk(ilev-1)%x2l,& & czero,mlprec_wrk(ilev)%x2l,& - & precv(ilev)%map,info,work=work) + & p%precv(ilev)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during restriction') @@ -940,7 +940,7 @@ contains ! update x2l ! call psb_geaxpby(cone,mlprec_wrk(ilev)%x2l,czero,mlprec_wrk(ilev)%tx,& - & precv(ilev)%base_desc,info) + & p%precv(ilev)%base_desc,info) if (info /= 0) then call psb_errpush(4001,name,a_err='Error in update') goto 9999 @@ -957,8 +957,8 @@ contains ! ! Apply the base preconditioner at the coarsest level ! - call mld_baseprec_aply(cone,precv(nlev)%prec,mlprec_wrk(nlev)%x2l, & - & czero, mlprec_wrk(nlev)%y2l,precv(nlev)%base_desc,trans,work,info) + call mld_baseprec_aply(cone,p%precv(nlev)%prec,mlprec_wrk(nlev)%x2l, & + & czero, mlprec_wrk(nlev)%y2l,p%precv(nlev)%base_desc,trans,work,info) if (info /=0) then call psb_errpush(4010,name,a_err='baseprec_aply') goto 9999 @@ -983,7 +983,7 @@ contains ! call psb_map_Y2X(cone,mlprec_wrk(ilev+1)%y2l,& & czero,mlprec_wrk(ilev)%y2l,& - & precv(ilev+1)%map,info,work=work) + & p%precv(ilev+1)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during prolongation') @@ -993,15 +993,15 @@ contains ! ! Compute the residual ! - call psb_spmm(-cone,precv(ilev)%base_a,mlprec_wrk(ilev)%y2l,& - & cone,mlprec_wrk(ilev)%tx,precv(ilev)%base_desc,info,& + call psb_spmm(-cone,p%precv(ilev)%base_a,mlprec_wrk(ilev)%y2l,& + & cone,mlprec_wrk(ilev)%tx,p%precv(ilev)%base_desc,info,& & work=work,trans=trans) ! ! Apply the base preconditioner ! - if (info == 0) call mld_baseprec_aply(cone,precv(ilev)%prec,& - & mlprec_wrk(ilev)%tx,cone,mlprec_wrk(ilev)%y2l,precv(ilev)%base_desc,& + if (info == 0) call mld_baseprec_aply(cone,p%precv(ilev)%prec,& + & mlprec_wrk(ilev)%tx,cone,mlprec_wrk(ilev)%y2l,p%precv(ilev)%base_desc,& & trans,work,info) if (info /=0) then call psb_errpush(4001,name,a_err=' spmm/baseprec_aply') @@ -1018,7 +1018,7 @@ contains ! ! Compute the output vector Y ! - call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,beta,y,precv(1)%base_desc,info) + call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,beta,y,p%precv(1)%base_desc,info) if (info /=0) then call psb_errpush(4001,name,a_err=' Final update') @@ -1055,7 +1055,7 @@ contains ! where ! - M is a symmetrized hybrid multilevel domain decomposition (Schwarz) ! preconditioner associated to a certain matrix A and stored in the array - ! precv, + ! p%precv, ! - op(M^(-1)) is M^(-1) or its (conjugate) transpose, according to ! the value of trans, ! - X and Y are vectors, @@ -1071,7 +1071,7 @@ contains ! ! The multilevel preconditioner M is regarded as an array of 'one-level preconditioners', ! each representing the part of the preconditioner associated to a certain level. - ! For each level ilev, the base preconditioner K(ilev) is stored in precv(ilev) + ! For each level ilev, the base preconditioner K(ilev) is stored in p%precv(ilev) ! and is associated to a matrix A(ilev), obtained by 'tranferring' the original ! matrix A (i.e. the matrix to be preconditioned) to the level ilev, through smoothed ! aggregation. @@ -1129,19 +1129,19 @@ contains ! ! 6. Yext = beta*Yext + alpha*Y(1) ! - subroutine mlt_twoside_ml_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) + subroutine mlt_twoside_ml_aply(alpha,p,x,beta,y,desc_data,trans,work,info) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_conelev_type), intent(in) :: precv(:) - complex(psb_spk_),intent(in) :: alpha,beta - complex(psb_spk_),intent(in) :: x(:) - complex(psb_spk_),intent(inout) :: y(:) - character, intent(in) :: trans - complex(psb_spk_),target :: work(:) - integer, intent(out) :: info + 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) :: x(:) + complex(psb_spk_),intent(inout) :: y(:) + character, intent(in) :: trans + complex(psb_spk_),target :: work(:) + integer, intent(out) :: info ! Local variables integer :: ictxt,np,me,i, nr2l,nc2l,err_act @@ -1165,9 +1165,9 @@ contains if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),& - & ' Entry ', size(precv) + & ' Entry ', size(p%precv) - nlev = size(precv) + nlev = size(p%precv) allocate(mlprec_wrk(nlev),stat=info) if (info /= 0) then call psb_errpush(4010,name,a_err='Allocate') @@ -1178,7 +1178,7 @@ contains ! ! Copy the input vector X ! - nc2l = psb_cd_get_local_cols(precv(1)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(1)%base_desc) allocate(mlprec_wrk(1)%x2l(nc2l),mlprec_wrk(1)%y2l(nc2l), & & mlprec_wrk(1)%ty(nc2l), mlprec_wrk(1)%tx(nc2l), stat=info) @@ -1191,17 +1191,17 @@ contains end if call psb_geaxpby(cone,x,czero,mlprec_wrk(1)%x2l,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) call psb_geaxpby(cone,x,czero,mlprec_wrk(1)%tx,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) ! ! STEP 2 ! ! Apply the base preconditioner at the finest level ! - call mld_baseprec_aply(cone,precv(1)%prec,mlprec_wrk(1)%x2l,& - & czero,mlprec_wrk(1)%y2l,precv(1)%base_desc,& + call mld_baseprec_aply(cone,p%precv(1)%prec,mlprec_wrk(1)%x2l,& + & czero,mlprec_wrk(1)%y2l,p%precv(1)%base_desc,& & trans,work,info) ! ! STEP 3 @@ -1209,8 +1209,8 @@ contains ! Compute the residual at the finest level ! mlprec_wrk(1)%ty = mlprec_wrk(1)%x2l - if (info == 0) call psb_spmm(-cone,precv(1)%base_a,mlprec_wrk(1)%y2l,& - & cone,mlprec_wrk(1)%ty,precv(1)%base_desc,info,& + if (info == 0) call psb_spmm(-cone,p%precv(1)%base_a,mlprec_wrk(1)%y2l,& + & cone,mlprec_wrk(1)%ty,p%precv(1)%base_desc,info,& & work=work,trans=trans) if (info /=0) then call psb_errpush(4010,name,a_err='Fine level baseprec/residual') @@ -1224,8 +1224,8 @@ contains ! do ilev = 2, nlev - nc2l = psb_cd_get_local_cols(precv(ilev)%base_desc) - nr2l = psb_cd_get_local_rows(precv(ilev)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(ilev)%base_desc) + nr2l = psb_cd_get_local_rows(p%precv(ilev)%base_desc) allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%ty(nc2l),& & mlprec_wrk(ilev)%y2l(nc2l),mlprec_wrk(ilev)%x2l(nc2l), stat=info) @@ -1240,7 +1240,7 @@ contains ! Apply prolongator transpose, i.e. restriction call psb_map_X2Y(cone,mlprec_wrk(ilev-1)%ty,& & czero,mlprec_wrk(ilev)%x2l,& - & precv(ilev)%map,info,work=work) + & p%precv(ilev)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during restriction') @@ -1248,21 +1248,21 @@ contains end if call psb_geaxpby(cone,mlprec_wrk(ilev)%x2l,czero,mlprec_wrk(ilev)%tx,& - & precv(ilev)%base_desc,info) + & p%precv(ilev)%base_desc,info) ! ! Apply the base preconditioner ! - if (info == 0) call mld_baseprec_aply(cone,precv(ilev)%prec,& + if (info == 0) call mld_baseprec_aply(cone,p%precv(ilev)%prec,& & mlprec_wrk(ilev)%x2l,czero,mlprec_wrk(ilev)%y2l,& - &precv(ilev)%base_desc,trans,work,info) + &p%precv(ilev)%base_desc,trans,work,info) ! ! Compute the residual (at all levels but the coarsest one) ! if(ilev < nlev) then mlprec_wrk(ilev)%ty = mlprec_wrk(ilev)%x2l - if (info == 0) call psb_spmm(-cone,precv(ilev)%base_a,& + if (info == 0) call psb_spmm(-cone,p%precv(ilev)%base_a,& & mlprec_wrk(ilev)%y2l,cone,mlprec_wrk(ilev)%ty,& - & precv(ilev)%base_desc,info,work=work,trans=trans) + & p%precv(ilev)%base_desc,info,work=work,trans=trans) endif if (info /=0) then call psb_errpush(4001,name,a_err='baseprec_aply/residual') @@ -1283,7 +1283,7 @@ contains ! call psb_map_Y2X(cone,mlprec_wrk(ilev+1)%y2l,& & cone,mlprec_wrk(ilev)%y2l,& - & precv(ilev+1)%map,info,work=work) + & p%precv(ilev+1)%map,info,work=work) if (info /=0 ) then call psb_errpush(4001,name,a_err='Error during restriction') @@ -1293,14 +1293,14 @@ contains ! ! Compute the residual ! - call psb_spmm(-cone,precv(ilev)%base_a,mlprec_wrk(ilev)%y2l,& - & cone,mlprec_wrk(ilev)%tx,precv(ilev)%base_desc,info,& + call psb_spmm(-cone,p%precv(ilev)%base_a,mlprec_wrk(ilev)%y2l,& + & cone,mlprec_wrk(ilev)%tx,p%precv(ilev)%base_desc,info,& & work=work,trans=trans) ! ! Apply the base preconditioner ! - if (info == 0) call mld_baseprec_aply(cone,precv(ilev)%prec,mlprec_wrk(ilev)%tx,& - & cone,mlprec_wrk(ilev)%y2l,precv(ilev)%base_desc, trans, work,info) + if (info == 0) call mld_baseprec_aply(cone,p%precv(ilev)%prec,mlprec_wrk(ilev)%tx,& + & cone,mlprec_wrk(ilev)%y2l,p%precv(ilev)%base_desc, trans, work,info) if (info /= 0) then call psb_errpush(4001,name,a_err='Error: residual/baseprec_aply') goto 9999 @@ -1313,7 +1313,7 @@ contains ! Compute the output vector Y ! call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,beta,y,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) if (info /= 0) then call psb_errpush(4001,name,a_err='Error final update') diff --git a/mlprec/mld_cprecaply.f90 b/mlprec/mld_cprecaply.f90 index c2dc2a53..8c91397e 100644 --- a/mlprec/mld_cprecaply.f90 +++ b/mlprec/mld_cprecaply.f90 @@ -127,7 +127,7 @@ subroutine mld_cprecaply(prec,x,y,desc_data,info,trans,work) goto 9999 end if if (size(prec%precv) >1) then - call mld_mlprec_aply(cone,prec%precv,x,czero,y,desc_data,trans_,work_,info) + call mld_mlprec_aply(cone,prec,x,czero,y,desc_data,trans_,work_,info) if(info /= 0) then call psb_errpush(4010,name,a_err='mld_cmlprec_aply') goto 9999 diff --git a/mlprec/mld_dmlprec_aply.f90 b/mlprec/mld_dmlprec_aply.f90 index 7988d437..33b5772f 100644 --- a/mlprec/mld_dmlprec_aply.f90 +++ b/mlprec/mld_dmlprec_aply.f90 @@ -46,7 +46,7 @@ ! Y = beta*Y + alpha*op(M^(-1))*X, ! where ! - M is a multilevel domain decomposition (Schwarz) preconditioner associated -! to a certain matrix A and stored in the array precv, +! to a certain matrix A and stored in the array p%precv, ! - op(M^(-1)) is M^(-1) or its transpose, according to the value of trans, ! - X and Y are vectors, ! - alpha and beta are scalars. @@ -57,7 +57,7 @@ ! ! The multilevel preconditioner M is regarded as an array of 'one-level preconditioners', ! each representing the part of the preconditioner associated to a certain level. -! For each level ilev, the preconditioner K(ilev) is stored in precv(ilev) +! For each level ilev, the preconditioner K(ilev) is stored in p%precv(ilev) ! and is associated to a matrix A(ilev), obtained by 'tranferring' the original ! matrix A (i.e. the matrix to be preconditioned) to the level ilev, through smoothed ! aggregation. @@ -78,41 +78,41 @@ ! Arguments: ! alpha - real(psb_dpk_), input. ! The scalar alpha. -! precv - type(mld_donelev_type), dimension(:), input. +! p - type(mld_dprec_type), input. ! The array of one-level preconditioner data structures containing the ! local parts of the preconditioners to be applied at each level. -! Note that nlev = size(precv) = number of levels. -! precv(ilev)%prec - type(psb_dbaseprec_type) +! Note that nlev = size(p%precv) = number of levels. +! p%precv(ilev)%prec - type(psb_dbaseprec_type) ! The "base" preconditioner for the current level -! precv(ilev)%ac - type(psb_dspmat_type) +! p%precv(ilev)%ac - type(psb_dspmat_type) ! The local part of the matrix A(ilev). -! precv(ilev)%desc_ac - type(psb_desc_type). +! p%precv(ilev)%desc_ac - type(psb_desc_type). ! The communication descriptor associated to the sparse ! matrix A(ilev) -! precv(ilev)%map - type(psb_inter_desc_type) +! p%precv(ilev)%map - type(psb_inter_desc_type) ! Stores the linear operators mapping between levels ! (ilev-1) and (ilev). These are the restriction and ! prolongation operators described in the sequel. -! precv(ilev)%iprcparm - integer, dimension(:), allocatable. +! p%precv(ilev)%iprcparm - integer, dimension(:), allocatable. ! The integer parameters defining the multilevel ! strategy -! precv(ilev)%rprcparm - real(psb_dpk_), dimension(:), allocatable. +! p%precv(ilev)%rprcparm - real(psb_dpk_), dimension(:), allocatable. ! The real parameters defining the multilevel strategy -! precv(ilev)%mlia - integer, dimension(:), allocatable. +! p%precv(ilev)%mlia - integer, dimension(:), allocatable. ! The aggregation map (ilev-1) --> (ilev). ! In case of non-smoothed aggregation, it is used ! instead of mld_sm_pr_. -! precv(ilev)%nlaggr - integer, dimension(:), allocatable. +! p%precv(ilev)%nlaggr - integer, dimension(:), allocatable. ! The number of aggregates (rows of A(ilev)) on the ! various processes. -! precv(ilev)%base_a - type(psb_dspmat_type), pointer. +! p%precv(ilev)%base_a - type(psb_dspmat_type), pointer. ! Pointer (really a pointer!) to the base matrix of ! the current level, i.e. the local part of A(ilev); ! so we have a unified treatment of residuals. We ! need this to avoid passing explicitly the matrix ! A(ilev) to the routine which applies the ! preconditioner. -! precv(ilev)%base_desc - type(psb_desc_type), pointer. +! p%precv(ilev)%base_desc - type(psb_desc_type), pointer. ! Pointer to the communication descriptor associated ! to the sparse matrix pointed by base_a. ! @@ -136,10 +136,10 @@ ! Note that when the LU factorization of the matrix A(ilev) is computed instead of ! the ILU one, by using UMFPACK or SuperLU, the corresponding L and U factors ! are stored in data structures provided by UMFPACK or SuperLU and pointed by -! precv(ilev)%prec%iprcparm(mld_umf_ptr) or precv(ilev)%prec%iprcparm(mld_slu_ptr), +! p%precv(ilev)%prec%iprcparm(mld_umf_ptr) or p%precv(ilev)%prec%iprcparm(mld_slu_ptr), ! respectively. ! -subroutine mld_dmlprec_aply(alpha,precv,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 use mld_inner_mod, mld_protect_name => mld_dmlprec_aply @@ -147,14 +147,15 @@ subroutine mld_dmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_donelev_type), intent(in) :: precv(:) + type(psb_desc_type),intent(in) :: desc_data + type(mld_dprec_type), intent(in) :: p +!!$ type(mld_donelev_type), intent(in) :: precv(:) real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: x(:) real(psb_dpk_),intent(inout) :: y(:) - character, intent(in) :: trans + character, intent(in) :: trans real(psb_dpk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info ! Local variables integer :: ictxt, np, me, err_act @@ -173,11 +174,11 @@ subroutine mld_dmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),& - & ' Entry ', size(precv) + & ' Entry ', size(p%precv) trans_ = psb_toupper(trans) - select case(precv(2)%iprcparm(mld_ml_type_)) + select case(p%precv(2)%iprcparm(mld_ml_type_)) case(mld_no_ml_) ! @@ -191,7 +192,7 @@ subroutine mld_dmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) ! Additive multilevel ! - call add_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call add_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case(mld_mult_ml_) ! @@ -202,15 +203,15 @@ subroutine mld_dmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) ! Note that the transpose switches pre <-> post. ! - select case(precv(2)%iprcparm(mld_smoother_pos_)) + select case(p%precv(2)%iprcparm(mld_smoother_pos_)) case(mld_post_smooth_) select case (trans_) case('N') - call mlt_post_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call mlt_post_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case('T','C') - call mlt_pre_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call mlt_pre_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case default info = 4001 call psb_errpush(info,name,a_err='invalid trans') @@ -221,9 +222,9 @@ subroutine mld_dmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) select case (trans_) case('N') - call mlt_pre_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call mlt_pre_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case('T','C') - call mlt_post_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call mlt_post_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case default info = 4001 call psb_errpush(info,name,a_err='invalid trans') @@ -232,12 +233,12 @@ subroutine mld_dmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) case(mld_twoside_smooth_) - call mlt_twoside_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call mlt_twoside_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case default info = 4013 call psb_errpush(info,name,a_err='invalid smooth_pos',& - & i_Err=(/precv(2)%iprcparm(mld_smoother_pos_),0,0,0,0/)) + & i_Err=(/p%precv(2)%iprcparm(mld_smoother_pos_),0,0,0,0/)) goto 9999 end select @@ -245,7 +246,7 @@ subroutine mld_dmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) case default info = 4013 call psb_errpush(info,name,a_err='invalid mltype',& - & i_Err=(/precv(2)%iprcparm(mld_ml_type_),0,0,0,0/)) + & i_Err=(/p%precv(2)%iprcparm(mld_ml_type_),0,0,0,0/)) goto 9999 end select @@ -334,19 +335,20 @@ contains ! ! 4. Yext = beta*Yext + alpha*Y(1) ! - subroutine add_ml_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) + subroutine add_ml_aply(alpha,p,x,beta,y,desc_data,trans,work,info) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_donelev_type), intent(in) :: precv(:) + type(psb_desc_type),intent(in) :: desc_data + type(mld_dprec_type), intent(in) :: p +!!$ type(mld_donelev_type), intent(in) :: precv(:) real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: x(:) real(psb_dpk_),intent(inout) :: y(:) - character, intent(in) :: trans + character, intent(in) :: trans real(psb_dpk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info ! Local variables integer :: ictxt,np,me,i, nr2l,nc2l,err_act @@ -370,9 +372,9 @@ contains if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),& - & ' Entry ', size(precv) + & ' Entry ', size(p%precv) - nlev = size(precv) + nlev = size(p%precv) allocate(mlprec_wrk(nlev),stat=info) if (info /= 0) then call psb_errpush(4010,name,a_err='Allocate') @@ -395,8 +397,8 @@ contains mlprec_wrk(1)%x2l(:) = x(:) mlprec_wrk(1)%y2l(:) = dzero - call mld_baseprec_aply(alpha,precv(1)%prec,x,beta,y,& - & precv(1)%base_desc,trans,work,info) + call mld_baseprec_aply(alpha,p%precv(1)%prec,x,beta,y,& + & p%precv(1)%base_desc,trans,work,info) if (info /=0) then call psb_errpush(4010,name,a_err='baseprec_aply') goto 9999 @@ -407,8 +409,8 @@ contains ! For each level except the finest one ... ! do ilev = 2, nlev - nc2l = psb_cd_get_local_cols(precv(ilev)%base_desc) - nr2l = psb_cd_get_local_rows(precv(ilev)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(ilev)%base_desc) + nr2l = psb_cd_get_local_rows(p%precv(ilev)%base_desc) allocate(mlprec_wrk(ilev)%x2l(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& & stat=info) if (info /= 0) then @@ -421,7 +423,7 @@ contains ! Apply prolongator transpose, i.e. restriction call psb_map_X2Y(done,mlprec_wrk(ilev-1)%x2l,& & dzero,mlprec_wrk(ilev)%x2l,& - & precv(ilev)%map,info,work=work) + & p%precv(ilev)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during restriction') @@ -431,9 +433,9 @@ contains ! ! Apply the base preconditioner ! - call mld_baseprec_aply(done,precv(ilev)%prec,& + call mld_baseprec_aply(done,p%precv(ilev)%prec,& & mlprec_wrk(ilev)%x2l,dzero,mlprec_wrk(ilev)%y2l,& - & precv(ilev)%base_desc, trans,work,info) + & p%precv(ilev)%base_desc, trans,work,info) enddo @@ -444,15 +446,15 @@ contains ! do ilev =nlev,2,-1 - nc2l = psb_cd_get_local_cols(precv(ilev)%base_desc) - nr2l = psb_cd_get_local_rows(precv(ilev)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(ilev)%base_desc) + nr2l = psb_cd_get_local_rows(p%precv(ilev)%base_desc) ! ! Apply prolongator ! call psb_map_Y2X(done,mlprec_wrk(ilev)%y2l,& & done,mlprec_wrk(ilev-1)%y2l,& - & precv(ilev)%map,info,work=work) + & p%precv(ilev)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during prolongation') @@ -465,7 +467,7 @@ contains ! ! Compute the output vector Y ! - call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,done,y,precv(1)%base_desc,info) + call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,done,y,p%precv(1)%base_desc,info) if (info /= 0) then call psb_errpush(4001,name,a_err='Error on final update') goto 9999 @@ -499,7 +501,7 @@ contains ! Y = beta*Y + alpha*op(M^(-1))*X, ! where ! - M is a hybrid multilevel domain decomposition (Schwarz) preconditioner - ! associated to a certain matrix A and stored in the array precv, + ! associated to a certain matrix A and stored in the array p%precv, ! - op(M^(-1)) is M^(-1) or its transpose, according to the value of trans, ! - X and Y are vectors, ! - alpha and beta are scalars. @@ -513,7 +515,7 @@ contains ! ! The multilevel preconditioner M is regarded as an array of 'one-level preconditioners', ! each representing the part of the preconditioner associated to a certain level. - ! For each level ilev, the base preconditioner K(ilev) is stored in precv(ilev) + ! For each level ilev, the base preconditioner K(ilev) is stored in p%precv(ilev) ! and is associated to a matrix A(ilev), obtained by 'tranferring' the original ! matrix A (i.e. the matrix to be preconditioned) to the level ilev, through smoothed ! aggregation. @@ -569,19 +571,20 @@ contains ! 6. Yext = beta*Yext + alpha*Y(1) ! ! - subroutine mlt_pre_ml_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) + subroutine mlt_pre_ml_aply(alpha,p,x,beta,y,desc_data,trans,work,info) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_donelev_type), intent(in) :: precv(:) + type(psb_desc_type),intent(in) :: desc_data + type(mld_dprec_type), intent(in) :: p +!!$ type(mld_donelev_type), intent(in) :: precv(:) real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: x(:) real(psb_dpk_),intent(inout) :: y(:) - character, intent(in) :: trans + character, intent(in) :: trans real(psb_dpk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info ! Local variables integer :: ictxt,np,me,i, nr2l,nc2l,err_act @@ -605,9 +608,9 @@ contains if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),& - & ' Entry ', size(precv) + & ' Entry ', size(p%precv) - nlev = size(precv) + nlev = size(p%precv) allocate(mlprec_wrk(nlev),stat=info) if (info /= 0) then call psb_errpush(4010,name,a_err='Allocate') @@ -619,7 +622,7 @@ contains ! ! Copy the input vector X ! - nc2l = psb_cd_get_local_cols(precv(1)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(1)%base_desc) allocate(mlprec_wrk(1)%x2l(nc2l),mlprec_wrk(1)%y2l(nc2l), & & mlprec_wrk(1)%tx(nc2l), stat=info) @@ -636,8 +639,8 @@ contains ! ! Apply the base preconditioner at the finest level ! - call mld_baseprec_aply(done,precv(1)%prec,mlprec_wrk(1)%x2l,& - & dzero,mlprec_wrk(1)%y2l,precv(1)%base_desc,& + call mld_baseprec_aply(done,p%precv(1)%prec,mlprec_wrk(1)%x2l,& + & dzero,mlprec_wrk(1)%y2l,p%precv(1)%base_desc,& & trans,work,info) if (info /=0) then call psb_errpush(4010,name,a_err=' baseprec_aply') @@ -651,8 +654,8 @@ contains ! mlprec_wrk(1)%tx = mlprec_wrk(1)%x2l - call psb_spmm(-done,precv(1)%base_a,mlprec_wrk(1)%y2l,& - & done,mlprec_wrk(1)%tx,precv(1)%base_desc,info,& + call psb_spmm(-done,p%precv(1)%base_a,mlprec_wrk(1)%y2l,& + & done,mlprec_wrk(1)%tx,p%precv(1)%base_desc,info,& & work=work,trans=trans) if (info /=0) then call psb_errpush(4001,name,a_err=' fine level residual') @@ -666,8 +669,8 @@ contains ! do ilev = 2, nlev - nc2l = psb_cd_get_local_cols(precv(ilev)%base_desc) - nr2l = psb_cd_get_local_rows(precv(ilev)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(ilev)%base_desc) + nr2l = psb_cd_get_local_rows(p%precv(ilev)%base_desc) allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& & mlprec_wrk(ilev)%x2l(nc2l), stat=info) @@ -681,7 +684,7 @@ contains ! Apply prolongator transpose, i.e. restriction call psb_map_X2Y(done,mlprec_wrk(ilev-1)%tx,& & dzero,mlprec_wrk(ilev)%x2l,& - & precv(ilev)%map,info,work=work) + & p%precv(ilev)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during restriction') @@ -691,17 +694,17 @@ contains ! ! Apply the base preconditioner ! - call mld_baseprec_aply(done,precv(ilev)%prec,mlprec_wrk(ilev)%x2l,& - & dzero,mlprec_wrk(ilev)%y2l,precv(ilev)%base_desc,trans,work,info) + call mld_baseprec_aply(done,p%precv(ilev)%prec,mlprec_wrk(ilev)%x2l,& + & dzero,mlprec_wrk(ilev)%y2l,p%precv(ilev)%base_desc,trans,work,info) ! ! Compute the residual (at all levels but the coarsest one) ! if (ilev < nlev) then mlprec_wrk(ilev)%tx = mlprec_wrk(ilev)%x2l - if (info == 0) call psb_spmm(-done,precv(ilev)%base_a,& + if (info == 0) call psb_spmm(-done,p%precv(ilev)%base_a,& & mlprec_wrk(ilev)%y2l,done,mlprec_wrk(ilev)%tx,& - & precv(ilev)%base_desc,info,work=work,trans=trans) + & p%precv(ilev)%base_desc,info,work=work,trans=trans) endif if (info /=0) then call psb_errpush(4001,name,a_err='Error on up sweep residual') @@ -720,7 +723,7 @@ contains ! call psb_map_Y2X(done,mlprec_wrk(ilev+1)%y2l,& & done,mlprec_wrk(ilev)%y2l,& - & precv(ilev+1)%map,info,work=work) + & p%precv(ilev+1)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during prolongation') @@ -734,7 +737,7 @@ contains ! Compute the output vector Y ! call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,beta,y,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) if (info /=0) then call psb_errpush(4001,name,a_err='Error on final update') goto 9999 @@ -767,7 +770,7 @@ contains ! Y = beta*Y + alpha*op(M^(-1))*X, ! where ! - M is a hybrid multilevel domain decomposition (Schwarz) preconditioner - ! associated to a certain matrix A and stored in the array precv, + ! associated to a certain matrix A and stored in the array p%precv, ! - op(M^(-1)) is M^(-1) or its transpose, according to the value of trans, ! - X and Y are vectors, ! - alpha and beta are scalars. @@ -781,7 +784,7 @@ contains ! ! The multilevel preconditioner M is regarded as an array of 'one-level preconditioners', ! each representing the part of the preconditioner associated to a certain level. - ! For each level ilev, the base preconditioner K(ilev) is stored in precv(ilev) + ! For each level ilev, the base preconditioner K(ilev) is stored in p%precv(ilev) ! and is associated to a matrix A(ilev), obtained by 'tranferring' the original ! matrix A (i.e. the matrix to be preconditioned) to the level ilev, through smoothed ! aggregation. @@ -828,19 +831,20 @@ contains ! 5. Yext = beta*Yext + alpha*Y(1) ! ! - subroutine mlt_post_ml_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) + subroutine mlt_post_ml_aply(alpha,p,x,beta,y,desc_data,trans,work,info) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_donelev_type), intent(in) :: precv(:) + type(psb_desc_type),intent(in) :: desc_data + type(mld_dprec_type), intent(in) :: p +!!$ type(mld_donelev_type), intent(in) :: precv(:) real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: x(:) real(psb_dpk_),intent(inout) :: y(:) - character, intent(in) :: trans + character, intent(in) :: trans real(psb_dpk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info ! Local variables integer :: ictxt,np,me,i, nr2l,nc2l,err_act @@ -864,9 +868,9 @@ contains if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),& - & ' Entry ', size(precv) + & ' Entry ', size(p%precv) - nlev = size(precv) + nlev = size(p%precv) allocate(mlprec_wrk(nlev),stat=info) if (info /= 0) then call psb_errpush(4010,name,a_err='Allocate') @@ -882,7 +886,7 @@ contains & write(debug_unit,*) me,' ',trim(name),& & ' desc_data status',allocated(desc_data%matrix_data) - nc2l = psb_cd_get_local_cols(precv(1)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(1)%base_desc) allocate(mlprec_wrk(1)%x2l(nc2l),mlprec_wrk(1)%y2l(nc2l), & & mlprec_wrk(1)%tx(nc2l), stat=info) @@ -894,9 +898,9 @@ contains end if call psb_geaxpby(done,x,dzero,mlprec_wrk(1)%tx,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) call psb_geaxpby(done,x,dzero,mlprec_wrk(1)%x2l,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) ! ! STEP 2 @@ -905,13 +909,13 @@ contains ! do ilev=2, nlev - nc2l = psb_cd_get_local_cols(precv(ilev)%base_desc) - nr2l = psb_cd_get_local_rows(precv(ilev)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(ilev)%base_desc) + nr2l = psb_cd_get_local_rows(p%precv(ilev)%base_desc) if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name), & & ' starting up sweep ',& - & ilev,allocated(precv(ilev)%iprcparm),nc2l, nr2l + & ilev,allocated(p%precv(ilev)%iprcparm),nc2l, nr2l allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& & mlprec_wrk(ilev)%x2l(nc2l), stat=info) @@ -926,7 +930,7 @@ contains ! Apply prolongator transpose, i.e. restriction call psb_map_X2Y(done,mlprec_wrk(ilev-1)%x2l,& & dzero,mlprec_wrk(ilev)%x2l,& - & precv(ilev)%map,info,work=work) + & p%precv(ilev)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during restriction') @@ -937,7 +941,7 @@ contains ! update x2l ! call psb_geaxpby(done,mlprec_wrk(ilev)%x2l,dzero,mlprec_wrk(ilev)%tx,& - & precv(ilev)%base_desc,info) + & p%precv(ilev)%base_desc,info) if (info /= 0) then call psb_errpush(4001,name,a_err='Error in update') goto 9999 @@ -954,8 +958,8 @@ contains ! ! Apply the base preconditioner at the coarsest level ! - call mld_baseprec_aply(done,precv(nlev)%prec,mlprec_wrk(nlev)%x2l, & - & dzero, mlprec_wrk(nlev)%y2l,precv(nlev)%base_desc,trans,work,info) + call mld_baseprec_aply(done,p%precv(nlev)%prec,mlprec_wrk(nlev)%x2l, & + & dzero, mlprec_wrk(nlev)%y2l,p%precv(nlev)%base_desc,trans,work,info) if (info /=0) then call psb_errpush(4010,name,a_err='baseprec_aply') goto 9999 @@ -980,7 +984,7 @@ contains ! call psb_map_Y2X(done,mlprec_wrk(ilev+1)%y2l,& & dzero,mlprec_wrk(ilev)%y2l,& - & precv(ilev+1)%map,info,work=work) + & p%precv(ilev+1)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during prolongation') @@ -990,15 +994,15 @@ contains ! ! Compute the residual ! - call psb_spmm(-done,precv(ilev)%base_a,mlprec_wrk(ilev)%y2l,& - & done,mlprec_wrk(ilev)%tx,precv(ilev)%base_desc,info,& + call psb_spmm(-done,p%precv(ilev)%base_a,mlprec_wrk(ilev)%y2l,& + & done,mlprec_wrk(ilev)%tx,p%precv(ilev)%base_desc,info,& & work=work,trans=trans) ! ! Apply the base preconditioner ! - if (info == 0) call mld_baseprec_aply(done,precv(ilev)%prec,& - & mlprec_wrk(ilev)%tx,done,mlprec_wrk(ilev)%y2l,precv(ilev)%base_desc,& + if (info == 0) call mld_baseprec_aply(done,p%precv(ilev)%prec,& + & mlprec_wrk(ilev)%tx,done,mlprec_wrk(ilev)%y2l,p%precv(ilev)%base_desc,& & trans,work,info) if (info /=0) then call psb_errpush(4001,name,a_err=' spmm/baseprec_aply') @@ -1015,7 +1019,7 @@ contains ! ! Compute the output vector Y ! - call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,beta,y,precv(1)%base_desc,info) + call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,beta,y,p%precv(1)%base_desc,info) if (info /=0) then call psb_errpush(4001,name,a_err=' Final update') @@ -1052,7 +1056,7 @@ contains ! where ! - M is a symmetrized hybrid multilevel domain decomposition (Schwarz) ! preconditioner associated to a certain matrix A and stored in the array - ! precv, + ! p%precv, ! - op(M^(-1)) is M^(-1) or its transpose, according to the value of trans, ! - X and Y are vectors, ! - alpha and beta are scalars. @@ -1067,7 +1071,7 @@ contains ! ! The multilevel preconditioner M is regarded as an array of 'one-level preconditioners', ! each representing the part of the preconditioner associated to a certain level. - ! For each level ilev, the base preconditioner K(ilev) is stored in precv(ilev) + ! For each level ilev, the base preconditioner K(ilev) is stored in p%precv(ilev) ! and is associated to a matrix A(ilev), obtained by 'tranferring' the original ! matrix A (i.e. the matrix to be preconditioned) to the level ilev, through smoothed ! aggregation. @@ -1125,19 +1129,20 @@ contains ! ! 6. Yext = beta*Yext + alpha*Y(1) ! - subroutine mlt_twoside_ml_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) + subroutine mlt_twoside_ml_aply(alpha,p,x,beta,y,desc_data,trans,work,info) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_donelev_type), intent(in) :: precv(:) + type(psb_desc_type),intent(in) :: desc_data + type(mld_dprec_type), intent(in) :: p +!!$ type(mld_donelev_type), intent(in) :: p%precv(:) real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: x(:) real(psb_dpk_),intent(inout) :: y(:) - character, intent(in) :: trans + character, intent(in) :: trans real(psb_dpk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info ! Local variables integer :: ictxt,np,me,i, nr2l,nc2l,err_act @@ -1161,9 +1166,9 @@ contains if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),& - & ' Entry ', size(precv) + & ' Entry ', size(p%precv) - nlev = size(precv) + nlev = size(p%precv) allocate(mlprec_wrk(nlev),stat=info) if (info /= 0) then call psb_errpush(4010,name,a_err='Allocate') @@ -1174,7 +1179,7 @@ contains ! ! Copy the input vector X ! - nc2l = psb_cd_get_local_cols(precv(1)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(1)%base_desc) allocate(mlprec_wrk(1)%x2l(nc2l),mlprec_wrk(1)%y2l(nc2l), & & mlprec_wrk(1)%ty(nc2l), mlprec_wrk(1)%tx(nc2l), stat=info) @@ -1187,17 +1192,17 @@ contains end if call psb_geaxpby(done,x,dzero,mlprec_wrk(1)%x2l,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) call psb_geaxpby(done,x,dzero,mlprec_wrk(1)%tx,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) ! ! STEP 2 ! ! Apply the base preconditioner at the finest level ! - call mld_baseprec_aply(done,precv(1)%prec,mlprec_wrk(1)%x2l,& - & dzero,mlprec_wrk(1)%y2l,precv(1)%base_desc,& + call mld_baseprec_aply(done,p%precv(1)%prec,mlprec_wrk(1)%x2l,& + & dzero,mlprec_wrk(1)%y2l,p%precv(1)%base_desc,& & trans,work,info) ! ! STEP 3 @@ -1205,8 +1210,8 @@ contains ! Compute the residual at the finest level ! mlprec_wrk(1)%ty = mlprec_wrk(1)%x2l - if (info == 0) call psb_spmm(-done,precv(1)%base_a,mlprec_wrk(1)%y2l,& - & done,mlprec_wrk(1)%ty,precv(1)%base_desc,info,& + if (info == 0) call psb_spmm(-done,p%precv(1)%base_a,mlprec_wrk(1)%y2l,& + & done,mlprec_wrk(1)%ty,p%precv(1)%base_desc,info,& & work=work,trans=trans) if (info /=0) then call psb_errpush(4010,name,a_err='Fine level baseprec/residual') @@ -1220,8 +1225,8 @@ contains ! do ilev = 2, nlev - nc2l = psb_cd_get_local_cols(precv(ilev)%base_desc) - nr2l = psb_cd_get_local_rows(precv(ilev)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(ilev)%base_desc) + nr2l = psb_cd_get_local_rows(p%precv(ilev)%base_desc) allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%ty(nc2l),& & mlprec_wrk(ilev)%y2l(nc2l),mlprec_wrk(ilev)%x2l(nc2l), stat=info) @@ -1236,7 +1241,7 @@ contains ! Apply prolongator transpose, i.e. restriction call psb_map_X2Y(done,mlprec_wrk(ilev-1)%ty,& & dzero,mlprec_wrk(ilev)%x2l,& - & precv(ilev)%map,info,work=work) + & p%precv(ilev)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during restriction') @@ -1244,21 +1249,21 @@ contains end if call psb_geaxpby(done,mlprec_wrk(ilev)%x2l,dzero,mlprec_wrk(ilev)%tx,& - & precv(ilev)%base_desc,info) + & p%precv(ilev)%base_desc,info) ! ! Apply the base preconditioner ! - if (info == 0) call mld_baseprec_aply(done,precv(ilev)%prec,& + if (info == 0) call mld_baseprec_aply(done,p%precv(ilev)%prec,& & mlprec_wrk(ilev)%x2l,dzero,mlprec_wrk(ilev)%y2l,& - & precv(ilev)%base_desc,trans,work,info) + & p%precv(ilev)%base_desc,trans,work,info) ! ! Compute the residual (at all levels but the coarsest one) ! if(ilev < nlev) then mlprec_wrk(ilev)%ty = mlprec_wrk(ilev)%x2l - if (info == 0) call psb_spmm(-done,precv(ilev)%base_a,& + if (info == 0) call psb_spmm(-done,p%precv(ilev)%base_a,& & mlprec_wrk(ilev)%y2l,done,mlprec_wrk(ilev)%ty,& - & precv(ilev)%base_desc,info,work=work,trans=trans) + & p%precv(ilev)%base_desc,info,work=work,trans=trans) endif if (info /=0) then call psb_errpush(4001,name,a_err='baseprec_aply/residual') @@ -1279,7 +1284,7 @@ contains ! call psb_map_Y2X(done,mlprec_wrk(ilev+1)%y2l,& & done,mlprec_wrk(ilev)%y2l,& - & precv(ilev+1)%map,info,work=work) + & p%precv(ilev+1)%map,info,work=work) if (info /=0 ) then call psb_errpush(4001,name,a_err='Error during restriction') @@ -1289,14 +1294,14 @@ contains ! ! Compute the residual ! - call psb_spmm(-done,precv(ilev)%base_a,mlprec_wrk(ilev)%y2l,& - & done,mlprec_wrk(ilev)%tx,precv(ilev)%base_desc,info,& + call psb_spmm(-done,p%precv(ilev)%base_a,mlprec_wrk(ilev)%y2l,& + & done,mlprec_wrk(ilev)%tx,p%precv(ilev)%base_desc,info,& & work=work,trans=trans) ! ! Apply the base preconditioner ! - if (info == 0) call mld_baseprec_aply(done,precv(ilev)%prec,mlprec_wrk(ilev)%tx,& - & done,mlprec_wrk(ilev)%y2l,precv(ilev)%base_desc, trans, work,info) + if (info == 0) call mld_baseprec_aply(done,p%precv(ilev)%prec,mlprec_wrk(ilev)%tx,& + & done,mlprec_wrk(ilev)%y2l,p%precv(ilev)%base_desc, trans, work,info) if (info /= 0) then call psb_errpush(4001,name,a_err='Error: residual/baseprec_aply') goto 9999 @@ -1309,7 +1314,7 @@ contains ! Compute the output vector Y ! call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,beta,y,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) if (info /= 0) then call psb_errpush(4001,name,a_err='Error final update') diff --git a/mlprec/mld_dprecaply.f90 b/mlprec/mld_dprecaply.f90 index 6786ef71..3fa7ba00 100644 --- a/mlprec/mld_dprecaply.f90 +++ b/mlprec/mld_dprecaply.f90 @@ -127,7 +127,7 @@ subroutine mld_dprecaply(prec,x,y,desc_data,info,trans,work) goto 9999 end if if (size(prec%precv) >1) then - call mld_mlprec_aply(done,prec%precv,x,dzero,y,desc_data,trans_,work_,info) + call mld_mlprec_aply(done,prec,x,dzero,y,desc_data,trans_,work_,info) if(info /= 0) then call psb_errpush(4010,name,a_err='mld_dmlprec_aply') goto 9999 diff --git a/mlprec/mld_inner_mod.f90 b/mlprec/mld_inner_mod.f90 index dac83296..c13d6d79 100644 --- a/mlprec/mld_inner_mod.f90 +++ b/mlprec/mld_inner_mod.f90 @@ -186,23 +186,23 @@ module mld_inner_mod end interface interface mld_mlprec_aply - subroutine mld_smlprec_aply(alpha,precv,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 mld_prec_type, only : mld_sbaseprec_type, mld_sonelev_type + use mld_prec_type, only : mld_sbaseprec_type, mld_sprec_type type(psb_desc_type),intent(in) :: desc_data - type(mld_sonelev_type), intent(in) :: precv(:) + type(mld_sprec_type), intent(in) :: p real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: x(:) real(psb_spk_),intent(inout) :: y(:) - character :: trans + character :: trans real(psb_spk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info end subroutine mld_smlprec_aply - subroutine mld_dmlprec_aply(alpha,precv,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 mld_prec_type, only : mld_dbaseprec_type, mld_donelev_type - type(psb_desc_type),intent(in) :: desc_data - type(mld_donelev_type), intent(in) :: precv(:) + use mld_prec_type, only : mld_dbaseprec_type, mld_dprec_type + 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) :: x(:) real(psb_dpk_),intent(inout) :: y(:) @@ -210,29 +210,29 @@ module mld_inner_mod real(psb_dpk_),target :: work(:) integer, intent(out) :: info end subroutine mld_dmlprec_aply - subroutine mld_cmlprec_aply(alpha,baseprecv,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 mld_prec_type, only : mld_cbaseprec_type, mld_conelev_type - type(psb_desc_type),intent(in) :: desc_data - type(mld_conelev_type), intent(in) :: baseprecv(:) + use mld_prec_type, only : mld_cbaseprec_type, mld_cprec_type + 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) :: x(:) complex(psb_spk_),intent(inout) :: y(:) - character :: trans + character :: trans complex(psb_spk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info end subroutine mld_cmlprec_aply - subroutine mld_zmlprec_aply(alpha,baseprecv,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 mld_prec_type, only : mld_zbaseprec_type, mld_zonelev_type - type(psb_desc_type),intent(in) :: desc_data - type(mld_zonelev_type), intent(in) :: baseprecv(:) + use mld_prec_type, only : mld_zbaseprec_type, mld_zprec_type + 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) :: x(:) complex(psb_dpk_),intent(inout) :: y(:) - character :: trans + character :: trans complex(psb_dpk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info end subroutine mld_zmlprec_aply end interface diff --git a/mlprec/mld_smlprec_aply.f90 b/mlprec/mld_smlprec_aply.f90 index 47851b03..78db23d1 100644 --- a/mlprec/mld_smlprec_aply.f90 +++ b/mlprec/mld_smlprec_aply.f90 @@ -46,7 +46,7 @@ ! Y = beta*Y + alpha*op(M^(-1))*X, ! where ! - M is a multilevel domain decomposition (Schwarz) preconditioner associated -! to a certain matrix A and stored in the array precv, +! to a certain matrix A and stored in the array p%precv, ! - op(M^(-1)) is M^(-1) or its transpose, according to the value of trans, ! - X and Y are vectors, ! - alpha and beta are scalars. @@ -57,7 +57,7 @@ ! ! The multilevel preconditioner M is regarded as an array of 'one-level preconditioners', ! each representing the part of the preconditioner associated to a certain level. -! For each level ilev, the preconditioner K(ilev) is stored in precv(ilev) +! For each level ilev, the preconditioner K(ilev) is stored in p%precv(ilev) ! and is associated to a matrix A(ilev), obtained by 'tranferring' the original ! matrix A (i.e. the matrix to be preconditioned) to the level ilev, through smoothed ! aggregation. @@ -78,41 +78,41 @@ ! Arguments: ! alpha - real(psb_spk_), input. ! The scalar alpha. -! precv - type(mld_sonelev_type), dimension(:), input. +! p - type(mld_sprec_type), input. ! The array of one-level preconditioner data structures containing the ! local parts of the preconditioners to be applied at each level. -! Note that nlev = size(precv) = number of levels. -! precv(ilev)%prec - type(psb_sbaseprec_type) +! Note that nlev = size(p%precv) = number of levels. +! p%precv(ilev)%prec - type(psb_sbaseprec_type) ! The "base" preconditioner for the current level -! precv(ilev)%ac - type(psb_sspmat_type) +! p%precv(ilev)%ac - type(psb_sspmat_type) ! The local part of the matrix A(ilev). -! precv(ilev)%desc_ac - type(psb_desc_type). +! p%precv(ilev)%desc_ac - type(psb_desc_type). ! The communication descriptor associated to the sparse ! matrix A(ilev) -! precv(ilev)%map - type(psb_inter_desc_type) +! p%precv(ilev)%map - type(psb_inter_desc_type) ! Stores the linear operators mapping between levels ! (ilev-1) and (ilev). These are the restriction and ! prolongation operators described in the sequel. -! precv(ilev)%iprcparm - integer, dimension(:), allocatable. +! p%precv(ilev)%iprcparm - integer, dimension(:), allocatable. ! The integer parameters defining the multilevel ! strategy -! precv(ilev)%rprcparm - real(psb_spk_), dimension(:), allocatable. +! p%precv(ilev)%rprcparm - real(psb_spk_), dimension(:), allocatable. ! The real parameters defining the multilevel strategy -! precv(ilev)%mlia - integer, dimension(:), allocatable. +! p%precv(ilev)%mlia - integer, dimension(:), allocatable. ! The aggregation map (ilev-1) --> (ilev). ! In case of non-smoothed aggregation, it is used ! instead of mld_sm_pr_. -! precv(ilev)%nlaggr - integer, dimension(:), allocatable. +! p%precv(ilev)%nlaggr - integer, dimension(:), allocatable. ! The number of aggregates (rows of A(ilev)) on the ! various processes. -! precv(ilev)%base_a - type(psb_sspmat_type), pointer. +! p%precv(ilev)%base_a - type(psb_sspmat_type), pointer. ! Pointer (really a pointer!) to the base matrix of ! the current level, i.e. the local part of A(ilev); ! so we have a unified treatment of residuals. We ! need this to avoid passing explicitly the matrix ! A(ilev) to the routine which applies the ! preconditioner. -! precv(ilev)%base_desc - type(psb_desc_type), pointer. +! p%precv(ilev)%base_desc - type(psb_desc_type), pointer. ! Pointer to the communication descriptor associated ! to the sparse matrix pointed by base_a. ! @@ -136,10 +136,10 @@ ! Note that when the LU factorization of the matrix A(ilev) is computed instead of ! the ILU one, by using UMFPACK or SuperLU, the corresponding L and U factors ! are stored in data structures provided by UMFPACK or SuperLU and pointed by -! precv(ilev)%prec%iprcparm(mld_umf_ptr) or precv(ilev)%prec%iprcparm(mld_slu_ptr), +! p%precv(ilev)%prec%iprcparm(mld_umf_ptr) or p%precv(ilev)%prec%iprcparm(mld_slu_ptr), ! respectively. ! -subroutine mld_smlprec_aply(alpha,precv,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 use mld_inner_mod, mld_protect_name => mld_smlprec_aply @@ -147,14 +147,14 @@ subroutine mld_smlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_sonelev_type), intent(in) :: precv(:) + 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) :: x(:) real(psb_spk_),intent(inout) :: y(:) - character, intent(in) :: trans + character, intent(in) :: trans real(psb_spk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info ! Local variables integer :: ictxt, np, me, err_act @@ -173,11 +173,11 @@ subroutine mld_smlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),& - & ' Entry ', size(precv) + & ' Entry ', size(p%precv) trans_ = psb_toupper(trans) - select case(precv(2)%iprcparm(mld_ml_type_)) + select case(p%precv(2)%iprcparm(mld_ml_type_)) case(mld_no_ml_) ! @@ -191,7 +191,7 @@ subroutine mld_smlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) ! Additive multilevel ! - call add_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call add_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case(mld_mult_ml_) ! @@ -202,15 +202,15 @@ subroutine mld_smlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) ! Note that the transpose switches pre <-> post. ! - select case(precv(2)%iprcparm(mld_smoother_pos_)) + select case(p%precv(2)%iprcparm(mld_smoother_pos_)) case(mld_post_smooth_) select case (trans_) case('N') - call mlt_post_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call mlt_post_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case('T','C') - call mlt_pre_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call mlt_pre_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case default info = 4001 call psb_errpush(info,name,a_err='invalid trans') @@ -221,9 +221,9 @@ subroutine mld_smlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) select case (trans_) case('N') - call mlt_pre_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call mlt_pre_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case('T','C') - call mlt_post_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call mlt_post_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case default info = 4001 call psb_errpush(info,name,a_err='invalid trans') @@ -232,12 +232,12 @@ subroutine mld_smlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) case(mld_twoside_smooth_) - call mlt_twoside_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call mlt_twoside_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case default info = 4013 call psb_errpush(info,name,a_err='invalid smooth_pos',& - & i_Err=(/precv(2)%iprcparm(mld_smoother_pos_),0,0,0,0/)) + & i_Err=(/p%precv(2)%iprcparm(mld_smoother_pos_),0,0,0,0/)) goto 9999 end select @@ -245,7 +245,7 @@ subroutine mld_smlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) case default info = 4013 call psb_errpush(info,name,a_err='invalid mltype',& - & i_Err=(/precv(2)%iprcparm(mld_ml_type_),0,0,0,0/)) + & i_Err=(/p%precv(2)%iprcparm(mld_ml_type_),0,0,0,0/)) goto 9999 end select @@ -272,7 +272,7 @@ contains ! Y = beta*Y + alpha*op(M^(-1))*X, ! where ! - M is an additive multilevel domain decomposition (Schwarz) preconditioner - ! associated to a certain matrix A and stored in the array precv, + ! associated to a certain matrix A and stored in the array p%precv, ! - op(M^(-1)) is M^(-1) or its transpose, according to the value of trans, ! - X and Y are vectors, ! - alpha and beta are scalars. @@ -286,7 +286,7 @@ contains ! ! The multilevel preconditioner M is regarded as an array of 'one-level preconditioners', ! each representing the part of the preconditioner associated to a certain level. - ! For each level ilev, the base preconditioner K(ilev) is stored in precv(ilev) + ! For each level ilev, the base preconditioner K(ilev) is stored in p%precv(ilev) ! and is associated to a matrix A(ilev), obtained by 'tranferring' the original ! matrix A (i.e. the matrix to be preconditioned) to the level ilev, through smoothed ! aggregation. @@ -334,19 +334,19 @@ contains ! ! 4. Yext = beta*Yext + alpha*Y(1) ! - subroutine add_ml_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) + subroutine add_ml_aply(alpha,p,x,beta,y,desc_data,trans,work,info) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_sonelev_type), intent(in) :: precv(:) + 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) :: x(:) real(psb_spk_),intent(inout) :: y(:) - character, intent(in) :: trans + character, intent(in) :: trans real(psb_spk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info ! Local variables integer :: ictxt,np,me,i, nr2l,nc2l,err_act @@ -370,9 +370,9 @@ contains if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),& - & ' Entry ', size(precv) + & ' Entry ', size(p%precv) - nlev = size(precv) + nlev = size(p%precv) allocate(mlprec_wrk(nlev),stat=info) if (info /= 0) then call psb_errpush(4010,name,a_err='Allocate') @@ -395,8 +395,8 @@ contains mlprec_wrk(1)%x2l(:) = x(:) mlprec_wrk(1)%y2l(:) = szero - call mld_baseprec_aply(alpha,precv(1)%prec,x,beta,y,& - & precv(1)%base_desc,trans,work,info) + call mld_baseprec_aply(alpha,p%precv(1)%prec,x,beta,y,& + & p%precv(1)%base_desc,trans,work,info) if (info /=0) then call psb_errpush(4010,name,a_err='baseprec_aply') goto 9999 @@ -407,8 +407,8 @@ contains ! For each level except the finest one ... ! do ilev = 2, nlev - nc2l = psb_cd_get_local_cols(precv(ilev)%base_desc) - nr2l = psb_cd_get_local_rows(precv(ilev)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(ilev)%base_desc) + nr2l = psb_cd_get_local_rows(p%precv(ilev)%base_desc) allocate(mlprec_wrk(ilev)%x2l(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& & stat=info) if (info /= 0) then @@ -421,7 +421,7 @@ contains ! Apply prolongator transpose, i.e. restriction call psb_map_X2Y(sone,mlprec_wrk(ilev-1)%x2l,& & szero,mlprec_wrk(ilev)%x2l,& - & precv(ilev)%map,info,work=work) + & p%precv(ilev)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during restriction') @@ -431,9 +431,9 @@ contains ! ! Apply the base preconditioner ! - call mld_baseprec_aply(sone,precv(ilev)%prec,& + call mld_baseprec_aply(sone,p%precv(ilev)%prec,& & mlprec_wrk(ilev)%x2l,szero,mlprec_wrk(ilev)%y2l,& - & precv(ilev)%base_desc, trans,work,info) + & p%precv(ilev)%base_desc, trans,work,info) enddo @@ -444,15 +444,15 @@ contains ! do ilev =nlev,2,-1 - nc2l = psb_cd_get_local_cols(precv(ilev)%base_desc) - nr2l = psb_cd_get_local_rows(precv(ilev)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(ilev)%base_desc) + nr2l = psb_cd_get_local_rows(p%precv(ilev)%base_desc) ! ! Apply prolongator ! call psb_map_Y2X(sone,mlprec_wrk(ilev)%y2l,& & sone,mlprec_wrk(ilev-1)%y2l,& - & precv(ilev)%map,info,work=work) + & p%precv(ilev)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during prolongation') @@ -465,7 +465,7 @@ contains ! ! Compute the output vector Y ! - call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,sone,y,precv(1)%base_desc,info) + call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,sone,y,p%precv(1)%base_desc,info) if (info /= 0) then call psb_errpush(4001,name,a_err='Error on final update') goto 9999 @@ -499,7 +499,7 @@ contains ! Y = beta*Y + alpha*op(M^(-1))*X, ! where ! - M is a hybrid multilevel domain decomposition (Schwarz) preconditioner - ! associated to a certain matrix A and stored in the array precv, + ! associated to a certain matrix A and stored in the array p%precv, ! - op(M^(-1)) is M^(-1) or its transpose, according to the value of trans, ! - X and Y are vectors, ! - alpha and beta are scalars. @@ -513,7 +513,7 @@ contains ! ! The multilevel preconditioner M is regarded as an array of 'one-level preconditioners', ! each representing the part of the preconditioner associated to a certain level. - ! For each level ilev, the base preconditioner K(ilev) is stored in precv(ilev) + ! For each level ilev, the base preconditioner K(ilev) is stored in p%precv(ilev) ! and is associated to a matrix A(ilev), obtained by 'tranferring' the original ! matrix A (i.e. the matrix to be preconditioned) to the level ilev, through smoothed ! aggregation. @@ -569,19 +569,19 @@ contains ! 6. Yext = beta*Yext + alpha*Y(1) ! ! - subroutine mlt_pre_ml_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) + subroutine mlt_pre_ml_aply(alpha,p,x,beta,y,desc_data,trans,work,info) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_sonelev_type), intent(in) :: precv(:) + 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) :: x(:) real(psb_spk_),intent(inout) :: y(:) - character, intent(in) :: trans + character, intent(in) :: trans real(psb_spk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info ! Local variables integer :: ictxt,np,me,i, nr2l,nc2l,err_act @@ -605,9 +605,9 @@ contains if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),& - & ' Entry ', size(precv) + & ' Entry ', size(p%precv) - nlev = size(precv) + nlev = size(p%precv) allocate(mlprec_wrk(nlev),stat=info) if (info /= 0) then call psb_errpush(4010,name,a_err='Allocate') @@ -619,7 +619,7 @@ contains ! ! Copy the input vector X ! - nc2l = psb_cd_get_local_cols(precv(1)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(1)%base_desc) allocate(mlprec_wrk(1)%x2l(nc2l),mlprec_wrk(1)%y2l(nc2l), & & mlprec_wrk(1)%tx(nc2l), stat=info) @@ -636,8 +636,8 @@ contains ! ! Apply the base preconditioner at the finest level ! - call mld_baseprec_aply(sone,precv(1)%prec,mlprec_wrk(1)%x2l,& - & szero,mlprec_wrk(1)%y2l,precv(1)%base_desc,& + call mld_baseprec_aply(sone,p%precv(1)%prec,mlprec_wrk(1)%x2l,& + & szero,mlprec_wrk(1)%y2l,p%precv(1)%base_desc,& & trans,work,info) if (info /=0) then call psb_errpush(4010,name,a_err=' baseprec_aply') @@ -651,8 +651,8 @@ contains ! mlprec_wrk(1)%tx = mlprec_wrk(1)%x2l - call psb_spmm(-sone,precv(1)%base_a,mlprec_wrk(1)%y2l,& - & sone,mlprec_wrk(1)%tx,precv(1)%base_desc,info,& + call psb_spmm(-sone,p%precv(1)%base_a,mlprec_wrk(1)%y2l,& + & sone,mlprec_wrk(1)%tx,p%precv(1)%base_desc,info,& & work=work,trans=trans) if (info /=0) then call psb_errpush(4001,name,a_err=' fine level residual') @@ -666,8 +666,8 @@ contains ! do ilev = 2, nlev - nc2l = psb_cd_get_local_cols(precv(ilev)%base_desc) - nr2l = psb_cd_get_local_rows(precv(ilev)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(ilev)%base_desc) + nr2l = psb_cd_get_local_rows(p%precv(ilev)%base_desc) allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& & mlprec_wrk(ilev)%x2l(nc2l), stat=info) @@ -681,7 +681,7 @@ contains ! Apply prolongator transpose, i.e. restriction call psb_map_X2Y(sone,mlprec_wrk(ilev-1)%tx,& & szero,mlprec_wrk(ilev)%x2l,& - & precv(ilev)%map,info,work=work) + & p%precv(ilev)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during restriction') @@ -691,17 +691,17 @@ contains ! ! Apply the base preconditioner ! - call mld_baseprec_aply(sone,precv(ilev)%prec,mlprec_wrk(ilev)%x2l,& - & szero,mlprec_wrk(ilev)%y2l,precv(ilev)%base_desc,trans,work,info) + call mld_baseprec_aply(sone,p%precv(ilev)%prec,mlprec_wrk(ilev)%x2l,& + & szero,mlprec_wrk(ilev)%y2l,p%precv(ilev)%base_desc,trans,work,info) ! ! Compute the residual (at all levels but the coarsest one) ! if (ilev < nlev) then mlprec_wrk(ilev)%tx = mlprec_wrk(ilev)%x2l - if (info == 0) call psb_spmm(-sone,precv(ilev)%base_a,& + if (info == 0) call psb_spmm(-sone,p%precv(ilev)%base_a,& & mlprec_wrk(ilev)%y2l,sone,mlprec_wrk(ilev)%tx,& - & precv(ilev)%base_desc,info,work=work,trans=trans) + & p%precv(ilev)%base_desc,info,work=work,trans=trans) endif if (info /=0) then call psb_errpush(4001,name,a_err='Error on up sweep residual') @@ -720,7 +720,7 @@ contains ! call psb_map_Y2X(sone,mlprec_wrk(ilev+1)%y2l,& & sone,mlprec_wrk(ilev)%y2l,& - & precv(ilev+1)%map,info,work=work) + & p%precv(ilev+1)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during prolongation') @@ -734,7 +734,7 @@ contains ! Compute the output vector Y ! call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,beta,y,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) if (info /=0) then call psb_errpush(4001,name,a_err='Error on final update') goto 9999 @@ -767,7 +767,7 @@ contains ! Y = beta*Y + alpha*op(M^(-1))*X, ! where ! - M is a hybrid multilevel domain decomposition (Schwarz) preconditioner - ! associated to a certain matrix A and stored in the array precv, + ! associated to a certain matrix A and stored in the array p%precv, ! - op(M^(-1)) is M^(-1) or its transpose, according to the value of trans, ! - X and Y are vectors, ! - alpha and beta are scalars. @@ -781,7 +781,7 @@ contains ! ! The multilevel preconditioner M is regarded as an array of 'one-level preconditioners', ! each representing the part of the preconditioner associated to a certain level. - ! For each level ilev, the base preconditioner K(ilev) is stored in precv(ilev) + ! For each level ilev, the base preconditioner K(ilev) is stored in p%precv(ilev) ! and is associated to a matrix A(ilev), obtained by 'tranferring' the original ! matrix A (i.e. the matrix to be preconditioned) to the level ilev, through smoothed ! aggregation. @@ -828,19 +828,19 @@ contains ! 5. Yext = beta*Yext + alpha*Y(1) ! ! - subroutine mlt_post_ml_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) + subroutine mlt_post_ml_aply(alpha,p,x,beta,y,desc_data,trans,work,info) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_sonelev_type), intent(in) :: precv(:) + 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) :: x(:) real(psb_spk_),intent(inout) :: y(:) - character, intent(in) :: trans + character, intent(in) :: trans real(psb_spk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info ! Local variables integer :: ictxt,np,me,i, nr2l,nc2l,err_act @@ -864,9 +864,9 @@ contains if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),& - & ' Entry ', size(precv) + & ' Entry ', size(p%precv) - nlev = size(precv) + nlev = size(p%precv) allocate(mlprec_wrk(nlev),stat=info) if (info /= 0) then call psb_errpush(4010,name,a_err='Allocate') @@ -882,7 +882,7 @@ contains & write(debug_unit,*) me,' ',trim(name),& & ' desc_data status',allocated(desc_data%matrix_data) - nc2l = psb_cd_get_local_cols(precv(1)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(1)%base_desc) allocate(mlprec_wrk(1)%x2l(nc2l),mlprec_wrk(1)%y2l(nc2l), & & mlprec_wrk(1)%tx(nc2l), stat=info) @@ -894,9 +894,9 @@ contains end if call psb_geaxpby(sone,x,szero,mlprec_wrk(1)%tx,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) call psb_geaxpby(sone,x,szero,mlprec_wrk(1)%x2l,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) ! ! STEP 2 @@ -905,13 +905,13 @@ contains ! do ilev=2, nlev - nc2l = psb_cd_get_local_cols(precv(ilev)%base_desc) - nr2l = psb_cd_get_local_rows(precv(ilev)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(ilev)%base_desc) + nr2l = psb_cd_get_local_rows(p%precv(ilev)%base_desc) if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name), & & ' starting up sweep ',& - & ilev,allocated(precv(ilev)%iprcparm),nc2l, nr2l + & ilev,allocated(p%precv(ilev)%iprcparm),nc2l, nr2l allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& & mlprec_wrk(ilev)%x2l(nc2l), stat=info) @@ -926,7 +926,7 @@ contains ! Apply prolongator transpose, i.e. restriction call psb_map_X2Y(sone,mlprec_wrk(ilev-1)%x2l,& & szero,mlprec_wrk(ilev)%x2l,& - & precv(ilev)%map,info,work=work) + & p%precv(ilev)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during restriction') @@ -937,7 +937,7 @@ contains ! update x2l ! call psb_geaxpby(sone,mlprec_wrk(ilev)%x2l,szero,mlprec_wrk(ilev)%tx,& - & precv(ilev)%base_desc,info) + & p%precv(ilev)%base_desc,info) if (info /= 0) then call psb_errpush(4001,name,a_err='Error in update') goto 9999 @@ -954,8 +954,8 @@ contains ! ! Apply the base preconditioner at the coarsest level ! - call mld_baseprec_aply(sone,precv(nlev)%prec,mlprec_wrk(nlev)%x2l, & - & szero, mlprec_wrk(nlev)%y2l,precv(nlev)%base_desc,trans,work,info) + call mld_baseprec_aply(sone,p%precv(nlev)%prec,mlprec_wrk(nlev)%x2l, & + & szero, mlprec_wrk(nlev)%y2l,p%precv(nlev)%base_desc,trans,work,info) if (info /=0) then call psb_errpush(4010,name,a_err='baseprec_aply') goto 9999 @@ -980,7 +980,7 @@ contains ! call psb_map_Y2X(sone,mlprec_wrk(ilev+1)%y2l,& & szero,mlprec_wrk(ilev)%y2l,& - & precv(ilev+1)%map,info,work=work) + & p%precv(ilev+1)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during prolongation') @@ -990,15 +990,15 @@ contains ! ! Compute the residual ! - call psb_spmm(-sone,precv(ilev)%base_a,mlprec_wrk(ilev)%y2l,& - & sone,mlprec_wrk(ilev)%tx,precv(ilev)%base_desc,info,& + call psb_spmm(-sone,p%precv(ilev)%base_a,mlprec_wrk(ilev)%y2l,& + & sone,mlprec_wrk(ilev)%tx,p%precv(ilev)%base_desc,info,& & work=work,trans=trans) ! ! Apply the base preconditioner ! - if (info == 0) call mld_baseprec_aply(sone,precv(ilev)%prec,& - & mlprec_wrk(ilev)%tx,sone,mlprec_wrk(ilev)%y2l,precv(ilev)%base_desc,& + if (info == 0) call mld_baseprec_aply(sone,p%precv(ilev)%prec,& + & mlprec_wrk(ilev)%tx,sone,mlprec_wrk(ilev)%y2l,p%precv(ilev)%base_desc,& & trans,work,info) if (info /=0) then call psb_errpush(4001,name,a_err=' spmm/baseprec_aply') @@ -1015,7 +1015,7 @@ contains ! ! Compute the output vector Y ! - call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,beta,y,precv(1)%base_desc,info) + call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,beta,y,p%precv(1)%base_desc,info) if (info /=0) then call psb_errpush(4001,name,a_err=' Final update') @@ -1052,7 +1052,7 @@ contains ! where ! - M is a symmetrized hybrid multilevel domain decomposition (Schwarz) ! preconditioner associated to a certain matrix A and stored in the array - ! precv, + ! p%precv, ! - op(M^(-1)) is M^(-1) or its transpose, according to the value of trans, ! - X and Y are vectors, ! - alpha and beta are scalars. @@ -1067,7 +1067,7 @@ contains ! ! The multilevel preconditioner M is regarded as an array of 'one-level preconditioners', ! each representing the part of the preconditioner associated to a certain level. - ! For each level ilev, the base preconditioner K(ilev) is stored in precv(ilev) + ! For each level ilev, the base preconditioner K(ilev) is stored in p%precv(ilev) ! and is associated to a matrix A(ilev), obtained by 'tranferring' the original ! matrix A (i.e. the matrix to be preconditioned) to the level ilev, through smoothed ! aggregation. @@ -1125,19 +1125,19 @@ contains ! ! 6. Yext = beta*Yext + alpha*Y(1) ! - subroutine mlt_twoside_ml_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) + subroutine mlt_twoside_ml_aply(alpha,p,x,beta,y,desc_data,trans,work,info) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_sonelev_type), intent(in) :: precv(:) + 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) :: x(:) real(psb_spk_),intent(inout) :: y(:) - character, intent(in) :: trans + character, intent(in) :: trans real(psb_spk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info ! Local variables integer :: ictxt,np,me,i, nr2l,nc2l,err_act @@ -1161,9 +1161,9 @@ contains if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),& - & ' Entry ', size(precv) + & ' Entry ', size(p%precv) - nlev = size(precv) + nlev = size(p%precv) allocate(mlprec_wrk(nlev),stat=info) if (info /= 0) then call psb_errpush(4010,name,a_err='Allocate') @@ -1174,7 +1174,7 @@ contains ! ! Copy the input vector X ! - nc2l = psb_cd_get_local_cols(precv(1)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(1)%base_desc) allocate(mlprec_wrk(1)%x2l(nc2l),mlprec_wrk(1)%y2l(nc2l), & & mlprec_wrk(1)%ty(nc2l), mlprec_wrk(1)%tx(nc2l), stat=info) @@ -1187,17 +1187,17 @@ contains end if call psb_geaxpby(sone,x,szero,mlprec_wrk(1)%x2l,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) call psb_geaxpby(sone,x,szero,mlprec_wrk(1)%tx,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) ! ! STEP 2 ! ! Apply the base preconditioner at the finest level ! - call mld_baseprec_aply(sone,precv(1)%prec,mlprec_wrk(1)%x2l,& - & szero,mlprec_wrk(1)%y2l,precv(1)%base_desc,& + call mld_baseprec_aply(sone,p%precv(1)%prec,mlprec_wrk(1)%x2l,& + & szero,mlprec_wrk(1)%y2l,p%precv(1)%base_desc,& & trans,work,info) ! ! STEP 3 @@ -1205,8 +1205,8 @@ contains ! Compute the residual at the finest level ! mlprec_wrk(1)%ty = mlprec_wrk(1)%x2l - if (info == 0) call psb_spmm(-sone,precv(1)%base_a,mlprec_wrk(1)%y2l,& - & sone,mlprec_wrk(1)%ty,precv(1)%base_desc,info,& + if (info == 0) call psb_spmm(-sone,p%precv(1)%base_a,mlprec_wrk(1)%y2l,& + & sone,mlprec_wrk(1)%ty,p%precv(1)%base_desc,info,& & work=work,trans=trans) if (info /=0) then call psb_errpush(4010,name,a_err='Fine level baseprec/residual') @@ -1220,8 +1220,8 @@ contains ! do ilev = 2, nlev - nc2l = psb_cd_get_local_cols(precv(ilev)%base_desc) - nr2l = psb_cd_get_local_rows(precv(ilev)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(ilev)%base_desc) + nr2l = psb_cd_get_local_rows(p%precv(ilev)%base_desc) allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%ty(nc2l),& & mlprec_wrk(ilev)%y2l(nc2l),mlprec_wrk(ilev)%x2l(nc2l), stat=info) @@ -1236,7 +1236,7 @@ contains ! Apply prolongator transpose, i.e. restriction call psb_map_X2Y(sone,mlprec_wrk(ilev-1)%ty,& & szero,mlprec_wrk(ilev)%x2l,& - & precv(ilev)%map,info,work=work) + & p%precv(ilev)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during restriction') @@ -1244,21 +1244,21 @@ contains end if call psb_geaxpby(sone,mlprec_wrk(ilev)%x2l,szero,mlprec_wrk(ilev)%tx,& - & precv(ilev)%base_desc,info) + & p%precv(ilev)%base_desc,info) ! ! Apply the base preconditioner ! - if (info == 0) call mld_baseprec_aply(sone,precv(ilev)%prec,& + if (info == 0) call mld_baseprec_aply(sone,p%precv(ilev)%prec,& & mlprec_wrk(ilev)%x2l,szero,mlprec_wrk(ilev)%y2l,& - & precv(ilev)%base_desc,trans,work,info) + & p%precv(ilev)%base_desc,trans,work,info) ! ! Compute the residual (at all levels but the coarsest one) ! if(ilev < nlev) then mlprec_wrk(ilev)%ty = mlprec_wrk(ilev)%x2l - if (info == 0) call psb_spmm(-sone,precv(ilev)%base_a,& + if (info == 0) call psb_spmm(-sone,p%precv(ilev)%base_a,& & mlprec_wrk(ilev)%y2l,sone,mlprec_wrk(ilev)%ty,& - & precv(ilev)%base_desc,info,work=work,trans=trans) + & p%precv(ilev)%base_desc,info,work=work,trans=trans) endif if (info /=0) then call psb_errpush(4001,name,a_err='baseprec_aply/residual') @@ -1279,7 +1279,7 @@ contains ! call psb_map_Y2X(sone,mlprec_wrk(ilev+1)%y2l,& & sone,mlprec_wrk(ilev)%y2l,& - & precv(ilev+1)%map,info,work=work) + & p%precv(ilev+1)%map,info,work=work) if (info /=0 ) then call psb_errpush(4001,name,a_err='Error during restriction') @@ -1289,14 +1289,14 @@ contains ! ! Compute the residual ! - call psb_spmm(-sone,precv(ilev)%base_a,mlprec_wrk(ilev)%y2l,& - & sone,mlprec_wrk(ilev)%tx,precv(ilev)%base_desc,info,& + call psb_spmm(-sone,p%precv(ilev)%base_a,mlprec_wrk(ilev)%y2l,& + & sone,mlprec_wrk(ilev)%tx,p%precv(ilev)%base_desc,info,& & work=work,trans=trans) ! ! Apply the base preconditioner ! - if (info == 0) call mld_baseprec_aply(sone,precv(ilev)%prec,mlprec_wrk(ilev)%tx,& - & sone,mlprec_wrk(ilev)%y2l,precv(ilev)%base_desc, trans, work,info) + if (info == 0) call mld_baseprec_aply(sone,p%precv(ilev)%prec,mlprec_wrk(ilev)%tx,& + & sone,mlprec_wrk(ilev)%y2l,p%precv(ilev)%base_desc, trans, work,info) if (info /= 0) then call psb_errpush(4001,name,a_err='Error: residual/baseprec_aply') goto 9999 @@ -1309,7 +1309,7 @@ contains ! Compute the output vector Y ! call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,beta,y,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) if (info /= 0) then call psb_errpush(4001,name,a_err='Error final update') diff --git a/mlprec/mld_sprecaply.f90 b/mlprec/mld_sprecaply.f90 index 81f57d5f..4877ad84 100644 --- a/mlprec/mld_sprecaply.f90 +++ b/mlprec/mld_sprecaply.f90 @@ -80,12 +80,12 @@ subroutine mld_sprecaply(prec,x,y,desc_data,info,trans,work) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_sprec_type), intent(in) :: prec + type(psb_desc_type),intent(in) :: desc_data + type(mld_sprec_type), intent(in) :: prec real(psb_spk_),intent(in) :: x(:) real(psb_spk_),intent(inout) :: y(:) - integer, intent(out) :: info - character(len=1), optional :: trans + integer, intent(out) :: info + character(len=1), optional :: trans real(psb_spk_), optional, target :: work(:) ! Local variables @@ -127,7 +127,7 @@ subroutine mld_sprecaply(prec,x,y,desc_data,info,trans,work) goto 9999 end if if (size(prec%precv) >1) then - call mld_mlprec_aply(sone,prec%precv,x,szero,y,desc_data,trans_,work_,info) + call mld_mlprec_aply(sone,prec,x,szero,y,desc_data,trans_,work_,info) if(info /= 0) then call psb_errpush(4010,name,a_err='mld_smlprec_aply') goto 9999 diff --git a/mlprec/mld_zmlprec_aply.f90 b/mlprec/mld_zmlprec_aply.f90 index 35c55cd9..24740569 100644 --- a/mlprec/mld_zmlprec_aply.f90 +++ b/mlprec/mld_zmlprec_aply.f90 @@ -78,41 +78,41 @@ ! Arguments: ! alpha - complex(psb_dpk_), input. ! The scalar alpha. -! precv - type(mld_zonelev_type), dimension(:), input. +! p - type(mld_zprec_type), input. ! The array of one-level preconditioner data structures containing the ! local parts of the preconditioners to be applied at each level. -! Note that nlev = size(precv) = number of levels. -! precv(ilev)%prec - type(psb_zbaseprec_type) +! Note that nlev = size(p%precv) = number of levels. +! p%p%precv(ilev)%prec - type(psb_zbaseprec_type) ! The "base" preconditioner for the current level -! precv(ilev)%ac - type(psb_zspmat_type) +! p%precv(ilev)%ac - type(psb_zspmat_type) ! The local part of the matrix A(ilev). -! precv(ilev)%desc_ac - type(psb_desc_type). +! p%precv(ilev)%desc_ac - type(psb_desc_type). ! The communication descriptor associated to the sparse ! matrix A(ilev) -! precv(ilev)%map - type(psb_inter_desc_type) +! p%precv(ilev)%map - type(psb_inter_desc_type) ! Stores the linear operators mapping between levels ! (ilev-1) and (ilev). These are the restriction and ! prolongation operators described in the sequel. -! precv(ilev)%iprcparm - integer, dimension(:), allocatable. +! p%precv(ilev)%iprcparm - integer, dimension(:), allocatable. ! The integer parameters defining the multilevel ! strategy -! precv(ilev)%rprcparm - real(psb_dpk_), dimension(:), allocatable. +! p%precv(ilev)%rprcparm - real(psb_dpk_), dimension(:), allocatable. ! The real parameters defining the multilevel strategy -! precv(ilev)%mlia - integer, dimension(:), allocatable. +! p%precv(ilev)%mlia - integer, dimension(:), allocatable. ! The aggregation map (ilev-1) --> (ilev). ! In case of non-smoothed aggregation, it is used ! instead of mld_sm_pr_. -! precv(ilev)%nlaggr - integer, dimension(:), allocatable. +! p%precv(ilev)%nlaggr - integer, dimension(:), allocatable. ! The number of aggregates (rows of A(ilev)) on the ! various processes. -! precv(ilev)%base_a - type(psb_zspmat_type), pointer. +! p%precv(ilev)%base_a - type(psb_zspmat_type), pointer. ! Pointer (really a pointer!) to the base matrix of ! the current level, i.e. the local part of A(ilev); ! so we have a unified treatment of residuals. We ! need this to avoid passing explicitly the matrix ! A(ilev) to the routine which applies the ! preconditioner. -! precv(ilev)%base_desc - type(psb_desc_type), pointer. +! p%precv(ilev)%base_desc - type(psb_desc_type), pointer. ! Pointer to the communication descriptor associated ! to the sparse matrix pointed by base_a. ! @@ -136,10 +136,10 @@ ! Note that when the LU factorization of the matrix A(ilev) is computed instead of ! the ILU one, by using UMFPACK or SuperLU, the corresponding L and U factors ! are stored in data structures provided by UMFPACK or SuperLU and pointed by -! precv(ilev)%prec%iprcparm(mld_umf_ptr) or precv(ilev)%prec%iprcparm(mld_slu_ptr), +! p%precv(ilev)%prec%iprcparm(mld_umf_ptr) or p%precv(ilev)%prec%iprcparm(mld_slu_ptr), ! respectively. ! -subroutine mld_zmlprec_aply(alpha,precv,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 use mld_inner_mod, mld_protect_name => mld_zmlprec_aply @@ -147,14 +147,14 @@ subroutine mld_zmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_zonelev_type), intent(in) :: precv(:) + 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) :: x(:) complex(psb_dpk_),intent(inout) :: y(:) - character, intent(in) :: trans + character, intent(in) :: trans complex(psb_dpk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info ! Local variables integer :: ictxt, np, me, err_act @@ -173,11 +173,11 @@ subroutine mld_zmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),& - & ' Entry ', size(precv) + & ' Entry ', size(p%precv) trans_ = psb_toupper(trans) - select case(precv(2)%iprcparm(mld_ml_type_)) + select case(p%precv(2)%iprcparm(mld_ml_type_)) case(mld_no_ml_) ! @@ -191,7 +191,7 @@ subroutine mld_zmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) ! Additive multilevel ! - call add_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call add_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case(mld_mult_ml_) ! @@ -202,15 +202,15 @@ subroutine mld_zmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) ! Note that the transpose switches pre <-> post. ! - select case(precv(2)%iprcparm(mld_smoother_pos_)) + select case(p%precv(2)%iprcparm(mld_smoother_pos_)) case(mld_post_smooth_) select case (trans_) case('N') - call mlt_post_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call mlt_post_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case('T','C') - call mlt_pre_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call mlt_pre_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case default info = 4001 call psb_errpush(info,name,a_err='invalid trans') @@ -221,9 +221,9 @@ subroutine mld_zmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) select case (trans_) case('N') - call mlt_pre_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call mlt_pre_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case('T','C') - call mlt_post_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call mlt_post_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case default info = 4001 call psb_errpush(info,name,a_err='invalid trans') @@ -232,12 +232,12 @@ subroutine mld_zmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) case(mld_twoside_smooth_) - call mlt_twoside_ml_aply(alpha,precv,x,beta,y,desc_data,trans_,work,info) + call mlt_twoside_ml_aply(alpha,p,x,beta,y,desc_data,trans_,work,info) case default info = 4013 call psb_errpush(info,name,a_err='invalid smooth_pos',& - & i_Err=(/precv(2)%iprcparm(mld_smoother_pos_),0,0,0,0/)) + & i_Err=(/p%precv(2)%iprcparm(mld_smoother_pos_),0,0,0,0/)) goto 9999 end select @@ -245,7 +245,7 @@ subroutine mld_zmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) case default info = 4013 call psb_errpush(info,name,a_err='invalid mltype',& - & i_Err=(/precv(2)%iprcparm(mld_ml_type_),0,0,0,0/)) + & i_Err=(/p%precv(2)%iprcparm(mld_ml_type_),0,0,0,0/)) goto 9999 end select @@ -272,7 +272,7 @@ contains ! Y = beta*Y + alpha*op(M^(-1))*X, ! where ! - M is an additive multilevel domain decomposition (Schwarz) preconditioner - ! associated to a certain matrix A and stored in the array precv, + ! associated to a certain matrix A and stored in the array p%precv, ! - op(M^(-1)) is M^(-1) or its (conjugate) transpose, according to ! the value of trans, ! - X and Y are vectors, @@ -287,7 +287,7 @@ contains ! ! The multilevel preconditioner M is regarded as an array of 'one-level preconditioners', ! each representing the part of the preconditioner associated to a certain level. - ! For each level ilev, the base preconditioner K(ilev) is stored in precv(ilev) + ! For each level ilev, the base preconditioner K(ilev) is stored in p%precv(ilev) ! and is associated to a matrix A(ilev), obtained by 'tranferring' the original ! matrix A (i.e. the matrix to be preconditioned) to the level ilev, through smoothed ! aggregation. @@ -335,19 +335,19 @@ contains ! ! 4. Yext = beta*Yext + alpha*Y(1) ! - subroutine add_ml_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) + subroutine add_ml_aply(alpha,p,x,beta,y,desc_data,trans,work,info) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_zonelev_type), intent(in) :: precv(:) + 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) :: x(:) complex(psb_dpk_),intent(inout) :: y(:) - character, intent(in) :: trans + character, intent(in) :: trans complex(psb_dpk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info ! Local variables integer :: ictxt,np,me,i, nr2l,nc2l,err_act @@ -371,9 +371,9 @@ contains if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),& - & ' Entry ', size(precv) + & ' Entry ', size(p%precv) - nlev = size(precv) + nlev = size(p%precv) allocate(mlprec_wrk(nlev),stat=info) if (info /= 0) then call psb_errpush(4010,name,a_err='Allocate') @@ -396,8 +396,8 @@ contains mlprec_wrk(1)%x2l(:) = x(:) mlprec_wrk(1)%y2l(:) = zzero - call mld_baseprec_aply(alpha,precv(1)%prec,x,beta,y,& - & precv(1)%base_desc,trans,work,info) + call mld_baseprec_aply(alpha,p%precv(1)%prec,x,beta,y,& + & p%precv(1)%base_desc,trans,work,info) if (info /=0) then call psb_errpush(4010,name,a_err='baseprec_aply') goto 9999 @@ -408,8 +408,8 @@ contains ! For each level except the finest one ... ! do ilev = 2, nlev - nc2l = psb_cd_get_local_cols(precv(ilev)%base_desc) - nr2l = psb_cd_get_local_rows(precv(ilev)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(ilev)%base_desc) + nr2l = psb_cd_get_local_rows(p%precv(ilev)%base_desc) allocate(mlprec_wrk(ilev)%x2l(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& & stat=info) if (info /= 0) then @@ -422,7 +422,7 @@ contains ! Apply prolongator transpose, i.e. restriction call psb_map_X2Y(zone,mlprec_wrk(ilev-1)%x2l,& & zzero,mlprec_wrk(ilev)%x2l,& - & precv(ilev)%map,info,work=work) + & p%precv(ilev)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during restriction') @@ -432,9 +432,9 @@ contains ! ! Apply the base preconditioner ! - call mld_baseprec_aply(zone,precv(ilev)%prec,& + call mld_baseprec_aply(zone,p%precv(ilev)%prec,& & mlprec_wrk(ilev)%x2l,zzero,mlprec_wrk(ilev)%y2l,& - & precv(ilev)%base_desc,trans,work,info) + & p%precv(ilev)%base_desc,trans,work,info) enddo @@ -445,15 +445,15 @@ contains ! do ilev =nlev,2,-1 - nc2l = psb_cd_get_local_cols(precv(ilev)%base_desc) - nr2l = psb_cd_get_local_rows(precv(ilev)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(ilev)%base_desc) + nr2l = psb_cd_get_local_rows(p%precv(ilev)%base_desc) ! ! Apply prolongator ! call psb_map_Y2X(zone,mlprec_wrk(ilev)%y2l,& & zone,mlprec_wrk(ilev-1)%y2l,& - & precv(ilev)%map,info,work=work) + & p%precv(ilev)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during prolongation') @@ -466,7 +466,7 @@ contains ! ! Compute the output vector Y ! - call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,zone,y,precv(1)%base_desc,info) + call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,zone,y,p%precv(1)%base_desc,info) if (info /= 0) then call psb_errpush(4001,name,a_err='Error on final update') goto 9999 @@ -500,7 +500,7 @@ contains ! Y = beta*Y + alpha*op(M^(-1))*X, ! where ! - M is a hybrid multilevel domain decomposition (Schwarz) preconditioner - ! associated to a certain matrix A and stored in the array precv, + ! associated to a certain matrix A and stored in the array p%precv, ! - op(M^(-1)) is M^(-1) or its (conjugate) transpose, according to ! the value of trans, ! - X and Y are vectors, @@ -515,7 +515,7 @@ contains ! ! The multilevel preconditioner M is regarded as an array of 'one-level preconditioners', ! each representing the part of the preconditioner associated to a certain level. - ! For each level ilev, the base preconditioner K(ilev) is stored in precv(ilev) + ! For each level ilev, the base preconditioner K(ilev) is stored in p%precv(ilev) ! and is associated to a matrix A(ilev), obtained by 'tranferring' the original ! matrix A (i.e. the matrix to be preconditioned) to the level ilev, through smoothed ! aggregation. @@ -571,19 +571,19 @@ contains ! 6. Yext = beta*Yext + alpha*Y(1) ! ! - subroutine mlt_pre_ml_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) + subroutine mlt_pre_ml_aply(alpha,p,x,beta,y,desc_data,trans,work,info) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_zonelev_type), intent(in) :: precv(:) + 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) :: x(:) complex(psb_dpk_),intent(inout) :: y(:) - character, intent(in) :: trans + character, intent(in) :: trans complex(psb_dpk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info ! Local variables integer :: ictxt,np,me,i, nr2l,nc2l,err_act @@ -607,9 +607,9 @@ contains if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),& - & ' Entry ', size(precv) + & ' Entry ', size(p%precv) - nlev = size(precv) + nlev = size(p%precv) allocate(mlprec_wrk(nlev),stat=info) if (info /= 0) then call psb_errpush(4010,name,a_err='Allocate') @@ -621,7 +621,7 @@ contains ! ! Copy the input vector X ! - nc2l = psb_cd_get_local_cols(precv(1)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(1)%base_desc) allocate(mlprec_wrk(1)%x2l(nc2l),mlprec_wrk(1)%y2l(nc2l), & & mlprec_wrk(1)%tx(nc2l), stat=info) @@ -638,8 +638,8 @@ contains ! ! Apply the base preconditioner at the finest level ! - call mld_baseprec_aply(zone,precv(1)%prec,mlprec_wrk(1)%x2l,& - & zzero,mlprec_wrk(1)%y2l,precv(1)%base_desc,& + call mld_baseprec_aply(zone,p%precv(1)%prec,mlprec_wrk(1)%x2l,& + & zzero,mlprec_wrk(1)%y2l,p%precv(1)%base_desc,& & trans,work,info) if (info /=0) then call psb_errpush(4010,name,a_err=' baseprec_aply') @@ -653,8 +653,8 @@ contains ! mlprec_wrk(1)%tx = mlprec_wrk(1)%x2l - call psb_spmm(-zone,precv(1)%base_a,mlprec_wrk(1)%y2l,& - & zone,mlprec_wrk(1)%tx,precv(1)%base_desc,info,& + call psb_spmm(-zone,p%precv(1)%base_a,mlprec_wrk(1)%y2l,& + & zone,mlprec_wrk(1)%tx,p%precv(1)%base_desc,info,& & work=work,trans=trans) if (info /=0) then call psb_errpush(4001,name,a_err=' fine level residual') @@ -668,8 +668,8 @@ contains ! do ilev = 2, nlev - nc2l = psb_cd_get_local_cols(precv(ilev)%base_desc) - nr2l = psb_cd_get_local_rows(precv(ilev)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(ilev)%base_desc) + nr2l = psb_cd_get_local_rows(p%precv(ilev)%base_desc) allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& & mlprec_wrk(ilev)%x2l(nc2l), stat=info) @@ -683,7 +683,7 @@ contains ! Apply prolongator transpose, i.e. restriction call psb_map_X2Y(zone,mlprec_wrk(ilev-1)%tx,& & zzero,mlprec_wrk(ilev)%x2l,& - & precv(ilev)%map,info,work=work) + & p%precv(ilev)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during restriction') @@ -693,17 +693,17 @@ contains ! ! Apply the base preconditioner ! - call mld_baseprec_aply(zone,precv(ilev)%prec,mlprec_wrk(ilev)%x2l,& - & zzero,mlprec_wrk(ilev)%y2l,precv(ilev)%base_desc,trans,work,info) + call mld_baseprec_aply(zone,p%precv(ilev)%prec,mlprec_wrk(ilev)%x2l,& + & zzero,mlprec_wrk(ilev)%y2l,p%precv(ilev)%base_desc,trans,work,info) ! ! Compute the residual (at all levels but the coarsest one) ! if (ilev < nlev) then mlprec_wrk(ilev)%tx = mlprec_wrk(ilev)%x2l - if (info == 0) call psb_spmm(-zone,precv(ilev)%base_a,& + if (info == 0) call psb_spmm(-zone,p%precv(ilev)%base_a,& & mlprec_wrk(ilev)%y2l,zone,mlprec_wrk(ilev)%tx,& - & precv(ilev)%base_desc,info,work=work,trans=trans) + & p%precv(ilev)%base_desc,info,work=work,trans=trans) endif if (info /=0) then call psb_errpush(4001,name,a_err='Error on up sweep residual') @@ -722,7 +722,7 @@ contains ! call psb_map_Y2X(zone,mlprec_wrk(ilev+1)%y2l,& & zone,mlprec_wrk(ilev)%y2l,& - & precv(ilev+1)%map,info,work=work) + & p%precv(ilev+1)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during prolongation') @@ -736,7 +736,7 @@ contains ! Compute the output vector Y ! call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,beta,y,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) if (info /=0) then call psb_errpush(4001,name,a_err='Error on final update') goto 9999 @@ -769,7 +769,7 @@ contains ! Y = beta*Y + alpha*op(M^(-1))*X, ! where ! - M is a hybrid multilevel domain decomposition (Schwarz) preconditioner - ! associated to a certain matrix A and stored in the array precv, + ! associated to a certain matrix A and stored in the array p%precv, ! - op(M^(-1)) is M^(-1) or its (conjugate) transpose, according to ! the value of trans, ! - X and Y are vectors, @@ -784,7 +784,7 @@ contains ! ! The multilevel preconditioner M is regarded as an array of 'one-level preconditioners', ! each representing the part of the preconditioner associated to a certain level. - ! For each level ilev, the base preconditioner K(ilev) is stored in precv(ilev) + ! For each level ilev, the base preconditioner K(ilev) is stored in p%precv(ilev) ! and is associated to a matrix A(ilev), obtained by 'tranferring' the original ! matrix A (i.e. the matrix to be preconditioned) to the level ilev, through smoothed ! aggregation. @@ -831,19 +831,19 @@ contains ! 5. Yext = beta*Yext + alpha*Y(1) ! ! - subroutine mlt_post_ml_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) + subroutine mlt_post_ml_aply(alpha,p,x,beta,y,desc_data,trans,work,info) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_zonelev_type), intent(in) :: precv(:) + 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) :: x(:) complex(psb_dpk_),intent(inout) :: y(:) - character, intent(in) :: trans + character, intent(in) :: trans complex(psb_dpk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info ! Local variables integer :: ictxt,np,me,i, nr2l,nc2l,err_act @@ -867,9 +867,9 @@ contains if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),& - & ' Entry ', size(precv) + & ' Entry ', size(p%precv) - nlev = size(precv) + nlev = size(p%precv) allocate(mlprec_wrk(nlev),stat=info) if (info /= 0) then call psb_errpush(4010,name,a_err='Allocate') @@ -885,7 +885,7 @@ contains & write(debug_unit,*) me,' ',trim(name),& & ' desc_data status',allocated(desc_data%matrix_data) - nc2l = psb_cd_get_local_cols(precv(1)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(1)%base_desc) allocate(mlprec_wrk(1)%x2l(nc2l),mlprec_wrk(1)%y2l(nc2l), & & mlprec_wrk(1)%tx(nc2l), stat=info) @@ -897,9 +897,9 @@ contains end if call psb_geaxpby(zone,x,zzero,mlprec_wrk(1)%tx,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) call psb_geaxpby(zone,x,zzero,mlprec_wrk(1)%x2l,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) ! ! STEP 2 @@ -908,13 +908,13 @@ contains ! do ilev=2, nlev - nc2l = psb_cd_get_local_cols(precv(ilev)%base_desc) - nr2l = psb_cd_get_local_rows(precv(ilev)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(ilev)%base_desc) + nr2l = psb_cd_get_local_rows(p%precv(ilev)%base_desc) if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name), & & ' starting up sweep ',& - & ilev,allocated(precv(ilev)%iprcparm),nc2l, nr2l + & ilev,allocated(p%precv(ilev)%iprcparm),nc2l, nr2l allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& & mlprec_wrk(ilev)%x2l(nc2l), stat=info) @@ -929,7 +929,7 @@ contains ! Apply prolongator transpose, i.e. restriction call psb_map_X2Y(zone,mlprec_wrk(ilev-1)%x2l,& & zzero,mlprec_wrk(ilev)%x2l,& - & precv(ilev)%map,info,work=work) + & p%precv(ilev)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during restriction') @@ -940,7 +940,7 @@ contains ! update x2l ! call psb_geaxpby(zone,mlprec_wrk(ilev)%x2l,zzero,mlprec_wrk(ilev)%tx,& - & precv(ilev)%base_desc,info) + & p%precv(ilev)%base_desc,info) if (info /= 0) then call psb_errpush(4001,name,a_err='Error in update') goto 9999 @@ -957,8 +957,8 @@ contains ! ! Apply the base preconditioner at the coarsest level ! - call mld_baseprec_aply(zone,precv(nlev)%prec,mlprec_wrk(nlev)%x2l, & - & zzero, mlprec_wrk(nlev)%y2l,precv(nlev)%base_desc,trans,work,info) + call mld_baseprec_aply(zone,p%precv(nlev)%prec,mlprec_wrk(nlev)%x2l, & + & zzero, mlprec_wrk(nlev)%y2l,p%precv(nlev)%base_desc,trans,work,info) if (info /=0) then call psb_errpush(4010,name,a_err='baseprec_aply') goto 9999 @@ -983,7 +983,7 @@ contains ! call psb_map_Y2X(zone,mlprec_wrk(ilev+1)%y2l,& & zzero,mlprec_wrk(ilev)%y2l,& - & precv(ilev+1)%map,info,work=work) + & p%precv(ilev+1)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during prolongation') @@ -993,15 +993,15 @@ contains ! ! Compute the residual ! - call psb_spmm(-zone,precv(ilev)%base_a,mlprec_wrk(ilev)%y2l,& - & zone,mlprec_wrk(ilev)%tx,precv(ilev)%base_desc,info,& + call psb_spmm(-zone,p%precv(ilev)%base_a,mlprec_wrk(ilev)%y2l,& + & zone,mlprec_wrk(ilev)%tx,p%precv(ilev)%base_desc,info,& & work=work,trans=trans) ! ! Apply the base preconditioner ! - if (info == 0) call mld_baseprec_aply(zone,precv(ilev)%prec,& - & mlprec_wrk(ilev)%tx,zone,mlprec_wrk(ilev)%y2l,precv(ilev)%base_desc,& + if (info == 0) call mld_baseprec_aply(zone,p%precv(ilev)%prec,& + & mlprec_wrk(ilev)%tx,zone,mlprec_wrk(ilev)%y2l,p%precv(ilev)%base_desc,& &trans,work,info) if (info /=0) then call psb_errpush(4001,name,a_err=' spmm/baseprec_aply') @@ -1018,7 +1018,7 @@ contains ! ! Compute the output vector Y ! - call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,beta,y,precv(1)%base_desc,info) + call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,beta,y,p%precv(1)%base_desc,info) if (info /=0) then call psb_errpush(4001,name,a_err=' Final update') @@ -1055,7 +1055,7 @@ contains ! where ! - M is a symmetrized hybrid multilevel domain decomposition (Schwarz) ! preconditioner associated to a certain matrix A and stored in the array - ! precv, + ! p%precv, ! - op(M^(-1)) is M^(-1) or its (conjugate) transpose, according to ! the value of trans, ! - X and Y are vectors, @@ -1071,7 +1071,7 @@ contains ! ! The multilevel preconditioner M is regarded as an array of 'one-level preconditioners', ! each representing the part of the preconditioner associated to a certain level. - ! For each level ilev, the base preconditioner K(ilev) is stored in precv(ilev) + ! For each level ilev, the base preconditioner K(ilev) is stored in p%precv(ilev) ! and is associated to a matrix A(ilev), obtained by 'tranferring' the original ! matrix A (i.e. the matrix to be preconditioned) to the level ilev, through smoothed ! aggregation. @@ -1129,19 +1129,19 @@ contains ! ! 6. Yext = beta*Yext + alpha*Y(1) ! - subroutine mlt_twoside_ml_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) + subroutine mlt_twoside_ml_aply(alpha,p,x,beta,y,desc_data,trans,work,info) implicit none ! Arguments - type(psb_desc_type),intent(in) :: desc_data - type(mld_zonelev_type), intent(in) :: precv(:) + 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) :: x(:) complex(psb_dpk_),intent(inout) :: y(:) - character, intent(in) :: trans + character, intent(in) :: trans complex(psb_dpk_),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info ! Local variables integer :: ictxt,np,me,i, nr2l,nc2l,err_act @@ -1165,9 +1165,9 @@ contains if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),& - & ' Entry ', size(precv) + & ' Entry ', size(p%precv) - nlev = size(precv) + nlev = size(p%precv) allocate(mlprec_wrk(nlev),stat=info) if (info /= 0) then call psb_errpush(4010,name,a_err='Allocate') @@ -1178,7 +1178,7 @@ contains ! ! Copy the input vector X ! - nc2l = psb_cd_get_local_cols(precv(1)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(1)%base_desc) allocate(mlprec_wrk(1)%x2l(nc2l),mlprec_wrk(1)%y2l(nc2l), & & mlprec_wrk(1)%ty(nc2l), mlprec_wrk(1)%tx(nc2l), stat=info) @@ -1191,17 +1191,17 @@ contains end if call psb_geaxpby(zone,x,zzero,mlprec_wrk(1)%x2l,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) call psb_geaxpby(zone,x,zzero,mlprec_wrk(1)%tx,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) ! ! STEP 2 ! ! Apply the base preconditioner at the finest level ! - call mld_baseprec_aply(zone,precv(1)%prec,mlprec_wrk(1)%x2l,& - & zzero,mlprec_wrk(1)%y2l,precv(1)%base_desc,& + call mld_baseprec_aply(zone,p%precv(1)%prec,mlprec_wrk(1)%x2l,& + & zzero,mlprec_wrk(1)%y2l,p%precv(1)%base_desc,& & trans,work,info) ! ! STEP 3 @@ -1209,8 +1209,8 @@ contains ! Compute the residual at the finest level ! mlprec_wrk(1)%ty = mlprec_wrk(1)%x2l - if (info == 0) call psb_spmm(-zone,precv(1)%base_a,mlprec_wrk(1)%y2l,& - & zone,mlprec_wrk(1)%ty,precv(1)%base_desc,info,& + if (info == 0) call psb_spmm(-zone,p%precv(1)%base_a,mlprec_wrk(1)%y2l,& + & zone,mlprec_wrk(1)%ty,p%precv(1)%base_desc,info,& & work=work,trans=trans) if (info /=0) then call psb_errpush(4010,name,a_err='Fine level baseprec/residual') @@ -1224,8 +1224,8 @@ contains ! do ilev = 2, nlev - nc2l = psb_cd_get_local_cols(precv(ilev)%base_desc) - nr2l = psb_cd_get_local_rows(precv(ilev)%base_desc) + nc2l = psb_cd_get_local_cols(p%precv(ilev)%base_desc) + nr2l = psb_cd_get_local_rows(p%precv(ilev)%base_desc) allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%ty(nc2l),& & mlprec_wrk(ilev)%y2l(nc2l),mlprec_wrk(ilev)%x2l(nc2l), stat=info) @@ -1240,7 +1240,7 @@ contains ! Apply prolongator transpose, i.e. restriction call psb_map_X2Y(zone,mlprec_wrk(ilev-1)%ty,& & zzero,mlprec_wrk(ilev)%x2l,& - & precv(ilev)%map,info,work=work) + & p%precv(ilev)%map,info,work=work) if (info /=0) then call psb_errpush(4001,name,a_err='Error during restriction') @@ -1248,21 +1248,21 @@ contains end if call psb_geaxpby(zone,mlprec_wrk(ilev)%x2l,zzero,mlprec_wrk(ilev)%tx,& - & precv(ilev)%base_desc,info) + & p%precv(ilev)%base_desc,info) ! ! Apply the base preconditioner ! - if (info == 0) call mld_baseprec_aply(zone,precv(ilev)%prec,& + if (info == 0) call mld_baseprec_aply(zone,p%precv(ilev)%prec,& & mlprec_wrk(ilev)%x2l,zzero,mlprec_wrk(ilev)%y2l,& - &precv(ilev)%base_desc,trans,work,info) + &p%precv(ilev)%base_desc,trans,work,info) ! ! Compute the residual (at all levels but the coarsest one) ! if(ilev < nlev) then mlprec_wrk(ilev)%ty = mlprec_wrk(ilev)%x2l - if (info == 0) call psb_spmm(-zone,precv(ilev)%base_a,& + if (info == 0) call psb_spmm(-zone,p%precv(ilev)%base_a,& & mlprec_wrk(ilev)%y2l,zone,mlprec_wrk(ilev)%ty,& - & precv(ilev)%base_desc,info,work=work,trans=trans) + & p%precv(ilev)%base_desc,info,work=work,trans=trans) endif if (info /=0) then call psb_errpush(4001,name,a_err='baseprec_aply/residual') @@ -1283,7 +1283,7 @@ contains ! call psb_map_Y2X(zone,mlprec_wrk(ilev+1)%y2l,& & zone,mlprec_wrk(ilev)%y2l,& - & precv(ilev+1)%map,info,work=work) + & p%precv(ilev+1)%map,info,work=work) if (info /=0 ) then call psb_errpush(4001,name,a_err='Error during restriction') @@ -1293,14 +1293,14 @@ contains ! ! Compute the residual ! - call psb_spmm(-zone,precv(ilev)%base_a,mlprec_wrk(ilev)%y2l,& - & zone,mlprec_wrk(ilev)%tx,precv(ilev)%base_desc,info,& + call psb_spmm(-zone,p%precv(ilev)%base_a,mlprec_wrk(ilev)%y2l,& + & zone,mlprec_wrk(ilev)%tx,p%precv(ilev)%base_desc,info,& & work=work,trans=trans) ! ! Apply the base preconditioner ! - if (info == 0) call mld_baseprec_aply(zone,precv(ilev)%prec,mlprec_wrk(ilev)%tx,& - & zone,mlprec_wrk(ilev)%y2l,precv(ilev)%base_desc, trans, work,info) + if (info == 0) call mld_baseprec_aply(zone,p%precv(ilev)%prec,mlprec_wrk(ilev)%tx,& + & zone,mlprec_wrk(ilev)%y2l,p%precv(ilev)%base_desc, trans, work,info) if (info /= 0) then call psb_errpush(4001,name,a_err='Error: residual/baseprec_aply') goto 9999 @@ -1313,7 +1313,7 @@ contains ! Compute the output vector Y ! call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,beta,y,& - & precv(1)%base_desc,info) + & p%precv(1)%base_desc,info) if (info /= 0) then call psb_errpush(4001,name,a_err='Error final update') diff --git a/mlprec/mld_zprecaply.f90 b/mlprec/mld_zprecaply.f90 index c60042b8..3b40308d 100644 --- a/mlprec/mld_zprecaply.f90 +++ b/mlprec/mld_zprecaply.f90 @@ -127,7 +127,7 @@ subroutine mld_zprecaply(prec,x,y,desc_data,info,trans,work) goto 9999 end if if (size(prec%precv) >1) then - call mld_mlprec_aply(zone,prec%precv,x,zzero,y,desc_data,trans_,work_,info) + call mld_mlprec_aply(zone,prec,x,zzero,y,desc_data,trans_,work_,info) if(info /= 0) then call psb_errpush(4010,name,a_err='mld_zmlprec_aply') goto 9999