diff --git a/base/modules/psb_c_base_mat_mod.f90 b/base/modules/psb_c_base_mat_mod.f90 index 5af10b8d..8a800f7e 100644 --- a/base/modules/psb_c_base_mat_mod.f90 +++ b/base/modules/psb_c_base_mat_mod.f90 @@ -32,15 +32,14 @@ ! ! package: psb_c_base_mat_mod ! -! 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 +! 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 ! 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 @@ -50,9 +49,11 @@ ! 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 @@ -132,6 +133,13 @@ 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 @@ -143,13 +151,6 @@ 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 @@ -208,14 +209,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_ @@ -242,7 +243,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 @@ -277,7 +278,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 @@ -302,7 +303,8 @@ 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_ @@ -318,7 +320,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_ @@ -358,7 +360,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_ @@ -433,7 +435,6 @@ 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_ @@ -510,7 +511,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 @@ -518,7 +519,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 @@ -585,7 +586,6 @@ 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,7 +802,6 @@ 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_ @@ -831,7 +830,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 @@ -839,7 +838,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 @@ -847,7 +846,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 @@ -855,7 +854,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 @@ -939,7 +938,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) @@ -1019,6 +1018,8 @@ contains ! ! == ================================== + + subroutine c_coo_free(a) implicit none @@ -1070,15 +1071,13 @@ 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() - ! 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(:)) + 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 04deb578..24913431 100644 --- a/base/modules/psb_c_base_vect_mod.f90 +++ b/base/modules/psb_c_base_vect_mod.f90 @@ -7,6 +7,7 @@ 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 @@ -71,10 +72,12 @@ 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 @@ -113,10 +116,14 @@ 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 - x%v = val - + 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 end subroutine c_base_set_vect @@ -139,21 +146,27 @@ 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 = -1 + res = 0 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 ! @@ -173,10 +186,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) @@ -255,11 +268,13 @@ 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 + 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 + integer :: i, n info = 0 @@ -320,19 +335,32 @@ contains end if end subroutine c_base_mlt_a_2 - subroutine c_base_mlt_v_2(alpha,x,y,beta,z,info) + subroutine c_base_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy) 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 + 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 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_mat_mod.f90 b/base/modules/psb_c_mat_mod.f90 index bfa7906a..c4788be7 100644 --- a/base/modules/psb_c_mat_mod.f90 +++ b/base/modules/psb_c_mat_mod.f90 @@ -109,6 +109,7 @@ 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 @@ -153,9 +154,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 @@ -346,9 +347,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_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(inout) :: a - complex(psb_dpk_), intent(in) :: val(:) + complex(psb_spk_), intent(in) :: val(:) integer, intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer, intent(out) :: info integer, intent(in), optional :: gtl(:) @@ -358,7 +359,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_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(in) :: a integer, intent(in) :: imin,imax integer, intent(out) :: nz @@ -374,12 +375,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_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(in) :: a integer, intent(in) :: imin,imax integer, intent(out) :: nz integer, allocatable, intent(inout) :: ia(:), ja(:) - complex(psb_dpk_), allocatable, intent(inout) :: val(:) + complex(psb_spk_), allocatable, intent(inout) :: val(:) integer,intent(out) :: info logical, intent(in), optional :: append integer, intent(in), optional :: iren(:) @@ -391,7 +392,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_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(in) :: a class(psb_cspmat_type), intent(out) :: b integer, intent(in) :: imin,imax @@ -406,7 +407,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_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(in) :: a class(psb_cspmat_type), intent(out) :: b integer,intent(out) :: info @@ -418,7 +419,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_dpk_, psb_c_coo_sparse_mat + import :: psb_cspmat_type, psb_spk_, 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 @@ -429,7 +430,7 @@ module psb_c_mat_mod interface subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl) - import :: psb_cspmat_type, psb_dpk_, psb_c_base_sparse_mat + import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat class(psb_cspmat_type), intent(in) :: a class(psb_cspmat_type), intent(out) :: b integer, intent(out) :: info @@ -442,7 +443,7 @@ module psb_c_mat_mod interface subroutine psb_c_cscnv_ip(a,iinfo,type,mold,dupl) - import :: psb_cspmat_type, psb_dpk_, psb_c_base_sparse_mat + import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat class(psb_cspmat_type), intent(inout) :: a integer, intent(out) :: iinfo integer,optional, intent(in) :: dupl @@ -454,7 +455,7 @@ module psb_c_mat_mod interface subroutine psb_c_cscnv_base(a,b,info,dupl) - import :: psb_cspmat_type, psb_dpk_, psb_c_base_sparse_mat + import :: psb_cspmat_type, psb_spk_, 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 @@ -481,32 +482,32 @@ module psb_c_mat_mod interface subroutine psb_c_mv_from(a,b) - import :: psb_cspmat_type, psb_dpk_, psb_c_base_sparse_mat - class(psb_cspmat_type), intent(out) :: a + 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(inout) :: b end subroutine psb_c_mv_from end interface interface subroutine psb_c_cp_from(a,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 + 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 end subroutine psb_c_cp_from end interface interface subroutine psb_c_mv_to(a,b) - import :: psb_cspmat_type, psb_dpk_, psb_c_base_sparse_mat - class(psb_cspmat_type), intent(inout) :: a + import :: psb_cspmat_type, psb_spk_, 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_dpk_, psb_c_base_sparse_mat - class(psb_cspmat_type), intent(in) :: a + import :: psb_cspmat_type, psb_spk_, 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 @@ -536,7 +537,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 @@ -593,26 +594,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_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(in) :: a - complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) - complex(psb_dpk_), intent(inout) :: y(:,:) + complex(psb_spk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_spk_), 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_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(in) :: a - complex(psb_dpk_), intent(in) :: alpha, beta, x(:) - complex(psb_dpk_), intent(inout) :: y(:) + complex(psb_spk_), intent(in) :: alpha, beta, x(:) + complex(psb_spk_), 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_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(in) :: a - complex(psb_dpk_), intent(in) :: alpha, beta + complex(psb_spk_), intent(in) :: alpha, beta type(psb_c_vect_type), intent(inout) :: x type(psb_c_vect_type), intent(inout) :: y integer, intent(out) :: info @@ -622,28 +623,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_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(in) :: a - complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) - complex(psb_dpk_), intent(inout) :: y(:,:) + complex(psb_spk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_spk_), intent(inout) :: y(:,:) integer, intent(out) :: info character, optional, intent(in) :: trans, scale - complex(psb_dpk_), intent(in), optional :: d(:) + complex(psb_spk_), 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_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(in) :: a - complex(psb_dpk_), intent(in) :: alpha, beta, x(:) - complex(psb_dpk_), intent(inout) :: y(:) + complex(psb_spk_), intent(in) :: alpha, beta, x(:) + complex(psb_spk_), intent(inout) :: y(:) integer, intent(out) :: info character, optional, intent(in) :: trans, scale - complex(psb_dpk_), intent(in), optional :: d(:) + complex(psb_spk_), 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_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(in) :: a - complex(psb_dpk_), intent(in) :: alpha, beta + complex(psb_spk_), intent(in) :: alpha, beta type(psb_c_vect_type), intent(inout) :: x type(psb_c_vect_type), intent(inout) :: y integer, intent(out) :: info @@ -654,60 +655,60 @@ module psb_c_mat_mod interface function psb_c_maxval(a) result(res) - import :: psb_cspmat_type, psb_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(in) :: a - real(psb_dpk_) :: res + real(psb_spk_) :: res end function psb_c_maxval end interface interface function psb_c_csnmi(a) result(res) - import :: psb_cspmat_type, psb_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(in) :: a - real(psb_dpk_) :: res + real(psb_spk_) :: res end function psb_c_csnmi end interface interface function psb_c_csnm1(a) result(res) - import :: psb_cspmat_type, psb_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(in) :: a - real(psb_dpk_) :: res + real(psb_spk_) :: res end function psb_c_csnm1 end interface interface subroutine psb_c_rowsum(d,a,info) - import :: psb_cspmat_type, psb_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(in) :: a - complex(psb_dpk_), intent(out) :: d(:) + complex(psb_spk_), 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_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) + real(psb_spk_), 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_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(in) :: a - complex(psb_dpk_), intent(out) :: d(:) + complex(psb_spk_), 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_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) + real(psb_spk_), intent(out) :: d(:) integer, intent(out) :: info end subroutine psb_c_aclsum end interface @@ -715,24 +716,24 @@ module psb_c_mat_mod interface subroutine psb_c_get_diag(a,d,info) - import :: psb_cspmat_type, psb_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(in) :: a - complex(psb_dpk_), intent(out) :: d(:) + complex(psb_spk_), 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_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(inout) :: a - complex(psb_dpk_), intent(in) :: d(:) + complex(psb_spk_), intent(in) :: d(:) integer, intent(out) :: info end subroutine psb_c_scal subroutine psb_c_scals(d,a,info) - import :: psb_cspmat_type, psb_dpk_ + import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(inout) :: a - complex(psb_dpk_), intent(in) :: d + complex(psb_spk_), intent(in) :: d integer, intent(out) :: info end subroutine psb_c_scals end interface @@ -767,6 +768,7 @@ contains end function psb_c_sizeof + function psb_c_get_fmt(a) result(res) implicit none class(psb_cspmat_type), intent(in) :: a @@ -983,7 +985,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 3a527772..406fc6ce 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(psb_dpk_) sparse matrix +! level definition of a real, 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 @@ -50,9 +50,11 @@ ! 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 @@ -510,7 +512,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 @@ -518,7 +520,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 @@ -1075,11 +1077,6 @@ 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 1a4b12bd..dc555e05 100644 --- a/base/modules/psb_d_base_vect_mod.f90 +++ b/base/modules/psb_d_base_vect_mod.f90 @@ -7,6 +7,7 @@ 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 @@ -71,10 +72,12 @@ 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 @@ -113,10 +116,14 @@ 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 - x%v = val - + 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 end subroutine d_base_set_vect @@ -139,15 +146,21 @@ 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 = -1 + res = 0 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 @@ -214,15 +227,24 @@ contains end subroutine d_base_axpby_a - subroutine d_base_mlt_v(x, y, info) + subroutine d_base_mlt_v(x, y, info, xconj) 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 - integer :: i, n + 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_ 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_mat_mod.f90 b/base/modules/psb_d_mat_mod.f90 index 6974154f..80e1f00a 100644 --- a/base/modules/psb_d_mat_mod.f90 +++ b/base/modules/psb_d_mat_mod.f90 @@ -41,7 +41,6 @@ ! 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 @@ -109,6 +108,7 @@ 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,6 +129,8 @@ 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 @@ -153,9 +155,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 @@ -183,7 +185,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 @@ -191,7 +193,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 @@ -199,7 +201,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 @@ -207,35 +209,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 @@ -243,7 +245,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 @@ -251,7 +253,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 @@ -259,7 +261,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 @@ -267,7 +269,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 @@ -275,7 +277,8 @@ 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 @@ -299,7 +302,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 @@ -311,7 +314,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 @@ -321,7 +324,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 @@ -329,21 +332,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_ @@ -354,10 +357,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 @@ -370,7 +373,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) @@ -387,10 +390,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 @@ -402,10 +405,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 @@ -414,10 +417,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 @@ -426,7 +429,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 @@ -438,7 +441,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) @@ -450,7 +453,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) @@ -461,7 +464,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 @@ -470,7 +473,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 @@ -478,39 +481,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(inout), allocatable :: b + class(psb_dspmat_type), intent(out) :: a + class(psb_d_base_sparse_mat), intent(in) :: 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 @@ -519,7 +522,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 @@ -536,14 +539,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 @@ -551,14 +554,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 @@ -566,16 +569,15 @@ 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 - ! == =================================== @@ -611,15 +613,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_ @@ -643,7 +645,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 @@ -651,7 +653,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_ @@ -680,8 +682,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 @@ -689,8 +691,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 @@ -698,8 +700,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 @@ -707,12 +709,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_ @@ -721,7 +723,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_ @@ -753,20 +755,21 @@ 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 @@ -985,10 +988,9 @@ 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 5329f66d..caded0fa 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 -! 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 +! 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 ! field, such as the matrix-vector product; this interface is defined, ! but is supposed to be overridden at the leaf level. ! @@ -50,9 +50,11 @@ ! 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 @@ -132,6 +134,13 @@ 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 @@ -143,13 +152,6 @@ 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 @@ -215,7 +217,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_ @@ -310,7 +312,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_ @@ -358,7 +360,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_ @@ -510,7 +512,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 @@ -518,7 +520,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 @@ -576,7 +578,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_ @@ -586,7 +588,6 @@ 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 @@ -620,7 +621,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 @@ -802,7 +803,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_ @@ -810,7 +811,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_ @@ -1075,11 +1076,6 @@ 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 3aaf149e..6972893b 100644 --- a/base/modules/psb_s_base_vect_mod.f90 +++ b/base/modules/psb_s_base_vect_mod.f90 @@ -7,6 +7,7 @@ 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 @@ -71,10 +72,12 @@ 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 @@ -113,10 +116,14 @@ 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 - x%v = val - + 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 end subroutine s_base_set_vect @@ -139,14 +146,20 @@ 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 = -1 + res = 0 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_mat_mod.f90 b/base/modules/psb_s_mat_mod.f90 index 63b983a7..31a7749d 100644 --- a/base/modules/psb_s_mat_mod.f90 +++ b/base/modules/psb_s_mat_mod.f90 @@ -109,6 +109,7 @@ 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 @@ -129,6 +130,8 @@ 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 @@ -153,9 +156,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 @@ -183,7 +186,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 @@ -191,7 +194,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 @@ -199,7 +202,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 @@ -207,35 +210,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 @@ -243,7 +246,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 @@ -251,7 +254,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 @@ -259,7 +262,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 @@ -267,7 +270,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 @@ -275,7 +278,8 @@ 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 @@ -299,7 +303,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 @@ -311,7 +315,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 @@ -321,7 +325,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 @@ -329,36 +333,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_dpk_ + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(inout) :: a - real(psb_dpk_), intent(in) :: val(:) + real(psb_spk_), 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_dpk_ + & jmin,jmax,iren,append,nzin,rscale,cscale) + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(in) :: a integer, intent(in) :: imin,imax integer, intent(out) :: nz @@ -370,16 +374,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_dpk_ + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(in) :: a integer, intent(in) :: imin,imax integer, intent(out) :: nz integer, allocatable, intent(inout) :: ia(:), ja(:) - real(psb_dpk_), allocatable, intent(inout) :: val(:) + real(psb_spk_), allocatable, intent(inout) :: val(:) integer,intent(out) :: info logical, intent(in), optional :: append integer, intent(in), optional :: iren(:) @@ -387,11 +391,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_dpk_ + & jmin,jmax,iren,append,rscale,cscale) + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(in) :: a class(psb_sspmat_type), intent(out) :: b integer, intent(in) :: imin,imax @@ -402,11 +406,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_dpk_ + & imin,imax,jmin,jmax,rscale,cscale) + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(in) :: a class(psb_sspmat_type), intent(out) :: b integer,intent(out) :: info @@ -414,11 +418,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_dpk_, psb_s_coo_sparse_mat + & imin,imax,jmin,jmax,rscale,cscale) + import :: psb_sspmat_type, psb_spk_, 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 @@ -426,10 +430,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_dpk_, psb_s_base_sparse_mat + import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat class(psb_sspmat_type), intent(in) :: a class(psb_sspmat_type), intent(out) :: b integer, intent(out) :: info @@ -438,11 +442,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_dpk_, psb_s_base_sparse_mat + import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat class(psb_sspmat_type), intent(inout) :: a integer, intent(out) :: iinfo integer,optional, intent(in) :: dupl @@ -450,18 +454,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_dpk_, psb_s_base_sparse_mat + import :: psb_sspmat_type, psb_spk_, 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 @@ -470,7 +474,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 @@ -478,39 +482,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_dpk_, psb_s_base_sparse_mat - class(psb_sspmat_type), intent(out) :: a + 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(inout) :: b end subroutine psb_s_mv_from end interface - + interface subroutine psb_s_cp_from(a,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 + 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 end subroutine psb_s_cp_from end interface - + interface subroutine psb_s_mv_to(a,b) - import :: psb_sspmat_type, psb_dpk_, psb_s_base_sparse_mat - class(psb_sspmat_type), intent(inout) :: a + import :: psb_sspmat_type, psb_spk_, 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_dpk_, psb_s_base_sparse_mat - class(psb_sspmat_type), intent(in) :: a + import :: psb_sspmat_type, psb_spk_, 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 @@ -518,8 +522,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 - + end interface psb_move_alloc + interface psb_clone subroutine psb_sspmat_type_clone(a,b,info) import :: psb_sspmat_type @@ -536,14 +540,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 @@ -551,14 +555,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 @@ -566,16 +570,15 @@ 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 - ! == =================================== @@ -593,57 +596,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_dpk_ + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(in) :: a - real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) - real(psb_dpk_), intent(inout) :: y(:,:) + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(psb_spk_), 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_dpk_ + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(in) :: a - real(psb_dpk_), intent(in) :: alpha, beta, x(:) - real(psb_dpk_), intent(inout) :: y(:) + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), 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_dpk_ + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(in) :: a - real(psb_dpk_), intent(in) :: alpha, beta + real(psb_spk_), 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_dpk_ + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(in) :: a - real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) - real(psb_dpk_), intent(inout) :: y(:,:) + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(psb_spk_), intent(inout) :: y(:,:) integer, intent(out) :: info character, optional, intent(in) :: trans, scale - real(psb_dpk_), intent(in), optional :: d(:) + real(psb_spk_), 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_dpk_ + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(in) :: a - real(psb_dpk_), intent(in) :: alpha, beta, x(:) - real(psb_dpk_), intent(inout) :: y(:) + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) integer, intent(out) :: info character, optional, intent(in) :: trans, scale - real(psb_dpk_), intent(in), optional :: d(:) + real(psb_spk_), 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_dpk_ + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(in) :: a - real(psb_dpk_), intent(in) :: alpha, beta + real(psb_spk_), intent(in) :: alpha, beta type(psb_s_vect_type), intent(inout) :: x type(psb_s_vect_type), intent(inout) :: y integer, intent(out) :: info @@ -651,88 +654,87 @@ 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_dpk_ + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(in) :: a - real(psb_dpk_) :: res + real(psb_spk_) :: res end function psb_s_maxval end interface - + interface function psb_s_csnmi(a) result(res) - import :: psb_sspmat_type, psb_dpk_ + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(in) :: a - real(psb_dpk_) :: res + real(psb_spk_) :: res end function psb_s_csnmi end interface interface function psb_s_csnm1(a) result(res) - import :: psb_sspmat_type, psb_dpk_ + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(in) :: a - real(psb_dpk_) :: res + real(psb_spk_) :: res end function psb_s_csnm1 end interface interface subroutine psb_s_rowsum(d,a,info) - import :: psb_sspmat_type, psb_dpk_ + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) - integer, intent(out) :: info + real(psb_spk_), 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_dpk_ + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) - integer, intent(out) :: info + real(psb_spk_), 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_dpk_ + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) - integer, intent(out) :: info + real(psb_spk_), 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_dpk_ + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) - integer, intent(out) :: info + real(psb_spk_), 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_dpk_ + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) + real(psb_spk_), 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_dpk_ + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(inout) :: a - real(psb_dpk_), intent(in) :: d(:) + real(psb_spk_), intent(in) :: d(:) integer, intent(out) :: info end subroutine psb_s_scal subroutine psb_s_scals(d,a,info) - import :: psb_sspmat_type, psb_dpk_ + import :: psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(inout) :: a - real(psb_dpk_), intent(in) :: d + real(psb_spk_), intent(in) :: d integer, intent(out) :: info end subroutine psb_s_scals end interface @@ -753,20 +755,21 @@ 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 @@ -985,10 +988,9 @@ 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 7a3b94b9..412fefcb 100644 --- a/base/modules/psb_z_base_mat_mod.f90 +++ b/base/modules/psb_z_base_mat_mod.f90 @@ -32,15 +32,16 @@ ! ! package: psb_z_base_mat_mod ! -! 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 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 also contains the implementation of the ! psb_z_coo_sparse_mat type and the related methods. This is the @@ -50,9 +51,11 @@ ! 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 @@ -132,6 +135,13 @@ 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 @@ -143,13 +153,6 @@ 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 @@ -208,14 +211,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_ @@ -242,7 +245,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 @@ -277,7 +280,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 @@ -318,7 +321,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_ @@ -358,7 +361,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_ @@ -510,7 +513,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 @@ -518,7 +521,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 @@ -585,7 +588,6 @@ 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) @@ -801,8 +803,7 @@ 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_ @@ -810,7 +811,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_ @@ -831,7 +832,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 @@ -839,7 +840,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 @@ -847,7 +848,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 @@ -855,7 +856,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 @@ -939,7 +940,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) @@ -1019,6 +1020,8 @@ contains ! ! == ================================== + + subroutine z_coo_free(a) implicit none @@ -1070,15 +1073,13 @@ 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() - ! 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(:)) + 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 3d60f4c8..6b2eb154 100644 --- a/base/modules/psb_z_base_vect_mod.f90 +++ b/base/modules/psb_z_base_vect_mod.f90 @@ -7,6 +7,7 @@ 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 @@ -71,10 +72,12 @@ 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 @@ -113,11 +116,16 @@ 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 - x%v = val - + 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 end subroutine z_base_set_vect + function constructor(x) result(this) @@ -139,21 +147,27 @@ 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 = -1 + res = 0 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 ! @@ -173,10 +187,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) @@ -188,7 +202,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) @@ -214,41 +228,72 @@ contains end subroutine z_base_axpby_a - subroutine z_base_mlt_v(x, y, info) + subroutine z_base_mlt_v(x, y, info, xconj) 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 - integer :: i, n + 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_ 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)) - do i=1, n - y%v(i) = y%v(i)*xx%v(i) - end do + 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 class default - call y%mlt(x%v,info) + call y%mlt(x%v,info,xconj) end select end subroutine z_base_mlt_v - subroutine z_base_mlt_a(x, y, info) + subroutine z_base_mlt_a(x, y, info, xconj) 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 + 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_ 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)) - do i=1, n - y%v(i) = y%v(i)*x(i) - end do - + 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 end subroutine z_base_mlt_a @@ -320,30 +365,44 @@ contains end if end subroutine z_base_mlt_a_2 - subroutine z_base_mlt_v_2(alpha,x,y,beta,z,info) + subroutine z_base_mlt_v_2(alpha,x,y,beta,z,info,xconj,yconj) 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 + 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 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) + subroutine z_base_mlt_av(alpha,x,y,beta,z,info,xconj,yconj) 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 + 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 integer :: i, n info = 0 @@ -352,19 +411,20 @@ contains end subroutine z_base_mlt_av - subroutine z_base_mlt_va(alpha,x,y,beta,z,info) + subroutine z_base_mlt_va(alpha,x,y,beta,z,info,xconj,yconj) 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 + 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 integer :: i, n info = 0 - call z%mlt(alpha,y,x,beta,info) + call z%mlt(alpha,y,x,beta,info,xconj=yconj,yconj=xconj) end subroutine z_base_mlt_va @@ -510,7 +570,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_mat_mod.f90 b/base/modules/psb_z_mat_mod.f90 index 8fd3ed55..705ee768 100644 --- a/base/modules/psb_z_mat_mod.f90 +++ b/base/modules/psb_z_mat_mod.f90 @@ -109,6 +109,7 @@ 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 @@ -153,9 +154,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 @@ -482,7 +483,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 @@ -490,15 +491,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(inout), allocatable :: b + class(psb_zspmat_type), intent(out) :: a + class(psb_z_base_sparse_mat), intent(in) :: 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