From 7092dc2063eaae2e6b0a0150970a34457a0d1961 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sat, 5 May 2018 07:46:24 +0100 Subject: [PATCH] Fixed compilation process. --- mlprec/impl/level/Makefile | 12 ++- .../impl/level/mld_c_base_onelev_mat_asb.f90 | 8 +- mlprec/impl/level/mld_c_base_onelev_setag.f90 | 80 +++++++++++++++++++ .../impl/level/mld_d_base_onelev_mat_asb.f90 | 8 +- mlprec/impl/level/mld_d_base_onelev_setag.f90 | 80 +++++++++++++++++++ .../impl/level/mld_s_base_onelev_mat_asb.f90 | 8 +- mlprec/impl/level/mld_s_base_onelev_setag.f90 | 80 +++++++++++++++++++ .../impl/level/mld_z_base_onelev_mat_asb.f90 | 8 +- mlprec/impl/level/mld_z_base_onelev_setag.f90 | 80 +++++++++++++++++++ mlprec/impl/mld_cprecset.F90 | 64 +++++++++++++++ mlprec/impl/mld_dprecset.F90 | 64 +++++++++++++++ mlprec/impl/mld_sprecset.F90 | 64 +++++++++++++++ mlprec/impl/mld_zprecset.F90 | 64 +++++++++++++++ 13 files changed, 600 insertions(+), 20 deletions(-) create mode 100644 mlprec/impl/level/mld_c_base_onelev_setag.f90 create mode 100644 mlprec/impl/level/mld_d_base_onelev_setag.f90 create mode 100644 mlprec/impl/level/mld_s_base_onelev_setag.f90 create mode 100644 mlprec/impl/level/mld_z_base_onelev_setag.f90 diff --git a/mlprec/impl/level/Makefile b/mlprec/impl/level/Makefile index 6a484fe1..9cb12928 100644 --- a/mlprec/impl/level/Makefile +++ b/mlprec/impl/level/Makefile @@ -17,7 +17,8 @@ mld_c_base_onelev_csetr.o \ mld_c_base_onelev_descr.o \ mld_c_base_onelev_dump.o \ mld_c_base_onelev_free.o \ -mld_c_base_onelev_mat_asb.f90 \ +mld_c_base_onelev_mat_asb.o \ +mld_c_base_onelev_setag.o \ mld_c_base_onelev_setc.o \ mld_c_base_onelev_seti.o \ mld_c_base_onelev_setr.o \ @@ -32,7 +33,8 @@ mld_d_base_onelev_csetr.o \ mld_d_base_onelev_descr.o \ mld_d_base_onelev_dump.o \ mld_d_base_onelev_free.o \ -mld_d_base_onelev_mat_asb.f90 \ +mld_d_base_onelev_mat_asb.o \ +mld_d_base_onelev_setag.o \ mld_d_base_onelev_setc.o \ mld_d_base_onelev_seti.o \ mld_d_base_onelev_setr.o \ @@ -47,7 +49,8 @@ mld_s_base_onelev_csetr.o \ mld_s_base_onelev_descr.o \ mld_s_base_onelev_dump.o \ mld_s_base_onelev_free.o \ -mld_s_base_onelev_mat_asb.f90 \ +mld_s_base_onelev_mat_asb.o \ +mld_s_base_onelev_setag.o \ mld_s_base_onelev_setc.o \ mld_s_base_onelev_seti.o \ mld_s_base_onelev_setr.o \ @@ -62,7 +65,8 @@ mld_z_base_onelev_csetr.o \ mld_z_base_onelev_descr.o \ mld_z_base_onelev_dump.o \ mld_z_base_onelev_free.o \ -mld_z_base_onelev_mat_asb.f90 \ +mld_z_base_onelev_mat_asb.o \ +mld_z_base_onelev_setag.o \ mld_z_base_onelev_setc.o \ mld_z_base_onelev_seti.o \ mld_z_base_onelev_setr.o \ diff --git a/mlprec/impl/level/mld_c_base_onelev_mat_asb.f90 b/mlprec/impl/level/mld_c_base_onelev_mat_asb.f90 index a1569265..c9275dc8 100644 --- a/mlprec/impl/level/mld_c_base_onelev_mat_asb.f90 +++ b/mlprec/impl/level/mld_c_base_onelev_mat_asb.f90 @@ -83,11 +83,11 @@ ! info - integer, output. ! Error code. ! -subroutine mld_c_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) +subroutine mld_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) use psb_base_mod use mld_base_prec_type - use mld_c_inner_mod, mld_protect_name => mld_c_onelev_mat_asb + use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_mat_asb implicit none @@ -137,7 +137,7 @@ subroutine mld_c_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) ! the mapping defined by mld_aggrmap_bld and applying the aggregation ! algorithm specified by lv%iprcparm(mld_aggr_prol_) ! - call lv%aggr%mat_asb(a,desc_a,ilaggr,nlaggr,lv%parms,ac,op_prol,op_restr,info) + call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb') @@ -264,4 +264,4 @@ subroutine mld_c_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) 9999 call psb_error_handler(err_act) return -end subroutine mld_c_onelev_mat_asb +end subroutine mld_c_base_onelev_mat_asb diff --git a/mlprec/impl/level/mld_c_base_onelev_setag.f90 b/mlprec/impl/level/mld_c_base_onelev_setag.f90 new file mode 100644 index 00000000..9625b7e9 --- /dev/null +++ b/mlprec/impl/level/mld_c_base_onelev_setag.f90 @@ -0,0 +1,80 @@ +! +! +! 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 , 2017 +! +! Salvatore Filippone Cranfield University +! Ambra Abdullahi Hassan University of Rome Tor Vergata +! 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_base_onelev_setag(lev,val,info,pos) + + use psb_base_mod + use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_setag + + implicit none + + ! Arguments + class(mld_c_onelev_type), target, intent(inout) :: lev + class(mld_c_base_aggregator_type), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + character(len=*), optional, intent(in) :: pos + + ! Local variables + integer(psb_ipk_) :: ipos_ + character(len=*), parameter :: name='mld_base_onelev_setag' + + info = psb_success_ + + ! Ignore pos for aggregator + + if (allocated(lev%aggr)) then + if (.not.same_type_as(lev%aggr,val)) then + call lev%aggr%free(info) + deallocate(lev%aggr,stat=info) + if (info /= 0) then + info = 3111 + return + end if + end if + end if + + if (.not.allocated(lev%aggr)) then + allocate(lev%aggr,mold=val,stat=info) + if (info /= 0) then + info = 3111 + return + end if + end if + +end subroutine mld_c_base_onelev_setag + diff --git a/mlprec/impl/level/mld_d_base_onelev_mat_asb.f90 b/mlprec/impl/level/mld_d_base_onelev_mat_asb.f90 index d8105c63..84c81147 100644 --- a/mlprec/impl/level/mld_d_base_onelev_mat_asb.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_mat_asb.f90 @@ -83,11 +83,11 @@ ! info - integer, output. ! Error code. ! -subroutine mld_d_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) +subroutine mld_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) use psb_base_mod use mld_base_prec_type - use mld_d_inner_mod, mld_protect_name => mld_d_onelev_mat_asb + use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_mat_asb implicit none @@ -137,7 +137,7 @@ subroutine mld_d_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) ! the mapping defined by mld_aggrmap_bld and applying the aggregation ! algorithm specified by lv%iprcparm(mld_aggr_prol_) ! - call lv%aggr%mat_asb(a,desc_a,ilaggr,nlaggr,lv%parms,ac,op_prol,op_restr,info) + call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb') @@ -264,4 +264,4 @@ subroutine mld_d_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) 9999 call psb_error_handler(err_act) return -end subroutine mld_d_onelev_mat_asb +end subroutine mld_d_base_onelev_mat_asb diff --git a/mlprec/impl/level/mld_d_base_onelev_setag.f90 b/mlprec/impl/level/mld_d_base_onelev_setag.f90 new file mode 100644 index 00000000..1ce8ed51 --- /dev/null +++ b/mlprec/impl/level/mld_d_base_onelev_setag.f90 @@ -0,0 +1,80 @@ +! +! +! 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 , 2017 +! +! Salvatore Filippone Cranfield University +! Ambra Abdullahi Hassan University of Rome Tor Vergata +! 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_base_onelev_setag(lev,val,info,pos) + + use psb_base_mod + use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_setag + + implicit none + + ! Arguments + class(mld_d_onelev_type), target, intent(inout) :: lev + class(mld_d_base_aggregator_type), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + character(len=*), optional, intent(in) :: pos + + ! Local variables + integer(psb_ipk_) :: ipos_ + character(len=*), parameter :: name='mld_base_onelev_setag' + + info = psb_success_ + + ! Ignore pos for aggregator + + if (allocated(lev%aggr)) then + if (.not.same_type_as(lev%aggr,val)) then + call lev%aggr%free(info) + deallocate(lev%aggr,stat=info) + if (info /= 0) then + info = 3111 + return + end if + end if + end if + + if (.not.allocated(lev%aggr)) then + allocate(lev%aggr,mold=val,stat=info) + if (info /= 0) then + info = 3111 + return + end if + end if + +end subroutine mld_d_base_onelev_setag + diff --git a/mlprec/impl/level/mld_s_base_onelev_mat_asb.f90 b/mlprec/impl/level/mld_s_base_onelev_mat_asb.f90 index 13b43e42..1e56b3f8 100644 --- a/mlprec/impl/level/mld_s_base_onelev_mat_asb.f90 +++ b/mlprec/impl/level/mld_s_base_onelev_mat_asb.f90 @@ -83,11 +83,11 @@ ! info - integer, output. ! Error code. ! -subroutine mld_s_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) +subroutine mld_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) use psb_base_mod use mld_base_prec_type - use mld_s_inner_mod, mld_protect_name => mld_s_onelev_mat_asb + use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_mat_asb implicit none @@ -137,7 +137,7 @@ subroutine mld_s_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) ! the mapping defined by mld_aggrmap_bld and applying the aggregation ! algorithm specified by lv%iprcparm(mld_aggr_prol_) ! - call lv%aggr%mat_asb(a,desc_a,ilaggr,nlaggr,lv%parms,ac,op_prol,op_restr,info) + call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb') @@ -264,4 +264,4 @@ subroutine mld_s_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) 9999 call psb_error_handler(err_act) return -end subroutine mld_s_onelev_mat_asb +end subroutine mld_s_base_onelev_mat_asb diff --git a/mlprec/impl/level/mld_s_base_onelev_setag.f90 b/mlprec/impl/level/mld_s_base_onelev_setag.f90 new file mode 100644 index 00000000..3c78aef1 --- /dev/null +++ b/mlprec/impl/level/mld_s_base_onelev_setag.f90 @@ -0,0 +1,80 @@ +! +! +! 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 , 2017 +! +! Salvatore Filippone Cranfield University +! Ambra Abdullahi Hassan University of Rome Tor Vergata +! 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_base_onelev_setag(lev,val,info,pos) + + use psb_base_mod + use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_setag + + implicit none + + ! Arguments + class(mld_s_onelev_type), target, intent(inout) :: lev + class(mld_s_base_aggregator_type), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + character(len=*), optional, intent(in) :: pos + + ! Local variables + integer(psb_ipk_) :: ipos_ + character(len=*), parameter :: name='mld_base_onelev_setag' + + info = psb_success_ + + ! Ignore pos for aggregator + + if (allocated(lev%aggr)) then + if (.not.same_type_as(lev%aggr,val)) then + call lev%aggr%free(info) + deallocate(lev%aggr,stat=info) + if (info /= 0) then + info = 3111 + return + end if + end if + end if + + if (.not.allocated(lev%aggr)) then + allocate(lev%aggr,mold=val,stat=info) + if (info /= 0) then + info = 3111 + return + end if + end if + +end subroutine mld_s_base_onelev_setag + diff --git a/mlprec/impl/level/mld_z_base_onelev_mat_asb.f90 b/mlprec/impl/level/mld_z_base_onelev_mat_asb.f90 index 62e58069..9ddc6749 100644 --- a/mlprec/impl/level/mld_z_base_onelev_mat_asb.f90 +++ b/mlprec/impl/level/mld_z_base_onelev_mat_asb.f90 @@ -83,11 +83,11 @@ ! info - integer, output. ! Error code. ! -subroutine mld_z_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) +subroutine mld_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) use psb_base_mod use mld_base_prec_type - use mld_z_inner_mod, mld_protect_name => mld_z_onelev_mat_asb + use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_mat_asb implicit none @@ -137,7 +137,7 @@ subroutine mld_z_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) ! the mapping defined by mld_aggrmap_bld and applying the aggregation ! algorithm specified by lv%iprcparm(mld_aggr_prol_) ! - call lv%aggr%mat_asb(a,desc_a,ilaggr,nlaggr,lv%parms,ac,op_prol,op_restr,info) + call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb') @@ -264,4 +264,4 @@ subroutine mld_z_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) 9999 call psb_error_handler(err_act) return -end subroutine mld_z_onelev_mat_asb +end subroutine mld_z_base_onelev_mat_asb diff --git a/mlprec/impl/level/mld_z_base_onelev_setag.f90 b/mlprec/impl/level/mld_z_base_onelev_setag.f90 new file mode 100644 index 00000000..c69bb47a --- /dev/null +++ b/mlprec/impl/level/mld_z_base_onelev_setag.f90 @@ -0,0 +1,80 @@ +! +! +! 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 , 2017 +! +! Salvatore Filippone Cranfield University +! Ambra Abdullahi Hassan University of Rome Tor Vergata +! 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_base_onelev_setag(lev,val,info,pos) + + use psb_base_mod + use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_setag + + implicit none + + ! Arguments + class(mld_z_onelev_type), target, intent(inout) :: lev + class(mld_z_base_aggregator_type), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + character(len=*), optional, intent(in) :: pos + + ! Local variables + integer(psb_ipk_) :: ipos_ + character(len=*), parameter :: name='mld_base_onelev_setag' + + info = psb_success_ + + ! Ignore pos for aggregator + + if (allocated(lev%aggr)) then + if (.not.same_type_as(lev%aggr,val)) then + call lev%aggr%free(info) + deallocate(lev%aggr,stat=info) + if (info /= 0) then + info = 3111 + return + end if + end if + end if + + if (.not.allocated(lev%aggr)) then + allocate(lev%aggr,mold=val,stat=info) + if (info /= 0) then + info = 3111 + return + end if + end if + +end subroutine mld_z_base_onelev_setag + diff --git a/mlprec/impl/mld_cprecset.F90 b/mlprec/impl/mld_cprecset.F90 index d6f8c468..f785c6b7 100644 --- a/mlprec/impl/mld_cprecset.F90 +++ b/mlprec/impl/mld_cprecset.F90 @@ -542,6 +542,70 @@ subroutine mld_cprecsetsv(p,val,info,ilev,ilmax,pos) end subroutine mld_cprecsetsv +subroutine mld_cprecsetag(p,val,info,ilev,ilmax,pos) + + use psb_base_mod + use mld_c_prec_mod, mld_protect_name => mld_cprecsetag + + implicit none + + ! Arguments + class(mld_cprec_type), intent(inout) :: p + class(mld_c_base_aggregator_type), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev, ilmax + character(len=*), optional, intent(in) :: pos + + ! Local variables + integer(psb_ipk_) :: ilev_, nlev_, ilmin_, ilmax_ + character(len=*), parameter :: name='mld_precsetag' + + info = psb_success_ + + if (.not.allocated(p%precv)) then + info = 3111 + write(psb_err_unit,*) name,& + & ': Error: uninitialized preconditioner,',& + &' should call MLD_PRECINIT' + return + endif + nlev_ = size(p%precv) + + if (present(ilev)) then + ilev_ = ilev + ilmin_ = ilev + if (present(ilmax)) then + ilmax_ = ilmax + else + ilmax_ = ilev_ + end if + else + ilev_ = 1 + ilmin_ = 1 + ilmax_ = nlev_ + end if + + + if ((ilev_<1).or.(ilev_ > nlev_)) then + info = -1 + write(psb_err_unit,*) name,& + & ': Error: invalid ILEV/NLEV combination',ilev_, nlev_ + return + endif + if ((ilmax_<1).or.(ilmax_ > nlev_)) then + info = -1 + write(psb_err_unit,*) name,& + &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ + return + endif + + do ilev_ = ilmin_, ilmax_ + call p%precv(ilev_)%set(val,info,pos=pos) + if (info /= 0) return + end do + +end subroutine mld_cprecsetag + ! ! Subroutine: mld_cprecsetc ! Version: complex diff --git a/mlprec/impl/mld_dprecset.F90 b/mlprec/impl/mld_dprecset.F90 index da732be5..8dfaa034 100644 --- a/mlprec/impl/mld_dprecset.F90 +++ b/mlprec/impl/mld_dprecset.F90 @@ -575,6 +575,70 @@ subroutine mld_dprecsetsv(p,val,info,ilev,ilmax,pos) end subroutine mld_dprecsetsv +subroutine mld_dprecsetag(p,val,info,ilev,ilmax,pos) + + use psb_base_mod + use mld_d_prec_mod, mld_protect_name => mld_dprecsetag + + implicit none + + ! Arguments + class(mld_dprec_type), intent(inout) :: p + class(mld_d_base_aggregator_type), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev, ilmax + character(len=*), optional, intent(in) :: pos + + ! Local variables + integer(psb_ipk_) :: ilev_, nlev_, ilmin_, ilmax_ + character(len=*), parameter :: name='mld_precsetag' + + info = psb_success_ + + if (.not.allocated(p%precv)) then + info = 3111 + write(psb_err_unit,*) name,& + & ': Error: uninitialized preconditioner,',& + &' should call MLD_PRECINIT' + return + endif + nlev_ = size(p%precv) + + if (present(ilev)) then + ilev_ = ilev + ilmin_ = ilev + if (present(ilmax)) then + ilmax_ = ilmax + else + ilmax_ = ilev_ + end if + else + ilev_ = 1 + ilmin_ = 1 + ilmax_ = nlev_ + end if + + + if ((ilev_<1).or.(ilev_ > nlev_)) then + info = -1 + write(psb_err_unit,*) name,& + & ': Error: invalid ILEV/NLEV combination',ilev_, nlev_ + return + endif + if ((ilmax_<1).or.(ilmax_ > nlev_)) then + info = -1 + write(psb_err_unit,*) name,& + &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ + return + endif + + do ilev_ = ilmin_, ilmax_ + call p%precv(ilev_)%set(val,info,pos=pos) + if (info /= 0) return + end do + +end subroutine mld_dprecsetag + ! ! Subroutine: mld_dprecsetc ! Version: real diff --git a/mlprec/impl/mld_sprecset.F90 b/mlprec/impl/mld_sprecset.F90 index 30e6cc02..90752348 100644 --- a/mlprec/impl/mld_sprecset.F90 +++ b/mlprec/impl/mld_sprecset.F90 @@ -542,6 +542,70 @@ subroutine mld_sprecsetsv(p,val,info,ilev,ilmax,pos) end subroutine mld_sprecsetsv +subroutine mld_sprecsetag(p,val,info,ilev,ilmax,pos) + + use psb_base_mod + use mld_s_prec_mod, mld_protect_name => mld_sprecsetag + + implicit none + + ! Arguments + class(mld_sprec_type), intent(inout) :: p + class(mld_s_base_aggregator_type), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev, ilmax + character(len=*), optional, intent(in) :: pos + + ! Local variables + integer(psb_ipk_) :: ilev_, nlev_, ilmin_, ilmax_ + character(len=*), parameter :: name='mld_precsetag' + + info = psb_success_ + + if (.not.allocated(p%precv)) then + info = 3111 + write(psb_err_unit,*) name,& + & ': Error: uninitialized preconditioner,',& + &' should call MLD_PRECINIT' + return + endif + nlev_ = size(p%precv) + + if (present(ilev)) then + ilev_ = ilev + ilmin_ = ilev + if (present(ilmax)) then + ilmax_ = ilmax + else + ilmax_ = ilev_ + end if + else + ilev_ = 1 + ilmin_ = 1 + ilmax_ = nlev_ + end if + + + if ((ilev_<1).or.(ilev_ > nlev_)) then + info = -1 + write(psb_err_unit,*) name,& + & ': Error: invalid ILEV/NLEV combination',ilev_, nlev_ + return + endif + if ((ilmax_<1).or.(ilmax_ > nlev_)) then + info = -1 + write(psb_err_unit,*) name,& + &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ + return + endif + + do ilev_ = ilmin_, ilmax_ + call p%precv(ilev_)%set(val,info,pos=pos) + if (info /= 0) return + end do + +end subroutine mld_sprecsetag + ! ! Subroutine: mld_sprecsetc ! Version: real diff --git a/mlprec/impl/mld_zprecset.F90 b/mlprec/impl/mld_zprecset.F90 index 3d1e7eb8..a3f74cad 100644 --- a/mlprec/impl/mld_zprecset.F90 +++ b/mlprec/impl/mld_zprecset.F90 @@ -575,6 +575,70 @@ subroutine mld_zprecsetsv(p,val,info,ilev,ilmax,pos) end subroutine mld_zprecsetsv +subroutine mld_zprecsetag(p,val,info,ilev,ilmax,pos) + + use psb_base_mod + use mld_z_prec_mod, mld_protect_name => mld_zprecsetag + + implicit none + + ! Arguments + class(mld_zprec_type), intent(inout) :: p + class(mld_z_base_aggregator_type), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev, ilmax + character(len=*), optional, intent(in) :: pos + + ! Local variables + integer(psb_ipk_) :: ilev_, nlev_, ilmin_, ilmax_ + character(len=*), parameter :: name='mld_precsetag' + + info = psb_success_ + + if (.not.allocated(p%precv)) then + info = 3111 + write(psb_err_unit,*) name,& + & ': Error: uninitialized preconditioner,',& + &' should call MLD_PRECINIT' + return + endif + nlev_ = size(p%precv) + + if (present(ilev)) then + ilev_ = ilev + ilmin_ = ilev + if (present(ilmax)) then + ilmax_ = ilmax + else + ilmax_ = ilev_ + end if + else + ilev_ = 1 + ilmin_ = 1 + ilmax_ = nlev_ + end if + + + if ((ilev_<1).or.(ilev_ > nlev_)) then + info = -1 + write(psb_err_unit,*) name,& + & ': Error: invalid ILEV/NLEV combination',ilev_, nlev_ + return + endif + if ((ilmax_<1).or.(ilmax_ > nlev_)) then + info = -1 + write(psb_err_unit,*) name,& + &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ + return + endif + + do ilev_ = ilmin_, ilmax_ + call p%precv(ilev_)%set(val,info,pos=pos) + if (info /= 0) return + end do + +end subroutine mld_zprecsetag + ! ! Subroutine: mld_zprecsetc ! Version: complex