fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
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.
psblas3-type-indexed
Salvatore Filippone 15 years ago
parent 8e68c312ff
commit 50f77c9095
11 changed files with 952 additions and 829 deletions
Show Stats Download Patch File Download Diff File

4
Changelog
Unescape Escape View File

@ -1,6 +1,8 @@
Changelog. A lot less detailed than usual, at least for past Changelog. A lot less detailed than usual, at least for past
history. 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/05/10: Fixed fakempi. Now works under XLF 13.1
2010/04/29: Restructure KRYLOV modules. 2010/04/29: Restructure KRYLOV modules.

7
base/modules/Makefile
Unescape Escape View File

@ -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_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 \ 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 \ 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_s_psblas_mod.o psb_c_psblas_mod.o \
psb_d_psblas_mod.o psb_z_psblas_mod.o psb_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\ 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_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 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_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_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_comm_mod.o: psb_desc_type.o psb_mat_mod.o
psb_check_mod.o: psb_desc_type.o psb_check_mod.o: psb_desc_type.o

21
base/modules/psb_base_mat_mod.f03
Unescape Escape View File

@ -2,16 +2,15 @@ module psb_base_mat_mod
use psb_const_mod use psb_const_mod
use psi_serial_mod use psi_serial_mod
integer, parameter, private :: auxsz=32
type :: psb_base_sparse_mat type :: psb_base_sparse_mat
integer, private :: m, n integer, private :: m, n
integer, private :: state, duplicate integer, private :: state, duplicate
logical, private :: triangle, unitd, upper, sorted logical, private :: triangle, unitd, upper, sorted
! This is a different animal: it's a kitchen sink for ! This is a different animal: it's a kitchen sink for
! any additional parameters that may be needed ! any additional parameters that may be needed
! when converting to/from COO. Why here? ! when converting to/from COO.
! Will tell you one day... integer :: aux(auxsz)
integer, allocatable :: aux(:)
contains contains
! == = ================================= ! == = =================================
@ -253,7 +252,7 @@ contains
subroutine psb_base_get_aux(v,a) subroutine psb_base_get_aux(v,a)
implicit none implicit none
class(psb_base_sparse_mat), intent(in) :: a class(psb_base_sparse_mat), intent(in) :: a
integer, intent(out), allocatable :: v(:) integer, intent(out), allocatable :: v(:)
! TBD ! TBD
write(psb_err_unit,*) 'GET_AUX is empty right now ' write(psb_err_unit,*) 'GET_AUX is empty right now '
end subroutine psb_base_get_aux end subroutine psb_base_get_aux
@ -453,7 +452,7 @@ contains
a%unitd = b%unitd a%unitd = b%unitd
a%upper = b%upper a%upper = b%upper
a%sorted = b%sorted a%sorted = b%sorted
call move_alloc(b%aux,a%aux) a%aux = b%aux
end subroutine psb_base_mv_from end subroutine psb_base_mv_from
@ -471,10 +470,7 @@ contains
a%unitd = b%unitd a%unitd = b%unitd
a%upper = b%upper a%upper = b%upper
a%sorted = b%sorted a%sorted = b%sorted
if (allocated(b%aux)) then a%aux(:) = b%aux(:)
allocate(a%aux(size(b%aux)))
a%aux(:) = b%aux(:)
end if
end subroutine psb_base_cp_from end subroutine psb_base_cp_from
@ -492,10 +488,7 @@ contains
a%unitd = b%unitd a%unitd = b%unitd
a%upper = .not.b%upper a%upper = .not.b%upper
a%sorted = .false. a%sorted = .false.
if (allocated(b%aux)) then a%aux(:) = b%aux(:)
allocate(a%aux(size(b%aux)))
a%aux(:) = b%aux(:)
end if
end subroutine psb_base_transp_2mat end subroutine psb_base_transp_2mat

232
base/modules/psb_c_linmap_mod.f90
Unescape Escape View File

@ -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

232
base/modules/psb_d_linmap_mod.f90
Unescape Escape View File

