From 17ebee01847e3f39d87f5d35aa452a3740a7d541 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sun, 27 Nov 2011 18:48:43 +0000 Subject: [PATCH] psblas3: base/modules/psb_c_base_mat_mod.f90 base/modules/psb_c_base_vect_mod.f90 base/modules/psb_c_csc_mat_mod.f90 base/modules/psb_c_csr_mat_mod.f90 base/modules/psb_c_mat_mod.f90 base/modules/psb_d_base_mat_mod.f90 base/modules/psb_d_base_vect_mod.f90 base/modules/psb_d_csc_mat_mod.f90 base/modules/psb_d_csr_mat_mod.f90 base/modules/psb_d_mat_mod.f90 base/modules/psb_s_base_mat_mod.f90 base/modules/psb_s_base_vect_mod.f90 base/modules/psb_s_csc_mat_mod.f90 base/modules/psb_s_csr_mat_mod.f90 base/modules/psb_s_mat_mod.f90 base/modules/psb_z_base_mat_mod.f90 base/modules/psb_z_base_vect_mod.f90 base/modules/psb_z_csc_mat_mod.f90 base/modules/psb_z_csr_mat_mod.f90 base/modules/psb_z_mat_mod.f90 Comments fixes with preprocessing. --- base/modules/psb_c_base_mat_mod.f90 | 73 ++++---- base/modules/psb_c_base_vect_mod.f90 | 72 +++----- base/modules/psb_c_csc_mat_mod.f90 | 26 +-- base/modules/psb_c_csr_mat_mod.f90 | 27 +-- base/modules/psb_c_mat_mod.f90 | 128 +++++++------- base/modules/psb_d_base_mat_mod.f90 | 15 +- base/modules/psb_d_base_vect_mod.f90 | 44 ++--- base/modules/psb_d_csc_mat_mod.f90 | 2 +- base/modules/psb_d_csr_mat_mod.f90 | 2 +- base/modules/psb_d_mat_mod.f90 | 160 +++++++++-------- base/modules/psb_s_base_mat_mod.f90 | 56 +++--- base/modules/psb_s_base_vect_mod.f90 | 23 +-- base/modules/psb_s_csc_mat_mod.f90 | 8 +- base/modules/psb_s_csr_mat_mod.f90 | 6 +- base/modules/psb_s_mat_mod.f90 | 246 +++++++++++++-------------- base/modules/psb_z_base_mat_mod.f90 | 77 +++++---- base/modules/psb_z_base_vect_mod.f90 | 158 ++++++----------- base/modules/psb_z_csc_mat_mod.f90 | 16 +- base/modules/psb_z_csr_mat_mod.f90 | 16 +- base/modules/psb_z_mat_mod.f90 | 15 +- 20 files changed, 524 insertions(+), 646 deletions(-) diff --git a/base/modules/psb_c_base_mat_mod.f90 b/base/modules/psb_c_base_mat_mod.f90 index 8a800f7e..5af10b8d 100644 --- a/base/modules/psb_c_base_mat_mod.f90 +++ b/base/modules/psb_c_base_mat_mod.f90 @@ -32,14 +32,15 @@ ! ! package: psb_c_base_mat_mod ! -! This module contains the implementation of the -! psb_c_base_sparse_mat, derived from the psb_base_sparse_mat to -! define a middle level definition of a complex, single-precision sparse -! matrix object.This class object itself does not have any additional -! members with respect to those of the base class. No methods can be -! fully implemented at this level, but we can define the interface for -! the computational methods requiring the knowledge of the underlying +! This module contains the implementation of the psb_c_base_sparse_mat +! type, derived from the psb_base_sparse_mat one to define a middle +! level definition of a complex(psb_spk_) sparse matrix +! object.This class object itself does not have any additional members +! with respect to those of the base class. No methods can be fully +! implemented at this level, but we can define the interface for the +! computational methods requiring the knowledge of the underlying ! field, such as the matrix-vector product; this interface is defined, +! but is supposed to be overridden at the leaf level. ! ! This module also contains the implementation of the ! psb_c_coo_sparse_mat type and the related methods. This is the @@ -49,11 +50,9 @@ ! psb_c_base_sparse_mat one. ! ! About the method MOLD: this has been defined for those compilers -! not yet supporting ALLOCATE( ...MOLD=...); it's otherwise silly to +! not yet supporting ALLOCATE( ...,MOLD=...); it's otherwise silly to ! duplicate "by hand" what is specified in the language (in this case F2008) ! - - module psb_c_base_mat_mod use psb_base_mat_mod @@ -133,13 +132,6 @@ module psb_c_base_mat_mod procedure, pass(a) :: c_inner_cssv => psb_c_coo_cssv procedure, pass(a) :: c_scals => psb_c_coo_scals procedure, pass(a) :: c_scal => psb_c_coo_scal - procedure, pass(a) :: maxval => psb_c_coo_maxval - procedure, pass(a) :: csnmi => psb_c_coo_csnmi - procedure, pass(a) :: csnm1 => psb_c_coo_csnm1 - procedure, pass(a) :: rowsum => psb_c_coo_rowsum - procedure, pass(a) :: arwsum => psb_c_coo_arwsum - procedure, pass(a) :: colsum => psb_c_coo_colsum - procedure, pass(a) :: aclsum => psb_c_coo_aclsum procedure, pass(a) :: reallocate_nz => psb_c_coo_reallocate_nz procedure, pass(a) :: allocate_mnnz => psb_c_coo_allocate_mnnz procedure, pass(a) :: cp_to_coo => psb_c_cp_coo_to_coo @@ -151,6 +143,13 @@ module psb_c_base_mat_mod procedure, pass(a) :: mv_to_fmt => psb_c_mv_coo_to_fmt procedure, pass(a) :: mv_from_fmt => psb_c_mv_coo_from_fmt procedure, pass(a) :: csput => psb_c_coo_csput + procedure, pass(a) :: maxval => psb_c_coo_maxval + procedure, pass(a) :: csnmi => psb_c_coo_csnmi + procedure, pass(a) :: csnm1 => psb_c_coo_csnm1 + procedure, pass(a) :: rowsum => psb_c_coo_rowsum + procedure, pass(a) :: arwsum => psb_c_coo_arwsum + procedure, pass(a) :: colsum => psb_c_coo_colsum + procedure, pass(a) :: aclsum => psb_c_coo_aclsum procedure, pass(a) :: get_diag => psb_c_coo_get_diag procedure, pass(a) :: c_csgetrow => psb_c_coo_csgetrow procedure, pass(a) :: csgetptn => psb_c_coo_csgetptn @@ -209,14 +208,14 @@ module psb_c_base_mat_mod subroutine psb_c_base_vect_mv(alpha,a,x,beta,y,info,trans) import :: psb_c_base_sparse_mat, psb_spk_, psb_c_base_vect_type class(psb_c_base_sparse_mat), intent(in) :: a - complex(psb_spk_), intent(in) :: alpha, beta + complex(psb_spk_), intent(in) :: alpha, beta class(psb_c_base_vect_type), intent(inout) :: x class(psb_c_base_vect_type), intent(inout) :: y integer, intent(out) :: info character, optional, intent(in) :: trans end subroutine psb_c_base_vect_mv end interface - + interface subroutine psb_c_base_inner_cssm(alpha,a,x,beta,y,info,trans) import :: psb_c_base_sparse_mat, psb_spk_ @@ -243,7 +242,7 @@ module psb_c_base_mat_mod subroutine psb_c_base_inner_vect_sv(alpha,a,x,beta,y,info,trans) import :: psb_c_base_sparse_mat, psb_spk_, psb_c_base_vect_type class(psb_c_base_sparse_mat), intent(in) :: a - complex(psb_spk_), intent(in) :: alpha, beta + complex(psb_spk_), intent(in) :: alpha, beta class(psb_c_base_vect_type), intent(inout) :: x, y integer, intent(out) :: info character, optional, intent(in) :: trans @@ -278,7 +277,7 @@ module psb_c_base_mat_mod subroutine psb_c_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d) import :: psb_c_base_sparse_mat, psb_spk_,psb_c_base_vect_type class(psb_c_base_sparse_mat), intent(in) :: a - complex(psb_spk_), intent(in) :: alpha, beta + complex(psb_spk_), intent(in) :: alpha, beta class(psb_c_base_vect_type), intent(inout) :: x,y integer, intent(out) :: info character, optional, intent(in) :: trans, scale @@ -303,8 +302,7 @@ module psb_c_base_mat_mod integer, intent(out) :: info end subroutine psb_c_base_scal end interface - - + interface function psb_c_base_maxval(a) result(res) import :: psb_c_base_sparse_mat, psb_spk_ @@ -320,7 +318,7 @@ module psb_c_base_mat_mod real(psb_spk_) :: res end function psb_c_base_csnmi end interface - + interface function psb_c_base_csnm1(a) result(res) import :: psb_c_base_sparse_mat, psb_spk_ @@ -360,7 +358,7 @@ module psb_c_base_mat_mod real(psb_spk_), intent(out) :: d(:) end subroutine psb_c_base_aclsum end interface - + interface subroutine psb_c_base_get_diag(a,d,info) import :: psb_c_base_sparse_mat, psb_spk_ @@ -435,6 +433,7 @@ module psb_c_base_mat_mod end subroutine psb_c_base_mold end interface + interface subroutine psb_c_base_cp_to_coo(a,b,info) import :: psb_c_base_sparse_mat, psb_c_coo_sparse_mat, psb_spk_ @@ -511,7 +510,7 @@ module psb_c_base_mat_mod subroutine psb_c_base_transp_2mat(a,b) import :: psb_c_base_sparse_mat, psb_base_sparse_mat, psb_spk_ class(psb_c_base_sparse_mat), intent(in) :: a - class(psb_base_sparse_mat), intent(out) :: b + class(psb_base_sparse_mat), intent(out) :: b end subroutine psb_c_base_transp_2mat end interface @@ -519,7 +518,7 @@ module psb_c_base_mat_mod subroutine psb_c_base_transc_2mat(a,b) import :: psb_c_base_sparse_mat, psb_base_sparse_mat, psb_spk_ class(psb_c_base_sparse_mat), intent(in) :: a - class(psb_base_sparse_mat), intent(out) :: b + class(psb_base_sparse_mat), intent(out) :: b end subroutine psb_c_base_transc_2mat end interface @@ -586,6 +585,7 @@ module psb_c_base_mat_mod integer, intent(out) :: info end subroutine psb_c_coo_mold end interface + interface subroutine psb_c_coo_print(iout,a,iv,eirs,eics,head,ivr,ivc) @@ -802,6 +802,7 @@ module psb_c_base_mat_mod end subroutine psb_c_coo_csmm end interface + interface function psb_c_coo_maxval(a) result(res) import :: psb_c_coo_sparse_mat, psb_spk_ @@ -830,7 +831,7 @@ module psb_c_base_mat_mod subroutine psb_c_coo_rowsum(d,a) import :: psb_c_coo_sparse_mat, psb_spk_ class(psb_c_coo_sparse_mat), intent(in) :: a - complex(psb_spk_), intent(out) :: d(:) + complex(psb_spk_), intent(out) :: d(:) end subroutine psb_c_coo_rowsum end interface @@ -838,7 +839,7 @@ module psb_c_base_mat_mod subroutine psb_c_coo_arwsum(d,a) import :: psb_c_coo_sparse_mat, psb_spk_ class(psb_c_coo_sparse_mat), intent(in) :: a - real(psb_spk_), intent(out) :: d(:) + real(psb_spk_), intent(out) :: d(:) end subroutine psb_c_coo_arwsum end interface @@ -846,7 +847,7 @@ module psb_c_base_mat_mod subroutine psb_c_coo_colsum(d,a) import :: psb_c_coo_sparse_mat, psb_spk_ class(psb_c_coo_sparse_mat), intent(in) :: a - complex(psb_spk_), intent(out) :: d(:) + complex(psb_spk_), intent(out) :: d(:) end subroutine psb_c_coo_colsum end interface @@ -854,7 +855,7 @@ module psb_c_base_mat_mod subroutine psb_c_coo_aclsum(d,a) import :: psb_c_coo_sparse_mat, psb_spk_ class(psb_c_coo_sparse_mat), intent(in) :: a - real(psb_spk_), intent(out) :: d(:) + real(psb_spk_), intent(out) :: d(:) end subroutine psb_c_coo_aclsum end interface @@ -938,7 +939,7 @@ contains class(psb_c_coo_sparse_mat), intent(in) :: a integer(psb_long_int_k_) :: res res = 8 + 1 - res = res + 2 * psb_sizeof_sp * size(a%val) + res = res + (2*psb_sizeof_sp) * size(a%val) res = res + psb_sizeof_int * size(a%ia) res = res + psb_sizeof_int * size(a%ja) @@ -1018,8 +1019,6 @@ contains ! ! == ================================== - - subroutine c_coo_free(a) implicit none @@ -1071,13 +1070,15 @@ contains end subroutine c_coo_transp_1mat subroutine c_coo_transc_1mat(a) - implicit none class(psb_c_coo_sparse_mat), intent(inout) :: a call a%transp() - a%val(:) = conjg(a%val) + ! This will morph into conjg() for C and Z + ! and into a no-op for S and D, so a conditional + ! on a constant ought to take it out completely. + if (psb_c_is_complex_) a%val(:) = conjg(a%val(:)) end subroutine c_coo_transc_1mat diff --git a/base/modules/psb_c_base_vect_mod.f90 b/base/modules/psb_c_base_vect_mod.f90 index 24913431..04deb578 100644 --- a/base/modules/psb_c_base_vect_mod.f90 +++ b/base/modules/psb_c_base_vect_mod.f90 @@ -7,7 +7,6 @@ module psb_c_base_vect_mod complex(psb_spk_), allocatable :: v(:) contains procedure, pass(x) :: get_nrows => c_base_get_nrows - procedure, pass(x) :: sizeof => c_base_sizeof procedure, pass(x) :: dot_v => c_base_dot_v procedure, pass(x) :: dot_a => c_base_dot_a generic, public :: dot => dot_v, dot_a @@ -72,12 +71,10 @@ contains subroutine c_base_bld_n(x,n) - use psb_realloc_mod integer, intent(in) :: n class(psb_c_base_vect_type), intent(inout) :: x integer :: info - call psb_realloc(n,x%v,info) call x%asb(n,info) end subroutine c_base_bld_n @@ -116,14 +113,10 @@ contains subroutine c_base_set_vect(x,val) class(psb_c_base_vect_type), intent(inout) :: x complex(psb_spk_), intent(in) :: val(:) - integer :: nr + integer :: info - if (allocated(x%v)) then - nr = min(size(x%v),size(val)) - x%v(1:nr) = val(1:nr) - else - x%v = val - end if + x%v = val + end subroutine c_base_set_vect @@ -146,27 +139,21 @@ contains end function size_const + function c_base_get_nrows(x) result(res) implicit none class(psb_c_base_vect_type), intent(in) :: x integer :: res - res = 0 + res = -1 if (allocated(x%v)) res = size(x%v) end function c_base_get_nrows - function c_base_sizeof(x) result(res) - implicit none - class(psb_c_base_vect_type), intent(in) :: x - integer(psb_long_int_k_) :: res - res = (2*psb_sizeof_sp)*x%get_nrows() - end function c_base_sizeof - function c_base_dot_v(n,x,y) result(res) implicit none class(psb_c_base_vect_type), intent(inout) :: x, y integer, intent(in) :: n - complex(psb_spk_) :: res - complex(psb_spk_), external :: cdotc + complex(psb_spk_) :: res + complex(psb_spk_), external :: cdotc res = czero ! @@ -186,10 +173,10 @@ contains function c_base_dot_a(n,x,y) result(res) implicit none class(psb_c_base_vect_type), intent(inout) :: x - complex(psb_spk_), intent(in) :: y(:) + complex(psb_spk_), intent(in) :: y(:) integer, intent(in) :: n - complex(psb_spk_) :: res - complex(psb_spk_), external :: cdotc + complex(psb_spk_) :: res + complex(psb_spk_), external :: cdotc res = cdotc(n,y,1,x%v,1) @@ -268,13 +255,11 @@ contains subroutine c_base_mlt_a_2(alpha,x,y,beta,z,info) use psi_serial_mod implicit none - complex(psb_spk_), intent(in) :: alpha,beta - complex(psb_spk_), intent(in) :: y(:) - complex(psb_spk_), intent(in) :: x(:) - class(psb_c_base_vect_type), intent(inout) :: z - integer, intent(out) :: info -! character(len=1), intent(in), optional :: conjgx, conjgy - + complex(psb_spk_), intent(in) :: alpha,beta + complex(psb_spk_), intent(in) :: y(:) + complex(psb_spk_), intent(in) :: x(:) + class(psb_c_base_vect_type), intent(inout) :: z + integer, intent(out) :: info integer :: i, n info = 0 @@ -335,32 +320,19 @@ contains end if end subroutine c_base_mlt_a_2 - subroutine c_base_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy) + subroutine c_base_mlt_v_2(alpha,x,y,beta,z,info) use psi_serial_mod - use psb_string_mod implicit none - complex(psb_spk_), intent(in) :: alpha,beta - class(psb_c_base_vect_type), intent(inout) :: x - class(psb_c_base_vect_type), intent(inout) :: y - class(psb_c_base_vect_type), intent(inout) :: z - integer, intent(out) :: info - character(len=1), intent(in), optional :: conjgx, conjgy + complex(psb_spk_), intent(in) :: alpha,beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + class(psb_c_base_vect_type), intent(inout) :: z + integer, intent(out) :: info integer :: i, n info = 0 - if (present(conjgx)) then - if (psb_toupper(conjgx)=='C') x%v=conjg(x%v) - end if - if (present(conjgy)) then - if (psb_toupper(conjgy)=='C') y%v=conjg(y%v) - end if + call z%mlt(alpha,x%v,y%v,beta,info) - if (present(conjgx)) then - if (psb_toupper(conjgx)=='C') x%v=conjg(x%v) - end if - if (present(conjgy)) then - if (psb_toupper(conjgy)=='C') y%v=conjg(y%v) - end if end subroutine c_base_mlt_v_2 diff --git a/base/modules/psb_c_csc_mat_mod.f90 b/base/modules/psb_c_csc_mat_mod.f90 index 02864652..3fa94fd7 100644 --- a/base/modules/psb_c_csc_mat_mod.f90 +++ b/base/modules/psb_c_csc_mat_mod.f90 @@ -38,7 +38,6 @@ ! specific to the type and could not be defined higher in the ! hierarchy). We are at the bottom level of the inheritance chain. ! - module psb_c_csc_mat_mod use psb_c_base_mat_mod @@ -80,7 +79,7 @@ module psb_c_csc_mat_mod procedure, pass(a) :: get_diag => psb_c_csc_get_diag procedure, pass(a) :: csgetptn => psb_c_csc_csgetptn procedure, pass(a) :: c_csgetrow => psb_c_csc_csgetrow -!!$ procedure, pass(a) :: get_nz_col => c_csc_get_nz_col + procedure, pass(a) :: get_nz_col => c_csc_get_nz_col procedure, pass(a) :: reinit => psb_c_csc_reinit procedure, pass(a) :: trim => psb_c_csc_trim procedure, pass(a) :: print => psb_c_csc_print @@ -94,7 +93,7 @@ module psb_c_csc_mat_mod end type psb_c_csc_sparse_mat private :: c_csc_get_nzeros, c_csc_free, c_csc_get_fmt, & - & c_csc_get_size, c_csc_sizeof, c_csc_get_nc_col + & c_csc_get_size, c_csc_sizeof, c_csc_get_nz_col interface subroutine psb_c_csc_reallocate_nz(nz,a) @@ -127,7 +126,7 @@ module psb_c_csc_mat_mod integer, intent(in), optional :: nz end subroutine psb_c_csc_allocate_mnnz end interface - + interface subroutine psb_c_csc_mold(a,b,info) import :: psb_c_csc_sparse_mat, psb_c_base_sparse_mat, psb_long_int_k_ @@ -336,6 +335,7 @@ module psb_c_csc_mat_mod end subroutine psb_c_csc_csmm end interface + interface function psb_c_csc_maxval(a) result(res) import :: psb_c_csc_sparse_mat, psb_spk_ @@ -364,7 +364,7 @@ module psb_c_csc_mat_mod subroutine psb_c_csc_rowsum(d,a) import :: psb_c_csc_sparse_mat, psb_spk_ class(psb_c_csc_sparse_mat), intent(in) :: a - complex(psb_spk_), intent(out) :: d(:) + complex(psb_spk_), intent(out) :: d(:) end subroutine psb_c_csc_rowsum end interface @@ -372,7 +372,7 @@ module psb_c_csc_mat_mod subroutine psb_c_csc_arwsum(d,a) import :: psb_c_csc_sparse_mat, psb_spk_ class(psb_c_csc_sparse_mat), intent(in) :: a - real(psb_spk_), intent(out) :: d(:) + real(psb_spk_), intent(out) :: d(:) end subroutine psb_c_csc_arwsum end interface @@ -380,7 +380,7 @@ module psb_c_csc_mat_mod subroutine psb_c_csc_colsum(d,a) import :: psb_c_csc_sparse_mat, psb_spk_ class(psb_c_csc_sparse_mat), intent(in) :: a - complex(psb_spk_), intent(out) :: d(:) + complex(psb_spk_), intent(out) :: d(:) end subroutine psb_c_csc_colsum end interface @@ -388,10 +388,10 @@ module psb_c_csc_mat_mod subroutine psb_c_csc_aclsum(d,a) import :: psb_c_csc_sparse_mat, psb_spk_ class(psb_c_csc_sparse_mat), intent(in) :: a - real(psb_spk_), intent(out) :: d(:) + real(psb_spk_), intent(out) :: d(:) end subroutine psb_c_csc_aclsum end interface - + interface subroutine psb_c_csc_get_diag(a,d,info) import :: psb_c_csc_sparse_mat, psb_spk_ @@ -440,7 +440,7 @@ contains class(psb_c_csc_sparse_mat), intent(in) :: a integer(psb_long_int_k_) :: res res = 8 - res = res + 2 * psb_sizeof_sp * size(a%val) + res = res + (2*psb_sizeof_sp) * size(a%val) res = res + psb_sizeof_int * size(a%icp) res = res + psb_sizeof_int * size(a%ia) @@ -464,7 +464,7 @@ contains class(psb_c_csc_sparse_mat), intent(in) :: a integer :: res - res = -1 + res = 0 if (allocated(a%ia)) then if (res >= 0) then @@ -485,7 +485,7 @@ contains - function c_csc_get_nc_col(idx,a) result(res) + function c_csc_get_nz_col(idx,a) result(res) use psb_const_mod implicit none @@ -499,7 +499,7 @@ contains res = a%icp(idx+1)-a%icp(idx) end if - end function c_csc_get_nc_col + end function c_csc_get_nz_col diff --git a/base/modules/psb_c_csr_mat_mod.f90 b/base/modules/psb_c_csr_mat_mod.f90 index 58ea137b..f733d549 100644 --- a/base/modules/psb_c_csr_mat_mod.f90 +++ b/base/modules/psb_c_csr_mat_mod.f90 @@ -79,7 +79,7 @@ module psb_c_csr_mat_mod procedure, pass(a) :: get_diag => psb_c_csr_get_diag procedure, pass(a) :: csgetptn => psb_c_csr_csgetptn procedure, pass(a) :: c_csgetrow => psb_c_csr_csgetrow -!!$ procedure, pass(a) :: get_nz_row => c_csr_get_nz_row + procedure, pass(a) :: get_nz_row => c_csr_get_nz_row procedure, pass(a) :: reinit => psb_c_csr_reinit procedure, pass(a) :: trim => psb_c_csr_trim procedure, pass(a) :: print => psb_c_csr_print @@ -93,7 +93,7 @@ module psb_c_csr_mat_mod end type psb_c_csr_sparse_mat private :: c_csr_get_nzeros, c_csr_free, c_csr_get_fmt, & - & c_csr_get_size, c_csr_sizeof, c_csr_get_nc_row + & c_csr_get_size, c_csr_sizeof, c_csr_get_nz_row interface subroutine psb_c_csr_reallocate_nz(nz,a) @@ -126,7 +126,7 @@ module psb_c_csr_mat_mod integer, intent(out) :: info end subroutine psb_c_csr_mold end interface - + interface subroutine psb_c_csr_allocate_mnnz(m,n,a,nz) import :: psb_c_csr_sparse_mat @@ -135,7 +135,7 @@ module psb_c_csr_mat_mod integer, intent(in), optional :: nz end subroutine psb_c_csr_allocate_mnnz end interface - + interface subroutine psb_c_csr_print(iout,a,iv,eirs,eics,head,ivr,ivc) import :: psb_c_csr_sparse_mat @@ -335,6 +335,7 @@ module psb_c_csr_mat_mod end subroutine psb_c_csr_csmm end interface + interface function psb_c_csr_maxval(a) result(res) import :: psb_c_csr_sparse_mat, psb_spk_ @@ -342,7 +343,7 @@ module psb_c_csr_mat_mod real(psb_spk_) :: res end function psb_c_csr_maxval end interface - + interface function psb_c_csr_csnmi(a) result(res) import :: psb_c_csr_sparse_mat, psb_spk_ @@ -363,7 +364,7 @@ module psb_c_csr_mat_mod subroutine psb_c_csr_rowsum(d,a) import :: psb_c_csr_sparse_mat, psb_spk_ class(psb_c_csr_sparse_mat), intent(in) :: a - complex(psb_spk_), intent(out) :: d(:) + complex(psb_spk_), intent(out) :: d(:) end subroutine psb_c_csr_rowsum end interface @@ -371,7 +372,7 @@ module psb_c_csr_mat_mod subroutine psb_c_csr_arwsum(d,a) import :: psb_c_csr_sparse_mat, psb_spk_ class(psb_c_csr_sparse_mat), intent(in) :: a - real(psb_spk_), intent(out) :: d(:) + real(psb_spk_), intent(out) :: d(:) end subroutine psb_c_csr_arwsum end interface @@ -379,7 +380,7 @@ module psb_c_csr_mat_mod subroutine psb_c_csr_colsum(d,a) import :: psb_c_csr_sparse_mat, psb_spk_ class(psb_c_csr_sparse_mat), intent(in) :: a - complex(psb_spk_), intent(out) :: d(:) + complex(psb_spk_), intent(out) :: d(:) end subroutine psb_c_csr_colsum end interface @@ -387,7 +388,7 @@ module psb_c_csr_mat_mod subroutine psb_c_csr_aclsum(d,a) import :: psb_c_csr_sparse_mat, psb_spk_ class(psb_c_csr_sparse_mat), intent(in) :: a - real(psb_spk_), intent(out) :: d(:) + real(psb_spk_), intent(out) :: d(:) end subroutine psb_c_csr_aclsum end interface @@ -440,7 +441,7 @@ contains class(psb_c_csr_sparse_mat), intent(in) :: a integer(psb_long_int_k_) :: res res = 8 - res = res + 2 * psb_sizeof_sp * size(a%val) + res = res + (2*psb_sizeof_sp) * size(a%val) res = res + psb_sizeof_int * size(a%irp) res = res + psb_sizeof_int * size(a%ja) @@ -464,7 +465,7 @@ contains class(psb_c_csr_sparse_mat), intent(in) :: a integer :: res - res = -1 + res = 0 if (allocated(a%ja)) then if (res >= 0) then @@ -485,7 +486,7 @@ contains - function c_csr_get_nc_row(idx,a) result(res) + function c_csr_get_nz_row(idx,a) result(res) implicit none @@ -499,7 +500,7 @@ contains res = a%irp(idx+1)-a%irp(idx) end if - end function c_csr_get_nc_row + end function c_csr_get_nz_row diff --git a/base/modules/psb_c_mat_mod.f90 b/base/modules/psb_c_mat_mod.f90 index c4788be7..bfa7906a 100644 --- a/base/modules/psb_c_mat_mod.f90 +++ b/base/modules/psb_c_mat_mod.f90 @@ -109,7 +109,6 @@ module psb_c_mat_mod procedure, pass(a) :: c_cscnv_ip => psb_c_cscnv_ip procedure, pass(a) :: c_cscnv_base => psb_c_cscnv_base generic, public :: cscnv => c_cscnv, c_cscnv_ip, c_cscnv_base - procedure, pass(a) :: clone => psb_cspmat_type_clone procedure, pass(a) :: reinit => psb_c_reinit procedure, pass(a) :: print_i => psb_c_sparse_print procedure, pass(a) :: print_n => psb_c_n_sparse_print @@ -154,9 +153,9 @@ module psb_c_mat_mod end type psb_cspmat_type private :: psb_c_get_nrows, psb_c_get_ncols, psb_c_get_nzeros, psb_c_get_size, & - & psb_c_get_state, psb_c_get_dupl, psb_c_is_null, psb_c_is_bld, psb_c_is_upd, & - & psb_c_is_asb, psb_c_is_sorted, psb_c_is_upper, psb_c_is_lower, psb_c_is_triangle,& - & psb_c_get_nz_row + & psb_c_get_state, psb_c_get_dupl, psb_c_is_null, psb_c_is_bld, & + & psb_c_is_upd, psb_c_is_asb, psb_c_is_sorted, psb_c_is_upper, & + & psb_c_is_lower, psb_c_is_triangle, psb_c_get_nz_row interface psb_sizeof module procedure psb_c_sizeof @@ -347,9 +346,9 @@ module psb_c_mat_mod interface subroutine psb_c_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(inout) :: a - complex(psb_spk_), intent(in) :: val(:) + complex(psb_dpk_), intent(in) :: val(:) integer, intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer, intent(out) :: info integer, intent(in), optional :: gtl(:) @@ -359,7 +358,7 @@ module psb_c_mat_mod interface subroutine psb_c_csgetptn(imin,imax,a,nz,ia,ja,info,& & jmin,jmax,iren,append,nzin,rscale,cscale) - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(in) :: a integer, intent(in) :: imin,imax integer, intent(out) :: nz @@ -375,12 +374,12 @@ module psb_c_mat_mod interface subroutine psb_c_csgetrow(imin,imax,a,nz,ia,ja,val,info,& & jmin,jmax,iren,append,nzin,rscale,cscale) - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(in) :: a integer, intent(in) :: imin,imax integer, intent(out) :: nz integer, allocatable, intent(inout) :: ia(:), ja(:) - complex(psb_spk_), allocatable, intent(inout) :: val(:) + complex(psb_dpk_), allocatable, intent(inout) :: val(:) integer,intent(out) :: info logical, intent(in), optional :: append integer, intent(in), optional :: iren(:) @@ -392,7 +391,7 @@ module psb_c_mat_mod interface subroutine psb_c_csgetblk(imin,imax,a,b,info,& & jmin,jmax,iren,append,rscale,cscale) - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(in) :: a class(psb_cspmat_type), intent(out) :: b integer, intent(in) :: imin,imax @@ -407,7 +406,7 @@ module psb_c_mat_mod interface subroutine psb_c_csclip(a,b,info,& & imin,imax,jmin,jmax,rscale,cscale) - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(in) :: a class(psb_cspmat_type), intent(out) :: b integer,intent(out) :: info @@ -419,7 +418,7 @@ module psb_c_mat_mod interface subroutine psb_c_b_csclip(a,b,info,& & imin,imax,jmin,jmax,rscale,cscale) - import :: psb_cspmat_type, psb_spk_, psb_c_coo_sparse_mat + import :: psb_cspmat_type, psb_dpk_, psb_c_coo_sparse_mat class(psb_cspmat_type), intent(in) :: a type(psb_c_coo_sparse_mat), intent(out) :: b integer,intent(out) :: info @@ -430,7 +429,7 @@ module psb_c_mat_mod interface subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl) - import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat + import :: psb_cspmat_type, psb_dpk_, psb_c_base_sparse_mat class(psb_cspmat_type), intent(in) :: a class(psb_cspmat_type), intent(out) :: b integer, intent(out) :: info @@ -443,7 +442,7 @@ module psb_c_mat_mod interface subroutine psb_c_cscnv_ip(a,iinfo,type,mold,dupl) - import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat + import :: psb_cspmat_type, psb_dpk_, psb_c_base_sparse_mat class(psb_cspmat_type), intent(inout) :: a integer, intent(out) :: iinfo integer,optional, intent(in) :: dupl @@ -455,7 +454,7 @@ module psb_c_mat_mod interface subroutine psb_c_cscnv_base(a,b,info,dupl) - import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat + import :: psb_cspmat_type, psb_dpk_, psb_c_base_sparse_mat class(psb_cspmat_type), intent(in) :: a class(psb_c_base_sparse_mat), intent(out) :: b integer, intent(out) :: info @@ -482,32 +481,32 @@ module psb_c_mat_mod interface subroutine psb_c_mv_from(a,b) - import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat - class(psb_cspmat_type), intent(out) :: a + import :: psb_cspmat_type, psb_dpk_, psb_c_base_sparse_mat + class(psb_cspmat_type), intent(out) :: a class(psb_c_base_sparse_mat), intent(inout) :: b end subroutine psb_c_mv_from end interface interface subroutine psb_c_cp_from(a,b) - import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat - class(psb_cspmat_type), intent(out) :: a - class(psb_c_base_sparse_mat), intent(in) :: b + import :: psb_cspmat_type, psb_dpk_, psb_c_base_sparse_mat + class(psb_cspmat_type), intent(out) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b end subroutine psb_c_cp_from end interface interface subroutine psb_c_mv_to(a,b) - import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat - class(psb_cspmat_type), intent(inout) :: a + import :: psb_cspmat_type, psb_dpk_, psb_c_base_sparse_mat + class(psb_cspmat_type), intent(inout) :: a class(psb_c_base_sparse_mat), intent(out) :: b end subroutine psb_c_mv_to end interface interface subroutine psb_c_cp_to(a,b) - import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat - class(psb_cspmat_type), intent(in) :: a + import :: psb_cspmat_type, psb_dpk_, psb_c_base_sparse_mat + class(psb_cspmat_type), intent(in) :: a class(psb_c_base_sparse_mat), intent(out) :: b end subroutine psb_c_cp_to end interface @@ -537,7 +536,7 @@ module psb_c_mat_mod class(psb_c_base_sparse_mat), allocatable, intent(out) :: b end subroutine psb_c_mold end interface - + interface subroutine psb_c_transp_1mat(a) import :: psb_cspmat_type @@ -594,26 +593,26 @@ module psb_c_mat_mod interface psb_csmm subroutine psb_c_csmm(alpha,a,x,beta,y,info,trans) - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(in) :: a - complex(psb_spk_), intent(in) :: alpha, beta, x(:,:) - complex(psb_spk_), intent(inout) :: y(:,:) + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), intent(inout) :: y(:,:) integer, intent(out) :: info character, optional, intent(in) :: trans end subroutine psb_c_csmm subroutine psb_c_csmv(alpha,a,x,beta,y,info,trans) - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(in) :: a - complex(psb_spk_), intent(in) :: alpha, beta, x(:) - complex(psb_spk_), intent(inout) :: y(:) + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) integer, intent(out) :: info character, optional, intent(in) :: trans end subroutine psb_c_csmv subroutine psb_c_csmv_vect(alpha,a,x,beta,y,info,trans) use psb_c_vect_mod, only : psb_c_vect_type - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(in) :: a - complex(psb_spk_), intent(in) :: alpha, beta + complex(psb_dpk_), intent(in) :: alpha, beta type(psb_c_vect_type), intent(inout) :: x type(psb_c_vect_type), intent(inout) :: y integer, intent(out) :: info @@ -623,28 +622,28 @@ module psb_c_mat_mod interface psb_cssm subroutine psb_c_cssm(alpha,a,x,beta,y,info,trans,scale,d) - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(in) :: a - complex(psb_spk_), intent(in) :: alpha, beta, x(:,:) - complex(psb_spk_), intent(inout) :: y(:,:) + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), intent(inout) :: y(:,:) integer, intent(out) :: info character, optional, intent(in) :: trans, scale - complex(psb_spk_), intent(in), optional :: d(:) + complex(psb_dpk_), intent(in), optional :: d(:) end subroutine psb_c_cssm subroutine psb_c_cssv(alpha,a,x,beta,y,info,trans,scale,d) - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(in) :: a - complex(psb_spk_), intent(in) :: alpha, beta, x(:) - complex(psb_spk_), intent(inout) :: y(:) + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) integer, intent(out) :: info character, optional, intent(in) :: trans, scale - complex(psb_spk_), intent(in), optional :: d(:) + complex(psb_dpk_), intent(in), optional :: d(:) end subroutine psb_c_cssv subroutine psb_c_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d) use psb_c_vect_mod, only : psb_c_vect_type - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(in) :: a - complex(psb_spk_), intent(in) :: alpha, beta + complex(psb_dpk_), intent(in) :: alpha, beta type(psb_c_vect_type), intent(inout) :: x type(psb_c_vect_type), intent(inout) :: y integer, intent(out) :: info @@ -655,60 +654,60 @@ module psb_c_mat_mod interface function psb_c_maxval(a) result(res) - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(in) :: a - real(psb_spk_) :: res + real(psb_dpk_) :: res end function psb_c_maxval end interface interface function psb_c_csnmi(a) result(res) - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(in) :: a - real(psb_spk_) :: res + real(psb_dpk_) :: res end function psb_c_csnmi end interface interface function psb_c_csnm1(a) result(res) - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(in) :: a - real(psb_spk_) :: res + real(psb_dpk_) :: res end function psb_c_csnm1 end interface interface subroutine psb_c_rowsum(d,a,info) - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(in) :: a - complex(psb_spk_), intent(out) :: d(:) + complex(psb_dpk_), intent(out) :: d(:) integer, intent(out) :: info end subroutine psb_c_rowsum end interface interface subroutine psb_c_arwsum(d,a,info) - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(in) :: a - real(psb_spk_), intent(out) :: d(:) + real(psb_dpk_), intent(out) :: d(:) integer, intent(out) :: info end subroutine psb_c_arwsum end interface interface subroutine psb_c_colsum(d,a,info) - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(in) :: a - complex(psb_spk_), intent(out) :: d(:) + complex(psb_dpk_), intent(out) :: d(:) integer, intent(out) :: info end subroutine psb_c_colsum end interface interface subroutine psb_c_aclsum(d,a,info) - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(in) :: a - real(psb_spk_), intent(out) :: d(:) + real(psb_dpk_), intent(out) :: d(:) integer, intent(out) :: info end subroutine psb_c_aclsum end interface @@ -716,24 +715,24 @@ module psb_c_mat_mod interface subroutine psb_c_get_diag(a,d,info) - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(in) :: a - complex(psb_spk_), intent(out) :: d(:) + complex(psb_dpk_), intent(out) :: d(:) integer, intent(out) :: info end subroutine psb_c_get_diag end interface interface psb_scal subroutine psb_c_scal(d,a,info) - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(inout) :: a - complex(psb_spk_), intent(in) :: d(:) + complex(psb_dpk_), intent(in) :: d(:) integer, intent(out) :: info end subroutine psb_c_scal subroutine psb_c_scals(d,a,info) - import :: psb_cspmat_type, psb_spk_ + import :: psb_cspmat_type, psb_dpk_ class(psb_cspmat_type), intent(inout) :: a - complex(psb_spk_), intent(in) :: d + complex(psb_dpk_), intent(in) :: d integer, intent(out) :: info end subroutine psb_c_scals end interface @@ -768,7 +767,6 @@ contains end function psb_c_sizeof - function psb_c_get_fmt(a) result(res) implicit none class(psb_cspmat_type), intent(in) :: a @@ -985,7 +983,7 @@ contains integer, intent(in) :: idx class(psb_cspmat_type), intent(in) :: a integer :: res - + res = 0 if (allocated(a%a)) res = a%a%get_nz_row(idx) diff --git a/base/modules/psb_d_base_mat_mod.f90 b/base/modules/psb_d_base_mat_mod.f90 index 406fc6ce..3a527772 100644 --- a/base/modules/psb_d_base_mat_mod.f90 +++ b/base/modules/psb_d_base_mat_mod.f90 @@ -34,7 +34,7 @@ ! ! This module contains the implementation of the psb_d_base_sparse_mat ! type, derived from the psb_base_sparse_mat one to define a middle -! level definition of a real, double-precision sparse matrix +! level definition of a real(psb_dpk_) sparse matrix ! object.This class object itself does not have any additional members ! with respect to those of the base class. No methods can be fully ! implemented at this level, but we can define the interface for the @@ -50,11 +50,9 @@ ! psb_d_base_sparse_mat one. ! ! About the method MOLD: this has been defined for those compilers -! not yet supporting ALLOCATE( ...MOLD=...); it's otherwise silly to +! not yet supporting ALLOCATE( ...,MOLD=...); it's otherwise silly to ! duplicate "by hand" what is specified in the language (in this case F2008) ! - - module psb_d_base_mat_mod use psb_base_mat_mod @@ -512,7 +510,7 @@ module psb_d_base_mat_mod subroutine psb_d_base_transp_2mat(a,b) import :: psb_d_base_sparse_mat, psb_base_sparse_mat, psb_dpk_ class(psb_d_base_sparse_mat), intent(in) :: a - class(psb_base_sparse_mat), intent(out) :: b + class(psb_base_sparse_mat), intent(out) :: b end subroutine psb_d_base_transp_2mat end interface @@ -520,7 +518,7 @@ module psb_d_base_mat_mod subroutine psb_d_base_transc_2mat(a,b) import :: psb_d_base_sparse_mat, psb_base_sparse_mat, psb_dpk_ class(psb_d_base_sparse_mat), intent(in) :: a - class(psb_base_sparse_mat), intent(out) :: b + class(psb_base_sparse_mat), intent(out) :: b end subroutine psb_d_base_transc_2mat end interface @@ -1077,6 +1075,11 @@ contains class(psb_d_coo_sparse_mat), intent(inout) :: a call a%transp() + ! This will morph into conjg() for C and Z + ! and into a no-op for S and D, so a conditional + ! on a constant ought to take it out completely. + if (psb_d_is_complex_) a%val(:) = (a%val(:)) + end subroutine d_coo_transc_1mat diff --git a/base/modules/psb_d_base_vect_mod.f90 b/base/modules/psb_d_base_vect_mod.f90 index dc555e05..1a4b12bd 100644 --- a/base/modules/psb_d_base_vect_mod.f90 +++ b/base/modules/psb_d_base_vect_mod.f90 @@ -7,7 +7,6 @@ module psb_d_base_vect_mod real(psb_dpk_), allocatable :: v(:) contains procedure, pass(x) :: get_nrows => d_base_get_nrows - procedure, pass(x) :: sizeof => d_base_sizeof procedure, pass(x) :: dot_v => d_base_dot_v procedure, pass(x) :: dot_a => d_base_dot_a generic, public :: dot => dot_v, dot_a @@ -72,12 +71,10 @@ contains subroutine d_base_bld_n(x,n) - use psb_realloc_mod integer, intent(in) :: n class(psb_d_base_vect_type), intent(inout) :: x integer :: info - - call psb_realloc(n,x%v,info) + call x%asb(n,info) end subroutine d_base_bld_n @@ -116,14 +113,10 @@ contains subroutine d_base_set_vect(x,val) class(psb_d_base_vect_type), intent(inout) :: x real(psb_dpk_), intent(in) :: val(:) - integer :: nr + integer :: info - if (allocated(x%v)) then - nr = min(size(x%v),size(val)) - x%v(1:nr) = val(1:nr) - else - x%v = val - end if + x%v = val + end subroutine d_base_set_vect @@ -146,21 +139,15 @@ contains end function size_const + function d_base_get_nrows(x) result(res) implicit none class(psb_d_base_vect_type), intent(in) :: x integer :: res - res = 0 + res = -1 if (allocated(x%v)) res = size(x%v) end function d_base_get_nrows - function d_base_sizeof(x) result(res) - implicit none - class(psb_d_base_vect_type), intent(in) :: x - integer(psb_long_int_k_) :: res - res = psb_sizeof_dp*x%get_nrows() - end function d_base_sizeof - function d_base_dot_v(n,x,y) result(res) implicit none class(psb_d_base_vect_type), intent(inout) :: x, y @@ -227,24 +214,15 @@ contains end subroutine d_base_axpby_a - subroutine d_base_mlt_v(x, y, info, xconj) + subroutine d_base_mlt_v(x, y, info) use psi_serial_mod - use psb_string_mod implicit none - class(psb_d_base_vect_type), intent(inout) :: x - class(psb_d_base_vect_type), intent(inout) :: y - integer, intent(out) :: info - character, intent(in), optional :: xconj - integer :: i, n - character :: xconj_ + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer, intent(out) :: info + integer :: i, n info = 0 - if (present(xconj)) then - xconj_ = (psb_toupper(xconj)) - else - xconj_ = 'N' - end if - select type(xx => x) type is (psb_d_base_vect_type) n = min(size(y%v), size(xx%v)) diff --git a/base/modules/psb_d_csc_mat_mod.f90 b/base/modules/psb_d_csc_mat_mod.f90 index 35a8ad67..1ee956f7 100644 --- a/base/modules/psb_d_csc_mat_mod.f90 +++ b/base/modules/psb_d_csc_mat_mod.f90 @@ -464,7 +464,7 @@ contains class(psb_d_csc_sparse_mat), intent(in) :: a integer :: res - res = -1 + res = 0 if (allocated(a%ia)) then if (res >= 0) then diff --git a/base/modules/psb_d_csr_mat_mod.f90 b/base/modules/psb_d_csr_mat_mod.f90 index 294b5695..9bc8fbb4 100644 --- a/base/modules/psb_d_csr_mat_mod.f90 +++ b/base/modules/psb_d_csr_mat_mod.f90 @@ -465,7 +465,7 @@ contains class(psb_d_csr_sparse_mat), intent(in) :: a integer :: res - res = -1 + res = 0 if (allocated(a%ja)) then if (res >= 0) then diff --git a/base/modules/psb_d_mat_mod.f90 b/base/modules/psb_d_mat_mod.f90 index 80e1f00a..6974154f 100644 --- a/base/modules/psb_d_mat_mod.f90 +++ b/base/modules/psb_d_mat_mod.f90 @@ -41,6 +41,7 @@ ! methods of the psb_d_mat_mod simply call the methods of the ! encapsulated class. + module psb_d_mat_mod use psb_d_base_mat_mod @@ -108,7 +109,6 @@ module psb_d_mat_mod procedure, pass(a) :: d_cscnv_ip => psb_d_cscnv_ip procedure, pass(a) :: d_cscnv_base => psb_d_cscnv_base generic, public :: cscnv => d_cscnv, d_cscnv_ip, d_cscnv_base - procedure, pass(a) :: clone => psb_dspmat_type_clone procedure, pass(a) :: reinit => psb_d_reinit procedure, pass(a) :: print_i => psb_d_sparse_print procedure, pass(a) :: print_n => psb_d_n_sparse_print @@ -129,8 +129,6 @@ module psb_d_mat_mod procedure, pass(a) :: d_transc_2mat => psb_d_transc_2mat generic, public :: transc => d_transc_1mat, d_transc_2mat - - ! Computational routines procedure, pass(a) :: get_diag => psb_d_get_diag procedure, pass(a) :: maxval => psb_d_maxval @@ -155,9 +153,9 @@ module psb_d_mat_mod end type psb_dspmat_type private :: psb_d_get_nrows, psb_d_get_ncols, psb_d_get_nzeros, psb_d_get_size, & - & psb_d_get_state, psb_d_get_dupl, psb_d_is_null, psb_d_is_bld, psb_d_is_upd, & - & psb_d_is_asb, psb_d_is_sorted, psb_d_is_upper, psb_d_is_lower,& - & psb_d_is_triangle, psb_d_get_nz_row + & psb_d_get_state, psb_d_get_dupl, psb_d_is_null, psb_d_is_bld, & + & psb_d_is_upd, psb_d_is_asb, psb_d_is_sorted, psb_d_is_upper, & + & psb_d_is_lower, psb_d_is_triangle, psb_d_get_nz_row interface psb_sizeof module procedure psb_d_sizeof @@ -185,7 +183,7 @@ module psb_d_mat_mod integer, intent(in) :: m end subroutine psb_d_set_nrows end interface - + interface subroutine psb_d_set_ncols(n,a) import :: psb_dspmat_type @@ -193,7 +191,7 @@ module psb_d_mat_mod integer, intent(in) :: n end subroutine psb_d_set_ncols end interface - + interface subroutine psb_d_set_state(n,a) import :: psb_dspmat_type @@ -201,7 +199,7 @@ module psb_d_mat_mod integer, intent(in) :: n end subroutine psb_d_set_state end interface - + interface subroutine psb_d_set_dupl(n,a) import :: psb_dspmat_type @@ -209,35 +207,35 @@ module psb_d_mat_mod integer, intent(in) :: n end subroutine psb_d_set_dupl end interface - + interface subroutine psb_d_set_null(a) import :: psb_dspmat_type class(psb_dspmat_type), intent(inout) :: a end subroutine psb_d_set_null end interface - + interface subroutine psb_d_set_bld(a) import :: psb_dspmat_type class(psb_dspmat_type), intent(inout) :: a end subroutine psb_d_set_bld end interface - + interface subroutine psb_d_set_upd(a) import :: psb_dspmat_type class(psb_dspmat_type), intent(inout) :: a end subroutine psb_d_set_upd end interface - + interface subroutine psb_d_set_asb(a) import :: psb_dspmat_type class(psb_dspmat_type), intent(inout) :: a end subroutine psb_d_set_asb end interface - + interface subroutine psb_d_set_sorted(a,val) import :: psb_dspmat_type @@ -245,7 +243,7 @@ module psb_d_mat_mod logical, intent(in), optional :: val end subroutine psb_d_set_sorted end interface - + interface subroutine psb_d_set_triangle(a,val) import :: psb_dspmat_type @@ -253,7 +251,7 @@ module psb_d_mat_mod logical, intent(in), optional :: val end subroutine psb_d_set_triangle end interface - + interface subroutine psb_d_set_unit(a,val) import :: psb_dspmat_type @@ -261,7 +259,7 @@ module psb_d_mat_mod logical, intent(in), optional :: val end subroutine psb_d_set_unit end interface - + interface subroutine psb_d_set_lower(a,val) import :: psb_dspmat_type @@ -269,7 +267,7 @@ module psb_d_mat_mod logical, intent(in), optional :: val end subroutine psb_d_set_lower end interface - + interface subroutine psb_d_set_upper(a,val) import :: psb_dspmat_type @@ -277,8 +275,7 @@ module psb_d_mat_mod logical, intent(in), optional :: val end subroutine psb_d_set_upper end interface - - + interface subroutine psb_d_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc) import :: psb_dspmat_type @@ -302,7 +299,7 @@ module psb_d_mat_mod integer, intent(in), optional :: ivr(:), ivc(:) end subroutine psb_d_n_sparse_print end interface - + interface subroutine psb_d_get_neigh(a,idx,neigh,n,info,lev) import :: psb_dspmat_type @@ -314,7 +311,7 @@ module psb_d_mat_mod integer, optional, intent(in) :: lev end subroutine psb_d_get_neigh end interface - + interface subroutine psb_d_csall(nr,nc,a,info,nz) import :: psb_dspmat_type @@ -324,7 +321,7 @@ module psb_d_mat_mod integer, intent(in), optional :: nz end subroutine psb_d_csall end interface - + interface subroutine psb_d_reallocate_nz(nz,a) import :: psb_dspmat_type @@ -332,21 +329,21 @@ module psb_d_mat_mod class(psb_dspmat_type), intent(inout) :: a end subroutine psb_d_reallocate_nz end interface - + interface subroutine psb_d_free(a) import :: psb_dspmat_type class(psb_dspmat_type), intent(inout) :: a end subroutine psb_d_free end interface - + interface subroutine psb_d_trim(a) import :: psb_dspmat_type class(psb_dspmat_type), intent(inout) :: a end subroutine psb_d_trim end interface - + interface subroutine psb_d_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) import :: psb_dspmat_type, psb_dpk_ @@ -357,10 +354,10 @@ module psb_d_mat_mod integer, intent(in), optional :: gtl(:) end subroutine psb_d_csput end interface - + interface subroutine psb_d_csgetptn(imin,imax,a,nz,ia,ja,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale) import :: psb_dspmat_type, psb_dpk_ class(psb_dspmat_type), intent(in) :: a integer, intent(in) :: imin,imax @@ -373,7 +370,7 @@ module psb_d_mat_mod logical, intent(in), optional :: rscale,cscale end subroutine psb_d_csgetptn end interface - + interface subroutine psb_d_csgetrow(imin,imax,a,nz,ia,ja,val,info,& & jmin,jmax,iren,append,nzin,rscale,cscale) @@ -390,10 +387,10 @@ module psb_d_mat_mod logical, intent(in), optional :: rscale,cscale end subroutine psb_d_csgetrow end interface - + interface subroutine psb_d_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) + & jmin,jmax,iren,append,rscale,cscale) import :: psb_dspmat_type, psb_dpk_ class(psb_dspmat_type), intent(in) :: a class(psb_dspmat_type), intent(out) :: b @@ -405,10 +402,10 @@ module psb_d_mat_mod logical, intent(in), optional :: rscale,cscale end subroutine psb_d_csgetblk end interface - + interface subroutine psb_d_csclip(a,b,info,& - & imin,imax,jmin,jmax,rscale,cscale) + & imin,imax,jmin,jmax,rscale,cscale) import :: psb_dspmat_type, psb_dpk_ class(psb_dspmat_type), intent(in) :: a class(psb_dspmat_type), intent(out) :: b @@ -417,10 +414,10 @@ module psb_d_mat_mod logical, intent(in), optional :: rscale,cscale end subroutine psb_d_csclip end interface - + interface subroutine psb_d_b_csclip(a,b,info,& - & imin,imax,jmin,jmax,rscale,cscale) + & imin,imax,jmin,jmax,rscale,cscale) import :: psb_dspmat_type, psb_dpk_, psb_d_coo_sparse_mat class(psb_dspmat_type), intent(in) :: a type(psb_d_coo_sparse_mat), intent(out) :: b @@ -429,7 +426,7 @@ module psb_d_mat_mod logical, intent(in), optional :: rscale,cscale end subroutine psb_d_b_csclip end interface - + interface subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl) import :: psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat @@ -441,7 +438,7 @@ module psb_d_mat_mod class(psb_d_base_sparse_mat), intent(in), optional :: mold end subroutine psb_d_cscnv end interface - + interface subroutine psb_d_cscnv_ip(a,iinfo,type,mold,dupl) @@ -453,7 +450,7 @@ module psb_d_mat_mod class(psb_d_base_sparse_mat), intent(in), optional :: mold end subroutine psb_d_cscnv_ip end interface - + interface subroutine psb_d_cscnv_base(a,b,info,dupl) @@ -464,7 +461,7 @@ module psb_d_mat_mod integer,optional, intent(in) :: dupl end subroutine psb_d_cscnv_base end interface - + interface subroutine psb_d_clip_d(a,b,info) import :: psb_dspmat_type @@ -473,7 +470,7 @@ module psb_d_mat_mod integer,intent(out) :: info end subroutine psb_d_clip_d end interface - + interface subroutine psb_d_clip_d_ip(a,info) import :: psb_dspmat_type @@ -481,39 +478,39 @@ module psb_d_mat_mod integer,intent(out) :: info end subroutine psb_d_clip_d_ip end interface - + interface subroutine psb_d_mv_from(a,b) import :: psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat - class(psb_dspmat_type), intent(out) :: a + class(psb_dspmat_type), intent(out) :: a class(psb_d_base_sparse_mat), intent(inout) :: b end subroutine psb_d_mv_from end interface - + interface subroutine psb_d_cp_from(a,b) import :: psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat - class(psb_dspmat_type), intent(out) :: a - class(psb_d_base_sparse_mat), intent(in) :: b + class(psb_dspmat_type), intent(out) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b end subroutine psb_d_cp_from end interface - + interface subroutine psb_d_mv_to(a,b) import :: psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat - class(psb_dspmat_type), intent(inout) :: a + class(psb_dspmat_type), intent(inout) :: a class(psb_d_base_sparse_mat), intent(out) :: b end subroutine psb_d_mv_to end interface - + interface subroutine psb_d_cp_to(a,b) import :: psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat - class(psb_dspmat_type), intent(in) :: a + class(psb_dspmat_type), intent(in) :: a class(psb_d_base_sparse_mat), intent(out) :: b end subroutine psb_d_cp_to end interface - + interface psb_move_alloc subroutine psb_dspmat_type_move(a,b,info) import :: psb_dspmat_type @@ -522,7 +519,7 @@ module psb_d_mat_mod integer, intent(out) :: info end subroutine psb_dspmat_type_move end interface - + interface psb_clone subroutine psb_dspmat_type_clone(a,b,info) import :: psb_dspmat_type @@ -539,14 +536,14 @@ module psb_d_mat_mod class(psb_d_base_sparse_mat), allocatable, intent(out) :: b end subroutine psb_d_mold end interface - + interface subroutine psb_d_transp_1mat(a) import :: psb_dspmat_type class(psb_dspmat_type), intent(inout) :: a end subroutine psb_d_transp_1mat end interface - + interface subroutine psb_d_transp_2mat(a,b) import :: psb_dspmat_type @@ -554,14 +551,14 @@ module psb_d_mat_mod class(psb_dspmat_type), intent(out) :: b end subroutine psb_d_transp_2mat end interface - + interface subroutine psb_d_transc_1mat(a) import :: psb_dspmat_type class(psb_dspmat_type), intent(inout) :: a end subroutine psb_d_transc_1mat end interface - + interface subroutine psb_d_transc_2mat(a,b) import :: psb_dspmat_type @@ -569,15 +566,16 @@ module psb_d_mat_mod class(psb_dspmat_type), intent(out) :: b end subroutine psb_d_transc_2mat end interface - + interface subroutine psb_d_reinit(a,clear) import :: psb_dspmat_type class(psb_dspmat_type), intent(inout) :: a logical, intent(in), optional :: clear end subroutine psb_d_reinit - + end interface + ! == =================================== @@ -613,15 +611,15 @@ module psb_d_mat_mod subroutine psb_d_csmv_vect(alpha,a,x,beta,y,info,trans) use psb_d_vect_mod, only : psb_d_vect_type import :: psb_dspmat_type, psb_dpk_ - class(psb_dspmat_type), intent(in) :: a - real(psb_dpk_), intent(in) :: alpha, beta - type(psb_d_vect_type), intent(inout) :: x - type(psb_d_vect_type), intent(inout) :: y - integer, intent(out) :: info - character, optional, intent(in) :: trans + class(psb_dspmat_type), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + type(psb_d_vect_type), intent(inout) :: x + type(psb_d_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans end subroutine psb_d_csmv_vect end interface - + interface psb_cssm subroutine psb_d_cssm(alpha,a,x,beta,y,info,trans,scale,d) import :: psb_dspmat_type, psb_dpk_ @@ -645,7 +643,7 @@ module psb_d_mat_mod use psb_d_vect_mod, only : psb_d_vect_type import :: psb_dspmat_type, psb_dpk_ class(psb_dspmat_type), intent(in) :: a - real(psb_dpk_), intent(in) :: alpha, beta + real(psb_dpk_), intent(in) :: alpha, beta type(psb_d_vect_type), intent(inout) :: x type(psb_d_vect_type), intent(inout) :: y integer, intent(out) :: info @@ -653,7 +651,7 @@ module psb_d_mat_mod type(psb_d_vect_type), optional, intent(inout) :: d end subroutine psb_d_cssv_vect end interface - + interface function psb_d_maxval(a) result(res) import :: psb_dspmat_type, psb_dpk_ @@ -682,8 +680,8 @@ module psb_d_mat_mod subroutine psb_d_rowsum(d,a,info) import :: psb_dspmat_type, psb_dpk_ class(psb_dspmat_type), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) - integer, intent(out) :: info + real(psb_dpk_), intent(out) :: d(:) + integer, intent(out) :: info end subroutine psb_d_rowsum end interface @@ -691,8 +689,8 @@ module psb_d_mat_mod subroutine psb_d_arwsum(d,a,info) import :: psb_dspmat_type, psb_dpk_ class(psb_dspmat_type), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) - integer, intent(out) :: info + real(psb_dpk_), intent(out) :: d(:) + integer, intent(out) :: info end subroutine psb_d_arwsum end interface @@ -700,8 +698,8 @@ module psb_d_mat_mod subroutine psb_d_colsum(d,a,info) import :: psb_dspmat_type, psb_dpk_ class(psb_dspmat_type), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) - integer, intent(out) :: info + real(psb_dpk_), intent(out) :: d(:) + integer, intent(out) :: info end subroutine psb_d_colsum end interface @@ -709,12 +707,12 @@ module psb_d_mat_mod subroutine psb_d_aclsum(d,a,info) import :: psb_dspmat_type, psb_dpk_ class(psb_dspmat_type), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) - integer, intent(out) :: info + real(psb_dpk_), intent(out) :: d(:) + integer, intent(out) :: info end subroutine psb_d_aclsum end interface - + interface subroutine psb_d_get_diag(a,d,info) import :: psb_dspmat_type, psb_dpk_ @@ -723,7 +721,7 @@ module psb_d_mat_mod integer, intent(out) :: info end subroutine psb_d_get_diag end interface - + interface psb_scal subroutine psb_d_scal(d,a,info) import :: psb_dspmat_type, psb_dpk_ @@ -755,21 +753,20 @@ contains ! ! == =================================== - + function psb_d_sizeof(a) result(res) implicit none class(psb_dspmat_type), intent(in) :: a integer(psb_long_int_k_) :: res - + res = 0 if (allocated(a%a)) then res = a%a%sizeof() end if - + end function psb_d_sizeof - function psb_d_get_fmt(a) result(res) implicit none class(psb_dspmat_type), intent(in) :: a @@ -988,9 +985,10 @@ contains integer :: res res = 0 - + if (allocated(a%a)) res = a%a%get_nz_row(idx) end function psb_d_get_nz_row + end module psb_d_mat_mod diff --git a/base/modules/psb_s_base_mat_mod.f90 b/base/modules/psb_s_base_mat_mod.f90 index caded0fa..5329f66d 100644 --- a/base/modules/psb_s_base_mat_mod.f90 +++ b/base/modules/psb_s_base_mat_mod.f90 @@ -32,13 +32,13 @@ ! ! package: psb_s_base_mat_mod ! -! This module contains the implementation of the -! psb_s_base_sparse_mat, derived from the psb_base_sparse_mat to -! define a middle level definition of a real, single-precision sparse -! matrix object.This class object itself does not have any additional -! members with respect to those of the base class. No methods can be -! fully implemented at this level, but we can define the interface for -! the computational methods requiring the knowledge of the underlying +! This module contains the implementation of the psb_s_base_sparse_mat +! type, derived from the psb_base_sparse_mat one to define a middle +! level definition of a real(psb_spk_) sparse matrix +! object.This class object itself does not have any additional members +! with respect to those of the base class. No methods can be fully +! implemented at this level, but we can define the interface for the +! computational methods requiring the knowledge of the underlying ! field, such as the matrix-vector product; this interface is defined, ! but is supposed to be overridden at the leaf level. ! @@ -50,11 +50,9 @@ ! psb_s_base_sparse_mat one. ! ! About the method MOLD: this has been defined for those compilers -! not yet supporting ALLOCATE( ...MOLD=...); it's otherwise silly to +! not yet supporting ALLOCATE( ...,MOLD=...); it's otherwise silly to ! duplicate "by hand" what is specified in the language (in this case F2008) ! - - module psb_s_base_mat_mod use psb_base_mat_mod @@ -134,13 +132,6 @@ module psb_s_base_mat_mod procedure, pass(a) :: s_inner_cssv => psb_s_coo_cssv procedure, pass(a) :: s_scals => psb_s_coo_scals procedure, pass(a) :: s_scal => psb_s_coo_scal - procedure, pass(a) :: maxval => psb_s_coo_maxval - procedure, pass(a) :: csnmi => psb_s_coo_csnmi - procedure, pass(a) :: csnm1 => psb_s_coo_csnm1 - procedure, pass(a) :: rowsum => psb_s_coo_rowsum - procedure, pass(a) :: arwsum => psb_s_coo_arwsum - procedure, pass(a) :: colsum => psb_s_coo_colsum - procedure, pass(a) :: aclsum => psb_s_coo_aclsum procedure, pass(a) :: reallocate_nz => psb_s_coo_reallocate_nz procedure, pass(a) :: allocate_mnnz => psb_s_coo_allocate_mnnz procedure, pass(a) :: cp_to_coo => psb_s_cp_coo_to_coo @@ -152,6 +143,13 @@ module psb_s_base_mat_mod procedure, pass(a) :: mv_to_fmt => psb_s_mv_coo_to_fmt procedure, pass(a) :: mv_from_fmt => psb_s_mv_coo_from_fmt procedure, pass(a) :: csput => psb_s_coo_csput + procedure, pass(a) :: maxval => psb_s_coo_maxval + procedure, pass(a) :: csnmi => psb_s_coo_csnmi + procedure, pass(a) :: csnm1 => psb_s_coo_csnm1 + procedure, pass(a) :: rowsum => psb_s_coo_rowsum + procedure, pass(a) :: arwsum => psb_s_coo_arwsum + procedure, pass(a) :: colsum => psb_s_coo_colsum + procedure, pass(a) :: aclsum => psb_s_coo_aclsum procedure, pass(a) :: get_diag => psb_s_coo_get_diag procedure, pass(a) :: s_csgetrow => psb_s_coo_csgetrow procedure, pass(a) :: csgetptn => psb_s_coo_csgetptn @@ -217,7 +215,7 @@ module psb_s_base_mat_mod character, optional, intent(in) :: trans end subroutine psb_s_base_vect_mv end interface - + interface subroutine psb_s_base_inner_cssm(alpha,a,x,beta,y,info,trans) import :: psb_s_base_sparse_mat, psb_spk_ @@ -312,7 +310,7 @@ module psb_s_base_mat_mod real(psb_spk_) :: res end function psb_s_base_maxval end interface - + interface function psb_s_base_csnmi(a) result(res) import :: psb_s_base_sparse_mat, psb_spk_ @@ -360,7 +358,7 @@ module psb_s_base_mat_mod real(psb_spk_), intent(out) :: d(:) end subroutine psb_s_base_aclsum end interface - + interface subroutine psb_s_base_get_diag(a,d,info) import :: psb_s_base_sparse_mat, psb_spk_ @@ -512,7 +510,7 @@ module psb_s_base_mat_mod subroutine psb_s_base_transp_2mat(a,b) import :: psb_s_base_sparse_mat, psb_base_sparse_mat, psb_spk_ class(psb_s_base_sparse_mat), intent(in) :: a - class(psb_base_sparse_mat), intent(out) :: b + class(psb_base_sparse_mat), intent(out) :: b end subroutine psb_s_base_transp_2mat end interface @@ -520,7 +518,7 @@ module psb_s_base_mat_mod subroutine psb_s_base_transc_2mat(a,b) import :: psb_s_base_sparse_mat, psb_base_sparse_mat, psb_spk_ class(psb_s_base_sparse_mat), intent(in) :: a - class(psb_base_sparse_mat), intent(out) :: b + class(psb_base_sparse_mat), intent(out) :: b end subroutine psb_s_base_transc_2mat end interface @@ -578,7 +576,7 @@ module psb_s_base_mat_mod integer, intent(in), optional :: nz end subroutine psb_s_coo_allocate_mnnz end interface - + interface subroutine psb_s_coo_mold(a,b,info) import :: psb_s_coo_sparse_mat, psb_s_base_sparse_mat, psb_long_int_k_ @@ -588,6 +586,7 @@ module psb_s_base_mat_mod end subroutine psb_s_coo_mold end interface + interface subroutine psb_s_coo_print(iout,a,iv,eirs,eics,head,ivr,ivc) import :: psb_s_coo_sparse_mat @@ -621,7 +620,7 @@ module psb_s_base_mat_mod integer, intent(in), optional :: idir end subroutine psb_s_fix_coo_inner end interface - + interface subroutine psb_s_fix_coo(a,info,idir) import :: psb_s_coo_sparse_mat @@ -803,7 +802,7 @@ module psb_s_base_mat_mod end subroutine psb_s_coo_csmm end interface - + interface function psb_s_coo_maxval(a) result(res) import :: psb_s_coo_sparse_mat, psb_spk_ @@ -811,7 +810,7 @@ module psb_s_base_mat_mod real(psb_spk_) :: res end function psb_s_coo_maxval end interface - + interface function psb_s_coo_csnmi(a) result(res) import :: psb_s_coo_sparse_mat, psb_spk_ @@ -1076,6 +1075,11 @@ contains class(psb_s_coo_sparse_mat), intent(inout) :: a call a%transp() + ! This will morph into conjg() for C and Z + ! and into a no-op for S and D, so a conditional + ! on a constant ought to take it out completely. + if (psb_s_is_complex_) a%val(:) = (a%val(:)) + end subroutine s_coo_transc_1mat diff --git a/base/modules/psb_s_base_vect_mod.f90 b/base/modules/psb_s_base_vect_mod.f90 index 6972893b..3aaf149e 100644 --- a/base/modules/psb_s_base_vect_mod.f90 +++ b/base/modules/psb_s_base_vect_mod.f90 @@ -7,7 +7,6 @@ module psb_s_base_vect_mod real(psb_spk_), allocatable :: v(:) contains procedure, pass(x) :: get_nrows => s_base_get_nrows - procedure, pass(x) :: sizeof => s_base_sizeof procedure, pass(x) :: dot_v => s_base_dot_v procedure, pass(x) :: dot_a => s_base_dot_a generic, public :: dot => dot_v, dot_a @@ -72,12 +71,10 @@ contains subroutine s_base_bld_n(x,n) - use psb_realloc_mod integer, intent(in) :: n class(psb_s_base_vect_type), intent(inout) :: x integer :: info - call psb_realloc(n,x%v,info) call x%asb(n,info) end subroutine s_base_bld_n @@ -116,14 +113,10 @@ contains subroutine s_base_set_vect(x,val) class(psb_s_base_vect_type), intent(inout) :: x real(psb_spk_), intent(in) :: val(:) - integer :: nr + integer :: info - if (allocated(x%v)) then - nr = min(size(x%v),size(val)) - x%v(1:nr) = val(1:nr) - else - x%v = val - end if + x%v = val + end subroutine s_base_set_vect @@ -146,20 +139,14 @@ contains end function size_const + function s_base_get_nrows(x) result(res) implicit none class(psb_s_base_vect_type), intent(in) :: x integer :: res - res = 0 + res = -1 if (allocated(x%v)) res = size(x%v) end function s_base_get_nrows - - function s_base_sizeof(x) result(res) - implicit none - class(psb_s_base_vect_type), intent(in) :: x - integer(psb_long_int_k_) :: res - res = psb_sizeof_sp*x%get_nrows() - end function s_base_sizeof function s_base_dot_v(n,x,y) result(res) implicit none diff --git a/base/modules/psb_s_csc_mat_mod.f90 b/base/modules/psb_s_csc_mat_mod.f90 index 78b7254b..4264fc26 100644 --- a/base/modules/psb_s_csc_mat_mod.f90 +++ b/base/modules/psb_s_csc_mat_mod.f90 @@ -126,7 +126,7 @@ module psb_s_csc_mat_mod integer, intent(in), optional :: nz end subroutine psb_s_csc_allocate_mnnz end interface - + interface subroutine psb_s_csc_mold(a,b,info) import :: psb_s_csc_sparse_mat, psb_s_base_sparse_mat, psb_long_int_k_ @@ -343,7 +343,7 @@ module psb_s_csc_mat_mod real(psb_spk_) :: res end function psb_s_csc_maxval end interface - + interface function psb_s_csc_csnmi(a) result(res) import :: psb_s_csc_sparse_mat, psb_spk_ @@ -391,7 +391,7 @@ module psb_s_csc_mat_mod real(psb_spk_), intent(out) :: d(:) end subroutine psb_s_csc_aclsum end interface - + interface subroutine psb_s_csc_get_diag(a,d,info) import :: psb_s_csc_sparse_mat, psb_spk_ @@ -464,7 +464,7 @@ contains class(psb_s_csc_sparse_mat), intent(in) :: a integer :: res - res = -1 + res = 0 if (allocated(a%ia)) then if (res >= 0) then diff --git a/base/modules/psb_s_csr_mat_mod.f90 b/base/modules/psb_s_csr_mat_mod.f90 index b4dc061e..4a5f3953 100644 --- a/base/modules/psb_s_csr_mat_mod.f90 +++ b/base/modules/psb_s_csr_mat_mod.f90 @@ -126,7 +126,7 @@ module psb_s_csr_mat_mod integer, intent(out) :: info end subroutine psb_s_csr_mold end interface - + interface subroutine psb_s_csr_allocate_mnnz(m,n,a,nz) import :: psb_s_csr_sparse_mat @@ -135,7 +135,7 @@ module psb_s_csr_mat_mod integer, intent(in), optional :: nz end subroutine psb_s_csr_allocate_mnnz end interface - + interface subroutine psb_s_csr_print(iout,a,iv,eirs,eics,head,ivr,ivc) import :: psb_s_csr_sparse_mat @@ -465,7 +465,7 @@ contains class(psb_s_csr_sparse_mat), intent(in) :: a integer :: res - res = -1 + res = 0 if (allocated(a%ja)) then if (res >= 0) then diff --git a/base/modules/psb_s_mat_mod.f90 b/base/modules/psb_s_mat_mod.f90 index 31a7749d..63b983a7 100644 --- a/base/modules/psb_s_mat_mod.f90 +++ b/base/modules/psb_s_mat_mod.f90 @@ -109,7 +109,6 @@ module psb_s_mat_mod procedure, pass(a) :: s_cscnv_ip => psb_s_cscnv_ip procedure, pass(a) :: s_cscnv_base => psb_s_cscnv_base generic, public :: cscnv => s_cscnv, s_cscnv_ip, s_cscnv_base - procedure, pass(a) :: clone => psb_sspmat_type_clone procedure, pass(a) :: reinit => psb_s_reinit procedure, pass(a) :: print_i => psb_s_sparse_print procedure, pass(a) :: print_n => psb_s_n_sparse_print @@ -130,8 +129,6 @@ module psb_s_mat_mod procedure, pass(a) :: s_transc_2mat => psb_s_transc_2mat generic, public :: transc => s_transc_1mat, s_transc_2mat - - ! Computational routines procedure, pass(a) :: get_diag => psb_s_get_diag procedure, pass(a) :: maxval => psb_s_maxval @@ -156,9 +153,9 @@ module psb_s_mat_mod end type psb_sspmat_type private :: psb_s_get_nrows, psb_s_get_ncols, psb_s_get_nzeros, psb_s_get_size, & - & psb_s_get_state, psb_s_get_dupl, psb_s_is_null, psb_s_is_bld, psb_s_is_upd, & - & psb_s_is_asb, psb_s_is_sorted, psb_s_is_upper, psb_s_is_lower, psb_s_is_triangle,& - & psb_s_get_nz_row + & psb_s_get_state, psb_s_get_dupl, psb_s_is_null, psb_s_is_bld, & + & psb_s_is_upd, psb_s_is_asb, psb_s_is_sorted, psb_s_is_upper, & + & psb_s_is_lower, psb_s_is_triangle, psb_s_get_nz_row interface psb_sizeof module procedure psb_s_sizeof @@ -186,7 +183,7 @@ module psb_s_mat_mod integer, intent(in) :: m end subroutine psb_s_set_nrows end interface - + interface subroutine psb_s_set_ncols(n,a) import :: psb_sspmat_type @@ -194,7 +191,7 @@ module psb_s_mat_mod integer, intent(in) :: n end subroutine psb_s_set_ncols end interface - + interface subroutine psb_s_set_state(n,a) import :: psb_sspmat_type @@ -202,7 +199,7 @@ module psb_s_mat_mod integer, intent(in) :: n end subroutine psb_s_set_state end interface - + interface subroutine psb_s_set_dupl(n,a) import :: psb_sspmat_type @@ -210,35 +207,35 @@ module psb_s_mat_mod integer, intent(in) :: n end subroutine psb_s_set_dupl end interface - + interface subroutine psb_s_set_null(a) import :: psb_sspmat_type class(psb_sspmat_type), intent(inout) :: a end subroutine psb_s_set_null end interface - + interface subroutine psb_s_set_bld(a) import :: psb_sspmat_type class(psb_sspmat_type), intent(inout) :: a end subroutine psb_s_set_bld end interface - + interface subroutine psb_s_set_upd(a) import :: psb_sspmat_type class(psb_sspmat_type), intent(inout) :: a end subroutine psb_s_set_upd end interface - + interface subroutine psb_s_set_asb(a) import :: psb_sspmat_type class(psb_sspmat_type), intent(inout) :: a end subroutine psb_s_set_asb end interface - + interface subroutine psb_s_set_sorted(a,val) import :: psb_sspmat_type @@ -246,7 +243,7 @@ module psb_s_mat_mod logical, intent(in), optional :: val end subroutine psb_s_set_sorted end interface - + interface subroutine psb_s_set_triangle(a,val) import :: psb_sspmat_type @@ -254,7 +251,7 @@ module psb_s_mat_mod logical, intent(in), optional :: val end subroutine psb_s_set_triangle end interface - + interface subroutine psb_s_set_unit(a,val) import :: psb_sspmat_type @@ -262,7 +259,7 @@ module psb_s_mat_mod logical, intent(in), optional :: val end subroutine psb_s_set_unit end interface - + interface subroutine psb_s_set_lower(a,val) import :: psb_sspmat_type @@ -270,7 +267,7 @@ module psb_s_mat_mod logical, intent(in), optional :: val end subroutine psb_s_set_lower end interface - + interface subroutine psb_s_set_upper(a,val) import :: psb_sspmat_type @@ -278,8 +275,7 @@ module psb_s_mat_mod logical, intent(in), optional :: val end subroutine psb_s_set_upper end interface - - + interface subroutine psb_s_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc) import :: psb_sspmat_type @@ -303,7 +299,7 @@ module psb_s_mat_mod integer, intent(in), optional :: ivr(:), ivc(:) end subroutine psb_s_n_sparse_print end interface - + interface subroutine psb_s_get_neigh(a,idx,neigh,n,info,lev) import :: psb_sspmat_type @@ -315,7 +311,7 @@ module psb_s_mat_mod integer, optional, intent(in) :: lev end subroutine psb_s_get_neigh end interface - + interface subroutine psb_s_csall(nr,nc,a,info,nz) import :: psb_sspmat_type @@ -325,7 +321,7 @@ module psb_s_mat_mod integer, intent(in), optional :: nz end subroutine psb_s_csall end interface - + interface subroutine psb_s_reallocate_nz(nz,a) import :: psb_sspmat_type @@ -333,36 +329,36 @@ module psb_s_mat_mod class(psb_sspmat_type), intent(inout) :: a end subroutine psb_s_reallocate_nz end interface - + interface subroutine psb_s_free(a) import :: psb_sspmat_type class(psb_sspmat_type), intent(inout) :: a end subroutine psb_s_free end interface - + interface subroutine psb_s_trim(a) import :: psb_sspmat_type class(psb_sspmat_type), intent(inout) :: a end subroutine psb_s_trim end interface - + interface subroutine psb_s_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) - import :: psb_sspmat_type, psb_spk_ + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(inout) :: a - real(psb_spk_), intent(in) :: val(:) + real(psb_dpk_), intent(in) :: val(:) integer, intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer, intent(out) :: info integer, intent(in), optional :: gtl(:) end subroutine psb_s_csput end interface - + interface subroutine psb_s_csgetptn(imin,imax,a,nz,ia,ja,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) - import :: psb_sspmat_type, psb_spk_ + & jmin,jmax,iren,append,nzin,rscale,cscale) + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(in) :: a integer, intent(in) :: imin,imax integer, intent(out) :: nz @@ -374,16 +370,16 @@ module psb_s_mat_mod logical, intent(in), optional :: rscale,cscale end subroutine psb_s_csgetptn end interface - + interface subroutine psb_s_csgetrow(imin,imax,a,nz,ia,ja,val,info,& & jmin,jmax,iren,append,nzin,rscale,cscale) - import :: psb_sspmat_type, psb_spk_ + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(in) :: a integer, intent(in) :: imin,imax integer, intent(out) :: nz integer, allocatable, intent(inout) :: ia(:), ja(:) - real(psb_spk_), allocatable, intent(inout) :: val(:) + real(psb_dpk_), allocatable, intent(inout) :: val(:) integer,intent(out) :: info logical, intent(in), optional :: append integer, intent(in), optional :: iren(:) @@ -391,11 +387,11 @@ module psb_s_mat_mod logical, intent(in), optional :: rscale,cscale end subroutine psb_s_csgetrow end interface - + interface subroutine psb_s_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - import :: psb_sspmat_type, psb_spk_ + & jmin,jmax,iren,append,rscale,cscale) + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(in) :: a class(psb_sspmat_type), intent(out) :: b integer, intent(in) :: imin,imax @@ -406,11 +402,11 @@ module psb_s_mat_mod logical, intent(in), optional :: rscale,cscale end subroutine psb_s_csgetblk end interface - + interface subroutine psb_s_csclip(a,b,info,& - & imin,imax,jmin,jmax,rscale,cscale) - import :: psb_sspmat_type, psb_spk_ + & imin,imax,jmin,jmax,rscale,cscale) + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(in) :: a class(psb_sspmat_type), intent(out) :: b integer,intent(out) :: info @@ -418,11 +414,11 @@ module psb_s_mat_mod logical, intent(in), optional :: rscale,cscale end subroutine psb_s_csclip end interface - + interface subroutine psb_s_b_csclip(a,b,info,& - & imin,imax,jmin,jmax,rscale,cscale) - import :: psb_sspmat_type, psb_spk_, psb_s_coo_sparse_mat + & imin,imax,jmin,jmax,rscale,cscale) + import :: psb_sspmat_type, psb_dpk_, psb_s_coo_sparse_mat class(psb_sspmat_type), intent(in) :: a type(psb_s_coo_sparse_mat), intent(out) :: b integer,intent(out) :: info @@ -430,10 +426,10 @@ module psb_s_mat_mod logical, intent(in), optional :: rscale,cscale end subroutine psb_s_b_csclip end interface - + interface subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl) - import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat + import :: psb_sspmat_type, psb_dpk_, psb_s_base_sparse_mat class(psb_sspmat_type), intent(in) :: a class(psb_sspmat_type), intent(out) :: b integer, intent(out) :: info @@ -442,11 +438,11 @@ module psb_s_mat_mod class(psb_s_base_sparse_mat), intent(in), optional :: mold end subroutine psb_s_cscnv end interface - + interface subroutine psb_s_cscnv_ip(a,iinfo,type,mold,dupl) - import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat + import :: psb_sspmat_type, psb_dpk_, psb_s_base_sparse_mat class(psb_sspmat_type), intent(inout) :: a integer, intent(out) :: iinfo integer,optional, intent(in) :: dupl @@ -454,18 +450,18 @@ module psb_s_mat_mod class(psb_s_base_sparse_mat), intent(in), optional :: mold end subroutine psb_s_cscnv_ip end interface - + interface subroutine psb_s_cscnv_base(a,b,info,dupl) - import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat + import :: psb_sspmat_type, psb_dpk_, psb_s_base_sparse_mat class(psb_sspmat_type), intent(in) :: a class(psb_s_base_sparse_mat), intent(out) :: b integer, intent(out) :: info integer,optional, intent(in) :: dupl end subroutine psb_s_cscnv_base end interface - + interface subroutine psb_s_clip_d(a,b,info) import :: psb_sspmat_type @@ -474,7 +470,7 @@ module psb_s_mat_mod integer,intent(out) :: info end subroutine psb_s_clip_d end interface - + interface subroutine psb_s_clip_d_ip(a,info) import :: psb_sspmat_type @@ -482,39 +478,39 @@ module psb_s_mat_mod integer,intent(out) :: info end subroutine psb_s_clip_d_ip end interface - + interface subroutine psb_s_mv_from(a,b) - import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat - class(psb_sspmat_type), intent(out) :: a + import :: psb_sspmat_type, psb_dpk_, psb_s_base_sparse_mat + class(psb_sspmat_type), intent(out) :: a class(psb_s_base_sparse_mat), intent(inout) :: b end subroutine psb_s_mv_from end interface - + interface subroutine psb_s_cp_from(a,b) - import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat - class(psb_sspmat_type), intent(out) :: a - class(psb_s_base_sparse_mat), intent(in) :: b + import :: psb_sspmat_type, psb_dpk_, psb_s_base_sparse_mat + class(psb_sspmat_type), intent(out) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b end subroutine psb_s_cp_from end interface - + interface subroutine psb_s_mv_to(a,b) - import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat - class(psb_sspmat_type), intent(inout) :: a + import :: psb_sspmat_type, psb_dpk_, psb_s_base_sparse_mat + class(psb_sspmat_type), intent(inout) :: a class(psb_s_base_sparse_mat), intent(out) :: b end subroutine psb_s_mv_to end interface - + interface subroutine psb_s_cp_to(a,b) - import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat - class(psb_sspmat_type), intent(in) :: a + import :: psb_sspmat_type, psb_dpk_, psb_s_base_sparse_mat + class(psb_sspmat_type), intent(in) :: a class(psb_s_base_sparse_mat), intent(out) :: b end subroutine psb_s_cp_to end interface - + interface psb_move_alloc subroutine psb_sspmat_type_move(a,b,info) import :: psb_sspmat_type @@ -522,8 +518,8 @@ module psb_s_mat_mod class(psb_sspmat_type), intent(out) :: b integer, intent(out) :: info end subroutine psb_sspmat_type_move - end interface psb_move_alloc - + end interface + interface psb_clone subroutine psb_sspmat_type_clone(a,b,info) import :: psb_sspmat_type @@ -540,14 +536,14 @@ module psb_s_mat_mod class(psb_s_base_sparse_mat), allocatable, intent(out) :: b end subroutine psb_s_mold end interface - + interface subroutine psb_s_transp_1mat(a) import :: psb_sspmat_type class(psb_sspmat_type), intent(inout) :: a end subroutine psb_s_transp_1mat end interface - + interface subroutine psb_s_transp_2mat(a,b) import :: psb_sspmat_type @@ -555,14 +551,14 @@ module psb_s_mat_mod class(psb_sspmat_type), intent(out) :: b end subroutine psb_s_transp_2mat end interface - + interface subroutine psb_s_transc_1mat(a) import :: psb_sspmat_type class(psb_sspmat_type), intent(inout) :: a end subroutine psb_s_transc_1mat end interface - + interface subroutine psb_s_transc_2mat(a,b) import :: psb_sspmat_type @@ -570,15 +566,16 @@ module psb_s_mat_mod class(psb_sspmat_type), intent(out) :: b end subroutine psb_s_transc_2mat end interface - + interface subroutine psb_s_reinit(a,clear) import :: psb_sspmat_type class(psb_sspmat_type), intent(inout) :: a logical, intent(in), optional :: clear end subroutine psb_s_reinit - + end interface + ! == =================================== @@ -596,57 +593,57 @@ module psb_s_mat_mod interface psb_csmm subroutine psb_s_csmm(alpha,a,x,beta,y,info,trans) - import :: psb_sspmat_type, psb_spk_ + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(in) :: a - real(psb_spk_), intent(in) :: alpha, beta, x(:,:) - real(psb_spk_), intent(inout) :: y(:,:) + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) integer, intent(out) :: info character, optional, intent(in) :: trans end subroutine psb_s_csmm subroutine psb_s_csmv(alpha,a,x,beta,y,info,trans) - import :: psb_sspmat_type, psb_spk_ + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(in) :: a - real(psb_spk_), intent(in) :: alpha, beta, x(:) - real(psb_spk_), intent(inout) :: y(:) + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) integer, intent(out) :: info character, optional, intent(in) :: trans end subroutine psb_s_csmv subroutine psb_s_csmv_vect(alpha,a,x,beta,y,info,trans) use psb_s_vect_mod, only : psb_s_vect_type - import :: psb_sspmat_type, psb_spk_ + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(in) :: a - real(psb_spk_), intent(in) :: alpha, beta + real(psb_dpk_), intent(in) :: alpha, beta type(psb_s_vect_type), intent(inout) :: x type(psb_s_vect_type), intent(inout) :: y integer, intent(out) :: info character, optional, intent(in) :: trans end subroutine psb_s_csmv_vect end interface - + interface psb_cssm subroutine psb_s_cssm(alpha,a,x,beta,y,info,trans,scale,d) - import :: psb_sspmat_type, psb_spk_ + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(in) :: a - real(psb_spk_), intent(in) :: alpha, beta, x(:,:) - real(psb_spk_), intent(inout) :: y(:,:) + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) integer, intent(out) :: info character, optional, intent(in) :: trans, scale - real(psb_spk_), intent(in), optional :: d(:) + real(psb_dpk_), intent(in), optional :: d(:) end subroutine psb_s_cssm subroutine psb_s_cssv(alpha,a,x,beta,y,info,trans,scale,d) - import :: psb_sspmat_type, psb_spk_ + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(in) :: a - real(psb_spk_), intent(in) :: alpha, beta, x(:) - real(psb_spk_), intent(inout) :: y(:) + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) integer, intent(out) :: info character, optional, intent(in) :: trans, scale - real(psb_spk_), intent(in), optional :: d(:) + real(psb_dpk_), intent(in), optional :: d(:) end subroutine psb_s_cssv subroutine psb_s_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d) use psb_s_vect_mod, only : psb_s_vect_type - import :: psb_sspmat_type, psb_spk_ + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(in) :: a - real(psb_spk_), intent(in) :: alpha, beta + real(psb_dpk_), intent(in) :: alpha, beta type(psb_s_vect_type), intent(inout) :: x type(psb_s_vect_type), intent(inout) :: y integer, intent(out) :: info @@ -654,87 +651,88 @@ module psb_s_mat_mod type(psb_s_vect_type), optional, intent(inout) :: d end subroutine psb_s_cssv_vect end interface - + interface function psb_s_maxval(a) result(res) - import :: psb_sspmat_type, psb_spk_ + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(in) :: a - real(psb_spk_) :: res + real(psb_dpk_) :: res end function psb_s_maxval end interface - + interface function psb_s_csnmi(a) result(res) - import :: psb_sspmat_type, psb_spk_ + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(in) :: a - real(psb_spk_) :: res + real(psb_dpk_) :: res end function psb_s_csnmi end interface interface function psb_s_csnm1(a) result(res) - import :: psb_sspmat_type, psb_spk_ + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(in) :: a - real(psb_spk_) :: res + real(psb_dpk_) :: res end function psb_s_csnm1 end interface interface subroutine psb_s_rowsum(d,a,info) - import :: psb_sspmat_type, psb_spk_ + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(in) :: a - real(psb_spk_), intent(out) :: d(:) - integer, intent(out) :: info + real(psb_dpk_), intent(out) :: d(:) + integer, intent(out) :: info end subroutine psb_s_rowsum end interface interface subroutine psb_s_arwsum(d,a,info) - import :: psb_sspmat_type, psb_spk_ + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(in) :: a - real(psb_spk_), intent(out) :: d(:) - integer, intent(out) :: info + real(psb_dpk_), intent(out) :: d(:) + integer, intent(out) :: info end subroutine psb_s_arwsum end interface interface subroutine psb_s_colsum(d,a,info) - import :: psb_sspmat_type, psb_spk_ + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(in) :: a - real(psb_spk_), intent(out) :: d(:) - integer, intent(out) :: info + real(psb_dpk_), intent(out) :: d(:) + integer, intent(out) :: info end subroutine psb_s_colsum end interface interface subroutine psb_s_aclsum(d,a,info) - import :: psb_sspmat_type, psb_spk_ + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(in) :: a - real(psb_spk_), intent(out) :: d(:) - integer, intent(out) :: info + real(psb_dpk_), intent(out) :: d(:) + integer, intent(out) :: info end subroutine psb_s_aclsum end interface + interface subroutine psb_s_get_diag(a,d,info) - import :: psb_sspmat_type, psb_spk_ + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(in) :: a - real(psb_spk_), intent(out) :: d(:) + real(psb_dpk_), intent(out) :: d(:) integer, intent(out) :: info end subroutine psb_s_get_diag end interface - + interface psb_scal subroutine psb_s_scal(d,a,info) - import :: psb_sspmat_type, psb_spk_ + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(inout) :: a - real(psb_spk_), intent(in) :: d(:) + real(psb_dpk_), intent(in) :: d(:) integer, intent(out) :: info end subroutine psb_s_scal subroutine psb_s_scals(d,a,info) - import :: psb_sspmat_type, psb_spk_ + import :: psb_sspmat_type, psb_dpk_ class(psb_sspmat_type), intent(inout) :: a - real(psb_spk_), intent(in) :: d + real(psb_dpk_), intent(in) :: d integer, intent(out) :: info end subroutine psb_s_scals end interface @@ -755,21 +753,20 @@ contains ! ! == =================================== - + function psb_s_sizeof(a) result(res) implicit none class(psb_sspmat_type), intent(in) :: a integer(psb_long_int_k_) :: res - + res = 0 if (allocated(a%a)) then res = a%a%sizeof() end if - + end function psb_s_sizeof - function psb_s_get_fmt(a) result(res) implicit none class(psb_sspmat_type), intent(in) :: a @@ -988,9 +985,10 @@ contains integer :: res res = 0 - + if (allocated(a%a)) res = a%a%get_nz_row(idx) end function psb_s_get_nz_row + end module psb_s_mat_mod diff --git a/base/modules/psb_z_base_mat_mod.f90 b/base/modules/psb_z_base_mat_mod.f90 index 412fefcb..7a3b94b9 100644 --- a/base/modules/psb_z_base_mat_mod.f90 +++ b/base/modules/psb_z_base_mat_mod.f90 @@ -32,16 +32,15 @@ ! ! package: psb_z_base_mat_mod ! -! This module contains the implementation of the -! psb_z_base_sparse_mat, derived from the psb_base_sparse_mat to -! define a middle level definition of a complex, double-precision -! sparse matrix object.This class object itself does not have any -! additional members with respect to those of the base class. No -! methods can be fully implemented at this level, but we can define -! the interface for the computational methods requiring the knowledge -! of the underlying field, such as the matrix-vector product; this -! interface is defined, but is supposed to be overridden at the leaf -! level. +! This module contains the implementation of the psb_z_base_sparse_mat +! type, derived from the psb_base_sparse_mat one to define a middle +! level definition of a complex(psb_dpk_) sparse matrix +! object.This class object itself does not have any additional members +! with respect to those of the base class. No methods can be fully +! implemented at this level, but we can define the interface for the +! computational methods requiring the knowledge of the underlying +! field, such as the matrix-vector product; this interface is defined, +! but is supposed to be overridden at the leaf level. ! ! This module also contains the implementation of the ! psb_z_coo_sparse_mat type and the related methods. This is the @@ -51,11 +50,9 @@ ! psb_z_base_sparse_mat one. ! ! About the method MOLD: this has been defined for those compilers -! not yet supporting ALLOCATE( ...MOLD=...); it's otherwise silly to +! not yet supporting ALLOCATE( ...,MOLD=...); it's otherwise silly to ! duplicate "by hand" what is specified in the language (in this case F2008) ! - - module psb_z_base_mat_mod use psb_base_mat_mod @@ -135,13 +132,6 @@ module psb_z_base_mat_mod procedure, pass(a) :: z_inner_cssv => psb_z_coo_cssv procedure, pass(a) :: z_scals => psb_z_coo_scals procedure, pass(a) :: z_scal => psb_z_coo_scal - procedure, pass(a) :: maxval => psb_z_coo_maxval - procedure, pass(a) :: csnmi => psb_z_coo_csnmi - procedure, pass(a) :: csnm1 => psb_z_coo_csnm1 - procedure, pass(a) :: rowsum => psb_z_coo_rowsum - procedure, pass(a) :: arwsum => psb_z_coo_arwsum - procedure, pass(a) :: colsum => psb_z_coo_colsum - procedure, pass(a) :: aclsum => psb_z_coo_aclsum procedure, pass(a) :: reallocate_nz => psb_z_coo_reallocate_nz procedure, pass(a) :: allocate_mnnz => psb_z_coo_allocate_mnnz procedure, pass(a) :: cp_to_coo => psb_z_cp_coo_to_coo @@ -153,6 +143,13 @@ module psb_z_base_mat_mod procedure, pass(a) :: mv_to_fmt => psb_z_mv_coo_to_fmt procedure, pass(a) :: mv_from_fmt => psb_z_mv_coo_from_fmt procedure, pass(a) :: csput => psb_z_coo_csput + procedure, pass(a) :: maxval => psb_z_coo_maxval + procedure, pass(a) :: csnmi => psb_z_coo_csnmi + procedure, pass(a) :: csnm1 => psb_z_coo_csnm1 + procedure, pass(a) :: rowsum => psb_z_coo_rowsum + procedure, pass(a) :: arwsum => psb_z_coo_arwsum + procedure, pass(a) :: colsum => psb_z_coo_colsum + procedure, pass(a) :: aclsum => psb_z_coo_aclsum procedure, pass(a) :: get_diag => psb_z_coo_get_diag procedure, pass(a) :: z_csgetrow => psb_z_coo_csgetrow procedure, pass(a) :: csgetptn => psb_z_coo_csgetptn @@ -211,14 +208,14 @@ module psb_z_base_mat_mod subroutine psb_z_base_vect_mv(alpha,a,x,beta,y,info,trans) import :: psb_z_base_sparse_mat, psb_dpk_, psb_z_base_vect_type class(psb_z_base_sparse_mat), intent(in) :: a - complex(psb_dpk_), intent(in) :: alpha, beta + complex(psb_dpk_), intent(in) :: alpha, beta class(psb_z_base_vect_type), intent(inout) :: x class(psb_z_base_vect_type), intent(inout) :: y integer, intent(out) :: info character, optional, intent(in) :: trans end subroutine psb_z_base_vect_mv end interface - + interface subroutine psb_z_base_inner_cssm(alpha,a,x,beta,y,info,trans) import :: psb_z_base_sparse_mat, psb_dpk_ @@ -245,7 +242,7 @@ module psb_z_base_mat_mod subroutine psb_z_base_inner_vect_sv(alpha,a,x,beta,y,info,trans) import :: psb_z_base_sparse_mat, psb_dpk_, psb_z_base_vect_type class(psb_z_base_sparse_mat), intent(in) :: a - complex(psb_dpk_), intent(in) :: alpha, beta + complex(psb_dpk_), intent(in) :: alpha, beta class(psb_z_base_vect_type), intent(inout) :: x, y integer, intent(out) :: info character, optional, intent(in) :: trans @@ -280,7 +277,7 @@ module psb_z_base_mat_mod subroutine psb_z_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d) import :: psb_z_base_sparse_mat, psb_dpk_,psb_z_base_vect_type class(psb_z_base_sparse_mat), intent(in) :: a - complex(psb_dpk_), intent(in) :: alpha, beta + complex(psb_dpk_), intent(in) :: alpha, beta class(psb_z_base_vect_type), intent(inout) :: x,y integer, intent(out) :: info character, optional, intent(in) :: trans, scale @@ -321,7 +318,7 @@ module psb_z_base_mat_mod real(psb_dpk_) :: res end function psb_z_base_csnmi end interface - + interface function psb_z_base_csnm1(a) result(res) import :: psb_z_base_sparse_mat, psb_dpk_ @@ -361,7 +358,7 @@ module psb_z_base_mat_mod real(psb_dpk_), intent(out) :: d(:) end subroutine psb_z_base_aclsum end interface - + interface subroutine psb_z_base_get_diag(a,d,info) import :: psb_z_base_sparse_mat, psb_dpk_ @@ -513,7 +510,7 @@ module psb_z_base_mat_mod subroutine psb_z_base_transp_2mat(a,b) import :: psb_z_base_sparse_mat, psb_base_sparse_mat, psb_dpk_ class(psb_z_base_sparse_mat), intent(in) :: a - class(psb_base_sparse_mat), intent(out) :: b + class(psb_base_sparse_mat), intent(out) :: b end subroutine psb_z_base_transp_2mat end interface @@ -521,7 +518,7 @@ module psb_z_base_mat_mod subroutine psb_z_base_transc_2mat(a,b) import :: psb_z_base_sparse_mat, psb_base_sparse_mat, psb_dpk_ class(psb_z_base_sparse_mat), intent(in) :: a - class(psb_base_sparse_mat), intent(out) :: b + class(psb_base_sparse_mat), intent(out) :: b end subroutine psb_z_base_transc_2mat end interface @@ -588,6 +585,7 @@ module psb_z_base_mat_mod integer, intent(out) :: info end subroutine psb_z_coo_mold end interface + interface subroutine psb_z_coo_print(iout,a,iv,eirs,eics,head,ivr,ivc) @@ -803,7 +801,8 @@ module psb_z_base_mat_mod character, optional, intent(in) :: trans end subroutine psb_z_coo_csmm end interface - + + interface function psb_z_coo_maxval(a) result(res) import :: psb_z_coo_sparse_mat, psb_dpk_ @@ -811,7 +810,7 @@ module psb_z_base_mat_mod real(psb_dpk_) :: res end function psb_z_coo_maxval end interface - + interface function psb_z_coo_csnmi(a) result(res) import :: psb_z_coo_sparse_mat, psb_dpk_ @@ -832,7 +831,7 @@ module psb_z_base_mat_mod subroutine psb_z_coo_rowsum(d,a) import :: psb_z_coo_sparse_mat, psb_dpk_ class(psb_z_coo_sparse_mat), intent(in) :: a - complex(psb_dpk_), intent(out) :: d(:) + complex(psb_dpk_), intent(out) :: d(:) end subroutine psb_z_coo_rowsum end interface @@ -840,7 +839,7 @@ module psb_z_base_mat_mod subroutine psb_z_coo_arwsum(d,a) import :: psb_z_coo_sparse_mat, psb_dpk_ class(psb_z_coo_sparse_mat), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) + real(psb_dpk_), intent(out) :: d(:) end subroutine psb_z_coo_arwsum end interface @@ -848,7 +847,7 @@ module psb_z_base_mat_mod subroutine psb_z_coo_colsum(d,a) import :: psb_z_coo_sparse_mat, psb_dpk_ class(psb_z_coo_sparse_mat), intent(in) :: a - complex(psb_dpk_), intent(out) :: d(:) + complex(psb_dpk_), intent(out) :: d(:) end subroutine psb_z_coo_colsum end interface @@ -856,7 +855,7 @@ module psb_z_base_mat_mod subroutine psb_z_coo_aclsum(d,a) import :: psb_z_coo_sparse_mat, psb_dpk_ class(psb_z_coo_sparse_mat), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) + real(psb_dpk_), intent(out) :: d(:) end subroutine psb_z_coo_aclsum end interface @@ -940,7 +939,7 @@ contains class(psb_z_coo_sparse_mat), intent(in) :: a integer(psb_long_int_k_) :: res res = 8 + 1 - res = res + 2 * psb_sizeof_dp * size(a%val) + res = res + (2*psb_sizeof_dp) * size(a%val) res = res + psb_sizeof_int * size(a%ia) res = res + psb_sizeof_int * size(a%ja) @@ -1020,8 +1019,6 @@ contains ! ! == ================================== - - subroutine z_coo_free(a) implicit none @@ -1073,13 +1070,15 @@ contains end subroutine z_coo_transp_1mat subroutine z_coo_transc_1mat(a) - implicit none class(psb_z_coo_sparse_mat), intent(inout) :: a call a%transp() - a%val(:) = conjg(a%val) + ! This will morph into conjg() for C and Z + ! and into a no-op for S and D, so a conditional + ! on a constant ought to take it out completely. + if (psb_z_is_complex_) a%val(:) = conjg(a%val(:)) end subroutine z_coo_transc_1mat diff --git a/base/modules/psb_z_base_vect_mod.f90 b/base/modules/psb_z_base_vect_mod.f90 index 6b2eb154..3d60f4c8 100644 --- a/base/modules/psb_z_base_vect_mod.f90 +++ b/base/modules/psb_z_base_vect_mod.f90 @@ -7,7 +7,6 @@ module psb_z_base_vect_mod complex(psb_dpk_), allocatable :: v(:) contains procedure, pass(x) :: get_nrows => z_base_get_nrows - procedure, pass(x) :: sizeof => z_base_sizeof procedure, pass(x) :: dot_v => z_base_dot_v procedure, pass(x) :: dot_a => z_base_dot_a generic, public :: dot => dot_v, dot_a @@ -72,12 +71,10 @@ contains subroutine z_base_bld_n(x,n) - use psb_realloc_mod integer, intent(in) :: n class(psb_z_base_vect_type), intent(inout) :: x integer :: info - call psb_realloc(n,x%v,info) call x%asb(n,info) end subroutine z_base_bld_n @@ -116,16 +113,11 @@ contains subroutine z_base_set_vect(x,val) class(psb_z_base_vect_type), intent(inout) :: x complex(psb_dpk_), intent(in) :: val(:) - integer :: nr + integer :: info - if (allocated(x%v)) then - nr = min(size(x%v),size(val)) - x%v(1:nr) = val(1:nr) - else - x%v = val - end if + x%v = val + end subroutine z_base_set_vect - function constructor(x) result(this) @@ -147,27 +139,21 @@ contains end function size_const + function z_base_get_nrows(x) result(res) implicit none class(psb_z_base_vect_type), intent(in) :: x integer :: res - res = 0 + res = -1 if (allocated(x%v)) res = size(x%v) end function z_base_get_nrows - function z_base_sizeof(x) result(res) - implicit none - class(psb_z_base_vect_type), intent(in) :: x - integer(psb_long_int_k_) :: res - res = (2*psb_sizeof_dp)*x%get_nrows() - end function z_base_sizeof - function z_base_dot_v(n,x,y) result(res) implicit none class(psb_z_base_vect_type), intent(inout) :: x, y integer, intent(in) :: n - complex(psb_dpk_) :: res - complex(psb_dpk_), external :: zdotc + complex(psb_dpk_) :: res + complex(psb_dpk_), external :: zdotc res = zzero ! @@ -187,10 +173,10 @@ contains function z_base_dot_a(n,x,y) result(res) implicit none class(psb_z_base_vect_type), intent(inout) :: x - complex(psb_dpk_), intent(in) :: y(:) + complex(psb_dpk_), intent(in) :: y(:) integer, intent(in) :: n - complex(psb_dpk_) :: res - complex(psb_dpk_), external :: zdotc + complex(psb_dpk_) :: res + complex(psb_dpk_), external :: zdotc res = zdotc(n,y,1,x%v,1) @@ -202,7 +188,7 @@ contains integer, intent(in) :: m class(psb_z_base_vect_type), intent(inout) :: x class(psb_z_base_vect_type), intent(inout) :: y - complex(psb_dpk_), intent (in) :: alpha, beta + complex(psb_dpk_), intent (in) :: alpha, beta integer, intent(out) :: info select type(xx => x) @@ -228,72 +214,41 @@ contains end subroutine z_base_axpby_a - subroutine z_base_mlt_v(x, y, info, xconj) + subroutine z_base_mlt_v(x, y, info) use psi_serial_mod - use psb_string_mod implicit none - class(psb_z_base_vect_type), intent(inout) :: x - class(psb_z_base_vect_type), intent(inout) :: y - integer, intent(out) :: info - character, intent(in), optional :: xconj - integer :: i, n - character :: xconj_ + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer, intent(out) :: info + integer :: i, n info = 0 - if (present(xconj)) then - xconj_ = (psb_toupper(xconj)) - else - xconj_ = 'N' - end if - select type(xx => x) type is (psb_z_base_vect_type) n = min(size(y%v), size(xx%v)) - select case (xconj_) - case ('C') - do i=1, n - y%v(i) = y%v(i)*conjg(xx%v(i)) - end do - case default - do i=1, n - y%v(i) = y%v(i)*xx%v(i) - end do - end select + do i=1, n + y%v(i) = y%v(i)*xx%v(i) + end do class default - call y%mlt(x%v,info,xconj) + call y%mlt(x%v,info) end select end subroutine z_base_mlt_v - subroutine z_base_mlt_a(x, y, info, xconj) + subroutine z_base_mlt_a(x, y, info) use psi_serial_mod - use psb_string_mod implicit none - complex(psb_dpk_), intent(in) :: x(:) - class(psb_z_base_vect_type), intent(inout) :: y - integer, intent(out) :: info - character, intent(in), optional :: xconj - character :: xconj_ + complex(psb_dpk_), intent(in) :: x(:) + class(psb_z_base_vect_type), intent(inout) :: y + integer, intent(out) :: info integer :: i, n info = 0 - if (present(xconj)) then - xconj_ = (psb_toupper(xconj)) - else - xconj_ = 'N' - end if - n = min(size(y%v), size(x)) - select case (xconj_) - case ('C') - do i=1, n - y%v(i) = y%v(i)*conjg(x(i)) - end do - case default - do i=1, n - y%v(i) = y%v(i)*x(i) - end do - end select + do i=1, n + y%v(i) = y%v(i)*x(i) + end do + end subroutine z_base_mlt_a @@ -365,44 +320,30 @@ contains end if end subroutine z_base_mlt_a_2 - subroutine z_base_mlt_v_2(alpha,x,y,beta,z,info,xconj,yconj) + subroutine z_base_mlt_v_2(alpha,x,y,beta,z,info) use psi_serial_mod - use psb_string_mod implicit none - complex(psb_dpk_), intent(in) :: alpha,beta - class(psb_z_base_vect_type), intent(inout) :: x - class(psb_z_base_vect_type), intent(inout) :: y - class(psb_z_base_vect_type), intent(inout) :: z - integer, intent(out) :: info - character(len=1), intent(in), optional :: xconj, yconj + complex(psb_dpk_), intent(in) :: alpha,beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + class(psb_z_base_vect_type), intent(inout) :: z + integer, intent(out) :: info integer :: i, n info = 0 - if (present(xconj)) then - if (psb_toupper(xconj)=='C') x%v=conjg(x%v) - end if - if (present(yconj)) then - if (psb_toupper(yconj)=='C') y%v=conjg(y%v) - end if + call z%mlt(alpha,x%v,y%v,beta,info) - if (present(xconj)) then - if (psb_toupper(xconj)=='C') x%v=conjg(x%v) - end if - if (present(yconj)) then - if (psb_toupper(yconj)=='C') y%v=conjg(y%v) - end if end subroutine z_base_mlt_v_2 - subroutine z_base_mlt_av(alpha,x,y,beta,z,info,xconj,yconj) + subroutine z_base_mlt_av(alpha,x,y,beta,z,info) use psi_serial_mod implicit none - complex(psb_dpk_), intent(in) :: alpha,beta - complex(psb_dpk_), intent(in) :: x(:) - class(psb_z_base_vect_type), intent(inout) :: y - class(psb_z_base_vect_type), intent(inout) :: z - integer, intent(out) :: info - character(len=1), intent(in), optional :: xconj, yconj + complex(psb_dpk_), intent(in) :: alpha,beta + complex(psb_dpk_), intent(in) :: x(:) + class(psb_z_base_vect_type), intent(inout) :: y + class(psb_z_base_vect_type), intent(inout) :: z + integer, intent(out) :: info integer :: i, n info = 0 @@ -411,20 +352,19 @@ contains end subroutine z_base_mlt_av - subroutine z_base_mlt_va(alpha,x,y,beta,z,info,xconj,yconj) + subroutine z_base_mlt_va(alpha,x,y,beta,z,info) use psi_serial_mod implicit none - complex(psb_dpk_), intent(in) :: alpha,beta - complex(psb_dpk_), intent(in) :: y(:) - class(psb_z_base_vect_type), intent(inout) :: x - class(psb_z_base_vect_type), intent(inout) :: z - integer, intent(out) :: info - character(len=1), intent(in), optional :: xconj, yconj + complex(psb_dpk_), intent(in) :: alpha,beta + complex(psb_dpk_), intent(in) :: y(:) + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: z + integer, intent(out) :: info integer :: i, n info = 0 - call z%mlt(alpha,y,x,beta,info,xconj=yconj,yconj=xconj) + call z%mlt(alpha,y,x,beta,info) end subroutine z_base_mlt_va @@ -570,7 +510,7 @@ contains class(psb_z_base_vect_type), intent(inout) :: x integer, intent(in) :: n, dupl integer, intent(in) :: irl(:) - complex(psb_dpk_), intent(in) :: val(:) + complex(psb_dpk_), intent(in) :: val(:) integer, intent(out) :: info integer :: i diff --git a/base/modules/psb_z_csc_mat_mod.f90 b/base/modules/psb_z_csc_mat_mod.f90 index 3fabe8c5..06551550 100644 --- a/base/modules/psb_z_csc_mat_mod.f90 +++ b/base/modules/psb_z_csc_mat_mod.f90 @@ -135,7 +135,7 @@ module psb_z_csc_mat_mod integer, intent(out) :: info end subroutine psb_z_csc_mold end interface - + interface subroutine psb_z_csc_print(iout,a,iv,eirs,eics,head,ivr,ivc) import :: psb_z_csc_sparse_mat @@ -364,7 +364,7 @@ module psb_z_csc_mat_mod subroutine psb_z_csc_rowsum(d,a) import :: psb_z_csc_sparse_mat, psb_dpk_ class(psb_z_csc_sparse_mat), intent(in) :: a - complex(psb_dpk_), intent(out) :: d(:) + complex(psb_dpk_), intent(out) :: d(:) end subroutine psb_z_csc_rowsum end interface @@ -372,7 +372,7 @@ module psb_z_csc_mat_mod subroutine psb_z_csc_arwsum(d,a) import :: psb_z_csc_sparse_mat, psb_dpk_ class(psb_z_csc_sparse_mat), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) + real(psb_dpk_), intent(out) :: d(:) end subroutine psb_z_csc_arwsum end interface @@ -380,7 +380,7 @@ module psb_z_csc_mat_mod subroutine psb_z_csc_colsum(d,a) import :: psb_z_csc_sparse_mat, psb_dpk_ class(psb_z_csc_sparse_mat), intent(in) :: a - complex(psb_dpk_), intent(out) :: d(:) + complex(psb_dpk_), intent(out) :: d(:) end subroutine psb_z_csc_colsum end interface @@ -388,10 +388,10 @@ module psb_z_csc_mat_mod subroutine psb_z_csc_aclsum(d,a) import :: psb_z_csc_sparse_mat, psb_dpk_ class(psb_z_csc_sparse_mat), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) + real(psb_dpk_), intent(out) :: d(:) end subroutine psb_z_csc_aclsum end interface - + interface subroutine psb_z_csc_get_diag(a,d,info) import :: psb_z_csc_sparse_mat, psb_dpk_ @@ -440,7 +440,7 @@ contains class(psb_z_csc_sparse_mat), intent(in) :: a integer(psb_long_int_k_) :: res res = 8 - res = res + 2 * psb_sizeof_dp * size(a%val) + res = res + (2*psb_sizeof_dp) * size(a%val) res = res + psb_sizeof_int * size(a%icp) res = res + psb_sizeof_int * size(a%ia) @@ -464,7 +464,7 @@ contains class(psb_z_csc_sparse_mat), intent(in) :: a integer :: res - res = -1 + res = 0 if (allocated(a%ia)) then if (res >= 0) then diff --git a/base/modules/psb_z_csr_mat_mod.f90 b/base/modules/psb_z_csr_mat_mod.f90 index edff24b1..aab3dff5 100644 --- a/base/modules/psb_z_csr_mat_mod.f90 +++ b/base/modules/psb_z_csr_mat_mod.f90 @@ -126,7 +126,7 @@ module psb_z_csr_mat_mod integer, intent(out) :: info end subroutine psb_z_csr_mold end interface - + interface subroutine psb_z_csr_allocate_mnnz(m,n,a,nz) import :: psb_z_csr_sparse_mat @@ -135,7 +135,7 @@ module psb_z_csr_mat_mod integer, intent(in), optional :: nz end subroutine psb_z_csr_allocate_mnnz end interface - + interface subroutine psb_z_csr_print(iout,a,iv,eirs,eics,head,ivr,ivc) import :: psb_z_csr_sparse_mat @@ -364,7 +364,7 @@ module psb_z_csr_mat_mod subroutine psb_z_csr_rowsum(d,a) import :: psb_z_csr_sparse_mat, psb_dpk_ class(psb_z_csr_sparse_mat), intent(in) :: a - complex(psb_dpk_), intent(out) :: d(:) + complex(psb_dpk_), intent(out) :: d(:) end subroutine psb_z_csr_rowsum end interface @@ -372,7 +372,7 @@ module psb_z_csr_mat_mod subroutine psb_z_csr_arwsum(d,a) import :: psb_z_csr_sparse_mat, psb_dpk_ class(psb_z_csr_sparse_mat), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) + real(psb_dpk_), intent(out) :: d(:) end subroutine psb_z_csr_arwsum end interface @@ -380,7 +380,7 @@ module psb_z_csr_mat_mod subroutine psb_z_csr_colsum(d,a) import :: psb_z_csr_sparse_mat, psb_dpk_ class(psb_z_csr_sparse_mat), intent(in) :: a - complex(psb_dpk_), intent(out) :: d(:) + complex(psb_dpk_), intent(out) :: d(:) end subroutine psb_z_csr_colsum end interface @@ -388,7 +388,7 @@ module psb_z_csr_mat_mod subroutine psb_z_csr_aclsum(d,a) import :: psb_z_csr_sparse_mat, psb_dpk_ class(psb_z_csr_sparse_mat), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) + real(psb_dpk_), intent(out) :: d(:) end subroutine psb_z_csr_aclsum end interface @@ -441,7 +441,7 @@ contains class(psb_z_csr_sparse_mat), intent(in) :: a integer(psb_long_int_k_) :: res res = 8 - res = res + 2 * psb_sizeof_dp * size(a%val) + res = res + (2*psb_sizeof_dp) * size(a%val) res = res + psb_sizeof_int * size(a%irp) res = res + psb_sizeof_int * size(a%ja) @@ -465,7 +465,7 @@ contains class(psb_z_csr_sparse_mat), intent(in) :: a integer :: res - res = -1 + res = 0 if (allocated(a%ja)) then if (res >= 0) then diff --git a/base/modules/psb_z_mat_mod.f90 b/base/modules/psb_z_mat_mod.f90 index 705ee768..8fd3ed55 100644 --- a/base/modules/psb_z_mat_mod.f90 +++ b/base/modules/psb_z_mat_mod.f90 @@ -109,7 +109,6 @@ module psb_z_mat_mod procedure, pass(a) :: z_cscnv_ip => psb_z_cscnv_ip procedure, pass(a) :: z_cscnv_base => psb_z_cscnv_base generic, public :: cscnv => z_cscnv, z_cscnv_ip, z_cscnv_base - procedure, pass(a) :: clone => psb_zspmat_type_clone procedure, pass(a) :: reinit => psb_z_reinit procedure, pass(a) :: print_i => psb_z_sparse_print procedure, pass(a) :: print_n => psb_z_n_sparse_print @@ -154,9 +153,9 @@ module psb_z_mat_mod end type psb_zspmat_type private :: psb_z_get_nrows, psb_z_get_ncols, psb_z_get_nzeros, psb_z_get_size, & - & psb_z_get_state, psb_z_get_dupl, psb_z_is_null, psb_z_is_bld, psb_z_is_upd, & - & psb_z_is_asb, psb_z_is_sorted, psb_z_is_upper, psb_z_is_lower, psb_z_is_triangle,& - & psb_z_get_nz_row + & psb_z_get_state, psb_z_get_dupl, psb_z_is_null, psb_z_is_bld, & + & psb_z_is_upd, psb_z_is_asb, psb_z_is_sorted, psb_z_is_upper, & + & psb_z_is_lower, psb_z_is_triangle, psb_z_get_nz_row interface psb_sizeof module procedure psb_z_sizeof @@ -483,7 +482,7 @@ module psb_z_mat_mod interface subroutine psb_z_mv_from(a,b) import :: psb_zspmat_type, psb_dpk_, psb_z_base_sparse_mat - class(psb_zspmat_type), intent(out) :: a + class(psb_zspmat_type), intent(out) :: a class(psb_z_base_sparse_mat), intent(inout) :: b end subroutine psb_z_mv_from end interface @@ -491,15 +490,15 @@ module psb_z_mat_mod interface subroutine psb_z_cp_from(a,b) import :: psb_zspmat_type, psb_dpk_, psb_z_base_sparse_mat - class(psb_zspmat_type), intent(out) :: a - class(psb_z_base_sparse_mat), intent(in) :: b + class(psb_zspmat_type), intent(out) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b end subroutine psb_z_cp_from end interface interface subroutine psb_z_mv_to(a,b) import :: psb_zspmat_type, psb_dpk_, psb_z_base_sparse_mat - class(psb_zspmat_type), intent(inout) :: a + class(psb_zspmat_type), intent(inout) :: a class(psb_z_base_sparse_mat), intent(out) :: b end subroutine psb_z_mv_to end interface