diff --git a/base/modules/psb_c_base_mat_mod.f90 b/base/modules/psb_c_base_mat_mod.f90 index 2d364996..0bbc2fad 100644 --- a/base/modules/psb_c_base_mat_mod.f90 +++ b/base/modules/psb_c_base_mat_mod.f90 @@ -101,7 +101,7 @@ module psb_c_base_mat_mod end type psb_c_base_sparse_mat - private :: c_base_cssv, c_base_cssm, c_base_cp_from, c_base_mv_from + private :: c_base_cp_from, c_base_mv_from type, extends(psb_c_base_sparse_mat) :: psb_c_coo_sparse_mat diff --git a/base/modules/psb_c_psblas_mod.f90 b/base/modules/psb_c_psblas_mod.f90 index 540b0755..e0151753 100644 --- a/base/modules/psb_c_psblas_mod.f90 +++ b/base/modules/psb_c_psblas_mod.f90 @@ -164,7 +164,7 @@ module psb_c_psblas_mod interface psb_genrm2 function psb_cnrm2(x, desc_a, info, jx) use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ - real(psb_spk_) psb_snrm2 + real(psb_spk_) psb_cnrm2 complex(psb_spk_), intent (in) :: x(:,:) type(psb_desc_type), intent (in) :: desc_a integer, optional, intent (in) :: jx diff --git a/base/modules/psb_d_base_mat_mod.f90 b/base/modules/psb_d_base_mat_mod.f90 index c3935cac..c5d827e2 100644 --- a/base/modules/psb_d_base_mat_mod.f90 +++ b/base/modules/psb_d_base_mat_mod.f90 @@ -107,7 +107,7 @@ module psb_d_base_mat_mod end type psb_d_base_sparse_mat - private :: d_base_cssv, d_base_cssm, d_base_cp_from, d_base_mv_from + private :: d_base_cp_from, d_base_mv_from type, extends(psb_d_base_sparse_mat) :: psb_d_coo_sparse_mat diff --git a/base/modules/psb_d_mat_mod.f90 b/base/modules/psb_d_mat_mod.f90 index 30bbb26d..63d54732 100644 --- a/base/modules/psb_d_mat_mod.f90 +++ b/base/modules/psb_d_mat_mod.f90 @@ -949,8 +949,6 @@ contains class(psb_dspmat_type), intent(in) :: a integer :: res - Integer :: err_act - res = 0 if (allocated(a%a)) res = a%a%get_nz_row(idx) diff --git a/base/modules/psb_desc_type.f90 b/base/modules/psb_desc_type.f90 index 1a4fa267..45a4eee4 100644 --- a/base/modules/psb_desc_type.f90 +++ b/base/modules/psb_desc_type.f90 @@ -477,7 +477,7 @@ contains type(psb_desc_type), intent(inout) :: desc integer :: info - + info = 0 if (psb_is_asb_desc(desc)) & & call desc%indxmap%set_state(psb_desc_ovl_asb_) diff --git a/base/modules/psb_gen_block_map_mod.f90 b/base/modules/psb_gen_block_map_mod.f90 index ebbe1391..89a0ed21 100644 --- a/base/modules/psb_gen_block_map_mod.f90 +++ b/base/modules/psb_gen_block_map_mod.f90 @@ -585,7 +585,7 @@ contains integer, intent(in) :: ictxt, nl integer, intent(out) :: info ! To be implemented - integer :: iam, np, i, j, ntot + integer :: iam, np, i, ntot integer, allocatable :: vnl(:) info = 0 diff --git a/base/modules/psb_glist_map_mod.f90 b/base/modules/psb_glist_map_mod.f90 index ebc286cf..373831cb 100644 --- a/base/modules/psb_glist_map_mod.f90 +++ b/base/modules/psb_glist_map_mod.f90 @@ -99,7 +99,7 @@ contains integer, intent(in) :: ictxt, vg(:) integer, intent(out) :: info ! To be implemented - integer :: iam, np, i, j, n, nl + integer :: iam, np, i, n, nl info = 0 @@ -155,7 +155,7 @@ contains integer, allocatable, intent(out) :: iprc(:) class(psb_glist_map), intent(in) :: idxmap integer, intent(out) :: info - integer :: ictxt, iam, np, nv, ip, i, ngp + integer :: ictxt, iam, np, nv, i, ngp ictxt = idxmap%get_ctxt() call psb_info(ictxt,iam,np) diff --git a/base/modules/psb_gps_mod.f90 b/base/modules/psb_gps_mod.f90 index d74fe3c5..294c1b5b 100644 --- a/base/modules/psb_gps_mod.f90 +++ b/base/modules/psb_gps_mod.f90 @@ -743,7 +743,7 @@ CONTAINS ! PERFORM ON FLY REALLOCATION OF POINTER VET INCREASING ! ITS SIZE FROM SZ1 TO SZ2 IMPLICIT NONE - INTEGER,allocatable :: VET(:),TMP(:) + INTEGER,allocatable :: VET(:) INTEGER :: SZ1,SZ2,INFO call psb_realloc(sz2,vet,info) diff --git a/base/modules/psb_hash_map_mod.f90 b/base/modules/psb_hash_map_mod.f90 index d89d5a49..1e2f665d 100644 --- a/base/modules/psb_hash_map_mod.f90 +++ b/base/modules/psb_hash_map_mod.f90 @@ -75,7 +75,7 @@ contains procedure, pass(idxmap) :: clone => hash_clone procedure, nopass :: get_fmt => hash_get_fmt - procedure, pass(idxmap) :: row_extendable => hash_row_extendable + procedure, nopass :: row_extendable => hash_row_extendable procedure, pass(idxmap) :: l2gs1 => hash_l2gs1 procedure, pass(idxmap) :: l2gs2 => hash_l2gs2 @@ -113,9 +113,8 @@ private :: hash_inner_cnv contains -function hash_row_extendable(idxmap) result(val) +function hash_row_extendable() result(val) implicit none - class(psb_hash_map), intent(in) :: idxmap logical :: val val = .true. end function hash_row_extendable @@ -312,7 +311,7 @@ subroutine hash_g2lv1(idx,idxmap,info,mask,owned) integer, intent(out) :: info logical, intent(in), optional :: mask(:) logical, intent(in), optional :: owned - integer :: i, nv, is, mglob, ip, lip, nrow, ncol, nrm + integer :: i, is, mglob, ip, lip, nrow, ncol, nrm integer :: ictxt, iam, np logical :: owned_ @@ -473,7 +472,7 @@ subroutine hash_g2ls2_ins(idxin,idxout,idxmap,info,mask) logical, intent(in), optional :: mask idxout = idxin - call idxmap%g2l_ins(idxout,info) + call idxmap%g2l_ins(idxout,info,mask=mask) end subroutine hash_g2ls2_ins @@ -488,8 +487,8 @@ subroutine hash_g2lv1_ins(idx,idxmap,info,mask) integer, intent(inout) :: idx(:) integer, intent(out) :: info logical, intent(in), optional :: mask(:) - integer :: i, nv, is, ix, mglob, ip, lip, nrow, ncol, & - & nrm, nxt, err_act, ictxt, me, np + integer :: i, is, mglob, ip, lip, nrow, ncol, & + & nxt, err_act, ictxt, me, np character(len=20) :: name,ch_err info = psb_success_ @@ -646,7 +645,7 @@ subroutine hash_init_vl(idxmap,ictxt,vl,info) integer, intent(in) :: ictxt, vl(:) integer, intent(out) :: info ! To be implemented - integer :: iam, np, i, j, nlu, nl, m, nrt,int_err(5) + integer :: iam, np, i, nlu, nl, m, nrt,int_err(5) integer, allocatable :: vlu(:) character(len=20), parameter :: name='hash_map_init_vl' @@ -710,8 +709,7 @@ subroutine hash_init_vg(idxmap,ictxt,vg,info) integer, intent(in) :: ictxt, vg(:) integer, intent(out) :: info ! To be implemented - integer :: iam, np, i, j, lc2, nl, nlu, n, nrt,int_err(5) - integer :: key, ih, ik, nh, idx, nbits, hsize, hmask + integer :: iam, np, i, j, nl, n, int_err(5) integer, allocatable :: vlu(:) info = 0 @@ -767,7 +765,6 @@ subroutine hash_init_vlu(idxmap,ictxt,ntot,nl,vlu,info) integer, intent(out) :: info ! To be implemented integer :: iam, np, i, j, lc2, nlu, m, nrt,int_err(5) - integer :: key, ih, ik, nh, idx, nbits, hsize, hmask character(len=20), parameter :: name='hash_map_init_vlu' info = 0 @@ -820,8 +817,8 @@ subroutine hash_bld_g2l_map(idxmap,info) class(psb_hash_map), intent(inout) :: idxmap integer, intent(out) :: info ! To be implemented - integer :: ictxt, iam, np, i, j, lc2, nlu, m, nrt,int_err(5), nl - integer :: key, ih, ik, nh, idx, nbits, hsize, hmask + integer :: ictxt, iam, np, i, j, m, nl + integer :: key, ih, nh, idx, nbits, hsize, hmask character(len=20), parameter :: name='hash_map_init_vlu' info = 0 @@ -959,7 +956,7 @@ subroutine hash_inner_cnvs1(x,hashmask,hashv,glb_lc,nrm) integer, intent(in) :: hashmask,hashv(0:),glb_lc(:,:) integer, intent(inout) :: x integer, intent(in) :: nrm - integer :: i, ih, key, idx,nh,tmp,lb,ub,lm + integer :: ih, key, idx,nh,tmp,lb,ub,lm ! ! When a large descriptor is assembled the indices ! are kept in a (hashed) list of ordered lists. @@ -1006,7 +1003,7 @@ subroutine hash_inner_cnvs2(x,y,hashmask,hashv,glb_lc,nrm) integer, intent(in) :: x integer, intent(out) :: y integer, intent(in) :: nrm - integer :: i, ih, key, idx,nh,tmp,lb,ub,lm + integer :: ih, key, idx,nh,tmp,lb,ub,lm ! ! When a large descriptor is assembled the indices ! are kept in a (hashed) list of ordered lists. diff --git a/base/modules/psb_hash_mod.f90 b/base/modules/psb_hash_mod.f90 index 4d379457..0dfb9961 100644 --- a/base/modules/psb_hash_mod.f90 +++ b/base/modules/psb_hash_mod.f90 @@ -193,7 +193,7 @@ contains type(psb_hash_type), intent(out) :: hash integer, intent(out) :: info - integer :: i,j,k,hsize,nbits, nv + integer :: i,j,nbits, nv info = psb_success_ nv = size(v) @@ -214,7 +214,7 @@ contains type(psb_hash_type), intent(out) :: hash integer, intent(out) :: info - integer :: i,j,k,hsize,nbits + integer :: hsize,nbits info = psb_success_ nbits = 12 @@ -253,7 +253,7 @@ contains type(psb_hash_type), intent(inout) :: hash integer, intent(out) :: info type(psb_hash_type) :: nhash - integer :: nk, key, val, nextval,i + integer :: key, val, nextval,i info = HashOk @@ -282,7 +282,7 @@ contains type(psb_hash_type) :: hash integer, intent(out) :: val, info - integer :: i,j,k,hsize,hmask, hk, hd + integer :: hsize,hmask, hk, hd info = HashOK hsize = hash%hsize @@ -338,7 +338,7 @@ contains type(psb_hash_type) :: hash integer, intent(out) :: val, info - integer :: i,j,k,hsize,hmask, hk, hd + integer :: hsize,hmask, hk, hd info = HashOK if (.not.allocated(hash%table) ) then diff --git a/base/modules/psb_indx_map_mod.f90 b/base/modules/psb_indx_map_mod.f90 index ed7880fc..02312de5 100644 --- a/base/modules/psb_indx_map_mod.f90 +++ b/base/modules/psb_indx_map_mod.f90 @@ -101,7 +101,7 @@ module psb_indx_map_mod procedure, pass(idxmap) :: get_state => base_get_state procedure, pass(idxmap) :: set_state => base_set_state procedure, pass(idxmap) :: is_null => base_is_null - procedure, pass(idxmap) :: is_repl => base_is_repl + procedure, nopass :: is_repl => base_is_repl procedure, pass(idxmap) :: is_bld => base_is_bld procedure, pass(idxmap) :: is_upd => base_is_upd procedure, pass(idxmap) :: is_asb => base_is_asb @@ -115,7 +115,7 @@ module psb_indx_map_mod procedure, pass(idxmap) :: get_mpic => base_get_mpic procedure, pass(idxmap) :: sizeof => base_sizeof procedure, pass(idxmap) :: set_null => base_set_null - procedure, pass(idxmap) :: row_extendable => base_row_extendable + procedure, nopass :: row_extendable => base_row_extendable procedure, pass(idxmap) :: set_gr => base_set_gr procedure, pass(idxmap) :: set_gc => base_set_gc @@ -315,16 +315,14 @@ contains end subroutine base_set_mpic - function base_row_extendable(idxmap) result(val) + function base_row_extendable() result(val) implicit none - class(psb_indx_map), intent(in) :: idxmap logical :: val val = .false. end function base_row_extendable - function base_is_repl(idxmap) result(val) + function base_is_repl() result(val) implicit none - class(psb_indx_map), intent(in) :: idxmap logical :: val val = .false. end function base_is_repl @@ -743,10 +741,6 @@ contains implicit none class(psb_indx_map), intent(inout) :: idxmap - Integer :: err_act - character(len=20) :: name='base_free' - logical, parameter :: debug=.false. - ! almost nothing to be done here idxmap%state = -1 idxmap%ictxt = -1 diff --git a/base/modules/psb_list_map_mod.f90 b/base/modules/psb_list_map_mod.f90 index efc8d8b2..48a80e50 100644 --- a/base/modules/psb_list_map_mod.f90 +++ b/base/modules/psb_list_map_mod.f90 @@ -55,7 +55,7 @@ module psb_list_map_mod procedure, pass(idxmap) :: free => list_free procedure, pass(idxmap) :: clone => list_clone procedure, nopass :: get_fmt => list_get_fmt - procedure, pass(idxmap) :: row_extendable => list_row_extendable + procedure, nopass :: row_extendable => list_row_extendable procedure, pass(idxmap) :: l2gs1 => list_l2gs1 procedure, pass(idxmap) :: l2gs2 => list_l2gs2 @@ -82,9 +82,8 @@ module psb_list_map_mod contains - function list_row_extendable(idxmap) result(val) + function list_row_extendable() result(val) implicit none - class(psb_list_map), intent(in) :: idxmap logical :: val val = .true. end function list_row_extendable @@ -269,7 +268,7 @@ contains integer, intent(out) :: info logical, intent(in), optional :: mask(:) logical, intent(in), optional :: owned - integer :: i, nv, is, ix + integer :: i, is, ix logical :: owned_ info = 0 @@ -322,7 +321,7 @@ contains idx(1:is) = -1 info = -1 end if - + end if end subroutine list_g2lv1 @@ -378,7 +377,7 @@ contains logical, intent(in), optional :: mask idxout = idxin - call idxmap%g2l_ins(idxout,info) + call idxmap%g2l_ins(idxout,info,mask=mask) end subroutine list_g2ls2_ins @@ -391,7 +390,7 @@ contains integer, intent(inout) :: idx(:) integer, intent(out) :: info logical, intent(in), optional :: mask(:) - integer :: i, nv, is, ix + integer :: i, is, ix info = 0 is = size(idx) diff --git a/base/modules/psb_repl_map_mod.f90 b/base/modules/psb_repl_map_mod.f90 index d2cf155d..a87b6f17 100644 --- a/base/modules/psb_repl_map_mod.f90 +++ b/base/modules/psb_repl_map_mod.f90 @@ -51,7 +51,7 @@ module psb_repl_map_mod procedure, pass(idxmap) :: repl_map_init => repl_init - procedure, pass(idxmap) :: is_repl => repl_is_repl + procedure, nopass :: is_repl => repl_is_repl procedure, pass(idxmap) :: asb => repl_asb procedure, pass(idxmap) :: free => repl_free procedure, pass(idxmap) :: clone => repl_clone @@ -85,9 +85,8 @@ module psb_repl_map_mod contains - function repl_is_repl(idxmap) result(val) + function repl_is_repl() result(val) implicit none - class(psb_repl_map), intent(in) :: idxmap logical :: val val = .true. end function repl_is_repl @@ -248,7 +247,7 @@ contains integer, intent(out) :: info logical, intent(in), optional :: mask(:) logical, intent(in), optional :: owned - integer :: i, nv, is + integer :: i, is logical :: owned_ info = 0 @@ -373,7 +372,7 @@ contains logical, intent(in), optional :: mask idxout = idxin - call idxmap%g2l_ins(idxout,info) + call idxmap%g2l_ins(idxout,info,mask=mask) end subroutine repl_g2ls2_ins @@ -386,7 +385,7 @@ contains integer, intent(inout) :: idx(:) integer, intent(out) :: info logical, intent(in), optional :: mask(:) - integer :: i, nv, is, ix + integer :: i, is info = 0 is = size(idx) @@ -484,8 +483,7 @@ contains integer, intent(in) :: ictxt, nl integer, intent(out) :: info ! To be implemented - integer :: iam, np, i, j, ntot - integer, allocatable :: vnl(:) + integer :: iam, np info = 0 call psb_info(ictxt,iam,np) diff --git a/base/modules/psb_s_base_mat_mod.f90 b/base/modules/psb_s_base_mat_mod.f90 index 2231dd0b..b125a7c2 100644 --- a/base/modules/psb_s_base_mat_mod.f90 +++ b/base/modules/psb_s_base_mat_mod.f90 @@ -102,7 +102,7 @@ module psb_s_base_mat_mod end type psb_s_base_sparse_mat - private :: s_base_cssv, s_base_cssm, s_base_cp_from, s_base_mv_from + private :: s_base_cp_from, s_base_mv_from type, extends(psb_s_base_sparse_mat) :: psb_s_coo_sparse_mat diff --git a/base/modules/psb_s_mat_mod.f90 b/base/modules/psb_s_mat_mod.f90 index 4a65eab1..c5b96700 100644 --- a/base/modules/psb_s_mat_mod.f90 +++ b/base/modules/psb_s_mat_mod.f90 @@ -145,7 +145,7 @@ module psb_s_mat_mod end type psb_sspmat_type - private :: psb_s_get_nrows, psb_s_get_ncols, get_nzeros, psb_s_get_size, & + private :: psb_s_get_nrows, psb_s_get_ncols, psb_s_get_nzeros, psb_s_get_size, & & psb_s_get_state, psb_s_get_dupl, psb_s_is_null, psb_s_is_bld, psb_s_is_upd, & & psb_s_is_asb, psb_s_is_sorted, psb_s_is_upper, psb_s_is_lower, psb_s_is_triangle,& & psb_s_get_nz_row @@ -899,8 +899,6 @@ contains class(psb_sspmat_type), intent(in) :: a integer :: res - Integer :: err_act - res = 0 if (allocated(a%a)) res = a%a%get_nz_row(idx) diff --git a/base/modules/psb_sort_mod.f90 b/base/modules/psb_sort_mod.f90 index e5e92795..d85ccda1 100644 --- a/base/modules/psb_sort_mod.f90 +++ b/base/modules/psb_sort_mod.f90 @@ -112,7 +112,6 @@ module psb_sort_mod logical function psb_isaperm(n,eip) integer, intent(in) :: n integer, intent(in) :: eip(n) - integer, allocatable :: ip(:) end function psb_isaperm end interface @@ -459,8 +458,6 @@ module psb_sort_mod real(psb_spk_), intent(inout) :: heap(:) integer, intent(inout) :: last integer, intent(out) :: info - integer :: i, i2 - real(psb_spk_) :: temp end subroutine psi_insert_real_heap end interface @@ -483,8 +480,6 @@ module psb_sort_mod real(psb_dpk_), intent(inout) :: heap(:) integer, intent(inout) :: last integer, intent(out) :: info - integer :: i, i2 - real(psb_dpk_) :: temp end subroutine psi_insert_double_heap end interface diff --git a/base/modules/psb_z_base_mat_mod.f90 b/base/modules/psb_z_base_mat_mod.f90 index df74704b..4569411d 100644 --- a/base/modules/psb_z_base_mat_mod.f90 +++ b/base/modules/psb_z_base_mat_mod.f90 @@ -103,7 +103,7 @@ module psb_z_base_mat_mod end type psb_z_base_sparse_mat - private :: z_base_cssv, z_base_cssm, z_base_cp_from, z_base_mv_from + private :: z_base_cp_from, z_base_mv_from type, extends(psb_z_base_sparse_mat) :: psb_z_coo_sparse_mat diff --git a/base/modules/psb_z_mat_mod.f90 b/base/modules/psb_z_mat_mod.f90 index d930d936..bbc02541 100644 --- a/base/modules/psb_z_mat_mod.f90 +++ b/base/modules/psb_z_mat_mod.f90 @@ -897,8 +897,6 @@ contains integer, intent(in) :: idx class(psb_zspmat_type), intent(in) :: a integer :: res - - Integer :: err_act res = 0 diff --git a/base/modules/psi_comm_buffers_mod.F90 b/base/modules/psi_comm_buffers_mod.F90 index dcc29a91..9668ee70 100644 --- a/base/modules/psi_comm_buffers_mod.F90 +++ b/base/modules/psi_comm_buffers_mod.F90 @@ -76,8 +76,9 @@ module psi_comm_buffers_mod contains subroutine psb_init_queue(mesg_queue,info) + implicit none type(psb_buffer_queue), intent(inout) :: mesg_queue - type(psb_buffer_node), pointer :: item + integer, intent(out) :: info info = 0 if ((.not.associated(mesg_queue%head)).and.&