diff --git a/mlprec/impl/level/mld_c_base_onelev_build.f90 b/mlprec/impl/level/mld_c_base_onelev_build.f90 index 199582d1..587bdb1c 100644 --- a/mlprec/impl/level/mld_c_base_onelev_build.f90 +++ b/mlprec/impl/level/mld_c_base_onelev_build.f90 @@ -93,30 +93,51 @@ subroutine mld_c_base_onelev_build(lv,info,amold,vmold,imold) & 'Jacobi sweeps',izero,is_int_non_negative) call mld_check_def(lv%parms%sweeps_post,& & 'Jacobi sweeps',izero,is_int_non_negative) - - call lv%sm%build(lv%base_a,lv%base_desc,& - & info,amold=amold,vmold=vmold,imold=imold) - if (info == 0) then - if (allocated(lv%sm2a)) then - call lv%sm2a%build(lv%base_a,lv%base_desc,info,& - & amold=amold,vmold=vmold,imold=imold) - lv%sm2 => lv%sm2a - else - lv%sm2 => lv%sm + + if (.false.) then + call lv%sm%build(lv%base_a,lv%base_desc,& + & info,amold=amold,vmold=vmold,imold=imold) + if (info == 0) then + if (allocated(lv%sm2a)) then + call lv%sm2a%build(lv%base_a,lv%base_desc,info,& + & amold=amold,vmold=vmold,imold=imold) + lv%sm2 => lv%sm2a + else + lv%sm2 => lv%sm + end if + end if + if (info /=0) then + info = psb_err_internal_error_ + call psb_errpush(info,name,& + & a_err='Smoother bld error') + goto 9999 + end if + else + call lv%sm%build(lv%base_a,lv%base_desc,info) + if (info == 0) then + if (allocated(lv%sm2a)) then + call lv%sm2a%build(lv%base_a,lv%base_desc,info) + lv%sm2 => lv%sm2a + else + lv%sm2 => lv%sm + end if + end if + if (info /=0 ) then + info = psb_err_internal_error_ + call psb_errpush(info,name,& + & a_err='Smoother bld error') + goto 9999 end if - end if - if (info /=0) then - info = psb_err_internal_error_ - call psb_errpush(info,name,& - & a_err='Smoother bld error') - goto 9999 - end if + if (any((/present(amold),present(vmold),present(imold)/))) & + & call lv%cnv(info,amold=amold,vmold=vmold,imold=imold) + end if + call psb_erractionrestore(err_act) return - + 9999 call psb_error_handler(err_act) - + return - + end subroutine mld_c_base_onelev_build diff --git a/mlprec/impl/level/mld_c_base_onelev_cnv.f90 b/mlprec/impl/level/mld_c_base_onelev_cnv.f90 index 9d71c74e..2b57fd13 100644 --- a/mlprec/impl/level/mld_c_base_onelev_cnv.f90 +++ b/mlprec/impl/level/mld_c_base_onelev_cnv.f90 @@ -54,10 +54,14 @@ subroutine mld_c_base_onelev_cnv(lv,info,amold,vmold,imold) if (any((/present(amold),present(vmold),present(imold)/))) then if (allocated(lv%sm)) & & call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info == psb_success_ .and. allocated(lv%sm2a)) & + & call lv%sm2a%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info == psb_success_ .and. allocated(lv%wrk)) & + & call lv%wrk(vmold=vmold) if (info == psb_success_.and. lv%ac%is_asb()) & & call lv%ac%cscnv(info,mold=amold) - if (info == psb_success_ .and. lv%desc_ac%is_ok()) & - & call lv%desc_ac%cnv(imold) + if (info == psb_success_ .and. lv%desc_ac%is_ok() & + & .and. present(imold)) call lv%desc_ac%cnv(imold) call lv%map%cnv(info,mold=amold,imold=imold) end if end subroutine mld_c_base_onelev_cnv diff --git a/mlprec/impl/level/mld_d_base_onelev_build.f90 b/mlprec/impl/level/mld_d_base_onelev_build.f90 index 796d0b72..1fe9c11d 100644 --- a/mlprec/impl/level/mld_d_base_onelev_build.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_build.f90 @@ -93,30 +93,51 @@ subroutine mld_d_base_onelev_build(lv,info,amold,vmold,imold) & 'Jacobi sweeps',izero,is_int_non_negative) call mld_check_def(lv%parms%sweeps_post,& & 'Jacobi sweeps',izero,is_int_non_negative) - - call lv%sm%build(lv%base_a,lv%base_desc,& - & info,amold=amold,vmold=vmold,imold=imold) - if (info == 0) then - if (allocated(lv%sm2a)) then - call lv%sm2a%build(lv%base_a,lv%base_desc,info,& - & amold=amold,vmold=vmold,imold=imold) - lv%sm2 => lv%sm2a - else - lv%sm2 => lv%sm + + if (.false.) then + call lv%sm%build(lv%base_a,lv%base_desc,& + & info,amold=amold,vmold=vmold,imold=imold) + if (info == 0) then + if (allocated(lv%sm2a)) then + call lv%sm2a%build(lv%base_a,lv%base_desc,info,& + & amold=amold,vmold=vmold,imold=imold) + lv%sm2 => lv%sm2a + else + lv%sm2 => lv%sm + end if + end if + if (info /=0) then + info = psb_err_internal_error_ + call psb_errpush(info,name,& + & a_err='Smoother bld error') + goto 9999 + end if + else + call lv%sm%build(lv%base_a,lv%base_desc,info) + if (info == 0) then + if (allocated(lv%sm2a)) then + call lv%sm2a%build(lv%base_a,lv%base_desc,info) + lv%sm2 => lv%sm2a + else + lv%sm2 => lv%sm + end if + end if + if (info /=0 ) then + info = psb_err_internal_error_ + call psb_errpush(info,name,& + & a_err='Smoother bld error') + goto 9999 end if - end if - if (info /=0) then - info = psb_err_internal_error_ - call psb_errpush(info,name,& - & a_err='Smoother bld error') - goto 9999 - end if + if (any((/present(amold),present(vmold),present(imold)/))) & + & call lv%cnv(info,amold=amold,vmold=vmold,imold=imold) + end if + call psb_erractionrestore(err_act) return - + 9999 call psb_error_handler(err_act) - + return - + end subroutine mld_d_base_onelev_build diff --git a/mlprec/impl/level/mld_d_base_onelev_cnv.f90 b/mlprec/impl/level/mld_d_base_onelev_cnv.f90 index 9df25328..834e004d 100644 --- a/mlprec/impl/level/mld_d_base_onelev_cnv.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_cnv.f90 @@ -54,10 +54,14 @@ subroutine mld_d_base_onelev_cnv(lv,info,amold,vmold,imold) if (any((/present(amold),present(vmold),present(imold)/))) then if (allocated(lv%sm)) & & call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info == psb_success_ .and. allocated(lv%sm2a)) & + & call lv%sm2a%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info == psb_success_ .and. allocated(lv%wrk)) & + & call lv%wrk(vmold=vmold) if (info == psb_success_.and. lv%ac%is_asb()) & & call lv%ac%cscnv(info,mold=amold) - if (info == psb_success_ .and. lv%desc_ac%is_ok()) & - & call lv%desc_ac%cnv(imold) + if (info == psb_success_ .and. lv%desc_ac%is_ok() & + & .and. present(imold)) call lv%desc_ac%cnv(imold) call lv%map%cnv(info,mold=amold,imold=imold) end if end subroutine mld_d_base_onelev_cnv diff --git a/mlprec/impl/level/mld_s_base_onelev_build.f90 b/mlprec/impl/level/mld_s_base_onelev_build.f90 index 774a39b0..a2c9fff4 100644 --- a/mlprec/impl/level/mld_s_base_onelev_build.f90 +++ b/mlprec/impl/level/mld_s_base_onelev_build.f90 @@ -93,30 +93,51 @@ subroutine mld_s_base_onelev_build(lv,info,amold,vmold,imold) & 'Jacobi sweeps',izero,is_int_non_negative) call mld_check_def(lv%parms%sweeps_post,& & 'Jacobi sweeps',izero,is_int_non_negative) - - call lv%sm%build(lv%base_a,lv%base_desc,& - & info,amold=amold,vmold=vmold,imold=imold) - if (info == 0) then - if (allocated(lv%sm2a)) then - call lv%sm2a%build(lv%base_a,lv%base_desc,info,& - & amold=amold,vmold=vmold,imold=imold) - lv%sm2 => lv%sm2a - else - lv%sm2 => lv%sm + + if (.false.) then + call lv%sm%build(lv%base_a,lv%base_desc,& + & info,amold=amold,vmold=vmold,imold=imold) + if (info == 0) then + if (allocated(lv%sm2a)) then + call lv%sm2a%build(lv%base_a,lv%base_desc,info,& + & amold=amold,vmold=vmold,imold=imold) + lv%sm2 => lv%sm2a + else + lv%sm2 => lv%sm + end if + end if + if (info /=0) then + info = psb_err_internal_error_ + call psb_errpush(info,name,& + & a_err='Smoother bld error') + goto 9999 + end if + else + call lv%sm%build(lv%base_a,lv%base_desc,info) + if (info == 0) then + if (allocated(lv%sm2a)) then + call lv%sm2a%build(lv%base_a,lv%base_desc,info) + lv%sm2 => lv%sm2a + else + lv%sm2 => lv%sm + end if + end if + if (info /=0 ) then + info = psb_err_internal_error_ + call psb_errpush(info,name,& + & a_err='Smoother bld error') + goto 9999 end if - end if - if (info /=0) then - info = psb_err_internal_error_ - call psb_errpush(info,name,& - & a_err='Smoother bld error') - goto 9999 - end if + if (any((/present(amold),present(vmold),present(imold)/))) & + & call lv%cnv(info,amold=amold,vmold=vmold,imold=imold) + end if + call psb_erractionrestore(err_act) return - + 9999 call psb_error_handler(err_act) - + return - + end subroutine mld_s_base_onelev_build diff --git a/mlprec/impl/level/mld_s_base_onelev_cnv.f90 b/mlprec/impl/level/mld_s_base_onelev_cnv.f90 index c4021e92..652b2c5c 100644 --- a/mlprec/impl/level/mld_s_base_onelev_cnv.f90 +++ b/mlprec/impl/level/mld_s_base_onelev_cnv.f90 @@ -54,10 +54,14 @@ subroutine mld_s_base_onelev_cnv(lv,info,amold,vmold,imold) if (any((/present(amold),present(vmold),present(imold)/))) then if (allocated(lv%sm)) & & call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info == psb_success_ .and. allocated(lv%sm2a)) & + & call lv%sm2a%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info == psb_success_ .and. allocated(lv%wrk)) & + & call lv%wrk(vmold=vmold) if (info == psb_success_.and. lv%ac%is_asb()) & & call lv%ac%cscnv(info,mold=amold) - if (info == psb_success_ .and. lv%desc_ac%is_ok()) & - & call lv%desc_ac%cnv(imold) + if (info == psb_success_ .and. lv%desc_ac%is_ok() & + & .and. present(imold)) call lv%desc_ac%cnv(imold) call lv%map%cnv(info,mold=amold,imold=imold) end if end subroutine mld_s_base_onelev_cnv diff --git a/mlprec/impl/level/mld_z_base_onelev_build.f90 b/mlprec/impl/level/mld_z_base_onelev_build.f90 index 63bb0f9c..2994f768 100644 --- a/mlprec/impl/level/mld_z_base_onelev_build.f90 +++ b/mlprec/impl/level/mld_z_base_onelev_build.f90 @@ -93,30 +93,51 @@ subroutine mld_z_base_onelev_build(lv,info,amold,vmold,imold) & 'Jacobi sweeps',izero,is_int_non_negative) call mld_check_def(lv%parms%sweeps_post,& & 'Jacobi sweeps',izero,is_int_non_negative) - - call lv%sm%build(lv%base_a,lv%base_desc,& - & info,amold=amold,vmold=vmold,imold=imold) - if (info == 0) then - if (allocated(lv%sm2a)) then - call lv%sm2a%build(lv%base_a,lv%base_desc,info,& - & amold=amold,vmold=vmold,imold=imold) - lv%sm2 => lv%sm2a - else - lv%sm2 => lv%sm + + if (.false.) then + call lv%sm%build(lv%base_a,lv%base_desc,& + & info,amold=amold,vmold=vmold,imold=imold) + if (info == 0) then + if (allocated(lv%sm2a)) then + call lv%sm2a%build(lv%base_a,lv%base_desc,info,& + & amold=amold,vmold=vmold,imold=imold) + lv%sm2 => lv%sm2a + else + lv%sm2 => lv%sm + end if + end if + if (info /=0) then + info = psb_err_internal_error_ + call psb_errpush(info,name,& + & a_err='Smoother bld error') + goto 9999 + end if + else + call lv%sm%build(lv%base_a,lv%base_desc,info) + if (info == 0) then + if (allocated(lv%sm2a)) then + call lv%sm2a%build(lv%base_a,lv%base_desc,info) + lv%sm2 => lv%sm2a + else + lv%sm2 => lv%sm + end if + end if + if (info /=0 ) then + info = psb_err_internal_error_ + call psb_errpush(info,name,& + & a_err='Smoother bld error') + goto 9999 end if - end if - if (info /=0) then - info = psb_err_internal_error_ - call psb_errpush(info,name,& - & a_err='Smoother bld error') - goto 9999 - end if + if (any((/present(amold),present(vmold),present(imold)/))) & + & call lv%cnv(info,amold=amold,vmold=vmold,imold=imold) + end if + call psb_erractionrestore(err_act) return - + 9999 call psb_error_handler(err_act) - + return - + end subroutine mld_z_base_onelev_build diff --git a/mlprec/impl/level/mld_z_base_onelev_cnv.f90 b/mlprec/impl/level/mld_z_base_onelev_cnv.f90 index 8e3d3ad3..5ac99b99 100644 --- a/mlprec/impl/level/mld_z_base_onelev_cnv.f90 +++ b/mlprec/impl/level/mld_z_base_onelev_cnv.f90 @@ -54,10 +54,14 @@ subroutine mld_z_base_onelev_cnv(lv,info,amold,vmold,imold) if (any((/present(amold),present(vmold),present(imold)/))) then if (allocated(lv%sm)) & & call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info == psb_success_ .and. allocated(lv%sm2a)) & + & call lv%sm2a%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info == psb_success_ .and. allocated(lv%wrk)) & + & call lv%wrk(vmold=vmold) if (info == psb_success_.and. lv%ac%is_asb()) & & call lv%ac%cscnv(info,mold=amold) - if (info == psb_success_ .and. lv%desc_ac%is_ok()) & - & call lv%desc_ac%cnv(imold) + if (info == psb_success_ .and. lv%desc_ac%is_ok() & + & .and. present(imold)) call lv%desc_ac%cnv(imold) call lv%map%cnv(info,mold=amold,imold=imold) end if end subroutine mld_z_base_onelev_cnv diff --git a/mlprec/mld_c_onelev_mod.f90 b/mlprec/mld_c_onelev_mod.f90 index 3035d30f..55548ce7 100644 --- a/mlprec/mld_c_onelev_mod.f90 +++ b/mlprec/mld_c_onelev_mod.f90 @@ -130,9 +130,10 @@ module mld_c_onelev_mod procedure, pass(wk) :: free => c_wrk_free procedure, pass(wk) :: clone => c_wrk_clone procedure, pass(wk) :: move_alloc => c_wrk_move_alloc + procedure, pass(wk) :: cnv => c_wrk_cnv end type mld_cmlprec_wrk_type private :: c_wrk_alloc, c_wrk_free, & - & c_wrk_clone, c_wrk_move_alloc + & c_wrk_clone, c_wrk_move_alloc, c_wrk_cnv type mld_c_onelev_type class(mld_c_base_smoother_type), allocatable :: sm, sm2a @@ -730,4 +731,30 @@ contains end subroutine c_wrk_move_alloc + subroutine c_wrk_cnv(wk,info,vmold) + use psb_base_mod + + Implicit None + + ! Arguments + class(mld_cmlprec_wrk_type), target, intent(inout) :: wk + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_vect_type), intent(in), optional :: vmold + ! + integer(psb_ipk_) :: i + + info = psb_success_ + if (present(vmold)) then + call wk%vtx%cnv(vmold) + call wk%vty%cnv(vmold) + call wk%vx2l%cnv(vmold) + call wk%vy2l%cnv(vmold) + if (allocated(wk%wv)) then + do i=1,size(wk%wv) + call wk%wv(i)%cnv(vmold) + end do + end if + end if + end subroutine c_wrk_cnv + end module mld_c_onelev_mod diff --git a/mlprec/mld_d_onelev_mod.f90 b/mlprec/mld_d_onelev_mod.f90 index e8223c68..9461d6f2 100644 --- a/mlprec/mld_d_onelev_mod.f90 +++ b/mlprec/mld_d_onelev_mod.f90 @@ -130,9 +130,10 @@ module mld_d_onelev_mod procedure, pass(wk) :: free => d_wrk_free procedure, pass(wk) :: clone => d_wrk_clone procedure, pass(wk) :: move_alloc => d_wrk_move_alloc + procedure, pass(wk) :: cnv => d_wrk_cnv end type mld_dmlprec_wrk_type private :: d_wrk_alloc, d_wrk_free, & - & d_wrk_clone, d_wrk_move_alloc + & d_wrk_clone, d_wrk_move_alloc, d_wrk_cnv type mld_d_onelev_type class(mld_d_base_smoother_type), allocatable :: sm, sm2a @@ -730,4 +731,30 @@ contains end subroutine d_wrk_move_alloc + subroutine d_wrk_cnv(wk,info,vmold) + use psb_base_mod + + Implicit None + + ! Arguments + class(mld_dmlprec_wrk_type), target, intent(inout) :: wk + integer(psb_ipk_), intent(out) :: info + class(psb_d_base_vect_type), intent(in), optional :: vmold + ! + integer(psb_ipk_) :: i + + info = psb_success_ + if (present(vmold)) then + call wk%vtx%cnv(vmold) + call wk%vty%cnv(vmold) + call wk%vx2l%cnv(vmold) + call wk%vy2l%cnv(vmold) + if (allocated(wk%wv)) then + do i=1,size(wk%wv) + call wk%wv(i)%cnv(vmold) + end do + end if + end if + end subroutine d_wrk_cnv + end module mld_d_onelev_mod diff --git a/mlprec/mld_s_onelev_mod.f90 b/mlprec/mld_s_onelev_mod.f90 index 85317faa..74559935 100644 --- a/mlprec/mld_s_onelev_mod.f90 +++ b/mlprec/mld_s_onelev_mod.f90 @@ -130,9 +130,10 @@ module mld_s_onelev_mod procedure, pass(wk) :: free => s_wrk_free procedure, pass(wk) :: clone => s_wrk_clone procedure, pass(wk) :: move_alloc => s_wrk_move_alloc + procedure, pass(wk) :: cnv => s_wrk_cnv end type mld_smlprec_wrk_type private :: s_wrk_alloc, s_wrk_free, & - & s_wrk_clone, s_wrk_move_alloc + & s_wrk_clone, s_wrk_move_alloc, s_wrk_cnv type mld_s_onelev_type class(mld_s_base_smoother_type), allocatable :: sm, sm2a @@ -730,4 +731,30 @@ contains end subroutine s_wrk_move_alloc + subroutine s_wrk_cnv(wk,info,vmold) + use psb_base_mod + + Implicit None + + ! Arguments + class(mld_smlprec_wrk_type), target, intent(inout) :: wk + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_vect_type), intent(in), optional :: vmold + ! + integer(psb_ipk_) :: i + + info = psb_success_ + if (present(vmold)) then + call wk%vtx%cnv(vmold) + call wk%vty%cnv(vmold) + call wk%vx2l%cnv(vmold) + call wk%vy2l%cnv(vmold) + if (allocated(wk%wv)) then + do i=1,size(wk%wv) + call wk%wv(i)%cnv(vmold) + end do + end if + end if + end subroutine s_wrk_cnv + end module mld_s_onelev_mod diff --git a/mlprec/mld_z_onelev_mod.f90 b/mlprec/mld_z_onelev_mod.f90 index f6d14102..b2c8e6cb 100644 --- a/mlprec/mld_z_onelev_mod.f90 +++ b/mlprec/mld_z_onelev_mod.f90 @@ -130,9 +130,10 @@ module mld_z_onelev_mod procedure, pass(wk) :: free => z_wrk_free procedure, pass(wk) :: clone => z_wrk_clone procedure, pass(wk) :: move_alloc => z_wrk_move_alloc + procedure, pass(wk) :: cnv => z_wrk_cnv end type mld_zmlprec_wrk_type private :: z_wrk_alloc, z_wrk_free, & - & z_wrk_clone, z_wrk_move_alloc + & z_wrk_clone, z_wrk_move_alloc, z_wrk_cnv type mld_z_onelev_type class(mld_z_base_smoother_type), allocatable :: sm, sm2a @@ -730,4 +731,30 @@ contains end subroutine z_wrk_move_alloc + subroutine z_wrk_cnv(wk,info,vmold) + use psb_base_mod + + Implicit None + + ! Arguments + class(mld_zmlprec_wrk_type), target, intent(inout) :: wk + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_vect_type), intent(in), optional :: vmold + ! + integer(psb_ipk_) :: i + + info = psb_success_ + if (present(vmold)) then + call wk%vtx%cnv(vmold) + call wk%vty%cnv(vmold) + call wk%vx2l%cnv(vmold) + call wk%vy2l%cnv(vmold) + if (allocated(wk%wv)) then + do i=1,size(wk%wv) + call wk%wv(i)%cnv(vmold) + end do + end if + end if + end subroutine z_wrk_cnv + end module mld_z_onelev_mod