diff --git a/base/comm/psb_dspgather.F90 b/base/comm/psb_dspgather.F90 index 0546a203..5a4f4c2b 100644 --- a/base/comm/psb_dspgather.F90 +++ b/base/comm/psb_dspgather.F90 @@ -11,7 +11,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep include 'mpif.h' #endif type(psb_d_sparse_mat), intent(inout) :: loca - type(psb_d_sparse_mat), intent(out) :: globa + type(psb_d_sparse_mat), intent(inout) :: globa type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info integer, intent(in), optional :: root, dupl @@ -44,6 +44,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep else keeploc_ = .true. end if + call globa%free() if (keepnum_) then nrg = psb_cd_get_global_rows(desc_a) diff --git a/base/modules/psb_c_base_mat_mod.f03 b/base/modules/psb_c_base_mat_mod.f03 index 9c1d1d6c..0dff3363 100644 --- a/base/modules/psb_c_base_mat_mod.f03 +++ b/base/modules/psb_c_base_mat_mod.f03 @@ -81,7 +81,7 @@ module psb_c_base_mat_mod 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 - procedure, pass(a) :: get_nc_row => psb_c_coo_get_nc_row + procedure, pass(a) :: get_nz_row => psb_c_coo_get_nz_row procedure, pass(a) :: reinit => psb_c_coo_reinit procedure, pass(a) :: fix => psb_c_fix_coo procedure, pass(a) :: trim => psb_c_coo_trim @@ -426,12 +426,12 @@ module psb_c_base_mat_mod interface - function psb_c_coo_get_nc_row(idx,a) result(res) + function psb_c_coo_get_nz_row(idx,a) result(res) import psb_c_coo_sparse_mat class(psb_c_coo_sparse_mat), intent(in) :: a integer, intent(in) :: idx integer :: res - end function psb_c_coo_get_nc_row + end function psb_c_coo_get_nz_row end interface diff --git a/base/modules/psb_c_mat_mod.f03 b/base/modules/psb_c_mat_mod.f03 index 9fe964d6..09f7a237 100644 --- a/base/modules/psb_c_mat_mod.f03 +++ b/base/modules/psb_c_mat_mod.f03 @@ -10,22 +10,22 @@ module psb_c_mat_mod contains ! Getters - procedure, pass(a) :: get_nrows - procedure, pass(a) :: get_ncols - procedure, pass(a) :: get_nzeros - procedure, pass(a) :: get_nz_row - procedure, pass(a) :: get_size - procedure, pass(a) :: get_state - procedure, pass(a) :: get_dupl - procedure, pass(a) :: is_null - procedure, pass(a) :: is_bld - procedure, pass(a) :: is_upd - procedure, pass(a) :: is_asb - procedure, pass(a) :: is_sorted - procedure, pass(a) :: is_upper - procedure, pass(a) :: is_lower - procedure, pass(a) :: is_triangle - procedure, pass(a) :: is_unit + procedure, pass(a) :: get_nrows => psb_c_get_nrows + procedure, pass(a) :: get_ncols => psb_c_get_ncols + procedure, pass(a) :: get_nzeros => psb_c_get_nzeros + procedure, pass(a) :: get_nz_row => psb_c_get_nz_row + procedure, pass(a) :: get_size => psb_c_get_size + procedure, pass(a) :: get_state => psb_c_get_state + procedure, pass(a) :: get_dupl => psb_c_get_dupl + procedure, pass(a) :: is_null => psb_c_is_null + procedure, pass(a) :: is_bld => psb_c_is_bld + procedure, pass(a) :: is_upd => psb_c_is_upd + procedure, pass(a) :: is_asb => psb_c_is_asb + procedure, pass(a) :: is_sorted => psb_c_is_sorted + procedure, pass(a) :: is_upper => psb_c_is_upper + procedure, pass(a) :: is_lower => psb_c_is_lower + procedure, pass(a) :: is_triangle => psb_c_is_triangle + procedure, pass(a) :: is_unit => psb_c_is_unit procedure, pass(a) :: get_fmt => psb_c_get_fmt procedure, pass(a) :: sizeof => psb_c_sizeof @@ -99,9 +99,9 @@ module psb_c_mat_mod end type psb_c_sparse_mat - private :: get_nrows, get_ncols, get_nzeros, get_size, & - & get_state, get_dupl, is_null, is_bld, is_upd, & - & is_asb, is_sorted, is_upper, is_lower, is_triangle + 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 interface psb_sizeof module procedure psb_c_sizeof @@ -638,8 +638,7 @@ contains end function psb_c_get_fmt - - function get_dupl(a) result(res) + function psb_c_get_dupl(a) result(res) implicit none class(psb_c_sparse_mat), intent(in) :: a integer :: res @@ -649,10 +648,10 @@ contains else res = psb_invalid_ end if - end function get_dupl + end function psb_c_get_dupl - function get_state(a) result(res) + function psb_c_get_state(a) result(res) implicit none class(psb_c_sparse_mat), intent(in) :: a integer :: res @@ -662,9 +661,9 @@ contains else res = psb_spmat_null_ end if - end function get_state + end function psb_c_get_state - function get_nrows(a) result(res) + function psb_c_get_nrows(a) result(res) implicit none class(psb_c_sparse_mat), intent(in) :: a integer :: res @@ -675,9 +674,9 @@ contains res = 0 end if - end function get_nrows + end function psb_c_get_nrows - function get_ncols(a) result(res) + function psb_c_get_ncols(a) result(res) implicit none class(psb_c_sparse_mat), intent(in) :: a integer :: res @@ -688,9 +687,9 @@ contains res = 0 end if - end function get_ncols + end function psb_c_get_ncols - function is_triangle(a) result(res) + function psb_c_is_triangle(a) result(res) implicit none class(psb_c_sparse_mat), intent(in) :: a logical :: res @@ -701,9 +700,9 @@ contains res = .false. end if - end function is_triangle + end function psb_c_is_triangle - function is_unit(a) result(res) + function psb_c_is_unit(a) result(res) implicit none class(psb_c_sparse_mat), intent(in) :: a logical :: res @@ -714,9 +713,9 @@ contains res = .false. end if - end function is_unit + end function psb_c_is_unit - function is_upper(a) result(res) + function psb_c_is_upper(a) result(res) implicit none class(psb_c_sparse_mat), intent(in) :: a logical :: res @@ -727,9 +726,9 @@ contains res = .false. end if - end function is_upper + end function psb_c_is_upper - function is_lower(a) result(res) + function psb_c_is_lower(a) result(res) implicit none class(psb_c_sparse_mat), intent(in) :: a logical :: res @@ -740,9 +739,9 @@ contains res = .false. end if - end function is_lower + end function psb_c_is_lower - function is_null(a) result(res) + function psb_c_is_null(a) result(res) implicit none class(psb_c_sparse_mat), intent(in) :: a logical :: res @@ -753,9 +752,9 @@ contains res = .true. end if - end function is_null + end function psb_c_is_null - function is_bld(a) result(res) + function psb_c_is_bld(a) result(res) implicit none class(psb_c_sparse_mat), intent(in) :: a logical :: res @@ -766,9 +765,9 @@ contains res = .false. end if - end function is_bld + end function psb_c_is_bld - function is_upd(a) result(res) + function psb_c_is_upd(a) result(res) implicit none class(psb_c_sparse_mat), intent(in) :: a logical :: res @@ -779,9 +778,9 @@ contains res = .false. end if - end function is_upd + end function psb_c_is_upd - function is_asb(a) result(res) + function psb_c_is_asb(a) result(res) implicit none class(psb_c_sparse_mat), intent(in) :: a logical :: res @@ -792,9 +791,9 @@ contains res = .false. end if - end function is_asb + end function psb_c_is_asb - function is_sorted(a) result(res) + function psb_c_is_sorted(a) result(res) implicit none class(psb_c_sparse_mat), intent(in) :: a logical :: res @@ -805,11 +804,11 @@ contains res = .false. end if - end function is_sorted + end function psb_c_is_sorted - function get_nzeros(a) result(res) + function psb_c_get_nzeros(a) result(res) implicit none class(psb_c_sparse_mat), intent(in) :: a integer :: res @@ -819,9 +818,9 @@ contains res = a%a%get_nzeros() end if - end function get_nzeros + end function psb_c_get_nzeros - function get_size(a) result(res) + function psb_c_get_size(a) result(res) implicit none class(psb_c_sparse_mat), intent(in) :: a @@ -833,22 +832,20 @@ contains res = a%a%get_size() end if - end function get_size + end function psb_c_get_size - function get_nz_row(idx,a) result(res) + function psb_c_get_nz_row(idx,a) result(res) implicit none integer, intent(in) :: idx class(psb_c_sparse_mat), intent(in) :: a integer :: res - Integer :: err_act - res = 0 if (allocated(a%a)) res = a%a%get_nz_row(idx) - end function get_nz_row + end function psb_c_get_nz_row end module psb_c_mat_mod diff --git a/base/modules/psb_c_tools_mod.f90 b/base/modules/psb_c_tools_mod.f90 index cfdfb21e..5881feeb 100644 --- a/base/modules/psb_c_tools_mod.f90 +++ b/base/modules/psb_c_tools_mod.f90 @@ -138,8 +138,8 @@ Module psb_c_tools_mod subroutine psb_cspalloc(a, desc_a, info, nnz) use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_c_sparse_mat - type(psb_desc_type), intent(inout) :: desc_a - type(psb_c_sparse_mat), intent(out) :: a + type(psb_desc_type), intent(in) :: desc_a + type(psb_c_sparse_mat), intent(inout) :: a integer, intent(out) :: info integer, optional, intent(in) :: nnz end subroutine psb_cspalloc diff --git a/base/modules/psb_d_mat_mod.f03 b/base/modules/psb_d_mat_mod.f03 index 8cdf9cd3..4f5b0a2c 100644 --- a/base/modules/psb_d_mat_mod.f03 +++ b/base/modules/psb_d_mat_mod.f03 @@ -10,22 +10,22 @@ module psb_d_mat_mod contains ! Getters - procedure, pass(a) :: get_nrows - procedure, pass(a) :: get_ncols - procedure, pass(a) :: get_nzeros - procedure, pass(a) :: get_nz_row - procedure, pass(a) :: get_size - procedure, pass(a) :: get_state - procedure, pass(a) :: get_dupl - procedure, pass(a) :: is_null - procedure, pass(a) :: is_bld - procedure, pass(a) :: is_upd - procedure, pass(a) :: is_asb - procedure, pass(a) :: is_sorted - procedure, pass(a) :: is_upper - procedure, pass(a) :: is_lower - procedure, pass(a) :: is_triangle - procedure, pass(a) :: is_unit + procedure, pass(a) :: get_nrows => psb_d_get_nrows + procedure, pass(a) :: get_ncols => psb_d_get_ncols + procedure, pass(a) :: get_nzeros => psb_d_get_nzeros + procedure, pass(a) :: get_nz_row => psb_d_get_nz_row + procedure, pass(a) :: get_size => psb_d_get_size + procedure, pass(a) :: get_state => psb_d_get_state + procedure, pass(a) :: get_dupl => psb_d_get_dupl + procedure, pass(a) :: is_null => psb_d_is_null + procedure, pass(a) :: is_bld => psb_d_is_bld + procedure, pass(a) :: is_upd => psb_d_is_upd + procedure, pass(a) :: is_asb => psb_d_is_asb + procedure, pass(a) :: is_sorted => psb_d_is_sorted + procedure, pass(a) :: is_upper => psb_d_is_upper + procedure, pass(a) :: is_lower => psb_d_is_lower + procedure, pass(a) :: is_triangle => psb_d_is_triangle + procedure, pass(a) :: is_unit => psb_d_is_unit procedure, pass(a) :: get_fmt => psb_d_get_fmt procedure, pass(a) :: sizeof => psb_d_sizeof @@ -82,8 +82,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) :: csnmi => psb_d_csnmi @@ -99,9 +99,9 @@ module psb_d_mat_mod end type psb_d_sparse_mat - private :: get_nrows, get_ncols, get_nzeros, get_size, & - & get_state, get_dupl, is_null, is_bld, is_upd, & - & is_asb, is_sorted, is_upper, is_lower, is_triangle + 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 interface psb_sizeof module procedure psb_d_sizeof @@ -129,7 +129,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_d_sparse_mat @@ -137,7 +137,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_d_sparse_mat @@ -145,7 +145,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_d_sparse_mat @@ -153,35 +153,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_d_sparse_mat class(psb_d_sparse_mat), intent(inout) :: a end subroutine psb_d_set_null end interface - + interface subroutine psb_d_set_bld(a) import psb_d_sparse_mat class(psb_d_sparse_mat), intent(inout) :: a end subroutine psb_d_set_bld end interface - + interface subroutine psb_d_set_upd(a) import psb_d_sparse_mat class(psb_d_sparse_mat), intent(inout) :: a end subroutine psb_d_set_upd end interface - + interface subroutine psb_d_set_asb(a) import psb_d_sparse_mat class(psb_d_sparse_mat), intent(inout) :: a end subroutine psb_d_set_asb end interface - + interface subroutine psb_d_set_sorted(a,val) import psb_d_sparse_mat @@ -189,7 +189,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_d_sparse_mat @@ -197,7 +197,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_d_sparse_mat @@ -205,7 +205,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_d_sparse_mat @@ -213,7 +213,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_d_sparse_mat @@ -221,8 +221,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_d_sparse_mat @@ -234,7 +234,7 @@ module psb_d_mat_mod integer, intent(in), optional :: ivr(:), ivc(:) end subroutine psb_d_sparse_print end interface - + interface subroutine psb_d_get_neigh(a,idx,neigh,n,info,lev) import psb_d_sparse_mat @@ -246,7 +246,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_d_sparse_mat @@ -256,7 +256,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_d_sparse_mat @@ -264,21 +264,21 @@ module psb_d_mat_mod class(psb_d_sparse_mat), intent(inout) :: a end subroutine psb_d_reallocate_nz end interface - + interface subroutine psb_d_free(a) import psb_d_sparse_mat class(psb_d_sparse_mat), intent(inout) :: a end subroutine psb_d_free end interface - + interface subroutine psb_d_trim(a) import psb_d_sparse_mat class(psb_d_sparse_mat), 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_d_sparse_mat, psb_dpk_ @@ -289,10 +289,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_d_sparse_mat, psb_dpk_ class(psb_d_sparse_mat), intent(in) :: a integer, intent(in) :: imin,imax @@ -305,7 +305,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) @@ -322,10 +322,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_d_sparse_mat, psb_dpk_ class(psb_d_sparse_mat), intent(in) :: a class(psb_d_sparse_mat), intent(out) :: b @@ -337,10 +337,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_d_sparse_mat, psb_dpk_ class(psb_d_sparse_mat), intent(in) :: a class(psb_d_sparse_mat), intent(out) :: b @@ -349,10 +349,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_d_sparse_mat, psb_dpk_, psb_d_coo_sparse_mat class(psb_d_sparse_mat), intent(in) :: a type(psb_d_coo_sparse_mat), intent(out) :: b @@ -361,7 +361,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_d_sparse_mat, psb_dpk_, psb_d_base_sparse_mat @@ -373,7 +373,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) @@ -385,7 +385,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) @@ -396,7 +396,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_d_sparse_mat @@ -405,7 +405,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_d_sparse_mat @@ -413,7 +413,7 @@ 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_d_sparse_mat, psb_dpk_, psb_d_base_sparse_mat @@ -421,7 +421,7 @@ module psb_d_mat_mod 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_d_sparse_mat, psb_dpk_, psb_d_base_sparse_mat @@ -429,7 +429,7 @@ module psb_d_mat_mod 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_d_sparse_mat, psb_dpk_, psb_d_base_sparse_mat @@ -437,7 +437,7 @@ module psb_d_mat_mod 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_d_sparse_mat, psb_dpk_, psb_d_base_sparse_mat @@ -445,7 +445,7 @@ module psb_d_mat_mod class(psb_d_base_sparse_mat), intent(out) :: b end subroutine psb_d_cp_to end interface - + interface psb_move_alloc subroutine psb_d_sparse_mat_move(a,b,info) import psb_d_sparse_mat @@ -454,7 +454,7 @@ module psb_d_mat_mod integer, intent(out) :: info end subroutine psb_d_sparse_mat_move end interface - + interface psb_clone subroutine psb_d_sparse_mat_clone(a,b,info) @@ -464,14 +464,14 @@ module psb_d_mat_mod integer, intent(out) :: info end subroutine psb_d_sparse_mat_clone end interface - + interface subroutine psb_d_transp_1mat(a) import psb_d_sparse_mat class(psb_d_sparse_mat), intent(inout) :: a end subroutine psb_d_transp_1mat end interface - + interface subroutine psb_d_transp_2mat(a,b) import psb_d_sparse_mat @@ -479,14 +479,14 @@ module psb_d_mat_mod class(psb_d_sparse_mat), intent(in) :: b end subroutine psb_d_transp_2mat end interface - + interface subroutine psb_d_transc_1mat(a) import psb_d_sparse_mat class(psb_d_sparse_mat), intent(inout) :: a end subroutine psb_d_transc_1mat end interface - + interface subroutine psb_d_transc_2mat(a,b) import psb_d_sparse_mat @@ -494,16 +494,15 @@ module psb_d_mat_mod class(psb_d_sparse_mat), intent(in) :: b end subroutine psb_d_transc_2mat end interface - + interface subroutine psb_d_reinit(a,clear) import psb_d_sparse_mat class(psb_d_sparse_mat), intent(inout) :: a logical, intent(in), optional :: clear end subroutine psb_d_reinit - + end interface - ! == =================================== @@ -537,7 +536,7 @@ module psb_d_mat_mod character, optional, intent(in) :: trans end subroutine psb_d_csmv end interface - + interface psb_cssm subroutine psb_d_cssm(alpha,a,x,beta,y,info,trans,scale,d) import psb_d_sparse_mat, psb_dpk_ @@ -558,7 +557,7 @@ module psb_d_mat_mod real(psb_dpk_), intent(in), optional :: d(:) end subroutine psb_d_cssv end interface - + interface function psb_d_csnmi(a) result(res) import psb_d_sparse_mat, psb_dpk_ @@ -566,7 +565,7 @@ module psb_d_mat_mod real(psb_dpk_) :: res end function psb_d_csnmi end interface - + interface subroutine psb_d_get_diag(a,d,info) import psb_d_sparse_mat, psb_dpk_ @@ -575,7 +574,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_d_sparse_mat, psb_dpk_ @@ -609,17 +608,17 @@ contains ! ! == =================================== - + function psb_d_sizeof(a) result(res) implicit none class(psb_d_sparse_mat), 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 @@ -639,7 +638,7 @@ contains - function get_dupl(a) result(res) + function psb_d_get_dupl(a) result(res) implicit none class(psb_d_sparse_mat), intent(in) :: a integer :: res @@ -649,10 +648,10 @@ contains else res = psb_invalid_ end if - end function get_dupl + end function psb_d_get_dupl - function get_state(a) result(res) + function psb_d_get_state(a) result(res) implicit none class(psb_d_sparse_mat), intent(in) :: a integer :: res @@ -662,9 +661,9 @@ contains else res = psb_spmat_null_ end if - end function get_state + end function psb_d_get_state - function get_nrows(a) result(res) + function psb_d_get_nrows(a) result(res) implicit none class(psb_d_sparse_mat), intent(in) :: a integer :: res @@ -675,9 +674,9 @@ contains res = 0 end if - end function get_nrows + end function psb_d_get_nrows - function get_ncols(a) result(res) + function psb_d_get_ncols(a) result(res) implicit none class(psb_d_sparse_mat), intent(in) :: a integer :: res @@ -688,9 +687,9 @@ contains res = 0 end if - end function get_ncols + end function psb_d_get_ncols - function is_triangle(a) result(res) + function psb_d_is_triangle(a) result(res) implicit none class(psb_d_sparse_mat), intent(in) :: a logical :: res @@ -701,9 +700,9 @@ contains res = .false. end if - end function is_triangle + end function psb_d_is_triangle - function is_unit(a) result(res) + function psb_d_is_unit(a) result(res) implicit none class(psb_d_sparse_mat), intent(in) :: a logical :: res @@ -714,9 +713,9 @@ contains res = .false. end if - end function is_unit + end function psb_d_is_unit - function is_upper(a) result(res) + function psb_d_is_upper(a) result(res) implicit none class(psb_d_sparse_mat), intent(in) :: a logical :: res @@ -727,9 +726,9 @@ contains res = .false. end if - end function is_upper + end function psb_d_is_upper - function is_lower(a) result(res) + function psb_d_is_lower(a) result(res) implicit none class(psb_d_sparse_mat), intent(in) :: a logical :: res @@ -740,9 +739,9 @@ contains res = .false. end if - end function is_lower + end function psb_d_is_lower - function is_null(a) result(res) + function psb_d_is_null(a) result(res) implicit none class(psb_d_sparse_mat), intent(in) :: a logical :: res @@ -753,9 +752,9 @@ contains res = .true. end if - end function is_null + end function psb_d_is_null - function is_bld(a) result(res) + function psb_d_is_bld(a) result(res) implicit none class(psb_d_sparse_mat), intent(in) :: a logical :: res @@ -766,9 +765,9 @@ contains res = .false. end if - end function is_bld + end function psb_d_is_bld - function is_upd(a) result(res) + function psb_d_is_upd(a) result(res) implicit none class(psb_d_sparse_mat), intent(in) :: a logical :: res @@ -779,9 +778,9 @@ contains res = .false. end if - end function is_upd + end function psb_d_is_upd - function is_asb(a) result(res) + function psb_d_is_asb(a) result(res) implicit none class(psb_d_sparse_mat), intent(in) :: a logical :: res @@ -792,9 +791,9 @@ contains res = .false. end if - end function is_asb + end function psb_d_is_asb - function is_sorted(a) result(res) + function psb_d_is_sorted(a) result(res) implicit none class(psb_d_sparse_mat), intent(in) :: a logical :: res @@ -805,11 +804,11 @@ contains res = .false. end if - end function is_sorted + end function psb_d_is_sorted - function get_nzeros(a) result(res) + function psb_d_get_nzeros(a) result(res) implicit none class(psb_d_sparse_mat), intent(in) :: a integer :: res @@ -819,9 +818,9 @@ contains res = a%a%get_nzeros() end if - end function get_nzeros + end function psb_d_get_nzeros - function get_size(a) result(res) + function psb_d_get_size(a) result(res) implicit none class(psb_d_sparse_mat), intent(in) :: a @@ -833,22 +832,22 @@ contains res = a%a%get_size() end if - end function get_size + end function psb_d_get_size - function get_nz_row(idx,a) result(res) + function psb_d_get_nz_row(idx,a) result(res) implicit none integer, intent(in) :: idx class(psb_d_sparse_mat), intent(in) :: a integer :: res - + Integer :: err_act res = 0 - + if (allocated(a%a)) res = a%a%get_nz_row(idx) - end function get_nz_row + end function psb_d_get_nz_row end module psb_d_mat_mod diff --git a/base/modules/psb_d_tools_mod.f90 b/base/modules/psb_d_tools_mod.f90 index 09ec4c31..3eef6f52 100644 --- a/base/modules/psb_d_tools_mod.f90 +++ b/base/modules/psb_d_tools_mod.f90 @@ -109,13 +109,13 @@ Module psb_d_tools_mod end subroutine psb_dinsi subroutine psb_dinsvi(m,irw,val,x,desc_a,info,dupl) use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ - integer, intent(in) :: m - type(psb_desc_type), intent(in) :: desc_a + integer, intent(in) :: m + type(psb_desc_type), intent(in) :: desc_a real(psb_dpk_),intent(inout) :: x(:) - integer, intent(in) :: irw(:) + integer, intent(in) :: irw(:) real(psb_dpk_), intent(in) :: val(:) - integer, intent(out) :: info - integer, optional, intent(in) :: dupl + integer, intent(out) :: info + integer, optional, intent(in) :: dupl end subroutine psb_dinsvi end interface @@ -137,8 +137,8 @@ Module psb_d_tools_mod subroutine psb_dspalloc(a, desc_a, info, nnz) use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_d_sparse_mat - type(psb_desc_type), intent(inout) :: desc_a - type(psb_d_sparse_mat), intent(out) :: a + type(psb_desc_type), intent(in) :: desc_a + type(psb_d_sparse_mat), intent(inout) :: a integer, intent(out) :: info integer, optional, intent(in) :: nnz end subroutine psb_dspalloc diff --git a/base/modules/psb_s_mat_mod.f03 b/base/modules/psb_s_mat_mod.f03 index c0a50377..9f7f2f5d 100644 --- a/base/modules/psb_s_mat_mod.f03 +++ b/base/modules/psb_s_mat_mod.f03 @@ -10,22 +10,22 @@ module psb_s_mat_mod contains ! Getters - procedure, pass(a) :: get_nrows - procedure, pass(a) :: get_ncols - procedure, pass(a) :: get_nzeros - procedure, pass(a) :: get_nz_row - procedure, pass(a) :: get_size - procedure, pass(a) :: get_state - procedure, pass(a) :: get_dupl - procedure, pass(a) :: is_null - procedure, pass(a) :: is_bld - procedure, pass(a) :: is_upd - procedure, pass(a) :: is_asb - procedure, pass(a) :: is_sorted - procedure, pass(a) :: is_upper - procedure, pass(a) :: is_lower - procedure, pass(a) :: is_triangle - procedure, pass(a) :: is_unit + procedure, pass(a) :: get_nrows => psb_s_get_nrows + procedure, pass(a) :: get_ncols => psb_s_get_ncols + procedure, pass(a) :: get_nzeros => psb_s_get_nzeros + procedure, pass(a) :: get_nz_row => psb_s_get_nz_row + procedure, pass(a) :: get_size => psb_s_get_size + procedure, pass(a) :: get_state => psb_s_get_state + procedure, pass(a) :: get_dupl => psb_s_get_dupl + procedure, pass(a) :: is_null => psb_s_is_null + procedure, pass(a) :: is_bld => psb_s_is_bld + procedure, pass(a) :: is_upd => psb_s_is_upd + procedure, pass(a) :: is_asb => psb_s_is_asb + procedure, pass(a) :: is_sorted => psb_s_is_sorted + procedure, pass(a) :: is_upper => psb_s_is_upper + procedure, pass(a) :: is_lower => psb_s_is_lower + procedure, pass(a) :: is_triangle => psb_s_is_triangle + procedure, pass(a) :: is_unit => psb_s_is_unit procedure, pass(a) :: get_fmt => psb_s_get_fmt procedure, pass(a) :: sizeof => psb_s_sizeof @@ -82,8 +82,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) :: csnmi => psb_s_csnmi @@ -99,9 +99,9 @@ module psb_s_mat_mod end type psb_s_sparse_mat - private :: get_nrows, get_ncols, get_nzeros, get_size, & - & get_state, get_dupl, is_null, is_bld, is_upd, & - & is_asb, is_sorted, is_upper, is_lower, is_triangle + private :: psb_s_get_nrows, psb_s_get_ncols, 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 interface psb_sizeof module procedure psb_s_sizeof @@ -129,7 +129,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_s_sparse_mat @@ -137,7 +137,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_s_sparse_mat @@ -145,7 +145,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_s_sparse_mat @@ -153,35 +153,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_s_sparse_mat class(psb_s_sparse_mat), intent(inout) :: a end subroutine psb_s_set_null end interface - + interface subroutine psb_s_set_bld(a) import psb_s_sparse_mat class(psb_s_sparse_mat), intent(inout) :: a end subroutine psb_s_set_bld end interface - + interface subroutine psb_s_set_upd(a) import psb_s_sparse_mat class(psb_s_sparse_mat), intent(inout) :: a end subroutine psb_s_set_upd end interface - + interface subroutine psb_s_set_asb(a) import psb_s_sparse_mat class(psb_s_sparse_mat), intent(inout) :: a end subroutine psb_s_set_asb end interface - + interface subroutine psb_s_set_sorted(a,val) import psb_s_sparse_mat @@ -189,7 +189,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_s_sparse_mat @@ -197,7 +197,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_s_sparse_mat @@ -205,7 +205,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_s_sparse_mat @@ -213,7 +213,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_s_sparse_mat @@ -221,8 +221,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_s_sparse_mat @@ -234,7 +234,7 @@ module psb_s_mat_mod integer, intent(in), optional :: ivr(:), ivc(:) end subroutine psb_s_sparse_print end interface - + interface subroutine psb_s_get_neigh(a,idx,neigh,n,info,lev) import psb_s_sparse_mat @@ -246,7 +246,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_s_sparse_mat @@ -256,7 +256,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_s_sparse_mat @@ -264,21 +264,21 @@ module psb_s_mat_mod class(psb_s_sparse_mat), intent(inout) :: a end subroutine psb_s_reallocate_nz end interface - + interface subroutine psb_s_free(a) import psb_s_sparse_mat class(psb_s_sparse_mat), intent(inout) :: a end subroutine psb_s_free end interface - + interface subroutine psb_s_trim(a) import psb_s_sparse_mat class(psb_s_sparse_mat), 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_s_sparse_mat, psb_spk_ @@ -289,10 +289,10 @@ module psb_s_mat_mod 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) + & jmin,jmax,iren,append,nzin,rscale,cscale) import psb_s_sparse_mat, psb_spk_ class(psb_s_sparse_mat), intent(in) :: a integer, intent(in) :: imin,imax @@ -305,7 +305,7 @@ 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) @@ -322,10 +322,10 @@ 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) + & jmin,jmax,iren,append,rscale,cscale) import psb_s_sparse_mat, psb_spk_ class(psb_s_sparse_mat), intent(in) :: a class(psb_s_sparse_mat), intent(out) :: b @@ -337,10 +337,10 @@ 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) + & imin,imax,jmin,jmax,rscale,cscale) import psb_s_sparse_mat, psb_spk_ class(psb_s_sparse_mat), intent(in) :: a class(psb_s_sparse_mat), intent(out) :: b @@ -349,10 +349,10 @@ 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) + & imin,imax,jmin,jmax,rscale,cscale) import psb_s_sparse_mat, psb_spk_, psb_s_coo_sparse_mat class(psb_s_sparse_mat), intent(in) :: a type(psb_s_coo_sparse_mat), intent(out) :: b @@ -361,7 +361,7 @@ 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_s_sparse_mat, psb_spk_, psb_s_base_sparse_mat @@ -373,7 +373,7 @@ 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) @@ -385,7 +385,7 @@ 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) @@ -396,7 +396,7 @@ module psb_s_mat_mod integer,optional, intent(in) :: dupl end subroutine psb_s_cscnv_base end interface - + interface subroutine psb_s_clip_d(a,b,info) import psb_s_sparse_mat @@ -405,7 +405,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_s_sparse_mat @@ -413,7 +413,7 @@ 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_s_sparse_mat, psb_spk_, psb_s_base_sparse_mat @@ -421,7 +421,7 @@ module psb_s_mat_mod 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_s_sparse_mat, psb_spk_, psb_s_base_sparse_mat @@ -429,7 +429,7 @@ module psb_s_mat_mod 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_s_sparse_mat, psb_spk_, psb_s_base_sparse_mat @@ -437,7 +437,7 @@ module psb_s_mat_mod 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_s_sparse_mat, psb_spk_, psb_s_base_sparse_mat @@ -445,7 +445,7 @@ module psb_s_mat_mod class(psb_s_base_sparse_mat), intent(out) :: b end subroutine psb_s_cp_to end interface - + interface psb_move_alloc subroutine psb_s_sparse_mat_move(a,b,info) import psb_s_sparse_mat @@ -454,7 +454,7 @@ module psb_s_mat_mod integer, intent(out) :: info end subroutine psb_s_sparse_mat_move end interface - + interface psb_clone subroutine psb_s_sparse_mat_clone(a,b,info) @@ -464,14 +464,14 @@ module psb_s_mat_mod integer, intent(out) :: info end subroutine psb_s_sparse_mat_clone end interface - + interface subroutine psb_s_transp_1mat(a) import psb_s_sparse_mat class(psb_s_sparse_mat), intent(inout) :: a end subroutine psb_s_transp_1mat end interface - + interface subroutine psb_s_transp_2mat(a,b) import psb_s_sparse_mat @@ -479,14 +479,14 @@ module psb_s_mat_mod class(psb_s_sparse_mat), intent(in) :: b end subroutine psb_s_transp_2mat end interface - + interface subroutine psb_s_transc_1mat(a) import psb_s_sparse_mat class(psb_s_sparse_mat), intent(inout) :: a end subroutine psb_s_transc_1mat end interface - + interface subroutine psb_s_transc_2mat(a,b) import psb_s_sparse_mat @@ -494,16 +494,15 @@ module psb_s_mat_mod class(psb_s_sparse_mat), intent(in) :: b end subroutine psb_s_transc_2mat end interface - + interface subroutine psb_s_reinit(a,clear) import psb_s_sparse_mat class(psb_s_sparse_mat), intent(inout) :: a logical, intent(in), optional :: clear end subroutine psb_s_reinit - + end interface - ! == =================================== @@ -537,7 +536,7 @@ module psb_s_mat_mod character, optional, intent(in) :: trans end subroutine psb_s_csmv end interface - + interface psb_cssm subroutine psb_s_cssm(alpha,a,x,beta,y,info,trans,scale,d) import psb_s_sparse_mat, psb_spk_ @@ -558,7 +557,7 @@ module psb_s_mat_mod real(psb_spk_), intent(in), optional :: d(:) end subroutine psb_s_cssv end interface - + interface function psb_s_csnmi(a) result(res) import psb_s_sparse_mat, psb_spk_ @@ -566,7 +565,7 @@ module psb_s_mat_mod real(psb_spk_) :: res end function psb_s_csnmi end interface - + interface subroutine psb_s_get_diag(a,d,info) import psb_s_sparse_mat, psb_spk_ @@ -575,7 +574,7 @@ module psb_s_mat_mod integer, intent(out) :: info end subroutine psb_s_get_diag end interface - + interface psb_scal subroutine psb_s_scal(d,a,info) import psb_s_sparse_mat, psb_spk_ @@ -609,17 +608,17 @@ contains ! ! == =================================== - + function psb_s_sizeof(a) result(res) implicit none class(psb_s_sparse_mat), 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 @@ -638,8 +637,7 @@ contains end function psb_s_get_fmt - - function get_dupl(a) result(res) + function psb_s_get_dupl(a) result(res) implicit none class(psb_s_sparse_mat), intent(in) :: a integer :: res @@ -649,10 +647,10 @@ contains else res = psb_invalid_ end if - end function get_dupl + end function psb_s_get_dupl - function get_state(a) result(res) + function psb_s_get_state(a) result(res) implicit none class(psb_s_sparse_mat), intent(in) :: a integer :: res @@ -662,9 +660,9 @@ contains else res = psb_spmat_null_ end if - end function get_state + end function psb_s_get_state - function get_nrows(a) result(res) + function psb_s_get_nrows(a) result(res) implicit none class(psb_s_sparse_mat), intent(in) :: a integer :: res @@ -675,9 +673,9 @@ contains res = 0 end if - end function get_nrows + end function psb_s_get_nrows - function get_ncols(a) result(res) + function psb_s_get_ncols(a) result(res) implicit none class(psb_s_sparse_mat), intent(in) :: a integer :: res @@ -688,9 +686,9 @@ contains res = 0 end if - end function get_ncols + end function psb_s_get_ncols - function is_triangle(a) result(res) + function psb_s_is_triangle(a) result(res) implicit none class(psb_s_sparse_mat), intent(in) :: a logical :: res @@ -701,9 +699,9 @@ contains res = .false. end if - end function is_triangle + end function psb_s_is_triangle - function is_unit(a) result(res) + function psb_s_is_unit(a) result(res) implicit none class(psb_s_sparse_mat), intent(in) :: a logical :: res @@ -714,9 +712,9 @@ contains res = .false. end if - end function is_unit + end function psb_s_is_unit - function is_upper(a) result(res) + function psb_s_is_upper(a) result(res) implicit none class(psb_s_sparse_mat), intent(in) :: a logical :: res @@ -727,9 +725,9 @@ contains res = .false. end if - end function is_upper + end function psb_s_is_upper - function is_lower(a) result(res) + function psb_s_is_lower(a) result(res) implicit none class(psb_s_sparse_mat), intent(in) :: a logical :: res @@ -740,9 +738,9 @@ contains res = .false. end if - end function is_lower + end function psb_s_is_lower - function is_null(a) result(res) + function psb_s_is_null(a) result(res) implicit none class(psb_s_sparse_mat), intent(in) :: a logical :: res @@ -753,9 +751,9 @@ contains res = .true. end if - end function is_null + end function psb_s_is_null - function is_bld(a) result(res) + function psb_s_is_bld(a) result(res) implicit none class(psb_s_sparse_mat), intent(in) :: a logical :: res @@ -766,9 +764,9 @@ contains res = .false. end if - end function is_bld + end function psb_s_is_bld - function is_upd(a) result(res) + function psb_s_is_upd(a) result(res) implicit none class(psb_s_sparse_mat), intent(in) :: a logical :: res @@ -779,9 +777,9 @@ contains res = .false. end if - end function is_upd + end function psb_s_is_upd - function is_asb(a) result(res) + function psb_s_is_asb(a) result(res) implicit none class(psb_s_sparse_mat), intent(in) :: a logical :: res @@ -792,9 +790,9 @@ contains res = .false. end if - end function is_asb + end function psb_s_is_asb - function is_sorted(a) result(res) + function psb_s_is_sorted(a) result(res) implicit none class(psb_s_sparse_mat), intent(in) :: a logical :: res @@ -805,11 +803,11 @@ contains res = .false. end if - end function is_sorted + end function psb_s_is_sorted - function get_nzeros(a) result(res) + function psb_s_get_nzeros(a) result(res) implicit none class(psb_s_sparse_mat), intent(in) :: a integer :: res @@ -819,9 +817,9 @@ contains res = a%a%get_nzeros() end if - end function get_nzeros + end function psb_s_get_nzeros - function get_size(a) result(res) + function psb_s_get_size(a) result(res) implicit none class(psb_s_sparse_mat), intent(in) :: a @@ -833,22 +831,22 @@ contains res = a%a%get_size() end if - end function get_size + end function psb_s_get_size - function get_nz_row(idx,a) result(res) + function psb_s_get_nz_row(idx,a) result(res) implicit none integer, intent(in) :: idx class(psb_s_sparse_mat), intent(in) :: a integer :: res - + Integer :: err_act res = 0 - + if (allocated(a%a)) res = a%a%get_nz_row(idx) - end function get_nz_row + end function psb_s_get_nz_row end module psb_s_mat_mod diff --git a/base/modules/psb_s_tools_mod.f90 b/base/modules/psb_s_tools_mod.f90 index 353ba4d6..9ef3679f 100644 --- a/base/modules/psb_s_tools_mod.f90 +++ b/base/modules/psb_s_tools_mod.f90 @@ -138,8 +138,8 @@ Module psb_s_tools_mod subroutine psb_sspalloc(a, desc_a, info, nnz) use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_s_sparse_mat - type(psb_desc_type), intent(inout) :: desc_a - type(psb_s_sparse_mat), intent(out) :: a + type(psb_desc_type), intent(in) :: desc_a + type(psb_s_sparse_mat), intent(inout) :: a integer, intent(out) :: info integer, optional, intent(in) :: nnz end subroutine psb_sspalloc diff --git a/base/modules/psb_z_mat_mod.f03 b/base/modules/psb_z_mat_mod.f03 index 2858ba2f..214b733b 100644 --- a/base/modules/psb_z_mat_mod.f03 +++ b/base/modules/psb_z_mat_mod.f03 @@ -10,22 +10,22 @@ module psb_z_mat_mod contains ! Getters - procedure, pass(a) :: get_nrows - procedure, pass(a) :: get_ncols - procedure, pass(a) :: get_nzeros - procedure, pass(a) :: get_nz_row - procedure, pass(a) :: get_size - procedure, pass(a) :: get_state - procedure, pass(a) :: get_dupl - procedure, pass(a) :: is_null - procedure, pass(a) :: is_bld - procedure, pass(a) :: is_upd - procedure, pass(a) :: is_asb - procedure, pass(a) :: is_sorted - procedure, pass(a) :: is_upper - procedure, pass(a) :: is_lower - procedure, pass(a) :: is_triangle - procedure, pass(a) :: is_unit + procedure, pass(a) :: get_nrows => psb_z_get_nrows + procedure, pass(a) :: get_ncols => psb_z_get_ncols + procedure, pass(a) :: get_nzeros => psb_z_get_nzeros + procedure, pass(a) :: get_nz_row => psb_z_get_nz_row + procedure, pass(a) :: get_size => psb_z_get_size + procedure, pass(a) :: get_state => psb_z_get_state + procedure, pass(a) :: get_dupl => psb_z_get_dupl + procedure, pass(a) :: is_null => psb_z_is_null + procedure, pass(a) :: is_bld => psb_z_is_bld + procedure, pass(a) :: is_upd => psb_z_is_upd + procedure, pass(a) :: is_asb => psb_z_is_asb + procedure, pass(a) :: is_sorted => psb_z_is_sorted + procedure, pass(a) :: is_upper => psb_z_is_upper + procedure, pass(a) :: is_lower => psb_z_is_lower + procedure, pass(a) :: is_triangle => psb_z_is_triangle + procedure, pass(a) :: is_unit => psb_z_is_unit procedure, pass(a) :: get_fmt => psb_z_get_fmt procedure, pass(a) :: sizeof => psb_z_sizeof @@ -99,9 +99,9 @@ module psb_z_mat_mod end type psb_z_sparse_mat - private :: get_nrows, get_ncols, get_nzeros, get_size, & - & get_state, get_dupl, is_null, is_bld, is_upd, & - & is_asb, is_sorted, is_upper, is_lower, is_triangle + 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 interface psb_sizeof module procedure psb_z_sizeof @@ -623,7 +623,6 @@ contains end function psb_z_sizeof - function psb_z_get_fmt(a) result(res) implicit none class(psb_z_sparse_mat), intent(in) :: a @@ -638,8 +637,7 @@ contains end function psb_z_get_fmt - - function get_dupl(a) result(res) + function psb_z_get_dupl(a) result(res) implicit none class(psb_z_sparse_mat), intent(in) :: a integer :: res @@ -649,10 +647,10 @@ contains else res = psb_invalid_ end if - end function get_dupl + end function psb_z_get_dupl - function get_state(a) result(res) + function psb_z_get_state(a) result(res) implicit none class(psb_z_sparse_mat), intent(in) :: a integer :: res @@ -662,9 +660,9 @@ contains else res = psb_spmat_null_ end if - end function get_state + end function psb_z_get_state - function get_nrows(a) result(res) + function psb_z_get_nrows(a) result(res) implicit none class(psb_z_sparse_mat), intent(in) :: a integer :: res @@ -675,9 +673,9 @@ contains res = 0 end if - end function get_nrows + end function psb_z_get_nrows - function get_ncols(a) result(res) + function psb_z_get_ncols(a) result(res) implicit none class(psb_z_sparse_mat), intent(in) :: a integer :: res @@ -688,9 +686,9 @@ contains res = 0 end if - end function get_ncols + end function psb_z_get_ncols - function is_triangle(a) result(res) + function psb_z_is_triangle(a) result(res) implicit none class(psb_z_sparse_mat), intent(in) :: a logical :: res @@ -701,9 +699,9 @@ contains res = .false. end if - end function is_triangle + end function psb_z_is_triangle - function is_unit(a) result(res) + function psb_z_is_unit(a) result(res) implicit none class(psb_z_sparse_mat), intent(in) :: a logical :: res @@ -714,9 +712,9 @@ contains res = .false. end if - end function is_unit + end function psb_z_is_unit - function is_upper(a) result(res) + function psb_z_is_upper(a) result(res) implicit none class(psb_z_sparse_mat), intent(in) :: a logical :: res @@ -727,9 +725,9 @@ contains res = .false. end if - end function is_upper + end function psb_z_is_upper - function is_lower(a) result(res) + function psb_z_is_lower(a) result(res) implicit none class(psb_z_sparse_mat), intent(in) :: a logical :: res @@ -740,9 +738,9 @@ contains res = .false. end if - end function is_lower + end function psb_z_is_lower - function is_null(a) result(res) + function psb_z_is_null(a) result(res) implicit none class(psb_z_sparse_mat), intent(in) :: a logical :: res @@ -753,9 +751,9 @@ contains res = .true. end if - end function is_null + end function psb_z_is_null - function is_bld(a) result(res) + function psb_z_is_bld(a) result(res) implicit none class(psb_z_sparse_mat), intent(in) :: a logical :: res @@ -766,9 +764,9 @@ contains res = .false. end if - end function is_bld + end function psb_z_is_bld - function is_upd(a) result(res) + function psb_z_is_upd(a) result(res) implicit none class(psb_z_sparse_mat), intent(in) :: a logical :: res @@ -779,9 +777,9 @@ contains res = .false. end if - end function is_upd + end function psb_z_is_upd - function is_asb(a) result(res) + function psb_z_is_asb(a) result(res) implicit none class(psb_z_sparse_mat), intent(in) :: a logical :: res @@ -792,9 +790,9 @@ contains res = .false. end if - end function is_asb + end function psb_z_is_asb - function is_sorted(a) result(res) + function psb_z_is_sorted(a) result(res) implicit none class(psb_z_sparse_mat), intent(in) :: a logical :: res @@ -805,11 +803,11 @@ contains res = .false. end if - end function is_sorted + end function psb_z_is_sorted - function get_nzeros(a) result(res) + function psb_z_get_nzeros(a) result(res) implicit none class(psb_z_sparse_mat), intent(in) :: a integer :: res @@ -819,9 +817,9 @@ contains res = a%a%get_nzeros() end if - end function get_nzeros + end function psb_z_get_nzeros - function get_size(a) result(res) + function psb_z_get_size(a) result(res) implicit none class(psb_z_sparse_mat), intent(in) :: a @@ -833,10 +831,10 @@ contains res = a%a%get_size() end if - end function get_size + end function psb_z_get_size - function get_nz_row(idx,a) result(res) + function psb_z_get_nz_row(idx,a) result(res) implicit none integer, intent(in) :: idx class(psb_z_sparse_mat), intent(in) :: a @@ -848,7 +846,7 @@ contains if (allocated(a%a)) res = a%a%get_nz_row(idx) - end function get_nz_row + end function psb_z_get_nz_row end module psb_z_mat_mod diff --git a/base/modules/psb_z_tools_mod.f90 b/base/modules/psb_z_tools_mod.f90 index b72992ec..9e9701b3 100644 --- a/base/modules/psb_z_tools_mod.f90 +++ b/base/modules/psb_z_tools_mod.f90 @@ -138,8 +138,8 @@ Module psb_z_tools_mod subroutine psb_zspalloc(a, desc_a, info, nnz) use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_z_sparse_mat - type(psb_desc_type), intent(inout) :: desc_a - type(psb_z_sparse_mat), intent(out) :: a + type(psb_desc_type), intent(in) :: desc_a + type(psb_z_sparse_mat), intent(inout) :: a integer, intent(out) :: info integer, optional, intent(in) :: nnz end subroutine psb_zspalloc diff --git a/base/serial/Makefile b/base/serial/Makefile index f24ceef0..d597ce66 100644 --- a/base/serial/Makefile +++ b/base/serial/Makefile @@ -2,10 +2,11 @@ include ../../Make.inc FOBJS = psb_lsame.o psi_serial_impl.o psi_impl.o psb_sort_impl.o \ - psb_ssymbmm.o psb_dsymbmm.o psb_csymbmm.o psb_zsymbmm.o \ - psb_snumbmm.o psb_dnumbmm.o psb_cnumbmm.o psb_znumbmm.o \ psb_srwextd.o psb_drwextd.o psb_crwextd.o psb_zrwextd.o +# psb_ssymbmm.o psb_dsymbmm.o psb_csymbmm.o psb_zsymbmm.o \ +# psb_snumbmm.o psb_dnumbmm.o psb_cnumbmm.o psb_znumbmm.o \ + LIBDIR=.. MODDIR=../modules FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG)$(MODDIR) $(FMFLAG). diff --git a/base/serial/f03/psb_c_coo_impl.f03 b/base/serial/f03/psb_c_coo_impl.f03 index baccca36..390c86a4 100644 --- a/base/serial/f03/psb_c_coo_impl.f03 +++ b/base/serial/f03/psb_c_coo_impl.f03 @@ -378,10 +378,10 @@ end subroutine psb_c_coo_print -function psb_c_coo_get_nc_row(idx,a) result(res) +function psb_c_coo_get_nz_row(idx,a) result(res) use psb_const_mod use psb_sort_mod - use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_get_nc_row + use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_get_nz_row implicit none class(psb_c_coo_sparse_mat), intent(in) :: a @@ -427,7 +427,7 @@ function psb_c_coo_get_nc_row(idx,a) result(res) end if -end function psb_c_coo_get_nc_row +end function psb_c_coo_get_nz_row subroutine psb_c_coo_cssm(alpha,a,x,beta,y,info,trans) use psb_const_mod diff --git a/base/serial/f03/psb_c_mat_impl.f03 b/base/serial/f03/psb_c_mat_impl.f03 index f7cd5272..cdc7f2bc 100644 --- a/base/serial/f03/psb_c_mat_impl.f03 +++ b/base/serial/f03/psb_c_mat_impl.f03 @@ -618,29 +618,12 @@ subroutine psb_c_free(a) use psb_error_mod implicit none class(psb_c_sparse_mat), intent(inout) :: a - Integer :: err_act, info - character(len=20) :: name='free' - logical, parameter :: debug=.false. - call psb_get_erraction(err_act) - if (.not.allocated(a%a)) then - info = 1121 - call psb_errpush(info,name) - goto 9999 + if (allocated(a%a)) then + call a%a%free() + deallocate(a%a) endif - call a%a%free() - deallocate(a%a) - return - -9999 continue - - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine psb_c_free diff --git a/base/serial/f03/psb_d_mat_impl.f03 b/base/serial/f03/psb_d_mat_impl.f03 index 34720350..917b8cba 100644 --- a/base/serial/f03/psb_d_mat_impl.f03 +++ b/base/serial/f03/psb_d_mat_impl.f03 @@ -618,29 +618,12 @@ subroutine psb_d_free(a) use psb_error_mod implicit none class(psb_d_sparse_mat), intent(inout) :: a - Integer :: err_act, info - character(len=20) :: name='free' - logical, parameter :: debug=.false. - call psb_get_erraction(err_act) - if (.not.allocated(a%a)) then - info = 1121 - call psb_errpush(info,name) - goto 9999 + if (allocated(a%a)) then + call a%a%free() + deallocate(a%a) endif - call a%a%free() - deallocate(a%a) - return - -9999 continue - - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine psb_d_free diff --git a/base/serial/f03/psb_s_mat_impl.f03 b/base/serial/f03/psb_s_mat_impl.f03 index 95a5bbbc..71d3d2e8 100644 --- a/base/serial/f03/psb_s_mat_impl.f03 +++ b/base/serial/f03/psb_s_mat_impl.f03 @@ -618,29 +618,12 @@ subroutine psb_s_free(a) use psb_error_mod implicit none class(psb_s_sparse_mat), intent(inout) :: a - Integer :: err_act, info - character(len=20) :: name='free' - logical, parameter :: debug=.false. - call psb_get_erraction(err_act) - if (.not.allocated(a%a)) then - info = 1121 - call psb_errpush(info,name) - goto 9999 + if (allocated(a%a)) then + call a%a%free() + deallocate(a%a) endif - call a%a%free() - deallocate(a%a) - return - -9999 continue - - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine psb_s_free diff --git a/base/serial/f03/psb_z_mat_impl.f03 b/base/serial/f03/psb_z_mat_impl.f03 index 0c3659a0..008533e7 100644 --- a/base/serial/f03/psb_z_mat_impl.f03 +++ b/base/serial/f03/psb_z_mat_impl.f03 @@ -618,29 +618,12 @@ subroutine psb_z_free(a) use psb_error_mod implicit none class(psb_z_sparse_mat), intent(inout) :: a - Integer :: err_act, info - character(len=20) :: name='free' - logical, parameter :: debug=.false. - call psb_get_erraction(err_act) - if (.not.allocated(a%a)) then - info = 1121 - call psb_errpush(info,name) - goto 9999 + if (allocated(a%a)) then + call a%a%free() + deallocate(a%a) endif - call a%a%free() - deallocate(a%a) - return - -9999 continue - - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine psb_z_free diff --git a/base/tools/Makefile b/base/tools/Makefile index c53203cd..05056fd5 100644 --- a/base/tools/Makefile +++ b/base/tools/Makefile @@ -21,7 +21,7 @@ FOBJS = psb_sallc.o psb_sasb.o \ psb_cspins.o psb_csprn.o psb_cd_set_bld.o #psb_linmap.o psb_map.o -MPFOBJS = psb_ssphalo.o psb_csphalo.o psb_dsphalo.o psb_zsphalo.o psb_icdasb.o \ +MPFOBJS = psb_icdasb.o psb_ssphalo.o psb_dsphalo.o psb_csphalo.o psb_zsphalo.o \ psb_dcdbldext.o psb_zcdbldext.o psb_scdbldext.o psb_ccdbldext.o LIBDIR=.. diff --git a/base/tools/psb_cspalloc.f90 b/base/tools/psb_cspalloc.f90 index a5d15923..42c31447 100644 --- a/base/tools/psb_cspalloc.f90 +++ b/base/tools/psb_cspalloc.f90 @@ -46,8 +46,8 @@ subroutine psb_cspalloc(a, desc_a, info, nnz) implicit none !....parameters... - type(psb_desc_type), intent(inout) :: desc_a - type(psb_c_sparse_mat), intent(out) :: a + type(psb_desc_type), intent(in) :: desc_a + type(psb_c_sparse_mat), intent(inout) :: a integer, intent(out) :: info integer, optional, intent(in) :: nnz @@ -102,6 +102,7 @@ subroutine psb_cspalloc(a, desc_a, info, nnz) & write(debug_unit,*) me,' ',trim(name),':allocating size:',length_ia1 !....allocate aspk, ia1, ia2..... + call a%free() call a%csall(loc_row,loc_col,info,nz=length_ia1) if(info /= psb_success_) then info=psb_err_from_subroutine_ diff --git a/base/tools/psb_dspalloc.f90 b/base/tools/psb_dspalloc.f90 index ac8248b5..260e3d02 100644 --- a/base/tools/psb_dspalloc.f90 +++ b/base/tools/psb_dspalloc.f90 @@ -46,8 +46,8 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) implicit none !....parameters... - type(psb_desc_type), intent(inout) :: desc_a - type(psb_d_sparse_mat), intent(out) :: a + type(psb_desc_type), intent(in) :: desc_a + type(psb_d_sparse_mat), intent(inout) :: a integer, intent(out) :: info integer, optional, intent(in) :: nnz @@ -100,6 +100,7 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),':allocating size:',length_ia1 + call a%free() !....allocate aspk, ia1, ia2..... call a%csall(loc_row,loc_col,info,nz=length_ia1) diff --git a/base/tools/psb_dsphalo.F90 b/base/tools/psb_dsphalo.F90 index d29165d0..6b073ee9 100644 --- a/base/tools/psb_dsphalo.F90 +++ b/base/tools/psb_dsphalo.F90 @@ -68,9 +68,9 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& include 'mpif.h' #endif - Type(psb_d_sparse_mat),Intent(in) :: a - Type(psb_d_sparse_mat),Intent(inout) :: blk - Type(psb_desc_type),Intent(in), target :: desc_a + type(psb_d_sparse_mat),intent(in) :: a + type(psb_d_sparse_mat),intent(inout) :: blk + type(psb_desc_type),intent(in), target :: desc_a integer, intent(out) :: info logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale character(len=5), optional :: outfmt diff --git a/base/tools/psb_sspalloc.f90 b/base/tools/psb_sspalloc.f90 index c83d5af5..c81f88e4 100644 --- a/base/tools/psb_sspalloc.f90 +++ b/base/tools/psb_sspalloc.f90 @@ -46,8 +46,8 @@ subroutine psb_sspalloc(a, desc_a, info, nnz) implicit none !....parameters... - type(psb_desc_type), intent(inout) :: desc_a - type(psb_s_sparse_mat), intent(out) :: a + type(psb_desc_type), intent(in) :: desc_a + type(psb_s_sparse_mat), intent(inout) :: a integer, intent(out) :: info integer, optional, intent(in) :: nnz @@ -100,7 +100,7 @@ subroutine psb_sspalloc(a, desc_a, info, nnz) if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),':allocating size:',length_ia1 - + call a%free() !....allocate aspk, ia1, ia2..... call a%csall(loc_row,loc_col,info,nz=length_ia1) if(info /= psb_success_) then diff --git a/base/tools/psb_zspalloc.f90 b/base/tools/psb_zspalloc.f90 index ae5413b3..9d37d2b0 100644 --- a/base/tools/psb_zspalloc.f90 +++ b/base/tools/psb_zspalloc.f90 @@ -46,8 +46,8 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) implicit none !....parameters... - type(psb_desc_type), intent(inout) :: desc_a - type(psb_z_sparse_mat), intent(out) :: a + type(psb_desc_type), intent(in) :: desc_a + type(psb_z_sparse_mat), intent(inout) :: a integer, intent(out) :: info integer, optional, intent(in) :: nnz @@ -100,7 +100,7 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),':allocating size:',length_ia1 - + call a%free() !....allocate aspk, ia1, ia2..... call a%csall(loc_row,loc_col,info,nz=length_ia1) if(info /= psb_success_) then