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

Merge branch 'development' into MixedI8

Browse Source
This commit is contained in:
Salvatore Filippone
2018-10-22 13:46:33 +01:00
parent 06a4ee5707 5315dd2875
commit ae62e3abfb
252 changed files with 4682 additions and 10854 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/impl/solver/Makefile
+1 -13
View File
@@ -19,9 +19,6 @@ mld_c_base_solver_csetr.o \
mld_c_base_solver_descr.o \
mld_c_base_solver_dmp.o \
mld_c_base_solver_free.o \
mld_c_base_solver_setc.o \
mld_c_base_solver_seti.o \
mld_c_base_solver_setr.o \
mld_c_diag_solver_apply.o \
mld_c_diag_solver_apply_vect.o \
mld_c_diag_solver_bld.o \
@@ -64,9 +61,6 @@ mld_d_base_solver_csetr.o \
mld_d_base_solver_descr.o \
mld_d_base_solver_dmp.o \
mld_d_base_solver_free.o \
mld_d_base_solver_setc.o \
mld_d_base_solver_seti.o \
mld_d_base_solver_setr.o \
mld_d_diag_solver_apply.o \
mld_d_diag_solver_apply_vect.o \
mld_d_diag_solver_bld.o \
@@ -109,9 +103,6 @@ mld_s_base_solver_csetr.o \
mld_s_base_solver_descr.o \
mld_s_base_solver_dmp.o \
mld_s_base_solver_free.o \
mld_s_base_solver_setc.o \
mld_s_base_solver_seti.o \
mld_s_base_solver_setr.o \
mld_s_diag_solver_apply.o \
mld_s_diag_solver_apply_vect.o \
mld_s_diag_solver_bld.o \
@@ -154,9 +145,6 @@ mld_z_base_solver_csetr.o \
mld_z_base_solver_descr.o \
mld_z_base_solver_dmp.o \
mld_z_base_solver_free.o \
mld_z_base_solver_setc.o \
mld_z_base_solver_seti.o \
mld_z_base_solver_setr.o \
mld_z_diag_solver_apply.o \
mld_z_diag_solver_apply_vect.o \
mld_z_diag_solver_bld.o \
@@ -187,7 +175,7 @@ mld_zilut_fact.o \
mld_z_mumps_solver_apply.o \
mld_z_mumps_solver_apply_vect.o \
mld_z_mumps_solver_bld.o \
LIBNAME=libmld_prec.a
mlprec/impl/solver/mld_c_base_solver_csetc.f90
+3 -2
View File
@@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_base_solver_csetc(sv,what,val,info)
subroutine mld_c_base_solver_csetc(sv,what,val,info,idx)
use psb_base_mod
use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_csetc
@@ -45,6 +45,7 @@ subroutine mld_c_base_solver_csetc(sv,what,val,info)
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='d_base_solver_csetc'
@@ -54,7 +55,7 @@ subroutine mld_c_base_solver_csetc(sv,what,val,info)
ival = sv%stringval(val)
if (ival >=0) then
call sv%set(what,ival,info)
call sv%set(what,ival,info,idx=idx)
end if
if (info /= psb_success_) goto 9999
mlprec/impl/solver/mld_c_base_solver_cseti.f90
+2 -1
View File
@@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_base_solver_cseti(sv,what,val,info)
subroutine mld_c_base_solver_cseti(sv,what,val,info,idx)
use psb_base_mod
use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_cseti
@@ -45,6 +45,7 @@ subroutine mld_c_base_solver_cseti(sv,what,val,info)
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_cseti'
mlprec/impl/solver/mld_c_base_solver_csetr.f90
+2 -1
View File
@@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_base_solver_csetr(sv,what,val,info)
subroutine mld_c_base_solver_csetr(sv,what,val,info,idx)
use psb_base_mod
use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_csetr
@@ -45,6 +45,7 @@ subroutine mld_c_base_solver_csetr(sv,what,val,info)
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_csetr'
mlprec/impl/solver/mld_c_base_solver_setc.f90
-69
View File
@@ -1,69 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! 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_solver_setc(sv,what,val,info)
use psb_base_mod
use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_setc
Implicit None
! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='d_base_solver_setc'
call psb_erractionsave(err_act)
info = psb_success_
ival = sv%stringval(val)
if (ival >=0) then
call sv%set(what,ival,info)
end if
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_c_base_solver_setc
mlprec/impl/solver/mld_c_base_solver_seti.f90
-55
View File
@@ -1,55 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! 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_solver_seti(sv,what,val,info)
use psb_base_mod
use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_seti
Implicit None
! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_seti'
! Correct action here is doing nothing.
info = 0
return
end subroutine mld_c_base_solver_seti
mlprec/impl/solver/mld_c_base_solver_setr.f90
-56
View File
@@ -1,56 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! 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_solver_setr(sv,what,val,info)
use psb_base_mod
use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_setr
Implicit None
! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_setr'
! Correct action here is doing nothing.
info = 0
return
end subroutine mld_c_base_solver_setr
mlprec/impl/solver/mld_c_mumps_solver_bld.F90
+25 -12
View File
@@ -72,9 +72,11 @@
debug_level = psb_get_debug_level()
ictxt = desc_a%get_context()
if (sv%ipar(1) < 0 ) then
call psb_info(ictxt, me, np)
call psb_info(ictxt, me, np)
call psb_init(ictxt1,np=1,basectxt=ictxt,ids=(/me/))
call psb_get_mpicomm(ictxt1, icomm)
allocate(sv%local_ictxt,stat=info)
sv%local_ictxt = ictxt1
write(*,*)'mumps_bld: +++++>',icomm,ictxt1
call psb_info(ictxt1, me, np)
npr = np
@@ -103,11 +105,22 @@
sv%id%comm = icomm
sv%id%job = -1
sv%id%par=1
sv%id%job = -1
sv%id%par = 1
call cmumps(sv%id)
!WARNING: CALLING cMUMPS WITH JOB=-1 DESTROY THE SETTING OF DEFAULT:TO FIX
if (allocated(sv%icntl)) then
do i=1,mld_mumps_icntl_size
if (allocated(sv%icntl(i)%item)) sv%id%icntl(i) = sv%icntl(i)%item
end do
end if
if (allocated(sv%rcntl)) then
do i=1,mld_mumps_rcntl_size
if (allocated(sv%rcntl(i)%item)) sv%id%cntl(i) = sv%rcntl(i)%item
end do
end if
sv%id%icntl(3)=sv%ipar(2)
nglob = desc_a%get_global_rows()
if (sv%ipar(1) < 0) then
nglobrec=desc_a%get_local_rows()
@@ -127,10 +140,10 @@
call psb_loc_to_glob(acoo%ja(1:nztota), desc_a, info, iact='I')
call psb_loc_to_glob(acoo%ia(1:nztota), desc_a, info, iact='I')
end if
sv%id%irn_loc=> acoo%ia
sv%id%jcn_loc=> acoo%ja
sv%id%a_loc=> acoo%val
sv%id%icntl(18)=3
sv%id%irn_loc => acoo%ia
sv%id%jcn_loc => acoo%ja
sv%id%a_loc => acoo%val
sv%id%icntl(18) = 3
if(acoo%is_upper() .or. acoo%is_lower()) then
sv%id%sym = 2
else
@@ -138,13 +151,13 @@
end if
sv%id%n = nglob
! there should be a better way for this
sv%id%nz_loc = acoo%get_nzeros()
sv%id%nz = acoo%get_nzeros()
sv%id%job = 4
call psb_barrier(ictxt)
sv%id%nz_loc = acoo%get_nzeros()
sv%id%nz = acoo%get_nzeros()
sv%id%job = 4
!call psb_barrier(ictxt)
write(*,*)'calling mumps N,nz,nz_loc',sv%id%n,sv%id%nz,sv%id%nz_loc
call cmumps(sv%id)
call psb_barrier(ictxt)
!call psb_barrier(ictxt)
info = sv%id%infog(1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
mlprec/impl/solver/mld_d_base_solver_csetc.f90
+3 -2
View File
@@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_base_solver_csetc(sv,what,val,info)
subroutine mld_d_base_solver_csetc(sv,what,val,info,idx)
use psb_base_mod
use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_csetc
@@ -45,6 +45,7 @@ subroutine mld_d_base_solver_csetc(sv,what,val,info)
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='d_base_solver_csetc'
@@ -54,7 +55,7 @@ subroutine mld_d_base_solver_csetc(sv,what,val,info)
ival = sv%stringval(val)
if (ival >=0) then
call sv%set(what,ival,info)
call sv%set(what,ival,info,idx=idx)
end if
if (info /= psb_success_) goto 9999
mlprec/impl/solver/mld_d_base_solver_cseti.f90
+2 -1
View File
@@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_base_solver_cseti(sv,what,val,info)
subroutine mld_d_base_solver_cseti(sv,what,val,info,idx)
use psb_base_mod
use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_cseti
@@ -45,6 +45,7 @@ subroutine mld_d_base_solver_cseti(sv,what,val,info)
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_cseti'
mlprec/impl/solver/mld_d_base_solver_csetr.f90
+2 -1
View File
@@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_base_solver_csetr(sv,what,val,info)
subroutine mld_d_base_solver_csetr(sv,what,val,info,idx)
use psb_base_mod
use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_csetr
@@ -45,6 +45,7 @@ subroutine mld_d_base_solver_csetr(sv,what,val,info)
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_csetr'
mlprec/impl/solver/mld_d_base_solver_setc.f90
-69
View File
@@ -1,69 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! 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_solver_setc(sv,what,val,info)
use psb_base_mod
use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_setc
Implicit None
! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='d_base_solver_setc'
call psb_erractionsave(err_act)
info = psb_success_
ival = sv%stringval(val)
if (ival >=0) then
call sv%set(what,ival,info)
end if
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_d_base_solver_setc
mlprec/impl/solver/mld_d_base_solver_seti.f90
-55
View File
@@ -1,55 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! 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_solver_seti(sv,what,val,info)
use psb_base_mod
use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_seti
Implicit None
! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_seti'
! Correct action here is doing nothing.
info = 0
return
end subroutine mld_d_base_solver_seti
mlprec/impl/solver/mld_d_base_solver_setr.f90
-56
View File
@@ -1,56 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! 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_solver_setr(sv,what,val,info)
use psb_base_mod
use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_setr
Implicit None
! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_setr'
! Correct action here is doing nothing.
info = 0
return
end subroutine mld_d_base_solver_setr
mlprec/impl/solver/mld_d_mumps_solver_bld.F90
+25 -12
View File
@@ -72,9 +72,11 @@
debug_level = psb_get_debug_level()
ictxt = desc_a%get_context()
if (sv%ipar(1) < 0 ) then
call psb_info(ictxt, me, np)
call psb_info(ictxt, me, np)
call psb_init(ictxt1,np=1,basectxt=ictxt,ids=(/me/))
call psb_get_mpicomm(ictxt1, icomm)
allocate(sv%local_ictxt,stat=info)
sv%local_ictxt = ictxt1
write(*,*)'mumps_bld: +++++>',icomm,ictxt1
call psb_info(ictxt1, me, np)
npr = np
@@ -103,11 +105,22 @@
sv%id%comm = icomm
sv%id%job = -1
sv%id%par=1
sv%id%job = -1
sv%id%par = 1
call dmumps(sv%id)
!WARNING: CALLING dMUMPS WITH JOB=-1 DESTROY THE SETTING OF DEFAULT:TO FIX
if (allocated(sv%icntl)) then
do i=1,mld_mumps_icntl_size
if (allocated(sv%icntl(i)%item)) sv%id%icntl(i) = sv%icntl(i)%item
end do
end if
if (allocated(sv%rcntl)) then
do i=1,mld_mumps_rcntl_size
if (allocated(sv%rcntl(i)%item)) sv%id%cntl(i) = sv%rcntl(i)%item
end do
end if
sv%id%icntl(3)=sv%ipar(2)
nglob = desc_a%get_global_rows()
if (sv%ipar(1) < 0) then
nglobrec=desc_a%get_local_rows()
@@ -127,10 +140,10 @@
call psb_loc_to_glob(acoo%ja(1:nztota), desc_a, info, iact='I')
call psb_loc_to_glob(acoo%ia(1:nztota), desc_a, info, iact='I')
end if
sv%id%irn_loc=> acoo%ia
sv%id%jcn_loc=> acoo%ja
sv%id%a_loc=> acoo%val
sv%id%icntl(18)=3
sv%id%irn_loc => acoo%ia
sv%id%jcn_loc => acoo%ja
sv%id%a_loc => acoo%val
sv%id%icntl(18) = 3
if(acoo%is_upper() .or. acoo%is_lower()) then
sv%id%sym = 2
else
@@ -138,13 +151,13 @@
end if
sv%id%n = nglob
! there should be a better way for this
sv%id%nz_loc = acoo%get_nzeros()
sv%id%nz = acoo%get_nzeros()
sv%id%job = 4
call psb_barrier(ictxt)
sv%id%nz_loc = acoo%get_nzeros()
sv%id%nz = acoo%get_nzeros()
sv%id%job = 4
!call psb_barrier(ictxt)
write(*,*)'calling mumps N,nz,nz_loc',sv%id%n,sv%id%nz,sv%id%nz_loc
call dmumps(sv%id)
call psb_barrier(ictxt)
!call psb_barrier(ictxt)
info = sv%id%infog(1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
mlprec/impl/solver/mld_s_base_solver_csetc.f90
+3 -2
View File
@@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_s_base_solver_csetc(sv,what,val,info)
subroutine mld_s_base_solver_csetc(sv,what,val,info,idx)
use psb_base_mod
use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_csetc
@@ -45,6 +45,7 @@ subroutine mld_s_base_solver_csetc(sv,what,val,info)
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='d_base_solver_csetc'
@@ -54,7 +55,7 @@ subroutine mld_s_base_solver_csetc(sv,what,val,info)
ival = sv%stringval(val)
if (ival >=0) then
call sv%set(what,ival,info)
call sv%set(what,ival,info,idx=idx)
end if
if (info /= psb_success_) goto 9999
mlprec/impl/solver/mld_s_base_solver_cseti.f90
+2 -1
View File
@@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_s_base_solver_cseti(sv,what,val,info)
subroutine mld_s_base_solver_cseti(sv,what,val,info,idx)
use psb_base_mod
use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_cseti
@@ -45,6 +45,7 @@ subroutine mld_s_base_solver_cseti(sv,what,val,info)
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_cseti'
mlprec/impl/solver/mld_s_base_solver_csetr.f90
+2 -1
View File
@@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_s_base_solver_csetr(sv,what,val,info)
subroutine mld_s_base_solver_csetr(sv,what,val,info,idx)
use psb_base_mod
use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_csetr
@@ -45,6 +45,7 @@ subroutine mld_s_base_solver_csetr(sv,what,val,info)
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_csetr'
mlprec/impl/solver/mld_s_base_solver_setc.f90
-69
View File
@@ -1,69 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! 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_solver_setc(sv,what,val,info)
use psb_base_mod
use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_setc
Implicit None
! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='d_base_solver_setc'
call psb_erractionsave(err_act)
info = psb_success_
ival = sv%stringval(val)
if (ival >=0) then
call sv%set(what,ival,info)
end if
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_s_base_solver_setc
mlprec/impl/solver/mld_s_base_solver_seti.f90
-55
View File
@@ -1,55 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! 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_solver_seti(sv,what,val,info)
use psb_base_mod
use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_seti
Implicit None
! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_seti'
! Correct action here is doing nothing.
info = 0
return
end subroutine mld_s_base_solver_seti
mlprec/impl/solver/mld_s_base_solver_setr.f90
-56
View File
@@ -1,56 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! 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_solver_setr(sv,what,val,info)
use psb_base_mod
use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_setr
Implicit None
! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_setr'
! Correct action here is doing nothing.
info = 0
return
end subroutine mld_s_base_solver_setr
mlprec/impl/solver/mld_s_mumps_solver_bld.F90
+25 -12
View File
@@ -72,9 +72,11 @@
debug_level = psb_get_debug_level()
ictxt = desc_a%get_context()
if (sv%ipar(1) < 0 ) then
call psb_info(ictxt, me, np)
call psb_info(ictxt, me, np)
call psb_init(ictxt1,np=1,basectxt=ictxt,ids=(/me/))
call psb_get_mpicomm(ictxt1, icomm)
allocate(sv%local_ictxt,stat=info)
sv%local_ictxt = ictxt1
write(*,*)'mumps_bld: +++++>',icomm,ictxt1
call psb_info(ictxt1, me, np)
npr = np
@@ -103,11 +105,22 @@
sv%id%comm = icomm
sv%id%job = -1
sv%id%par=1
sv%id%job = -1
sv%id%par = 1
call smumps(sv%id)
!WARNING: CALLING sMUMPS WITH JOB=-1 DESTROY THE SETTING OF DEFAULT:TO FIX
if (allocated(sv%icntl)) then
do i=1,mld_mumps_icntl_size
if (allocated(sv%icntl(i)%item)) sv%id%icntl(i) = sv%icntl(i)%item
end do
end if
if (allocated(sv%rcntl)) then
do i=1,mld_mumps_rcntl_size
if (allocated(sv%rcntl(i)%item)) sv%id%cntl(i) = sv%rcntl(i)%item
end do
end if
sv%id%icntl(3)=sv%ipar(2)
nglob = desc_a%get_global_rows()
if (sv%ipar(1) < 0) then
nglobrec=desc_a%get_local_rows()
@@ -127,10 +140,10 @@
call psb_loc_to_glob(acoo%ja(1:nztota), desc_a, info, iact='I')
call psb_loc_to_glob(acoo%ia(1:nztota), desc_a, info, iact='I')
end if
sv%id%irn_loc=> acoo%ia
sv%id%jcn_loc=> acoo%ja
sv%id%a_loc=> acoo%val
sv%id%icntl(18)=3
sv%id%irn_loc => acoo%ia
sv%id%jcn_loc => acoo%ja
sv%id%a_loc => acoo%val
sv%id%icntl(18) = 3
if(acoo%is_upper() .or. acoo%is_lower()) then
sv%id%sym = 2
else
@@ -138,13 +151,13 @@
end if
sv%id%n = nglob
! there should be a better way for this
sv%id%nz_loc = acoo%get_nzeros()
sv%id%nz = acoo%get_nzeros()
sv%id%job = 4
call psb_barrier(ictxt)
sv%id%nz_loc = acoo%get_nzeros()
sv%id%nz = acoo%get_nzeros()
sv%id%job = 4
!call psb_barrier(ictxt)
write(*,*)'calling mumps N,nz,nz_loc',sv%id%n,sv%id%nz,sv%id%nz_loc
call smumps(sv%id)
call psb_barrier(ictxt)
!call psb_barrier(ictxt)
info = sv%id%infog(1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
mlprec/impl/solver/mld_z_base_solver_csetc.f90
+3 -2
View File
@@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_z_base_solver_csetc(sv,what,val,info)
subroutine mld_z_base_solver_csetc(sv,what,val,info,idx)
use psb_base_mod
use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_csetc
@@ -45,6 +45,7 @@ subroutine mld_z_base_solver_csetc(sv,what,val,info)
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='d_base_solver_csetc'
@@ -54,7 +55,7 @@ subroutine mld_z_base_solver_csetc(sv,what,val,info)
ival = sv%stringval(val)
if (ival >=0) then
call sv%set(what,ival,info)
call sv%set(what,ival,info,idx=idx)
end if
if (info /= psb_success_) goto 9999
mlprec/impl/solver/mld_z_base_solver_cseti.f90
+2 -1
View File
@@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_z_base_solver_cseti(sv,what,val,info)
subroutine mld_z_base_solver_cseti(sv,what,val,info,idx)
use psb_base_mod
use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_cseti
@@ -45,6 +45,7 @@ subroutine mld_z_base_solver_cseti(sv,what,val,info)
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_cseti'
mlprec/impl/solver/mld_z_base_solver_csetr.f90
+2 -1
View File
@@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_z_base_solver_csetr(sv,what,val,info)
subroutine mld_z_base_solver_csetr(sv,what,val,info,idx)
use psb_base_mod
use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_csetr
@@ -45,6 +45,7 @@ subroutine mld_z_base_solver_csetr(sv,what,val,info)
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_csetr'
mlprec/impl/solver/mld_z_base_solver_setc.f90
-69
View File
@@ -1,69 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! 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_solver_setc(sv,what,val,info)
use psb_base_mod
use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_setc
Implicit None
! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='d_base_solver_setc'
call psb_erractionsave(err_act)
info = psb_success_
ival = sv%stringval(val)
if (ival >=0) then
call sv%set(what,ival,info)
end if
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_z_base_solver_setc
mlprec/impl/solver/mld_z_base_solver_seti.f90
-55
View File
@@ -1,55 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! 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_solver_seti(sv,what,val,info)
use psb_base_mod
use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_seti
Implicit None
! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_seti'
! Correct action here is doing nothing.
info = 0
return
end subroutine mld_z_base_solver_seti
mlprec/impl/solver/mld_z_base_solver_setr.f90
-56
View File
@@ -1,56 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! 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_solver_setr(sv,what,val,info)
use psb_base_mod
use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_setr
Implicit None
! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_setr'
! Correct action here is doing nothing.
info = 0
return
end subroutine mld_z_base_solver_setr
mlprec/impl/solver/mld_z_mumps_solver_bld.F90
+25 -12
View File
@@ -72,9 +72,11 @@
debug_level = psb_get_debug_level()
ictxt = desc_a%get_context()
if (sv%ipar(1) < 0 ) then
call psb_info(ictxt, me, np)
call psb_info(ictxt, me, np)
call psb_init(ictxt1,np=1,basectxt=ictxt,ids=(/me/))
call psb_get_mpicomm(ictxt1, icomm)
allocate(sv%local_ictxt,stat=info)
sv%local_ictxt = ictxt1
write(*,*)'mumps_bld: +++++>',icomm,ictxt1
call psb_info(ictxt1, me, np)
npr = np
@@ -103,11 +105,22 @@
sv%id%comm = icomm
sv%id%job = -1
sv%id%par=1
sv%id%job = -1
sv%id%par = 1
call zmumps(sv%id)
!WARNING: CALLING zMUMPS WITH JOB=-1 DESTROY THE SETTING OF DEFAULT:TO FIX
if (allocated(sv%icntl)) then
do i=1,mld_mumps_icntl_size
if (allocated(sv%icntl(i)%item)) sv%id%icntl(i) = sv%icntl(i)%item
end do
end if
if (allocated(sv%rcntl)) then
do i=1,mld_mumps_rcntl_size
if (allocated(sv%rcntl(i)%item)) sv%id%cntl(i) = sv%rcntl(i)%item
end do
end if
sv%id%icntl(3)=sv%ipar(2)
nglob = desc_a%get_global_rows()
if (sv%ipar(1) < 0) then
nglobrec=desc_a%get_local_rows()
@@ -127,10 +140,10 @@
call psb_loc_to_glob(acoo%ja(1:nztota), desc_a, info, iact='I')
call psb_loc_to_glob(acoo%ia(1:nztota), desc_a, info, iact='I')
end if
sv%id%irn_loc=> acoo%ia
sv%id%jcn_loc=> acoo%ja
sv%id%a_loc=> acoo%val
sv%id%icntl(18)=3
sv%id%irn_loc => acoo%ia
sv%id%jcn_loc => acoo%ja
sv%id%a_loc => acoo%val
sv%id%icntl(18) = 3
if(acoo%is_upper() .or. acoo%is_lower()) then
sv%id%sym = 2
else
@@ -138,13 +151,13 @@
end if
sv%id%n = nglob
! there should be a better way for this
sv%id%nz_loc = acoo%get_nzeros()
sv%id%nz = acoo%get_nzeros()
sv%id%job = 4
call psb_barrier(ictxt)
sv%id%nz_loc = acoo%get_nzeros()
sv%id%nz = acoo%get_nzeros()
sv%id%job = 4
!call psb_barrier(ictxt)
write(*,*)'calling mumps N,nz,nz_loc',sv%id%n,sv%id%nz,sv%id%nz_loc
call zmumps(sv%id)
call psb_barrier(ictxt)
!call psb_barrier(ictxt)
info = sv%id%infog(1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_