@ -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

787
base/modules/psb_linmap_mod.f90
Unescape Escape View File

@ -35,793 +35,6 @@
! Defines facilities for mapping between vectors belonging ! Defines facilities for mapping between vectors belonging
! to different spaces. ! 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 module psb_linmap_mod
use psb_const_mod use psb_const_mod

236
base/modules/psb_s_linmap_mod.f90
Unescape Escape View File

@ -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

233
base/modules/psb_z_linmap_mod.f90
Unescape Escape View File

@ -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

11
base/serial/f03/psb_d_csr_impl.f03
Unescape Escape View File

@ -2444,8 +2444,6 @@ subroutine psb_d_cp_csr_from_coo(a,b,info)
info = psb_success_ info = psb_success_
! This is to have fix_coo called behind the scenes ! 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) call tmp%cp_from_coo(b,info)
if (info == psb_success_) call a%mv_from_coo(tmp,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 character(len=20) :: name
info = psb_success_ info = psb_success_
write(0,*) 'In mv_from_coo 1 : ',allocated(a%irp),allocated(a%ja),allocated(a%val)
call b%fix(info) call b%fix(info)
if (info /= psb_success_) return 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() nr = b%get_nrows()
nc = b%get_ncols() nc = b%get_ncols()
nza = b%get_nzeros() 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) 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. ! 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%ia,itemp)
call move_alloc(b%ja,a%ja) call move_alloc(b%ja,a%ja)
call move_alloc(b%val,a%val) call move_alloc(b%val,a%val)
@ -2773,7 +2765,6 @@ subroutine psb_d_cp_csr_from_fmt(a,b,info)
info = psb_success_ info = psb_success_
write(0,*) 'In cp_from_fmt: ',allocated(a%irp),allocated(a%ja),allocated(a%val)
select type (b) select type (b)
type is (psb_d_coo_sparse_mat) type is (psb_d_coo_sparse_mat)
call a%cp_from_coo(b,info) call a%cp_from_coo(b,info)

16
test/serial/Makefile
Unescape Escape View File

@ -19,28 +19,18 @@ all: d_coo_matgen d_matgen
d_coo_matgen: d_coo_matgen.o d_coo_matgen: d_coo_matgen.o
$(F90LINK) $(LINKOPT) d_coo_matgen.o -o d_coo_matgen $(PSBLAS_LIB) $(LDLIBS) $(F90LINK) $(LINKOPT) d_coo_matgen.o -o d_coo_matgen $(PSBLAS_LIB) $(LDLIBS)
/bin/mv d_coo_matgen $(EXEDIR) /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 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) $(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) /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: .f90.o:
$(MPF90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $< $(MPF90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $<
clean: clean:
/bin/rm -f d_coo_matgen.o d_matgen.o tpg.o ppde.o spde.o \ /bin/rm -f d_coo_matgen.o d_matgen.o \
psb_d_cxx_mat_mod.o psb_d_cxx_impl.o *$(.mod) $(EXEDIR)/ppde psb_d_cxx_mat_mod.o psb_d_cxx_impl.o *$(.mod)
verycleanlib: verycleanlib:
(cd ../..; make veryclean) (cd ../..; make veryclean)
lib: lib:

2
test/serial/d_matgen.f03
Unescape Escape View File

@ -212,7 +212,6 @@ contains
goto 9999 goto 9999
end if end if
write(0,*) 'After allocate ',a_n%is_null()
! we build an auxiliary matrix consisting of one row at a ! we build an auxiliary matrix consisting of one row at a
! time; just a small matrix. might be extended to generate ! time; just a small matrix. might be extended to generate
@ -370,7 +369,6 @@ contains
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
write(0,*) 'After insert ',a_n%is_null()
!!$ call a_n%print(19) !!$ call a_n%print(19)
t1 = psb_wtime() t1 = psb_wtime()
call a_n%cscnv(info,mold=acsr) call a_n%cscnv(info,mold=acsr)

Write Preview
Loading…
Cancel
Save