From 084f6d9f1a8660fff243081ddad8c1e9d1e0ab0e Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 24 Oct 2012 17:23:11 +0000 Subject: [PATCH] psblas3: base/modules/Makefile base/modules/psb_c_serial_mod.f90 base/modules/psb_d_serial_mod.f90 base/modules/psb_s_serial_mod.f90 base/modules/psb_serial_mod.f90 base/modules/psb_z_serial_mod.f90 Split psb_serial_mod to ease compilation times. --- base/modules/Makefile | 6 +- base/modules/psb_c_serial_mod.f90 | 206 +++++++++++ base/modules/psb_d_serial_mod.f90 | 206 +++++++++++ base/modules/psb_s_serial_mod.f90 | 206 +++++++++++ base/modules/psb_serial_mod.f90 | 576 +----------------------------- base/modules/psb_z_serial_mod.f90 | 206 +++++++++++ 6 files changed, 833 insertions(+), 573 deletions(-) create mode 100644 base/modules/psb_c_serial_mod.f90 create mode 100644 base/modules/psb_d_serial_mod.f90 create mode 100644 base/modules/psb_s_serial_mod.f90 create mode 100644 base/modules/psb_z_serial_mod.f90 diff --git a/base/modules/Makefile b/base/modules/Makefile index 0f9ee6fb..87a44e6e 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -5,7 +5,8 @@ COMMINT=psi_comm_buffers_mod.o psi_penv_mod.o psi_bcast_mod.o psi_reduce_mod.o p UTIL_MODS = psb_string_mod.o psb_desc_const_mod.o psb_indx_map_mod.o\ psb_gen_block_map_mod.o psb_list_map_mod.o psb_repl_map_mod.o\ psb_glist_map_mod.o psb_hash_map_mod.o \ - psb_desc_type.o psb_sort_mod.o psb_serial_mod.o \ + psb_desc_type.o psb_sort_mod.o \ + psb_s_serial_mod.o psb_d_serial_mod.o psb_c_serial_mod.o psb_z_serial_mod.o psb_serial_mod.o \ psb_cd_tools_mod.o psb_i_tools_mod.o psb_s_tools_mod.o psb_d_tools_mod.o\ psb_c_tools_mod.o psb_z_tools_mod.o psb_tools_mod.o \ psb_penv_mod.o $(COMMINT) psb_error_impl.o \ @@ -103,7 +104,8 @@ psb_z_linmap_mod.o: psb_base_linmap_mod.o psb_z_mat_mod.o psb_z_vect_mod.o psb_base_linmap_mod.o: psb_desc_type.o psb_serial_mod.o psb_comm_mod.o psb_comm_mod.o: psb_desc_type.o psb_mat_mod.o psb_check_mod.o: psb_desc_type.o -psb_serial_mod.o: psb_mat_mod.o psb_string_mod.o psb_sort_mod.o psi_serial_mod.o +psb_s_serial_mod.o psb_d_serial_mod.o psb_c_serial_mod.o psb_z_serial_mod.o: psb_mat_mod.o psb_string_mod.o psb_sort_mod.o psi_serial_mod.o +psb_serial_mod.o: psb_s_serial_mod.o psb_d_serial_mod.o psb_c_serial_mod.o psb_z_serial_mod.o psb_i_vect_mod.o: psb_i_base_vect_mod.o psb_s_vect_mod.o: psb_s_base_vect_mod.o psb_d_vect_mod.o: psb_d_base_vect_mod.o diff --git a/base/modules/psb_c_serial_mod.f90 b/base/modules/psb_c_serial_mod.f90 new file mode 100644 index 00000000..36388725 --- /dev/null +++ b/base/modules/psb_c_serial_mod.f90 @@ -0,0 +1,206 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ 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 PSBLAS 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 PSBLAS 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. +!!$ +!!$ +module psb_c_serial_mod + use psb_const_mod + use psb_error_mod + + interface psb_amax + function psb_camax_s(n, x) result(val) + import :: psb_ipk_, psb_spk_ + integer(psb_ipk_), intent(in) :: n + complex(psb_spk_), intent(in) :: x(:) + real(psb_spk_) :: val + end function psb_camax_s + end interface psb_amax + + interface psb_asum + function psb_casum_s(n, x) result(val) + import :: psb_ipk_, psb_spk_ + integer(psb_ipk_), intent(in) :: n + complex(psb_spk_), intent(in) :: x(:) + real(psb_spk_) :: val + end function psb_casum_s + end interface psb_asum + + interface psb_symbmm + subroutine psb_csymbmm(a,b,c,info) + use psb_c_mat_mod, only : psb_cspmat_type + import :: psb_ipk_ + implicit none + type(psb_cspmat_type), intent(in) :: a,b + type(psb_cspmat_type), intent(out) :: c + integer(psb_ipk_), intent(out) :: info + end subroutine psb_csymbmm + subroutine psb_cbase_symbmm(a,b,c,info) + use psb_c_mat_mod, only : psb_c_base_sparse_mat, psb_c_csr_sparse_mat + import :: psb_ipk_ + implicit none + class(psb_c_base_sparse_mat), intent(in) :: a,b + type(psb_c_csr_sparse_mat), intent(out) :: c + integer(psb_ipk_), intent(out) :: info + end subroutine psb_cbase_symbmm + end interface psb_symbmm + + interface psb_numbmm + subroutine psb_cnumbmm(a,b,c) + use psb_c_mat_mod, only : psb_cspmat_type + import :: psb_ipk_ + implicit none + type(psb_cspmat_type), intent(in) :: a,b + type(psb_cspmat_type), intent(inout) :: c + end subroutine psb_cnumbmm + subroutine psb_cbase_numbmm(a,b,c) + use psb_c_mat_mod, only : psb_c_base_sparse_mat, psb_c_csr_sparse_mat + import :: psb_ipk_ + implicit none + class(psb_c_base_sparse_mat), intent(in) :: a,b + type(psb_c_csr_sparse_mat), intent(inout) :: c + end subroutine psb_cbase_numbmm + end interface psb_numbmm + + interface psb_rwextd + subroutine psb_crwextd(nr,a,info,b,rowscale) + use psb_c_mat_mod, only : psb_cspmat_type + import :: psb_ipk_ + implicit none + integer(psb_ipk_), intent(in) :: nr + type(psb_cspmat_type), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + type(psb_cspmat_type), intent(in), optional :: b + logical,intent(in), optional :: rowscale + end subroutine psb_crwextd + subroutine psb_cbase_rwextd(nr,a,info,b,rowscale) + use psb_c_mat_mod, only : psb_c_base_sparse_mat + import :: psb_ipk_ + implicit none + integer(psb_ipk_), intent(in) :: nr + class(psb_c_base_sparse_mat), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: b + logical,intent(in), optional :: rowscale + end subroutine psb_cbase_rwextd + end interface psb_rwextd + + + interface psb_geprt + subroutine psb_cgeprtn2(fname,a,head) + use psb_const_mod, only : psb_spk_, psb_ipk_ + character(len=*), intent(in) :: fname + complex(psb_spk_), intent(in) :: a(:,:) + character(len=*), optional :: head + end subroutine psb_cgeprtn2 + subroutine psb_cgeprtn1(fname,a,head) + use psb_const_mod, only : psb_spk_, psb_ipk_ + character(len=*), intent(in) :: fname + complex(psb_spk_), intent(in) :: a(:) + character(len=*), optional :: head + end subroutine psb_cgeprtn1 + subroutine psb_cgeprt2(iout,a,head) + use psb_const_mod, only : psb_spk_, psb_ipk_ + integer(psb_ipk_), intent(in) :: iout + complex(psb_spk_), intent(in) :: a(:,:) + character(len=*), optional :: head + end subroutine psb_cgeprt2 + subroutine psb_cgeprt1(iout,a,head) + use psb_const_mod, only : psb_spk_, psb_ipk_ + integer(psb_ipk_), intent(in) :: iout + complex(psb_spk_), intent(in) :: a(:) + character(len=*), optional :: head + end subroutine psb_cgeprt1 + end interface psb_geprt + + interface psb_csprt + module procedure psb_ccsprt, psb_ccsprtn + end interface psb_csprt + + interface psb_spdot_srtd + function psb_c_spdot_srtd(nv1,iv1,v1,nv2,iv2,v2) result(dot) + use psb_const_mod, only : psb_ipk_, psb_spk_ + integer(psb_ipk_), intent(in) :: nv1,nv2 + integer(psb_ipk_), intent(in) :: iv1(*), iv2(*) + complex(psb_spk_), intent(in) :: v1(*),v2(*) + complex(psb_spk_) :: dot + end function psb_c_spdot_srtd + end interface psb_spdot_srtd + + + interface psb_spge_dot + function psb_c_spge_dot(nv1,iv1,v1,v2) result(dot) + use psb_const_mod, only : psb_ipk_, psb_spk_ + integer(psb_ipk_), intent(in) :: nv1 + integer(psb_ipk_), intent(in) :: iv1(*) + complex(psb_spk_), intent(in) :: v1(*),v2(*) + complex(psb_spk_) :: dot + end function psb_c_spge_dot + end interface psb_spge_dot + + + interface psb_aspxpby + subroutine psb_c_aspxpby(alpha, nx, ix, x, beta, y, info) + use psb_const_mod, only : psb_ipk_, psb_spk_ + integer(psb_ipk_), intent(in) :: nx + integer(psb_ipk_), intent(in) :: ix(:) + complex(psb_spk_), intent (in) :: x(:) + complex(psb_spk_), intent (inout) :: y(:) + complex(psb_spk_), intent (in) :: alpha, beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_aspxpby + end interface psb_aspxpby + +contains + + subroutine psb_ccsprt(iout,a,iv,head,ivr,ivc) + use psb_c_mat_mod, only : psb_cspmat_type + integer(psb_ipk_), intent(in) :: iout + type(psb_cspmat_type), intent(in) :: a + integer(psb_ipk_), intent(in), optional :: iv(:) + character(len=*), optional :: head + integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + + call a%print(iout,iv,head,ivr,ivc) + + end subroutine psb_ccsprt + + subroutine psb_ccsprtn(fname,a,iv,head,ivr,ivc) + use psb_c_mat_mod, only : psb_cspmat_type + character(len=*), intent(in) :: fname + type(psb_cspmat_type), intent(in) :: a + integer(psb_ipk_), intent(in), optional :: iv(:) + character(len=*), optional :: head + integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + + call a%print(fname,iv,head,ivr,ivc) + + end subroutine psb_ccsprtn + +end module psb_c_serial_mod + diff --git a/base/modules/psb_d_serial_mod.f90 b/base/modules/psb_d_serial_mod.f90 new file mode 100644 index 00000000..02f319dd --- /dev/null +++ b/base/modules/psb_d_serial_mod.f90 @@ -0,0 +1,206 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ 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 PSBLAS 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 PSBLAS 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. +!!$ +!!$ +module psb_d_serial_mod + use psb_const_mod + use psb_error_mod + + interface psb_amax + function psb_damax_s(n, x) result(val) + import :: psb_ipk_, psb_dpk_ + integer(psb_ipk_), intent(in) :: n + real(psb_dpk_), intent(in) :: x(:) + real(psb_dpk_) :: val + end function psb_damax_s + end interface psb_amax + + interface psb_asum + function psb_dasum_s(n, x) result(val) + import :: psb_ipk_, psb_dpk_ + integer(psb_ipk_), intent(in) :: n + real(psb_dpk_), intent(in) :: x(:) + real(psb_dpk_) :: val + end function psb_dasum_s + end interface psb_asum + + interface psb_symbmm + subroutine psb_dsymbmm(a,b,c,info) + use psb_d_mat_mod, only : psb_dspmat_type + import :: psb_ipk_ + implicit none + type(psb_dspmat_type), intent(in) :: a,b + type(psb_dspmat_type), intent(out) :: c + integer(psb_ipk_), intent(out) :: info + end subroutine psb_dsymbmm + subroutine psb_dbase_symbmm(a,b,c,info) + use psb_d_mat_mod, only : psb_d_base_sparse_mat, psb_d_csr_sparse_mat + import :: psb_ipk_ + implicit none + class(psb_d_base_sparse_mat), intent(in) :: a,b + type(psb_d_csr_sparse_mat), intent(out) :: c + integer(psb_ipk_), intent(out) :: info + end subroutine psb_dbase_symbmm + end interface psb_symbmm + + interface psb_numbmm + subroutine psb_dnumbmm(a,b,c) + use psb_d_mat_mod, only : psb_dspmat_type + import :: psb_ipk_ + implicit none + type(psb_dspmat_type), intent(in) :: a,b + type(psb_dspmat_type), intent(inout) :: c + end subroutine psb_dnumbmm + subroutine psb_dbase_numbmm(a,b,c) + use psb_d_mat_mod, only : psb_d_base_sparse_mat, psb_d_csr_sparse_mat + import :: psb_ipk_ + implicit none + class(psb_d_base_sparse_mat), intent(in) :: a,b + type(psb_d_csr_sparse_mat), intent(inout) :: c + end subroutine psb_dbase_numbmm + end interface psb_numbmm + + interface psb_rwextd + subroutine psb_drwextd(nr,a,info,b,rowscale) + use psb_d_mat_mod, only : psb_dspmat_type + import :: psb_ipk_ + implicit none + integer(psb_ipk_), intent(in) :: nr + type(psb_dspmat_type), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + type(psb_dspmat_type), intent(in), optional :: b + logical,intent(in), optional :: rowscale + end subroutine psb_drwextd + subroutine psb_dbase_rwextd(nr,a,info,b,rowscale) + use psb_d_mat_mod, only : psb_d_base_sparse_mat + import :: psb_ipk_ + implicit none + integer(psb_ipk_), intent(in) :: nr + class(psb_d_base_sparse_mat), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + class(psb_d_base_sparse_mat), intent(in), optional :: b + logical,intent(in), optional :: rowscale + end subroutine psb_dbase_rwextd + end interface psb_rwextd + + + interface psb_geprt + subroutine psb_dgeprtn2(fname,a,head) + use psb_const_mod, only : psb_dpk_, psb_ipk_ + character(len=*), intent(in) :: fname + real(psb_dpk_), intent(in) :: a(:,:) + character(len=*), optional :: head + end subroutine psb_dgeprtn2 + subroutine psb_dgeprtn1(fname,a,head) + use psb_const_mod, only : psb_dpk_, psb_ipk_ + character(len=*), intent(in) :: fname + real(psb_dpk_), intent(in) :: a(:) + character(len=*), optional :: head + end subroutine psb_dgeprtn1 + subroutine psb_dgeprt2(iout,a,head) + use psb_const_mod, only : psb_dpk_, psb_ipk_ + integer(psb_ipk_), intent(in) :: iout + real(psb_dpk_), intent(in) :: a(:,:) + character(len=*), optional :: head + end subroutine psb_dgeprt2 + subroutine psb_dgeprt1(iout,a,head) + use psb_const_mod, only : psb_dpk_, psb_ipk_ + integer(psb_ipk_), intent(in) :: iout + real(psb_dpk_), intent(in) :: a(:) + character(len=*), optional :: head + end subroutine psb_dgeprt1 + end interface psb_geprt + + interface psb_csprt + module procedure psb_dcsprt, psb_dcsprtn + end interface psb_csprt + + interface psb_spdot_srtd + function psb_d_spdot_srtd(nv1,iv1,v1,nv2,iv2,v2) result(dot) + use psb_const_mod, only : psb_ipk_, psb_dpk_ + integer(psb_ipk_), intent(in) :: nv1,nv2 + integer(psb_ipk_), intent(in) :: iv1(*), iv2(*) + real(psb_dpk_), intent(in) :: v1(*),v2(*) + real(psb_dpk_) :: dot + end function psb_d_spdot_srtd + end interface psb_spdot_srtd + + + interface psb_spge_dot + function psb_d_spge_dot(nv1,iv1,v1,v2) result(dot) + use psb_const_mod, only : psb_ipk_, psb_dpk_ + integer(psb_ipk_), intent(in) :: nv1 + integer(psb_ipk_), intent(in) :: iv1(*) + real(psb_dpk_), intent(in) :: v1(*),v2(*) + real(psb_dpk_) :: dot + end function psb_d_spge_dot + end interface psb_spge_dot + + + interface psb_aspxpby + subroutine psb_d_aspxpby(alpha, nx, ix, x, beta, y, info) + use psb_const_mod, only : psb_ipk_, psb_dpk_ + integer(psb_ipk_), intent(in) :: nx + integer(psb_ipk_), intent(in) :: ix(:) + real(psb_dpk_), intent (in) :: x(:) + real(psb_dpk_), intent (inout) :: y(:) + real(psb_dpk_), intent (in) :: alpha, beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_aspxpby + end interface psb_aspxpby + +contains + + subroutine psb_dcsprt(iout,a,iv,head,ivr,ivc) + use psb_d_mat_mod, only : psb_dspmat_type + integer(psb_ipk_), intent(in) :: iout + type(psb_dspmat_type), intent(in) :: a + integer(psb_ipk_), intent(in), optional :: iv(:) + character(len=*), optional :: head + integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + + call a%print(iout,iv,head,ivr,ivc) + + end subroutine psb_dcsprt + + subroutine psb_dcsprtn(fname,a,iv,head,ivr,ivc) + use psb_d_mat_mod, only : psb_dspmat_type + character(len=*), intent(in) :: fname + type(psb_dspmat_type), intent(in) :: a + integer(psb_ipk_), intent(in), optional :: iv(:) + character(len=*), optional :: head + integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + + call a%print(fname,iv,head,ivr,ivc) + + end subroutine psb_dcsprtn + +end module psb_d_serial_mod + diff --git a/base/modules/psb_s_serial_mod.f90 b/base/modules/psb_s_serial_mod.f90 new file mode 100644 index 00000000..5553b73a --- /dev/null +++ b/base/modules/psb_s_serial_mod.f90 @@ -0,0 +1,206 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ 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 PSBLAS 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 PSBLAS 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. +!!$ +!!$ +module psb_s_serial_mod + use psb_const_mod + use psb_error_mod + + interface psb_amax + function psb_samax_s(n, x) result(val) + import :: psb_ipk_, psb_spk_ + integer(psb_ipk_), intent(in) :: n + real(psb_spk_), intent(in) :: x(:) + real(psb_spk_) :: val + end function psb_samax_s + end interface psb_amax + + interface psb_asum + function psb_sasum_s(n, x) result(val) + import :: psb_ipk_, psb_spk_ + integer(psb_ipk_), intent(in) :: n + real(psb_spk_), intent(in) :: x(:) + real(psb_spk_) :: val + end function psb_sasum_s + end interface psb_asum + + interface psb_symbmm + subroutine psb_ssymbmm(a,b,c,info) + use psb_s_mat_mod, only : psb_sspmat_type + import :: psb_ipk_ + implicit none + type(psb_sspmat_type), intent(in) :: a,b + type(psb_sspmat_type), intent(out) :: c + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ssymbmm + subroutine psb_sbase_symbmm(a,b,c,info) + use psb_s_mat_mod, only : psb_s_base_sparse_mat, psb_s_csr_sparse_mat + import :: psb_ipk_ + implicit none + class(psb_s_base_sparse_mat), intent(in) :: a,b + type(psb_s_csr_sparse_mat), intent(out) :: c + integer(psb_ipk_), intent(out) :: info + end subroutine psb_sbase_symbmm + end interface psb_symbmm + + interface psb_numbmm + subroutine psb_snumbmm(a,b,c) + use psb_s_mat_mod, only : psb_sspmat_type + import :: psb_ipk_ + implicit none + type(psb_sspmat_type), intent(in) :: a,b + type(psb_sspmat_type), intent(inout) :: c + end subroutine psb_snumbmm + subroutine psb_sbase_numbmm(a,b,c) + use psb_s_mat_mod, only : psb_s_base_sparse_mat, psb_s_csr_sparse_mat + import :: psb_ipk_ + implicit none + class(psb_s_base_sparse_mat), intent(in) :: a,b + type(psb_s_csr_sparse_mat), intent(inout) :: c + end subroutine psb_sbase_numbmm + end interface psb_numbmm + + interface psb_rwextd + subroutine psb_srwextd(nr,a,info,b,rowscale) + use psb_s_mat_mod, only : psb_sspmat_type + import :: psb_ipk_ + implicit none + integer(psb_ipk_), intent(in) :: nr + type(psb_sspmat_type), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + type(psb_sspmat_type), intent(in), optional :: b + logical,intent(in), optional :: rowscale + end subroutine psb_srwextd + subroutine psb_sbase_rwextd(nr,a,info,b,rowscale) + use psb_s_mat_mod, only : psb_s_base_sparse_mat + import :: psb_ipk_ + implicit none + integer(psb_ipk_), intent(in) :: nr + class(psb_s_base_sparse_mat), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: b + logical,intent(in), optional :: rowscale + end subroutine psb_sbase_rwextd + end interface psb_rwextd + + + interface psb_geprt + subroutine psb_sgeprtn2(fname,a,head) + use psb_const_mod, only : psb_spk_, psb_ipk_ + character(len=*), intent(in) :: fname + real(psb_spk_), intent(in) :: a(:,:) + character(len=*), optional :: head + end subroutine psb_sgeprtn2 + subroutine psb_sgeprtn1(fname,a,head) + use psb_const_mod, only : psb_spk_, psb_ipk_ + character(len=*), intent(in) :: fname + real(psb_spk_), intent(in) :: a(:) + character(len=*), optional :: head + end subroutine psb_sgeprtn1 + subroutine psb_sgeprt2(iout,a,head) + use psb_const_mod, only : psb_spk_, psb_ipk_ + integer(psb_ipk_), intent(in) :: iout + real(psb_spk_), intent(in) :: a(:,:) + character(len=*), optional :: head + end subroutine psb_sgeprt2 + subroutine psb_sgeprt1(iout,a,head) + use psb_const_mod, only : psb_spk_, psb_ipk_ + integer(psb_ipk_), intent(in) :: iout + real(psb_spk_), intent(in) :: a(:) + character(len=*), optional :: head + end subroutine psb_sgeprt1 + end interface psb_geprt + + interface psb_csprt + module procedure psb_scsprt, psb_scsprtn + end interface psb_csprt + + interface psb_spdot_srtd + function psb_s_spdot_srtd(nv1,iv1,v1,nv2,iv2,v2) result(dot) + use psb_const_mod, only : psb_ipk_, psb_spk_ + integer(psb_ipk_), intent(in) :: nv1,nv2 + integer(psb_ipk_), intent(in) :: iv1(*), iv2(*) + real(psb_spk_), intent(in) :: v1(*),v2(*) + real(psb_spk_) :: dot + end function psb_s_spdot_srtd + end interface psb_spdot_srtd + + + interface psb_spge_dot + function psb_s_spge_dot(nv1,iv1,v1,v2) result(dot) + use psb_const_mod, only : psb_ipk_, psb_spk_ + integer(psb_ipk_), intent(in) :: nv1 + integer(psb_ipk_), intent(in) :: iv1(*) + real(psb_spk_), intent(in) :: v1(*),v2(*) + real(psb_spk_) :: dot + end function psb_s_spge_dot + end interface psb_spge_dot + + + interface psb_aspxpby + subroutine psb_s_aspxpby(alpha, nx, ix, x, beta, y, info) + use psb_const_mod, only : psb_ipk_, psb_spk_ + integer(psb_ipk_), intent(in) :: nx + integer(psb_ipk_), intent(in) :: ix(:) + real(psb_spk_), intent (in) :: x(:) + real(psb_spk_), intent (inout) :: y(:) + real(psb_spk_), intent (in) :: alpha, beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_aspxpby + end interface psb_aspxpby + +contains + + subroutine psb_scsprt(iout,a,iv,head,ivr,ivc) + use psb_s_mat_mod, only : psb_sspmat_type + integer(psb_ipk_), intent(in) :: iout + type(psb_sspmat_type), intent(in) :: a + integer(psb_ipk_), intent(in), optional :: iv(:) + character(len=*), optional :: head + integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + + call a%print(iout,iv,head,ivr,ivc) + + end subroutine psb_scsprt + + subroutine psb_scsprtn(fname,a,iv,head,ivr,ivc) + use psb_s_mat_mod, only : psb_sspmat_type + character(len=*), intent(in) :: fname + type(psb_sspmat_type), intent(in) :: a + integer(psb_ipk_), intent(in), optional :: iv(:) + character(len=*), optional :: head + integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + + call a%print(fname,iv,head,ivr,ivc) + + end subroutine psb_scsprtn + +end module psb_s_serial_mod + diff --git a/base/modules/psb_serial_mod.f90 b/base/modules/psb_serial_mod.f90 index 8b5d0f42..f4798f0b 100644 --- a/base/modules/psb_serial_mod.f90 +++ b/base/modules/psb_serial_mod.f90 @@ -40,6 +40,11 @@ module psb_serial_mod & psb_gth => psi_gth,& & psb_sct => psi_sct + use psb_s_serial_mod + use psb_d_serial_mod + use psb_c_serial_mod + use psb_z_serial_mod + interface psb_nrm1 module procedure psb_snrm1, psb_dnrm1, psb_cnrm1, psb_znrm1 end interface psb_nrm1 @@ -48,443 +53,6 @@ module psb_serial_mod module procedure psb_sminreal, psb_dminreal, psb_cminreal, psb_zminreal end interface psb_minreal - interface psb_amax - function psb_samax_s(n, x) result(val) - import :: psb_ipk_, psb_spk_, psb_dpk_ - integer(psb_ipk_), intent(in) :: n - real(psb_spk_), intent(in) :: x(:) - real(psb_spk_) :: val - end function psb_samax_s - function psb_damax_s(n, x) result(val) - import :: psb_ipk_, psb_spk_, psb_dpk_ - integer(psb_ipk_), intent(in) :: n - real(psb_dpk_), intent(in) :: x(:) - real(psb_dpk_) :: val - end function psb_damax_s - function psb_camax_s(n, x) result(val) - import :: psb_ipk_, psb_spk_, psb_dpk_ - integer(psb_ipk_), intent(in) :: n - complex(psb_spk_), intent(in) :: x(:) - real(psb_spk_) :: val - end function psb_camax_s - function psb_zamax_s(n, x) result(val) - import :: psb_ipk_, psb_spk_, psb_dpk_ - integer(psb_ipk_), intent(in) :: n - complex(psb_dpk_), intent(in) :: x(:) - real(psb_dpk_) :: val - end function psb_zamax_s - end interface psb_amax - - interface psb_asum - function psb_sasum_s(n, x) result(val) - import :: psb_ipk_, psb_spk_, psb_dpk_ - integer(psb_ipk_), intent(in) :: n - real(psb_spk_), intent(in) :: x(:) - real(psb_spk_) :: val - end function psb_sasum_s - function psb_dasum_s(n, x) result(val) - import :: psb_ipk_, psb_spk_, psb_dpk_ - integer(psb_ipk_), intent(in) :: n - real(psb_dpk_), intent(in) :: x(:) - real(psb_dpk_) :: val - end function psb_dasum_s - function psb_casum_s(n, x) result(val) - import :: psb_ipk_, psb_spk_, psb_dpk_ - integer(psb_ipk_), intent(in) :: n - complex(psb_spk_), intent(in) :: x(:) - real(psb_spk_) :: val - end function psb_casum_s - function psb_zasum_s(n, x) result(val) - import :: psb_ipk_, psb_spk_, psb_dpk_ - integer(psb_ipk_), intent(in) :: n - complex(psb_dpk_), intent(in) :: x(:) - real(psb_dpk_) :: val - end function psb_zasum_s - end interface psb_asum - - interface psb_symbmm - subroutine psb_ssymbmm(a,b,c,info) - use psb_mat_mod, only : psb_sspmat_type - import :: psb_ipk_ - implicit none - type(psb_sspmat_type), intent(in) :: a,b - type(psb_sspmat_type), intent(out) :: c - integer(psb_ipk_), intent(out) :: info - end subroutine psb_ssymbmm - subroutine psb_sbase_symbmm(a,b,c,info) - use psb_mat_mod, only : psb_s_base_sparse_mat, psb_s_csr_sparse_mat - import :: psb_ipk_ - implicit none - class(psb_s_base_sparse_mat), intent(in) :: a,b - type(psb_s_csr_sparse_mat), intent(out) :: c - integer(psb_ipk_), intent(out) :: info - end subroutine psb_sbase_symbmm - subroutine psb_dsymbmm(a,b,c,info) - use psb_mat_mod, only : psb_dspmat_type - import :: psb_ipk_ - implicit none - type(psb_dspmat_type), intent(in) :: a,b - type(psb_dspmat_type), intent(out) :: c - integer(psb_ipk_), intent(out) :: info - end subroutine psb_dsymbmm - subroutine psb_dbase_symbmm(a,b,c,info) - use psb_mat_mod, only : psb_d_base_sparse_mat, psb_d_csr_sparse_mat - import :: psb_ipk_ - implicit none - class(psb_d_base_sparse_mat), intent(in) :: a,b - type(psb_d_csr_sparse_mat), intent(out) :: c - integer(psb_ipk_), intent(out) :: info - end subroutine psb_dbase_symbmm - subroutine psb_csymbmm(a,b,c,info) - use psb_mat_mod, only : psb_cspmat_type - import :: psb_ipk_ - implicit none - type(psb_cspmat_type), intent(in) :: a,b - type(psb_cspmat_type), intent(out) :: c - integer(psb_ipk_), intent(out) :: info - end subroutine psb_csymbmm - subroutine psb_cbase_symbmm(a,b,c,info) - use psb_mat_mod, only : psb_c_base_sparse_mat, psb_c_csr_sparse_mat - import :: psb_ipk_ - implicit none - class(psb_c_base_sparse_mat), intent(in) :: a,b - type(psb_c_csr_sparse_mat), intent(out) :: c - integer(psb_ipk_), intent(out) :: info - end subroutine psb_cbase_symbmm - subroutine psb_zsymbmm(a,b,c,info) - use psb_mat_mod, only : psb_zspmat_type - import :: psb_ipk_ - implicit none - type(psb_zspmat_type), intent(in) :: a,b - type(psb_zspmat_type), intent(out) :: c - integer(psb_ipk_), intent(out) :: info - end subroutine psb_zsymbmm - subroutine psb_zbase_symbmm(a,b,c,info) - use psb_mat_mod, only : psb_z_base_sparse_mat, psb_z_csr_sparse_mat - import :: psb_ipk_ - implicit none - class(psb_z_base_sparse_mat), intent(in) :: a,b - type(psb_z_csr_sparse_mat), intent(out) :: c - integer(psb_ipk_), intent(out) :: info - end subroutine psb_zbase_symbmm - end interface psb_symbmm - - interface psb_numbmm - subroutine psb_snumbmm(a,b,c) - use psb_mat_mod, only : psb_sspmat_type - import :: psb_ipk_ - implicit none - type(psb_sspmat_type), intent(in) :: a,b - type(psb_sspmat_type), intent(inout) :: c - end subroutine psb_snumbmm - subroutine psb_sbase_numbmm(a,b,c) - use psb_mat_mod, only : psb_s_base_sparse_mat, psb_s_csr_sparse_mat - import :: psb_ipk_ - implicit none - class(psb_s_base_sparse_mat), intent(in) :: a,b - type(psb_s_csr_sparse_mat), intent(inout) :: c - end subroutine psb_sbase_numbmm - subroutine psb_dnumbmm(a,b,c) - use psb_mat_mod, only : psb_dspmat_type - import :: psb_ipk_ - implicit none - type(psb_dspmat_type), intent(in) :: a,b - type(psb_dspmat_type), intent(inout) :: c - end subroutine psb_dnumbmm - subroutine psb_dbase_numbmm(a,b,c) - use psb_mat_mod, only : psb_d_base_sparse_mat, psb_d_csr_sparse_mat - import :: psb_ipk_ - implicit none - class(psb_d_base_sparse_mat), intent(in) :: a,b - type(psb_d_csr_sparse_mat), intent(inout) :: c - end subroutine psb_dbase_numbmm - subroutine psb_cnumbmm(a,b,c) - use psb_mat_mod, only : psb_cspmat_type - import :: psb_ipk_ - implicit none - type(psb_cspmat_type), intent(in) :: a,b - type(psb_cspmat_type), intent(inout) :: c - end subroutine psb_cnumbmm - subroutine psb_cbase_numbmm(a,b,c) - use psb_mat_mod, only : psb_c_base_sparse_mat, psb_c_csr_sparse_mat - import :: psb_ipk_ - implicit none - class(psb_c_base_sparse_mat), intent(in) :: a,b - type(psb_c_csr_sparse_mat), intent(inout) :: c - end subroutine psb_cbase_numbmm - subroutine psb_znumbmm(a,b,c) - use psb_mat_mod, only : psb_zspmat_type - import :: psb_ipk_ - implicit none - type(psb_zspmat_type), intent(in) :: a,b - type(psb_zspmat_type), intent(inout) :: c - end subroutine psb_znumbmm - subroutine psb_zbase_numbmm(a,b,c) - use psb_mat_mod, only : psb_z_base_sparse_mat, psb_z_csr_sparse_mat - import :: psb_ipk_ - implicit none - class(psb_z_base_sparse_mat), intent(in) :: a,b - type(psb_z_csr_sparse_mat), intent(inout) :: c - end subroutine psb_zbase_numbmm - end interface psb_numbmm - - interface psb_rwextd - subroutine psb_srwextd(nr,a,info,b,rowscale) - use psb_mat_mod, only : psb_sspmat_type - import :: psb_ipk_ - implicit none - integer(psb_ipk_), intent(in) :: nr - type(psb_sspmat_type), intent(inout) :: a - integer(psb_ipk_),intent(out) :: info - type(psb_sspmat_type), intent(in), optional :: b - logical,intent(in), optional :: rowscale - end subroutine psb_srwextd - subroutine psb_sbase_rwextd(nr,a,info,b,rowscale) - use psb_mat_mod, only : psb_s_base_sparse_mat - import :: psb_ipk_ - implicit none - integer(psb_ipk_), intent(in) :: nr - class(psb_s_base_sparse_mat), intent(inout) :: a - integer(psb_ipk_),intent(out) :: info - class(psb_s_base_sparse_mat), intent(in), optional :: b - logical,intent(in), optional :: rowscale - end subroutine psb_sbase_rwextd - subroutine psb_drwextd(nr,a,info,b,rowscale) - use psb_mat_mod, only : psb_dspmat_type - import :: psb_ipk_ - implicit none - integer(psb_ipk_), intent(in) :: nr - type(psb_dspmat_type), intent(inout) :: a - integer(psb_ipk_),intent(out) :: info - type(psb_dspmat_type), intent(in), optional :: b - logical,intent(in), optional :: rowscale - end subroutine psb_drwextd - subroutine psb_dbase_rwextd(nr,a,info,b,rowscale) - use psb_mat_mod, only : psb_d_base_sparse_mat - import :: psb_ipk_ - implicit none - integer(psb_ipk_), intent(in) :: nr - class(psb_d_base_sparse_mat), intent(inout) :: a - integer(psb_ipk_),intent(out) :: info - class(psb_d_base_sparse_mat), intent(in), optional :: b - logical,intent(in), optional :: rowscale - end subroutine psb_dbase_rwextd - subroutine psb_crwextd(nr,a,info,b,rowscale) - use psb_mat_mod, only : psb_cspmat_type - import :: psb_ipk_ - implicit none - integer(psb_ipk_), intent(in) :: nr - type(psb_cspmat_type), intent(inout) :: a - integer(psb_ipk_),intent(out) :: info - type(psb_cspmat_type), intent(in), optional :: b - logical,intent(in), optional :: rowscale - end subroutine psb_crwextd - subroutine psb_cbase_rwextd(nr,a,info,b,rowscale) - use psb_mat_mod, only : psb_c_base_sparse_mat - import :: psb_ipk_ - implicit none - integer(psb_ipk_), intent(in) :: nr - class(psb_c_base_sparse_mat), intent(inout) :: a - integer(psb_ipk_),intent(out) :: info - class(psb_c_base_sparse_mat), intent(in), optional :: b - logical,intent(in), optional :: rowscale - end subroutine psb_cbase_rwextd - subroutine psb_zrwextd(nr,a,info,b,rowscale) - use psb_mat_mod, only : psb_zspmat_type - import :: psb_ipk_ - implicit none - integer(psb_ipk_), intent(in) :: nr - type(psb_zspmat_type), intent(inout) :: a - integer(psb_ipk_),intent(out) :: info - type(psb_zspmat_type), intent(in), optional :: b - logical,intent(in), optional :: rowscale - end subroutine psb_zrwextd - subroutine psb_zbase_rwextd(nr,a,info,b,rowscale) - use psb_mat_mod, only : psb_z_base_sparse_mat - import :: psb_ipk_ - implicit none - integer(psb_ipk_), intent(in) :: nr - class(psb_z_base_sparse_mat), intent(inout) :: a - integer(psb_ipk_),intent(out) :: info - class(psb_z_base_sparse_mat), intent(in), optional :: b - logical,intent(in), optional :: rowscale - end subroutine psb_zbase_rwextd - end interface psb_rwextd - - - interface psb_geprt - subroutine psb_sgeprtn2(fname,a,head) - use psb_const_mod, only : psb_spk_, psb_ipk_ - character(len=*), intent(in) :: fname - real(psb_spk_), intent(in) :: a(:,:) - character(len=*), optional :: head - end subroutine psb_sgeprtn2 - subroutine psb_sgeprtn1(fname,a,head) - use psb_const_mod, only : psb_spk_, psb_ipk_ - character(len=*), intent(in) :: fname - real(psb_spk_), intent(in) :: a(:) - character(len=*), optional :: head - end subroutine psb_sgeprtn1 - subroutine psb_sgeprt2(iout,a,head) - use psb_const_mod, only : psb_spk_, psb_ipk_ - integer(psb_ipk_), intent(in) :: iout - real(psb_spk_), intent(in) :: a(:,:) - character(len=*), optional :: head - end subroutine psb_sgeprt2 - subroutine psb_sgeprt1(iout,a,head) - use psb_const_mod, only : psb_spk_, psb_ipk_ - integer(psb_ipk_), intent(in) :: iout - real(psb_spk_), intent(in) :: a(:) - character(len=*), optional :: head - end subroutine psb_sgeprt1 - subroutine psb_dgeprtn2(fname,a,head) - use psb_const_mod, only : psb_dpk_, psb_ipk_ - character(len=*), intent(in) :: fname - real(psb_dpk_), intent(in) :: a(:,:) - character(len=*), optional :: head - end subroutine psb_dgeprtn2 - subroutine psb_dgeprtn1(fname,a,head) - use psb_const_mod, only : psb_dpk_, psb_ipk_ - character(len=*), intent(in) :: fname - real(psb_dpk_), intent(in) :: a(:) - character(len=*), optional :: head - end subroutine psb_dgeprtn1 - subroutine psb_dgeprt2(iout,a,head) - use psb_const_mod, only : psb_dpk_, psb_ipk_ - integer(psb_ipk_), intent(in) :: iout - real(psb_dpk_), intent(in) :: a(:,:) - character(len=*), optional :: head - end subroutine psb_dgeprt2 - subroutine psb_dgeprt1(iout,a,head) - use psb_const_mod, only : psb_dpk_, psb_ipk_ - integer(psb_ipk_), intent(in) :: iout - real(psb_dpk_), intent(in) :: a(:) - character(len=*), optional :: head - end subroutine psb_dgeprt1 - subroutine psb_cgeprtn2(fname,a,head) - use psb_const_mod, only : psb_spk_, psb_ipk_ - character(len=*), intent(in) :: fname - complex(psb_spk_), intent(in) :: a(:,:) - character(len=*), optional :: head - end subroutine psb_cgeprtn2 - subroutine psb_cgeprtn1(fname,a,head) - use psb_const_mod, only : psb_spk_, psb_ipk_ - character(len=*), intent(in) :: fname - complex(psb_spk_), intent(in) :: a(:) - character(len=*), optional :: head - end subroutine psb_cgeprtn1 - subroutine psb_cgeprt2(iout,a,head) - use psb_const_mod, only : psb_spk_, psb_ipk_ - integer(psb_ipk_), intent(in) :: iout - complex(psb_spk_), intent(in) :: a(:,:) - character(len=*), optional :: head - end subroutine psb_cgeprt2 - subroutine psb_cgeprt1(iout,a,head) - use psb_const_mod, only : psb_spk_, psb_ipk_ - integer(psb_ipk_), intent(in) :: iout - complex(psb_spk_), intent(in) :: a(:) - character(len=*), optional :: head - end subroutine psb_cgeprt1 - subroutine psb_zgeprtn2(fname,a,head) - use psb_const_mod, only : psb_dpk_, psb_ipk_ - character(len=*), intent(in) :: fname - complex(psb_dpk_), intent(in) :: a(:,:) - character(len=*), optional :: head - end subroutine psb_zgeprtn2 - subroutine psb_zgeprtn1(fname,a,head) - use psb_const_mod, only : psb_dpk_, psb_ipk_ - character(len=*), intent(in) :: fname - complex(psb_dpk_), intent(in) :: a(:) - character(len=*), optional :: head - end subroutine psb_zgeprtn1 - subroutine psb_zgeprt2(iout,a,head) - use psb_const_mod, only : psb_dpk_, psb_ipk_ - integer(psb_ipk_), intent(in) :: iout - complex(psb_dpk_), intent(in) :: a(:,:) - character(len=*), optional :: head - end subroutine psb_zgeprt2 - subroutine psb_zgeprt1(iout,a,head) - use psb_const_mod, only : psb_dpk_, psb_ipk_ - integer(psb_ipk_), intent(in) :: iout - complex(psb_dpk_), intent(in) :: a(:) - character(len=*), optional :: head - end subroutine psb_zgeprt1 - end interface psb_geprt - - interface psb_csprt - module procedure psb_scsprt, psb_scsprtn, psb_dcsprt, psb_dcsprtn, & - & psb_ccsprt, psb_ccsprtn, psb_zcsprt, psb_zcsprtn - end interface psb_csprt - - interface psb_spdot_srtd - function psb_s_spdot_srtd(nv1,iv1,v1,nv2,iv2,v2) result(dot) - use psb_const_mod, only : psb_ipk_, psb_spk_, psb_dpk_ - integer(psb_ipk_), intent(in) :: nv1,nv2 - integer(psb_ipk_), intent(in) :: iv1(*), iv2(*) - real(psb_spk_), intent(in) :: v1(*),v2(*) - real(psb_spk_) :: dot - end function psb_s_spdot_srtd - - function psb_d_spdot_srtd(nv1,iv1,v1,nv2,iv2,v2) result(dot) - use psb_const_mod, only : psb_ipk_, psb_spk_, psb_dpk_ - integer(psb_ipk_), intent(in) :: nv1,nv2 - integer(psb_ipk_), intent(in) :: iv1(*), iv2(*) - real(psb_dpk_), intent(in) :: v1(*), v2(*) - real(psb_dpk_) :: dot - end function psb_d_spdot_srtd - - function psb_c_spdot_srtd(nv1,iv1,v1,nv2,iv2,v2) result(dot) - use psb_const_mod, only : psb_ipk_, psb_spk_, psb_dpk_ - integer(psb_ipk_), intent(in) :: nv1,nv2 - integer(psb_ipk_), intent(in) :: iv1(*), iv2(*) - complex(psb_spk_), intent(in) :: v1(*),v2(*) - complex(psb_spk_) :: dot - end function psb_c_spdot_srtd - - function psb_z_spdot_srtd(nv1,iv1,v1,nv2,iv2,v2) result(dot) - use psb_const_mod, only : psb_ipk_, psb_spk_, psb_dpk_ - integer(psb_ipk_), intent(in) :: nv1,nv2 - integer(psb_ipk_), intent(in) :: iv1(*), iv2(*) - complex(psb_dpk_), intent(in) :: v1(*),v2(*) - complex(psb_dpk_) :: dot - end function psb_z_spdot_srtd - end interface psb_spdot_srtd - - - interface psb_spge_dot - function psb_s_spge_dot(nv1,iv1,v1,v2) result(dot) - use psb_const_mod, only : psb_ipk_, psb_spk_, psb_dpk_ - integer(psb_ipk_), intent(in) :: nv1 - integer(psb_ipk_), intent(in) :: iv1(*) - real(psb_spk_), intent(in) :: v1(*),v2(*) - real(psb_spk_) :: dot - end function psb_s_spge_dot - - function psb_d_spge_dot(nv1,iv1,v1,v2) result(dot) - use psb_const_mod, only : psb_ipk_, psb_spk_, psb_dpk_ - integer(psb_ipk_), intent(in) :: nv1 - integer(psb_ipk_), intent(in) :: iv1(*) - real(psb_dpk_), intent(in) :: v1(*),v2(*) - real(psb_dpk_) :: dot - end function psb_d_spge_dot - - function psb_c_spge_dot(nv1,iv1,v1,v2) result(dot) - use psb_const_mod, only : psb_ipk_, psb_spk_, psb_dpk_ - integer(psb_ipk_), intent(in) :: nv1 - integer(psb_ipk_), intent(in) :: iv1(*) - complex(psb_spk_), intent(in) :: v1(*),v2(*) - complex(psb_spk_) :: dot - end function psb_c_spge_dot - - function psb_z_spge_dot(nv1,iv1,v1,v2) result(dot) - use psb_const_mod, only : psb_ipk_, psb_spk_, psb_dpk_ - integer(psb_ipk_), intent(in) :: nv1 - integer(psb_ipk_), intent(in) :: iv1(*) - complex(psb_dpk_), intent(in) :: v1(*),v2(*) - complex(psb_dpk_) :: dot - end function psb_z_spge_dot - end interface psb_spge_dot - interface psb_nspaxpby subroutine psb_d_nspaxpby(nz,iz,z,alpha, nx, ix, x, beta, ny,iy,y,info) @@ -500,44 +68,6 @@ module psb_serial_mod end subroutine psb_d_nspaxpby end interface psb_nspaxpby - interface psb_aspxpby - subroutine psb_s_aspxpby(alpha, nx, ix, x, beta, y, info) - use psb_const_mod, only : psb_ipk_, psb_spk_, psb_dpk_ - integer(psb_ipk_), intent(in) :: nx - integer(psb_ipk_), intent(in) :: ix(:) - real(psb_spk_), intent (in) :: x(:) - real(psb_spk_), intent (inout) :: y(:) - real(psb_spk_), intent (in) :: alpha, beta - integer(psb_ipk_), intent(out) :: info - end subroutine psb_s_aspxpby - subroutine psb_d_aspxpby(alpha, nx, ix, x, beta, y, info) - use psb_const_mod, only : psb_ipk_, psb_spk_, psb_dpk_ - integer(psb_ipk_), intent(in) :: nx - integer(psb_ipk_), intent(in) :: ix(:) - real(psb_dpk_), intent (in) :: x(:) - real(psb_dpk_), intent (inout) :: y(:) - real(psb_dpk_), intent (in) :: alpha, beta - integer(psb_ipk_), intent(out) :: info - end subroutine psb_d_aspxpby - subroutine psb_c_aspxpby(alpha, nx, ix, x, beta, y, info) - use psb_const_mod, only : psb_ipk_, psb_spk_, psb_dpk_ - integer(psb_ipk_), intent(in) :: nx - integer(psb_ipk_), intent(in) :: ix(:) - complex(psb_spk_), intent (in) :: x(:) - complex(psb_spk_), intent (inout) :: y(:) - complex(psb_spk_), intent (in) :: alpha, beta - integer(psb_ipk_), intent(out) :: info - end subroutine psb_c_aspxpby - subroutine psb_z_aspxpby(alpha, nx, ix, x, beta, y, info) - use psb_const_mod, only : psb_ipk_, psb_spk_, psb_dpk_ - integer(psb_ipk_), intent(in) :: nx - integer(psb_ipk_), intent(in) :: ix(:) - complex(psb_dpk_), intent (in) :: x(:) - complex(psb_dpk_), intent (inout) :: y(:) - complex(psb_dpk_), intent (in) :: alpha, beta - integer(psb_ipk_), intent(out) :: info - end subroutine psb_z_aspxpby - end interface psb_aspxpby contains @@ -827,101 +357,5 @@ contains end subroutine zrotg - subroutine psb_scsprt(iout,a,iv,head,ivr,ivc) - use psb_mat_mod - integer(psb_ipk_), intent(in) :: iout - type(psb_sspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) - character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) - - call a%print(iout,iv,head,ivr,ivc) - - end subroutine psb_scsprt - - subroutine psb_scsprtn(fname,a,iv,head,ivr,ivc) - use psb_mat_mod - character(len=*), intent(in) :: fname - type(psb_sspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) - character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) - - call a%print(fname,iv,head,ivr,ivc) - - end subroutine psb_scsprtn - - subroutine psb_dcsprt(iout,a,iv,head,ivr,ivc) - use psb_mat_mod - integer(psb_ipk_), intent(in) :: iout - type(psb_dspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) - character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) - - call a%print(iout,iv,head,ivr,ivc) - - end subroutine psb_dcsprt - - subroutine psb_dcsprtn(fname,a,iv,head,ivr,ivc) - use psb_mat_mod - character(len=*), intent(in) :: fname - type(psb_dspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) - character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) - - call a%print(fname,iv,head,ivr,ivc) - - end subroutine psb_dcsprtn - - subroutine psb_ccsprt(iout,a,iv,head,ivr,ivc) - use psb_mat_mod - integer(psb_ipk_), intent(in) :: iout - type(psb_cspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) - character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) - - call a%print(iout,iv,head,ivr,ivc) - - end subroutine psb_ccsprt - - subroutine psb_ccsprtn(fname,a,iv,head,ivr,ivc) - use psb_mat_mod - character(len=*), intent(in) :: fname - type(psb_cspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) - character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) - - call a%print(fname,iv,head,ivr,ivc) - - end subroutine psb_ccsprtn - - subroutine psb_zcsprt(iout,a,iv,head,ivr,ivc) - use psb_mat_mod - integer(psb_ipk_), intent(in) :: iout - type(psb_zspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) - character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) - - call a%print(iout,iv,head,ivr,ivc) - - end subroutine psb_zcsprt - - subroutine psb_zcsprtn(fname,a,iv,head,ivr,ivc) - use psb_mat_mod - character(len=*), intent(in) :: fname - type(psb_zspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) - character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) - - call a%print(fname,iv,head,ivr,ivc) - - end subroutine psb_zcsprtn - end module psb_serial_mod diff --git a/base/modules/psb_z_serial_mod.f90 b/base/modules/psb_z_serial_mod.f90 new file mode 100644 index 00000000..4708f5e1 --- /dev/null +++ b/base/modules/psb_z_serial_mod.f90 @@ -0,0 +1,206 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ 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 PSBLAS 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 PSBLAS 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. +!!$ +!!$ +module psb_z_serial_mod + use psb_const_mod + use psb_error_mod + + interface psb_amax + function psb_zamax_s(n, x) result(val) + import :: psb_ipk_, psb_dpk_ + integer(psb_ipk_), intent(in) :: n + complex(psb_dpk_), intent(in) :: x(:) + real(psb_dpk_) :: val + end function psb_zamax_s + end interface psb_amax + + interface psb_asum + function psb_zasum_s(n, x) result(val) + import :: psb_ipk_, psb_dpk_ + integer(psb_ipk_), intent(in) :: n + complex(psb_dpk_), intent(in) :: x(:) + real(psb_dpk_) :: val + end function psb_zasum_s + end interface psb_asum + + interface psb_symbmm + subroutine psb_zsymbmm(a,b,c,info) + use psb_z_mat_mod, only : psb_zspmat_type + import :: psb_ipk_ + implicit none + type(psb_zspmat_type), intent(in) :: a,b + type(psb_zspmat_type), intent(out) :: c + integer(psb_ipk_), intent(out) :: info + end subroutine psb_zsymbmm + subroutine psb_zbase_symbmm(a,b,c,info) + use psb_z_mat_mod, only : psb_z_base_sparse_mat, psb_z_csr_sparse_mat + import :: psb_ipk_ + implicit none + class(psb_z_base_sparse_mat), intent(in) :: a,b + type(psb_z_csr_sparse_mat), intent(out) :: c + integer(psb_ipk_), intent(out) :: info + end subroutine psb_zbase_symbmm + end interface psb_symbmm + + interface psb_numbmm + subroutine psb_znumbmm(a,b,c) + use psb_z_mat_mod, only : psb_zspmat_type + import :: psb_ipk_ + implicit none + type(psb_zspmat_type), intent(in) :: a,b + type(psb_zspmat_type), intent(inout) :: c + end subroutine psb_znumbmm + subroutine psb_zbase_numbmm(a,b,c) + use psb_z_mat_mod, only : psb_z_base_sparse_mat, psb_z_csr_sparse_mat + import :: psb_ipk_ + implicit none + class(psb_z_base_sparse_mat), intent(in) :: a,b + type(psb_z_csr_sparse_mat), intent(inout) :: c + end subroutine psb_zbase_numbmm + end interface psb_numbmm + + interface psb_rwextd + subroutine psb_zrwextd(nr,a,info,b,rowscale) + use psb_z_mat_mod, only : psb_zspmat_type + import :: psb_ipk_ + implicit none + integer(psb_ipk_), intent(in) :: nr + type(psb_zspmat_type), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + type(psb_zspmat_type), intent(in), optional :: b + logical,intent(in), optional :: rowscale + end subroutine psb_zrwextd + subroutine psb_zbase_rwextd(nr,a,info,b,rowscale) + use psb_z_mat_mod, only : psb_z_base_sparse_mat + import :: psb_ipk_ + implicit none + integer(psb_ipk_), intent(in) :: nr + class(psb_z_base_sparse_mat), intent(inout) :: a + integer(psb_ipk_),intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: b + logical,intent(in), optional :: rowscale + end subroutine psb_zbase_rwextd + end interface psb_rwextd + + + interface psb_geprt + subroutine psb_zgeprtn2(fname,a,head) + use psb_const_mod, only : psb_dpk_, psb_ipk_ + character(len=*), intent(in) :: fname + complex(psb_dpk_), intent(in) :: a(:,:) + character(len=*), optional :: head + end subroutine psb_zgeprtn2 + subroutine psb_zgeprtn1(fname,a,head) + use psb_const_mod, only : psb_dpk_, psb_ipk_ + character(len=*), intent(in) :: fname + complex(psb_dpk_), intent(in) :: a(:) + character(len=*), optional :: head + end subroutine psb_zgeprtn1 + subroutine psb_zgeprt2(iout,a,head) + use psb_const_mod, only : psb_dpk_, psb_ipk_ + integer(psb_ipk_), intent(in) :: iout + complex(psb_dpk_), intent(in) :: a(:,:) + character(len=*), optional :: head + end subroutine psb_zgeprt2 + subroutine psb_zgeprt1(iout,a,head) + use psb_const_mod, only : psb_dpk_, psb_ipk_ + integer(psb_ipk_), intent(in) :: iout + complex(psb_dpk_), intent(in) :: a(:) + character(len=*), optional :: head + end subroutine psb_zgeprt1 + end interface psb_geprt + + interface psb_csprt + module procedure psb_zcsprt, psb_zcsprtn + end interface psb_csprt + + interface psb_spdot_srtd + function psb_z_spdot_srtd(nv1,iv1,v1,nv2,iv2,v2) result(dot) + use psb_const_mod, only : psb_ipk_, psb_dpk_ + integer(psb_ipk_), intent(in) :: nv1,nv2 + integer(psb_ipk_), intent(in) :: iv1(*), iv2(*) + complex(psb_dpk_), intent(in) :: v1(*),v2(*) + complex(psb_dpk_) :: dot + end function psb_z_spdot_srtd + end interface psb_spdot_srtd + + + interface psb_spge_dot + function psb_z_spge_dot(nv1,iv1,v1,v2) result(dot) + use psb_const_mod, only : psb_ipk_, psb_dpk_ + integer(psb_ipk_), intent(in) :: nv1 + integer(psb_ipk_), intent(in) :: iv1(*) + complex(psb_dpk_), intent(in) :: v1(*),v2(*) + complex(psb_dpk_) :: dot + end function psb_z_spge_dot + end interface psb_spge_dot + + + interface psb_aspxpby + subroutine psb_z_aspxpby(alpha, nx, ix, x, beta, y, info) + use psb_const_mod, only : psb_ipk_, psb_dpk_ + integer(psb_ipk_), intent(in) :: nx + integer(psb_ipk_), intent(in) :: ix(:) + complex(psb_dpk_), intent (in) :: x(:) + complex(psb_dpk_), intent (inout) :: y(:) + complex(psb_dpk_), intent (in) :: alpha, beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_aspxpby + end interface psb_aspxpby + +contains + + subroutine psb_zcsprt(iout,a,iv,head,ivr,ivc) + use psb_z_mat_mod, only : psb_zspmat_type + integer(psb_ipk_), intent(in) :: iout + type(psb_zspmat_type), intent(in) :: a + integer(psb_ipk_), intent(in), optional :: iv(:) + character(len=*), optional :: head + integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + + call a%print(iout,iv,head,ivr,ivc) + + end subroutine psb_zcsprt + + subroutine psb_zcsprtn(fname,a,iv,head,ivr,ivc) + use psb_z_mat_mod, only : psb_zspmat_type + character(len=*), intent(in) :: fname + type(psb_zspmat_type), intent(in) :: a + integer(psb_ipk_), intent(in), optional :: iv(:) + character(len=*), optional :: head + integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + + call a%print(fname,iv,head,ivr,ivc) + + end subroutine psb_zcsprtn + +end module psb_z_serial_mod +