base/modules/Makefile
 base/modules/psb_base_mat_mod.f03
 base/modules/psb_c_base_mat_mod.f03
 base/modules/psb_c_csc_mat_mod.f03
 base/modules/psb_c_csr_mat_mod.f03
 base/modules/psb_c_mat_mod.f03
 base/modules/psb_d_base_mat_mod.f03
 base/modules/psb_d_csc_mat_mod.f03
 base/modules/psb_d_csr_mat_mod.f03
 base/modules/psb_d_mat_mod.f03
 base/modules/psb_s_base_mat_mod.f03
 base/modules/psb_s_csc_mat_mod.f03
 base/modules/psb_s_csr_mat_mod.f03
 base/modules/psb_s_mat_mod.f03
 base/modules/psb_sort_mod.f90
 base/modules/psb_z_base_mat_mod.f03
 base/modules/psb_z_csc_mat_mod.f03
 base/modules/psb_z_csr_mat_mod.f03
 base/modules/psb_z_mat_mod.f03
 base/modules/psi_mod.f90
 base/modules/psi_serial_mod.f90
 base/psblas/psb_cnrmi.f90
 base/psblas/psb_dnrmi.f90
 base/psblas/psb_snrmi.f90
 base/psblas/psb_znrmi.f90
 base/serial/Makefile
 base/serial/f03/Makefile
 base/serial/f03/psb_base_mat_impl.f03
 base/serial/f03/psb_c_base_mat_impl.f03
 base/serial/f03/psb_c_coo_impl.f03
 base/serial/f03/psb_c_csc_impl.f03
 base/serial/f03/psb_c_csr_impl.f03
 base/serial/f03/psb_c_mat_impl.f03
 base/serial/f03/psb_d_base_mat_impl.f03
 base/serial/f03/psb_d_coo_impl.f03
 base/serial/f03/psb_d_csc_impl.f03
 base/serial/f03/psb_d_csr_impl.f03
 base/serial/f03/psb_d_mat_impl.f03
 base/serial/f03/psb_s_base_mat_impl.f03
 base/serial/f03/psb_s_coo_impl.f03
 base/serial/f03/psb_s_csc_impl.f03
 base/serial/f03/psb_s_csr_impl.f03
 base/serial/f03/psb_s_mat_impl.f03
 base/serial/f03/psb_z_base_mat_impl.f03
 base/serial/f03/psb_z_coo_impl.f03
 base/serial/f03/psb_z_csc_impl.f03
 base/serial/f03/psb_z_csr_impl.f03
 base/serial/f03/psb_z_mat_impl.f03
 base/serial/psb_sort_impl.f90
 base/serial/psi_impl.f90
 base/serial/psi_serial_impl.f90
 test/pargen/runs/ppde.inp
 test/torture
 test/torture/Makefile
 test/torture/psb_mvsv_tester.f90
 test/torture/psbtf.f90
 test/torture/runs
 util/Makefile
 util/psb_hbio_impl.f90
 util/psb_hbio_mod.f90
 util/psb_mat_dist_impl.f90
 util/psb_mat_dist_mod.f90
 util/psb_mmio_impl.f90
 util/psb_mmio_mod.f90

Merged (at r 4082) the XLF-TEST branch, where we have decoupled
interface and implementation for serial stuff.
psblas3-type-indexed
Salvatore Filippone 15 years ago
parent eda6a4941a
commit 56fd1cfbea

@ -44,7 +44,7 @@ psb_c_mat_mod.o: psb_c_base_mat_mod.o psb_c_csr_mat_mod.o psb_c_csc_mat_mod.o
psb_z_mat_mod.o: psb_z_base_mat_mod.o psb_z_csr_mat_mod.o psb_z_csc_mat_mod.o psb_z_mat_mod.o: psb_z_base_mat_mod.o psb_z_csr_mat_mod.o psb_z_csc_mat_mod.o
psb_s_csc_mat_mod.o psb_s_csr_mat_mod.o: psb_s_base_mat_mod.o psb_s_csc_mat_mod.o psb_s_csr_mat_mod.o: psb_s_base_mat_mod.o
psb_d_csc_mat_mod.o psb_d_csr_mat_mod.o: psb_d_base_mat_mod.o psb_d_csc_mat_mod.o psb_d_csr_mat_mod.o: psb_d_base_mat_mod.o
psb_dccsc_mat_mod.o psb_c_csr_mat_mod.o: psb_c_base_mat_mod.o psb_c_csc_mat_mod.o psb_c_csr_mat_mod.o: psb_c_base_mat_mod.o
psb_z_csc_mat_mod.o psb_z_csr_mat_mod.o: psb_z_base_mat_mod.o psb_z_csc_mat_mod.o psb_z_csr_mat_mod.o: psb_z_base_mat_mod.o
psb_mat_mod.o: psb_s_mat_mod.o psb_d_mat_mod.o psb_c_mat_mod.o psb_z_mat_mod.o psb_mat_mod.o: psb_s_mat_mod.o psb_d_mat_mod.o psb_c_mat_mod.o psb_z_mat_mod.o
psb_realloc_mod.o : psb_error_mod.o psb_realloc_mod.o : psb_error_mod.o

