From 720fbd161ace430eaffeeaf4e5f883d1b3b8faec Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 22 Sep 2009 16:15:42 +0000 Subject: [PATCH] psblas3: base/modules/psb_base_mat_mod.f03 base/modules/psb_d_base_mat_mod.f03 base/modules/psb_linmap_mod.f90 base/modules/psb_linmap_type_mod.f90 base/modules/psb_serial_mod.f90 base/modules/psb_spmat_type.f03 base/serial/f03/psbn_d_coo_impl.f03 base/serial/f03/psbn_d_csr_impl.f03 prec/psb_dbjac_bld.f90 prec/psb_dilu_fct.f90 prec/psb_dprecbld.f90 prec/psb_prec_mod.f90 prec/psb_prec_type.f90 test/fileread/df_sample.f90 util/psb_metispart_mod.F90 1. Taken out psb_dspmat_type from definition modules. 2. Commented out compilation of all old serial stuff; 3. Fixed (for the time being, but needs more exploration) CP_FROM and MV_FROM. 4. BEWARE: new serial stuff is still incomplete. --- base/modules/psb_base_mat_mod.f03 | 133 +- base/modules/psb_d_base_mat_mod.f03 | 45 + base/modules/psb_linmap_mod.f90 | 2 +- base/modules/psb_linmap_type_mod.f90 | 2 +- base/modules/psb_serial_mod.f90 | 598 ++++----- base/modules/psb_spmat_type.f03 | 1717 +++++++++++++------------- base/serial/f03/psbn_d_coo_impl.f03 | 8 +- base/serial/f03/psbn_d_csr_impl.f03 | 14 +- prec/psb_dbjac_bld.f90 | 4 +- prec/psb_dilu_fct.f90 | 22 +- prec/psb_dprecbld.f90 | 1 - prec/psb_prec_mod.f90 | 16 +- prec/psb_prec_type.f90 | 2 +- test/fileread/df_sample.f90 | 9 +- util/psb_metispart_mod.F90 | 22 +- 15 files changed, 1334 insertions(+), 1261 deletions(-) diff --git a/base/modules/psb_base_mat_mod.f03 b/base/modules/psb_base_mat_mod.f03 index 32047159..1d3647ae 100644 --- a/base/modules/psb_base_mat_mod.f03 +++ b/base/modules/psb_base_mat_mod.f03 @@ -3,9 +3,14 @@ module psb_base_mat_mod use psb_const_mod type :: psb_base_sparse_mat - integer, private :: m, n - integer, private :: state, duplicate - logical, private :: triangle, unitd, upper, sorted + integer :: m, n + integer :: state, duplicate + logical :: triangle, unitd, upper, sorted + ! This is a different animal: it's a kitchen sink for + ! any additional parameters that may be needed + ! when converting to/from COO. Why here? + ! Will tell you one day... + integer, allocatable :: aux(:) contains ! ==================================== @@ -22,6 +27,7 @@ module psb_base_mat_mod procedure, pass(a) :: get_state procedure, pass(a) :: get_dupl procedure, pass(a) :: get_fmt + procedure, pass(a) :: get_aux procedure, pass(a) :: is_null procedure, pass(a) :: is_bld procedure, pass(a) :: is_upd @@ -50,7 +56,7 @@ module psb_base_mat_mod procedure, pass(a) :: set_lower procedure, pass(a) :: set_triangle procedure, pass(a) :: set_unit - + procedure, pass(a) :: set_aux ! ==================================== @@ -58,6 +64,7 @@ module psb_base_mat_mod ! Data management ! ! ==================================== + procedure, pass(a) :: get_neigh procedure, pass(a) :: allocate_mnnz procedure, pass(a) :: reallocate_nz @@ -69,7 +76,9 @@ module psb_base_mat_mod procedure, pass(a) :: csgetptn generic, public :: csget => csgetptn procedure, pass(a) :: print => sparse_print - procedure, pass(a) :: sizeof + procedure, pass(a) :: sizeof +!!$ procedure, pass(a) :: base_cp_from +!!$ procedure, pass(a) :: base_mv_from end type psb_base_sparse_mat @@ -80,7 +89,14 @@ module psb_base_mat_mod & is_upd, is_asb, is_sorted, is_upper, is_lower, is_triangle, & & is_unit, get_neigh, allocate_mn, allocate_mnnz, reallocate_nz, & & free, sparse_print, get_fmt, trim, sizeof, reinit, csgetptn, & - & get_nz_row + & get_nz_row, get_aux, set_aux +!!$, base_mv_from, base_cp_from + interface cp_from + module procedure base_cp_from + end interface + interface mv_from + module procedure base_mv_from + end interface contains @@ -130,6 +146,22 @@ contains end function get_ncols + subroutine set_aux(v,a) + implicit none + class(psb_base_sparse_mat), intent(inout) :: a + integer, intent(in) :: v(:) + ! TBD + write(0,*) 'SET_AUX is empty right now ' + end subroutine set_aux + + subroutine get_aux(v,a) + implicit none + class(psb_base_sparse_mat), intent(in) :: a + integer, intent(out), allocatable :: v(:) + ! TBD + write(0,*) 'GET_AUX is empty right now ' + end subroutine get_aux + subroutine set_nrows(m,a) implicit none class(psb_base_sparse_mat), intent(inout) :: a @@ -410,51 +442,50 @@ contains end subroutine reinit -!!$ -!!$ ! -!!$ ! Since at this level we have only simple components, -!!$ ! mv_from is identical to cp_from. -!!$ ! -!!$ subroutine mv_from(a,b) -!!$ use psb_error_mod -!!$ implicit none -!!$ -!!$ class(psb_base_sparse_mat), intent(out) :: a -!!$ type(psb_base_sparse_mat), intent(inout) :: b -!!$ -!!$ a%m = b%m -!!$ a%n = b%n -!!$ a%state = b%state -!!$ a%duplicate = b%duplicate -!!$ a%triangle = b%triangle -!!$ a%unitd = b%unitd -!!$ a%upper = b%upper -!!$ a%sorted = b%sorted -!!$ -!!$ return -!!$ -!!$ end subroutine mv_from -!!$ -!!$ subroutine cp_from(a,b) -!!$ use psb_error_mod -!!$ implicit none -!!$ -!!$ class(psb_base_sparse_mat), intent(out) :: a -!!$ type(psb_base_sparse_mat), intent(in) :: b -!!$ -!!$ a%m = b%m -!!$ a%n = b%n -!!$ a%state = b%state -!!$ a%duplicate = b%duplicate -!!$ a%triangle = b%triangle -!!$ a%unitd = b%unitd -!!$ a%upper = b%upper -!!$ a%sorted = b%sorted -!!$ -!!$ return -!!$ -!!$ end subroutine cp_from -!!$ + + ! + ! + subroutine base_mv_from(a,b) + use psb_error_mod + implicit none + + type(psb_base_sparse_mat), intent(out) :: a + type(psb_base_sparse_mat), intent(inout) :: b + + a%m = b%m + a%n = b%n + a%state = b%state + a%duplicate = b%duplicate + a%triangle = b%triangle + a%unitd = b%unitd + a%upper = b%upper + a%sorted = b%sorted + call move_alloc(b%aux,a%aux) + + return + + end subroutine base_mv_from + + subroutine base_cp_from(a,b) + use psb_error_mod + implicit none + + type(psb_base_sparse_mat), intent(out) :: a + type(psb_base_sparse_mat), intent(in) :: b + + a%m = b%m + a%n = b%n + a%state = b%state + a%duplicate = b%duplicate + a%triangle = b%triangle + a%unitd = b%unitd + a%upper = b%upper + a%sorted = b%sorted + a%aux = b%aux + return + + end subroutine base_cp_from + subroutine sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc) use psb_error_mod implicit none diff --git a/base/modules/psb_d_base_mat_mod.f03 b/base/modules/psb_d_base_mat_mod.f03 index 71dc4f3d..dcf02779 100644 --- a/base/modules/psb_d_base_mat_mod.f03 +++ b/base/modules/psb_d_base_mat_mod.f03 @@ -32,6 +32,8 @@ module psb_d_base_mat_mod procedure, pass(a) :: mv_from_coo procedure, pass(a) :: mv_to_fmt procedure, pass(a) :: mv_from_fmt +!!$ procedure, pass(a) :: base_cp_from => d_base_cp_from +!!$ procedure, pass(a) :: base_mv_from => d_base_mv_from end type psb_d_base_sparse_mat private :: d_base_csmv, d_base_csmm, d_base_cssv, d_base_cssm,& @@ -39,6 +41,16 @@ module psb_d_base_mat_mod & cp_to_coo, cp_from_coo, cp_to_fmt, cp_from_fmt, & & mv_to_coo, mv_from_coo, mv_to_fmt, mv_from_fmt, & & get_diag, csclip, d_cssv, d_cssm +!!$, & +!!$ & d_base_mv_from, d_base_cp_from + + interface cp_from + module procedure d_base_cp_from + end interface + interface mv_from + module procedure d_base_mv_from + end interface + type, extends(psb_d_base_sparse_mat) :: psb_d_coo_sparse_mat @@ -314,6 +326,39 @@ contains ! !==================================== + ! + ! For the time being we do not have anything beyond + ! the base components, but you never know. + ! + subroutine d_base_mv_from(a,b) + use psb_error_mod + implicit none + + type(psb_d_base_sparse_mat), intent(out) :: a + type(psb_d_base_sparse_mat), intent(inout) :: b + +!!$ call a%psb_base_sparse_mat%base_mv_from(b%psb_base_sparse_mat) + call mv_from(a%psb_base_sparse_mat,b%psb_base_sparse_mat) + + return + + end subroutine d_base_mv_from + + subroutine d_base_cp_from(a,b) + use psb_error_mod + implicit none + + type(psb_d_base_sparse_mat), intent(out) :: a + type(psb_d_base_sparse_mat), intent(in) :: b + + call cp_from(a%psb_base_sparse_mat,b%psb_base_sparse_mat) + + return + + end subroutine d_base_cp_from + + + subroutine cp_to_coo(a,b,info) use psb_error_mod use psb_realloc_mod diff --git a/base/modules/psb_linmap_mod.f90 b/base/modules/psb_linmap_mod.f90 index 0a2cef54..da4202e3 100644 --- a/base/modules/psb_linmap_mod.f90 +++ b/base/modules/psb_linmap_mod.f90 @@ -37,7 +37,7 @@ ! module psb_linmap_mod - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type, & + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_, psb_sizeof use psb_descriptor_type use psb_linmap_type_mod diff --git a/base/modules/psb_linmap_type_mod.f90 b/base/modules/psb_linmap_type_mod.f90 index aa9d512e..485d3d8d 100644 --- a/base/modules/psb_linmap_type_mod.f90 +++ b/base/modules/psb_linmap_type_mod.f90 @@ -36,7 +36,7 @@ ! to different spaces. ! module psb_linmap_type_mod - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type, & + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_, psb_sizeof use psb_d_mat_mod, only: psb_d_sparse_mat diff --git a/base/modules/psb_serial_mod.f90 b/base/modules/psb_serial_mod.f90 index 25a488f6..6c70668c 100644 --- a/base/modules/psb_serial_mod.f90 +++ b/base/modules/psb_serial_mod.f90 @@ -40,16 +40,16 @@ module psb_serial_mod & psb_sct => psi_sct interface psb_csrws - subroutine psb_dcsrws(rw,a,info,trans) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type) :: a - real(psb_dpk_), allocatable :: rw(:) - integer :: info - character, optional :: trans - end subroutine psb_dcsrws +!!$ subroutine psb_dcsrws(rw,a,info,trans) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type) :: a +!!$ real(psb_dpk_), allocatable :: rw(:) +!!$ integer :: info +!!$ character, optional :: trans +!!$ end subroutine psb_dcsrws subroutine psb_zcsrws(rw,a,info,trans) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type) :: a complex(psb_dpk_), allocatable :: rw(:) @@ -60,7 +60,7 @@ module psb_serial_mod !!$ interface psb_cssm !!$ subroutine psb_scssm(alpha,t,b,beta,c,info,trans,unitd,d) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ use psb_spmat_type, only : psb_sspmat_type, & !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ type(psb_sspmat_type) :: t !!$ real(psb_spk_) :: alpha, beta, b(:,:), c(:,:) @@ -69,7 +69,7 @@ module psb_serial_mod !!$ real(psb_spk_), optional, target :: d(:) !!$ end subroutine psb_scssm !!$ subroutine psb_scssv(alpha,t,b,beta,c,info,trans,unitd,d) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ use psb_spmat_type, only : psb_sspmat_type, & !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ type(psb_sspmat_type) :: t !!$ real(psb_spk_) :: alpha, beta, b(:), c(:) @@ -78,7 +78,7 @@ module psb_serial_mod !!$ real(psb_spk_), optional, target :: d(:) !!$ end subroutine psb_scssv !!$ subroutine psb_dcssm(alpha,t,b,beta,c,info,trans,unitd,d) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ use psb_spmat_type, only : psb_sspmat_type, & !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ type(psb_dspmat_type) :: t !!$ real(psb_dpk_) :: alpha, beta, b(:,:), c(:,:) @@ -87,7 +87,7 @@ module psb_serial_mod !!$ real(psb_dpk_), optional, target :: d(:) !!$ end subroutine psb_dcssm !!$ subroutine psb_dcssv(alpha,t,b,beta,c,info,trans,unitd,d) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ use psb_spmat_type, only : psb_sspmat_type, & !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ type(psb_dspmat_type) :: t !!$ real(psb_dpk_) :: alpha, beta, b(:), c(:) @@ -96,7 +96,7 @@ module psb_serial_mod !!$ real(psb_dpk_), optional, target :: d(:) !!$ end subroutine psb_dcssv !!$ subroutine psb_ccssm(alpha,t,b,beta,c,info,trans,unitd,d) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ use psb_spmat_type, only : psb_sspmat_type, & !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ type(psb_cspmat_type) :: t !!$ complex(psb_spk_) :: alpha, beta, b(:,:), c(:,:) @@ -105,7 +105,7 @@ module psb_serial_mod !!$ complex(psb_spk_), optional, target :: d(:) !!$ end subroutine psb_ccssm !!$ subroutine psb_ccssv(alpha,t,b,beta,c,info,trans,unitd,d) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ use psb_spmat_type, only : psb_sspmat_type, & !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ type(psb_cspmat_type) :: t !!$ complex(psb_spk_) :: alpha, beta, b(:), c(:) @@ -114,7 +114,7 @@ module psb_serial_mod !!$ complex(psb_spk_), optional, target :: d(:) !!$ end subroutine psb_ccssv !!$ subroutine psb_zcssm(alpha,t,b,beta,c,info,trans,unitd,d) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ use psb_spmat_type, only : psb_sspmat_type, & !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ type(psb_zspmat_type) :: t !!$ complex(psb_dpk_) :: alpha, beta, b(:,:), c(:,:) @@ -123,7 +123,7 @@ module psb_serial_mod !!$ complex(psb_dpk_), optional, target :: d(:) !!$ end subroutine psb_zcssm !!$ subroutine psb_zcssv(alpha,t,b,beta,c,info,trans,unitd,d) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ use psb_spmat_type, only : psb_sspmat_type, & !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ type(psb_zspmat_type) :: t !!$ complex(psb_dpk_) :: alpha, beta, b(:), c(:) @@ -137,7 +137,7 @@ module psb_serial_mod !!$ module procedure psb_scsmm, psb_scsmv, psb_dcsmm, psb_dcsmv,& !!$ & psb_ccsmm, psb_ccsmv, psb_zcsmm, psb_zcsmv !!$ subroutine psb_scsmv(alpha,a,b,beta,c,info,trans) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ use psb_spmat_type, only : psb_sspmat_type, & !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ type(psb_sspmat_type) :: a !!$ real(psb_spk_) :: alpha, beta, b(:), c(:) @@ -145,7 +145,7 @@ module psb_serial_mod !!$ character, optional :: trans !!$ end subroutine psb_scsmv !!$ subroutine psb_scsmm(alpha,a,b,beta,c,info,trans) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ use psb_spmat_type, only : psb_sspmat_type, & !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ type(psb_sspmat_type) :: a !!$ real(psb_spk_) :: alpha, beta, b(:,:), c(:,:) @@ -153,7 +153,7 @@ module psb_serial_mod !!$ character, optional :: trans !!$ end subroutine psb_scsmm !!$ subroutine psb_dcsmv(alpha,a,b,beta,c,info,trans) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ use psb_spmat_type, only : psb_sspmat_type, & !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ type(psb_dspmat_type) :: a !!$ real(psb_dpk_) :: alpha, beta, b(:), c(:) @@ -161,7 +161,7 @@ module psb_serial_mod !!$ character, optional :: trans !!$ end subroutine psb_dcsmv !!$ subroutine psb_dcsmm(alpha,a,b,beta,c,info,trans) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ use psb_spmat_type, only : psb_sspmat_type, & !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ type(psb_dspmat_type) :: a !!$ real(psb_dpk_) :: alpha, beta, b(:,:), c(:,:) @@ -169,7 +169,7 @@ module psb_serial_mod !!$ character, optional :: trans !!$ end subroutine psb_dcsmm !!$ subroutine psb_ccsmv(alpha,a,b,beta,c,info,trans) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ use psb_spmat_type, only : psb_sspmat_type, & !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ type(psb_cspmat_type) :: a !!$ complex(psb_spk_) :: alpha, beta, b(:), c(:) @@ -177,7 +177,7 @@ module psb_serial_mod !!$ character, optional :: trans !!$ end subroutine psb_ccsmv !!$ subroutine psb_ccsmm(alpha,a,b,beta,c,info,trans) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ use psb_spmat_type, only : psb_sspmat_type, & !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ type(psb_cspmat_type) :: a !!$ complex(psb_spk_) :: alpha, beta, b(:,:), c(:,:) @@ -185,7 +185,7 @@ module psb_serial_mod !!$ character, optional :: trans !!$ end subroutine psb_ccsmm !!$ subroutine psb_zcsmv(alpha,a,b,beta,c,info,trans) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ use psb_spmat_type, only : psb_sspmat_type, & !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ type(psb_zspmat_type) :: a !!$ complex(psb_dpk_) :: alpha, beta, b(:), c(:) @@ -193,7 +193,7 @@ module psb_serial_mod !!$ character, optional :: trans !!$ end subroutine psb_zcsmv !!$ subroutine psb_zcsmm(alpha,a,b,beta,c,info,trans) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ use psb_spmat_type, only : psb_sspmat_type, & !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ type(psb_zspmat_type) :: a !!$ complex(psb_dpk_) :: alpha, beta, b(:,:), c(:,:) @@ -212,7 +212,7 @@ module psb_serial_mod interface psb_spcnv subroutine psb_sspcnv2(ain, a, info, afmt, upd, dupl) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_sspmat_type), intent (in) :: ain type(psb_sspmat_type), intent (out) :: a @@ -221,32 +221,32 @@ module psb_serial_mod character(len=*), optional, intent(in) :: afmt end subroutine psb_sspcnv2 subroutine psb_sspcnv1(a, info, afmt, upd, dupl) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_sspmat_type), intent (inout) :: a integer, intent(out) :: info integer,optional, intent(in) :: dupl, upd character(len=*), optional, intent(in) :: afmt end subroutine psb_sspcnv1 - subroutine psb_dspcnv2(ain, a, info, afmt, upd, dupl) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type), intent (in) :: ain - type(psb_dspmat_type), intent (out) :: a - integer, intent(out) :: info - integer,optional, intent(in) :: dupl, upd - character(len=*), optional, intent(in) :: afmt - end subroutine psb_dspcnv2 - subroutine psb_dspcnv1(a, info, afmt, upd, dupl) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type), intent (inout) :: a - integer, intent(out) :: info - integer,optional, intent(in) :: dupl, upd - character(len=*), optional, intent(in) :: afmt - end subroutine psb_dspcnv1 +!!$ subroutine psb_dspcnv2(ain, a, info, afmt, upd, dupl) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type), intent (in) :: ain +!!$ type(psb_dspmat_type), intent (out) :: a +!!$ integer, intent(out) :: info +!!$ integer,optional, intent(in) :: dupl, upd +!!$ character(len=*), optional, intent(in) :: afmt +!!$ end subroutine psb_dspcnv2 +!!$ subroutine psb_dspcnv1(a, info, afmt, upd, dupl) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type), intent (inout) :: a +!!$ integer, intent(out) :: info +!!$ integer,optional, intent(in) :: dupl, upd +!!$ character(len=*), optional, intent(in) :: afmt +!!$ end subroutine psb_dspcnv1 subroutine psb_cspcnv2(ain, a, info, afmt, upd, dupl) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_cspmat_type), intent (in) :: ain type(psb_cspmat_type), intent (out) :: a @@ -255,7 +255,7 @@ module psb_serial_mod character(len=*), optional, intent(in) :: afmt end subroutine psb_cspcnv2 subroutine psb_cspcnv1(a, info, afmt, upd, dupl) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_cspmat_type), intent (inout) :: a integer, intent(out) :: info @@ -263,7 +263,7 @@ module psb_serial_mod character(len=*), optional, intent(in) :: afmt end subroutine psb_cspcnv1 subroutine psb_zspcnv2(ain, a, info, afmt, upd, dupl) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type), intent (in) :: ain type(psb_zspmat_type), intent (out) :: a @@ -272,7 +272,7 @@ module psb_serial_mod character(len=*), optional, intent(in) :: afmt end subroutine psb_zspcnv2 subroutine psb_zspcnv1(a, info, afmt, upd, dupl) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type), intent (inout) :: a integer, intent(out) :: info @@ -285,28 +285,28 @@ module psb_serial_mod interface psb_fixcoo subroutine psb_sfixcoo(a,info,idir) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_sspmat_type), intent(inout) :: a integer, intent(out) :: info integer, intent(in), optional :: idir end subroutine psb_sfixcoo - subroutine psb_dfixcoo(a,info,idir) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type), intent(inout) :: a - integer, intent(out) :: info - integer, intent(in), optional :: idir - end subroutine psb_dfixcoo +!!$ subroutine psb_dfixcoo(a,info,idir) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type), intent(inout) :: a +!!$ integer, intent(out) :: info +!!$ integer, intent(in), optional :: idir +!!$ end subroutine psb_dfixcoo subroutine psb_cfixcoo(a,info,idir) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_cspmat_type), intent(inout) :: a integer, intent(out) :: info integer, intent(in), optional :: idir end subroutine psb_cfixcoo subroutine psb_zfixcoo(a,info,idir) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type), intent(inout) :: a integer, intent(out) :: info @@ -316,28 +316,28 @@ module psb_serial_mod interface psb_ipcoo2csr subroutine psb_sipcoo2csr(a,info,rwshr) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_sspmat_type), intent(inout) :: a integer, intent(out) :: info logical, optional :: rwshr end subroutine psb_sipcoo2csr - subroutine psb_dipcoo2csr(a,info,rwshr) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type), intent(inout) :: a - integer, intent(out) :: info - logical, optional :: rwshr - end subroutine psb_dipcoo2csr +!!$ subroutine psb_dipcoo2csr(a,info,rwshr) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type), intent(inout) :: a +!!$ integer, intent(out) :: info +!!$ logical, optional :: rwshr +!!$ end subroutine psb_dipcoo2csr subroutine psb_cipcoo2csr(a,info,rwshr) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_cspmat_type), intent(inout) :: a integer, intent(out) :: info logical, optional :: rwshr end subroutine psb_cipcoo2csr subroutine psb_zipcoo2csr(a,info,rwshr) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type), intent(inout) :: a integer, intent(out) :: info @@ -347,28 +347,28 @@ module psb_serial_mod interface psb_ipcoo2csc subroutine psb_sipcoo2csc(a,info,clshr) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_sspmat_type), intent(inout) :: a integer, intent(out) :: info logical, optional :: clshr end subroutine psb_sipcoo2csc - subroutine psb_dipcoo2csc(a,info,clshr) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type), intent(inout) :: a - integer, intent(out) :: info - logical, optional :: clshr - end subroutine psb_dipcoo2csc +!!$ subroutine psb_dipcoo2csc(a,info,clshr) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type), intent(inout) :: a +!!$ integer, intent(out) :: info +!!$ logical, optional :: clshr +!!$ end subroutine psb_dipcoo2csc subroutine psb_cipcoo2csc(a,info,clshr) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_cspmat_type), intent(inout) :: a integer, intent(out) :: info logical, optional :: clshr end subroutine psb_cipcoo2csc subroutine psb_zipcoo2csc(a,info,clshr) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type), intent(inout) :: a integer, intent(out) :: info @@ -378,25 +378,25 @@ module psb_serial_mod interface psb_ipcsr2coo subroutine psb_sipcsr2coo(a,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_sspmat_type), intent(inout) :: a integer, intent(out) :: info end subroutine psb_sipcsr2coo - subroutine psb_dipcsr2coo(a,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type), intent(inout) :: a - integer, intent(out) :: info - end subroutine psb_dipcsr2coo +!!$ subroutine psb_dipcsr2coo(a,info) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type), intent(inout) :: a +!!$ integer, intent(out) :: info +!!$ end subroutine psb_dipcsr2coo subroutine psb_cipcsr2coo(a,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_cspmat_type), intent(inout) :: a integer, intent(out) :: info end subroutine psb_cipcsr2coo subroutine psb_zipcsr2coo(a,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type), intent(inout) :: a integer, intent(out) :: info @@ -405,7 +405,7 @@ module psb_serial_mod interface psb_csprt subroutine psb_scsprt(iout,a,iv,irs,ics,head,ivr,ivc) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ integer, intent(in) :: iout type(psb_sspmat_type), intent(in) :: a @@ -414,18 +414,18 @@ module psb_serial_mod character(len=*), optional :: head integer, intent(in), optional :: ivr(:),ivc(:) end subroutine psb_scsprt - subroutine psb_dcsprt(iout,a,iv,irs,ics,head,ivr,ivc) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - integer, intent(in) :: iout - type(psb_dspmat_type), intent(in) :: a - integer, intent(in), optional :: iv(:) - integer, intent(in), optional :: irs,ics - character(len=*), optional :: head - integer, intent(in), optional :: ivr(:),ivc(:) - end subroutine psb_dcsprt +!!$ subroutine psb_dcsprt(iout,a,iv,irs,ics,head,ivr,ivc) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ integer, intent(in) :: iout +!!$ type(psb_dspmat_type), intent(in) :: a +!!$ integer, intent(in), optional :: iv(:) +!!$ integer, intent(in), optional :: irs,ics +!!$ character(len=*), optional :: head +!!$ integer, intent(in), optional :: ivr(:),ivc(:) +!!$ end subroutine psb_dcsprt subroutine psb_ccsprt(iout,a,iv,irs,ics,head,ivr,ivc) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ integer, intent(in) :: iout type(psb_cspmat_type), intent(in) :: a @@ -435,7 +435,7 @@ module psb_serial_mod integer, intent(in), optional :: ivr(:),ivc(:) end subroutine psb_ccsprt subroutine psb_zcsprt(iout,a,iv,irs,ics,head,ivr,ivc) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ integer, intent(in) :: iout type(psb_zspmat_type), intent(in) :: a @@ -448,7 +448,7 @@ module psb_serial_mod interface psb_neigh subroutine psb_sneigh(a,idx,neigh,n,info,lev) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_sspmat_type), intent(in) :: a integer, intent(in) :: idx @@ -457,18 +457,18 @@ module psb_serial_mod integer, intent(out) :: info integer, optional, intent(in) :: lev end subroutine psb_sneigh - subroutine psb_dneigh(a,idx,neigh,n,info,lev) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type), intent(in) :: a - integer, intent(in) :: idx - integer, intent(out) :: n - integer, allocatable :: neigh(:) - integer, intent(out) :: info - integer, optional, intent(in) :: lev - end subroutine psb_dneigh +!!$ subroutine psb_dneigh(a,idx,neigh,n,info,lev) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type), intent(in) :: a +!!$ integer, intent(in) :: idx +!!$ integer, intent(out) :: n +!!$ integer, allocatable :: neigh(:) +!!$ integer, intent(out) :: info +!!$ integer, optional, intent(in) :: lev +!!$ end subroutine psb_dneigh subroutine psb_cneigh(a,idx,neigh,n,info,lev) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_cspmat_type), intent(in) :: a integer, intent(in) :: idx @@ -478,7 +478,7 @@ module psb_serial_mod integer, optional, intent(in) :: lev end subroutine psb_cneigh subroutine psb_zneigh(a,idx,neigh,n,info,lev) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type), intent(in) :: a integer, intent(in) :: idx @@ -491,7 +491,7 @@ module psb_serial_mod interface psb_coins subroutine psb_scoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ integer, intent(in) :: nz, imin,imax,jmin,jmax integer, intent(in) :: ia(:),ja(:) @@ -501,19 +501,19 @@ module psb_serial_mod integer, intent(in), optional :: gtl(:) logical, optional, intent(in) :: rebuild end subroutine psb_scoins - subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - integer, intent(in) :: nz, imin,imax,jmin,jmax - integer, intent(in) :: ia(:),ja(:) - real(psb_dpk_), intent(in) :: val(:) - type(psb_dspmat_type), intent(inout) :: a - integer, intent(out) :: info - integer, intent(in), optional :: gtl(:) - logical, optional, intent(in) :: rebuild - end subroutine psb_dcoins +!!$ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ integer, intent(in) :: nz, imin,imax,jmin,jmax +!!$ integer, intent(in) :: ia(:),ja(:) +!!$ real(psb_dpk_), intent(in) :: val(:) +!!$ type(psb_dspmat_type), intent(inout) :: a +!!$ integer, intent(out) :: info +!!$ integer, intent(in), optional :: gtl(:) +!!$ logical, optional, intent(in) :: rebuild +!!$ end subroutine psb_dcoins subroutine psb_ccoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ integer, intent(in) :: nz, imin,imax,jmin,jmax integer, intent(in) :: ia(:),ja(:) @@ -524,7 +524,7 @@ module psb_serial_mod logical, optional, intent(in) :: rebuild end subroutine psb_ccoins subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ integer, intent(in) :: nz, imin,imax,jmin,jmax integer, intent(in) :: ia(:),ja(:) @@ -539,25 +539,25 @@ module psb_serial_mod interface psb_symbmm subroutine psb_ssymbmm(a,b,c,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_sspmat_type) :: a,b,c integer :: info end subroutine psb_ssymbmm - subroutine psb_dsymbmm(a,b,c,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type) :: a,b,c - integer :: info - end subroutine psb_dsymbmm +!!$ subroutine psb_dsymbmm(a,b,c,info) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type) :: a,b,c +!!$ integer :: info +!!$ end subroutine psb_dsymbmm subroutine psb_csymbmm(a,b,c,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_cspmat_type) :: a,b,c integer :: info end subroutine psb_csymbmm subroutine psb_zsymbmm(a,b,c,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type) :: a,b,c integer :: info @@ -566,22 +566,22 @@ module psb_serial_mod interface psb_numbmm subroutine psb_snumbmm(a,b,c) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_sspmat_type) :: a,b,c end subroutine psb_snumbmm - subroutine psb_dnumbmm(a,b,c) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type) :: a,b,c - end subroutine psb_dnumbmm +!!$ subroutine psb_dnumbmm(a,b,c) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type) :: a,b,c +!!$ end subroutine psb_dnumbmm subroutine psb_cnumbmm(a,b,c) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_cspmat_type) :: a,b,c end subroutine psb_cnumbmm subroutine psb_znumbmm(a,b,c) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type) :: a,b,c end subroutine psb_znumbmm @@ -589,23 +589,23 @@ module psb_serial_mod interface psb_transp subroutine psb_stransp(a,b,c,fmt) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_sspmat_type), intent(in) :: a type(psb_sspmat_type), intent(out) :: b integer, optional :: c character(len=*), optional :: fmt end subroutine psb_stransp - subroutine psb_dtransp(a,b,c,fmt) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type), intent(in) :: a - type(psb_dspmat_type), intent(out) :: b - integer, optional :: c - character(len=*), optional :: fmt - end subroutine psb_dtransp +!!$ subroutine psb_dtransp(a,b,c,fmt) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type), intent(in) :: a +!!$ type(psb_dspmat_type), intent(out) :: b +!!$ integer, optional :: c +!!$ character(len=*), optional :: fmt +!!$ end subroutine psb_dtransp subroutine psb_ctransp(a,b,c,fmt) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(out) :: b @@ -613,7 +613,7 @@ module psb_serial_mod character(len=*), optional :: fmt end subroutine psb_ctransp subroutine psb_ztransp(a,b,c,fmt) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(out) :: b @@ -621,28 +621,28 @@ module psb_serial_mod character(len=*), optional :: fmt end subroutine psb_ztransp subroutine psb_stransp1(a,c,fmt) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_sspmat_type), intent(inout) :: a integer, optional :: c character(len=*), optional :: fmt end subroutine psb_stransp1 - subroutine psb_dtransp1(a,c,fmt) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type), intent(inout) :: a - integer, optional :: c - character(len=*), optional :: fmt - end subroutine psb_dtransp1 +!!$ subroutine psb_dtransp1(a,c,fmt) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type), intent(inout) :: a +!!$ integer, optional :: c +!!$ character(len=*), optional :: fmt +!!$ end subroutine psb_dtransp1 subroutine psb_ctransp1(a,c,fmt) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_cspmat_type), intent(inout) :: a integer, optional :: c character(len=*), optional :: fmt end subroutine psb_ctransp1 subroutine psb_ztransp1(a,c,fmt) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type), intent(inout) :: a integer, optional :: c @@ -652,7 +652,7 @@ module psb_serial_mod interface psb_transc subroutine psb_ctransc(a,b,c,fmt) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(out) :: b @@ -660,7 +660,7 @@ module psb_serial_mod character(len=*), optional :: fmt end subroutine psb_ctransc subroutine psb_ztransc(a,b,c,fmt) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(out) :: b @@ -671,7 +671,7 @@ module psb_serial_mod interface psb_rwextd subroutine psb_srwextd(nr,a,info,b,rowscale) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ integer, intent(in) :: nr type(psb_sspmat_type), intent(inout) :: a @@ -679,17 +679,17 @@ module psb_serial_mod type(psb_sspmat_type), intent(in), optional :: b logical, intent(in), optional :: rowscale end subroutine psb_srwextd - subroutine psb_drwextd(nr,a,info,b,rowscale) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - integer, intent(in) :: nr - type(psb_dspmat_type), intent(inout) :: a - integer, intent(out) :: info - type(psb_dspmat_type), intent(in), optional :: b - logical, intent(in), optional :: rowscale - end subroutine psb_drwextd +!!$ subroutine psb_drwextd(nr,a,info,b,rowscale) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ integer, intent(in) :: nr +!!$ type(psb_dspmat_type), intent(inout) :: a +!!$ integer, intent(out) :: info +!!$ type(psb_dspmat_type), intent(in), optional :: b +!!$ logical, intent(in), optional :: rowscale +!!$ end subroutine psb_drwextd subroutine psb_crwextd(nr,a,info,b,rowscale) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ integer, intent(in) :: nr type(psb_cspmat_type), intent(inout) :: a @@ -698,7 +698,7 @@ module psb_serial_mod logical, intent(in), optional :: rowscale end subroutine psb_crwextd subroutine psb_zrwextd(nr,a,info,b,rowscale) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ integer, intent(in) :: nr type(psb_zspmat_type), intent(inout) :: a @@ -710,23 +710,23 @@ module psb_serial_mod interface psb_csnmi function psb_scsnmi(a,info,trans) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_sspmat_type), intent(in) :: a integer, intent(out) :: info character, optional :: trans real(psb_spk_) :: psb_scsnmi end function psb_scsnmi - function psb_dcsnmi(a,info,trans) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type), intent(in) :: a - integer, intent(out) :: info - character, optional :: trans - real(psb_dpk_) :: psb_dcsnmi - end function psb_dcsnmi +!!$ function psb_dcsnmi(a,info,trans) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type), intent(in) :: a +!!$ integer, intent(out) :: info +!!$ character, optional :: trans +!!$ real(psb_dpk_) :: psb_dcsnmi +!!$ end function psb_dcsnmi function psb_ccsnmi(a,info,trans) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_cspmat_type), intent(in) :: a integer, intent(out) :: info @@ -734,7 +734,7 @@ module psb_serial_mod real(psb_spk_) :: psb_ccsnmi end function psb_ccsnmi function psb_zcsnmi(a,info,trans) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type), intent(in) :: a integer, intent(out) :: info @@ -745,7 +745,7 @@ module psb_serial_mod interface psb_sp_clip subroutine psb_sspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ implicit none type(psb_sspmat_type), intent(in) :: a @@ -754,18 +754,18 @@ module psb_serial_mod integer, intent(in), optional :: imin,imax,jmin,jmax logical, intent(in), optional :: rscale,cscale end subroutine psb_sspclip - subroutine psb_dspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - implicit none - type(psb_dspmat_type), intent(in) :: a - type(psb_dspmat_type), intent(out) :: b - integer, intent(out) :: info - integer, intent(in), optional :: imin,imax,jmin,jmax - logical, intent(in), optional :: rscale,cscale - end subroutine psb_dspclip +!!$ subroutine psb_dspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ implicit none +!!$ type(psb_dspmat_type), intent(in) :: a +!!$ type(psb_dspmat_type), intent(out) :: b +!!$ integer, intent(out) :: info +!!$ integer, intent(in), optional :: imin,imax,jmin,jmax +!!$ logical, intent(in), optional :: rscale,cscale +!!$ end subroutine psb_dspclip subroutine psb_cspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ implicit none type(psb_cspmat_type), intent(in) :: a @@ -775,7 +775,7 @@ module psb_serial_mod logical, intent(in), optional :: rscale,cscale end subroutine psb_cspclip subroutine psb_zspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ implicit none type(psb_zspmat_type), intent(in) :: a @@ -788,28 +788,28 @@ module psb_serial_mod interface psb_sp_getdiag subroutine psb_sspgtdiag(a,d,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_sspmat_type), intent(in) :: a real(psb_spk_), intent(inout) :: d(:) integer, intent(out) :: info end subroutine psb_sspgtdiag - subroutine psb_dspgtdiag(a,d,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type), intent(in) :: a - real(psb_dpk_), intent(inout) :: d(:) - integer, intent(out) :: info - end subroutine psb_dspgtdiag +!!$ subroutine psb_dspgtdiag(a,d,info) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type), intent(in) :: a +!!$ real(psb_dpk_), intent(inout) :: d(:) +!!$ integer, intent(out) :: info +!!$ end subroutine psb_dspgtdiag subroutine psb_cspgtdiag(a,d,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_cspmat_type), intent(in) :: a complex(psb_spk_), intent(inout) :: d(:) integer, intent(out) :: info end subroutine psb_cspgtdiag subroutine psb_zspgtdiag(a,d,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type), intent(in) :: a complex(psb_dpk_), intent(inout) :: d(:) @@ -819,56 +819,56 @@ module psb_serial_mod interface psb_sp_scal subroutine psb_sspscals(a,d,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_sspmat_type), intent(inout) :: a real(psb_spk_), intent(in) :: d integer, intent(out) :: info end subroutine psb_sspscals subroutine psb_sspscal(a,d,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_sspmat_type), intent(inout) :: a real(psb_spk_), intent(in) :: d(:) integer, intent(out) :: info end subroutine psb_sspscal - subroutine psb_dspscals(a,d,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type), intent(inout) :: a - real(psb_dpk_), intent(in) :: d - integer, intent(out) :: info - end subroutine psb_dspscals - subroutine psb_dspscal(a,d,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type), intent(inout) :: a - real(psb_dpk_), intent(in) :: d(:) - integer, intent(out) :: info - end subroutine psb_dspscal +!!$ subroutine psb_dspscals(a,d,info) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type), intent(inout) :: a +!!$ real(psb_dpk_), intent(in) :: d +!!$ integer, intent(out) :: info +!!$ end subroutine psb_dspscals +!!$ subroutine psb_dspscal(a,d,info) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type), intent(inout) :: a +!!$ real(psb_dpk_), intent(in) :: d(:) +!!$ integer, intent(out) :: info +!!$ end subroutine psb_dspscal subroutine psb_cspscals(a,d,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_cspmat_type), intent(inout) :: a complex(psb_spk_), intent(in) :: d integer, intent(out) :: info end subroutine psb_cspscals subroutine psb_cspscal(a,d,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_cspmat_type), intent(inout) :: a complex(psb_spk_), intent(in) :: d(:) integer, intent(out) :: info end subroutine psb_cspscal subroutine psb_zspscals(a,d,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type), intent(inout) :: a complex(psb_dpk_), intent(in) :: d integer, intent(out) :: info end subroutine psb_zspscals subroutine psb_zspscal(a,d,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type), intent(inout) :: a complex(psb_dpk_), intent(in) :: d(:) @@ -878,27 +878,27 @@ module psb_serial_mod interface psb_sp_setbld - subroutine psb_dspsetbld1(a,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type), intent(inout) :: a - integer, intent(out) :: info - end subroutine psb_dspsetbld1 - subroutine psb_dspsetbld2(a,b,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type), intent(in) :: a - type(psb_dspmat_type), intent(out) :: b - integer, intent(out) :: info - end subroutine psb_dspsetbld2 +!!$ subroutine psb_dspsetbld1(a,info) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type), intent(inout) :: a +!!$ integer, intent(out) :: info +!!$ end subroutine psb_dspsetbld1 +!!$ subroutine psb_dspsetbld2(a,b,info) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type), intent(in) :: a +!!$ type(psb_dspmat_type), intent(out) :: b +!!$ integer, intent(out) :: info +!!$ end subroutine psb_dspsetbld2 subroutine psb_zspsetbld1(a,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type), intent(inout) :: a integer, intent(out) :: info end subroutine psb_zspsetbld1 subroutine psb_zspsetbld2(a,b,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(out) :: b @@ -907,16 +907,16 @@ module psb_serial_mod end interface interface psb_sp_shift - subroutine psb_dspshift(alpha,a,beta,b,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type), intent(in) :: a - type(psb_dspmat_type), intent(out) :: b - real(psb_dpk_), intent(in) :: alpha, beta - integer, intent(out) :: info - end subroutine psb_dspshift +!!$ subroutine psb_dspshift(alpha,a,beta,b,info) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type), intent(in) :: a +!!$ type(psb_dspmat_type), intent(out) :: b +!!$ real(psb_dpk_), intent(in) :: alpha, beta +!!$ integer, intent(out) :: info +!!$ end subroutine psb_dspshift subroutine psb_zspshift(alpha,a,beta,b,info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(out) :: b @@ -927,7 +927,7 @@ module psb_serial_mod interface psb_sp_getblk subroutine psb_sspgtblk(irw,a,b,info,append,iren,lrw,srt) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_sspmat_type), intent(in) :: a integer, intent(in) :: irw @@ -938,20 +938,20 @@ module psb_serial_mod integer, intent(in), optional :: lrw logical, intent(in), optional :: srt end subroutine psb_sspgtblk - subroutine psb_dspgtblk(irw,a,b,info,append,iren,lrw,srt) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type), intent(in) :: a - integer, intent(in) :: irw - type(psb_dspmat_type), intent(inout) :: b - integer, intent(out) :: info - logical, intent(in), optional :: append - integer, intent(in), target, optional :: iren(:) - integer, intent(in), optional :: lrw - logical, intent(in), optional :: srt - end subroutine psb_dspgtblk +!!$ subroutine psb_dspgtblk(irw,a,b,info,append,iren,lrw,srt) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type), intent(in) :: a +!!$ integer, intent(in) :: irw +!!$ type(psb_dspmat_type), intent(inout) :: b +!!$ integer, intent(out) :: info +!!$ logical, intent(in), optional :: append +!!$ integer, intent(in), target, optional :: iren(:) +!!$ integer, intent(in), optional :: lrw +!!$ logical, intent(in), optional :: srt +!!$ end subroutine psb_dspgtblk subroutine psb_cspgtblk(irw,a,b,info,append,iren,lrw,srt) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_cspmat_type), intent(in) :: a integer, intent(in) :: irw @@ -963,7 +963,7 @@ module psb_serial_mod logical, intent(in), optional :: srt end subroutine psb_cspgtblk subroutine psb_zspgtblk(irw,a,b,info,append,iren,lrw,srt) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type), intent(in) :: a integer, intent(in) :: irw @@ -979,7 +979,7 @@ module psb_serial_mod interface psb_sp_getrow subroutine psb_sspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin) ! Output is always in COO format - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ implicit none @@ -993,25 +993,25 @@ module psb_serial_mod integer, intent(in), optional :: iren(:) integer, intent(in), optional :: lrw, nzin end subroutine psb_sspgetrow - subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin) - ! Output is always in COO format - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - implicit none - - type(psb_dspmat_type), intent(in) :: a - integer, intent(in) :: irw - integer, intent(out) :: nz - integer, allocatable, intent(inout) :: ia(:), ja(:) - real(psb_dpk_), allocatable, intent(inout) :: val(:) - integer,intent(out) :: info - logical, intent(in), optional :: append - integer, intent(in), optional :: iren(:) - integer, intent(in), optional :: lrw, nzin - end subroutine psb_dspgetrow +!!$ subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin) +!!$ ! Output is always in COO format +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ implicit none +!!$ +!!$ type(psb_dspmat_type), intent(in) :: a +!!$ integer, intent(in) :: irw +!!$ integer, intent(out) :: nz +!!$ integer, allocatable, intent(inout) :: ia(:), ja(:) +!!$ real(psb_dpk_), allocatable, intent(inout) :: val(:) +!!$ integer,intent(out) :: info +!!$ logical, intent(in), optional :: append +!!$ integer, intent(in), optional :: iren(:) +!!$ integer, intent(in), optional :: lrw, nzin +!!$ end subroutine psb_dspgetrow subroutine psb_cspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin) ! Output is always in COO format - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ implicit none @@ -1027,7 +1027,7 @@ module psb_serial_mod end subroutine psb_cspgetrow subroutine psb_zspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin) ! Output is always in COO format - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ implicit none @@ -1046,15 +1046,15 @@ module psb_serial_mod interface psb_csrp - subroutine psb_dcsrp(trans,iperm,a, info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_dspmat_type), intent(inout) :: a - integer, intent(inout) :: iperm(:), info - character, intent(in) :: trans - end subroutine psb_dcsrp +!!$ subroutine psb_dcsrp(trans,iperm,a, info) +!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ type(psb_dspmat_type), intent(inout) :: a +!!$ integer, intent(inout) :: iperm(:), info +!!$ character, intent(in) :: trans +!!$ end subroutine psb_dcsrp subroutine psb_zcsrp(trans,iperm,a, info) - use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& + use psb_spmat_type, only : psb_sspmat_type, & & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ type(psb_zspmat_type), intent(inout) :: a integer, intent(inout) :: iperm(:), info diff --git a/base/modules/psb_spmat_type.f03 b/base/modules/psb_spmat_type.f03 index ecf99412..2fef7fb4 100644 --- a/base/modules/psb_spmat_type.f03 +++ b/base/modules/psb_spmat_type.f03 @@ -113,16 +113,9 @@ module psb_spmat_type generic, public :: cssm => psb_ccssm, psb_ccssv end type psb_cspmat_type - type, extends(psb_base_spmat_type) :: psb_dspmat_type - real(psb_dpk_), allocatable :: aspk(:) -!!$ contains -!!$ procedure, pass(a) :: psb_dcsmm -!!$ procedure, pass(a) :: psb_dcsmv -!!$ generic, public :: csmm => psb_dcsmm, psb_dcsmv -!!$ procedure, pass(t) :: psb_dcssm -!!$ procedure, pass(t) :: psb_dcssv -!!$ generic, public :: cssm => psb_dcssm, psb_dcssv - end type psb_dspmat_type +!!$ type, extends(psb_base_spmat_type) :: psb_dspmat_type +!!$ real(psb_dpk_), allocatable :: aspk(:) +!!$ end type psb_dspmat_type type, extends(psb_base_spmat_type) :: psb_zspmat_type complex(psb_dpk_), allocatable :: aspk(:) @@ -137,98 +130,96 @@ module psb_spmat_type interface psb_nullify_sp module procedure psb_nullify_ssp, psb_nullify_csp,& - & psb_nullify_dsp, psb_nullify_zsp + & psb_nullify_zsp end interface interface psb_sp_clone module procedure psb_sspclone, psb_cspclone,& - & psb_dspclone, psb_zspclone + & psb_zspclone end interface interface psb_sp_setifld module procedure psb_ssp_setifld, psb_csp_setifld,& - & psb_dsp_setifld, psb_zsp_setifld + & psb_zsp_setifld end interface interface psb_sp_getifld module procedure psb_ssp_getifld, psb_csp_getifld,& - & psb_dsp_getifld, psb_zsp_getifld + & psb_zsp_getifld end interface interface psb_move_alloc module procedure psb_ssp_transfer, psb_csp_transfer,& - & psb_dsp_transfer, psb_zsp_transfer + & psb_zsp_transfer end interface interface psb_sp_trim module procedure psb_ssp_trim, psb_csp_trim,& - & psb_dsp_trim, psb_zsp_trim + & psb_zsp_trim end interface interface psb_sp_trimsize module procedure psb_ssp_trimsize, psb_csp_trimsize,& - & psb_dsp_trimsize, psb_zsp_trimsize + & psb_zsp_trimsize end interface interface psb_sp_reall module procedure psb_sspreallocate, psb_sspreall3, & & psb_cspreall3, psb_cspreallocate,& - & psb_dspreallocate, psb_dspreall3, & & psb_zspreall3, psb_zspreallocate end interface interface psb_sp_all module procedure psb_sspallocate, psb_sspall3, psb_sspallmk, psb_sspallmknz, & & psb_cspallocate, psb_cspall3, psb_cspallmk, psb_cspallmknz, & - & psb_dspallocate, psb_dspall3, psb_dspallmk, psb_dspallmknz, & & psb_zspallocate, psb_zspall3, psb_zspallmk, psb_zspallmknz end interface interface psb_sp_free module procedure psb_ssp_free, psb_csp_free,& - & psb_dsp_free, psb_zsp_free + & psb_zsp_free end interface interface psb_sp_reinit module procedure psb_sspreinit, psb_cspreinit, & - & psb_dspreinit, psb_zspreinit + & psb_zspreinit end interface interface psb_sizeof module procedure psb_sspsizeof, psb_cspsizeof,& - & psb_dspsizeof, psb_zspsizeof + & psb_zspsizeof end interface interface psb_sp_get_nrows module procedure psb_get_ssp_nrows, psb_get_csp_nrows,& - & psb_get_dsp_nrows, psb_get_zsp_nrows + & psb_get_zsp_nrows end interface interface psb_sp_get_ncols module procedure psb_get_ssp_ncols, psb_get_csp_ncols,& - & psb_get_dsp_ncols, psb_get_zsp_ncols + & psb_get_zsp_ncols end interface interface psb_sp_get_nnzeros module procedure psb_get_ssp_nnzeros, psb_get_csp_nnzeros,& - & psb_get_dsp_nnzeros, psb_get_zsp_nnzeros + & psb_get_zsp_nnzeros end interface interface psb_sp_get_nzsize module procedure psb_get_ssp_nzsize, psb_get_csp_nzsize,& - & psb_get_dsp_nzsize, psb_get_zsp_nzsize + & psb_get_zsp_nzsize end interface interface psb_sp_get_nnz_row module procedure psb_get_ssp_nnz_row, psb_get_csp_nnz_row,& - & psb_get_dsp_nnz_row, psb_get_zsp_nnz_row + & psb_get_zsp_nnz_row end interface interface psb_sp_info module procedure psb_sspinfo, psb_cspinfo, & - & psb_dspinfo, psb_zspinfo + & psb_zspinfo end interface @@ -247,20 +238,20 @@ module psb_spmat_type integer :: info character, optional :: trans end subroutine psb_scsmm - subroutine psb_dcsmv(alpha,a,b,beta,c,info,trans) - import :: psb_dspmat_type, psb_dpk_ - class(psb_dspmat_type) :: a - real(psb_dpk_) :: alpha, beta, b(:), c(:) - integer :: info - character, optional :: trans - end subroutine psb_dcsmv - subroutine psb_dcsmm(alpha,a,b,beta,c,info,trans) - import :: psb_dspmat_type, psb_dpk_ - class(psb_dspmat_type) :: a - real(psb_dpk_) :: alpha, beta, b(:,:), c(:,:) - integer :: info - character, optional :: trans - end subroutine psb_dcsmm +!!$ subroutine psb_dcsmv(alpha,a,b,beta,c,info,trans) +!!$ import :: psb_dspmat_type, psb_dpk_ +!!$ class(psb_dspmat_type) :: a +!!$ real(psb_dpk_) :: alpha, beta, b(:), c(:) +!!$ integer :: info +!!$ character, optional :: trans +!!$ end subroutine psb_dcsmv +!!$ subroutine psb_dcsmm(alpha,a,b,beta,c,info,trans) +!!$ import :: psb_dspmat_type, psb_dpk_ +!!$ class(psb_dspmat_type) :: a +!!$ real(psb_dpk_) :: alpha, beta, b(:,:), c(:,:) +!!$ integer :: info +!!$ character, optional :: trans +!!$ end subroutine psb_dcsmm subroutine psb_ccsmv(alpha,a,b,beta,c,info,trans) import :: psb_cspmat_type, psb_spk_ class(psb_cspmat_type) :: a @@ -293,7 +284,7 @@ module psb_spmat_type interface psb_cssm subroutine psb_scssm(alpha,t,b,beta,c,info,trans,unitd,d) - import :: psb_sspmat_type, psb_dspmat_type,& + import :: psb_sspmat_type,& & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ class(psb_sspmat_type) :: t real(psb_spk_) :: alpha, beta, b(:,:), c(:,:) @@ -302,7 +293,7 @@ module psb_spmat_type real(psb_spk_), optional, target :: d(:) end subroutine psb_scssm subroutine psb_scssv(alpha,t,b,beta,c,info,trans,unitd,d) - import :: psb_sspmat_type, psb_dspmat_type,& + import :: psb_sspmat_type,& & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ class(psb_sspmat_type) :: t real(psb_spk_) :: alpha, beta, b(:), c(:) @@ -310,26 +301,26 @@ module psb_spmat_type character, optional :: trans, unitd real(psb_spk_), optional, target :: d(:) end subroutine psb_scssv - subroutine psb_dcssm(alpha,t,b,beta,c,info,trans,unitd,d) - import :: psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - class(psb_dspmat_type) :: t - real(psb_dpk_) :: alpha, beta, b(:,:), c(:,:) - integer :: info - character, optional :: trans, unitd - real(psb_dpk_), optional, target :: d(:) - end subroutine psb_dcssm - subroutine psb_dcssv(alpha,t,b,beta,c,info,trans,unitd,d) - import :: psb_sspmat_type, psb_dspmat_type,& - & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - class(psb_dspmat_type) :: t - real(psb_dpk_) :: alpha, beta, b(:), c(:) - integer :: info - character, optional :: trans, unitd - real(psb_dpk_), optional, target :: d(:) - end subroutine psb_dcssv +!!$ subroutine psb_dcssm(alpha,t,b,beta,c,info,trans,unitd,d) +!!$ import :: psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ class(psb_dspmat_type) :: t +!!$ real(psb_dpk_) :: alpha, beta, b(:,:), c(:,:) +!!$ integer :: info +!!$ character, optional :: trans, unitd +!!$ real(psb_dpk_), optional, target :: d(:) +!!$ end subroutine psb_dcssm +!!$ subroutine psb_dcssv(alpha,t,b,beta,c,info,trans,unitd,d) +!!$ import :: psb_sspmat_type, psb_dspmat_type,& +!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ +!!$ class(psb_dspmat_type) :: t +!!$ real(psb_dpk_) :: alpha, beta, b(:), c(:) +!!$ integer :: info +!!$ character, optional :: trans, unitd +!!$ real(psb_dpk_), optional, target :: d(:) +!!$ end subroutine psb_dcssv subroutine psb_ccssm(alpha,t,b,beta,c,info,trans,unitd,d) - import :: psb_sspmat_type, psb_dspmat_type,& + import :: psb_sspmat_type,& & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ class(psb_cspmat_type) :: t complex(psb_spk_) :: alpha, beta, b(:,:), c(:,:) @@ -338,7 +329,7 @@ module psb_spmat_type complex(psb_spk_), optional, target :: d(:) end subroutine psb_ccssm subroutine psb_ccssv(alpha,t,b,beta,c,info,trans,unitd,d) - import :: psb_sspmat_type, psb_dspmat_type,& + import :: psb_sspmat_type,& & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ class(psb_cspmat_type) :: t complex(psb_spk_) :: alpha, beta, b(:), c(:) @@ -347,7 +338,7 @@ module psb_spmat_type complex(psb_spk_), optional, target :: d(:) end subroutine psb_ccssv subroutine psb_zcssm(alpha,t,b,beta,c,info,trans,unitd,d) - import :: psb_sspmat_type, psb_dspmat_type,& + import :: psb_sspmat_type,& & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ class(psb_zspmat_type) :: t complex(psb_dpk_) :: alpha, beta, b(:,:), c(:,:) @@ -356,7 +347,7 @@ module psb_spmat_type complex(psb_dpk_), optional, target :: d(:) end subroutine psb_zcssm subroutine psb_zcssv(alpha,t,b,beta,c,info,trans,unitd,d) - import :: psb_sspmat_type, psb_dspmat_type,& + import :: psb_sspmat_type,& & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ class(psb_zspmat_type) :: t complex(psb_dpk_) :: alpha, beta, b(:), c(:) @@ -399,19 +390,20 @@ contains end function psb_get_csp_ncols - integer function psb_get_dsp_nrows(a) - type(psb_dspmat_type), intent(in) :: a - psb_get_dsp_nrows = a%m - - return - end function psb_get_dsp_nrows - - integer function psb_get_dsp_ncols(a) - type(psb_dspmat_type), intent(in) :: a - psb_get_dsp_ncols = a%k +!!$ integer function psb_get_dsp_nrows(a) +!!$ type(psb_dspmat_type), intent(in) :: a +!!$ psb_get_dsp_nrows = a%m +!!$ +!!$ return +!!$ end function psb_get_dsp_nrows +!!$ +!!$ integer function psb_get_dsp_ncols(a) +!!$ type(psb_dspmat_type), intent(in) :: a +!!$ psb_get_dsp_ncols = a%k +!!$ +!!$ return +!!$ end function psb_get_dsp_ncols - return - end function psb_get_dsp_ncols integer function psb_get_zsp_nrows(a) type(psb_zspmat_type), intent(in) :: a psb_get_zsp_nrows = a%m @@ -451,17 +443,17 @@ contains end if end function psb_get_csp_nnzeros - integer function psb_get_dsp_nnzeros(a) - type(psb_dspmat_type), intent(in) :: a - integer :: ires,info - - call psb_sp_info(psb_nztotreq_,a,ires,info) - if (info == 0) then - psb_get_dsp_nnzeros = ires - else - psb_get_dsp_nnzeros = 0 - end if - end function psb_get_dsp_nnzeros +!!$ integer function psb_get_dsp_nnzeros(a) +!!$ type(psb_dspmat_type), intent(in) :: a +!!$ integer :: ires,info +!!$ +!!$ call psb_sp_info(psb_nztotreq_,a,ires,info) +!!$ if (info == 0) then +!!$ psb_get_dsp_nnzeros = ires +!!$ else +!!$ psb_get_dsp_nnzeros = 0 +!!$ end if +!!$ end function psb_get_dsp_nnzeros integer function psb_get_zsp_nnzeros(a) type(psb_zspmat_type), intent(in) :: a @@ -499,17 +491,17 @@ contains end if end function psb_get_csp_nzsize - integer function psb_get_dsp_nzsize(a) - type(psb_dspmat_type), intent(in) :: a - integer :: ires,info - - call psb_sp_info(psb_nzsizereq_,a,ires,info) - if (info == 0) then - psb_get_dsp_nzsize = ires - else - psb_get_dsp_nzsize = 0 - end if - end function psb_get_dsp_nzsize +!!$ integer function psb_get_dsp_nzsize(a) +!!$ type(psb_dspmat_type), intent(in) :: a +!!$ integer :: ires,info +!!$ +!!$ call psb_sp_info(psb_nzsizereq_,a,ires,info) +!!$ if (info == 0) then +!!$ psb_get_dsp_nzsize = ires +!!$ else +!!$ psb_get_dsp_nzsize = 0 +!!$ end if +!!$ end function psb_get_dsp_nzsize integer function psb_get_zsp_nzsize(a) type(psb_zspmat_type), intent(in) :: a @@ -549,564 +541,36 @@ contains end if end function psb_get_csp_nnz_row - integer function psb_get_dsp_nnz_row(ir,a) - integer, intent(in) :: ir - type(psb_dspmat_type), intent(in) :: a - integer :: ires,info - - call psb_sp_info(psb_nzrowreq_,a,ires,info,iaux=ir) - if (info == 0) then - psb_get_dsp_nnz_row = ires - else - psb_get_dsp_nnz_row = 0 - end if - end function psb_get_dsp_nnz_row +!!$ integer function psb_get_dsp_nnz_row(ir,a) +!!$ integer, intent(in) :: ir +!!$ type(psb_dspmat_type), intent(in) :: a +!!$ integer :: ires,info +!!$ +!!$ call psb_sp_info(psb_nzrowreq_,a,ires,info,iaux=ir) +!!$ if (info == 0) then +!!$ psb_get_dsp_nnz_row = ires +!!$ else +!!$ psb_get_dsp_nnz_row = 0 +!!$ end if +!!$ end function psb_get_dsp_nnz_row integer function psb_get_zsp_nnz_row(ir,a) integer, intent(in) :: ir type(psb_zspmat_type), intent(in) :: a integer :: ires,info - call psb_sp_info(psb_nzrowreq_,a,ires,info,iaux=ir) - if (info == 0) then - psb_get_zsp_nnz_row = ires - else - psb_get_zsp_nnz_row = 0 - end if - end function psb_get_zsp_nnz_row - - - subroutine psb_nullify_ssp(mat) - implicit none - type(psb_sspmat_type), intent(inout) :: mat - -!!$ nullify(mat%aspk,mat%ia1,mat%ia2,mat%pl,mat%pr) - - mat%infoa(:)=0 - mat%m=0 - mat%k=0 - mat%fida='' - mat%descra='' - - end subroutine psb_nullify_ssp - - Subroutine psb_sspreinit(a,info,clear) - use psb_string_mod - Implicit None - - !....Parameters... - Type(psb_sspmat_type), intent(inout) :: a - integer, intent(out) :: info - logical, intent(in), optional :: clear - - !locals - logical, parameter :: debug=.false. - logical :: clear_ - character(len=20) :: name - - info = 0 - name = 'psb_sp_reinit' - - if (present(clear)) then - clear_ = clear - else - clear_ = .true. - end if - - select case(psb_sp_getifld(psb_state_,a,info)) - case(psb_spmat_asb_) - - if (clear_) a%aspk(:) = dzero - - if (psb_sp_getifld(psb_upd_,a,info)==psb_upd_perm_) then - if(psb_toupper(a%fida(1:3)) == 'JAD') then - a%ia1(a%infoa(psb_upd_pnt_)+psb_nnz_) = 0 - else - a%ia2(a%infoa(psb_upd_pnt_)+psb_nnz_) = 0 - endif - endif - a%infoa(psb_state_) = psb_spmat_upd_ - case(psb_spmat_bld_) - ! in this case do nothing. this allows sprn to be called - ! right after allocate, with spins doing the right thing. - ! hopefully :-) - - case( psb_spmat_upd_) - - case default - info=591 - call psb_errpush(info,name) - end select - - end Subroutine psb_sspreinit - - Subroutine psb_sspallocate(a, nnz,info) - implicit none - !....Parameters... - Type(psb_sspmat_type), intent(inout) :: A - Integer, intent(in) :: nnz - integer, intent(out) :: info - - !locals - logical, parameter :: debug=.false. - - info = 0 - if (nnz < 0) then - info=45 - return - Endif - if (debug) write(0,*) 'SPALL : NNZ ',nnz,a%m,a%k - call psb_nullify_sp(a) - call psb_sp_reall(a,nnz,info) - if (info /= 0) return - a%pl(:)=0 - a%pr(:)=0 - ! set INFOA fields - a%fida = 'COO' - a%descra = 'GUN' - a%infoa(:) = 0 - a%infoa(psb_state_) = psb_spmat_bld_ - a%m = 0 - a%k = 0 - if (debug) write(0,*) 'SPALL : end' - Return - - End Subroutine psb_sspallocate - - Subroutine psb_sspallmk(m,k,a,info) - implicit none - !....Parameters... - - Type(psb_sspmat_type), intent(inout) :: A - Integer, intent(in) :: m,k - Integer, intent(out) :: info - - !locals - logical, parameter :: debug=.false. - integer :: nnz - - INFO = 0 - call psb_nullify_sp(a) - nnz = 2*max(1,m,k) - a%m=max(0,m) - a%k=max(0,k) - if (debug) write(0,*) 'SPALL : NNZ ',nnz,a%m,a%k - call psb_sp_reall(a,nnz,info) - if (debug) write(0,*) 'Check in ALLOCATE ',info,allocated(a%pl),allocated(a%pr) - if (info /= 0) return - a%pl(:)=0 - a%pr(:)=0 - ! set INFOA fields - a%fida = 'COO' - a%descra = 'GUN' - a%infoa(:) = 0 - a%infoa(psb_state_) = psb_spmat_bld_ - if (debug) write(0,*) 'SPALL : end' - Return - - end subroutine psb_sspallmk - - Subroutine psb_sspallmknz(m,k,a, nnz,info) - implicit none - !....parameters... - - type(psb_sspmat_type), intent(inout) :: a - integer, intent(in) :: m,k,nnz - integer, intent(out) :: info - - !locals - logical, parameter :: debug=.false. - - info = 0 - if (nnz < 0) then - info=45 - return - endif - call psb_nullify_sp(a) - if (debug) write(0,*) 'spallmknz : nnz ',nnz,a%m,a%k,psb_get_errstatus() - a%m=max(0,m) - a%k=max(0,k) - call psb_sp_reall(a,nnz,info) - if (debug) write(0,*) 'Check in ALLOCATE ',info,allocated(a%pl),allocated(a%pr) - if (info /= 0) return - a%pl(:)=0 - a%pr(:)=0 - ! set infoa fields - a%fida = 'COO' - a%descra = 'GUN' - a%infoa(:) = 0 - a%infoa(psb_state_) = psb_spmat_bld_ - if (debug) write(0,*) 'spall : end' - return - - end subroutine psb_sspallmknz - - - subroutine psb_sspall3(a, ni1,ni2,nd,info) - implicit none - !....Parameters... - Type(psb_sspmat_type), intent(inout) :: A - Integer, intent(in) :: ni1,ni2,nd - Integer, intent(out) :: info - - !locals - logical, parameter :: debug=.false. - - info = 0 - call psb_nullify_sp(a) - call psb_sp_reall(a, ni1,ni2,nd,info) - if (info /= 0) return - a%pl(:)=0 - a%pr(:)=0 - ! set INFOA fields - a%fida = 'COO' - a%descra = 'GUN' - a%infoa(:) = 0 - a%infoa(psb_state_) = psb_spmat_bld_ - a%m = 0 - a%k = 0 - if (debug) write(0,*) 'SPALL : end' - Return - - End Subroutine psb_sspall3 - - - subroutine psb_sspreallocate(a, nnz,info,ifc) - implicit none - !....Parameters... - Type(psb_sspmat_type), intent(inout) :: A - Integer, intent(in) :: NNZ - Integer, intent(out) :: info - ! - ! ifc is used here to allocate space in IA1 for smart - ! regeneration. This probably ought to be changed, - ! by adding a new component to d_spmat, or by making - ! infoa a pointer. - ! - Integer, intent(in), optional :: ifc - integer :: ifc_ - - !locals - logical, parameter :: debug=.false. - - info = 0 - if (nnz < 0) then - info=45 - return - endif - if (present(ifc)) then - ifc_ = max(1,ifc) - else - ifc_ = 1 - endif - - if (ifc_ == 1) then - if (debug) write(0,*) 'sspreallocate: calling realloc',max(nnz,a%m+1,a%k+1) - call psb_realloc(max(nnz,a%m+1,a%k+1),a%ia1,a%ia2,a%aspk,info) - if (debug) write(0,*) 'sspreallocate: done realloc',info, psb_get_errstatus() - else - call psb_realloc(max(nnz,a%m+1,a%k+1),a%aspk,info) - if (info /= 0) return - call psb_realloc(max(nnz,a%m+1,a%k+1),a%ia2,info) - if (info /= 0) return - call psb_realloc(max(ifc*nnz+200,a%m+1,a%k+1),a%ia1,info) - if (info /= 0) return - end if - if (info /= 0) return - call psb_realloc(max(1,a%m),a%pl,info) - if (info /= 0) return - call psb_realloc(max(1,a%k),a%pr,info) - if (debug) write(0,*) 'sspreallocate:',allocated(a%ia1),allocated(a%ia2),& - & allocated(a%aspk),allocated(a%pl),allocated(a%pr),info - if (info /= 0) return - - Return - - End Subroutine psb_sspreallocate - - subroutine psb_sspreall3(a, ni1,ni2,nd,info) - implicit none - !....Parameters... - Type(psb_sspmat_type), intent(inout) :: A - Integer, intent(in) :: ni1,ni2,nd - Integer, intent(inout) :: info - - !locals - logical, parameter :: debug=.false. - - info = 0 - if (debug) write(0,*) 'Before realloc',nd,size(a%aspk),ni1,ni2 - call psb_realloc(nd,a%aspk,info) - if (debug) write(0,*) 'After realloc',nd,size(a%aspk),info - if (info /= 0) return - if (debug) write(0,*) 'Before realloc2',ni2,allocated(a%ia2),size(a%ia2) - call psb_realloc(ni2,a%ia2,info) - if (info /= 0) return - if (debug) write(0,*) 'Before realloc3',ni1,allocated(a%ia1),size(a%ia1) - call psb_realloc(ni1,a%ia1,info) - if (info /= 0) return - if (debug) write(0,*) 'Before realloc4',max(1,a%m),allocated(a%pl),size(a%pl) - call psb_realloc(max(1,a%m),a%pl,info) - if (info /= 0) return - if (debug) write(0,*) 'Before realloc5',max(1,a%k),allocated(a%pr),size(a%pr) - call psb_realloc(max(1,a%k),a%pr,info) - if (info /= 0) return - - Return - - End Subroutine psb_sspreall3 - - - subroutine psb_sspclone(a, b,info) - implicit none - !....Parameters... - Type(psb_sspmat_type), intent(in) :: A - Type(psb_sspmat_type), intent(out) :: B - Integer, intent(out) :: info - - !locals - - INFO = 0 - call psb_nullify_sp(b) - call psb_safe_ab_cpy(a%aspk,b%aspk,info) - if (info == 0) call psb_safe_ab_cpy(a%ia1,b%ia1,info) - if (info == 0) call psb_safe_ab_cpy(a%ia2,b%ia2,info) - if (info == 0) call psb_safe_ab_cpy(a%pl,b%pl,info) - if (info == 0) call psb_safe_ab_cpy(a%pr,b%pr,info) - if (info /= 0) then - info=2023 - return - Endif - b%infoa(:) = a%infoa(:) - b%fida = a%fida - b%descra = a%descra - b%m = a%m - b%k = a%k - - Return - - End Subroutine psb_sspclone - - - - ! Will be changed to use MOVE_ALLOC - subroutine psb_ssp_transfer(a, b,info) - implicit none - !....Parameters... - Type(psb_sspmat_type), intent(inout) :: A - Type(psb_sspmat_type), intent(inout) :: B - Integer, intent(out) :: info - - info = 0 - - - call psb_move_alloc( a%aspk, b%aspk , info) - call psb_move_alloc( a%ia1 , b%ia1 , info) - call psb_move_alloc( a%ia2 , b%ia2 , info) - call psb_move_alloc( a%pl , b%pl , info) - call psb_move_alloc( a%pr , b%pr , info) - b%infoa(:) = a%infoa(:) - b%fida = a%fida - b%descra = a%descra - b%m = a%m - b%k = a%k - - call psb_nullify_sp(a) - - Return - - End Subroutine psb_ssp_transfer - - - Subroutine psb_ssp_setifld(val,field,a,info) - implicit none - !....Parameters... - - Type(psb_sspmat_type), intent(inout) :: A - Integer, intent(in) :: field,val - Integer, intent(out) :: info - - info = 0 - - - if (info == 0) & - & call psb_setifield(val,field,a%infoa,psb_ifasize_,info) - - - Return - - end subroutine psb_ssp_setifld - - - ! - ! Reduce the size of A to the barest minimum necessary. - ! - ! - - - subroutine psb_ssp_trim(a,info) - use psb_string_mod - implicit none - !....Parameters... - Type(psb_sspmat_type), intent(inout) :: A - Integer, intent(out) :: info - - !locals - Integer :: i1, i2, ia - - info = 0 - call psb_sp_trimsize(a,i1,i2,ia,info) - i1 = max(i1,1); i2 = max(i2,1); ia = max(ia,1) - if (info == 0) call psb_sp_reall(a,i1,i2,ia,info) - - Return - - End Subroutine psb_ssp_trim - - - subroutine psb_ssp_trimsize(a, i1,i2,ia,info) - use psb_string_mod - implicit none - !....Parameters... - Type(psb_sspmat_type), intent(in) :: A - Integer, intent(out) :: i1, i2, ia, info - - !locals - Integer :: nza - - info = 0 - if (psb_sp_getifld(psb_upd_,a,info) == psb_upd_perm_) then - info = -1 - i1 = size(a%ia1) - i2 = size(a%ia2) - ia = size(a%aspk) - return - endif - select case(psb_tolower(a%fida)) - case('csr') - nza = a%ia2(a%m+1)-1 - ia = nza - i1 = nza - i2 = a%m + 1 - case('csc') - nza = a%ia2(a%k+1)-1 - ia = nza - i1 = nza - i2 = a%k + 1 - case('coo','coi') - nza = a%infoa(psb_nnz_) - i1 = nza - i2 = nza - ia = nza - case('jad') - ! Feeling lazy today - i1 = size(a%ia1) - i2 = size(a%ia2) - ia = size(a%aspk) - case default - i1 = size(a%ia1) - i2 = size(a%ia2) - ia = size(a%aspk) - end select - - Return - - End Subroutine psb_ssp_trimsize - - function psb_ssp_getifld(field,a,info) - implicit none - !....Parameters... - - Type(psb_sspmat_type), intent(in) :: A - Integer, intent(in) :: field - Integer :: psb_ssp_getifld - Integer, intent(out) :: info - - !locals - integer :: val - - info = 0 - val = -1 - - if ((field < 1).or.(field > psb_ifasize_)) then - info = -1 - psb_ssp_getifld = val - return - endif - - call psb_getifield(val,field,a%infoa,psb_ifasize_,info) - - psb_ssp_getifld = val - Return - - end function psb_ssp_getifld - - function psb_sspsizeof(a) result(val) - implicit none - !....Parameters... - - Type(psb_sspmat_type), intent(in) :: A - integer(psb_long_int_k_) :: val - - val = psb_sizeof_int*size(a%infoa) - if (allocated(a%aspk)) then - val = val + psb_sizeof_sp * size(a%aspk) - endif - if (allocated(a%ia1)) then - val = val + psb_sizeof_int * size(a%ia1) - endif - if (allocated(a%ia2)) then - val = val + psb_sizeof_int * size(a%ia2) - endif - if (allocated(a%pl)) then - val = val + psb_sizeof_int * size(a%pl) - endif - if (allocated(a%pr)) then - val = val + psb_sizeof_int * size(a%pr) - endif - - end function psb_sspsizeof - - - subroutine psb_ssp_free(a,info) - implicit none - !....Parameters... - Type(psb_sspmat_type), intent(inout) :: A - Integer, intent(out) :: info - !locals - integer :: iret - info = 0 + call psb_sp_info(psb_nzrowreq_,a,ires,info,iaux=ir) + if (info == 0) then + psb_get_zsp_nnz_row = ires + else + psb_get_zsp_nnz_row = 0 + end if + end function psb_get_zsp_nnz_row - if (allocated(a%aspk)) then -!!$ write(0,*) 'Deallocating aspk' - deallocate(a%aspk,STAT=IRET) -!!$ write(0,*) 'Deallocated aspk',iret - if (iret /= 0) info = max(info,1) - endif - if (allocated(a%ia1)) then - deallocate(a%ia1,STAT=IRET) - if (iret /= 0) info = max(info,2) - endif - if (allocated(a%ia2)) then - deallocate(a%ia2,STAT=IRET) - if (iret /= 0) info = max(info,3) - endif - if (allocated(a%pr)) then - deallocate(a%pr,STAT=IRET) - if (iret /= 0) info = max(info,4) - endif - if (allocated(a%pl)) then - deallocate(a%pl,STAT=IRET) - if (iret /= 0) info = max(info,5) - endif - call psb_nullify_sp(a) -!!$ write(0,*) 'End of sp_free ',info - Return - End Subroutine psb_ssp_free - subroutine psb_nullify_dsp(mat) + subroutine psb_nullify_ssp(mat) implicit none - type(psb_dspmat_type), intent(inout) :: mat + type(psb_sspmat_type), intent(inout) :: mat !!$ nullify(mat%aspk,mat%ia1,mat%ia2,mat%pl,mat%pr) @@ -1116,15 +580,14 @@ contains mat%fida='' mat%descra='' - end subroutine psb_nullify_dsp + end subroutine psb_nullify_ssp - Subroutine psb_dspreinit(a,info,clear) - use psb_string_mod + Subroutine psb_sspreinit(a,info,clear) use psb_string_mod Implicit None !....Parameters... - Type(psb_dspmat_type), intent(inout) :: a + Type(psb_sspmat_type), intent(inout) :: a integer, intent(out) :: info logical, intent(in), optional :: clear @@ -1167,12 +630,12 @@ contains call psb_errpush(info,name) end select - end Subroutine psb_dspreinit + end Subroutine psb_sspreinit - Subroutine psb_dspallocate(a, nnz,info) + Subroutine psb_sspallocate(a, nnz,info) implicit none !....Parameters... - Type(psb_dspmat_type), intent(inout) :: A + Type(psb_sspmat_type), intent(inout) :: A Integer, intent(in) :: nnz integer, intent(out) :: info @@ -1200,13 +663,13 @@ contains if (debug) write(0,*) 'SPALL : end' Return - End Subroutine psb_dspallocate + End Subroutine psb_sspallocate - Subroutine psb_dspallmk(m,k,a,info) + Subroutine psb_sspallmk(m,k,a,info) implicit none !....Parameters... - Type(psb_dspmat_type), intent(inout) :: A + Type(psb_sspmat_type), intent(inout) :: A Integer, intent(in) :: m,k Integer, intent(out) :: info @@ -1233,13 +696,13 @@ contains if (debug) write(0,*) 'SPALL : end' Return - end subroutine psb_dspallmk + end subroutine psb_sspallmk - Subroutine psb_dspallmknz(m,k,a, nnz,info) + Subroutine psb_sspallmknz(m,k,a, nnz,info) implicit none !....parameters... - type(psb_dspmat_type), intent(inout) :: a + type(psb_sspmat_type), intent(inout) :: a integer, intent(in) :: m,k,nnz integer, intent(out) :: info @@ -1252,7 +715,7 @@ contains return endif call psb_nullify_sp(a) - if (debug) write(0,*) 'spall : nnz ',nnz,a%m,a%k + if (debug) write(0,*) 'spallmknz : nnz ',nnz,a%m,a%k,psb_get_errstatus() a%m=max(0,m) a%k=max(0,k) call psb_sp_reall(a,nnz,info) @@ -1268,13 +731,13 @@ contains if (debug) write(0,*) 'spall : end' return - end subroutine psb_dspallmknz + end subroutine psb_sspallmknz - subroutine psb_dspall3(a, ni1,ni2,nd,info) + subroutine psb_sspall3(a, ni1,ni2,nd,info) implicit none !....Parameters... - Type(psb_dspmat_type), intent(inout) :: A + Type(psb_sspmat_type), intent(inout) :: A Integer, intent(in) :: ni1,ni2,nd Integer, intent(out) :: info @@ -1297,13 +760,13 @@ contains if (debug) write(0,*) 'SPALL : end' Return - End Subroutine psb_dspall3 + End Subroutine psb_sspall3 - subroutine psb_dspreallocate(a, nnz,info,ifc) + subroutine psb_sspreallocate(a, nnz,info,ifc) implicit none !....Parameters... - Type(psb_dspmat_type), intent(inout) :: A + Type(psb_sspmat_type), intent(inout) :: A Integer, intent(in) :: NNZ Integer, intent(out) :: info ! @@ -1330,7 +793,9 @@ contains endif if (ifc_ == 1) then + if (debug) write(0,*) 'sspreallocate: calling realloc',max(nnz,a%m+1,a%k+1) call psb_realloc(max(nnz,a%m+1,a%k+1),a%ia1,a%ia2,a%aspk,info) + if (debug) write(0,*) 'sspreallocate: done realloc',info, psb_get_errstatus() else call psb_realloc(max(nnz,a%m+1,a%k+1),a%aspk,info) if (info /= 0) return @@ -1343,18 +808,18 @@ contains call psb_realloc(max(1,a%m),a%pl,info) if (info /= 0) return call psb_realloc(max(1,a%k),a%pr,info) - if (debug) write(0,*) allocated(a%ia1),allocated(a%ia2),& + if (debug) write(0,*) 'sspreallocate:',allocated(a%ia1),allocated(a%ia2),& & allocated(a%aspk),allocated(a%pl),allocated(a%pr),info if (info /= 0) return Return - End Subroutine psb_dspreallocate + End Subroutine psb_sspreallocate - subroutine psb_dspreall3(a, ni1,ni2,nd,info) + subroutine psb_sspreall3(a, ni1,ni2,nd,info) implicit none !....Parameters... - Type(psb_dspmat_type), intent(inout) :: A + Type(psb_sspmat_type), intent(inout) :: A Integer, intent(in) :: ni1,ni2,nd Integer, intent(inout) :: info @@ -1381,14 +846,14 @@ contains Return - End Subroutine psb_dspreall3 + End Subroutine psb_sspreall3 - subroutine psb_dspclone(a, b,info) + subroutine psb_sspclone(a, b,info) implicit none !....Parameters... - Type(psb_dspmat_type), intent(in) :: A - Type(psb_dspmat_type), intent(out) :: B + Type(psb_sspmat_type), intent(in) :: A + Type(psb_sspmat_type), intent(out) :: B Integer, intent(out) :: info !locals @@ -1412,16 +877,16 @@ contains Return - End Subroutine psb_dspclone + End Subroutine psb_sspclone ! Will be changed to use MOVE_ALLOC - subroutine psb_dsp_transfer(a, b,info) + subroutine psb_ssp_transfer(a, b,info) implicit none !....Parameters... - Type(psb_dspmat_type), intent(inout) :: A - Type(psb_dspmat_type), intent(inout) :: B + Type(psb_sspmat_type), intent(inout) :: A + Type(psb_sspmat_type), intent(inout) :: B Integer, intent(out) :: info info = 0 @@ -1442,14 +907,14 @@ contains Return - End Subroutine psb_dsp_transfer + End Subroutine psb_ssp_transfer - Subroutine psb_dsp_setifld(val,field,a,info) + Subroutine psb_ssp_setifld(val,field,a,info) implicit none !....Parameters... - Type(psb_dspmat_type), intent(inout) :: A + Type(psb_sspmat_type), intent(inout) :: A Integer, intent(in) :: field,val Integer, intent(out) :: info @@ -1462,7 +927,7 @@ contains Return - end subroutine psb_dsp_setifld + end subroutine psb_ssp_setifld ! @@ -1471,11 +936,11 @@ contains ! - subroutine psb_dsp_trim(a,info) + subroutine psb_ssp_trim(a,info) use psb_string_mod implicit none !....Parameters... - Type(psb_dspmat_type), intent(inout) :: A + Type(psb_sspmat_type), intent(inout) :: A Integer, intent(out) :: info !locals @@ -1488,14 +953,14 @@ contains Return - End Subroutine psb_dsp_trim + End Subroutine psb_ssp_trim - subroutine psb_dsp_trimsize(a, i1,i2,ia,info) + subroutine psb_ssp_trimsize(a, i1,i2,ia,info) use psb_string_mod implicit none !....Parameters... - Type(psb_dspmat_type), intent(in) :: A + Type(psb_sspmat_type), intent(in) :: A Integer, intent(out) :: i1, i2, ia, info !locals @@ -1538,15 +1003,15 @@ contains Return - End Subroutine psb_dsp_trimsize + End Subroutine psb_ssp_trimsize - function psb_dsp_getifld(field,a,info) + function psb_ssp_getifld(field,a,info) implicit none !....Parameters... - Type(psb_dspmat_type), intent(in) :: A + Type(psb_sspmat_type), intent(in) :: A Integer, intent(in) :: field - Integer :: psb_dsp_getifld + Integer :: psb_ssp_getifld Integer, intent(out) :: info !locals @@ -1557,27 +1022,27 @@ contains if ((field < 1).or.(field > psb_ifasize_)) then info = -1 - psb_dsp_getifld = val + psb_ssp_getifld = val return endif call psb_getifield(val,field,a%infoa,psb_ifasize_,info) - psb_dsp_getifld = val + psb_ssp_getifld = val Return - end function psb_dsp_getifld + end function psb_ssp_getifld - function psb_dspsizeof(a) result(val) + function psb_sspsizeof(a) result(val) implicit none !....Parameters... - Type(psb_dspmat_type), intent(in) :: A + Type(psb_sspmat_type), intent(in) :: A integer(psb_long_int_k_) :: val val = psb_sizeof_int*size(a%infoa) if (allocated(a%aspk)) then - val = val + psb_sizeof_dp * size(a%aspk) + val = val + psb_sizeof_sp * size(a%aspk) endif if (allocated(a%ia1)) then val = val + psb_sizeof_int * size(a%ia1) @@ -1592,13 +1057,13 @@ contains val = val + psb_sizeof_int * size(a%pr) endif - end function psb_dspsizeof + end function psb_sspsizeof - subroutine psb_dsp_free(a,info) + subroutine psb_ssp_free(a,info) implicit none !....Parameters... - Type(psb_dspmat_type), intent(inout) :: A + Type(psb_sspmat_type), intent(inout) :: A Integer, intent(out) :: info !locals integer :: iret @@ -1629,8 +1094,534 @@ contains call psb_nullify_sp(a) !!$ write(0,*) 'End of sp_free ',info Return - End Subroutine psb_dsp_free + End Subroutine psb_ssp_free +!!$ subroutine psb_nullify_dsp(mat) +!!$ implicit none +!!$ type(psb_dspmat_type), intent(inout) :: mat +!!$ +!!$ +!!$ mat%infoa(:)=0 +!!$ mat%m=0 +!!$ mat%k=0 +!!$ mat%fida='' +!!$ mat%descra='' +!!$ +!!$ end subroutine psb_nullify_dsp +!!$ +!!$ Subroutine psb_dspreinit(a,info,clear) +!!$ use psb_string_mod +!!$ use psb_string_mod +!!$ Implicit None +!!$ +!!$ !....Parameters... +!!$ Type(psb_dspmat_type), intent(inout) :: a +!!$ integer, intent(out) :: info +!!$ logical, intent(in), optional :: clear +!!$ +!!$ !locals +!!$ logical, parameter :: debug=.false. +!!$ logical :: clear_ +!!$ character(len=20) :: name +!!$ +!!$ info = 0 +!!$ name = 'psb_sp_reinit' +!!$ +!!$ if (present(clear)) then +!!$ clear_ = clear +!!$ else +!!$ clear_ = .true. +!!$ end if +!!$ +!!$ select case(psb_sp_getifld(psb_state_,a,info)) +!!$ case(psb_spmat_asb_) +!!$ +!!$ if (clear_) a%aspk(:) = dzero +!!$ +!!$ if (psb_sp_getifld(psb_upd_,a,info)==psb_upd_perm_) then +!!$ if(psb_toupper(a%fida(1:3)) == 'JAD') then +!!$ a%ia1(a%infoa(psb_upd_pnt_)+psb_nnz_) = 0 +!!$ else +!!$ a%ia2(a%infoa(psb_upd_pnt_)+psb_nnz_) = 0 +!!$ endif +!!$ endif +!!$ a%infoa(psb_state_) = psb_spmat_upd_ +!!$ case(psb_spmat_bld_) +!!$ ! in this case do nothing. this allows sprn to be called +!!$ ! right after allocate, with spins doing the right thing. +!!$ ! hopefully :-) +!!$ +!!$ case( psb_spmat_upd_) +!!$ +!!$ case default +!!$ info=591 +!!$ call psb_errpush(info,name) +!!$ end select +!!$ +!!$ end Subroutine psb_dspreinit +!!$ +!!$ Subroutine psb_dspallocate(a, nnz,info) +!!$ implicit none +!!$ !....Parameters... +!!$ Type(psb_dspmat_type), intent(inout) :: A +!!$ Integer, intent(in) :: nnz +!!$ integer, intent(out) :: info +!!$ +!!$ !locals +!!$ logical, parameter :: debug=.false. +!!$ +!!$ info = 0 +!!$ if (nnz < 0) then +!!$ info=45 +!!$ return +!!$ Endif +!!$ if (debug) write(0,*) 'SPALL : NNZ ',nnz,a%m,a%k +!!$ call psb_nullify_sp(a) +!!$ call psb_sp_reall(a,nnz,info) +!!$ if (info /= 0) return +!!$ a%pl(:)=0 +!!$ a%pr(:)=0 +!!$ ! set INFOA fields +!!$ a%fida = 'COO' +!!$ a%descra = 'GUN' +!!$ a%infoa(:) = 0 +!!$ a%infoa(psb_state_) = psb_spmat_bld_ +!!$ a%m = 0 +!!$ a%k = 0 +!!$ if (debug) write(0,*) 'SPALL : end' +!!$ Return +!!$ +!!$ End Subroutine psb_dspallocate +!!$ +!!$ Subroutine psb_dspallmk(m,k,a,info) +!!$ implicit none +!!$ !....Parameters... +!!$ +!!$ Type(psb_dspmat_type), intent(inout) :: A +!!$ Integer, intent(in) :: m,k +!!$ Integer, intent(out) :: info +!!$ +!!$ !locals +!!$ logical, parameter :: debug=.false. +!!$ integer :: nnz +!!$ +!!$ INFO = 0 +!!$ call psb_nullify_sp(a) +!!$ nnz = 2*max(1,m,k) +!!$ a%m=max(0,m) +!!$ a%k=max(0,k) +!!$ if (debug) write(0,*) 'SPALL : NNZ ',nnz,a%m,a%k +!!$ call psb_sp_reall(a,nnz,info) +!!$ if (debug) write(0,*) 'Check in ALLOCATE ',info,allocated(a%pl),allocated(a%pr) +!!$ if (info /= 0) return +!!$ a%pl(:)=0 +!!$ a%pr(:)=0 +!!$ ! set INFOA fields +!!$ a%fida = 'COO' +!!$ a%descra = 'GUN' +!!$ a%infoa(:) = 0 +!!$ a%infoa(psb_state_) = psb_spmat_bld_ +!!$ if (debug) write(0,*) 'SPALL : end' +!!$ Return +!!$ +!!$ end subroutine psb_dspallmk +!!$ +!!$ Subroutine psb_dspallmknz(m,k,a, nnz,info) +!!$ implicit none +!!$ !....parameters... +!!$ +!!$ type(psb_dspmat_type), intent(inout) :: a +!!$ integer, intent(in) :: m,k,nnz +!!$ integer, intent(out) :: info +!!$ +!!$ !locals +!!$ logical, parameter :: debug=.false. +!!$ +!!$ info = 0 +!!$ if (nnz < 0) then +!!$ info=45 +!!$ return +!!$ endif +!!$ call psb_nullify_sp(a) +!!$ if (debug) write(0,*) 'spall : nnz ',nnz,a%m,a%k +!!$ a%m=max(0,m) +!!$ a%k=max(0,k) +!!$ call psb_sp_reall(a,nnz,info) +!!$ if (debug) write(0,*) 'Check in ALLOCATE ',info,allocated(a%pl),allocated(a%pr) +!!$ if (info /= 0) return +!!$ a%pl(:)=0 +!!$ a%pr(:)=0 +!!$ ! set infoa fields +!!$ a%fida = 'COO' +!!$ a%descra = 'GUN' +!!$ a%infoa(:) = 0 +!!$ a%infoa(psb_state_) = psb_spmat_bld_ +!!$ if (debug) write(0,*) 'spall : end' +!!$ return +!!$ +!!$ end subroutine psb_dspallmknz +!!$ +!!$ +!!$ subroutine psb_dspall3(a, ni1,ni2,nd,info) +!!$ implicit none +!!$ !....Parameters... +!!$ Type(psb_dspmat_type), intent(inout) :: A +!!$ Integer, intent(in) :: ni1,ni2,nd +!!$ Integer, intent(out) :: info +!!$ +!!$ !locals +!!$ logical, parameter :: debug=.false. +!!$ +!!$ info = 0 +!!$ call psb_nullify_sp(a) +!!$ call psb_sp_reall(a, ni1,ni2,nd,info) +!!$ if (info /= 0) return +!!$ a%pl(:)=0 +!!$ a%pr(:)=0 +!!$ ! set INFOA fields +!!$ a%fida = 'COO' +!!$ a%descra = 'GUN' +!!$ a%infoa(:) = 0 +!!$ a%infoa(psb_state_) = psb_spmat_bld_ +!!$ a%m = 0 +!!$ a%k = 0 +!!$ if (debug) write(0,*) 'SPALL : end' +!!$ Return +!!$ +!!$ End Subroutine psb_dspall3 +!!$ +!!$ +!!$ subroutine psb_dspreallocate(a, nnz,info,ifc) +!!$ implicit none +!!$ !....Parameters... +!!$ Type(psb_dspmat_type), intent(inout) :: A +!!$ Integer, intent(in) :: NNZ +!!$ Integer, intent(out) :: info +!!$ ! +!!$ ! ifc is used here to allocate space in IA1 for smart +!!$ ! regeneration. This probably ought to be changed, +!!$ ! by adding a new component to d_spmat, or by making +!!$ ! infoa a pointer. +!!$ ! +!!$ Integer, intent(in), optional :: ifc +!!$ integer :: ifc_ +!!$ +!!$ !locals +!!$ logical, parameter :: debug=.false. +!!$ +!!$ info = 0 +!!$ if (nnz < 0) then +!!$ info=45 +!!$ return +!!$ endif +!!$ if (present(ifc)) then +!!$ ifc_ = max(1,ifc) +!!$ else +!!$ ifc_ = 1 +!!$ endif +!!$ +!!$ if (ifc_ == 1) then +!!$ call psb_realloc(max(nnz,a%m+1,a%k+1),a%ia1,a%ia2,a%aspk,info) +!!$ else +!!$ call psb_realloc(max(nnz,a%m+1,a%k+1),a%aspk,info) +!!$ if (info /= 0) return +!!$ call psb_realloc(max(nnz,a%m+1,a%k+1),a%ia2,info) +!!$ if (info /= 0) return +!!$ call psb_realloc(max(ifc*nnz+200,a%m+1,a%k+1),a%ia1,info) +!!$ if (info /= 0) return +!!$ end if +!!$ if (info /= 0) return +!!$ call psb_realloc(max(1,a%m),a%pl,info) +!!$ if (info /= 0) return +!!$ call psb_realloc(max(1,a%k),a%pr,info) +!!$ if (debug) write(0,*) allocated(a%ia1),allocated(a%ia2),& +!!$ & allocated(a%aspk),allocated(a%pl),allocated(a%pr),info +!!$ if (info /= 0) return +!!$ +!!$ Return +!!$ +!!$ End Subroutine psb_dspreallocate +!!$ +!!$ subroutine psb_dspreall3(a, ni1,ni2,nd,info) +!!$ implicit none +!!$ !....Parameters... +!!$ Type(psb_dspmat_type), intent(inout) :: A +!!$ Integer, intent(in) :: ni1,ni2,nd +!!$ Integer, intent(inout) :: info +!!$ +!!$ !locals +!!$ logical, parameter :: debug=.false. +!!$ +!!$ info = 0 +!!$ if (debug) write(0,*) 'Before realloc',nd,size(a%aspk),ni1,ni2 +!!$ call psb_realloc(nd,a%aspk,info) +!!$ if (debug) write(0,*) 'After realloc',nd,size(a%aspk),info +!!$ if (info /= 0) return +!!$ if (debug) write(0,*) 'Before realloc2',ni2,allocated(a%ia2),size(a%ia2) +!!$ call psb_realloc(ni2,a%ia2,info) +!!$ if (info /= 0) return +!!$ if (debug) write(0,*) 'Before realloc3',ni1,allocated(a%ia1),size(a%ia1) +!!$ call psb_realloc(ni1,a%ia1,info) +!!$ if (info /= 0) return +!!$ if (debug) write(0,*) 'Before realloc4',max(1,a%m),allocated(a%pl),size(a%pl) +!!$ call psb_realloc(max(1,a%m),a%pl,info) +!!$ if (info /= 0) return +!!$ if (debug) write(0,*) 'Before realloc5',max(1,a%k),allocated(a%pr),size(a%pr) +!!$ call psb_realloc(max(1,a%k),a%pr,info) +!!$ if (info /= 0) return +!!$ +!!$ Return +!!$ +!!$ End Subroutine psb_dspreall3 +!!$ +!!$ +!!$ subroutine psb_dspclone(a, b,info) +!!$ implicit none +!!$ !....Parameters... +!!$ Type(psb_dspmat_type), intent(in) :: A +!!$ Type(psb_dspmat_type), intent(out) :: B +!!$ Integer, intent(out) :: info +!!$ +!!$ !locals +!!$ +!!$ INFO = 0 +!!$ call psb_nullify_sp(b) +!!$ call psb_safe_ab_cpy(a%aspk,b%aspk,info) +!!$ if (info == 0) call psb_safe_ab_cpy(a%ia1,b%ia1,info) +!!$ if (info == 0) call psb_safe_ab_cpy(a%ia2,b%ia2,info) +!!$ if (info == 0) call psb_safe_ab_cpy(a%pl,b%pl,info) +!!$ if (info == 0) call psb_safe_ab_cpy(a%pr,b%pr,info) +!!$ if (info /= 0) then +!!$ info=2023 +!!$ return +!!$ Endif +!!$ b%infoa(:) = a%infoa(:) +!!$ b%fida = a%fida +!!$ b%descra = a%descra +!!$ b%m = a%m +!!$ b%k = a%k +!!$ +!!$ Return +!!$ +!!$ End Subroutine psb_dspclone +!!$ +!!$ +!!$ +!!$ ! Will be changed to use MOVE_ALLOC +!!$ subroutine psb_dsp_transfer(a, b,info) +!!$ implicit none +!!$ !....Parameters... +!!$ Type(psb_dspmat_type), intent(inout) :: A +!!$ Type(psb_dspmat_type), intent(inout) :: B +!!$ Integer, intent(out) :: info +!!$ +!!$ info = 0 +!!$ +!!$ +!!$ call psb_move_alloc( a%aspk, b%aspk , info) +!!$ call psb_move_alloc( a%ia1 , b%ia1 , info) +!!$ call psb_move_alloc( a%ia2 , b%ia2 , info) +!!$ call psb_move_alloc( a%pl , b%pl , info) +!!$ call psb_move_alloc( a%pr , b%pr , info) +!!$ b%infoa(:) = a%infoa(:) +!!$ b%fida = a%fida +!!$ b%descra = a%descra +!!$ b%m = a%m +!!$ b%k = a%k +!!$ +!!$ call psb_nullify_sp(a) +!!$ +!!$ Return +!!$ +!!$ End Subroutine psb_dsp_transfer +!!$ +!!$ +!!$ Subroutine psb_dsp_setifld(val,field,a,info) +!!$ implicit none +!!$ !....Parameters... +!!$ +!!$ Type(psb_dspmat_type), intent(inout) :: A +!!$ Integer, intent(in) :: field,val +!!$ Integer, intent(out) :: info +!!$ +!!$ info = 0 +!!$ +!!$ +!!$ if (info == 0) & +!!$ & call psb_setifield(val,field,a%infoa,psb_ifasize_,info) +!!$ +!!$ +!!$ Return +!!$ +!!$ end subroutine psb_dsp_setifld +!!$ +!!$ +!!$ ! +!!$ ! Reduce the size of A to the barest minimum necessary. +!!$ ! +!!$ ! +!!$ +!!$ +!!$ subroutine psb_dsp_trim(a,info) +!!$ use psb_string_mod +!!$ implicit none +!!$ !....Parameters... +!!$ Type(psb_dspmat_type), intent(inout) :: A +!!$ Integer, intent(out) :: info +!!$ +!!$ !locals +!!$ Integer :: i1, i2, ia +!!$ +!!$ info = 0 +!!$ call psb_sp_trimsize(a,i1,i2,ia,info) +!!$ i1 = max(i1,1); i2 = max(i2,1); ia = max(ia,1) +!!$ if (info == 0) call psb_sp_reall(a,i1,i2,ia,info) +!!$ +!!$ Return +!!$ +!!$ End Subroutine psb_dsp_trim +!!$ +!!$ +!!$ subroutine psb_dsp_trimsize(a, i1,i2,ia,info) +!!$ use psb_string_mod +!!$ implicit none +!!$ !....Parameters... +!!$ Type(psb_dspmat_type), intent(in) :: A +!!$ Integer, intent(out) :: i1, i2, ia, info +!!$ +!!$ !locals +!!$ Integer :: nza +!!$ +!!$ info = 0 +!!$ if (psb_sp_getifld(psb_upd_,a,info) == psb_upd_perm_) then +!!$ info = -1 +!!$ i1 = size(a%ia1) +!!$ i2 = size(a%ia2) +!!$ ia = size(a%aspk) +!!$ return +!!$ endif +!!$ select case(psb_tolower(a%fida)) +!!$ case('csr') +!!$ nza = a%ia2(a%m+1)-1 +!!$ ia = nza +!!$ i1 = nza +!!$ i2 = a%m + 1 +!!$ case('csc') +!!$ nza = a%ia2(a%k+1)-1 +!!$ ia = nza +!!$ i1 = nza +!!$ i2 = a%k + 1 +!!$ case('coo','coi') +!!$ nza = a%infoa(psb_nnz_) +!!$ i1 = nza +!!$ i2 = nza +!!$ ia = nza +!!$ case('jad') +!!$ ! Feeling lazy today +!!$ i1 = size(a%ia1) +!!$ i2 = size(a%ia2) +!!$ ia = size(a%aspk) +!!$ case default +!!$ i1 = size(a%ia1) +!!$ i2 = size(a%ia2) +!!$ ia = size(a%aspk) +!!$ end select +!!$ +!!$ Return +!!$ +!!$ End Subroutine psb_dsp_trimsize +!!$ +!!$ function psb_dsp_getifld(field,a,info) +!!$ implicit none +!!$ !....Parameters... +!!$ +!!$ Type(psb_dspmat_type), intent(in) :: A +!!$ Integer, intent(in) :: field +!!$ Integer :: psb_dsp_getifld +!!$ Integer, intent(out) :: info +!!$ +!!$ !locals +!!$ integer :: val +!!$ +!!$ info = 0 +!!$ val = -1 +!!$ +!!$ if ((field < 1).or.(field > psb_ifasize_)) then +!!$ info = -1 +!!$ psb_dsp_getifld = val +!!$ return +!!$ endif +!!$ +!!$ call psb_getifield(val,field,a%infoa,psb_ifasize_,info) +!!$ +!!$ psb_dsp_getifld = val +!!$ Return +!!$ +!!$ end function psb_dsp_getifld +!!$ +!!$ function psb_dspsizeof(a) result(val) +!!$ implicit none +!!$ !....Parameters... +!!$ +!!$ Type(psb_dspmat_type), intent(in) :: A +!!$ integer(psb_long_int_k_) :: val +!!$ +!!$ val = psb_sizeof_int*size(a%infoa) +!!$ if (allocated(a%aspk)) then +!!$ val = val + psb_sizeof_dp * size(a%aspk) +!!$ endif +!!$ if (allocated(a%ia1)) then +!!$ val = val + psb_sizeof_int * size(a%ia1) +!!$ endif +!!$ if (allocated(a%ia2)) then +!!$ val = val + psb_sizeof_int * size(a%ia2) +!!$ endif +!!$ if (allocated(a%pl)) then +!!$ val = val + psb_sizeof_int * size(a%pl) +!!$ endif +!!$ if (allocated(a%pr)) then +!!$ val = val + psb_sizeof_int * size(a%pr) +!!$ endif +!!$ +!!$ end function psb_dspsizeof +!!$ +!!$ +!!$ subroutine psb_dsp_free(a,info) +!!$ implicit none +!!$ !....Parameters... +!!$ Type(psb_dspmat_type), intent(inout) :: A +!!$ Integer, intent(out) :: info +!!$ !locals +!!$ integer :: iret +!!$ info = 0 +!!$ +!!$ if (allocated(a%aspk)) then +!!$! !$ write(0,*) 'Deallocating aspk' +!!$ deallocate(a%aspk,STAT=IRET) +!!$! !$ write(0,*) 'Deallocated aspk',iret +!!$ if (iret /= 0) info = max(info,1) +!!$ endif +!!$ if (allocated(a%ia1)) then +!!$ deallocate(a%ia1,STAT=IRET) +!!$ if (iret /= 0) info = max(info,2) +!!$ endif +!!$ if (allocated(a%ia2)) then +!!$ deallocate(a%ia2,STAT=IRET) +!!$ if (iret /= 0) info = max(info,3) +!!$ endif +!!$ if (allocated(a%pr)) then +!!$ deallocate(a%pr,STAT=IRET) +!!$ if (iret /= 0) info = max(info,4) +!!$ endif +!!$ if (allocated(a%pl)) then +!!$ deallocate(a%pl,STAT=IRET) +!!$ if (iret /= 0) info = max(info,5) +!!$ endif +!!$ call psb_nullify_sp(a) +!!$! !$ write(0,*) 'End of sp_free ',info +!!$ Return +!!$ End Subroutine psb_dsp_free +!!$ subroutine psb_nullify_csp(mat) implicit none @@ -2779,165 +2770,165 @@ contains end subroutine psb_sspinfo - subroutine psb_dspinfo(ireq,a,ires,info,iaux) - use psb_const_mod - use psb_error_mod - use psb_string_mod - use psb_sort_mod - implicit none - - type(psb_dspmat_type), intent(in), target :: a - integer, intent(in) :: ireq - integer, intent(out) :: ires, info - integer, intent(in), optional :: iaux - - integer :: j,ip,jp,nr,irw,nz, err_act, row, ipx, pia, pja, rb,idx, nc - integer, pointer :: ia1(:), ia2(:), ia3(:), ja(:) - character(len=20) :: name, ch_err - - name='psb_dspinfo' - info = 0 - call psb_erractionsave(err_act) - - - if (ireq == psb_nztotreq_) then - ! The number of nonzeroes - if (psb_toupper(a%fida) == 'CSR') then - nr = a%m - ires = a%ia2(nr+1)-1 - else if ((psb_toupper(a%fida) == 'COO').or.(psb_toupper(a%fida) == 'COI')) then - ires = a%infoa(psb_nnz_) - else if (psb_toupper(a%fida) == 'JAD') then - ires = a%infoa(psb_nnz_) - else if (psb_toupper(a%fida) == 'CSC') then - nc = a%k - ires = a%ia2(nc+1)-1 - else - ires=-1 - info=136 - ch_err=a%fida(1:3) - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - else if (ireq == psb_nzrowreq_) then - ! The number of nonzeroes in row iaux - if (.not.present(iaux)) then - write(0,*) 'Need IAUX when ireq=nzrowreq' - ires=-1 - return - endif - irw = iaux - if (irw > a%m) then - write(0,*) 'SPINFO: Accessing out of bounds? ',irw,a%m - ires = 0 - return - endif - if (psb_toupper(a%fida) == 'CSR') then - ires = a%ia2(irw+1)-a%ia2(irw) - else if ((psb_toupper(a%fida) == 'COO').or.(psb_toupper(a%fida) == 'COI')) then - - if (a%infoa(psb_srtd_) == psb_isrtdcoo_) then - ! In this case we can do a binary search. - nz = a%infoa(psb_nnz_) - ip = psb_ibsrch(irw,nz,a%ia1) - jp = ip - ! expand [ip,jp] to contain all row entries. - do - if (ip < 2) exit - if (a%ia1(ip-1) == irw) then - ip = ip -1 - else - exit - end if - end do - - do - if (jp > nz) exit - if (a%ia1(jp) == irw) then - jp =jp + 1 - else - exit - endif - end do - ires = jp-ip - else - ires = count(a%ia1(1:a%infoa(psb_nnz_))==irw) - endif -!!$ ires = 0 -!!$ do i=1, a%infoa(psb_nnz_) -!!$ if (a%ia1(i) == irw) ires = ires + 1 -!!$ enddo - else if (psb_toupper(a%fida) == 'JAD') then - pia = a%ia2(2) ! points to the beginning of ia(3,png) - pja = a%ia2(3) ! points to the beginning of ja(:) - ja => a%ia2(pja:) ! the array containing the pointers to ka and aspk - ia1 => a%ia2(pia:pja-1:3) ! the array containing the first row index of each block - ia2 => a%ia2(pia+1:pja-1:3) ! the array containing a pointer to the pos. in ja to the first jad column - ia3 => a%ia2(pia+2:pja-1:3) ! the array containing a pointer to the pos. in ja to the first csr column - - idx=a%pl(irw) - j=0 - nz=0 - blkfnd: do - j=j+1 - if(ia1(j) == idx) then - nz=nz+ia3(j)-ia2(j) - ipx = ia1(j) ! the first row index of the block - rb = idx-ipx ! the row offset within the block - row = ia3(j)+rb - nz = nz+ja(row+1)-ja(row) - exit blkfnd - else if(ia1(j) > idx) then - nz=nz+ia3(j-1)-ia2(j-1) - ipx = ia1(j-1) ! the first row index of the block - rb = idx-ipx ! the row offset within the block - row = ia3(j-1)+rb - nz = nz+ja(row+1)-ja(row) - exit blkfnd - end if - end do blkfnd - ires=nz - else - ires=-1 - info=136 - ch_err=a%fida(1:3) - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - else if (ireq == psb_nzsizereq_) then - if (psb_toupper(a%fida) == 'CSR') then - ires = size(a%aspk) - else if ((psb_toupper(a%fida) == 'COO').or.(psb_toupper(a%fida) == 'COI')) then - ires = size(a%aspk) - else if (psb_toupper(a%fida) == 'JAD') then - ires = a%infoa(psb_nnz_) - else - ires=-1 - info=136 - ch_err=a%fida(1:3) - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - else - write(0,*) 'Unknown request into SPINFO' - ires=-1 - endif - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - - end subroutine psb_dspinfo +!!$ subroutine psb_dspinfo(ireq,a,ires,info,iaux) +!!$ use psb_const_mod +!!$ use psb_error_mod +!!$ use psb_string_mod +!!$ use psb_sort_mod +!!$ implicit none +!!$ +!!$ type(psb_dspmat_type), intent(in), target :: a +!!$ integer, intent(in) :: ireq +!!$ integer, intent(out) :: ires, info +!!$ integer, intent(in), optional :: iaux +!!$ +!!$ integer :: j,ip,jp,nr,irw,nz, err_act, row, ipx, pia, pja, rb,idx, nc +!!$ integer, pointer :: ia1(:), ia2(:), ia3(:), ja(:) +!!$ character(len=20) :: name, ch_err +!!$ +!!$ name='psb_dspinfo' +!!$ info = 0 +!!$ call psb_erractionsave(err_act) +!!$ +!!$ +!!$ if (ireq == psb_nztotreq_) then +!!$ ! The number of nonzeroes +!!$ if (psb_toupper(a%fida) == 'CSR') then +!!$ nr = a%m +!!$ ires = a%ia2(nr+1)-1 +!!$ else if ((psb_toupper(a%fida) == 'COO').or.(psb_toupper(a%fida) == 'COI')) then +!!$ ires = a%infoa(psb_nnz_) +!!$ else if (psb_toupper(a%fida) == 'JAD') then +!!$ ires = a%infoa(psb_nnz_) +!!$ else if (psb_toupper(a%fida) == 'CSC') then +!!$ nc = a%k +!!$ ires = a%ia2(nc+1)-1 +!!$ else +!!$ ires=-1 +!!$ info=136 +!!$ ch_err=a%fida(1:3) +!!$ call psb_errpush(info,name,a_err=ch_err) +!!$ goto 9999 +!!$ end if +!!$ +!!$ else if (ireq == psb_nzrowreq_) then +!!$ ! The number of nonzeroes in row iaux +!!$ if (.not.present(iaux)) then +!!$ write(0,*) 'Need IAUX when ireq=nzrowreq' +!!$ ires=-1 +!!$ return +!!$ endif +!!$ irw = iaux +!!$ if (irw > a%m) then +!!$ write(0,*) 'SPINFO: Accessing out of bounds? ',irw,a%m +!!$ ires = 0 +!!$ return +!!$ endif +!!$ if (psb_toupper(a%fida) == 'CSR') then +!!$ ires = a%ia2(irw+1)-a%ia2(irw) +!!$ else if ((psb_toupper(a%fida) == 'COO').or.(psb_toupper(a%fida) == 'COI')) then +!!$ +!!$ if (a%infoa(psb_srtd_) == psb_isrtdcoo_) then +!!$ ! In this case we can do a binary search. +!!$ nz = a%infoa(psb_nnz_) +!!$ ip = psb_ibsrch(irw,nz,a%ia1) +!!$ jp = ip +!!$ ! expand [ip,jp] to contain all row entries. +!!$ do +!!$ if (ip < 2) exit +!!$ if (a%ia1(ip-1) == irw) then +!!$ ip = ip -1 +!!$ else +!!$ exit +!!$ end if +!!$ end do +!!$ +!!$ do +!!$ if (jp > nz) exit +!!$ if (a%ia1(jp) == irw) then +!!$ jp =jp + 1 +!!$ else +!!$ exit +!!$ endif +!!$ end do +!!$ ires = jp-ip +!!$ else +!!$ ires = count(a%ia1(1:a%infoa(psb_nnz_))==irw) +!!$ endif +!!$! !$ ires = 0 +!!$! !$ do i=1, a%infoa(psb_nnz_) +!!$! !$ if (a%ia1(i) == irw) ires = ires + 1 +!!$! !$ enddo +!!$ else if (psb_toupper(a%fida) == 'JAD') then +!!$ pia = a%ia2(2) ! points to the beginning of ia(3,png) +!!$ pja = a%ia2(3) ! points to the beginning of ja(:) +!!$ ja => a%ia2(pja:) ! the array containing the pointers to ka and aspk +!!$ ia1 => a%ia2(pia:pja-1:3) ! the array containing the first row index of each block +!!$ ia2 => a%ia2(pia+1:pja-1:3) ! the array containing a pointer to the pos. in ja to the first jad column +!!$ ia3 => a%ia2(pia+2:pja-1:3) ! the array containing a pointer to the pos. in ja to the first csr column +!!$ +!!$ idx=a%pl(irw) +!!$ j=0 +!!$ nz=0 +!!$ blkfnd: do +!!$ j=j+1 +!!$ if(ia1(j) == idx) then +!!$ nz=nz+ia3(j)-ia2(j) +!!$ ipx = ia1(j) ! the first row index of the block +!!$ rb = idx-ipx ! the row offset within the block +!!$ row = ia3(j)+rb +!!$ nz = nz+ja(row+1)-ja(row) +!!$ exit blkfnd +!!$ else if(ia1(j) > idx) then +!!$ nz=nz+ia3(j-1)-ia2(j-1) +!!$ ipx = ia1(j-1) ! the first row index of the block +!!$ rb = idx-ipx ! the row offset within the block +!!$ row = ia3(j-1)+rb +!!$ nz = nz+ja(row+1)-ja(row) +!!$ exit blkfnd +!!$ end if +!!$ end do blkfnd +!!$ ires=nz +!!$ else +!!$ ires=-1 +!!$ info=136 +!!$ ch_err=a%fida(1:3) +!!$ call psb_errpush(info,name,a_err=ch_err) +!!$ goto 9999 +!!$ end if +!!$ +!!$ else if (ireq == psb_nzsizereq_) then +!!$ if (psb_toupper(a%fida) == 'CSR') then +!!$ ires = size(a%aspk) +!!$ else if ((psb_toupper(a%fida) == 'COO').or.(psb_toupper(a%fida) == 'COI')) then +!!$ ires = size(a%aspk) +!!$ else if (psb_toupper(a%fida) == 'JAD') then +!!$ ires = a%infoa(psb_nnz_) +!!$ else +!!$ ires=-1 +!!$ info=136 +!!$ ch_err=a%fida(1:3) +!!$ call psb_errpush(info,name,a_err=ch_err) +!!$ goto 9999 +!!$ end if +!!$ +!!$ else +!!$ write(0,*) 'Unknown request into SPINFO' +!!$ ires=-1 +!!$ endif +!!$ +!!$ call psb_erractionrestore(err_act) +!!$ return +!!$ +!!$9999 continue +!!$ call psb_erractionrestore(err_act) +!!$ if (err_act == psb_act_abort_) then +!!$ call psb_error() +!!$ return +!!$ end if +!!$ return +!!$ +!!$ end subroutine psb_dspinfo subroutine psb_cspinfo(ireq,a,ires,info,iaux) use psb_const_mod diff --git a/base/serial/f03/psbn_d_coo_impl.f03 b/base/serial/f03/psbn_d_coo_impl.f03 index e9bb6b48..58511e65 100644 --- a/base/serial/f03/psbn_d_coo_impl.f03 +++ b/base/serial/f03/psbn_d_coo_impl.f03 @@ -1849,7 +1849,7 @@ subroutine d_cp_coo_to_coo_impl(a,b,info) call psb_erractionsave(err_act) info = 0 - b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat + call cp_from(b%psb_d_base_sparse_mat,a%psb_d_base_sparse_mat) call b%set_nzeros(a%get_nzeros()) call b%reallocate(a%get_nzeros()) @@ -1894,7 +1894,7 @@ subroutine d_cp_coo_from_coo_impl(a,b,info) call psb_erractionsave(err_act) info = 0 - a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat + call cp_from(a%psb_d_base_sparse_mat,b%psb_d_base_sparse_mat) call a%set_nzeros(b%get_nzeros()) call a%reallocate(b%get_nzeros()) @@ -2311,7 +2311,7 @@ subroutine d_mv_coo_to_coo_impl(a,b,info) call psb_erractionsave(err_act) info = 0 - b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat + call mv_from(b%psb_d_base_sparse_mat,a%psb_d_base_sparse_mat) call b%set_nzeros(a%get_nzeros()) call b%reallocate(a%get_nzeros()) @@ -2356,7 +2356,7 @@ subroutine d_mv_coo_from_coo_impl(a,b,info) call psb_erractionsave(err_act) info = 0 - a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat + call mv_from(a%psb_d_base_sparse_mat,b%psb_d_base_sparse_mat) call a%set_nzeros(b%get_nzeros()) call a%reallocate(b%get_nzeros()) diff --git a/base/serial/f03/psbn_d_csr_impl.f03 b/base/serial/f03/psbn_d_csr_impl.f03 index 89bdaed7..a047d7b6 100644 --- a/base/serial/f03/psbn_d_csr_impl.f03 +++ b/base/serial/f03/psbn_d_csr_impl.f03 @@ -1708,7 +1708,7 @@ subroutine d_cp_csr_to_coo_impl(a,b,info) nza = a%get_nzeros() call b%allocate(nr,nc,nza) - b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat + call cp_from(b%psb_d_base_sparse_mat,a%psb_d_base_sparse_mat) do i=1, nr do j=a%irp(i),a%irp(i+1)-1 @@ -1749,8 +1749,7 @@ subroutine d_mv_csr_to_coo_impl(a,b,info) nc = a%get_ncols() nza = a%get_nzeros() - - b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat + call mv_from( b%psb_d_base_sparse_mat,a%psb_d_base_sparse_mat) call b%set_nzeros(a%get_nzeros()) call move_alloc(a%ja,b%ja) call move_alloc(a%val,b%val) @@ -1797,7 +1796,8 @@ subroutine d_mv_csr_from_coo_impl(a,b,info) nc = b%get_ncols() nza = b%get_nzeros() - a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat + call mv_from(a%psb_d_base_sparse_mat,b%psb_d_base_sparse_mat) + ! Dirty trick: call move_alloc to have the new data allocated just once. call move_alloc(b%ia,itemp) call move_alloc(b%ja,a%ja) @@ -1884,7 +1884,7 @@ subroutine d_mv_csr_to_fmt_impl(a,b,info) call a%mv_to_coo(b,info) ! Need to fix trivial copies! type is (psb_d_csr_sparse_mat) - b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat + call mv_from(b%psb_d_base_sparse_mat,a%psb_d_base_sparse_mat) call move_alloc(a%irp, b%irp) call move_alloc(a%ja, b%ja) call move_alloc(a%val, b%val) @@ -1961,7 +1961,7 @@ subroutine d_mv_csr_from_fmt_impl(a,b,info) call a%mv_from_coo(b,info) type is (psb_d_csr_sparse_mat) - a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat + call mv_from(a%psb_d_base_sparse_mat,b%psb_d_base_sparse_mat) call move_alloc(b%irp, a%irp) call move_alloc(b%ja, a%ja) call move_alloc(b%val, a%val) @@ -2002,7 +2002,7 @@ subroutine d_cp_csr_from_fmt_impl(a,b,info) call a%cp_from_coo(b,info) type is (psb_d_csr_sparse_mat) - a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat + call cp_from(a%psb_d_base_sparse_mat,b%psb_d_base_sparse_mat) a%irp = b%irp a%ja = b%ja a%val = b%val diff --git a/prec/psb_dbjac_bld.f90 b/prec/psb_dbjac_bld.f90 index 57a05ec9..c3eca9f7 100644 --- a/prec/psb_dbjac_bld.f90 +++ b/prec/psb_dbjac_bld.f90 @@ -46,7 +46,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info) integer :: i, m integer :: int_err(5) character :: trans, unitd - type(psb_dspmat_type) :: atmp +!!$ type(psb_dspmat_type) :: atmp type(psb_d_csr_sparse_mat), allocatable :: lf, uf real(psb_dpk_) :: t1,t2,t3,t4,t5,t6, t7, t8 integer nztota, err_act, n_row, nrow_a,n_col, nhalo @@ -72,7 +72,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info) endif trans = 'N' unitd = 'U' - call psb_nullify_sp(atmp) +!!$ call psb_nullify_sp(atmp) call psb_cdcpy(desc_a,p%desc_data,info) if(info /= 0) then diff --git a/prec/psb_dilu_fct.f90 b/prec/psb_dilu_fct.f90 index 6aca9652..3d9daaaf 100644 --- a/prec/psb_dilu_fct.f90 +++ b/prec/psb_dilu_fct.f90 @@ -43,11 +43,11 @@ subroutine psb_dilu_fct(a,l,u,d,info,blck) ! .. Array Arguments .. type(psb_d_sparse_mat),intent(in) :: a type(psb_d_csr_sparse_mat),intent(inout) :: l,u - type(psb_dspmat_type),intent(in), optional, target :: blck + type(psb_d_sparse_mat),intent(in), optional, target :: blck real(psb_dpk_), intent(inout) :: d(:) ! .. Local Scalars .. integer :: l1,l2,m,err_act - type(psb_dspmat_type), pointer :: blck_ + type(psb_d_sparse_mat), pointer :: blck_ character(len=20) :: name, ch_err name='psb_dcsrlu' info = 0 @@ -64,19 +64,11 @@ subroutine psb_dilu_fct(a,l,u,d,info,blck) goto 9999 end if - call psb_nullify_sp(blck_) ! Why do we need this? Who knows.... - call psb_sp_all(0,0,blck_,1,info) - if(info /= 0) then - info=4010 - ch_err='psb_sp_all' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if + call blck_%csall(0,0,info,1) - blck_%m=0 endif - call psb_dilu_fctint(m,a%get_nrows(),a,blck_%m,blck_,& + call psb_dilu_fctint(m,a%get_nrows(),a,blck_%get_nrows(),blck_,& & d,l%val,l%ja,l%irp,u%val,u%ja,u%irp,l1,l2,info) if(info /= 0) then info=4010 @@ -99,7 +91,7 @@ subroutine psb_dilu_fct(a,l,u,d,info,blck) if (present(blck)) then blck_ => null() else - call psb_sp_free(blck_,info) + call blck_%free() if(info /= 0) then info=4010 ch_err='psb_sp_free' @@ -127,8 +119,8 @@ contains implicit none - type(psb_d_sparse_mat) :: a - type(psb_dspmat_type) :: b + type(psb_d_sparse_mat) :: a + type(psb_d_sparse_mat) :: b integer :: m,ma,mb,l1,l2,info integer, dimension(:) :: lia1,lia2,uia1,uia2 real(psb_dpk_), dimension(:) :: laspk,uaspk,d diff --git a/prec/psb_dprecbld.f90 b/prec/psb_dprecbld.f90 index 46da5e51..e1207e08 100644 --- a/prec/psb_dprecbld.f90 +++ b/prec/psb_dprecbld.f90 @@ -46,7 +46,6 @@ subroutine psb_dprecbld(aa,desc_a,p,info,upd) & me,np,mglob, err_act integer :: int_err(5) character :: upd_ - type(psb_dspmat_type), target :: a integer,parameter :: iroot=psb_root_,iout=60,ilout=40 character(len=20) :: name, ch_err diff --git a/prec/psb_prec_mod.f90 b/prec/psb_prec_mod.f90 index 6639a785..d010f116 100644 --- a/prec/psb_prec_mod.f90 +++ b/prec/psb_prec_mod.f90 @@ -86,7 +86,7 @@ module psb_prec_mod integer, intent(out) :: info end subroutine psb_sprecinit subroutine psb_dprecinit(prec,ptype,info) - use psb_base_mod, only : psb_desc_type, psb_dspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_dpk_ use psb_prec_type, only : psb_dprec_type implicit none type(psb_dprec_type), intent(inout) :: prec @@ -130,7 +130,7 @@ module psb_prec_mod integer, intent(out) :: info end subroutine psb_sprecsets subroutine psb_dprecseti(prec,what,val,info) - use psb_base_mod, only : psb_desc_type, psb_dspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_dpk_ use psb_prec_type, only : psb_dprec_type implicit none type(psb_dprec_type), intent(inout) :: prec @@ -138,7 +138,7 @@ module psb_prec_mod integer, intent(out) :: info end subroutine psb_dprecseti subroutine psb_dprecsetd(prec,what,val,info) - use psb_base_mod, only : psb_desc_type, psb_dspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_dpk_ use psb_prec_type, only : psb_dprec_type implicit none type(psb_dprec_type), intent(inout) :: prec @@ -205,7 +205,7 @@ module psb_prec_mod character(len=1), optional :: trans end subroutine psb_sprc_aply1 subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans,work) - use psb_base_mod, only : psb_desc_type, psb_dspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_dpk_ use psb_prec_type, only : psb_dprec_type type(psb_desc_type),intent(in) :: desc_data type(psb_dprec_type), intent(in) :: prec @@ -216,7 +216,7 @@ module psb_prec_mod real(psb_dpk_),intent(inout), optional, target :: work(:) end subroutine psb_dprc_aply subroutine psb_dprc_aply1(prec,x,desc_data,info,trans) - use psb_base_mod, only : psb_desc_type, psb_dspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_dpk_ use psb_prec_type, only : psb_dprec_type type(psb_desc_type),intent(in) :: desc_data type(psb_dprec_type), intent(in) :: prec @@ -281,7 +281,7 @@ module psb_prec_mod integer, intent(out) :: info end subroutine psb_sbjac_aply subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) - use psb_base_mod, only : psb_desc_type, psb_dspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_dpk_ use psb_prec_type, only : psb_dprec_type type(psb_desc_type), intent(in) :: desc_data type(psb_dprec_type), intent(in) :: prec @@ -404,7 +404,7 @@ module psb_prec_mod character, intent(in) :: upd end subroutine psb_sdiagsc_bld subroutine psb_ddiagsc_bld(a,desc_a,p,upd,info) - use psb_base_mod, only : psb_desc_type, psb_dspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_dpk_ use psb_prec_type, only : psb_dprec_type use psb_d_mat_mod integer, intent(out) :: info @@ -447,7 +447,7 @@ module psb_prec_mod integer, intent(out) :: info end subroutine psb_sgprec_aply subroutine psb_dgprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) - use psb_base_mod, only : psb_desc_type, psb_dspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_dpk_ use psb_prec_type, only : psb_dprec_type type(psb_desc_type),intent(in) :: desc_data type(psb_dprec_type), intent(in) :: prec diff --git a/prec/psb_prec_type.f90 b/prec/psb_prec_type.f90 index 48e82932..f2c3af50 100644 --- a/prec/psb_prec_type.f90 +++ b/prec/psb_prec_type.f90 @@ -38,7 +38,7 @@ module psb_prec_type ! Reduces size of .mod file. use psb_base_mod, only : psb_sspmat_type, psb_cspmat_type,& - & psb_dspmat_type, psb_zspmat_type, psb_dpk_, psb_spk_, psb_long_int_k_,& + & psb_zspmat_type, psb_dpk_, psb_spk_, psb_long_int_k_,& & psb_desc_type, psb_sizeof, psb_sp_free, psb_cdfree,& & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus use psb_d_mat_mod, only : psb_d_sparse_mat diff --git a/test/fileread/df_sample.f90 b/test/fileread/df_sample.f90 index 851e4004..6eed604e 100644 --- a/test/fileread/df_sample.f90 +++ b/test/fileread/df_sample.f90 @@ -182,13 +182,8 @@ program df_sample write(*,'("Partition type: graph")') write(*,'(" ")') ! write(0,'("Build type: graph")') - select type (aa=>aux_a%a) - type is (psb_d_csr_sparse_mat) - call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,np) - class default - write(0,*) 'Should never get here!' - call psb_abort(ictxt) - end select + call build_mtpart(aux_a,np) + endif call psb_barrier(ictxt) call distr_mtpart(psb_root_,ictxt) diff --git a/util/psb_metispart_mod.F90 b/util/psb_metispart_mod.F90 index b52b173c..8b11654a 100644 --- a/util/psb_metispart_mod.F90 +++ b/util/psb_metispart_mod.F90 @@ -58,7 +58,11 @@ module psb_metispart_mod & getv_mtpart, free_part private integer, allocatable, save :: graph_vect(:) - + + interface build_mtpart + module procedure build_mtpart, d_mat_build_mtpart + end interface + contains subroutine part_graph(global_indx,n,np,pv,nv) @@ -130,6 +134,22 @@ contains end if end subroutine getv_mtpart + subroutine d_mat_build_mtpart(a,nparts) + use psb_base_mod + type(psb_d_sparse_mat), intent(in) :: a + integer :: nparts + + + select type (aa=>a%a) + type is (psb_d_csr_sparse_mat) + call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts) + class default + write(0,*) 'Sorry, right now we only take CSR input!' + call psb_abort(ictxt) + end select + + end subroutine d_mat_build_mtpart + subroutine build_mtpart(n,fida,ia1,ia2,nparts) use psb_base_mod