fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 22:55:12 +00:00
Code Issues Packages Projects Releases Wiki Activity

Fixed compilation process.

Browse Source
This commit is contained in:
Salvatore Filippone
2018-05-05 07:46:24 +01:00
parent e0b15f495e
commit 7092dc2063
13 changed files with 600 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/impl/level/Makefile
+8 -4
View File
@@ -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 \
mlprec/impl/level/mld_c_base_onelev_mat_asb.f90
+4 -4
View File
@@ -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
mlprec/impl/level/mld_c_base_onelev_setag.f90
+80
View File
@@ -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
mlprec/impl/level/mld_d_base_onelev_mat_asb.f90
+4 -4
View File
@@ -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
mlprec/impl/level/mld_d_base_onelev_setag.f90
+80
View File
@@ -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
mlprec/impl/level/mld_s_base_onelev_mat_asb.f90
+4 -4
View File
@@ -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
mlprec/impl/level/mld_s_base_onelev_setag.f90
+80
View File
@@ -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
mlprec/impl/level/mld_z_base_onelev_mat_asb.f90
+4 -4
View File
@@ -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
mlprec/impl/level/mld_z_base_onelev_setag.f90
+80
View File
@@ -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
mlprec/impl/mld_cprecset.F90
+64
View File
@@ -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
mlprec/impl/mld_dprecset.F90
+64
View File
@@ -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
mlprec/impl/mld_sprecset.F90
+64
View File
@@ -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
mlprec/impl/mld_zprecset.F90
+64
View File
@@ -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