From 50f77c90958f630852dda8e78165036419ffe419 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 29 Jul 2010 08:01:43 +0000 Subject: [PATCH] psblas3: Changelog base/modules/Makefile base/modules/psb_base_mat_mod.f03 base/modules/psb_c_linmap_mod.f90 base/modules/psb_d_linmap_mod.f90 base/modules/psb_linmap_mod.f90 base/modules/psb_s_linmap_mod.f90 base/modules/psb_z_linmap_mod.f90 base/serial/f03/psb_d_csr_impl.f03 test/serial/Makefile test/serial/d_matgen.f03 Split linmap_mod. base_mat%aux to be of fixed size, workaround for a gfortran strange bug. --- Changelog | 4 +- base/modules/Makefile | 7 +- base/modules/psb_base_mat_mod.f03 | 21 +- base/modules/psb_c_linmap_mod.f90 | 232 +++++++++ base/modules/psb_d_linmap_mod.f90 | 232 +++++++++ base/modules/psb_linmap_mod.f90 | 787 ----------------------------- base/modules/psb_s_linmap_mod.f90 | 236 +++++++++ base/modules/psb_z_linmap_mod.f90 | 233 +++++++++ base/serial/f03/psb_d_csr_impl.f03 | 11 +- test/serial/Makefile | 16 +- test/serial/d_matgen.f03 | 2 - 11 files changed, 952 insertions(+), 829 deletions(-) create mode 100644 base/modules/psb_c_linmap_mod.f90 create mode 100644 base/modules/psb_d_linmap_mod.f90 create mode 100644 base/modules/psb_s_linmap_mod.f90 create mode 100644 base/modules/psb_z_linmap_mod.f90 diff --git a/Changelog b/Changelog index a35079cc..07a8172b 100644 --- a/Changelog +++ b/Changelog @@ -1,6 +1,8 @@ Changelog. A lot less detailed than usual, at least for past history. - +2010/07/29: Make the aux component of base_mat a static array; works + around a problem with gfortran. The library does not fully + work yet under gfortran. 2010/05/10: Fixed fakempi. Now works under XLF 13.1 2010/04/29: Restructure KRYLOV modules. diff --git a/base/modules/Makefile b/base/modules/Makefile index 886391ed..e13c0d1f 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -7,7 +7,9 @@ UTIL_MODS = psb_string_mod.o \ psb_c_tools_mod.o psb_z_tools_mod.o psb_tools_mod.o \ psb_penv_mod.o psi_comm_buffers_mod.o psi_penv_mod.o psi_bcast_mod.o \ psi_reduce_mod.o psi_p2p_mod.o psb_error_impl.o \ - psb_linmap_type_mod.o psb_linmap_mod.o psb_comm_mod.o\ + psb_linmap_type_mod.o psb_linmap_mod.o \ + psb_s_linmap_mod.o psb_d_linmap_mod.o psb_c_linmap_mod.o psb_z_linmap_mod.o \ + psb_comm_mod.o\ psb_s_psblas_mod.o psb_c_psblas_mod.o \ psb_d_psblas_mod.o psb_z_psblas_mod.o psb_psblas_mod.o \ psi_serial_mod.o psi_mod.o psb_ip_reord_mod.o\ @@ -59,7 +61,8 @@ psb_blacs_mod.o: psb_const_mod.o psi_serial_mod.o: psb_const_mod.o psb_realloc_mod.o psi_mod.o: psb_penv_mod.o psb_error_mod.o psb_desc_type.o psb_const_mod.o psi_serial_mod.o psb_serial_mod.o psb_desc_type.o: psb_const_mod.o psb_error_mod.o psb_penv_mod.o psb_realloc_mod.o psb_hash_mod.o -psb_linmap_mod.o: psb_linmap_type_mod.o psb_mat_mod.o +psb_linmap_mod.o: psb_s_linmap_mod.o psb_d_linmap_mod.o psb_c_linmap_mod.o psb_z_linmap_mod.o + psb_s_linmap_mod.o psb_d_linmap_mod.o psb_c_linmap_mod.o psb_z_linmap_mod.o: psb_linmap_type_mod.o psb_mat_mod.o psb_linmap_type_mod.o: psb_desc_type.o psb_error_mod.o psb_serial_mod.o psb_comm_mod.o psb_mat_mod.o psb_comm_mod.o: psb_desc_type.o psb_mat_mod.o psb_check_mod.o: psb_desc_type.o diff --git a/base/modules/psb_base_mat_mod.f03 b/base/modules/psb_base_mat_mod.f03 index c3d7bba9..696a52ff 100644 --- a/base/modules/psb_base_mat_mod.f03 +++ b/base/modules/psb_base_mat_mod.f03 @@ -2,16 +2,15 @@ module psb_base_mat_mod use psb_const_mod use psi_serial_mod - + integer, parameter, private :: auxsz=32 type :: psb_base_sparse_mat integer, private :: m, n integer, private :: state, duplicate logical, private :: triangle, unitd, upper, sorted ! This is a different animal: it's a kitchen sink for ! any additional parameters that may be needed - ! when converting to/from COO. Why here? - ! Will tell you one day... - integer, allocatable :: aux(:) + ! when converting to/from COO. + integer :: aux(auxsz) contains ! == = ================================= @@ -253,7 +252,7 @@ contains subroutine psb_base_get_aux(v,a) implicit none class(psb_base_sparse_mat), intent(in) :: a - integer, intent(out), allocatable :: v(:) + integer, intent(out), allocatable :: v(:) ! TBD write(psb_err_unit,*) 'GET_AUX is empty right now ' end subroutine psb_base_get_aux @@ -453,7 +452,7 @@ contains a%unitd = b%unitd a%upper = b%upper a%sorted = b%sorted - call move_alloc(b%aux,a%aux) + a%aux = b%aux end subroutine psb_base_mv_from @@ -471,10 +470,7 @@ contains a%unitd = b%unitd a%upper = b%upper a%sorted = b%sorted - if (allocated(b%aux)) then - allocate(a%aux(size(b%aux))) - a%aux(:) = b%aux(:) - end if + a%aux(:) = b%aux(:) end subroutine psb_base_cp_from @@ -492,10 +488,7 @@ contains a%unitd = b%unitd a%upper = .not.b%upper a%sorted = .false. - if (allocated(b%aux)) then - allocate(a%aux(size(b%aux))) - a%aux(:) = b%aux(:) - end if + a%aux(:) = b%aux(:) end subroutine psb_base_transp_2mat diff --git a/base/modules/psb_c_linmap_mod.f90 b/base/modules/psb_c_linmap_mod.f90 new file mode 100644 index 00000000..7da5da4d --- /dev/null +++ b/base/modules/psb_c_linmap_mod.f90 @@ -0,0 +1,232 @@ +!!$ +!!$ Parallel Sparse BLAS version 2.2 +!!$ (C) Copyright 2006/2007/2008 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ 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. +!!$ +!!$ +! +! +! package: psb_linmap_mod +! Defines facilities for mapping between vectors belonging +! to different spaces. +! +module psb_c_linmap_mod + + use psb_const_mod + use psb_linmap_type_mod + + + interface psb_map_X2Y + subroutine psb_c_map_X2Y(alpha,x,beta,y,map,info,work) + use psb_linmap_type_mod + implicit none + type(psb_clinmap_type), intent(in) :: map + complex(psb_spk_), intent(in) :: alpha,beta + complex(psb_spk_), intent(inout) :: x(:) + complex(psb_spk_), intent(out) :: y(:) + integer, intent(out) :: info + complex(psb_spk_), optional :: work(:) + end subroutine psb_c_map_X2Y + end interface + + interface psb_map_Y2X + subroutine psb_c_map_Y2X(alpha,x,beta,y,map,info,work) + use psb_linmap_type_mod + implicit none + type(psb_clinmap_type), intent(in) :: map + complex(psb_spk_), intent(in) :: alpha,beta + complex(psb_spk_), intent(inout) :: x(:) + complex(psb_spk_), intent(out) :: y(:) + integer, intent(out) :: info + complex(psb_spk_), optional :: work(:) + end subroutine psb_c_map_Y2X + end interface + + + interface psb_is_ok_map + module procedure psb_is_ok_clinmap + end interface + + interface psb_get_map_kind + module procedure psb_get_cmap_kind + end interface + + interface psb_set_map_kind + module procedure psb_set_cmap_kind + end interface + + interface psb_is_asb_map + module procedure psb_is_asb_clinmap + end interface + + interface psb_linmap_sub + module procedure psb_c_linmap_sub + end interface + + interface psb_move_alloc + module procedure psb_clinmap_transfer + end interface + + interface psb_linmap + function psb_c_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) + use psb_linmap_type_mod + implicit none + type(psb_clinmap_type) :: psb_c_linmap + type(psb_desc_type), target :: desc_X, desc_Y + type(psb_c_sparse_mat), intent(in) :: map_X2Y, map_Y2X + integer, intent(in) :: map_kind + integer, intent(in), optional :: iaggr(:), naggr(:) + end function psb_c_linmap + end interface + + interface psb_sizeof + module procedure psb_clinmap_sizeof + end interface + +contains + + function psb_get_cmap_kind(map) + implicit none + type(psb_clinmap_type), intent(in) :: map + Integer :: psb_get_cmap_kind + if (allocated(map%itd_data)) then + psb_get_cmap_kind = map%itd_data(psb_map_kind_) + else + psb_get_cmap_kind = -1 + end if + end function psb_get_cmap_kind + + subroutine psb_set_cmap_kind(map_kind,map) + implicit none + integer, intent(in) :: map_kind + type(psb_clinmap_type), intent(inout) :: map + + map%itd_data(psb_map_kind_) = map_kind + + end subroutine psb_set_cmap_kind + + function psb_is_asb_clinmap(map) result(this) + use psb_descriptor_type + implicit none + type(psb_clinmap_type), intent(in) :: map + logical :: this + + this = .false. + if (.not.allocated(map%itd_data)) return + select case(psb_get_map_kind(map)) + case (psb_map_aggr_) + if (.not.associated(map%p_desc_X)) return + if (.not.associated(map%p_desc_Y)) return + this = & + & psb_is_asb_desc(map%p_desc_X).and.psb_is_asb_desc(map%p_desc_Y) + + case(psb_map_gen_linear_) + + this = & + & psb_is_asb_desc(map%desc_X).and.psb_is_asb_desc(map%desc_Y) + + end select + + end function psb_is_asb_clinmap + + function psb_is_ok_clinmap(map) result(this) + use psb_descriptor_type + implicit none + type(psb_clinmap_type), intent(in) :: map + logical :: this + this = .false. + if (.not.allocated(map%itd_data)) return + select case(psb_get_map_kind(map)) + case (psb_map_aggr_) + if (.not.associated(map%p_desc_X)) return + if (.not.associated(map%p_desc_Y)) return + this = & + & psb_is_ok_desc(map%p_desc_X).and.psb_is_ok_desc(map%p_desc_Y) + case(psb_map_gen_linear_) + this = & + & psb_is_ok_desc(map%desc_X).and.psb_is_ok_desc(map%desc_Y) + end select + + end function psb_is_ok_clinmap + + function psb_clinmap_sizeof(map) result(val) + use psb_descriptor_type + use psb_mat_mod, only : psb_sizeof + implicit none + type(psb_clinmap_type), intent(in) :: map + integer(psb_long_int_k_) :: val + + val = 0 + if (allocated(map%itd_data)) & + & val = val + psb_sizeof_int*size(map%itd_data) + if (allocated(map%iaggr)) & + & val = val + psb_sizeof_int*size(map%iaggr) + if (allocated(map%naggr)) & + & val = val + psb_sizeof_int*size(map%naggr) + val = val + psb_sizeof(map%desc_X) + val = val + psb_sizeof(map%desc_Y) + val = val + psb_sizeof(map%map_X2Y) + val = val + psb_sizeof(map%map_Y2X) + + end function psb_clinmap_sizeof + + subroutine psb_c_linmap_sub(out_map,map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) + use psb_linmap_type_mod + implicit none + type(psb_clinmap_type), intent(out) :: out_map + type(psb_desc_type), target :: desc_X, desc_Y + type(psb_c_sparse_mat), intent(in) :: map_X2Y, map_Y2X + integer, intent(in) :: map_kind + integer, intent(in), optional :: iaggr(:), naggr(:) + out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) + end subroutine psb_c_linmap_sub + + subroutine psb_clinmap_transfer(mapin,mapout,info) + use psb_realloc_mod + use psb_mat_mod, only : psb_move_alloc + use psb_descriptor_type + implicit none + type(psb_clinmap_type) :: mapin,mapout + integer, intent(out) :: info + + call psb_move_alloc(mapin%itd_data,mapout%itd_data,info) + call psb_move_alloc(mapin%iaggr,mapout%iaggr,info) + call psb_move_alloc(mapin%naggr,mapout%naggr,info) + mapout%p_desc_X => mapin%p_desc_X + mapin%p_desc_X => null() + mapout%p_desc_Y => mapin%p_desc_Y + mapin%p_desc_Y => null() + call psb_move_alloc(mapin%desc_X,mapout%desc_X,info) + call psb_move_alloc(mapin%desc_Y,mapout%desc_Y,info) + call psb_move_alloc(mapin%map_X2Y,mapout%map_X2Y,info) + call psb_move_alloc(mapin%map_Y2X,mapout%map_Y2X,info) + + end subroutine psb_clinmap_transfer + +end module psb_c_linmap_mod + diff --git a/base/modules/psb_d_linmap_mod.f90 b/base/modules/psb_d_linmap_mod.f90 new file mode 100644 index 00000000..ae6f77c3 --- /dev/null +++ b/base/modules/psb_d_linmap_mod.f90 @@ -0,0 +1,232 @@ +!!$ +!!$ Parallel Sparse BLAS version 2.2 +!!$ (C) Copyright 2006/2007/2008 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ 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. +!!$ +!!$ +! +! +! package: psb_linmap_mod +! Defines facilities for mapping between vectors belonging +! to different spaces. +! +module psb_d_linmap_mod + + use psb_const_mod + use psb_linmap_type_mod + + + interface psb_map_X2Y + subroutine psb_d_map_X2Y(alpha,x,beta,y,map,info,work) + use psb_linmap_type_mod + implicit none + type(psb_dlinmap_type), intent(in) :: map + real(psb_dpk_), intent(in) :: alpha,beta + real(psb_dpk_), intent(inout) :: x(:) + real(psb_dpk_), intent(out) :: y(:) + integer, intent(out) :: info + real(psb_dpk_), optional :: work(:) + end subroutine psb_d_map_X2Y + end interface + + interface psb_map_Y2X + subroutine psb_d_map_Y2X(alpha,x,beta,y,map,info,work) + use psb_linmap_type_mod + implicit none + type(psb_dlinmap_type), intent(in) :: map + real(psb_dpk_), intent(in) :: alpha,beta + real(psb_dpk_), intent(inout) :: x(:) + real(psb_dpk_), intent(out) :: y(:) + integer, intent(out) :: info + real(psb_dpk_), optional :: work(:) + end subroutine psb_d_map_Y2X + end interface + + + interface psb_is_ok_map + module procedure psb_is_ok_dlinmap + end interface + + interface psb_get_map_kind + module procedure psb_get_dmap_kind + end interface + + interface psb_set_map_kind + module procedure psb_set_dmap_kind + end interface + + interface psb_is_asb_map + module procedure psb_is_asb_dlinmap + end interface + + interface psb_linmap_sub + module procedure psb_d_linmap_sub + end interface + + interface psb_move_alloc + module procedure psb_dlinmap_transfer + end interface + + interface psb_linmap + function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) + use psb_linmap_type_mod + implicit none + type(psb_dlinmap_type) :: psb_d_linmap + type(psb_desc_type), target :: desc_X, desc_Y + type(psb_d_sparse_mat), intent(in) :: map_X2Y, map_Y2X + integer, intent(in) :: map_kind + integer, intent(in), optional :: iaggr(:), naggr(:) + end function psb_d_linmap + end interface + + interface psb_sizeof + module procedure psb_dlinmap_sizeof + end interface + +contains + + function psb_get_dmap_kind(map) + implicit none + type(psb_dlinmap_type), intent(in) :: map + Integer :: psb_get_dmap_kind + if (allocated(map%itd_data)) then + psb_get_dmap_kind = map%itd_data(psb_map_kind_) + else + psb_get_dmap_kind = -1 + end if + end function psb_get_dmap_kind + + + subroutine psb_set_dmap_kind(map_kind,map) + implicit none + integer, intent(in) :: map_kind + type(psb_dlinmap_type), intent(inout) :: map + + map%itd_data(psb_map_kind_) = map_kind + + end subroutine psb_set_dmap_kind + + function psb_is_asb_dlinmap(map) result(this) + use psb_descriptor_type + implicit none + type(psb_dlinmap_type), intent(in) :: map + logical :: this + + this = .false. + if (.not.allocated(map%itd_data)) return + select case(psb_get_map_kind(map)) + case (psb_map_aggr_) + if (.not.associated(map%p_desc_X)) return + if (.not.associated(map%p_desc_Y)) return + this = & + & psb_is_asb_desc(map%p_desc_X).and.psb_is_asb_desc(map%p_desc_Y) + + case(psb_map_gen_linear_) + + this = & + & psb_is_asb_desc(map%desc_X).and.psb_is_asb_desc(map%desc_Y) + + end select + + end function psb_is_asb_dlinmap + + function psb_is_ok_dlinmap(map) result(this) + use psb_descriptor_type + implicit none + type(psb_dlinmap_type), intent(in) :: map + logical :: this + this = .false. + if (.not.allocated(map%itd_data)) return + select case(psb_get_map_kind(map)) + case (psb_map_aggr_) + if (.not.associated(map%p_desc_X)) return + if (.not.associated(map%p_desc_Y)) return + this = & + & psb_is_ok_desc(map%p_desc_X).and.psb_is_ok_desc(map%p_desc_Y) + case(psb_map_gen_linear_) + this = & + & psb_is_ok_desc(map%desc_X).and.psb_is_ok_desc(map%desc_Y) + end select + + end function psb_is_ok_dlinmap + + function psb_dlinmap_sizeof(map) result(val) + use psb_descriptor_type + use psb_mat_mod, only : psb_sizeof + implicit none + type(psb_dlinmap_type), intent(in) :: map + integer(psb_long_int_k_) :: val + + val = 0 + if (allocated(map%itd_data)) & + & val = val + psb_sizeof_int*size(map%itd_data) + if (allocated(map%iaggr)) & + & val = val + psb_sizeof_int*size(map%iaggr) + if (allocated(map%naggr)) & + & val = val + psb_sizeof_int*size(map%naggr) + val = val + psb_sizeof(map%desc_X) + val = val + psb_sizeof(map%desc_Y) + val = val + psb_sizeof(map%map_X2Y) + val = val + psb_sizeof(map%map_Y2X) + + end function psb_dlinmap_sizeof + + subroutine psb_d_linmap_sub(out_map,map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) + use psb_linmap_type_mod + implicit none + type(psb_dlinmap_type), intent(out) :: out_map + type(psb_desc_type), target :: desc_X, desc_Y + type(psb_d_sparse_mat), intent(in) :: map_X2Y, map_Y2X + integer, intent(in) :: map_kind + integer, intent(in), optional :: iaggr(:), naggr(:) + out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) + end subroutine psb_d_linmap_sub + + subroutine psb_dlinmap_transfer(mapin,mapout,info) + use psb_realloc_mod + use psb_descriptor_type + use psb_mat_mod, only : psb_move_alloc + implicit none + type(psb_dlinmap_type) :: mapin,mapout + integer, intent(out) :: info + + call psb_move_alloc(mapin%itd_data,mapout%itd_data,info) + call psb_move_alloc(mapin%iaggr,mapout%iaggr,info) + call psb_move_alloc(mapin%naggr,mapout%naggr,info) + mapout%p_desc_X => mapin%p_desc_X + mapin%p_desc_X => null() + mapout%p_desc_Y => mapin%p_desc_Y + mapin%p_desc_Y => null() + call psb_move_alloc(mapin%desc_X,mapout%desc_X,info) + call psb_move_alloc(mapin%desc_Y,mapout%desc_Y,info) + call psb_move_alloc(mapin%map_X2Y,mapout%map_X2Y,info) + call psb_move_alloc(mapin%map_Y2X,mapout%map_Y2X,info) + + end subroutine psb_dlinmap_transfer + +end module psb_d_linmap_mod diff --git a/base/modules/psb_linmap_mod.f90 b/base/modules/psb_linmap_mod.f90 index edd1f315..0eb06a01 100644 --- a/base/modules/psb_linmap_mod.f90 +++ b/base/modules/psb_linmap_mod.f90 @@ -35,793 +35,6 @@ ! Defines facilities for mapping between vectors belonging ! to different spaces. ! -module psb_s_linmap_mod - - use psb_const_mod - use psb_linmap_type_mod - - - interface psb_map_X2Y - subroutine psb_s_map_X2Y(alpha,x,beta,y,map,info,work) - use psb_linmap_type_mod - implicit none - type(psb_slinmap_type), intent(in) :: map - real(psb_spk_), intent(in) :: alpha,beta - real(psb_spk_), intent(inout) :: x(:) - real(psb_spk_), intent(out) :: y(:) - integer, intent(out) :: info - real(psb_spk_), optional :: work(:) - end subroutine psb_s_map_X2Y - end interface - - interface psb_map_Y2X - subroutine psb_s_map_Y2X(alpha,x,beta,y,map,info,work) - use psb_linmap_type_mod - implicit none - type(psb_slinmap_type), intent(in) :: map - real(psb_spk_), intent(in) :: alpha,beta - real(psb_spk_), intent(inout) :: x(:) - real(psb_spk_), intent(out) :: y(:) - integer, intent(out) :: info - real(psb_spk_), optional :: work(:) - end subroutine psb_s_map_Y2X - end interface - - - interface psb_is_ok_map - module procedure psb_is_ok_slinmap - end interface - - interface psb_get_map_kind - module procedure psb_get_smap_kind - end interface - - interface psb_set_map_kind - module procedure psb_set_smap_kind - end interface - - interface psb_is_asb_map - module procedure psb_is_asb_slinmap - end interface - - interface psb_linmap_sub - module procedure psb_s_linmap_sub - end interface - - interface psb_move_alloc - module procedure psb_slinmap_transfer - end interface - - interface psb_linmap - function psb_s_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) - use psb_linmap_type_mod - implicit none - type(psb_slinmap_type) :: psb_s_linmap - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_s_sparse_mat), intent(in) :: map_X2Y, map_Y2X - integer, intent(in) :: map_kind - integer, intent(in), optional :: iaggr(:), naggr(:) - end function psb_s_linmap - end interface - - interface psb_sizeof - module procedure psb_slinmap_sizeof - end interface - -contains - - function psb_get_smap_kind(map) - implicit none - type(psb_slinmap_type), intent(in) :: map - Integer :: psb_get_smap_kind - if (allocated(map%itd_data)) then - psb_get_smap_kind = map%itd_data(psb_map_kind_) - else - psb_get_smap_kind = -1 - end if - end function psb_get_smap_kind - - - subroutine psb_set_smap_kind(map_kind,map) - implicit none - integer, intent(in) :: map_kind - type(psb_slinmap_type), intent(inout) :: map - - map%itd_data(psb_map_kind_) = map_kind - - end subroutine psb_set_smap_kind - - - function psb_is_asb_slinmap(map) result(this) - use psb_descriptor_type - implicit none - type(psb_slinmap_type), intent(in) :: map - logical :: this - - this = .false. - if (.not.allocated(map%itd_data)) return - select case(psb_get_map_kind(map)) - case (psb_map_aggr_) - if (.not.associated(map%p_desc_X)) return - if (.not.associated(map%p_desc_Y)) return - this = & - & psb_is_asb_desc(map%p_desc_X).and.psb_is_asb_desc(map%p_desc_Y) - - case(psb_map_gen_linear_) - - this = & - & psb_is_asb_desc(map%desc_X).and.psb_is_asb_desc(map%desc_Y) - - end select - - end function psb_is_asb_slinmap - - function psb_is_ok_slinmap(map) result(this) - use psb_descriptor_type - implicit none - type(psb_slinmap_type), intent(in) :: map - logical :: this - this = .false. - if (.not.allocated(map%itd_data)) return - select case(psb_get_map_kind(map)) - case (psb_map_aggr_) - if (.not.associated(map%p_desc_X)) return - if (.not.associated(map%p_desc_Y)) return - this = & - & psb_is_ok_desc(map%p_desc_X).and.psb_is_ok_desc(map%p_desc_Y) - case(psb_map_gen_linear_) - this = & - & psb_is_ok_desc(map%desc_X).and.psb_is_ok_desc(map%desc_Y) - end select - - end function psb_is_ok_slinmap - - function psb_slinmap_sizeof(map) result(val) - use psb_descriptor_type - use psb_mat_mod, only : psb_sizeof - implicit none - type(psb_slinmap_type), intent(in) :: map - integer(psb_long_int_k_) :: val - - val = 0 - if (allocated(map%itd_data)) & - & val = val + psb_sizeof_int*size(map%itd_data) - if (allocated(map%iaggr)) & - & val = val + psb_sizeof_int*size(map%iaggr) - if (allocated(map%naggr)) & - & val = val + psb_sizeof_int*size(map%naggr) - val = val + psb_sizeof(map%desc_X) - val = val + psb_sizeof(map%desc_Y) - val = val + psb_sizeof(map%map_X2Y) - val = val + psb_sizeof(map%map_Y2X) - - end function psb_slinmap_sizeof - - - subroutine psb_s_linmap_sub(out_map,map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) - use psb_linmap_type_mod - implicit none - type(psb_slinmap_type), intent(out) :: out_map - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_s_sparse_mat), intent(in) :: map_X2Y, map_Y2X - integer, intent(in) :: map_kind - integer, intent(in), optional :: iaggr(:), naggr(:) - out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) - end subroutine psb_s_linmap_sub - - - subroutine psb_slinmap_transfer(mapin,mapout,info) - use psb_realloc_mod - use psb_descriptor_type - use psb_mat_mod, only : psb_move_alloc - implicit none - type(psb_slinmap_type) :: mapin,mapout - integer, intent(out) :: info - - call psb_move_alloc(mapin%itd_data,mapout%itd_data,info) - call psb_move_alloc(mapin%iaggr,mapout%iaggr,info) - call psb_move_alloc(mapin%naggr,mapout%naggr,info) - mapout%p_desc_X => mapin%p_desc_X - mapin%p_desc_X => null() - mapout%p_desc_Y => mapin%p_desc_Y - mapin%p_desc_Y => null() - call psb_move_alloc(mapin%desc_X,mapout%desc_X,info) - call psb_move_alloc(mapin%desc_Y,mapout%desc_Y,info) - call psb_move_alloc(mapin%map_X2Y,mapout%map_X2Y,info) - call psb_move_alloc(mapin%map_Y2X,mapout%map_Y2X,info) - - end subroutine psb_slinmap_transfer - - -end module psb_s_linmap_mod - -module psb_d_linmap_mod - - use psb_const_mod - use psb_linmap_type_mod - - - interface psb_map_X2Y - subroutine psb_d_map_X2Y(alpha,x,beta,y,map,info,work) - use psb_linmap_type_mod - implicit none - type(psb_dlinmap_type), intent(in) :: map - real(psb_dpk_), intent(in) :: alpha,beta - real(psb_dpk_), intent(inout) :: x(:) - real(psb_dpk_), intent(out) :: y(:) - integer, intent(out) :: info - real(psb_dpk_), optional :: work(:) - end subroutine psb_d_map_X2Y - end interface - - interface psb_map_Y2X - subroutine psb_d_map_Y2X(alpha,x,beta,y,map,info,work) - use psb_linmap_type_mod - implicit none - type(psb_dlinmap_type), intent(in) :: map - real(psb_dpk_), intent(in) :: alpha,beta - real(psb_dpk_), intent(inout) :: x(:) - real(psb_dpk_), intent(out) :: y(:) - integer, intent(out) :: info - real(psb_dpk_), optional :: work(:) - end subroutine psb_d_map_Y2X - end interface - - - interface psb_is_ok_map - module procedure psb_is_ok_dlinmap - end interface - - interface psb_get_map_kind - module procedure psb_get_dmap_kind - end interface - - interface psb_set_map_kind - module procedure psb_set_dmap_kind - end interface - - interface psb_is_asb_map - module procedure psb_is_asb_dlinmap - end interface - - interface psb_linmap_sub - module procedure psb_d_linmap_sub - end interface - - interface psb_move_alloc - module procedure psb_dlinmap_transfer - end interface - - interface psb_linmap - function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) - use psb_linmap_type_mod - implicit none - type(psb_dlinmap_type) :: psb_d_linmap - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_d_sparse_mat), intent(in) :: map_X2Y, map_Y2X - integer, intent(in) :: map_kind - integer, intent(in), optional :: iaggr(:), naggr(:) - end function psb_d_linmap - end interface - - interface psb_sizeof - module procedure psb_dlinmap_sizeof - end interface - -contains - - function psb_get_dmap_kind(map) - implicit none - type(psb_dlinmap_type), intent(in) :: map - Integer :: psb_get_dmap_kind - if (allocated(map%itd_data)) then - psb_get_dmap_kind = map%itd_data(psb_map_kind_) - else - psb_get_dmap_kind = -1 - end if - end function psb_get_dmap_kind - - - subroutine psb_set_dmap_kind(map_kind,map) - implicit none - integer, intent(in) :: map_kind - type(psb_dlinmap_type), intent(inout) :: map - - map%itd_data(psb_map_kind_) = map_kind - - end subroutine psb_set_dmap_kind - - function psb_is_asb_dlinmap(map) result(this) - use psb_descriptor_type - implicit none - type(psb_dlinmap_type), intent(in) :: map - logical :: this - - this = .false. - if (.not.allocated(map%itd_data)) return - select case(psb_get_map_kind(map)) - case (psb_map_aggr_) - if (.not.associated(map%p_desc_X)) return - if (.not.associated(map%p_desc_Y)) return - this = & - & psb_is_asb_desc(map%p_desc_X).and.psb_is_asb_desc(map%p_desc_Y) - - case(psb_map_gen_linear_) - - this = & - & psb_is_asb_desc(map%desc_X).and.psb_is_asb_desc(map%desc_Y) - - end select - - end function psb_is_asb_dlinmap - - function psb_is_ok_dlinmap(map) result(this) - use psb_descriptor_type - implicit none - type(psb_dlinmap_type), intent(in) :: map - logical :: this - this = .false. - if (.not.allocated(map%itd_data)) return - select case(psb_get_map_kind(map)) - case (psb_map_aggr_) - if (.not.associated(map%p_desc_X)) return - if (.not.associated(map%p_desc_Y)) return - this = & - & psb_is_ok_desc(map%p_desc_X).and.psb_is_ok_desc(map%p_desc_Y) - case(psb_map_gen_linear_) - this = & - & psb_is_ok_desc(map%desc_X).and.psb_is_ok_desc(map%desc_Y) - end select - - end function psb_is_ok_dlinmap - - function psb_dlinmap_sizeof(map) result(val) - use psb_descriptor_type - use psb_mat_mod, only : psb_sizeof - implicit none - type(psb_dlinmap_type), intent(in) :: map - integer(psb_long_int_k_) :: val - - val = 0 - if (allocated(map%itd_data)) & - & val = val + psb_sizeof_int*size(map%itd_data) - if (allocated(map%iaggr)) & - & val = val + psb_sizeof_int*size(map%iaggr) - if (allocated(map%naggr)) & - & val = val + psb_sizeof_int*size(map%naggr) - val = val + psb_sizeof(map%desc_X) - val = val + psb_sizeof(map%desc_Y) - val = val + psb_sizeof(map%map_X2Y) - val = val + psb_sizeof(map%map_Y2X) - - end function psb_dlinmap_sizeof - - subroutine psb_d_linmap_sub(out_map,map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) - use psb_linmap_type_mod - implicit none - type(psb_dlinmap_type), intent(out) :: out_map - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_d_sparse_mat), intent(in) :: map_X2Y, map_Y2X - integer, intent(in) :: map_kind - integer, intent(in), optional :: iaggr(:), naggr(:) - out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) - end subroutine psb_d_linmap_sub - - subroutine psb_dlinmap_transfer(mapin,mapout,info) - use psb_realloc_mod - use psb_descriptor_type - use psb_mat_mod, only : psb_move_alloc - implicit none - type(psb_dlinmap_type) :: mapin,mapout - integer, intent(out) :: info - - call psb_move_alloc(mapin%itd_data,mapout%itd_data,info) - call psb_move_alloc(mapin%iaggr,mapout%iaggr,info) - call psb_move_alloc(mapin%naggr,mapout%naggr,info) - mapout%p_desc_X => mapin%p_desc_X - mapin%p_desc_X => null() - mapout%p_desc_Y => mapin%p_desc_Y - mapin%p_desc_Y => null() - call psb_move_alloc(mapin%desc_X,mapout%desc_X,info) - call psb_move_alloc(mapin%desc_Y,mapout%desc_Y,info) - call psb_move_alloc(mapin%map_X2Y,mapout%map_X2Y,info) - call psb_move_alloc(mapin%map_Y2X,mapout%map_Y2X,info) - - end subroutine psb_dlinmap_transfer - -end module psb_d_linmap_mod - -module psb_c_linmap_mod - - use psb_const_mod - use psb_linmap_type_mod - - - interface psb_map_X2Y - subroutine psb_c_map_X2Y(alpha,x,beta,y,map,info,work) - use psb_linmap_type_mod - implicit none - type(psb_clinmap_type), intent(in) :: map - complex(psb_spk_), intent(in) :: alpha,beta - complex(psb_spk_), intent(inout) :: x(:) - complex(psb_spk_), intent(out) :: y(:) - integer, intent(out) :: info - complex(psb_spk_), optional :: work(:) - end subroutine psb_c_map_X2Y - end interface - - interface psb_map_Y2X - subroutine psb_c_map_Y2X(alpha,x,beta,y,map,info,work) - use psb_linmap_type_mod - implicit none - type(psb_clinmap_type), intent(in) :: map - complex(psb_spk_), intent(in) :: alpha,beta - complex(psb_spk_), intent(inout) :: x(:) - complex(psb_spk_), intent(out) :: y(:) - integer, intent(out) :: info - complex(psb_spk_), optional :: work(:) - end subroutine psb_c_map_Y2X - end interface - - - interface psb_is_ok_map - module procedure psb_is_ok_clinmap - end interface - - interface psb_get_map_kind - module procedure psb_get_cmap_kind - end interface - - interface psb_set_map_kind - module procedure psb_set_cmap_kind - end interface - - interface psb_is_asb_map - module procedure psb_is_asb_clinmap - end interface - - interface psb_linmap_sub - module procedure psb_c_linmap_sub - end interface - - interface psb_move_alloc - module procedure psb_clinmap_transfer - end interface - - interface psb_linmap - function psb_c_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) - use psb_linmap_type_mod - implicit none - type(psb_clinmap_type) :: psb_c_linmap - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_c_sparse_mat), intent(in) :: map_X2Y, map_Y2X - integer, intent(in) :: map_kind - integer, intent(in), optional :: iaggr(:), naggr(:) - end function psb_c_linmap - end interface - - interface psb_sizeof - module procedure psb_clinmap_sizeof - end interface - -contains - - function psb_get_cmap_kind(map) - implicit none - type(psb_clinmap_type), intent(in) :: map - Integer :: psb_get_cmap_kind - if (allocated(map%itd_data)) then - psb_get_cmap_kind = map%itd_data(psb_map_kind_) - else - psb_get_cmap_kind = -1 - end if - end function psb_get_cmap_kind - - subroutine psb_set_cmap_kind(map_kind,map) - implicit none - integer, intent(in) :: map_kind - type(psb_clinmap_type), intent(inout) :: map - - map%itd_data(psb_map_kind_) = map_kind - - end subroutine psb_set_cmap_kind - - function psb_is_asb_clinmap(map) result(this) - use psb_descriptor_type - implicit none - type(psb_clinmap_type), intent(in) :: map - logical :: this - - this = .false. - if (.not.allocated(map%itd_data)) return - select case(psb_get_map_kind(map)) - case (psb_map_aggr_) - if (.not.associated(map%p_desc_X)) return - if (.not.associated(map%p_desc_Y)) return - this = & - & psb_is_asb_desc(map%p_desc_X).and.psb_is_asb_desc(map%p_desc_Y) - - case(psb_map_gen_linear_) - - this = & - & psb_is_asb_desc(map%desc_X).and.psb_is_asb_desc(map%desc_Y) - - end select - - end function psb_is_asb_clinmap - - function psb_is_ok_clinmap(map) result(this) - use psb_descriptor_type - implicit none - type(psb_clinmap_type), intent(in) :: map - logical :: this - this = .false. - if (.not.allocated(map%itd_data)) return - select case(psb_get_map_kind(map)) - case (psb_map_aggr_) - if (.not.associated(map%p_desc_X)) return - if (.not.associated(map%p_desc_Y)) return - this = & - & psb_is_ok_desc(map%p_desc_X).and.psb_is_ok_desc(map%p_desc_Y) - case(psb_map_gen_linear_) - this = & - & psb_is_ok_desc(map%desc_X).and.psb_is_ok_desc(map%desc_Y) - end select - - end function psb_is_ok_clinmap - - function psb_clinmap_sizeof(map) result(val) - use psb_descriptor_type - use psb_mat_mod, only : psb_sizeof - implicit none - type(psb_clinmap_type), intent(in) :: map - integer(psb_long_int_k_) :: val - - val = 0 - if (allocated(map%itd_data)) & - & val = val + psb_sizeof_int*size(map%itd_data) - if (allocated(map%iaggr)) & - & val = val + psb_sizeof_int*size(map%iaggr) - if (allocated(map%naggr)) & - & val = val + psb_sizeof_int*size(map%naggr) - val = val + psb_sizeof(map%desc_X) - val = val + psb_sizeof(map%desc_Y) - val = val + psb_sizeof(map%map_X2Y) - val = val + psb_sizeof(map%map_Y2X) - - end function psb_clinmap_sizeof - - subroutine psb_c_linmap_sub(out_map,map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) - use psb_linmap_type_mod - implicit none - type(psb_clinmap_type), intent(out) :: out_map - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_c_sparse_mat), intent(in) :: map_X2Y, map_Y2X - integer, intent(in) :: map_kind - integer, intent(in), optional :: iaggr(:), naggr(:) - out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) - end subroutine psb_c_linmap_sub - - subroutine psb_clinmap_transfer(mapin,mapout,info) - use psb_realloc_mod - use psb_mat_mod, only : psb_move_alloc - use psb_descriptor_type - implicit none - type(psb_clinmap_type) :: mapin,mapout - integer, intent(out) :: info - - call psb_move_alloc(mapin%itd_data,mapout%itd_data,info) - call psb_move_alloc(mapin%iaggr,mapout%iaggr,info) - call psb_move_alloc(mapin%naggr,mapout%naggr,info) - mapout%p_desc_X => mapin%p_desc_X - mapin%p_desc_X => null() - mapout%p_desc_Y => mapin%p_desc_Y - mapin%p_desc_Y => null() - call psb_move_alloc(mapin%desc_X,mapout%desc_X,info) - call psb_move_alloc(mapin%desc_Y,mapout%desc_Y,info) - call psb_move_alloc(mapin%map_X2Y,mapout%map_X2Y,info) - call psb_move_alloc(mapin%map_Y2X,mapout%map_Y2X,info) - - end subroutine psb_clinmap_transfer - -end module psb_c_linmap_mod - -module psb_z_linmap_mod - - use psb_const_mod - use psb_linmap_type_mod - - - interface psb_map_X2Y - subroutine psb_z_map_X2Y(alpha,x,beta,y,map,info,work) - use psb_linmap_type_mod - implicit none - type(psb_zlinmap_type), intent(in) :: map - complex(psb_dpk_), intent(in) :: alpha,beta - complex(psb_dpk_), intent(inout) :: x(:) - complex(psb_dpk_), intent(out) :: y(:) - integer, intent(out) :: info - complex(psb_dpk_), optional :: work(:) - end subroutine psb_z_map_X2Y - end interface - - interface psb_map_Y2X - subroutine psb_z_map_Y2X(alpha,x,beta,y,map,info,work) - use psb_linmap_type_mod - implicit none - type(psb_zlinmap_type), intent(in) :: map - complex(psb_dpk_), intent(in) :: alpha,beta - complex(psb_dpk_), intent(inout) :: x(:) - complex(psb_dpk_), intent(out) :: y(:) - integer, intent(out) :: info - complex(psb_dpk_), optional :: work(:) - end subroutine psb_z_map_Y2X - end interface - - - interface psb_is_ok_map - module procedure psb_is_ok_zlinmap - end interface - - interface psb_get_map_kind - module procedure psb_get_zmap_kind - end interface - - interface psb_set_map_kind - module procedure psb_set_zmap_kind - end interface - - interface psb_is_asb_map - module procedure psb_is_asb_zlinmap - end interface - - interface psb_linmap_sub - module procedure psb_z_linmap_sub - end interface - - interface psb_move_alloc - module procedure psb_zlinmap_transfer - end interface - - interface psb_linmap - function psb_z_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) - use psb_linmap_type_mod - implicit none - type(psb_zlinmap_type) :: psb_z_linmap - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_z_sparse_mat), intent(in) :: map_X2Y, map_Y2X - integer, intent(in) :: map_kind - integer, intent(in), optional :: iaggr(:), naggr(:) - end function psb_z_linmap - end interface - - interface psb_sizeof - module procedure psb_zlinmap_sizeof - end interface - -contains - - function psb_get_zmap_kind(map) - implicit none - type(psb_zlinmap_type), intent(in) :: map - Integer :: psb_get_zmap_kind - if (allocated(map%itd_data)) then - psb_get_zmap_kind = map%itd_data(psb_map_kind_) - else - psb_get_zmap_kind = -1 - end if - end function psb_get_zmap_kind - - subroutine psb_set_zmap_kind(map_kind,map) - implicit none - integer, intent(in) :: map_kind - type(psb_zlinmap_type), intent(inout) :: map - - map%itd_data(psb_map_kind_) = map_kind - - end subroutine psb_set_zmap_kind - - function psb_is_asb_zlinmap(map) result(this) - use psb_descriptor_type - implicit none - type(psb_zlinmap_type), intent(in) :: map - logical :: this - - this = .false. - if (.not.allocated(map%itd_data)) return - select case(psb_get_map_kind(map)) - case (psb_map_aggr_) - if (.not.associated(map%p_desc_X)) return - if (.not.associated(map%p_desc_Y)) return - this = & - & psb_is_asb_desc(map%p_desc_X).and.psb_is_asb_desc(map%p_desc_Y) - - case(psb_map_gen_linear_) - - this = & - & psb_is_asb_desc(map%desc_X).and.psb_is_asb_desc(map%desc_Y) - - end select - - end function psb_is_asb_zlinmap - - function psb_is_ok_zlinmap(map) result(this) - use psb_descriptor_type - implicit none - type(psb_zlinmap_type), intent(in) :: map - logical :: this - this = .false. - if (.not.allocated(map%itd_data)) return - select case(psb_get_map_kind(map)) - case (psb_map_aggr_) - if (.not.associated(map%p_desc_X)) return - if (.not.associated(map%p_desc_Y)) return - this = & - & psb_is_ok_desc(map%p_desc_X).and.psb_is_ok_desc(map%p_desc_Y) - case(psb_map_gen_linear_) - this = & - & psb_is_ok_desc(map%desc_X).and.psb_is_ok_desc(map%desc_Y) - end select - - end function psb_is_ok_zlinmap - - function psb_zlinmap_sizeof(map) result(val) - use psb_mat_mod, only : psb_sizeof - use psb_descriptor_type - implicit none - type(psb_zlinmap_type), intent(in) :: map - integer(psb_long_int_k_) :: val - - val = 0 - if (allocated(map%itd_data)) & - & val = val + psb_sizeof_int*size(map%itd_data) - if (allocated(map%iaggr)) & - & val = val + psb_sizeof_int*size(map%iaggr) - if (allocated(map%naggr)) & - & val = val + psb_sizeof_int*size(map%naggr) - val = val + psb_sizeof(map%desc_X) - val = val + psb_sizeof(map%desc_Y) - val = val + psb_sizeof(map%map_X2Y) - val = val + psb_sizeof(map%map_Y2X) - - end function psb_zlinmap_sizeof - - subroutine psb_z_linmap_sub(out_map,map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) - use psb_linmap_type_mod - implicit none - type(psb_zlinmap_type), intent(out) :: out_map - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_z_sparse_mat), intent(in) :: map_X2Y, map_Y2X - integer, intent(in) :: map_kind - integer, intent(in), optional :: iaggr(:), naggr(:) - out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) - end subroutine psb_z_linmap_sub - - subroutine psb_zlinmap_transfer(mapin,mapout,info) - use psb_realloc_mod - use psb_mat_mod, only : psb_move_alloc - use psb_descriptor_type - implicit none - type(psb_zlinmap_type) :: mapin,mapout - integer, intent(out) :: info - - call psb_move_alloc(mapin%itd_data,mapout%itd_data,info) - call psb_move_alloc(mapin%iaggr,mapout%iaggr,info) - call psb_move_alloc(mapin%naggr,mapout%naggr,info) - mapout%p_desc_X => mapin%p_desc_X - mapin%p_desc_X => null() - mapout%p_desc_Y => mapin%p_desc_Y - mapin%p_desc_Y => null() - call psb_move_alloc(mapin%desc_X,mapout%desc_X,info) - call psb_move_alloc(mapin%desc_Y,mapout%desc_Y,info) - call psb_move_alloc(mapin%map_X2Y,mapout%map_X2Y,info) - call psb_move_alloc(mapin%map_Y2X,mapout%map_Y2X,info) - - end subroutine psb_zlinmap_transfer - - -end module psb_z_linmap_mod - module psb_linmap_mod use psb_const_mod diff --git a/base/modules/psb_s_linmap_mod.f90 b/base/modules/psb_s_linmap_mod.f90 new file mode 100644 index 00000000..4fb69140 --- /dev/null +++ b/base/modules/psb_s_linmap_mod.f90 @@ -0,0 +1,236 @@ +!!$ +!!$ Parallel Sparse BLAS version 2.2 +!!$ (C) Copyright 2006/2007/2008 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ 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. +!!$ +!!$ +! +! +! package: psb_linmap_mod +! Defines facilities for mapping between vectors belonging +! to different spaces. +! +module psb_s_linmap_mod + + use psb_const_mod + use psb_linmap_type_mod + + + interface psb_map_X2Y + subroutine psb_s_map_X2Y(alpha,x,beta,y,map,info,work) + use psb_linmap_type_mod + implicit none + type(psb_slinmap_type), intent(in) :: map + real(psb_spk_), intent(in) :: alpha,beta + real(psb_spk_), intent(inout) :: x(:) + real(psb_spk_), intent(out) :: y(:) + integer, intent(out) :: info + real(psb_spk_), optional :: work(:) + end subroutine psb_s_map_X2Y + end interface + + interface psb_map_Y2X + subroutine psb_s_map_Y2X(alpha,x,beta,y,map,info,work) + use psb_linmap_type_mod + implicit none + type(psb_slinmap_type), intent(in) :: map + real(psb_spk_), intent(in) :: alpha,beta + real(psb_spk_), intent(inout) :: x(:) + real(psb_spk_), intent(out) :: y(:) + integer, intent(out) :: info + real(psb_spk_), optional :: work(:) + end subroutine psb_s_map_Y2X + end interface + + + interface psb_is_ok_map + module procedure psb_is_ok_slinmap + end interface + + interface psb_get_map_kind + module procedure psb_get_smap_kind + end interface + + interface psb_set_map_kind + module procedure psb_set_smap_kind + end interface + + interface psb_is_asb_map + module procedure psb_is_asb_slinmap + end interface + + interface psb_linmap_sub + module procedure psb_s_linmap_sub + end interface + + interface psb_move_alloc + module procedure psb_slinmap_transfer + end interface + + interface psb_linmap + function psb_s_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) + use psb_linmap_type_mod + implicit none + type(psb_slinmap_type) :: psb_s_linmap + type(psb_desc_type), target :: desc_X, desc_Y + type(psb_s_sparse_mat), intent(in) :: map_X2Y, map_Y2X + integer, intent(in) :: map_kind + integer, intent(in), optional :: iaggr(:), naggr(:) + end function psb_s_linmap + end interface + + interface psb_sizeof + module procedure psb_slinmap_sizeof + end interface + +contains + + function psb_get_smap_kind(map) + implicit none + type(psb_slinmap_type), intent(in) :: map + Integer :: psb_get_smap_kind + if (allocated(map%itd_data)) then + psb_get_smap_kind = map%itd_data(psb_map_kind_) + else + psb_get_smap_kind = -1 + end if + end function psb_get_smap_kind + + + subroutine psb_set_smap_kind(map_kind,map) + implicit none + integer, intent(in) :: map_kind + type(psb_slinmap_type), intent(inout) :: map + + map%itd_data(psb_map_kind_) = map_kind + + end subroutine psb_set_smap_kind + + + function psb_is_asb_slinmap(map) result(this) + use psb_descriptor_type + implicit none + type(psb_slinmap_type), intent(in) :: map + logical :: this + + this = .false. + if (.not.allocated(map%itd_data)) return + select case(psb_get_map_kind(map)) + case (psb_map_aggr_) + if (.not.associated(map%p_desc_X)) return + if (.not.associated(map%p_desc_Y)) return + this = & + & psb_is_asb_desc(map%p_desc_X).and.psb_is_asb_desc(map%p_desc_Y) + + case(psb_map_gen_linear_) + + this = & + & psb_is_asb_desc(map%desc_X).and.psb_is_asb_desc(map%desc_Y) + + end select + + end function psb_is_asb_slinmap + + function psb_is_ok_slinmap(map) result(this) + use psb_descriptor_type + implicit none + type(psb_slinmap_type), intent(in) :: map + logical :: this + this = .false. + if (.not.allocated(map%itd_data)) return + select case(psb_get_map_kind(map)) + case (psb_map_aggr_) + if (.not.associated(map%p_desc_X)) return + if (.not.associated(map%p_desc_Y)) return + this = & + & psb_is_ok_desc(map%p_desc_X).and.psb_is_ok_desc(map%p_desc_Y) + case(psb_map_gen_linear_) + this = & + & psb_is_ok_desc(map%desc_X).and.psb_is_ok_desc(map%desc_Y) + end select + + end function psb_is_ok_slinmap + + function psb_slinmap_sizeof(map) result(val) + use psb_descriptor_type + use psb_mat_mod, only : psb_sizeof + implicit none + type(psb_slinmap_type), intent(in) :: map + integer(psb_long_int_k_) :: val + + val = 0 + if (allocated(map%itd_data)) & + & val = val + psb_sizeof_int*size(map%itd_data) + if (allocated(map%iaggr)) & + & val = val + psb_sizeof_int*size(map%iaggr) + if (allocated(map%naggr)) & + & val = val + psb_sizeof_int*size(map%naggr) + val = val + psb_sizeof(map%desc_X) + val = val + psb_sizeof(map%desc_Y) + val = val + psb_sizeof(map%map_X2Y) + val = val + psb_sizeof(map%map_Y2X) + + end function psb_slinmap_sizeof + + + subroutine psb_s_linmap_sub(out_map,map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) + use psb_linmap_type_mod + implicit none + type(psb_slinmap_type), intent(out) :: out_map + type(psb_desc_type), target :: desc_X, desc_Y + type(psb_s_sparse_mat), intent(in) :: map_X2Y, map_Y2X + integer, intent(in) :: map_kind + integer, intent(in), optional :: iaggr(:), naggr(:) + out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) + end subroutine psb_s_linmap_sub + + + subroutine psb_slinmap_transfer(mapin,mapout,info) + use psb_realloc_mod + use psb_descriptor_type + use psb_mat_mod, only : psb_move_alloc + implicit none + type(psb_slinmap_type) :: mapin,mapout + integer, intent(out) :: info + + call psb_move_alloc(mapin%itd_data,mapout%itd_data,info) + call psb_move_alloc(mapin%iaggr,mapout%iaggr,info) + call psb_move_alloc(mapin%naggr,mapout%naggr,info) + mapout%p_desc_X => mapin%p_desc_X + mapin%p_desc_X => null() + mapout%p_desc_Y => mapin%p_desc_Y + mapin%p_desc_Y => null() + call psb_move_alloc(mapin%desc_X,mapout%desc_X,info) + call psb_move_alloc(mapin%desc_Y,mapout%desc_Y,info) + call psb_move_alloc(mapin%map_X2Y,mapout%map_X2Y,info) + call psb_move_alloc(mapin%map_Y2X,mapout%map_Y2X,info) + + end subroutine psb_slinmap_transfer + + +end module psb_s_linmap_mod diff --git a/base/modules/psb_z_linmap_mod.f90 b/base/modules/psb_z_linmap_mod.f90 new file mode 100644 index 00000000..214497bf --- /dev/null +++ b/base/modules/psb_z_linmap_mod.f90 @@ -0,0 +1,233 @@ +!!$ +!!$ Parallel Sparse BLAS version 2.2 +!!$ (C) Copyright 2006/2007/2008 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ 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. +!!$ +!!$ +! +! +! package: psb_linmap_mod +! Defines facilities for mapping between vectors belonging +! to different spaces. +! + +module psb_z_linmap_mod + + use psb_const_mod + use psb_linmap_type_mod + + + interface psb_map_X2Y + subroutine psb_z_map_X2Y(alpha,x,beta,y,map,info,work) + use psb_linmap_type_mod + implicit none + type(psb_zlinmap_type), intent(in) :: map + complex(psb_dpk_), intent(in) :: alpha,beta + complex(psb_dpk_), intent(inout) :: x(:) + complex(psb_dpk_), intent(out) :: y(:) + integer, intent(out) :: info + complex(psb_dpk_), optional :: work(:) + end subroutine psb_z_map_X2Y + end interface + + interface psb_map_Y2X + subroutine psb_z_map_Y2X(alpha,x,beta,y,map,info,work) + use psb_linmap_type_mod + implicit none + type(psb_zlinmap_type), intent(in) :: map + complex(psb_dpk_), intent(in) :: alpha,beta + complex(psb_dpk_), intent(inout) :: x(:) + complex(psb_dpk_), intent(out) :: y(:) + integer, intent(out) :: info + complex(psb_dpk_), optional :: work(:) + end subroutine psb_z_map_Y2X + end interface + + + interface psb_is_ok_map + module procedure psb_is_ok_zlinmap + end interface + + interface psb_get_map_kind + module procedure psb_get_zmap_kind + end interface + + interface psb_set_map_kind + module procedure psb_set_zmap_kind + end interface + + interface psb_is_asb_map + module procedure psb_is_asb_zlinmap + end interface + + interface psb_linmap_sub + module procedure psb_z_linmap_sub + end interface + + interface psb_move_alloc + module procedure psb_zlinmap_transfer + end interface + + interface psb_linmap + function psb_z_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) + use psb_linmap_type_mod + implicit none + type(psb_zlinmap_type) :: psb_z_linmap + type(psb_desc_type), target :: desc_X, desc_Y + type(psb_z_sparse_mat), intent(in) :: map_X2Y, map_Y2X + integer, intent(in) :: map_kind + integer, intent(in), optional :: iaggr(:), naggr(:) + end function psb_z_linmap + end interface + + interface psb_sizeof + module procedure psb_zlinmap_sizeof + end interface + +contains + + function psb_get_zmap_kind(map) + implicit none + type(psb_zlinmap_type), intent(in) :: map + Integer :: psb_get_zmap_kind + if (allocated(map%itd_data)) then + psb_get_zmap_kind = map%itd_data(psb_map_kind_) + else + psb_get_zmap_kind = -1 + end if + end function psb_get_zmap_kind + + subroutine psb_set_zmap_kind(map_kind,map) + implicit none + integer, intent(in) :: map_kind + type(psb_zlinmap_type), intent(inout) :: map + + map%itd_data(psb_map_kind_) = map_kind + + end subroutine psb_set_zmap_kind + + function psb_is_asb_zlinmap(map) result(this) + use psb_descriptor_type + implicit none + type(psb_zlinmap_type), intent(in) :: map + logical :: this + + this = .false. + if (.not.allocated(map%itd_data)) return + select case(psb_get_map_kind(map)) + case (psb_map_aggr_) + if (.not.associated(map%p_desc_X)) return + if (.not.associated(map%p_desc_Y)) return + this = & + & psb_is_asb_desc(map%p_desc_X).and.psb_is_asb_desc(map%p_desc_Y) + + case(psb_map_gen_linear_) + + this = & + & psb_is_asb_desc(map%desc_X).and.psb_is_asb_desc(map%desc_Y) + + end select + + end function psb_is_asb_zlinmap + + function psb_is_ok_zlinmap(map) result(this) + use psb_descriptor_type + implicit none + type(psb_zlinmap_type), intent(in) :: map + logical :: this + this = .false. + if (.not.allocated(map%itd_data)) return + select case(psb_get_map_kind(map)) + case (psb_map_aggr_) + if (.not.associated(map%p_desc_X)) return + if (.not.associated(map%p_desc_Y)) return + this = & + & psb_is_ok_desc(map%p_desc_X).and.psb_is_ok_desc(map%p_desc_Y) + case(psb_map_gen_linear_) + this = & + & psb_is_ok_desc(map%desc_X).and.psb_is_ok_desc(map%desc_Y) + end select + + end function psb_is_ok_zlinmap + + function psb_zlinmap_sizeof(map) result(val) + use psb_mat_mod, only : psb_sizeof + use psb_descriptor_type + implicit none + type(psb_zlinmap_type), intent(in) :: map + integer(psb_long_int_k_) :: val + + val = 0 + if (allocated(map%itd_data)) & + & val = val + psb_sizeof_int*size(map%itd_data) + if (allocated(map%iaggr)) & + & val = val + psb_sizeof_int*size(map%iaggr) + if (allocated(map%naggr)) & + & val = val + psb_sizeof_int*size(map%naggr) + val = val + psb_sizeof(map%desc_X) + val = val + psb_sizeof(map%desc_Y) + val = val + psb_sizeof(map%map_X2Y) + val = val + psb_sizeof(map%map_Y2X) + + end function psb_zlinmap_sizeof + + subroutine psb_z_linmap_sub(out_map,map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) + use psb_linmap_type_mod + implicit none + type(psb_zlinmap_type), intent(out) :: out_map + type(psb_desc_type), target :: desc_X, desc_Y + type(psb_z_sparse_mat), intent(in) :: map_X2Y, map_Y2X + integer, intent(in) :: map_kind + integer, intent(in), optional :: iaggr(:), naggr(:) + out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) + end subroutine psb_z_linmap_sub + + subroutine psb_zlinmap_transfer(mapin,mapout,info) + use psb_realloc_mod + use psb_mat_mod, only : psb_move_alloc + use psb_descriptor_type + implicit none + type(psb_zlinmap_type) :: mapin,mapout + integer, intent(out) :: info + + call psb_move_alloc(mapin%itd_data,mapout%itd_data,info) + call psb_move_alloc(mapin%iaggr,mapout%iaggr,info) + call psb_move_alloc(mapin%naggr,mapout%naggr,info) + mapout%p_desc_X => mapin%p_desc_X + mapin%p_desc_X => null() + mapout%p_desc_Y => mapin%p_desc_Y + mapin%p_desc_Y => null() + call psb_move_alloc(mapin%desc_X,mapout%desc_X,info) + call psb_move_alloc(mapin%desc_Y,mapout%desc_Y,info) + call psb_move_alloc(mapin%map_X2Y,mapout%map_X2Y,info) + call psb_move_alloc(mapin%map_Y2X,mapout%map_Y2X,info) + + end subroutine psb_zlinmap_transfer + + +end module psb_z_linmap_mod diff --git a/base/serial/f03/psb_d_csr_impl.f03 b/base/serial/f03/psb_d_csr_impl.f03 index caad45b0..2b1e94c8 100644 --- a/base/serial/f03/psb_d_csr_impl.f03 +++ b/base/serial/f03/psb_d_csr_impl.f03 @@ -2444,8 +2444,6 @@ subroutine psb_d_cp_csr_from_coo(a,b,info) info = psb_success_ ! This is to have fix_coo called behind the scenes - write(0,*) 'In cp_from_coo: ',allocated(a%irp),allocated(a%ja),allocated(a%val) - call tmp%cp_from_coo(b,info) if (info == psb_success_) call a%mv_from_coo(tmp,info) @@ -2558,21 +2556,15 @@ subroutine psb_d_mv_csr_from_coo(a,b,info) character(len=20) :: name info = psb_success_ - write(0,*) 'In mv_from_coo 1 : ',allocated(a%irp),allocated(a%ja),allocated(a%val) call b%fix(info) if (info /= psb_success_) return - write(0,*) 'In mv_from_coo 2 : ',allocated(a%irp),allocated(a%ja),allocated(a%val) nr = b%get_nrows() nc = b%get_ncols() nza = b%get_nzeros() - write(0,*) 'In mv_from_coo 3 : ',allocated(a%irp),allocated(a%ja),allocated(a%val) call a%psb_d_base_sparse_mat%mv_from(b%psb_d_base_sparse_mat) - write(0,*) 'In mv_from_coo 4 : ',allocated(a%irp),allocated(a%ja),allocated(a%val) + ! Dirty trick: call move_alloc to have the new data allocated just once. - write(psb_err_unit,*) 'itemp ',allocated(itemp),& - & ' a%ja ', allocated(a%ja),& - & ' a%val ', allocated(a%val) call move_alloc(b%ia,itemp) call move_alloc(b%ja,a%ja) call move_alloc(b%val,a%val) @@ -2773,7 +2765,6 @@ subroutine psb_d_cp_csr_from_fmt(a,b,info) info = psb_success_ - write(0,*) 'In cp_from_fmt: ',allocated(a%irp),allocated(a%ja),allocated(a%val) select type (b) type is (psb_d_coo_sparse_mat) call a%cp_from_coo(b,info) diff --git a/test/serial/Makefile b/test/serial/Makefile index f1faa379..d9d9eff5 100644 --- a/test/serial/Makefile +++ b/test/serial/Makefile @@ -19,28 +19,18 @@ all: d_coo_matgen d_matgen d_coo_matgen: d_coo_matgen.o $(F90LINK) $(LINKOPT) d_coo_matgen.o -o d_coo_matgen $(PSBLAS_LIB) $(LDLIBS) /bin/mv d_coo_matgen $(EXEDIR) +psb_d_cxx_impl.o d_matgen.o: psb_d_cxx_mat_mod.o d_matgen: d_matgen.o psb_d_cxx_mat_mod.o psb_d_cxx_impl.o $(F90LINK) $(LINKOPT) d_matgen.o psb_d_cxx_mat_mod.o psb_d_cxx_impl.o -o d_matgen $(PSBLAS_LIB) $(LDLIBS) /bin/mv d_matgen $(EXEDIR) -d_matgen.o: psb_d_cxx_mat_mod.o - -#ppde spde - -ppde: ppde.o - $(F90LINK) ppde.o -o ppde $(PSBLAS_LIB) $(LDLIBS) - /bin/mv ppde $(EXEDIR) - -spde: spde.o - $(F90LINK) spde.o -o spde $(PSBLAS_LIB) $(LDLIBS) - /bin/mv spde $(EXEDIR) .f90.o: $(MPF90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $< clean: - /bin/rm -f d_coo_matgen.o d_matgen.o tpg.o ppde.o spde.o \ - psb_d_cxx_mat_mod.o psb_d_cxx_impl.o *$(.mod) $(EXEDIR)/ppde + /bin/rm -f d_coo_matgen.o d_matgen.o \ + psb_d_cxx_mat_mod.o psb_d_cxx_impl.o *$(.mod) verycleanlib: (cd ../..; make veryclean) lib: diff --git a/test/serial/d_matgen.f03 b/test/serial/d_matgen.f03 index f431fbe4..85d33b95 100644 --- a/test/serial/d_matgen.f03 +++ b/test/serial/d_matgen.f03 @@ -212,7 +212,6 @@ contains goto 9999 end if - write(0,*) 'After allocate ',a_n%is_null() ! we build an auxiliary matrix consisting of one row at a ! time; just a small matrix. might be extended to generate @@ -370,7 +369,6 @@ contains call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - write(0,*) 'After insert ',a_n%is_null() !!$ call a_n%print(19) t1 = psb_wtime() call a_n%cscnv(info,mold=acsr)