@ -20,44 +20,44 @@ module psb_base_mat_mod
! !
! !
! ==================================== ! ====================================
procedure, pass(a) :: get_nrows procedure, pass(a) :: get_nrows => psb_base_get_nrows
procedure, pass(a) :: get_ncols procedure, pass(a) :: get_ncols => psb_base_get_ncols
procedure, pass(a) :: get_nzeros procedure, pass(a) :: get_nzeros => psb_base_get_nzeros
procedure, pass(a) :: get_nz_row procedure, pass(a) :: get_nz_row => psb_base_get_nz_row
procedure, pass(a) :: get_size procedure, pass(a) :: get_size => psb_base_get_size
procedure, pass(a) :: get_state procedure, pass(a) :: get_state => psb_base_get_state
procedure, pass(a) :: get_dupl procedure, pass(a) :: get_dupl => psb_base_get_dupl
procedure, pass(a) :: get_fmt procedure, pass(a) :: get_fmt => psb_base_get_fmt
procedure, pass(a) :: get_aux procedure, pass(a) :: get_aux => psb_base_get_aux
procedure, pass(a) :: is_null procedure, pass(a) :: is_null => psb_base_is_null
procedure, pass(a) :: is_bld procedure, pass(a) :: is_bld => psb_base_is_bld
procedure, pass(a) :: is_upd procedure, pass(a) :: is_upd => psb_base_is_upd
procedure, pass(a) :: is_asb procedure, pass(a) :: is_asb => psb_base_is_asb
procedure, pass(a) :: is_sorted procedure, pass(a) :: is_sorted => psb_base_is_sorted
procedure, pass(a) :: is_upper procedure, pass(a) :: is_upper => psb_base_is_upper
procedure, pass(a) :: is_lower procedure, pass(a) :: is_lower => psb_base_is_lower
procedure, pass(a) :: is_triangle procedure, pass(a) :: is_triangle => psb_base_is_triangle
procedure, pass(a) :: is_unit procedure, pass(a) :: is_unit => psb_base_is_unit
! ==================================== ! ====================================
! !
! Setters ! Setters
! !
! ==================================== ! ====================================
procedure, pass(a) :: set_nrows procedure, pass(a) :: set_nrows => psb_base_set_nrows
procedure, pass(a) :: set_ncols procedure, pass(a) :: set_ncols => psb_base_set_ncols
procedure, pass(a) :: set_dupl procedure, pass(a) :: set_dupl => psb_base_set_dupl
procedure, pass(a) :: set_state procedure, pass(a) :: set_state => psb_base_set_state
procedure, pass(a) :: set_null procedure, pass(a) :: set_null => psb_base_set_null
procedure, pass(a) :: set_bld procedure, pass(a) :: set_bld => psb_base_set_bld
procedure, pass(a) :: set_upd procedure, pass(a) :: set_upd => psb_base_set_upd
procedure, pass(a) :: set_asb procedure, pass(a) :: set_asb => psb_base_set_asb
procedure, pass(a) :: set_sorted procedure, pass(a) :: set_sorted => psb_base_set_sorted
procedure, pass(a) :: set_upper procedure, pass(a) :: set_upper => psb_base_set_upper
procedure, pass(a) :: set_lower procedure, pass(a) :: set_lower => psb_base_set_lower
procedure, pass(a) :: set_triangle procedure, pass(a) :: set_triangle => psb_base_set_triangle
procedure, pass(a) :: set_unit procedure, pass(a) :: set_unit => psb_base_set_unit
procedure, pass(a) :: set_aux procedure, pass(a) :: set_aux => psb_base_set_aux
! ==================================== ! ====================================
@ -65,164 +65,258 @@ module psb_base_mat_mod
! Data management ! Data management
! !
! ==================================== ! ====================================
procedure, pass(a) :: get_neigh procedure, pass(a) :: get_neigh => psb_base_get_neigh
procedure, pass(a) :: allocate_mnnz procedure, pass(a) :: free => psb_base_free
procedure, pass(a) :: reallocate_nz procedure, pass(a) :: trim => psb_base_trim
procedure, pass(a) :: free procedure, pass(a) :: reinit => psb_base_reinit
procedure, pass(a) :: trim procedure, pass(a) :: allocate_mnnz => psb_base_allocate_mnnz
procedure, pass(a) :: reinit procedure, pass(a) :: reallocate_nz => psb_base_reallocate_nz
generic, public :: allocate => allocate_mnnz generic, public :: allocate => allocate_mnnz
generic, public :: reallocate => reallocate_nz generic, public :: reallocate => reallocate_nz
procedure, pass(a) :: csgetptn procedure, pass(a) :: csgetptn => psb_base_csgetptn
generic, public :: csget => csgetptn generic, public :: csget => csgetptn
procedure, pass(a) :: print => sparse_print procedure, pass(a) :: print => psb_base_sparse_print
procedure, pass(a) :: sizeof procedure, pass(a) :: sizeof => psb_base_sizeof
procedure, pass(a) :: base_cp_from procedure, pass(a) :: psb_base_cp_from
generic, public :: cp_from => base_cp_from generic, public :: cp_from => psb_base_cp_from
procedure, pass(a) :: base_mv_from procedure, pass(a) :: psb_base_mv_from
generic, public :: mv_from => base_mv_from generic, public :: mv_from => psb_base_mv_from
procedure, pass(a) :: base_transp_1mat procedure, pass(a) :: transp_1mat => psb_base_transp_1mat
procedure, pass(a) :: base_transp_2mat procedure, pass(a) :: transp_2mat => psb_base_transp_2mat
generic, public :: transp => base_transp_1mat, base_transp_2mat generic, public :: transp => transp_1mat, transp_2mat
procedure, pass(a) :: base_transc_1mat procedure, pass(a) :: transc_1mat => psb_base_transc_1mat
procedure, pass(a) :: base_transc_2mat procedure, pass(a) :: transc_2mat => psb_base_transc_2mat
generic, public :: transc => base_transc_1mat, base_transc_2mat generic, public :: transc => transc_1mat, transc_2mat
end type psb_base_sparse_mat end type psb_base_sparse_mat
private :: set_nrows, set_ncols, set_dupl, set_state, &
& set_null, set_bld, set_upd, set_asb, set_sorted, set_upper, & interface
& set_lower, set_triangle, set_unit, get_nrows, get_ncols, & function psb_base_get_nz_row(idx,a) result(res)
& get_nzeros, get_size, get_state, get_dupl, is_null, is_bld, & import psb_base_sparse_mat, psb_long_int_k_
& is_upd, is_asb, is_sorted, is_upper, is_lower, is_triangle, & integer, intent(in) :: idx
& is_unit, get_neigh, allocate_mn, allocate_mnnz, reallocate_nz, & class(psb_base_sparse_mat), intent(in) :: a
& free, sparse_print, get_fmt, trim, sizeof, reinit, csgetptn, & integer :: res
& get_nz_row, get_aux, set_aux, base_cp_from, base_mv_from, & end function psb_base_get_nz_row
& base_transp_1mat, base_transp_2mat, base_transc_1mat, base_transc_2mat end interface
interface
function psb_base_get_nzeros(a) result(res)
import psb_base_sparse_mat, psb_long_int_k_
class(psb_base_sparse_mat), intent(in) :: a
integer :: res
end function psb_base_get_nzeros
end interface
interface
function psb_base_get_size(a) result(res)
import psb_base_sparse_mat, psb_long_int_k_
class(psb_base_sparse_mat), intent(in) :: a
integer :: res
end function psb_base_get_size
end interface
interface
subroutine psb_base_reinit(a,clear)
import psb_base_sparse_mat, psb_long_int_k_
class(psb_base_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_base_reinit
end interface
interface
subroutine psb_base_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc)
import psb_base_sparse_mat, psb_long_int_k_
integer, intent(in) :: iout
class(psb_base_sparse_mat), intent(in) :: a
integer, intent(in), optional :: iv(:)
integer, intent(in), optional :: eirs,eics
character(len=*), optional :: head
integer, intent(in), optional :: ivr(:), ivc(:)
end subroutine psb_base_sparse_print
end interface
interface
subroutine psb_base_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import psb_base_sparse_mat, psb_long_int_k_
class(psb_base_sparse_mat), intent(in) :: a
integer, intent(in) :: imin,imax
integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
end subroutine psb_base_csgetptn
end interface
interface
subroutine psb_base_get_neigh(a,idx,neigh,n,info,lev)
import psb_base_sparse_mat, psb_long_int_k_
class(psb_base_sparse_mat), intent(in) :: a
integer, intent(in) :: idx
integer, intent(out) :: n
integer, allocatable, intent(out) :: neigh(:)
integer, intent(out) :: info
integer, optional, intent(in) :: lev
end subroutine psb_base_get_neigh
end interface
interface
subroutine psb_base_allocate_mnnz(m,n,a,nz)
import psb_base_sparse_mat, psb_long_int_k_
integer, intent(in) :: m,n
class(psb_base_sparse_mat), intent(inout) :: a
integer, intent(in), optional :: nz
end subroutine psb_base_allocate_mnnz
end interface
interface
subroutine psb_base_reallocate_nz(nz,a)
import psb_base_sparse_mat, psb_long_int_k_
integer, intent(in) :: nz
class(psb_base_sparse_mat), intent(inout) :: a
end subroutine psb_base_reallocate_nz
end interface
interface
subroutine psb_base_free(a)
import psb_base_sparse_mat, psb_long_int_k_
class(psb_base_sparse_mat), intent(inout) :: a
end subroutine psb_base_free
end interface
interface
subroutine psb_base_trim(a)
import psb_base_sparse_mat, psb_long_int_k_
class(psb_base_sparse_mat), intent(inout) :: a
end subroutine psb_base_trim
end interface
contains contains
function sizeof(a) result(res) function psb_base_sizeof(a) result(res)
implicit none implicit none
class(psb_base_sparse_mat), intent(in) :: a class(psb_base_sparse_mat), intent(in) :: a
integer(psb_long_int_k_) :: res integer(psb_long_int_k_) :: res
res = 8 res = 8
end function sizeof end function psb_base_sizeof
function psb_base_get_fmt(a) result(res)
function get_fmt(a) result(res)
implicit none implicit none
class(psb_base_sparse_mat), intent(in) :: a class(psb_base_sparse_mat), intent(in) :: a
character(len=5) :: res character(len=5) :: res
res = 'NULL' res = 'NULL'
end function get_fmt end function psb_base_get_fmt
function get_dupl(a) result(res) function psb_base_get_dupl(a) result(res)
implicit none implicit none
class(psb_base_sparse_mat), intent(in) :: a class(psb_base_sparse_mat), intent(in) :: a
integer :: res integer :: res
res = a%duplicate res = a%duplicate
end function get_dupl end function psb_base_get_dupl
function get_state(a) result(res) function psb_base_get_state(a) result(res)
implicit none implicit none
class(psb_base_sparse_mat), intent(in) :: a class(psb_base_sparse_mat), intent(in) :: a
integer :: res integer :: res
res = a%state res = a%state
end function get_state end function psb_base_get_state
function get_nrows(a) result(res) function psb_base_get_nrows(a) result(res)
implicit none implicit none
class(psb_base_sparse_mat), intent(in) :: a class(psb_base_sparse_mat), intent(in) :: a
integer :: res integer :: res
res = a%m res = a%m
end function get_nrows end function psb_base_get_nrows
function get_ncols(a) result(res) function psb_base_get_ncols(a) result(res)
implicit none implicit none
class(psb_base_sparse_mat), intent(in) :: a class(psb_base_sparse_mat), intent(in) :: a
integer :: res integer :: res
res = a%n res = a%n
end function get_ncols end function psb_base_get_ncols
subroutine set_aux(v,a) subroutine psb_base_set_aux(v,a)
implicit none implicit none
class(psb_base_sparse_mat), intent(inout) :: a class(psb_base_sparse_mat), intent(inout) :: a
integer, intent(in) :: v(:) integer, intent(in) :: v(:)
! TBD ! TBD
write(0,*) 'SET_AUX is empty right now ' write(0,*) 'SET_AUX is empty right now '
end subroutine set_aux end subroutine psb_base_set_aux
subroutine 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(0,*) 'GET_AUX is empty right now ' write(0,*) 'GET_AUX is empty right now '
end subroutine get_aux end subroutine psb_base_get_aux
subroutine set_nrows(m,a) subroutine psb_base_set_nrows(m,a)
implicit none implicit none
class(psb_base_sparse_mat), intent(inout) :: a class(psb_base_sparse_mat), intent(inout) :: a
integer, intent(in) :: m integer, intent(in) :: m
a%m = m a%m = m
end subroutine set_nrows end subroutine psb_base_set_nrows
subroutine set_ncols(n,a) subroutine psb_base_set_ncols(n,a)
implicit none implicit none
class(psb_base_sparse_mat), intent(inout) :: a class(psb_base_sparse_mat), intent(inout) :: a
integer, intent(in) :: n integer, intent(in) :: n
a%n = n a%n = n
end subroutine set_ncols end subroutine psb_base_set_ncols
subroutine set_state(n,a) subroutine psb_base_set_state(n,a)
implicit none implicit none
class(psb_base_sparse_mat), intent(inout) :: a class(psb_base_sparse_mat), intent(inout) :: a
integer, intent(in) :: n integer, intent(in) :: n
a%state = n a%state = n
end subroutine set_state end subroutine psb_base_set_state
subroutine set_dupl(n,a) subroutine psb_base_set_dupl(n,a)
implicit none implicit none
class(psb_base_sparse_mat), intent(inout) :: a class(psb_base_sparse_mat), intent(inout) :: a
integer, intent(in) :: n integer, intent(in) :: n
a%duplicate = n a%duplicate = n
end subroutine set_dupl end subroutine psb_base_set_dupl
subroutine set_null(a) subroutine psb_base_set_null(a)
implicit none implicit none
class(psb_base_sparse_mat), intent(inout) :: a class(psb_base_sparse_mat), intent(inout) :: a
a%state = psb_spmat_null_ a%state = psb_spmat_null_
end subroutine set_null end subroutine psb_base_set_null
subroutine set_bld(a) subroutine psb_base_set_bld(a)
implicit none implicit none
class(psb_base_sparse_mat), intent(inout) :: a class(psb_base_sparse_mat), intent(inout) :: a
a%state = psb_spmat_bld_ a%state = psb_spmat_bld_
end subroutine set_bld end subroutine psb_base_set_bld
subroutine set_upd(a) subroutine psb_base_set_upd(a)
implicit none implicit none
class(psb_base_sparse_mat), intent(inout) :: a class(psb_base_sparse_mat), intent(inout) :: a
a%state = psb_spmat_upd_ a%state = psb_spmat_upd_
end subroutine set_upd end subroutine psb_base_set_upd
subroutine set_asb(a) subroutine psb_base_set_asb(a)
implicit none implicit none
class(psb_base_sparse_mat), intent(inout) :: a class(psb_base_sparse_mat), intent(inout) :: a
a%state = psb_spmat_asb_ a%state = psb_spmat_asb_
end subroutine set_asb end subroutine psb_base_set_asb
subroutine set_sorted(a,val) subroutine psb_base_set_sorted(a,val)
implicit none implicit none
class(psb_base_sparse_mat), intent(inout) :: a class(psb_base_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: val logical, intent(in), optional :: val
@ -232,9 +326,9 @@ contains
else else
a%sorted = .true. a%sorted = .true.
end if end if
end subroutine set_sorted end subroutine psb_base_set_sorted
subroutine set_triangle(a,val) subroutine psb_base_set_triangle(a,val)
implicit none implicit none
class(psb_base_sparse_mat), intent(inout) :: a class(psb_base_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: val logical, intent(in), optional :: val
@ -244,9 +338,9 @@ contains
else else
a%triangle = .true. a%triangle = .true.
end if end if
end subroutine set_triangle end subroutine psb_base_set_triangle
subroutine set_unit(a,val) subroutine psb_base_set_unit(a,val)
implicit none implicit none
class(psb_base_sparse_mat), intent(inout) :: a class(psb_base_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: val logical, intent(in), optional :: val
@ -256,9 +350,9 @@ contains
else else
a%unitd = .true. a%unitd = .true.
end if end if
end subroutine set_unit end subroutine psb_base_set_unit
subroutine set_lower(a,val) subroutine psb_base_set_lower(a,val)
implicit none implicit none
class(psb_base_sparse_mat), intent(inout) :: a class(psb_base_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: val logical, intent(in), optional :: val
@ -268,9 +362,9 @@ contains
else else
a%upper = .false. a%upper = .false.
end if end if
end subroutine set_lower end subroutine psb_base_set_lower
subroutine set_upper(a,val) subroutine psb_base_set_upper(a,val)
implicit none implicit none
class(psb_base_sparse_mat), intent(inout) :: a class(psb_base_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: val logical, intent(in), optional :: val
@ -280,175 +374,72 @@ contains
else else
a%upper = .true. a%upper = .true.
end if end if
end subroutine set_upper end subroutine psb_base_set_upper
function is_triangle(a) result(res) function psb_base_is_triangle(a) result(res)
implicit none implicit none
class(psb_base_sparse_mat), intent(in) :: a class(psb_base_sparse_mat), intent(in) :: a
logical :: res logical :: res
res = a%triangle res = a%triangle
end function is_triangle end function psb_base_is_triangle
function is_unit(a) result(res) function psb_base_is_unit(a) result(res)
implicit none implicit none
class(psb_base_sparse_mat), intent(in) :: a class(psb_base_sparse_mat), intent(in) :: a
logical :: res logical :: res
res = a%unitd res = a%unitd
end function is_unit end function psb_base_is_unit
function is_upper(a) result(res) function psb_base_is_upper(a) result(res)
implicit none implicit none
class(psb_base_sparse_mat), intent(in) :: a class(psb_base_sparse_mat), intent(in) :: a
logical :: res logical :: res
res = a%upper res = a%upper
end function is_upper end function psb_base_is_upper
function is_lower(a) result(res) function psb_base_is_lower(a) result(res)
implicit none implicit none
class(psb_base_sparse_mat), intent(in) :: a class(psb_base_sparse_mat), intent(in) :: a
logical :: res logical :: res
res = .not.a%upper res = .not.a%upper
end function is_lower end function psb_base_is_lower
function is_null(a) result(res) function psb_base_is_null(a) result(res)
implicit none implicit none
class(psb_base_sparse_mat), intent(in) :: a class(psb_base_sparse_mat), intent(in) :: a
logical :: res logical :: res
res = (a%state == psb_spmat_null_) res = (a%state == psb_spmat_null_)
end function is_null end function psb_base_is_null
function is_bld(a) result(res) function psb_base_is_bld(a) result(res)
implicit none implicit none
class(psb_base_sparse_mat), intent(in) :: a class(psb_base_sparse_mat), intent(in) :: a
logical :: res logical :: res
res = (a%state == psb_spmat_bld_) res = (a%state == psb_spmat_bld_)
end function is_bld end function psb_base_is_bld
function is_upd(a) result(res) function psb_base_is_upd(a) result(res)
implicit none implicit none
class(psb_base_sparse_mat), intent(in) :: a class(psb_base_sparse_mat), intent(in) :: a
logical :: res logical :: res
res = (a%state == psb_spmat_upd_) res = (a%state == psb_spmat_upd_)
end function is_upd end function psb_base_is_upd
function is_asb(a) result(res) function psb_base_is_asb(a) result(res)
implicit none implicit none
class(psb_base_sparse_mat), intent(in) :: a class(psb_base_sparse_mat), intent(in) :: a
logical :: res logical :: res
res = (a%state == psb_spmat_asb_) res = (a%state == psb_spmat_asb_)
end function is_asb end function psb_base_is_asb
function is_sorted(a) result(res) function psb_base_is_sorted(a) result(res)
implicit none implicit none
class(psb_base_sparse_mat), intent(in) :: a class(psb_base_sparse_mat), intent(in) :: a
logical :: res logical :: res
res = a%sorted res = a%sorted
end function is_sorted end function psb_base_is_sorted
subroutine psb_base_mv_from(a,b)
function get_nz_row(idx,a) result(res)
use psb_error_mod
implicit none
integer, intent(in) :: idx
class(psb_base_sparse_mat), intent(in) :: a
integer :: res
Integer :: err_act
character(len=20) :: name='base_get_nz_row'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
res = -1
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end function get_nz_row
function get_nzeros(a) result(res)
use psb_error_mod
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer :: res
Integer :: err_act
character(len=20) :: name='base_get_nzeros'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
res = -1
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end function get_nzeros
function get_size(a) result(res)
use psb_error_mod
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer :: res
Integer :: err_act
character(len=20) :: name='get_size'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
res = -1
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end function get_size
subroutine reinit(a,clear)
use psb_error_mod
implicit none
class(psb_base_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
Integer :: err_act, info
character(len=20) :: name='reinit'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = 700
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine reinit
!
!
subroutine base_mv_from(a,b)
use psb_error_mod
implicit none implicit none
class(psb_base_sparse_mat), intent(out) :: a class(psb_base_sparse_mat), intent(out) :: a
@ -464,12 +455,9 @@ contains
a%sorted = b%sorted a%sorted = b%sorted
call move_alloc(b%aux,a%aux) call move_alloc(b%aux,a%aux)
return end subroutine psb_base_mv_from
end subroutine base_mv_from subroutine psb_base_cp_from(a,b)
subroutine base_cp_from(a,b)
use psb_error_mod
implicit none implicit none
class(psb_base_sparse_mat), intent(out) :: a class(psb_base_sparse_mat), intent(out) :: a
@ -487,16 +475,10 @@ contains
allocate(a%aux(size(b%aux))) allocate(a%aux(size(b%aux)))
a%aux(:) = b%aux(:) a%aux(:) = b%aux(:)
end if end if
return
end subroutine base_cp_from
end subroutine psb_base_cp_from
! subroutine psb_base_transp_2mat(a,b)
! Here we go.
!
subroutine base_transp_2mat(a,b)
use psb_error_mod
implicit none implicit none
class(psb_base_sparse_mat), intent(out) :: a class(psb_base_sparse_mat), intent(out) :: a
@ -515,22 +497,18 @@ contains
a%aux(:) = b%aux(:) a%aux(:) = b%aux(:)
end if end if
return end subroutine psb_base_transp_2mat
end subroutine base_transp_2mat
subroutine base_transc_2mat(a,b) subroutine psb_base_transc_2mat(a,b)
use psb_error_mod
implicit none implicit none
class(psb_base_sparse_mat), intent(out) :: a class(psb_base_sparse_mat), intent(out) :: a
class(psb_base_sparse_mat), intent(in) :: b class(psb_base_sparse_mat), intent(in) :: b
call a%transp(b) call a%transp(b)
end subroutine base_transc_2mat end subroutine psb_base_transc_2mat
subroutine base_transp_1mat(a) subroutine psb_base_transp_1mat(a)
use psb_error_mod
implicit none implicit none
class(psb_base_sparse_mat), intent(inout) :: a class(psb_base_sparse_mat), intent(inout) :: a
@ -546,246 +524,15 @@ contains
a%upper = .not.a%upper a%upper = .not.a%upper
a%sorted = .false. a%sorted = .false.
return end subroutine psb_base_transp_1mat
end subroutine base_transp_1mat
subroutine base_transc_1mat(a) subroutine psb_base_transc_1mat(a)
use psb_error_mod
implicit none implicit none
class(psb_base_sparse_mat), intent(inout) :: a class(psb_base_sparse_mat), intent(inout) :: a
call a%transp() call a%transp()
end subroutine base_transc_1mat end subroutine psb_base_transc_1mat
subroutine sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc)
use psb_error_mod
implicit none
integer, intent(in) :: iout
class(psb_base_sparse_mat), intent(in) :: a
integer, intent(in), optional :: iv(:)
integer, intent(in), optional :: eirs,eics
character(len=*), optional :: head
integer, intent(in), optional :: ivr(:), ivc(:)
Integer :: err_act, info
character(len=20) :: name='sparse_print'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = 700
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine sparse_print
subroutine csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer, intent(in) :: imin,imax
integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
Integer :: err_act
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = 700
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine csgetptn
subroutine get_neigh(a,idx,neigh,n,info,lev)
use psb_error_mod
use psb_realloc_mod
use psb_sort_mod
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer, intent(in) :: idx
integer, intent(out) :: n
integer, allocatable, intent(out) :: neigh(:)
integer, intent(out) :: info
integer, optional, intent(in) :: lev
integer :: lev_, i, nl, ifl,ill,&
& n1, err_act, nn, nidx,ntl
integer, allocatable :: ia(:), ja(:)
character(len=20) :: name='get_neigh'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
if(present(lev)) then
lev_ = lev
else
lev_=1
end if
! Turns out we can write get_neigh at this
! level
n = 0
call a%csget(idx,idx,n,ia,ja,info)
if (info == 0) call psb_realloc(n,neigh,info)
if (info /= 0) then
call psb_errpush(4000,name)
goto 9999
end if
neigh(1:n) = ja(1:n)
ifl = 1
ill = n
do nl = 2, lev_
n1 = ill - ifl + 1
call psb_ensure_size(ill+n1*n1,neigh,info)
if (info /= 0) then
call psb_errpush(4000,name)
goto 9999
end if
ntl = 0
do i=ifl,ill
nidx=neigh(i)
if ((nidx /= idx).and.(nidx > 0).and.(nidx <= a%m)) then
call a%csget(nidx,nidx,nn,ia,ja,info)
if (info==0) call psb_ensure_size(ill+ntl+nn,neigh,info)
if (info /= 0) then
call psb_errpush(4000,name)
goto 9999
end if
neigh(ill+ntl+1:ill+ntl+nn)=ja(1:nn)
ntl = ntl+nn
end if
end do
call psb_msort_unique(neigh(ill+1:ill+ntl),nn)
ifl = ill + 1
ill = ill + nn
end do
call psb_msort_unique(neigh(1:ill),nn,dir=psb_sort_up_)
n = nn
call psb_erractionrestore(err_act)
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine get_neigh
subroutine allocate_mnnz(m,n,a,nz)
use psb_error_mod
implicit none
integer, intent(in) :: m,n
class(psb_base_sparse_mat), intent(inout) :: a
integer, intent(in), optional :: nz
Integer :: err_act
character(len=20) :: name='allocate_mnz'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine allocate_mnnz
subroutine reallocate_nz(nz,a)
use psb_error_mod
implicit none
integer, intent(in) :: nz
class(psb_base_sparse_mat), intent(inout) :: a
Integer :: err_act
character(len=20) :: name='reallocate_nz'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine reallocate_nz
subroutine free(a)
use psb_error_mod
implicit none
class(psb_base_sparse_mat), intent(inout) :: a
Integer :: err_act
character(len=20) :: name='free'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine free
subroutine trim(a)
use psb_error_mod
implicit none
class(psb_base_sparse_mat), intent(inout) :: a
Integer :: err_act
character(len=20) :: name='trim'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine trim
end module psb_base_mat_mod end module psb_base_mat_mod

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

@ -90,7 +90,7 @@ function psb_cnrmi(a,desc_a,info)
end if end if
if ((m /= 0).and.(n /= 0)) then if ((m /= 0).and.(n /= 0)) then
nrmi = psb_csnmi(a) nrmi = a%csnmi()
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_csnmi' ch_err='psb_csnmi'

@ -95,7 +95,7 @@ function psb_dnrmi(a,desc_a,info)
end if end if
if ((m /= 0).and.(n /= 0)) then if ((m /= 0).and.(n /= 0)) then
nrmi = psb_csnmi(a) nrmi = a%csnmi()
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_csnmi' ch_err='psb_csnmi'

@ -95,7 +95,7 @@ function psb_snrmi(a,desc_a,info)
end if end if
if ((m /= 0).and.(n /= 0)) then if ((m /= 0).and.(n /= 0)) then
nrmi = psb_csnmi(a) nrmi = a%csnmi()
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_csnmi' ch_err='psb_csnmi'

@ -95,7 +95,7 @@ function psb_znrmi(a,desc_a,info)
end if end if
if ((m /= 0).and.(n /= 0)) then if ((m /= 0).and.(n /= 0)) then
nrmi = psb_csnmi(a) nrmi = a%csnmi()
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_csnmi' ch_err='psb_csnmi'

@ -1,7 +1,7 @@
include ../../Make.inc include ../../Make.inc
FOBJS = psb_lsame.o \ FOBJS = psb_lsame.o psi_serial_impl.o psi_impl.o psb_sort_impl.o \
psb_ssymbmm.o psb_dsymbmm.o psb_csymbmm.o psb_zsymbmm.o \ psb_ssymbmm.o psb_dsymbmm.o psb_csymbmm.o psb_zsymbmm.o \
psb_snumbmm.o psb_dnumbmm.o psb_cnumbmm.o psb_znumbmm.o \ psb_snumbmm.o psb_dnumbmm.o psb_cnumbmm.o psb_znumbmm.o \
psb_srwextd.o psb_drwextd.o psb_crwextd.o psb_zrwextd.o psb_srwextd.o psb_drwextd.o psb_crwextd.o psb_zrwextd.o

@ -3,11 +3,13 @@ include ../../../Make.inc
# #
# The object files # The object files
# #
FOBJS = psb_s_csr_impl.o psb_c_csr_impl.o psb_d_csr_impl.o psb_z_csr_impl.o\ BOBJS=psb_base_mat_impl.o psb_s_base_mat_impl.o psb_d_base_mat_impl.o psb_c_base_mat_impl.o psb_z_base_mat_impl.o
psb_s_coo_impl.o psb_c_coo_impl.o psb_d_coo_impl.o psb_z_coo_impl.o\ SOBJS=psb_s_csr_impl.o psb_s_coo_impl.o psb_s_csc_impl.o psb_s_mat_impl.o
psb_s_csc_impl.o psb_c_csc_impl.o psb_d_csc_impl.o psb_z_csc_impl.o DOBJS=psb_d_csr_impl.o psb_d_coo_impl.o psb_d_csc_impl.o psb_d_mat_impl.o
COBJS=psb_c_csr_impl.o psb_c_coo_impl.o psb_c_csc_impl.o psb_c_mat_impl.o
ZOBJS=psb_z_csr_impl.o psb_z_coo_impl.o psb_z_csc_impl.o psb_z_mat_impl.o
OBJS=$(FOBJS) OBJS=$(BOBJS) $(SOBJS) $(DOBJS) $(COBJS) $(ZOBJS)
# #
# Where the library should go, and how it is called. # Where the library should go, and how it is called.
@ -30,6 +32,9 @@ lib: $(OBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(OBJS) $(AR) $(LIBDIR)/$(LIBNAME) $(OBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME) $(RANLIB) $(LIBDIR)/$(LIBNAME)
# A bit excessive, but safe
$(OBJS): $(MODDIR)/psb_sparse_mod.o
clean: cleanobjs clean: cleanobjs
veryclean: cleanobjs veryclean: cleanobjs

@ -0,0 +1,337 @@
function psb_base_get_nz_row(idx,a) result(res)
use psb_error_mod
use psb_base_mat_mod, psb_protect_name => psb_base_get_nz_row
implicit none
integer, intent(in) :: idx
class(psb_base_sparse_mat), intent(in) :: a
integer :: res
Integer :: err_act
character(len=20) :: name='base_get_nz_row'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
res = -1
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end function psb_base_get_nz_row
function psb_base_get_nzeros(a) result(res)
use psb_base_mat_mod, psb_protect_name => psb_base_get_nzeros
use psb_error_mod
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer :: res
Integer :: err_act
character(len=20) :: name='base_get_nzeros'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
res = -1
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end function psb_base_get_nzeros
function psb_base_get_size(a) result(res)
use psb_base_mat_mod, psb_protect_name => psb_base_get_size
use psb_error_mod
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer :: res
Integer :: err_act
character(len=20) :: name='get_size'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
res = -1
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end function psb_base_get_size
subroutine psb_base_reinit(a,clear)
use psb_base_mat_mod, psb_protect_name => psb_base_reinit
use psb_error_mod
implicit none
class(psb_base_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
Integer :: err_act, info
character(len=20) :: name='reinit'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = 700
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_base_reinit
subroutine psb_base_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc)
use psb_base_mat_mod, psb_protect_name => psb_base_sparse_print
use psb_error_mod
implicit none
integer, intent(in) :: iout
class(psb_base_sparse_mat), intent(in) :: a
integer, intent(in), optional :: iv(:)
integer, intent(in), optional :: eirs,eics
character(len=*), optional :: head
integer, intent(in), optional :: ivr(:), ivc(:)
Integer :: err_act, info
character(len=20) :: name='sparse_print'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = 700
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_base_sparse_print
subroutine psb_base_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_base_mat_mod, psb_protect_name => psb_base_csgetptn
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer, intent(in) :: imin,imax
integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
Integer :: err_act
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = 700
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_base_csgetptn
subroutine psb_base_get_neigh(a,idx,neigh,n,info,lev)
use psb_base_mat_mod, psb_protect_name => psb_base_get_neigh
use psb_error_mod
use psb_realloc_mod
use psb_sort_mod
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer, intent(in) :: idx
integer, intent(out) :: n
integer, allocatable, intent(out) :: neigh(:)
integer, intent(out) :: info
integer, optional, intent(in) :: lev
integer :: lev_, i, nl, ifl,ill,&
& n1, err_act, nn, nidx,ntl,ma
integer, allocatable :: ia(:), ja(:)
character(len=20) :: name='get_neigh'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
if(present(lev)) then
lev_ = lev
else
lev_=1
end if
! Turns out we can write get_neigh at this
! level
n = 0
ma = a%get_nrows()
call a%csget(idx,idx,n,ia,ja,info)
if (info == 0) call psb_realloc(n,neigh,info)
if (info /= 0) then
call psb_errpush(4000,name)
goto 9999
end if
neigh(1:n) = ja(1:n)
ifl = 1
ill = n
do nl = 2, lev_
n1 = ill - ifl + 1
call psb_ensure_size(ill+n1*n1,neigh,info)
if (info /= 0) then
call psb_errpush(4000,name)
goto 9999
end if
ntl = 0
do i=ifl,ill
nidx=neigh(i)
if ((nidx /= idx).and.(nidx > 0).and.(nidx <= ma)) then
call a%csget(nidx,nidx,nn,ia,ja,info)
if (info==0) call psb_ensure_size(ill+ntl+nn,neigh,info)
if (info /= 0) then
call psb_errpush(4000,name)
goto 9999
end if
neigh(ill+ntl+1:ill+ntl+nn)=ja(1:nn)
ntl = ntl+nn
end if
end do
call psb_msort_unique(neigh(ill+1:ill+ntl),nn)
ifl = ill + 1
ill = ill + nn
end do
call psb_msort_unique(neigh(1:ill),nn,dir=psb_sort_up_)
n = nn
call psb_erractionrestore(err_act)
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_base_get_neigh
subroutine psb_base_allocate_mnnz(m,n,a,nz)
use psb_base_mat_mod, psb_protect_name => psb_base_allocate_mnnz
use psb_error_mod
implicit none
integer, intent(in) :: m,n
class(psb_base_sparse_mat), intent(inout) :: a
integer, intent(in), optional :: nz
Integer :: err_act
character(len=20) :: name='allocate_mnz'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_base_allocate_mnnz
subroutine psb_base_reallocate_nz(nz,a)
use psb_base_mat_mod, psb_protect_name => psb_base_reallocate_nz
use psb_error_mod
implicit none
integer, intent(in) :: nz
class(psb_base_sparse_mat), intent(inout) :: a
Integer :: err_act
character(len=20) :: name='reallocate_nz'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_base_reallocate_nz
subroutine psb_base_free(a)
use psb_base_mat_mod, psb_protect_name => psb_base_free
use psb_error_mod
implicit none
class(psb_base_sparse_mat), intent(inout) :: a
Integer :: err_act
character(len=20) :: name='free'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_base_free
subroutine psb_base_trim(a)
use psb_base_mat_mod, psb_protect_name => psb_base_trim
use psb_error_mod
implicit none
class(psb_base_sparse_mat), intent(inout) :: a
Integer :: err_act
character(len=20) :: name='trim'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_base_trim

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

@ -2,7 +2,7 @@
BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES
BJAC Preconditioner NONE DIAG BJAC BJAC Preconditioner NONE DIAG BJAC
CSR Storage format for matrix A: CSR COO JAD CSR Storage format for matrix A: CSR COO JAD
060 Domain size (acutal system is this**3) 020 Domain size (acutal system is this**3)
2 Stopping criterion 2 Stopping criterion
0100 MAXIT 0100 MAXIT
01 ITRACE 01 ITRACE

@ -0,0 +1,37 @@
include ../../Make.inc
#
# Libraries used
#
LIBDIR=../../lib/
PSBLAS_LIB= -L$(LIBDIR) -lpsb_util -lpsb_krylov -lpsb_prec -lpsb_base
LDLIBS=$(PSBLDLIBS)
#
# Compilers and such
#
CCOPT= -g
FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG).
PSBTOBJS=psb_mvsv_tester.o psbtf.o
EXEDIR=./runs
all: psbtf
psbtf: $(PSBTOBJS)
$(F90LINK) $(PSBTOBJS) -o psbtf $(PSBLAS_LIB) $(LDLIBS)
/bin/mv psbtf $(EXEDIR)
psbtf.o: psb_mvsv_tester.o
.f90.o:
$(MPF90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $<
clean:
/bin/rm -f $(PSBTOBJS) ppde.o spde.o $(EXEDIR)/ppde
verycleanlib:
(cd ../..; make veryclean)
lib:
(cd ../../; make library)

File diff suppressed because it is too large Load Diff

@ -0,0 +1,754 @@
!
! Parallel Sparse BLAS fortran interface testing code
!
!
!
program main
use psb_sparse_mod
use psb_mvsv_tester
implicit none
integer, parameter :: psb_fidasize_=16
integer :: res,passed=0,failed=0;
integer :: ictxt, iam=-1, np=-1
character(len=psb_fidasize_) :: afmt
write(*,*) 'Format ?'
read(*,*) afmt
! afmt = 'COO'
call psb_init(ictxt)
call psb_info(ictxt,iam,np)
if(iam<0)then
goto 9999
endif
call s_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call s_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call d_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call c_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
call z_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt)
if(res/=0)failed=failed+1
if(res.eq.0)passed=passed+1
res=0
9999 continue
print *,"PASSED:",passed
print *,"FAILED:",failed
call psb_exit(ictxt)
end program main

@ -6,11 +6,12 @@ LIBDIR=../lib
HERE=. HERE=.
BASEOBJS= psb_blockpart_mod.o psb_metispart_mod.o \ BASEOBJS= psb_blockpart_mod.o psb_metispart_mod.o \
psb_hbio_mod.o psb_mmio_mod.o psb_mat_dist_mod.o psb_hbio_mod.o psb_mmio_mod.o psb_mat_dist_mod.o
MODOBJ=psb_util_mod.o IMPLOBJS= psb_hbio_impl.o psb_mmio_impl.o psb_mat_dist_impl.o
OBJS=$(BASEOBJS) $(MODOBJ) MODOBJS=psb_util_mod.o $(BASEOBJS)
OBJS=$(MODOBJS) $(IMPLOBJS)
LIBMOD=psb_util_mod$(.mod) LIBMOD=psb_util_mod$(.mod)
LOCAL_MODS=$(OBJS:.o=$(.mod)) LOCAL_MODS=$(MODOBJS:.o=$(.mod))
LIBNAME=$(UTILLIBNAME) LIBNAME=$(UTILLIBNAME)
FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG). FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG).
@ -23,7 +24,6 @@ lib: $(OBJS)
psb_util_mod.o: $(BASEOBJS) psb_util_mod.o: $(BASEOBJS)
psb_read_mat_mod.o: psb_mmio_mod.o
veryclean: clean veryclean: clean
/bin/rm -f $(HERE)/$(LIBNAME) /bin/rm -f $(HERE)/$(LIBNAME)

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff
Loading…
Cancel
Save