diff --git a/mlprec/impl/smoother/Makefile b/mlprec/impl/smoother/Makefile index 2a4490ab..62d69064 100644 --- a/mlprec/impl/smoother/Makefile +++ b/mlprec/impl/smoother/Makefile @@ -42,6 +42,7 @@ mld_c_base_smoother_setr.o \ mld_c_jac_smoother_apply.o \ mld_c_jac_smoother_apply_vect.o \ mld_c_jac_smoother_bld.o \ +mld_c_jac_smoother_descr.o \ mld_c_jac_smoother_dmp.o \ mld_c_jac_smoother_clone.o \ mld_c_jac_smoother_cnv.o \ @@ -81,6 +82,7 @@ mld_d_base_smoother_setr.o \ mld_d_jac_smoother_apply.o \ mld_d_jac_smoother_apply_vect.o \ mld_d_jac_smoother_bld.o \ +mld_d_jac_smoother_descr.o \ mld_d_jac_smoother_dmp.o \ mld_d_jac_smoother_clone.o \ mld_d_jac_smoother_cnv.o \ @@ -120,6 +122,7 @@ mld_s_base_smoother_setr.o \ mld_s_jac_smoother_apply.o \ mld_s_jac_smoother_apply_vect.o \ mld_s_jac_smoother_bld.o \ +mld_s_jac_smoother_descr.o \ mld_s_jac_smoother_dmp.o \ mld_s_jac_smoother_clone.o \ mld_s_jac_smoother_cnv.o \ @@ -159,6 +162,7 @@ mld_z_base_smoother_setr.o \ mld_z_jac_smoother_apply.o \ mld_z_jac_smoother_apply_vect.o \ mld_z_jac_smoother_bld.o \ +mld_z_jac_smoother_descr.o \ mld_z_jac_smoother_dmp.o \ mld_z_jac_smoother_clone.o \ mld_z_jac_smoother_cnv.o diff --git a/mlprec/impl/smoother/mld_c_base_smoother_descr.f90 b/mlprec/impl/smoother/mld_c_base_smoother_descr.f90 index 3b69691f..7dff2afb 100644 --- a/mlprec/impl/smoother/mld_c_base_smoother_descr.f90 +++ b/mlprec/impl/smoother/mld_c_base_smoother_descr.f90 @@ -68,7 +68,7 @@ subroutine mld_c_base_smoother_descr(sm,info,iout,coarse) if (present(iout)) then iout_ = iout else - iout_ = 6 + iout_ = psb_out_unit end if if (.not.coarse_) & diff --git a/mlprec/impl/smoother/mld_c_jac_smoother_descr.f90 b/mlprec/impl/smoother/mld_c_jac_smoother_descr.f90 new file mode 100644 index 00000000..f0ecd4e8 --- /dev/null +++ b/mlprec/impl/smoother/mld_c_jac_smoother_descr.f90 @@ -0,0 +1,107 @@ +! +! +! MLD2P4 version 2.1 +! MultiLevel Domain Decomposition Parallel Preconditioners Package +! based on PSBLAS (Parallel Sparse BLAS version 3.5) +! +! (C) Copyright 2008, 2010, 2012, 2015, 2017 +! +! Salvatore Filippone Cranfield University, UK +! Ambra Abdullahi Hassan University of Rome Tor Vergata, IT +! Alfredo Buttari CNRS-IRIT, Toulouse, FR +! Pasqua D'Ambra IAC-CNR, Naples, IT +! Daniela di Serafino University of Campania "L. Vanvitelli", Caserta, IT +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the MLD2P4 group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +subroutine mld_c_jac_smoother_descr(sm,info,iout,coarse) + + use psb_base_mod + use mld_c_diag_solver + use mld_c_jac_smoother, mld_protect_name => mld_c_jac_smoother_descr + use mld_c_diag_solver + use mld_c_gs_solver + + Implicit None + + ! Arguments + class(mld_c_jac_smoother_type), intent(in) :: sm + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + ! Local variables + integer(psb_ipk_) :: err_act + character(len=20), parameter :: name='mld_c_jac_smoother_descr' + integer(psb_ipk_) :: iout_ + logical :: coarse_ + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(coarse)) then + coarse_ = coarse + else + coarse_ = .false. + end if + if (present(iout)) then + iout_ = iout + else + iout_ = psb_out_unit + endif + + if (.not.coarse_) then + if (allocated(sm%sv)) then + select type(smv=>sm%sv) + class is (mld_c_diag_solver_type) + write(iout_,*) ' Point Jacobi smoother ' + class is (mld_c_bwgs_solver_type) + write(iout_,*) ' Hybrid Backward Gauss-Seidel smoother ' +!!$ write(iout_,*) ' Local Gauss-Seidel solver details:' +!!$ call smv%descr(info,iout_,coarse=coarse) + class is (mld_c_gs_solver_type) + write(iout_,*) ' Hybrid Forward Gauss-Seidel smoother ' +!!$ write(iout_,*) ' Local Gauss-Seidel solver details:' +!!$ call smv%descr(info,iout_,coarse=coarse) + class default + write(iout_,*) ' Block Jacobi smoother ' + write(iout_,*) ' Local solver details:' + call smv%descr(info,iout_,coarse=coarse) + end select + + else + write(iout_,*) ' Block Jacobi smoother ' + end if + else + if (allocated(sm%sv)) then + call sm%sv%descr(info,iout_,coarse=coarse) + end if + end if + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine mld_c_jac_smoother_descr diff --git a/mlprec/impl/smoother/mld_d_base_smoother_descr.f90 b/mlprec/impl/smoother/mld_d_base_smoother_descr.f90 index 99fd5ddb..b11844f3 100644 --- a/mlprec/impl/smoother/mld_d_base_smoother_descr.f90 +++ b/mlprec/impl/smoother/mld_d_base_smoother_descr.f90 @@ -68,7 +68,7 @@ subroutine mld_d_base_smoother_descr(sm,info,iout,coarse) if (present(iout)) then iout_ = iout else - iout_ = 6 + iout_ = psb_out_unit end if if (.not.coarse_) & diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_descr.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_descr.f90 new file mode 100644 index 00000000..e83d2565 --- /dev/null +++ b/mlprec/impl/smoother/mld_d_jac_smoother_descr.f90 @@ -0,0 +1,107 @@ +! +! +! MLD2P4 version 2.1 +! MultiLevel Domain Decomposition Parallel Preconditioners Package +! based on PSBLAS (Parallel Sparse BLAS version 3.5) +! +! (C) Copyright 2008, 2010, 2012, 2015, 2017 +! +! Salvatore Filippone Cranfield University, UK +! Ambra Abdullahi Hassan University of Rome Tor Vergata, IT +! Alfredo Buttari CNRS-IRIT, Toulouse, FR +! Pasqua D'Ambra IAC-CNR, Naples, IT +! Daniela di Serafino University of Campania "L. Vanvitelli", Caserta, IT +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the MLD2P4 group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +subroutine mld_d_jac_smoother_descr(sm,info,iout,coarse) + + use psb_base_mod + use mld_d_diag_solver + use mld_d_jac_smoother, mld_protect_name => mld_d_jac_smoother_descr + use mld_d_diag_solver + use mld_d_gs_solver + + Implicit None + + ! Arguments + class(mld_d_jac_smoother_type), intent(in) :: sm + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + ! Local variables + integer(psb_ipk_) :: err_act + character(len=20), parameter :: name='mld_d_jac_smoother_descr' + integer(psb_ipk_) :: iout_ + logical :: coarse_ + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(coarse)) then + coarse_ = coarse + else + coarse_ = .false. + end if + if (present(iout)) then + iout_ = iout + else + iout_ = psb_out_unit + endif + + if (.not.coarse_) then + if (allocated(sm%sv)) then + select type(smv=>sm%sv) + class is (mld_d_diag_solver_type) + write(iout_,*) ' Point Jacobi smoother ' + class is (mld_d_bwgs_solver_type) + write(iout_,*) ' Hybrid Backward Gauss-Seidel smoother ' +!!$ write(iout_,*) ' Local Gauss-Seidel solver details:' +!!$ call smv%descr(info,iout_,coarse=coarse) + class is (mld_d_gs_solver_type) + write(iout_,*) ' Hybrid Forward Gauss-Seidel smoother ' +!!$ write(iout_,*) ' Local Gauss-Seidel solver details:' +!!$ call smv%descr(info,iout_,coarse=coarse) + class default + write(iout_,*) ' Block Jacobi smoother ' + write(iout_,*) ' Local solver details:' + call smv%descr(info,iout_,coarse=coarse) + end select + + else + write(iout_,*) ' Block Jacobi smoother ' + end if + else + if (allocated(sm%sv)) then + call sm%sv%descr(info,iout_,coarse=coarse) + end if + end if + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine mld_d_jac_smoother_descr diff --git a/mlprec/impl/smoother/mld_s_base_smoother_descr.f90 b/mlprec/impl/smoother/mld_s_base_smoother_descr.f90 index 516dfea0..db1241dd 100644 --- a/mlprec/impl/smoother/mld_s_base_smoother_descr.f90 +++ b/mlprec/impl/smoother/mld_s_base_smoother_descr.f90 @@ -68,7 +68,7 @@ subroutine mld_s_base_smoother_descr(sm,info,iout,coarse) if (present(iout)) then iout_ = iout else - iout_ = 6 + iout_ = psb_out_unit end if if (.not.coarse_) & diff --git a/mlprec/impl/smoother/mld_s_jac_smoother_descr.f90 b/mlprec/impl/smoother/mld_s_jac_smoother_descr.f90 new file mode 100644 index 00000000..007c66a6 --- /dev/null +++ b/mlprec/impl/smoother/mld_s_jac_smoother_descr.f90 @@ -0,0 +1,107 @@ +! +! +! MLD2P4 version 2.1 +! MultiLevel Domain Decomposition Parallel Preconditioners Package +! based on PSBLAS (Parallel Sparse BLAS version 3.5) +! +! (C) Copyright 2008, 2010, 2012, 2015, 2017 +! +! Salvatore Filippone Cranfield University, UK +! Ambra Abdullahi Hassan University of Rome Tor Vergata, IT +! Alfredo Buttari CNRS-IRIT, Toulouse, FR +! Pasqua D'Ambra IAC-CNR, Naples, IT +! Daniela di Serafino University of Campania "L. Vanvitelli", Caserta, IT +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the MLD2P4 group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +subroutine mld_s_jac_smoother_descr(sm,info,iout,coarse) + + use psb_base_mod + use mld_s_diag_solver + use mld_s_jac_smoother, mld_protect_name => mld_s_jac_smoother_descr + use mld_s_diag_solver + use mld_s_gs_solver + + Implicit None + + ! Arguments + class(mld_s_jac_smoother_type), intent(in) :: sm + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + ! Local variables + integer(psb_ipk_) :: err_act + character(len=20), parameter :: name='mld_s_jac_smoother_descr' + integer(psb_ipk_) :: iout_ + logical :: coarse_ + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(coarse)) then + coarse_ = coarse + else + coarse_ = .false. + end if + if (present(iout)) then + iout_ = iout + else + iout_ = psb_out_unit + endif + + if (.not.coarse_) then + if (allocated(sm%sv)) then + select type(smv=>sm%sv) + class is (mld_s_diag_solver_type) + write(iout_,*) ' Point Jacobi smoother ' + class is (mld_s_bwgs_solver_type) + write(iout_,*) ' Hybrid Backward Gauss-Seidel smoother ' +!!$ write(iout_,*) ' Local Gauss-Seidel solver details:' +!!$ call smv%descr(info,iout_,coarse=coarse) + class is (mld_s_gs_solver_type) + write(iout_,*) ' Hybrid Forward Gauss-Seidel smoother ' +!!$ write(iout_,*) ' Local Gauss-Seidel solver details:' +!!$ call smv%descr(info,iout_,coarse=coarse) + class default + write(iout_,*) ' Block Jacobi smoother ' + write(iout_,*) ' Local solver details:' + call smv%descr(info,iout_,coarse=coarse) + end select + + else + write(iout_,*) ' Block Jacobi smoother ' + end if + else + if (allocated(sm%sv)) then + call sm%sv%descr(info,iout_,coarse=coarse) + end if + end if + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine mld_s_jac_smoother_descr diff --git a/mlprec/impl/smoother/mld_z_base_smoother_descr.f90 b/mlprec/impl/smoother/mld_z_base_smoother_descr.f90 index 95fbb26c..66a93e95 100644 --- a/mlprec/impl/smoother/mld_z_base_smoother_descr.f90 +++ b/mlprec/impl/smoother/mld_z_base_smoother_descr.f90 @@ -68,7 +68,7 @@ subroutine mld_z_base_smoother_descr(sm,info,iout,coarse) if (present(iout)) then iout_ = iout else - iout_ = 6 + iout_ = psb_out_unit end if if (.not.coarse_) & diff --git a/mlprec/impl/smoother/mld_z_jac_smoother_descr.f90 b/mlprec/impl/smoother/mld_z_jac_smoother_descr.f90 new file mode 100644 index 00000000..533ec20c --- /dev/null +++ b/mlprec/impl/smoother/mld_z_jac_smoother_descr.f90 @@ -0,0 +1,107 @@ +! +! +! MLD2P4 version 2.1 +! MultiLevel Domain Decomposition Parallel Preconditioners Package +! based on PSBLAS (Parallel Sparse BLAS version 3.5) +! +! (C) Copyright 2008, 2010, 2012, 2015, 2017 +! +! Salvatore Filippone Cranfield University, UK +! Ambra Abdullahi Hassan University of Rome Tor Vergata, IT +! Alfredo Buttari CNRS-IRIT, Toulouse, FR +! Pasqua D'Ambra IAC-CNR, Naples, IT +! Daniela di Serafino University of Campania "L. Vanvitelli", Caserta, IT +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the MLD2P4 group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +subroutine mld_z_jac_smoother_descr(sm,info,iout,coarse) + + use psb_base_mod + use mld_z_diag_solver + use mld_z_jac_smoother, mld_protect_name => mld_z_jac_smoother_descr + use mld_z_diag_solver + use mld_z_gs_solver + + Implicit None + + ! Arguments + class(mld_z_jac_smoother_type), intent(in) :: sm + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + ! Local variables + integer(psb_ipk_) :: err_act + character(len=20), parameter :: name='mld_z_jac_smoother_descr' + integer(psb_ipk_) :: iout_ + logical :: coarse_ + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(coarse)) then + coarse_ = coarse + else + coarse_ = .false. + end if + if (present(iout)) then + iout_ = iout + else + iout_ = psb_out_unit + endif + + if (.not.coarse_) then + if (allocated(sm%sv)) then + select type(smv=>sm%sv) + class is (mld_z_diag_solver_type) + write(iout_,*) ' Point Jacobi smoother ' + class is (mld_z_bwgs_solver_type) + write(iout_,*) ' Hybrid Backward Gauss-Seidel smoother ' +!!$ write(iout_,*) ' Local Gauss-Seidel solver details:' +!!$ call smv%descr(info,iout_,coarse=coarse) + class is (mld_z_gs_solver_type) + write(iout_,*) ' Hybrid Forward Gauss-Seidel smoother ' +!!$ write(iout_,*) ' Local Gauss-Seidel solver details:' +!!$ call smv%descr(info,iout_,coarse=coarse) + class default + write(iout_,*) ' Block Jacobi smoother ' + write(iout_,*) ' Local solver details:' + call smv%descr(info,iout_,coarse=coarse) + end select + + else + write(iout_,*) ' Block Jacobi smoother ' + end if + else + if (allocated(sm%sv)) then + call sm%sv%descr(info,iout_,coarse=coarse) + end if + end if + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine mld_z_jac_smoother_descr diff --git a/mlprec/mld_c_jac_smoother.f90 b/mlprec/mld_c_jac_smoother.f90 index 20b517a2..f2af3cfa 100644 --- a/mlprec/mld_c_jac_smoother.f90 +++ b/mlprec/mld_c_jac_smoother.f90 @@ -70,7 +70,7 @@ module mld_c_jac_smoother procedure, pass(sm) :: apply_v => mld_c_jac_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_c_jac_smoother_apply procedure, pass(sm) :: free => c_jac_smoother_free - procedure, pass(sm) :: descr => c_jac_smoother_descr + procedure, pass(sm) :: descr => mld_c_jac_smoother_descr procedure, pass(sm) :: sizeof => c_jac_smoother_sizeof procedure, pass(sm) :: get_nzeros => c_jac_smoother_get_nzeros procedure, nopass :: get_fmt => c_jac_smoother_get_fmt @@ -176,7 +176,17 @@ module mld_c_jac_smoother integer(psb_ipk_), intent(out) :: info end subroutine mld_c_jac_smoother_clone end interface - + + interface + subroutine mld_c_jac_smoother_descr(sm,info,iout,coarse) + import :: mld_c_jac_smoother_type, psb_ipk_ + class(mld_c_jac_smoother_type), intent(in) :: sm + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + end subroutine mld_c_jac_smoother_descr + end interface + contains @@ -214,50 +224,6 @@ contains return end subroutine c_jac_smoother_free - subroutine c_jac_smoother_descr(sm,info,iout,coarse) - - Implicit None - - ! Arguments - class(mld_c_jac_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse - - ! Local variables - integer(psb_ipk_) :: err_act - character(len=20), parameter :: name='mld_c_jac_smoother_descr' - integer(psb_ipk_) :: iout_ - logical :: coarse_ - - call psb_erractionsave(err_act) - info = psb_success_ - if (present(coarse)) then - coarse_ = coarse - else - coarse_ = .false. - end if - if (present(iout)) then - iout_ = iout - else - iout_ = psb_out_unit - endif - - if (.not.coarse_) then - write(iout_,*) ' Block Jacobi smoother ' - write(iout_,*) ' Local solver:' - end if - if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine c_jac_smoother_descr - function c_jac_smoother_sizeof(sm) result(val) implicit none diff --git a/mlprec/mld_d_jac_smoother.f90 b/mlprec/mld_d_jac_smoother.f90 index 3519403c..c7884f95 100644 --- a/mlprec/mld_d_jac_smoother.f90 +++ b/mlprec/mld_d_jac_smoother.f90 @@ -70,7 +70,7 @@ module mld_d_jac_smoother procedure, pass(sm) :: apply_v => mld_d_jac_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_d_jac_smoother_apply procedure, pass(sm) :: free => d_jac_smoother_free - procedure, pass(sm) :: descr => d_jac_smoother_descr + procedure, pass(sm) :: descr => mld_d_jac_smoother_descr procedure, pass(sm) :: sizeof => d_jac_smoother_sizeof procedure, pass(sm) :: get_nzeros => d_jac_smoother_get_nzeros procedure, nopass :: get_fmt => d_jac_smoother_get_fmt @@ -176,7 +176,17 @@ module mld_d_jac_smoother integer(psb_ipk_), intent(out) :: info end subroutine mld_d_jac_smoother_clone end interface - + + interface + subroutine mld_d_jac_smoother_descr(sm,info,iout,coarse) + import :: mld_d_jac_smoother_type, psb_ipk_ + class(mld_d_jac_smoother_type), intent(in) :: sm + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + end subroutine mld_d_jac_smoother_descr + end interface + contains @@ -214,50 +224,6 @@ contains return end subroutine d_jac_smoother_free - subroutine d_jac_smoother_descr(sm,info,iout,coarse) - - Implicit None - - ! Arguments - class(mld_d_jac_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse - - ! Local variables - integer(psb_ipk_) :: err_act - character(len=20), parameter :: name='mld_d_jac_smoother_descr' - integer(psb_ipk_) :: iout_ - logical :: coarse_ - - call psb_erractionsave(err_act) - info = psb_success_ - if (present(coarse)) then - coarse_ = coarse - else - coarse_ = .false. - end if - if (present(iout)) then - iout_ = iout - else - iout_ = psb_out_unit - endif - - if (.not.coarse_) then - write(iout_,*) ' Block Jacobi smoother ' - write(iout_,*) ' Local solver:' - end if - if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine d_jac_smoother_descr - function d_jac_smoother_sizeof(sm) result(val) implicit none diff --git a/mlprec/mld_s_jac_smoother.f90 b/mlprec/mld_s_jac_smoother.f90 index af926a28..86167d89 100644 --- a/mlprec/mld_s_jac_smoother.f90 +++ b/mlprec/mld_s_jac_smoother.f90 @@ -70,7 +70,7 @@ module mld_s_jac_smoother procedure, pass(sm) :: apply_v => mld_s_jac_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_s_jac_smoother_apply procedure, pass(sm) :: free => s_jac_smoother_free - procedure, pass(sm) :: descr => s_jac_smoother_descr + procedure, pass(sm) :: descr => mld_s_jac_smoother_descr procedure, pass(sm) :: sizeof => s_jac_smoother_sizeof procedure, pass(sm) :: get_nzeros => s_jac_smoother_get_nzeros procedure, nopass :: get_fmt => s_jac_smoother_get_fmt @@ -176,7 +176,17 @@ module mld_s_jac_smoother integer(psb_ipk_), intent(out) :: info end subroutine mld_s_jac_smoother_clone end interface - + + interface + subroutine mld_s_jac_smoother_descr(sm,info,iout,coarse) + import :: mld_s_jac_smoother_type, psb_ipk_ + class(mld_s_jac_smoother_type), intent(in) :: sm + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + end subroutine mld_s_jac_smoother_descr + end interface + contains @@ -214,50 +224,6 @@ contains return end subroutine s_jac_smoother_free - subroutine s_jac_smoother_descr(sm,info,iout,coarse) - - Implicit None - - ! Arguments - class(mld_s_jac_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse - - ! Local variables - integer(psb_ipk_) :: err_act - character(len=20), parameter :: name='mld_s_jac_smoother_descr' - integer(psb_ipk_) :: iout_ - logical :: coarse_ - - call psb_erractionsave(err_act) - info = psb_success_ - if (present(coarse)) then - coarse_ = coarse - else - coarse_ = .false. - end if - if (present(iout)) then - iout_ = iout - else - iout_ = psb_out_unit - endif - - if (.not.coarse_) then - write(iout_,*) ' Block Jacobi smoother ' - write(iout_,*) ' Local solver:' - end if - if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine s_jac_smoother_descr - function s_jac_smoother_sizeof(sm) result(val) implicit none diff --git a/mlprec/mld_z_jac_smoother.f90 b/mlprec/mld_z_jac_smoother.f90 index cf34b4f8..d53c7fc5 100644 --- a/mlprec/mld_z_jac_smoother.f90 +++ b/mlprec/mld_z_jac_smoother.f90 @@ -70,7 +70,7 @@ module mld_z_jac_smoother procedure, pass(sm) :: apply_v => mld_z_jac_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_z_jac_smoother_apply procedure, pass(sm) :: free => z_jac_smoother_free - procedure, pass(sm) :: descr => z_jac_smoother_descr + procedure, pass(sm) :: descr => mld_z_jac_smoother_descr procedure, pass(sm) :: sizeof => z_jac_smoother_sizeof procedure, pass(sm) :: get_nzeros => z_jac_smoother_get_nzeros procedure, nopass :: get_fmt => z_jac_smoother_get_fmt @@ -176,7 +176,17 @@ module mld_z_jac_smoother integer(psb_ipk_), intent(out) :: info end subroutine mld_z_jac_smoother_clone end interface - + + interface + subroutine mld_z_jac_smoother_descr(sm,info,iout,coarse) + import :: mld_z_jac_smoother_type, psb_ipk_ + class(mld_z_jac_smoother_type), intent(in) :: sm + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + end subroutine mld_z_jac_smoother_descr + end interface + contains @@ -214,50 +224,6 @@ contains return end subroutine z_jac_smoother_free - subroutine z_jac_smoother_descr(sm,info,iout,coarse) - - Implicit None - - ! Arguments - class(mld_z_jac_smoother_type), intent(in) :: sm - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: iout - logical, intent(in), optional :: coarse - - ! Local variables - integer(psb_ipk_) :: err_act - character(len=20), parameter :: name='mld_z_jac_smoother_descr' - integer(psb_ipk_) :: iout_ - logical :: coarse_ - - call psb_erractionsave(err_act) - info = psb_success_ - if (present(coarse)) then - coarse_ = coarse - else - coarse_ = .false. - end if - if (present(iout)) then - iout_ = iout - else - iout_ = psb_out_unit - endif - - if (.not.coarse_) then - write(iout_,*) ' Block Jacobi smoother ' - write(iout_,*) ' Local solver:' - end if - if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine z_jac_smoother_descr - function z_jac_smoother_sizeof(sm) result(val) implicit none