From 07fa2323ebf3fc3aceaf30d53e2dae786ad9a437 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Sun, 1 Jun 2025 20:56:11 +0200 Subject: [PATCH] Fixes for IPK8 --- base/comm/internals/psi_covrl_restr.f90 | 6 +- base/comm/internals/psi_covrl_save.f90 | 6 +- base/comm/internals/psi_covrl_upd.f90 | 6 +- base/comm/internals/psi_cswapdata.F90 | 15 ++-- base/comm/internals/psi_cswapdata_a.F90 | 24 +++--- base/comm/internals/psi_cswaptran.F90 | 14 ++-- base/comm/internals/psi_cswaptran_a.F90 | 21 ++--- base/comm/internals/psi_dovrl_restr.f90 | 6 +- base/comm/internals/psi_dovrl_save.f90 | 6 +- base/comm/internals/psi_dovrl_upd.f90 | 6 +- base/comm/internals/psi_dswapdata.F90 | 15 ++-- base/comm/internals/psi_dswapdata_a.F90 | 24 +++--- base/comm/internals/psi_dswaptran.F90 | 14 ++-- base/comm/internals/psi_dswaptran_a.F90 | 21 ++--- base/comm/internals/psi_eswapdata_a.F90 | 24 +++--- base/comm/internals/psi_eswaptran_a.F90 | 21 ++--- base/comm/internals/psi_i2swapdata_a.F90 | 24 +++--- base/comm/internals/psi_i2swaptran_a.F90 | 21 ++--- base/comm/internals/psi_iovrl_restr.f90 | 6 +- base/comm/internals/psi_iovrl_save.f90 | 6 +- base/comm/internals/psi_iovrl_upd.f90 | 6 +- base/comm/internals/psi_iswapdata.F90 | 15 ++-- base/comm/internals/psi_iswaptran.F90 | 14 ++-- base/comm/internals/psi_lovrl_restr.f90 | 6 +- base/comm/internals/psi_lovrl_save.f90 | 6 +- base/comm/internals/psi_lovrl_upd.f90 | 6 +- base/comm/internals/psi_lswapdata.F90 | 15 ++-- base/comm/internals/psi_lswaptran.F90 | 14 ++-- base/comm/internals/psi_mswapdata_a.F90 | 24 +++--- base/comm/internals/psi_mswaptran_a.F90 | 21 ++--- base/comm/internals/psi_sovrl_restr.f90 | 6 +- base/comm/internals/psi_sovrl_save.f90 | 6 +- base/comm/internals/psi_sovrl_upd.f90 | 6 +- base/comm/internals/psi_sswapdata.F90 | 15 ++-- base/comm/internals/psi_sswapdata_a.F90 | 24 +++--- base/comm/internals/psi_sswaptran.F90 | 14 ++-- base/comm/internals/psi_sswaptran_a.F90 | 21 ++--- base/comm/internals/psi_zovrl_restr.f90 | 6 +- base/comm/internals/psi_zovrl_save.f90 | 6 +- base/comm/internals/psi_zovrl_upd.f90 | 6 +- base/comm/internals/psi_zswapdata.F90 | 15 ++-- base/comm/internals/psi_zswapdata_a.F90 | 24 +++--- base/comm/internals/psi_zswaptran.F90 | 14 ++-- base/comm/internals/psi_zswaptran_a.F90 | 21 ++--- base/comm/psb_chalo_a.f90 | 4 +- base/comm/psb_covrl_a.f90 | 4 +- base/comm/psb_cscatter_a.F90 | 33 ++++---- base/comm/psb_dhalo_a.f90 | 4 +- base/comm/psb_dovrl_a.f90 | 4 +- base/comm/psb_dscatter_a.F90 | 33 ++++---- base/comm/psb_ehalo_a.f90 | 4 +- base/comm/psb_eovrl_a.f90 | 4 +- base/comm/psb_escatter_a.F90 | 33 ++++---- base/comm/psb_i2halo_a.f90 | 4 +- base/comm/psb_i2ovrl_a.f90 | 4 +- base/comm/psb_i2scatter_a.F90 | 33 ++++---- base/comm/psb_mhalo_a.f90 | 4 +- base/comm/psb_movrl_a.f90 | 4 +- base/comm/psb_mscatter_a.F90 | 33 ++++---- base/comm/psb_shalo_a.f90 | 4 +- base/comm/psb_sovrl_a.f90 | 4 +- base/comm/psb_sscatter_a.F90 | 33 ++++---- base/comm/psb_zhalo_a.f90 | 4 +- base/comm/psb_zovrl_a.f90 | 4 +- base/comm/psb_zscatter_a.F90 | 33 ++++---- base/internals/psi_adjcncy_fnd_owner.F90 | 92 +++++++++++---------- base/internals/psi_bld_glb_dep_list.F90 | 11 ++- base/internals/psi_crea_index.f90 | 6 +- base/internals/psi_desc_index.F90 | 3 +- base/internals/psi_graph_fnd_owner.F90 | 2 +- base/internals/psi_sort_dl.f90 | 4 +- base/internals/psi_xtr_loc_dl.F90 | 3 +- base/modules/auxil/psi_c_serial_mod.f90 | 42 ++++++---- base/modules/auxil/psi_d_serial_mod.f90 | 42 ++++++---- base/modules/auxil/psi_e_serial_mod.f90 | 24 ++++-- base/modules/auxil/psi_i2_serial_mod.f90 | 24 ++++-- base/modules/auxil/psi_m_serial_mod.f90 | 24 ++++-- base/modules/auxil/psi_s_serial_mod.f90 | 42 ++++++---- base/modules/auxil/psi_z_serial_mod.f90 | 42 ++++++---- base/modules/comm/psi_c_comm_a_mod.f90 | 12 ++- base/modules/comm/psi_d_comm_a_mod.f90 | 12 ++- base/modules/comm/psi_e_comm_a_mod.f90 | 12 ++- base/modules/comm/psi_i2_comm_a_mod.f90 | 12 ++- base/modules/comm/psi_m_comm_a_mod.f90 | 12 ++- base/modules/comm/psi_s_comm_a_mod.f90 | 12 ++- base/modules/comm/psi_z_comm_a_mod.f90 | 12 ++- base/modules/penv/psi_c_collective_mod.F90 | 41 +++++---- base/modules/penv/psi_d_collective_mod.F90 | 41 +++++---- base/modules/penv/psi_e_collective_mod.F90 | 41 +++++---- base/modules/penv/psi_i2_collective_mod.F90 | 41 +++++---- base/modules/penv/psi_m_collective_mod.F90 | 41 +++++---- base/modules/penv/psi_penv_mod.F90 | 4 +- base/modules/penv/psi_s_collective_mod.F90 | 41 +++++---- base/modules/penv/psi_z_collective_mod.F90 | 41 +++++---- base/modules/psb_const_mod.F90 | 2 +- base/modules/psb_error_impl.F90 | 2 +- base/modules/psi_i_mod.F90 | 13 +-- base/modules/serial/psb_c_base_vect_mod.F90 | 58 ++++++++----- base/modules/serial/psb_c_vect_mod.F90 | 24 ++++-- base/modules/serial/psb_d_base_vect_mod.F90 | 58 ++++++++----- base/modules/serial/psb_d_vect_mod.F90 | 24 ++++-- base/modules/serial/psb_i_base_vect_mod.F90 | 58 ++++++++----- base/modules/serial/psb_i_vect_mod.F90 | 24 ++++-- base/modules/serial/psb_l_base_vect_mod.F90 | 58 ++++++++----- base/modules/serial/psb_l_vect_mod.F90 | 24 ++++-- base/modules/serial/psb_s_base_vect_mod.F90 | 58 ++++++++----- base/modules/serial/psb_s_vect_mod.F90 | 24 ++++-- base/modules/serial/psb_z_base_vect_mod.F90 | 58 ++++++++----- base/modules/serial/psb_z_vect_mod.F90 | 24 ++++-- base/psblas/psb_cspmm.f90 | 12 +-- base/psblas/psb_cspsm.f90 | 6 +- base/psblas/psb_dspmm.f90 | 12 +-- base/psblas/psb_dspsm.f90 | 6 +- base/psblas/psb_sspmm.f90 | 12 +-- base/psblas/psb_sspsm.f90 | 6 +- base/psblas/psb_zspmm.f90 | 12 +-- base/psblas/psb_zspsm.f90 | 6 +- base/serial/psi_c_serial_impl.F90 | 24 ++++-- base/serial/psi_d_serial_impl.F90 | 24 ++++-- base/serial/psi_e_serial_impl.F90 | 24 ++++-- base/serial/psi_i2_serial_impl.F90 | 24 ++++-- base/serial/psi_m_serial_impl.F90 | 24 ++++-- base/serial/psi_s_serial_impl.F90 | 24 ++++-- base/serial/psi_z_serial_impl.F90 | 24 ++++-- base/tools/psb_c_remap.F90 | 66 ++++++++------- base/tools/psb_callc.f90 | 2 +- base/tools/psb_cd_remap.F90 | 6 +- base/tools/psb_d_remap.F90 | 66 ++++++++------- base/tools/psb_dallc.f90 | 2 +- base/tools/psb_iallc.f90 | 2 +- base/tools/psb_lallc.f90 | 2 +- base/tools/psb_s_remap.F90 | 66 ++++++++------- base/tools/psb_sallc.f90 | 2 +- base/tools/psb_z_remap.F90 | 66 ++++++++------- base/tools/psb_zallc.f90 | 2 +- cbind/base/psb_cpenv_mod.f90 | 43 +++++++--- cbind/util/psb_util_cbind_mod.f90 | 21 +++-- cuda/psb_c_cuda_vect_mod.F90 | 15 ++-- cuda/psb_d_cuda_vect_mod.F90 | 15 ++-- cuda/psb_i_cuda_vect_mod.F90 | 15 ++-- cuda/psb_s_cuda_vect_mod.F90 | 15 ++-- cuda/psb_z_cuda_vect_mod.F90 | 15 ++-- openacc/psb_c_oacc_vect_mod.F90 | 33 +++++--- openacc/psb_d_oacc_vect_mod.F90 | 33 +++++--- openacc/psb_i_oacc_vect_mod.F90 | 33 +++++--- openacc/psb_l_oacc_vect_mod.F90 | 33 +++++--- openacc/psb_s_oacc_vect_mod.F90 | 33 +++++--- openacc/psb_z_oacc_vect_mod.F90 | 33 +++++--- prec/psb_prec_const_mod.f90 | 18 ++-- test/fileread/psb_cf_sample.f90 | 8 +- test/fileread/psb_df_sample.f90 | 8 +- test/fileread/psb_sf_sample.f90 | 8 +- test/fileread/psb_zf_sample.f90 | 8 +- test/pdegen/psb_d_pde2d.F90 | 12 +-- test/pdegen/psb_d_pde3d.F90 | 16 ++-- test/pdegen/psb_s_pde2d.F90 | 12 +-- test/pdegen/psb_s_pde3d.F90 | 16 ++-- util/psb_c_mat_dist_impl.f90 | 26 +++--- util/psb_d_mat_dist_impl.f90 | 26 +++--- util/psb_metispart_mod.F90 | 13 +-- util/psb_s_mat_dist_impl.f90 | 26 +++--- util/psb_z_mat_dist_impl.f90 | 26 +++--- 162 files changed, 1873 insertions(+), 1338 deletions(-) diff --git a/base/comm/internals/psi_covrl_restr.f90 b/base/comm/internals/psi_covrl_restr.f90 index c0276bfd..9a0ecbed 100644 --- a/base/comm/internals/psi_covrl_restr.f90 +++ b/base/comm/internals/psi_covrl_restr.f90 @@ -48,7 +48,8 @@ subroutine psi_covrl_restr_vect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz + integer(psb_mpk_) :: np, me, isz + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_covrl_restr_vect' @@ -91,7 +92,8 @@ subroutine psi_covrl_restr_multivect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc + integer(psb_mpk_) :: np, me, isz,nc + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_covrl_restr_mv' diff --git a/base/comm/internals/psi_covrl_save.f90 b/base/comm/internals/psi_covrl_save.f90 index 8ee6dc9c..42f2ae3a 100644 --- a/base/comm/internals/psi_covrl_save.f90 +++ b/base/comm/internals/psi_covrl_save.f90 @@ -48,7 +48,8 @@ subroutine psi_covrl_save_vect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz + integer(psb_mpk_) :: np, me, isz + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_dovrl_saver1' @@ -97,7 +98,8 @@ subroutine psi_covrl_save_multivect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc + integer(psb_mpk_) :: np, me, isz, nc + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_dovrl_saver1' diff --git a/base/comm/internals/psi_covrl_upd.f90 b/base/comm/internals/psi_covrl_upd.f90 index c829e570..8212895c 100644 --- a/base/comm/internals/psi_covrl_upd.f90 +++ b/base/comm/internals/psi_covrl_upd.f90 @@ -51,7 +51,8 @@ subroutine psi_covrl_upd_vect(x,desc_a,update,info) ! locals complex(psb_spk_), allocatable :: xs(:) type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx + integer(psb_mpk_) :: np, me, isz, nx, ndm + integer(psb_ipk_) :: err_act, i, idx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -133,7 +134,8 @@ subroutine psi_covrl_upd_multivect(x,desc_a,update,info) ! locals complex(psb_spk_), allocatable :: xs(:,:) type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc + integer(psb_mpk_) :: np, me, isz, ndm, nx, nc + integer(psb_ipk_) :: err_act, i, idx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err diff --git a/base/comm/internals/psi_cswapdata.F90 b/base/comm/internals/psi_cswapdata.F90 index 92d58e5e..db76d16e 100644 --- a/base/comm/internals/psi_cswapdata.F90 +++ b/base/comm/internals/psi_cswapdata.F90 @@ -203,11 +203,11 @@ subroutine psi_cswap_vidx_vect(ctxt,icomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me - integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret + integer(psb_mpk_) :: np, me + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size),& + & iret, nesd, nerv integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv @@ -541,12 +541,11 @@ subroutine psi_cswap_vidx_multivect(ctxt,icomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. diff --git a/base/comm/internals/psi_cswapdata_a.F90 b/base/comm/internals/psi_cswapdata_a.F90 index e3368e0a..8b137397 100644 --- a/base/comm/internals/psi_cswapdata_a.F90 +++ b/base/comm/internals/psi_cswapdata_a.F90 @@ -98,7 +98,8 @@ subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data) include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info complex(psb_spk_) :: y(:,:), beta complex(psb_spk_), target :: work(:) @@ -108,7 +109,8 @@ subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -171,7 +173,8 @@ subroutine psi_cswapidxm(ctxt,icomm,flag,n,beta,y,idx, & type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag,n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info complex(psb_spk_) :: y(:,:), beta complex(psb_spk_), target :: work(:) @@ -179,12 +182,11 @@ subroutine psi_cswapidxm(ctxt,icomm,flag,n,beta,y,idx, & ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv @@ -585,7 +587,8 @@ subroutine psi_cswapdatav(flag,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -666,13 +669,12 @@ subroutine psi_cswapidxv(ctxt,icomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. diff --git a/base/comm/internals/psi_cswaptran.F90 b/base/comm/internals/psi_cswaptran.F90 index fac810b8..28b356c8 100644 --- a/base/comm/internals/psi_cswaptran.F90 +++ b/base/comm/internals/psi_cswaptran.F90 @@ -204,12 +204,11 @@ subroutine psi_ctran_vidx_vect(ctxt,icomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -552,12 +551,11 @@ subroutine psi_ctran_vidx_multivect(ctxt,icomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. diff --git a/base/comm/internals/psi_cswaptran_a.F90 b/base/comm/internals/psi_cswaptran_a.F90 index d1b80a2f..3fa61d94 100644 --- a/base/comm/internals/psi_cswaptran_a.F90 +++ b/base/comm/internals/psi_cswaptran_a.F90 @@ -102,7 +102,8 @@ subroutine psi_cswaptranm(flag,n,beta,y,desc_a,work,info,data) include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info complex(psb_spk_) :: y(:,:), beta complex(psb_spk_), target :: work(:) @@ -112,7 +113,8 @@ subroutine psi_cswaptranm(flag,n,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -176,19 +178,19 @@ subroutine psi_ctranidxm(ctxt,icomm,flag,n,beta,y,idx,& type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag,n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info complex(psb_spk_) :: y(:,:), beta complex(psb_spk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv @@ -678,13 +680,12 @@ subroutine psi_ctranidxv(ctxt,icomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. diff --git a/base/comm/internals/psi_dovrl_restr.f90 b/base/comm/internals/psi_dovrl_restr.f90 index 22a77328..bbcab4f3 100644 --- a/base/comm/internals/psi_dovrl_restr.f90 +++ b/base/comm/internals/psi_dovrl_restr.f90 @@ -48,7 +48,8 @@ subroutine psi_dovrl_restr_vect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz + integer(psb_mpk_) :: np, me, isz + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_dovrl_restr_vect' @@ -91,7 +92,8 @@ subroutine psi_dovrl_restr_multivect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc + integer(psb_mpk_) :: np, me, isz,nc + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_dovrl_restr_mv' diff --git a/base/comm/internals/psi_dovrl_save.f90 b/base/comm/internals/psi_dovrl_save.f90 index 38a83d2d..f7bc3dd1 100644 --- a/base/comm/internals/psi_dovrl_save.f90 +++ b/base/comm/internals/psi_dovrl_save.f90 @@ -48,7 +48,8 @@ subroutine psi_dovrl_save_vect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz + integer(psb_mpk_) :: np, me, isz + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_dovrl_saver1' @@ -97,7 +98,8 @@ subroutine psi_dovrl_save_multivect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc + integer(psb_mpk_) :: np, me, isz, nc + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_dovrl_saver1' diff --git a/base/comm/internals/psi_dovrl_upd.f90 b/base/comm/internals/psi_dovrl_upd.f90 index 261971ba..4ca995d9 100644 --- a/base/comm/internals/psi_dovrl_upd.f90 +++ b/base/comm/internals/psi_dovrl_upd.f90 @@ -51,7 +51,8 @@ subroutine psi_dovrl_upd_vect(x,desc_a,update,info) ! locals real(psb_dpk_), allocatable :: xs(:) type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx + integer(psb_mpk_) :: np, me, isz, nx, ndm + integer(psb_ipk_) :: err_act, i, idx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -133,7 +134,8 @@ subroutine psi_dovrl_upd_multivect(x,desc_a,update,info) ! locals real(psb_dpk_), allocatable :: xs(:,:) type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc + integer(psb_mpk_) :: np, me, isz, ndm, nx, nc + integer(psb_ipk_) :: err_act, i, idx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err diff --git a/base/comm/internals/psi_dswapdata.F90 b/base/comm/internals/psi_dswapdata.F90 index af5d6062..fb1924be 100644 --- a/base/comm/internals/psi_dswapdata.F90 +++ b/base/comm/internals/psi_dswapdata.F90 @@ -203,11 +203,11 @@ subroutine psi_dswap_vidx_vect(ctxt,icomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me - integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret + integer(psb_mpk_) :: np, me + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size),& + & iret, nesd, nerv integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv @@ -541,12 +541,11 @@ subroutine psi_dswap_vidx_multivect(ctxt,icomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. diff --git a/base/comm/internals/psi_dswapdata_a.F90 b/base/comm/internals/psi_dswapdata_a.F90 index 869b531f..6f1d4a10 100644 --- a/base/comm/internals/psi_dswapdata_a.F90 +++ b/base/comm/internals/psi_dswapdata_a.F90 @@ -98,7 +98,8 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data) include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info real(psb_dpk_) :: y(:,:), beta real(psb_dpk_), target :: work(:) @@ -108,7 +109,8 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -171,7 +173,8 @@ subroutine psi_dswapidxm(ctxt,icomm,flag,n,beta,y,idx, & type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag,n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info real(psb_dpk_) :: y(:,:), beta real(psb_dpk_), target :: work(:) @@ -179,12 +182,11 @@ subroutine psi_dswapidxm(ctxt,icomm,flag,n,beta,y,idx, & ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv @@ -585,7 +587,8 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -666,13 +669,12 @@ subroutine psi_dswapidxv(ctxt,icomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. diff --git a/base/comm/internals/psi_dswaptran.F90 b/base/comm/internals/psi_dswaptran.F90 index 0b4c850d..25cd8276 100644 --- a/base/comm/internals/psi_dswaptran.F90 +++ b/base/comm/internals/psi_dswaptran.F90 @@ -204,12 +204,11 @@ subroutine psi_dtran_vidx_vect(ctxt,icomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -552,12 +551,11 @@ subroutine psi_dtran_vidx_multivect(ctxt,icomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. diff --git a/base/comm/internals/psi_dswaptran_a.F90 b/base/comm/internals/psi_dswaptran_a.F90 index c96c96d1..df04c391 100644 --- a/base/comm/internals/psi_dswaptran_a.F90 +++ b/base/comm/internals/psi_dswaptran_a.F90 @@ -102,7 +102,8 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data) include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info real(psb_dpk_) :: y(:,:), beta real(psb_dpk_), target :: work(:) @@ -112,7 +113,8 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -176,19 +178,19 @@ subroutine psi_dtranidxm(ctxt,icomm,flag,n,beta,y,idx,& type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag,n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info real(psb_dpk_) :: y(:,:), beta real(psb_dpk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv @@ -678,13 +680,12 @@ subroutine psi_dtranidxv(ctxt,icomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. diff --git a/base/comm/internals/psi_eswapdata_a.F90 b/base/comm/internals/psi_eswapdata_a.F90 index fb6d0583..6e2d9557 100644 --- a/base/comm/internals/psi_eswapdata_a.F90 +++ b/base/comm/internals/psi_eswapdata_a.F90 @@ -98,7 +98,8 @@ subroutine psi_eswapdatam(flag,n,beta,y,desc_a,work,info,data) include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_epk_) :: y(:,:), beta integer(psb_epk_), target :: work(:) @@ -108,7 +109,8 @@ subroutine psi_eswapdatam(flag,n,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -171,7 +173,8 @@ subroutine psi_eswapidxm(ctxt,icomm,flag,n,beta,y,idx, & type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag,n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_epk_) :: y(:,:), beta integer(psb_epk_), target :: work(:) @@ -179,12 +182,11 @@ subroutine psi_eswapidxm(ctxt,icomm,flag,n,beta,y,idx, & ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv @@ -585,7 +587,8 @@ subroutine psi_eswapdatav(flag,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -666,13 +669,12 @@ subroutine psi_eswapidxv(ctxt,icomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. diff --git a/base/comm/internals/psi_eswaptran_a.F90 b/base/comm/internals/psi_eswaptran_a.F90 index 2b82d988..e105c88b 100644 --- a/base/comm/internals/psi_eswaptran_a.F90 +++ b/base/comm/internals/psi_eswaptran_a.F90 @@ -102,7 +102,8 @@ subroutine psi_eswaptranm(flag,n,beta,y,desc_a,work,info,data) include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_epk_) :: y(:,:), beta integer(psb_epk_), target :: work(:) @@ -112,7 +113,8 @@ subroutine psi_eswaptranm(flag,n,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -176,19 +178,19 @@ subroutine psi_etranidxm(ctxt,icomm,flag,n,beta,y,idx,& type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag,n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_epk_) :: y(:,:), beta integer(psb_epk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv @@ -678,13 +680,12 @@ subroutine psi_etranidxv(ctxt,icomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. diff --git a/base/comm/internals/psi_i2swapdata_a.F90 b/base/comm/internals/psi_i2swapdata_a.F90 index 58b1aeca..4acdbc9e 100644 --- a/base/comm/internals/psi_i2swapdata_a.F90 +++ b/base/comm/internals/psi_i2swapdata_a.F90 @@ -98,7 +98,8 @@ subroutine psi_i2swapdatam(flag,n,beta,y,desc_a,work,info,data) include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_) :: y(:,:), beta integer(psb_i2pk_), target :: work(:) @@ -108,7 +109,8 @@ subroutine psi_i2swapdatam(flag,n,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -171,7 +173,8 @@ subroutine psi_i2swapidxm(ctxt,icomm,flag,n,beta,y,idx, & type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag,n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_) :: y(:,:), beta integer(psb_i2pk_), target :: work(:) @@ -179,12 +182,11 @@ subroutine psi_i2swapidxm(ctxt,icomm,flag,n,beta,y,idx, & ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv @@ -585,7 +587,8 @@ subroutine psi_i2swapdatav(flag,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -666,13 +669,12 @@ subroutine psi_i2swapidxv(ctxt,icomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. diff --git a/base/comm/internals/psi_i2swaptran_a.F90 b/base/comm/internals/psi_i2swaptran_a.F90 index 02ccc221..f879702c 100644 --- a/base/comm/internals/psi_i2swaptran_a.F90 +++ b/base/comm/internals/psi_i2swaptran_a.F90 @@ -102,7 +102,8 @@ subroutine psi_i2swaptranm(flag,n,beta,y,desc_a,work,info,data) include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_) :: y(:,:), beta integer(psb_i2pk_), target :: work(:) @@ -112,7 +113,8 @@ subroutine psi_i2swaptranm(flag,n,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -176,19 +178,19 @@ subroutine psi_i2tranidxm(ctxt,icomm,flag,n,beta,y,idx,& type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag,n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_) :: y(:,:), beta integer(psb_i2pk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv @@ -678,13 +680,12 @@ subroutine psi_i2tranidxv(ctxt,icomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. diff --git a/base/comm/internals/psi_iovrl_restr.f90 b/base/comm/internals/psi_iovrl_restr.f90 index 4059f508..599a986e 100644 --- a/base/comm/internals/psi_iovrl_restr.f90 +++ b/base/comm/internals/psi_iovrl_restr.f90 @@ -48,7 +48,8 @@ subroutine psi_iovrl_restr_vect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz + integer(psb_mpk_) :: np, me, isz + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_iovrl_restr_vect' @@ -91,7 +92,8 @@ subroutine psi_iovrl_restr_multivect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc + integer(psb_mpk_) :: np, me, isz,nc + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_iovrl_restr_mv' diff --git a/base/comm/internals/psi_iovrl_save.f90 b/base/comm/internals/psi_iovrl_save.f90 index 0a9b13fd..eb7a7ffb 100644 --- a/base/comm/internals/psi_iovrl_save.f90 +++ b/base/comm/internals/psi_iovrl_save.f90 @@ -48,7 +48,8 @@ subroutine psi_iovrl_save_vect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz + integer(psb_mpk_) :: np, me, isz + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_dovrl_saver1' @@ -97,7 +98,8 @@ subroutine psi_iovrl_save_multivect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc + integer(psb_mpk_) :: np, me, isz, nc + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_dovrl_saver1' diff --git a/base/comm/internals/psi_iovrl_upd.f90 b/base/comm/internals/psi_iovrl_upd.f90 index 4eefe131..cf3c201b 100644 --- a/base/comm/internals/psi_iovrl_upd.f90 +++ b/base/comm/internals/psi_iovrl_upd.f90 @@ -51,7 +51,8 @@ subroutine psi_iovrl_upd_vect(x,desc_a,update,info) ! locals integer(psb_ipk_), allocatable :: xs(:) type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx + integer(psb_mpk_) :: np, me, isz, nx, ndm + integer(psb_ipk_) :: err_act, i, idx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -133,7 +134,8 @@ subroutine psi_iovrl_upd_multivect(x,desc_a,update,info) ! locals integer(psb_ipk_), allocatable :: xs(:,:) type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc + integer(psb_mpk_) :: np, me, isz, ndm, nx, nc + integer(psb_ipk_) :: err_act, i, idx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err diff --git a/base/comm/internals/psi_iswapdata.F90 b/base/comm/internals/psi_iswapdata.F90 index 1c4cf961..d73277ef 100644 --- a/base/comm/internals/psi_iswapdata.F90 +++ b/base/comm/internals/psi_iswapdata.F90 @@ -203,11 +203,11 @@ subroutine psi_iswap_vidx_vect(ctxt,icomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me - integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret + integer(psb_mpk_) :: np, me + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size),& + & iret, nesd, nerv integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv @@ -541,12 +541,11 @@ subroutine psi_iswap_vidx_multivect(ctxt,icomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. diff --git a/base/comm/internals/psi_iswaptran.F90 b/base/comm/internals/psi_iswaptran.F90 index 151f53f1..9f58455a 100644 --- a/base/comm/internals/psi_iswaptran.F90 +++ b/base/comm/internals/psi_iswaptran.F90 @@ -204,12 +204,11 @@ subroutine psi_itran_vidx_vect(ctxt,icomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -552,12 +551,11 @@ subroutine psi_itran_vidx_multivect(ctxt,icomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. diff --git a/base/comm/internals/psi_lovrl_restr.f90 b/base/comm/internals/psi_lovrl_restr.f90 index 71871e70..d3f6c913 100644 --- a/base/comm/internals/psi_lovrl_restr.f90 +++ b/base/comm/internals/psi_lovrl_restr.f90 @@ -48,7 +48,8 @@ subroutine psi_lovrl_restr_vect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz + integer(psb_mpk_) :: np, me, isz + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_lovrl_restr_vect' @@ -91,7 +92,8 @@ subroutine psi_lovrl_restr_multivect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc + integer(psb_mpk_) :: np, me, isz,nc + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_lovrl_restr_mv' diff --git a/base/comm/internals/psi_lovrl_save.f90 b/base/comm/internals/psi_lovrl_save.f90 index 29d3b0ad..0eb623da 100644 --- a/base/comm/internals/psi_lovrl_save.f90 +++ b/base/comm/internals/psi_lovrl_save.f90 @@ -48,7 +48,8 @@ subroutine psi_lovrl_save_vect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz + integer(psb_mpk_) :: np, me, isz + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_dovrl_saver1' @@ -97,7 +98,8 @@ subroutine psi_lovrl_save_multivect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc + integer(psb_mpk_) :: np, me, isz, nc + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_dovrl_saver1' diff --git a/base/comm/internals/psi_lovrl_upd.f90 b/base/comm/internals/psi_lovrl_upd.f90 index d8b4bb5a..1371e02b 100644 --- a/base/comm/internals/psi_lovrl_upd.f90 +++ b/base/comm/internals/psi_lovrl_upd.f90 @@ -51,7 +51,8 @@ subroutine psi_lovrl_upd_vect(x,desc_a,update,info) ! locals integer(psb_lpk_), allocatable :: xs(:) type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx + integer(psb_mpk_) :: np, me, isz, nx, ndm + integer(psb_ipk_) :: err_act, i, idx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -133,7 +134,8 @@ subroutine psi_lovrl_upd_multivect(x,desc_a,update,info) ! locals integer(psb_lpk_), allocatable :: xs(:,:) type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc + integer(psb_mpk_) :: np, me, isz, ndm, nx, nc + integer(psb_ipk_) :: err_act, i, idx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err diff --git a/base/comm/internals/psi_lswapdata.F90 b/base/comm/internals/psi_lswapdata.F90 index ecb94a74..2d819ae9 100644 --- a/base/comm/internals/psi_lswapdata.F90 +++ b/base/comm/internals/psi_lswapdata.F90 @@ -203,11 +203,11 @@ subroutine psi_lswap_vidx_vect(ctxt,icomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me - integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret + integer(psb_mpk_) :: np, me + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size),& + & iret, nesd, nerv integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv @@ -541,12 +541,11 @@ subroutine psi_lswap_vidx_multivect(ctxt,icomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. diff --git a/base/comm/internals/psi_lswaptran.F90 b/base/comm/internals/psi_lswaptran.F90 index 9f9c98fb..3bf0eacd 100644 --- a/base/comm/internals/psi_lswaptran.F90 +++ b/base/comm/internals/psi_lswaptran.F90 @@ -204,12 +204,11 @@ subroutine psi_ltran_vidx_vect(ctxt,icomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -552,12 +551,11 @@ subroutine psi_ltran_vidx_multivect(ctxt,icomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. diff --git a/base/comm/internals/psi_mswapdata_a.F90 b/base/comm/internals/psi_mswapdata_a.F90 index 4101805c..0a1a3a61 100644 --- a/base/comm/internals/psi_mswapdata_a.F90 +++ b/base/comm/internals/psi_mswapdata_a.F90 @@ -98,7 +98,8 @@ subroutine psi_mswapdatam(flag,n,beta,y,desc_a,work,info,data) include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_mpk_) :: y(:,:), beta integer(psb_mpk_), target :: work(:) @@ -108,7 +109,8 @@ subroutine psi_mswapdatam(flag,n,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -171,7 +173,8 @@ subroutine psi_mswapidxm(ctxt,icomm,flag,n,beta,y,idx, & type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag,n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_mpk_) :: y(:,:), beta integer(psb_mpk_), target :: work(:) @@ -179,12 +182,11 @@ subroutine psi_mswapidxm(ctxt,icomm,flag,n,beta,y,idx, & ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv @@ -585,7 +587,8 @@ subroutine psi_mswapdatav(flag,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -666,13 +669,12 @@ subroutine psi_mswapidxv(ctxt,icomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. diff --git a/base/comm/internals/psi_mswaptran_a.F90 b/base/comm/internals/psi_mswaptran_a.F90 index dac51c9b..8d6e0b52 100644 --- a/base/comm/internals/psi_mswaptran_a.F90 +++ b/base/comm/internals/psi_mswaptran_a.F90 @@ -102,7 +102,8 @@ subroutine psi_mswaptranm(flag,n,beta,y,desc_a,work,info,data) include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_mpk_) :: y(:,:), beta integer(psb_mpk_), target :: work(:) @@ -112,7 +113,8 @@ subroutine psi_mswaptranm(flag,n,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -176,19 +178,19 @@ subroutine psi_mtranidxm(ctxt,icomm,flag,n,beta,y,idx,& type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag,n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_mpk_) :: y(:,:), beta integer(psb_mpk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv @@ -678,13 +680,12 @@ subroutine psi_mtranidxv(ctxt,icomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. diff --git a/base/comm/internals/psi_sovrl_restr.f90 b/base/comm/internals/psi_sovrl_restr.f90 index f51d98e2..86361fba 100644 --- a/base/comm/internals/psi_sovrl_restr.f90 +++ b/base/comm/internals/psi_sovrl_restr.f90 @@ -48,7 +48,8 @@ subroutine psi_sovrl_restr_vect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz + integer(psb_mpk_) :: np, me, isz + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_sovrl_restr_vect' @@ -91,7 +92,8 @@ subroutine psi_sovrl_restr_multivect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc + integer(psb_mpk_) :: np, me, isz,nc + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_sovrl_restr_mv' diff --git a/base/comm/internals/psi_sovrl_save.f90 b/base/comm/internals/psi_sovrl_save.f90 index 04fc3350..cb058fe4 100644 --- a/base/comm/internals/psi_sovrl_save.f90 +++ b/base/comm/internals/psi_sovrl_save.f90 @@ -48,7 +48,8 @@ subroutine psi_sovrl_save_vect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz + integer(psb_mpk_) :: np, me, isz + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_dovrl_saver1' @@ -97,7 +98,8 @@ subroutine psi_sovrl_save_multivect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc + integer(psb_mpk_) :: np, me, isz, nc + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_dovrl_saver1' diff --git a/base/comm/internals/psi_sovrl_upd.f90 b/base/comm/internals/psi_sovrl_upd.f90 index 046524ff..ba3a9f41 100644 --- a/base/comm/internals/psi_sovrl_upd.f90 +++ b/base/comm/internals/psi_sovrl_upd.f90 @@ -51,7 +51,8 @@ subroutine psi_sovrl_upd_vect(x,desc_a,update,info) ! locals real(psb_spk_), allocatable :: xs(:) type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx + integer(psb_mpk_) :: np, me, isz, nx, ndm + integer(psb_ipk_) :: err_act, i, idx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -133,7 +134,8 @@ subroutine psi_sovrl_upd_multivect(x,desc_a,update,info) ! locals real(psb_spk_), allocatable :: xs(:,:) type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc + integer(psb_mpk_) :: np, me, isz, ndm, nx, nc + integer(psb_ipk_) :: err_act, i, idx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err diff --git a/base/comm/internals/psi_sswapdata.F90 b/base/comm/internals/psi_sswapdata.F90 index 0ab5e1ca..e3b49e34 100644 --- a/base/comm/internals/psi_sswapdata.F90 +++ b/base/comm/internals/psi_sswapdata.F90 @@ -203,11 +203,11 @@ subroutine psi_sswap_vidx_vect(ctxt,icomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me - integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret + integer(psb_mpk_) :: np, me + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size),& + & iret, nesd, nerv integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv @@ -541,12 +541,11 @@ subroutine psi_sswap_vidx_multivect(ctxt,icomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. diff --git a/base/comm/internals/psi_sswapdata_a.F90 b/base/comm/internals/psi_sswapdata_a.F90 index 3eed18d9..0f1f26da 100644 --- a/base/comm/internals/psi_sswapdata_a.F90 +++ b/base/comm/internals/psi_sswapdata_a.F90 @@ -98,7 +98,8 @@ subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data) include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info real(psb_spk_) :: y(:,:), beta real(psb_spk_), target :: work(:) @@ -108,7 +109,8 @@ subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -171,7 +173,8 @@ subroutine psi_sswapidxm(ctxt,icomm,flag,n,beta,y,idx, & type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag,n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info real(psb_spk_) :: y(:,:), beta real(psb_spk_), target :: work(:) @@ -179,12 +182,11 @@ subroutine psi_sswapidxm(ctxt,icomm,flag,n,beta,y,idx, & ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv @@ -585,7 +587,8 @@ subroutine psi_sswapdatav(flag,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -666,13 +669,12 @@ subroutine psi_sswapidxv(ctxt,icomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. diff --git a/base/comm/internals/psi_sswaptran.F90 b/base/comm/internals/psi_sswaptran.F90 index deb49919..abb0ebed 100644 --- a/base/comm/internals/psi_sswaptran.F90 +++ b/base/comm/internals/psi_sswaptran.F90 @@ -204,12 +204,11 @@ subroutine psi_stran_vidx_vect(ctxt,icomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -552,12 +551,11 @@ subroutine psi_stran_vidx_multivect(ctxt,icomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. diff --git a/base/comm/internals/psi_sswaptran_a.F90 b/base/comm/internals/psi_sswaptran_a.F90 index cd87ace6..10e741dd 100644 --- a/base/comm/internals/psi_sswaptran_a.F90 +++ b/base/comm/internals/psi_sswaptran_a.F90 @@ -102,7 +102,8 @@ subroutine psi_sswaptranm(flag,n,beta,y,desc_a,work,info,data) include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info real(psb_spk_) :: y(:,:), beta real(psb_spk_), target :: work(:) @@ -112,7 +113,8 @@ subroutine psi_sswaptranm(flag,n,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -176,19 +178,19 @@ subroutine psi_stranidxm(ctxt,icomm,flag,n,beta,y,idx,& type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag,n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info real(psb_spk_) :: y(:,:), beta real(psb_spk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv @@ -678,13 +680,12 @@ subroutine psi_stranidxv(ctxt,icomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. diff --git a/base/comm/internals/psi_zovrl_restr.f90 b/base/comm/internals/psi_zovrl_restr.f90 index 0b127c3e..7fe94aa6 100644 --- a/base/comm/internals/psi_zovrl_restr.f90 +++ b/base/comm/internals/psi_zovrl_restr.f90 @@ -48,7 +48,8 @@ subroutine psi_zovrl_restr_vect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz + integer(psb_mpk_) :: np, me, isz + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_zovrl_restr_vect' @@ -91,7 +92,8 @@ subroutine psi_zovrl_restr_multivect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc + integer(psb_mpk_) :: np, me, isz,nc + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_zovrl_restr_mv' diff --git a/base/comm/internals/psi_zovrl_save.f90 b/base/comm/internals/psi_zovrl_save.f90 index 830479fe..841dec1d 100644 --- a/base/comm/internals/psi_zovrl_save.f90 +++ b/base/comm/internals/psi_zovrl_save.f90 @@ -48,7 +48,8 @@ subroutine psi_zovrl_save_vect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz + integer(psb_mpk_) :: np, me, isz + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_dovrl_saver1' @@ -97,7 +98,8 @@ subroutine psi_zovrl_save_multivect(x,xs,desc_a,info) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc + integer(psb_mpk_) :: np, me, isz, nc + integer(psb_ipk_) :: err_act, i, idx character(len=20) :: name, ch_err name='psi_dovrl_saver1' diff --git a/base/comm/internals/psi_zovrl_upd.f90 b/base/comm/internals/psi_zovrl_upd.f90 index f71862f7..7a3bccf2 100644 --- a/base/comm/internals/psi_zovrl_upd.f90 +++ b/base/comm/internals/psi_zovrl_upd.f90 @@ -51,7 +51,8 @@ subroutine psi_zovrl_upd_vect(x,desc_a,update,info) ! locals complex(psb_dpk_), allocatable :: xs(:) type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx + integer(psb_mpk_) :: np, me, isz, nx, ndm + integer(psb_ipk_) :: err_act, i, idx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -133,7 +134,8 @@ subroutine psi_zovrl_upd_multivect(x,desc_a,update,info) ! locals complex(psb_dpk_), allocatable :: xs(:,:) type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc + integer(psb_mpk_) :: np, me, isz, ndm, nx, nc + integer(psb_ipk_) :: err_act, i, idx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err diff --git a/base/comm/internals/psi_zswapdata.F90 b/base/comm/internals/psi_zswapdata.F90 index af683671..53147c84 100644 --- a/base/comm/internals/psi_zswapdata.F90 +++ b/base/comm/internals/psi_zswapdata.F90 @@ -203,11 +203,11 @@ subroutine psi_zswap_vidx_vect(ctxt,icomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me - integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret + integer(psb_mpk_) :: np, me + integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size),& + & iret, nesd, nerv integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv @@ -541,12 +541,11 @@ subroutine psi_zswap_vidx_multivect(ctxt,icomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. diff --git a/base/comm/internals/psi_zswapdata_a.F90 b/base/comm/internals/psi_zswapdata_a.F90 index 85cda7b7..f37dc1c7 100644 --- a/base/comm/internals/psi_zswapdata_a.F90 +++ b/base/comm/internals/psi_zswapdata_a.F90 @@ -98,7 +98,8 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data) include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info complex(psb_dpk_) :: y(:,:), beta complex(psb_dpk_), target :: work(:) @@ -108,7 +109,8 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -171,7 +173,8 @@ subroutine psi_zswapidxm(ctxt,icomm,flag,n,beta,y,idx, & type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag,n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info complex(psb_dpk_) :: y(:,:), beta complex(psb_dpk_), target :: work(:) @@ -179,12 +182,11 @@ subroutine psi_zswapidxm(ctxt,icomm,flag,n,beta,y,idx, & ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv @@ -585,7 +587,8 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -666,13 +669,12 @@ subroutine psi_zswapidxv(ctxt,icomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. diff --git a/base/comm/internals/psi_zswaptran.F90 b/base/comm/internals/psi_zswaptran.F90 index 1150b471..367dbd33 100644 --- a/base/comm/internals/psi_zswaptran.F90 +++ b/base/comm/internals/psi_zswaptran.F90 @@ -204,12 +204,11 @@ subroutine psi_ztran_vidx_vect(ctxt,icomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -552,12 +551,11 @@ subroutine psi_ztran_vidx_multivect(ctxt,icomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. diff --git a/base/comm/internals/psi_zswaptran_a.F90 b/base/comm/internals/psi_zswaptran_a.F90 index 2eaed34d..8b4e4268 100644 --- a/base/comm/internals/psi_zswaptran_a.F90 +++ b/base/comm/internals/psi_zswaptran_a.F90 @@ -102,7 +102,8 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data) include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info complex(psb_dpk_) :: y(:,:), beta complex(psb_dpk_), target :: work(:) @@ -112,7 +113,8 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data) ! locals type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm - integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ + integer(psb_mpk_) :: np, me + integer(psb_ipk_) :: idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -176,19 +178,19 @@ subroutine psi_ztranidxm(ctxt,icomm,flag,n,beta,y,idx,& type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag,n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info complex(psb_dpk_) :: y(:,:), beta complex(psb_dpk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv @@ -678,13 +680,12 @@ subroutine psi_ztranidxv(ctxt,icomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_ipk_) :: np, me + integer(psb_mpk_) :: np, me, nesd, nerv, n integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd - integer(psb_ipk_) :: nesd, nerv,& - & err_act, i, idx_pt, totsnd_, totrcv_,& - & snd_pt, rcv_pt, pnti, n + integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. diff --git a/base/comm/psb_chalo_a.f90 b/base/comm/psb_chalo_a.f90 index b27ffe56..30d47ba0 100644 --- a/base/comm/psb_chalo_a.f90 +++ b/base/comm/psb_chalo_a.f90 @@ -66,8 +66,8 @@ subroutine psb_chalom(x,desc_a,info,jx,ik,work,tran,mode,data) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me - integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& + integer(psb_mpk_) :: np, me, k + integer(psb_ipk_) :: err_act, iix, jjx, maxk, nrow, imode, i,& & liwork,data_, ldx integer(psb_lpk_) :: m, n, ix, ijx complex(psb_spk_),pointer :: iwork(:), xp(:,:) diff --git a/base/comm/psb_covrl_a.f90 b/base/comm/psb_covrl_a.f90 index d0f079ae..2d389438 100644 --- a/base/comm/psb_covrl_a.f90 +++ b/base/comm/psb_covrl_a.f90 @@ -77,8 +77,8 @@ subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me - integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& + integer(psb_mpk_) :: np, me, k + integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, maxk, update_,& & mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx complex(psb_spk_),pointer :: iwork(:), xp(:,:) diff --git a/base/comm/psb_cscatter_a.F90 b/base/comm/psb_cscatter_a.F90 index 542356d4..f351b0b0 100644 --- a/base/comm/psb_cscatter_a.F90 +++ b/base/comm/psb_cscatter_a.F90 @@ -63,7 +63,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr + integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam,& + & nlr, minfo integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & col,pos @@ -167,8 +168,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root) ! nlr = nrow call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& - & 1,psb_mpi_mpk_,rootrank,icomm,info) - + & 1,psb_mpi_mpk_,rootrank,icomm,minfo) + info = minfo if (iam == iroot) then displ(1)=0 do i=2,np @@ -195,8 +196,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root) call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& - & displ,psb_mpi_lpk_,rootrank,icomm,info) - + & displ,psb_mpi_lpk_,rootrank,icomm,minfo) + info = minfo do col=1, k ! prepare vector to scatter if(iam == iroot) then @@ -211,9 +212,9 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root) ! scatter call mpi_scatterv(scatterv,all_dim,displ,& - & psb_mpi_c_spk_,locx(1,col),nrow,& - & psb_mpi_c_spk_,rootrank,icomm,info) - + & psb_mpi_c_spk_,locx(1,col),nlr,& + & psb_mpi_c_spk_,rootrank,icomm,minfo) + info = minfo end do deallocate(l_t_g_all, scatterv,stat=info) @@ -308,7 +309,7 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr, minfo integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx @@ -403,8 +404,8 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root) ! nlr = nrow call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& - & 1,psb_mpi_mpk_,rootrank,icomm,info) - + & 1,psb_mpi_mpk_,rootrank,icomm,minfo) + info = minfo if(iam == iroot) then displ(1)=0 do i=2,np @@ -436,8 +437,8 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root) call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& - & displ,psb_mpi_lpk_,rootrank,icomm,info) - + & displ,psb_mpi_lpk_,rootrank,icomm,minfo) + info = minfo ! prepare vector to scatter if (iam == iroot) then do i=1,np @@ -451,9 +452,9 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root) end if call mpi_scatterv(scatterv,all_dim,displ,& - & psb_mpi_c_spk_,locx,nrow,& - & psb_mpi_c_spk_,rootrank,icomm,info) - + & psb_mpi_c_spk_,locx,nlr,& + & psb_mpi_c_spk_,rootrank,icomm,minfo) + info = minfo deallocate(l_t_g_all, scatterv,stat=info) if(info /= psb_success_) then info=psb_err_from_subroutine_ diff --git a/base/comm/psb_dhalo_a.f90 b/base/comm/psb_dhalo_a.f90 index ccbc169d..d802ead5 100644 --- a/base/comm/psb_dhalo_a.f90 +++ b/base/comm/psb_dhalo_a.f90 @@ -66,8 +66,8 @@ subroutine psb_dhalom(x,desc_a,info,jx,ik,work,tran,mode,data) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me - integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& + integer(psb_mpk_) :: np, me, k + integer(psb_ipk_) :: err_act, iix, jjx, maxk, nrow, imode, i,& & liwork,data_, ldx integer(psb_lpk_) :: m, n, ix, ijx real(psb_dpk_),pointer :: iwork(:), xp(:,:) diff --git a/base/comm/psb_dovrl_a.f90 b/base/comm/psb_dovrl_a.f90 index e005a393..464b8e31 100644 --- a/base/comm/psb_dovrl_a.f90 +++ b/base/comm/psb_dovrl_a.f90 @@ -77,8 +77,8 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me - integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& + integer(psb_mpk_) :: np, me, k + integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, maxk, update_,& & mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx real(psb_dpk_),pointer :: iwork(:), xp(:,:) diff --git a/base/comm/psb_dscatter_a.F90 b/base/comm/psb_dscatter_a.F90 index 67058e67..8864cca8 100644 --- a/base/comm/psb_dscatter_a.F90 +++ b/base/comm/psb_dscatter_a.F90 @@ -63,7 +63,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr + integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam,& + & nlr, minfo integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & col,pos @@ -167,8 +168,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root) ! nlr = nrow call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& - & 1,psb_mpi_mpk_,rootrank,icomm,info) - + & 1,psb_mpi_mpk_,rootrank,icomm,minfo) + info = minfo if (iam == iroot) then displ(1)=0 do i=2,np @@ -195,8 +196,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root) call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& - & displ,psb_mpi_lpk_,rootrank,icomm,info) - + & displ,psb_mpi_lpk_,rootrank,icomm,minfo) + info = minfo do col=1, k ! prepare vector to scatter if(iam == iroot) then @@ -211,9 +212,9 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root) ! scatter call mpi_scatterv(scatterv,all_dim,displ,& - & psb_mpi_r_dpk_,locx(1,col),nrow,& - & psb_mpi_r_dpk_,rootrank,icomm,info) - + & psb_mpi_r_dpk_,locx(1,col),nlr,& + & psb_mpi_r_dpk_,rootrank,icomm,minfo) + info = minfo end do deallocate(l_t_g_all, scatterv,stat=info) @@ -308,7 +309,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr, minfo integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx @@ -403,8 +404,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root) ! nlr = nrow call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& - & 1,psb_mpi_mpk_,rootrank,icomm,info) - + & 1,psb_mpi_mpk_,rootrank,icomm,minfo) + info = minfo if(iam == iroot) then displ(1)=0 do i=2,np @@ -436,8 +437,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root) call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& - & displ,psb_mpi_lpk_,rootrank,icomm,info) - + & displ,psb_mpi_lpk_,rootrank,icomm,minfo) + info = minfo ! prepare vector to scatter if (iam == iroot) then do i=1,np @@ -451,9 +452,9 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root) end if call mpi_scatterv(scatterv,all_dim,displ,& - & psb_mpi_r_dpk_,locx,nrow,& - & psb_mpi_r_dpk_,rootrank,icomm,info) - + & psb_mpi_r_dpk_,locx,nlr,& + & psb_mpi_r_dpk_,rootrank,icomm,minfo) + info = minfo deallocate(l_t_g_all, scatterv,stat=info) if(info /= psb_success_) then info=psb_err_from_subroutine_ diff --git a/base/comm/psb_ehalo_a.f90 b/base/comm/psb_ehalo_a.f90 index 03aa1e3f..d5431e69 100644 --- a/base/comm/psb_ehalo_a.f90 +++ b/base/comm/psb_ehalo_a.f90 @@ -66,8 +66,8 @@ subroutine psb_ehalom(x,desc_a,info,jx,ik,work,tran,mode,data) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me - integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& + integer(psb_mpk_) :: np, me, k + integer(psb_ipk_) :: err_act, iix, jjx, maxk, nrow, imode, i,& & liwork,data_, ldx integer(psb_lpk_) :: m, n, ix, ijx integer(psb_epk_),pointer :: iwork(:), xp(:,:) diff --git a/base/comm/psb_eovrl_a.f90 b/base/comm/psb_eovrl_a.f90 index fc6a868d..b24e5ab8 100644 --- a/base/comm/psb_eovrl_a.f90 +++ b/base/comm/psb_eovrl_a.f90 @@ -77,8 +77,8 @@ subroutine psb_eovrlm(x,desc_a,info,jx,ik,work,update,mode) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me - integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& + integer(psb_mpk_) :: np, me, k + integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, maxk, update_,& & mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx integer(psb_epk_),pointer :: iwork(:), xp(:,:) diff --git a/base/comm/psb_escatter_a.F90 b/base/comm/psb_escatter_a.F90 index d059e9e9..9c5ed19d 100644 --- a/base/comm/psb_escatter_a.F90 +++ b/base/comm/psb_escatter_a.F90 @@ -63,7 +63,8 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr + integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam,& + & nlr, minfo integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & col,pos @@ -167,8 +168,8 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root) ! nlr = nrow call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& - & 1,psb_mpi_mpk_,rootrank,icomm,info) - + & 1,psb_mpi_mpk_,rootrank,icomm,minfo) + info = minfo if (iam == iroot) then displ(1)=0 do i=2,np @@ -195,8 +196,8 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root) call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& - & displ,psb_mpi_lpk_,rootrank,icomm,info) - + & displ,psb_mpi_lpk_,rootrank,icomm,minfo) + info = minfo do col=1, k ! prepare vector to scatter if(iam == iroot) then @@ -211,9 +212,9 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root) ! scatter call mpi_scatterv(scatterv,all_dim,displ,& - & psb_mpi_epk_,locx(1,col),nrow,& - & psb_mpi_epk_,rootrank,icomm,info) - + & psb_mpi_epk_,locx(1,col),nlr,& + & psb_mpi_epk_,rootrank,icomm,minfo) + info = minfo end do deallocate(l_t_g_all, scatterv,stat=info) @@ -308,7 +309,7 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr, minfo integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx @@ -403,8 +404,8 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root) ! nlr = nrow call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& - & 1,psb_mpi_mpk_,rootrank,icomm,info) - + & 1,psb_mpi_mpk_,rootrank,icomm,minfo) + info = minfo if(iam == iroot) then displ(1)=0 do i=2,np @@ -436,8 +437,8 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root) call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& - & displ,psb_mpi_lpk_,rootrank,icomm,info) - + & displ,psb_mpi_lpk_,rootrank,icomm,minfo) + info = minfo ! prepare vector to scatter if (iam == iroot) then do i=1,np @@ -451,9 +452,9 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root) end if call mpi_scatterv(scatterv,all_dim,displ,& - & psb_mpi_epk_,locx,nrow,& - & psb_mpi_epk_,rootrank,icomm,info) - + & psb_mpi_epk_,locx,nlr,& + & psb_mpi_epk_,rootrank,icomm,minfo) + info = minfo deallocate(l_t_g_all, scatterv,stat=info) if(info /= psb_success_) then info=psb_err_from_subroutine_ diff --git a/base/comm/psb_i2halo_a.f90 b/base/comm/psb_i2halo_a.f90 index d49d71c6..054b61be 100644 --- a/base/comm/psb_i2halo_a.f90 +++ b/base/comm/psb_i2halo_a.f90 @@ -66,8 +66,8 @@ subroutine psb_i2halom(x,desc_a,info,jx,ik,work,tran,mode,data) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me - integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& + integer(psb_mpk_) :: np, me, k + integer(psb_ipk_) :: err_act, iix, jjx, maxk, nrow, imode, i,& & liwork,data_, ldx integer(psb_lpk_) :: m, n, ix, ijx integer(psb_i2pk_),pointer :: iwork(:), xp(:,:) diff --git a/base/comm/psb_i2ovrl_a.f90 b/base/comm/psb_i2ovrl_a.f90 index f7ccd7a6..09cc3b5d 100644 --- a/base/comm/psb_i2ovrl_a.f90 +++ b/base/comm/psb_i2ovrl_a.f90 @@ -77,8 +77,8 @@ subroutine psb_i2ovrlm(x,desc_a,info,jx,ik,work,update,mode) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me - integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& + integer(psb_mpk_) :: np, me, k + integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, maxk, update_,& & mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx integer(psb_i2pk_),pointer :: iwork(:), xp(:,:) diff --git a/base/comm/psb_i2scatter_a.F90 b/base/comm/psb_i2scatter_a.F90 index fd135324..1a07587f 100644 --- a/base/comm/psb_i2scatter_a.F90 +++ b/base/comm/psb_i2scatter_a.F90 @@ -63,7 +63,8 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr + integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam,& + & nlr, minfo integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & col,pos @@ -167,8 +168,8 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root) ! nlr = nrow call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& - & 1,psb_mpi_mpk_,rootrank,icomm,info) - + & 1,psb_mpi_mpk_,rootrank,icomm,minfo) + info = minfo if (iam == iroot) then displ(1)=0 do i=2,np @@ -195,8 +196,8 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root) call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& - & displ,psb_mpi_lpk_,rootrank,icomm,info) - + & displ,psb_mpi_lpk_,rootrank,icomm,minfo) + info = minfo do col=1, k ! prepare vector to scatter if(iam == iroot) then @@ -211,9 +212,9 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root) ! scatter call mpi_scatterv(scatterv,all_dim,displ,& - & psb_mpi_i2pk_,locx(1,col),nrow,& - & psb_mpi_i2pk_,rootrank,icomm,info) - + & psb_mpi_i2pk_,locx(1,col),nlr,& + & psb_mpi_i2pk_,rootrank,icomm,minfo) + info = minfo end do deallocate(l_t_g_all, scatterv,stat=info) @@ -308,7 +309,7 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr, minfo integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx @@ -403,8 +404,8 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root) ! nlr = nrow call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& - & 1,psb_mpi_mpk_,rootrank,icomm,info) - + & 1,psb_mpi_mpk_,rootrank,icomm,minfo) + info = minfo if(iam == iroot) then displ(1)=0 do i=2,np @@ -436,8 +437,8 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root) call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& - & displ,psb_mpi_lpk_,rootrank,icomm,info) - + & displ,psb_mpi_lpk_,rootrank,icomm,minfo) + info = minfo ! prepare vector to scatter if (iam == iroot) then do i=1,np @@ -451,9 +452,9 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root) end if call mpi_scatterv(scatterv,all_dim,displ,& - & psb_mpi_i2pk_,locx,nrow,& - & psb_mpi_i2pk_,rootrank,icomm,info) - + & psb_mpi_i2pk_,locx,nlr,& + & psb_mpi_i2pk_,rootrank,icomm,minfo) + info = minfo deallocate(l_t_g_all, scatterv,stat=info) if(info /= psb_success_) then info=psb_err_from_subroutine_ diff --git a/base/comm/psb_mhalo_a.f90 b/base/comm/psb_mhalo_a.f90 index cb9ffec1..c3f6a688 100644 --- a/base/comm/psb_mhalo_a.f90 +++ b/base/comm/psb_mhalo_a.f90 @@ -66,8 +66,8 @@ subroutine psb_mhalom(x,desc_a,info,jx,ik,work,tran,mode,data) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me - integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& + integer(psb_mpk_) :: np, me, k + integer(psb_ipk_) :: err_act, iix, jjx, maxk, nrow, imode, i,& & liwork,data_, ldx integer(psb_lpk_) :: m, n, ix, ijx integer(psb_mpk_),pointer :: iwork(:), xp(:,:) diff --git a/base/comm/psb_movrl_a.f90 b/base/comm/psb_movrl_a.f90 index 42d7d82d..983bcbf8 100644 --- a/base/comm/psb_movrl_a.f90 +++ b/base/comm/psb_movrl_a.f90 @@ -77,8 +77,8 @@ subroutine psb_movrlm(x,desc_a,info,jx,ik,work,update,mode) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me - integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& + integer(psb_mpk_) :: np, me, k + integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, maxk, update_,& & mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx integer(psb_mpk_),pointer :: iwork(:), xp(:,:) diff --git a/base/comm/psb_mscatter_a.F90 b/base/comm/psb_mscatter_a.F90 index 45271adb..628fcf19 100644 --- a/base/comm/psb_mscatter_a.F90 +++ b/base/comm/psb_mscatter_a.F90 @@ -63,7 +63,8 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr + integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam,& + & nlr, minfo integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & col,pos @@ -167,8 +168,8 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root) ! nlr = nrow call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& - & 1,psb_mpi_mpk_,rootrank,icomm,info) - + & 1,psb_mpi_mpk_,rootrank,icomm,minfo) + info = minfo if (iam == iroot) then displ(1)=0 do i=2,np @@ -195,8 +196,8 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root) call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& - & displ,psb_mpi_lpk_,rootrank,icomm,info) - + & displ,psb_mpi_lpk_,rootrank,icomm,minfo) + info = minfo do col=1, k ! prepare vector to scatter if(iam == iroot) then @@ -211,9 +212,9 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root) ! scatter call mpi_scatterv(scatterv,all_dim,displ,& - & psb_mpi_mpk_,locx(1,col),nrow,& - & psb_mpi_mpk_,rootrank,icomm,info) - + & psb_mpi_mpk_,locx(1,col),nlr,& + & psb_mpi_mpk_,rootrank,icomm,minfo) + info = minfo end do deallocate(l_t_g_all, scatterv,stat=info) @@ -308,7 +309,7 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr, minfo integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx @@ -403,8 +404,8 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root) ! nlr = nrow call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& - & 1,psb_mpi_mpk_,rootrank,icomm,info) - + & 1,psb_mpi_mpk_,rootrank,icomm,minfo) + info = minfo if(iam == iroot) then displ(1)=0 do i=2,np @@ -436,8 +437,8 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root) call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& - & displ,psb_mpi_lpk_,rootrank,icomm,info) - + & displ,psb_mpi_lpk_,rootrank,icomm,minfo) + info = minfo ! prepare vector to scatter if (iam == iroot) then do i=1,np @@ -451,9 +452,9 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root) end if call mpi_scatterv(scatterv,all_dim,displ,& - & psb_mpi_mpk_,locx,nrow,& - & psb_mpi_mpk_,rootrank,icomm,info) - + & psb_mpi_mpk_,locx,nlr,& + & psb_mpi_mpk_,rootrank,icomm,minfo) + info = minfo deallocate(l_t_g_all, scatterv,stat=info) if(info /= psb_success_) then info=psb_err_from_subroutine_ diff --git a/base/comm/psb_shalo_a.f90 b/base/comm/psb_shalo_a.f90 index 0030d5c9..23cc464d 100644 --- a/base/comm/psb_shalo_a.f90 +++ b/base/comm/psb_shalo_a.f90 @@ -66,8 +66,8 @@ subroutine psb_shalom(x,desc_a,info,jx,ik,work,tran,mode,data) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me - integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& + integer(psb_mpk_) :: np, me, k + integer(psb_ipk_) :: err_act, iix, jjx, maxk, nrow, imode, i,& & liwork,data_, ldx integer(psb_lpk_) :: m, n, ix, ijx real(psb_spk_),pointer :: iwork(:), xp(:,:) diff --git a/base/comm/psb_sovrl_a.f90 b/base/comm/psb_sovrl_a.f90 index 9944036d..6ced0fd5 100644 --- a/base/comm/psb_sovrl_a.f90 +++ b/base/comm/psb_sovrl_a.f90 @@ -77,8 +77,8 @@ subroutine psb_sovrlm(x,desc_a,info,jx,ik,work,update,mode) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me - integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& + integer(psb_mpk_) :: np, me, k + integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, maxk, update_,& & mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx real(psb_spk_),pointer :: iwork(:), xp(:,:) diff --git a/base/comm/psb_sscatter_a.F90 b/base/comm/psb_sscatter_a.F90 index 48968785..e060bd1c 100644 --- a/base/comm/psb_sscatter_a.F90 +++ b/base/comm/psb_sscatter_a.F90 @@ -63,7 +63,8 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr + integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam,& + & nlr, minfo integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & col,pos @@ -167,8 +168,8 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root) ! nlr = nrow call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& - & 1,psb_mpi_mpk_,rootrank,icomm,info) - + & 1,psb_mpi_mpk_,rootrank,icomm,minfo) + info = minfo if (iam == iroot) then displ(1)=0 do i=2,np @@ -195,8 +196,8 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root) call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& - & displ,psb_mpi_lpk_,rootrank,icomm,info) - + & displ,psb_mpi_lpk_,rootrank,icomm,minfo) + info = minfo do col=1, k ! prepare vector to scatter if(iam == iroot) then @@ -211,9 +212,9 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root) ! scatter call mpi_scatterv(scatterv,all_dim,displ,& - & psb_mpi_r_spk_,locx(1,col),nrow,& - & psb_mpi_r_spk_,rootrank,icomm,info) - + & psb_mpi_r_spk_,locx(1,col),nlr,& + & psb_mpi_r_spk_,rootrank,icomm,minfo) + info = minfo end do deallocate(l_t_g_all, scatterv,stat=info) @@ -308,7 +309,7 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr, minfo integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx @@ -403,8 +404,8 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root) ! nlr = nrow call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& - & 1,psb_mpi_mpk_,rootrank,icomm,info) - + & 1,psb_mpi_mpk_,rootrank,icomm,minfo) + info = minfo if(iam == iroot) then displ(1)=0 do i=2,np @@ -436,8 +437,8 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root) call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& - & displ,psb_mpi_lpk_,rootrank,icomm,info) - + & displ,psb_mpi_lpk_,rootrank,icomm,minfo) + info = minfo ! prepare vector to scatter if (iam == iroot) then do i=1,np @@ -451,9 +452,9 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root) end if call mpi_scatterv(scatterv,all_dim,displ,& - & psb_mpi_r_spk_,locx,nrow,& - & psb_mpi_r_spk_,rootrank,icomm,info) - + & psb_mpi_r_spk_,locx,nlr,& + & psb_mpi_r_spk_,rootrank,icomm,minfo) + info = minfo deallocate(l_t_g_all, scatterv,stat=info) if(info /= psb_success_) then info=psb_err_from_subroutine_ diff --git a/base/comm/psb_zhalo_a.f90 b/base/comm/psb_zhalo_a.f90 index 4855592a..2acc2463 100644 --- a/base/comm/psb_zhalo_a.f90 +++ b/base/comm/psb_zhalo_a.f90 @@ -66,8 +66,8 @@ subroutine psb_zhalom(x,desc_a,info,jx,ik,work,tran,mode,data) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me - integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& + integer(psb_mpk_) :: np, me, k + integer(psb_ipk_) :: err_act, iix, jjx, maxk, nrow, imode, i,& & liwork,data_, ldx integer(psb_lpk_) :: m, n, ix, ijx complex(psb_dpk_),pointer :: iwork(:), xp(:,:) diff --git a/base/comm/psb_zovrl_a.f90 b/base/comm/psb_zovrl_a.f90 index 6af46069..e7a87cef 100644 --- a/base/comm/psb_zovrl_a.f90 +++ b/base/comm/psb_zovrl_a.f90 @@ -77,8 +77,8 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me - integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& + integer(psb_mpk_) :: np, me, k + integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, maxk, update_,& & mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx complex(psb_dpk_),pointer :: iwork(:), xp(:,:) diff --git a/base/comm/psb_zscatter_a.F90 b/base/comm/psb_zscatter_a.F90 index 13eb22fe..d51dc82a 100644 --- a/base/comm/psb_zscatter_a.F90 +++ b/base/comm/psb_zscatter_a.F90 @@ -63,7 +63,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr + integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam,& + & nlr, minfo integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & col,pos @@ -167,8 +168,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root) ! nlr = nrow call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& - & 1,psb_mpi_mpk_,rootrank,icomm,info) - + & 1,psb_mpi_mpk_,rootrank,icomm,minfo) + info = minfo if (iam == iroot) then displ(1)=0 do i=2,np @@ -195,8 +196,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root) call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& - & displ,psb_mpi_lpk_,rootrank,icomm,info) - + & displ,psb_mpi_lpk_,rootrank,icomm,minfo) + info = minfo do col=1, k ! prepare vector to scatter if(iam == iroot) then @@ -211,9 +212,9 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root) ! scatter call mpi_scatterv(scatterv,all_dim,displ,& - & psb_mpi_c_dpk_,locx(1,col),nrow,& - & psb_mpi_c_dpk_,rootrank,icomm,info) - + & psb_mpi_c_dpk_,locx(1,col),nlr,& + & psb_mpi_c_dpk_,rootrank,icomm,minfo) + info = minfo end do deallocate(l_t_g_all, scatterv,stat=info) @@ -308,7 +309,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root) ! locals type(psb_ctxt_type) :: ctxt - integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr, minfo integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx @@ -403,8 +404,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root) ! nlr = nrow call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& - & 1,psb_mpi_mpk_,rootrank,icomm,info) - + & 1,psb_mpi_mpk_,rootrank,icomm,minfo) + info = minfo if(iam == iroot) then displ(1)=0 do i=2,np @@ -436,8 +437,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root) call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& - & displ,psb_mpi_lpk_,rootrank,icomm,info) - + & displ,psb_mpi_lpk_,rootrank,icomm,minfo) + info = minfo ! prepare vector to scatter if (iam == iroot) then do i=1,np @@ -451,9 +452,9 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root) end if call mpi_scatterv(scatterv,all_dim,displ,& - & psb_mpi_c_dpk_,locx,nrow,& - & psb_mpi_c_dpk_,rootrank,icomm,info) - + & psb_mpi_c_dpk_,locx,nlr,& + & psb_mpi_c_dpk_,rootrank,icomm,minfo) + info = minfo deallocate(l_t_g_all, scatterv,stat=info) if(info /= psb_success_) then info=psb_err_from_subroutine_ diff --git a/base/internals/psi_adjcncy_fnd_owner.F90 b/base/internals/psi_adjcncy_fnd_owner.F90 index dacc4e68..4af37493 100644 --- a/base/internals/psi_adjcncy_fnd_owner.F90 +++ b/base/internals/psi_adjcncy_fnd_owner.F90 @@ -81,12 +81,12 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) integer(psb_mpk_), allocatable :: hsz(:),hidx(:), sdidx(:), rvidx(:),& & sdsz(:), rvsz(:), sdhd(:), rvhd(:), p2pstat(:,:) integer(psb_mpk_) :: prc, p2ptag, iret - integer(psb_mpk_) :: icomm, minfo - integer(psb_ipk_) :: i,n_row,n_col,err_act,hsize,ip,isz,j, k,& - & last_ih, last_j, nidx, nrecv, nadj + integer(psb_mpk_) :: icomm, minfo, ip,nidx + integer(psb_ipk_) :: n_row,n_col,err_act,hsize,isz,j, k,& + & last_ih, last_j, nrecv, nadj integer(psb_lpk_) :: mglob, ih type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np,me + integer(psb_mpk_) :: np,me logical, parameter :: debug=.false. integer(psb_mpk_) :: xchg_alg logical, parameter :: do_timings=.false. @@ -176,8 +176,8 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) if (do_timings) call psb_toc(idx_phase11) if (do_timings) call psb_tic(idx_phase12) rvidx(0) = 0 - do i=0, np-1 - rvidx(i+1) = rvidx(i) + rvsz(i) + do ip=0, np-1 + rvidx(ip+1) = rvidx(ip) + rvsz(ip) end do hsize = rvidx(np) @@ -204,9 +204,9 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) ! Third, compute local answers ! call idxmap%g2l(rmtidx(1:hsize),lclidx(1:hsize),info,owned=.true.) - do i=1, hsize - tproc(i) = -1 - if ((0 < lclidx(i)).and. (lclidx(i) <= n_row)) tproc(i) = me + do ip=1, hsize + tproc(ip) = -1 + if ((0 < lclidx(ip)).and. (lclidx(ip) <= n_row)) tproc(ip) = me end do if (do_timings) call psb_toc(idx_phase2) if (do_timings) call psb_tic(idx_phase3) @@ -215,8 +215,8 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) ! Fourth, exchange the answers ! ! Adjust sdidx for reuse in receiving lclidx array - do i=0,np-1 - sdidx(i+1) = sdidx(i) + sdsz(i) + do ip=0,np-1 + sdidx(ip+1) = sdidx(ip) + sdsz(ip) end do call mpi_alltoallv(tproc,rvsz,rvidx,psb_mpi_ipk_,& & lclidx,sdsz,sdidx,psb_mpi_ipk_,icomm,iret) @@ -225,10 +225,10 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) ! Because IPRC has been initialized to -1, the MAX operation selects ! the answers. ! - do i=0, np-1 - if (sdsz(i)>0) then + do ip=0, np-1 + if (sdsz(ip)>0) then ! Must be nidx == sdsz(i) - iprc(1:nidx) = max(iprc(1:nidx), lclidx(sdidx(i)+1:sdidx(i)+sdsz(i))) + iprc(1:nidx) = max(iprc(1:nidx), lclidx(sdidx(ip)+1:sdidx(ip)+sdsz(ip))) end if end do if (do_timings) call psb_toc(idx_phase3) @@ -262,8 +262,8 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& & rvsz,1,psb_mpi_mpk_,icomm,minfo) hidx(0) = 0 - do i=0, np-1 - hidx(i+1) = hidx(i) + rvsz(i) + do ip=0, np-1 + hidx(ip+1) = hidx(ip) + rvsz(ip) end do hsize = hidx(np) ! write(0,*)me,' Check on sizes from a2a:',hsize,rvsz(:) @@ -276,22 +276,23 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') goto 9999 end if - do i = 0, np-1 - if (rvsz(i)>0) then + do ip = 0, np-1 + if (rvsz(ip)>0) then ! write(0,*) me, ' First receive from ',i,rvsz(i) - prc = psb_get_mpi_rank(ctxt,i) + prc = psb_get_mpi_rank(ctxt,ip) p2ptag = psb_long_swap_tag !write(0,*) me, ' Posting first receive from ',i,rvsz(i),prc - call mpi_irecv(rmtidx(hidx(i)+1),rvsz(i),& + call mpi_irecv(rmtidx(hidx(ip)+1),rvsz(ip),& & psb_mpi_lpk_,prc,& - & p2ptag, icomm,rvhd(i),iret) + & p2ptag, icomm,rvhd(ip),iret) end if end do if (do_timings) call psb_toc(idx_phase11) if (do_timings) call psb_tic(idx_phase12) do j=1, nadj if (nidx > 0) then - prc = psb_get_mpi_rank(ctxt,adj(j)) + ip = adj(j) + prc = psb_get_mpi_rank(ctxt,ip) p2ptag = psb_long_swap_tag !write(0,*) me, ' First send to ',adj(j),nidx, prc call mpi_send(idx,nidx,& @@ -310,9 +311,9 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) ! Third, compute local answers ! call idxmap%g2l(rmtidx(1:hsize),lclidx(1:hsize),info,owned=.true.) - do i=1, hsize - tproc(i) = -1 - if ((0 < lclidx(i)).and. (lclidx(i) <= n_row)) tproc(i) = me + do ip=1, hsize + tproc(ip) = -1 + if ((0 < lclidx(ip)).and. (lclidx(ip) <= n_row)) tproc(ip) = me end do if (do_timings) call psb_toc(idx_phase2) if (do_timings) call psb_tic(idx_phase3) @@ -323,7 +324,8 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) do j=1, nadj !write(0,*) me, ' First send to ',adj(j),nidx if (nidx > 0) then - prc = psb_get_mpi_rank(ctxt,adj(j)) + ip = adj(j) + prc = psb_get_mpi_rank(ctxt,ip) p2ptag = psb_int_swap_tag !write(0,*) me, ' Posting second receive from ',adj(j),nidx, prc call mpi_irecv(lclidx((j-1)*nidx+1),nidx, & @@ -335,12 +337,12 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) ! ! Fourth, send data back; ! - do i = 0, np-1 - if (rvsz(i)>0) then - prc = psb_get_mpi_rank(ctxt,i) + do ip = 0, np-1 + if (rvsz(ip)>0) then + prc = psb_get_mpi_rank(ctxt,ip) p2ptag = psb_int_swap_tag !write(0,*) me, ' Second send to ',i,rvsz(i), prc - call mpi_send(tproc(hidx(i)+1),rvsz(i),& + call mpi_send(tproc(hidx(ip)+1),rvsz(ip),& & psb_mpi_ipk_,prc,& & p2ptag, icomm,iret) end if @@ -372,8 +374,8 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& & rvsz,1,psb_mpi_mpk_,icomm,minfo) hidx(0) = 0 - do i=0, np-1 - hidx(i+1) = hidx(i) + rvsz(i) + do ip=0, np-1 + hidx(ip+1) = hidx(ip) + rvsz(ip) end do hsize = hidx(np) ! write(0,*)me,' Check on sizes from a2a:',hsize,rvsz(:) @@ -388,12 +390,13 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) end if do j=1, nadj !write(0,*) me, ' First send to ',adj(j),nidx - if (nidx > 0) call psb_snd(ctxt,idx(1:nidx),adj(j)) + ip = adj(j) + if (nidx > 0) call psb_snd(ctxt,idx(1:nidx),ip) end do - do i = 0, np-1 - if (rvsz(i)>0) then + do ip = 0, np-1 + if (rvsz(ip)>0) then ! write(0,*) me, ' First receive from ',i,rvsz(i) - call psb_rcv(ctxt,rmtidx(hidx(i)+1:hidx(i)+rvsz(i)),i) + call psb_rcv(ctxt,rmtidx(hidx(ip)+1:hidx(ip)+rvsz(ip)),ip) end if end do @@ -401,18 +404,18 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) ! Third, compute local answers ! call idxmap%g2l(rmtidx(1:hsize),lclidx(1:hsize),info,owned=.true.) - do i=1, hsize - tproc(i) = -1 - if ((0 < lclidx(i)).and. (lclidx(i) <= n_row)) tproc(i) = me + do ip=1, hsize + tproc(ip) = -1 + if ((0 < lclidx(ip)).and. (lclidx(ip) <= n_row)) tproc(ip) = me end do ! ! Fourth, send data back; ! - do i = 0, np-1 - if (rvsz(i)>0) then + do ip = 0, np-1 + if (rvsz(ip)>0) then !write(0,*) me, ' Second send to ',i,rvsz(i) - call psb_snd(ctxt,tproc(hidx(i)+1:hidx(i)+rvsz(i)),i) + call psb_snd(ctxt,tproc(hidx(ip)+1:hidx(ip)+rvsz(ip)),ip) end if end do ! @@ -420,8 +423,9 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) ! answer is -1. Reuse tproc ! do j = 1, nadj - !write(0,*) me, ' Second receive from ',adj(j), nidx - if (nidx > 0) call psb_rcv(ctxt,tproc(1:nidx),adj(j)) + !write(0,*) me, ' Second receive from ',adj(j), nidx + ip = adj(j) + if (nidx > 0) call psb_rcv(ctxt,tproc(1:nidx),ip) iprc(1:nidx) = max(iprc(1:nidx), tproc(1:nidx)) end do case default diff --git a/base/internals/psi_bld_glb_dep_list.F90 b/base/internals/psi_bld_glb_dep_list.F90 index 70a7159e..ea5349c4 100644 --- a/base/internals/psi_bld_glb_dep_list.F90 +++ b/base/internals/psi_bld_glb_dep_list.F90 @@ -45,8 +45,10 @@ subroutine psi_i_bld_glb_dep_list(ctxt,loc_dl,length_dl,c_dep_list,dl_ptr,info) #endif ! ....scalar parameters... type(psb_ctxt_type), intent(in) :: ctxt - integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:) - integer(psb_ipk_), allocatable, intent(out) :: c_dep_list(:), dl_ptr(:) + integer(psb_ipk_), intent(in) :: loc_dl(:) + integer(psb_mpk_), intent(in) :: length_dl(0:) + integer(psb_mpk_), allocatable, intent(out) :: dl_ptr(:) + integer(psb_ipk_), allocatable, intent(out) :: c_dep_list(:) integer(psb_ipk_), intent(out) :: info @@ -54,10 +56,11 @@ subroutine psi_i_bld_glb_dep_list(ctxt,loc_dl,length_dl,c_dep_list,dl_ptr,info) integer(psb_ipk_) :: int_err(5) ! .....local scalars... - integer(psb_ipk_) :: i, proc,j,err_act, length, myld + integer(psb_mpk_) :: myld + integer(psb_ipk_) :: i, proc,j,err_act, length integer(psb_ipk_) :: err integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: me, np + integer(psb_mpk_) :: me, np integer(psb_mpk_) :: icomm, minfo logical, parameter :: dist_symm_list=.false., print_dl=.false. character name*20 diff --git a/base/internals/psi_crea_index.f90 b/base/internals/psi_crea_index.f90 index 7e749288..bbef054e 100644 --- a/base/internals/psi_crea_index.f90 +++ b/base/internals/psi_crea_index.f90 @@ -67,8 +67,8 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np, mode, err_act, dl_lda, ldl ! ...parameters... - integer(psb_ipk_), allocatable :: length_dl(:), loc_dl(:),& - & c_dep_list(:), dl_ptr(:) + integer(psb_mpk_), allocatable :: length_dl(:), dl_ptr(:) + integer(psb_ipk_), allocatable :: loc_dl(:), c_dep_list(:) integer(psb_ipk_) :: dlmax, dlavg integer(psb_ipk_),parameter :: root=psb_root_,no_comm=-1 integer(psb_ipk_) :: debug_level, debug_unit @@ -132,7 +132,7 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) if (do_timings) call psb_toc(idx_phase21) if (do_timings) call psb_tic(idx_phase22) - call psi_sort_dl(dl_ptr,c_dep_list,length_dl,ctxt,info) + call psi_i_csr_sort_dl(dl_ptr,c_dep_list,length_dl,ctxt,info) if (info /= 0) then write(0,*) me,trim(name),' From sort_dl ',info end if diff --git a/base/internals/psi_desc_index.F90 b/base/internals/psi_desc_index.F90 index 5266bc5b..ec16afbe 100644 --- a/base/internals/psi_desc_index.F90 +++ b/base/internals/psi_desc_index.F90 @@ -119,7 +119,8 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,& integer(psb_ipk_),allocatable :: desc_index(:) integer(psb_ipk_) :: length_dl,nsnd,nrcv,info ! ....local scalars... - integer(psb_ipk_) :: j,me,np,i,proc + integer(psb_mpk_) :: me,np,proc + integer(psb_ipk_) :: j,i ! ...parameters... type(psb_ctxt_type) :: ctxt integer(psb_ipk_), parameter :: no_comm=-1 diff --git a/base/internals/psi_graph_fnd_owner.F90 b/base/internals/psi_graph_fnd_owner.F90 index 9d320cc3..de5d5915 100644 --- a/base/internals/psi_graph_fnd_owner.F90 +++ b/base/internals/psi_graph_fnd_owner.F90 @@ -237,7 +237,7 @@ subroutine psi_graph_fnd_owner(idx,iprc,ladj,idxmap,info) ! Choose a sample, should it be done in this simplistic way? ! Note: nsampl_in is a hint, not an absolute, hence nsampl_out ! - call psi_get_sample(1,idx,iprc,tidx,tsmpl,iend,nsampl_in,nsampl_out) + call psi_get_sample(ione,idx,iprc,tidx,tsmpl,iend,nsampl_in,nsampl_out) nsampl = min(nsampl_out,nsampl_in) if (debugsz) write(0,*) me,' From first sampling ',nsampl_in ! diff --git a/base/internals/psi_sort_dl.f90 b/base/internals/psi_sort_dl.f90 index ef3ac74d..a5c0b374 100644 --- a/base/internals/psi_sort_dl.f90 +++ b/base/internals/psi_sort_dl.f90 @@ -84,8 +84,8 @@ subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,ctxt,info) use psb_sort_mod implicit none - integer(psb_ipk_), intent(in) :: dl_ptr(0:) - integer(psb_ipk_), intent(inout) :: c_dep_list(:), l_dep_list(0:) + integer(psb_mpk_), intent(in) :: dl_ptr(0:), l_dep_list(0:) + integer(psb_ipk_), intent(inout) :: c_dep_list(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info ! Local variables diff --git a/base/internals/psi_xtr_loc_dl.F90 b/base/internals/psi_xtr_loc_dl.F90 index 8b22a0ca..26751dc9 100644 --- a/base/internals/psi_xtr_loc_dl.F90 +++ b/base/internals/psi_xtr_loc_dl.F90 @@ -125,7 +125,8 @@ subroutine psi_i_xtr_loc_dl(ctxt,is_bld,is_upd,desc_str,loc_dl,length_dl,info) logical, intent(in) :: is_bld, is_upd type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(in) :: desc_str(:) - integer(psb_ipk_), allocatable, intent(out) :: loc_dl(:), length_dl(:) + integer(psb_ipk_), allocatable, intent(out) :: loc_dl(:) + integer(psb_mpk_), allocatable, intent(out) :: length_dl(:) integer(psb_ipk_), intent(out) :: info ! .....local arrays.... integer(psb_ipk_) :: int_err(5) diff --git a/base/modules/auxil/psi_c_serial_mod.f90 b/base/modules/auxil/psi_c_serial_mod.f90 index 3fe001c8..1d30df10 100644 --- a/base/modules/auxil/psi_c_serial_mod.f90 +++ b/base/modules/auxil/psi_c_serial_mod.f90 @@ -128,64 +128,72 @@ module psi_c_serial_mod interface psi_gth subroutine psi_cgthmv(n,k,idx,alpha,x,beta,y) - import :: psb_ipk_, psb_spk_ + import :: psb_ipk_, psb_mpk_, psb_spk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: x(:,:), y(:),alpha,beta end subroutine psi_cgthmv subroutine psi_cgthv(n,idx,alpha,x,beta,y) - import :: psb_ipk_, psb_spk_ + import :: psb_ipk_, psb_mpk_, psb_spk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: x(:), y(:),alpha,beta end subroutine psi_cgthv subroutine psi_cgthzmv(n,k,idx,x,y) - import :: psb_ipk_, psb_spk_ + import :: psb_ipk_, psb_mpk_, psb_spk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: x(:,:), y(:) end subroutine psi_cgthzmv subroutine psi_cgthzmm(n,k,idx,x,y) - import :: psb_ipk_, psb_spk_ + import :: psb_ipk_, psb_mpk_, psb_spk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: x(:,:), y(:,:) end subroutine psi_cgthzmm subroutine psi_cgthzv(n,idx,x,y) - import :: psb_ipk_, psb_spk_ + import :: psb_ipk_, psb_mpk_, psb_spk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: x(:), y(:) end subroutine psi_cgthzv end interface psi_gth interface psi_sct subroutine psi_csctmm(n,k,idx,x,beta,y) - import :: psb_ipk_, psb_spk_ + import :: psb_ipk_, psb_mpk_, psb_spk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: beta, x(:,:), y(:,:) end subroutine psi_csctmm subroutine psi_csctmv(n,k,idx,x,beta,y) - import :: psb_ipk_, psb_spk_ + import :: psb_ipk_, psb_mpk_, psb_spk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: beta, x(:), y(:,:) end subroutine psi_csctmv subroutine psi_csctv(n,idx,x,beta,y) - import :: psb_ipk_, psb_spk_ + import :: psb_ipk_, psb_mpk_, psb_spk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: beta, x(:), y(:) end subroutine psi_csctv end interface psi_sct interface psi_exscan subroutine psi_c_exscanv(n,x,info,shift) - import :: psb_ipk_, psb_spk_ + import :: psb_ipk_, psb_mpk_, psb_spk_ implicit none integer(psb_ipk_), intent(in) :: n complex(psb_spk_), intent (inout) :: x(:) diff --git a/base/modules/auxil/psi_d_serial_mod.f90 b/base/modules/auxil/psi_d_serial_mod.f90 index a08263df..4115d89a 100644 --- a/base/modules/auxil/psi_d_serial_mod.f90 +++ b/base/modules/auxil/psi_d_serial_mod.f90 @@ -128,64 +128,72 @@ module psi_d_serial_mod interface psi_gth subroutine psi_dgthmv(n,k,idx,alpha,x,beta,y) - import :: psb_ipk_, psb_dpk_ + import :: psb_ipk_, psb_mpk_, psb_dpk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: x(:,:), y(:),alpha,beta end subroutine psi_dgthmv subroutine psi_dgthv(n,idx,alpha,x,beta,y) - import :: psb_ipk_, psb_dpk_ + import :: psb_ipk_, psb_mpk_, psb_dpk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: x(:), y(:),alpha,beta end subroutine psi_dgthv subroutine psi_dgthzmv(n,k,idx,x,y) - import :: psb_ipk_, psb_dpk_ + import :: psb_ipk_, psb_mpk_, psb_dpk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: x(:,:), y(:) end subroutine psi_dgthzmv subroutine psi_dgthzmm(n,k,idx,x,y) - import :: psb_ipk_, psb_dpk_ + import :: psb_ipk_, psb_mpk_, psb_dpk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: x(:,:), y(:,:) end subroutine psi_dgthzmm subroutine psi_dgthzv(n,idx,x,y) - import :: psb_ipk_, psb_dpk_ + import :: psb_ipk_, psb_mpk_, psb_dpk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: x(:), y(:) end subroutine psi_dgthzv end interface psi_gth interface psi_sct subroutine psi_dsctmm(n,k,idx,x,beta,y) - import :: psb_ipk_, psb_dpk_ + import :: psb_ipk_, psb_mpk_, psb_dpk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: beta, x(:,:), y(:,:) end subroutine psi_dsctmm subroutine psi_dsctmv(n,k,idx,x,beta,y) - import :: psb_ipk_, psb_dpk_ + import :: psb_ipk_, psb_mpk_, psb_dpk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: beta, x(:), y(:,:) end subroutine psi_dsctmv subroutine psi_dsctv(n,idx,x,beta,y) - import :: psb_ipk_, psb_dpk_ + import :: psb_ipk_, psb_mpk_, psb_dpk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: beta, x(:), y(:) end subroutine psi_dsctv end interface psi_sct interface psi_exscan subroutine psi_d_exscanv(n,x,info,shift) - import :: psb_ipk_, psb_dpk_ + import :: psb_ipk_, psb_mpk_, psb_dpk_ implicit none integer(psb_ipk_), intent(in) :: n real(psb_dpk_), intent (inout) :: x(:) diff --git a/base/modules/auxil/psi_e_serial_mod.f90 b/base/modules/auxil/psi_e_serial_mod.f90 index 1f1bebd7..6ebc3a54 100644 --- a/base/modules/auxil/psi_e_serial_mod.f90 +++ b/base/modules/auxil/psi_e_serial_mod.f90 @@ -130,33 +130,38 @@ module psi_e_serial_mod subroutine psi_egthmv(n,k,idx,alpha,x,beta,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_epk_) :: x(:,:), y(:),alpha,beta end subroutine psi_egthmv subroutine psi_egthv(n,idx,alpha,x,beta,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_epk_) :: x(:), y(:),alpha,beta end subroutine psi_egthv subroutine psi_egthzmv(n,k,idx,x,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_epk_) :: x(:,:), y(:) end subroutine psi_egthzmv subroutine psi_egthzmm(n,k,idx,x,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_epk_) :: x(:,:), y(:,:) end subroutine psi_egthzmm subroutine psi_egthzv(n,idx,x,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_epk_) :: x(:), y(:) end subroutine psi_egthzv end interface psi_gth @@ -165,20 +170,23 @@ module psi_e_serial_mod subroutine psi_esctmm(n,k,idx,x,beta,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_epk_) :: beta, x(:,:), y(:,:) end subroutine psi_esctmm subroutine psi_esctmv(n,k,idx,x,beta,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_epk_) :: beta, x(:), y(:,:) end subroutine psi_esctmv subroutine psi_esctv(n,idx,x,beta,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_epk_) :: beta, x(:), y(:) end subroutine psi_esctv end interface psi_sct diff --git a/base/modules/auxil/psi_i2_serial_mod.f90 b/base/modules/auxil/psi_i2_serial_mod.f90 index 770d3256..57712a66 100644 --- a/base/modules/auxil/psi_i2_serial_mod.f90 +++ b/base/modules/auxil/psi_i2_serial_mod.f90 @@ -130,33 +130,38 @@ module psi_i2_serial_mod subroutine psi_i2gthmv(n,k,idx,alpha,x,beta,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_i2pk_) :: x(:,:), y(:),alpha,beta end subroutine psi_i2gthmv subroutine psi_i2gthv(n,idx,alpha,x,beta,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_i2pk_) :: x(:), y(:),alpha,beta end subroutine psi_i2gthv subroutine psi_i2gthzmv(n,k,idx,x,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_i2pk_) :: x(:,:), y(:) end subroutine psi_i2gthzmv subroutine psi_i2gthzmm(n,k,idx,x,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_i2pk_) :: x(:,:), y(:,:) end subroutine psi_i2gthzmm subroutine psi_i2gthzv(n,idx,x,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_i2pk_) :: x(:), y(:) end subroutine psi_i2gthzv end interface psi_gth @@ -165,20 +170,23 @@ module psi_i2_serial_mod subroutine psi_i2sctmm(n,k,idx,x,beta,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_i2pk_) :: beta, x(:,:), y(:,:) end subroutine psi_i2sctmm subroutine psi_i2sctmv(n,k,idx,x,beta,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_i2pk_) :: beta, x(:), y(:,:) end subroutine psi_i2sctmv subroutine psi_i2sctv(n,idx,x,beta,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_i2pk_) :: beta, x(:), y(:) end subroutine psi_i2sctv end interface psi_sct diff --git a/base/modules/auxil/psi_m_serial_mod.f90 b/base/modules/auxil/psi_m_serial_mod.f90 index 3583cccc..05a75bde 100644 --- a/base/modules/auxil/psi_m_serial_mod.f90 +++ b/base/modules/auxil/psi_m_serial_mod.f90 @@ -130,33 +130,38 @@ module psi_m_serial_mod subroutine psi_mgthmv(n,k,idx,alpha,x,beta,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_mpk_) :: x(:,:), y(:),alpha,beta end subroutine psi_mgthmv subroutine psi_mgthv(n,idx,alpha,x,beta,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_mpk_) :: x(:), y(:),alpha,beta end subroutine psi_mgthv subroutine psi_mgthzmv(n,k,idx,x,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_mpk_) :: x(:,:), y(:) end subroutine psi_mgthzmv subroutine psi_mgthzmm(n,k,idx,x,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_mpk_) :: x(:,:), y(:,:) end subroutine psi_mgthzmm subroutine psi_mgthzv(n,idx,x,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_mpk_) :: x(:), y(:) end subroutine psi_mgthzv end interface psi_gth @@ -165,20 +170,23 @@ module psi_m_serial_mod subroutine psi_msctmm(n,k,idx,x,beta,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_mpk_) :: beta, x(:,:), y(:,:) end subroutine psi_msctmm subroutine psi_msctmv(n,k,idx,x,beta,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_mpk_) :: beta, x(:), y(:,:) end subroutine psi_msctmv subroutine psi_msctv(n,idx,x,beta,y) import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_mpk_) :: beta, x(:), y(:) end subroutine psi_msctv end interface psi_sct diff --git a/base/modules/auxil/psi_s_serial_mod.f90 b/base/modules/auxil/psi_s_serial_mod.f90 index 3e0c6d91..95f536f3 100644 --- a/base/modules/auxil/psi_s_serial_mod.f90 +++ b/base/modules/auxil/psi_s_serial_mod.f90 @@ -128,64 +128,72 @@ module psi_s_serial_mod interface psi_gth subroutine psi_sgthmv(n,k,idx,alpha,x,beta,y) - import :: psb_ipk_, psb_spk_ + import :: psb_ipk_, psb_mpk_, psb_spk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: x(:,:), y(:),alpha,beta end subroutine psi_sgthmv subroutine psi_sgthv(n,idx,alpha,x,beta,y) - import :: psb_ipk_, psb_spk_ + import :: psb_ipk_, psb_mpk_, psb_spk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: x(:), y(:),alpha,beta end subroutine psi_sgthv subroutine psi_sgthzmv(n,k,idx,x,y) - import :: psb_ipk_, psb_spk_ + import :: psb_ipk_, psb_mpk_, psb_spk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: x(:,:), y(:) end subroutine psi_sgthzmv subroutine psi_sgthzmm(n,k,idx,x,y) - import :: psb_ipk_, psb_spk_ + import :: psb_ipk_, psb_mpk_, psb_spk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: x(:,:), y(:,:) end subroutine psi_sgthzmm subroutine psi_sgthzv(n,idx,x,y) - import :: psb_ipk_, psb_spk_ + import :: psb_ipk_, psb_mpk_, psb_spk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: x(:), y(:) end subroutine psi_sgthzv end interface psi_gth interface psi_sct subroutine psi_ssctmm(n,k,idx,x,beta,y) - import :: psb_ipk_, psb_spk_ + import :: psb_ipk_, psb_mpk_, psb_spk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: beta, x(:,:), y(:,:) end subroutine psi_ssctmm subroutine psi_ssctmv(n,k,idx,x,beta,y) - import :: psb_ipk_, psb_spk_ + import :: psb_ipk_, psb_mpk_, psb_spk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: beta, x(:), y(:,:) end subroutine psi_ssctmv subroutine psi_ssctv(n,idx,x,beta,y) - import :: psb_ipk_, psb_spk_ + import :: psb_ipk_, psb_mpk_, psb_spk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: beta, x(:), y(:) end subroutine psi_ssctv end interface psi_sct interface psi_exscan subroutine psi_s_exscanv(n,x,info,shift) - import :: psb_ipk_, psb_spk_ + import :: psb_ipk_, psb_mpk_, psb_spk_ implicit none integer(psb_ipk_), intent(in) :: n real(psb_spk_), intent (inout) :: x(:) diff --git a/base/modules/auxil/psi_z_serial_mod.f90 b/base/modules/auxil/psi_z_serial_mod.f90 index a8ea734e..c08a0fec 100644 --- a/base/modules/auxil/psi_z_serial_mod.f90 +++ b/base/modules/auxil/psi_z_serial_mod.f90 @@ -128,64 +128,72 @@ module psi_z_serial_mod interface psi_gth subroutine psi_zgthmv(n,k,idx,alpha,x,beta,y) - import :: psb_ipk_, psb_dpk_ + import :: psb_ipk_, psb_mpk_, psb_dpk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: x(:,:), y(:),alpha,beta end subroutine psi_zgthmv subroutine psi_zgthv(n,idx,alpha,x,beta,y) - import :: psb_ipk_, psb_dpk_ + import :: psb_ipk_, psb_mpk_, psb_dpk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: x(:), y(:),alpha,beta end subroutine psi_zgthv subroutine psi_zgthzmv(n,k,idx,x,y) - import :: psb_ipk_, psb_dpk_ + import :: psb_ipk_, psb_mpk_, psb_dpk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: x(:,:), y(:) end subroutine psi_zgthzmv subroutine psi_zgthzmm(n,k,idx,x,y) - import :: psb_ipk_, psb_dpk_ + import :: psb_ipk_, psb_mpk_, psb_dpk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: x(:,:), y(:,:) end subroutine psi_zgthzmm subroutine psi_zgthzv(n,idx,x,y) - import :: psb_ipk_, psb_dpk_ + import :: psb_ipk_, psb_mpk_, psb_dpk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: x(:), y(:) end subroutine psi_zgthzv end interface psi_gth interface psi_sct subroutine psi_zsctmm(n,k,idx,x,beta,y) - import :: psb_ipk_, psb_dpk_ + import :: psb_ipk_, psb_mpk_, psb_dpk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: beta, x(:,:), y(:,:) end subroutine psi_zsctmm subroutine psi_zsctmv(n,k,idx,x,beta,y) - import :: psb_ipk_, psb_dpk_ + import :: psb_ipk_, psb_mpk_, psb_dpk_ implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: beta, x(:), y(:,:) end subroutine psi_zsctmv subroutine psi_zsctv(n,idx,x,beta,y) - import :: psb_ipk_, psb_dpk_ + import :: psb_ipk_, psb_mpk_, psb_dpk_ implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: beta, x(:), y(:) end subroutine psi_zsctv end interface psi_sct interface psi_exscan subroutine psi_z_exscanv(n,x,info,shift) - import :: psb_ipk_, psb_dpk_ + import :: psb_ipk_, psb_mpk_, psb_dpk_ implicit none integer(psb_ipk_), intent(in) :: n complex(psb_dpk_), intent (inout) :: x(:) diff --git a/base/modules/comm/psi_c_comm_a_mod.f90 b/base/modules/comm/psi_c_comm_a_mod.f90 index 1277efdf..ce2da78d 100644 --- a/base/modules/comm/psi_c_comm_a_mod.f90 +++ b/base/modules/comm/psi_c_comm_a_mod.f90 @@ -36,7 +36,8 @@ module psi_c_comm_a_mod interface psi_swapdata subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data) import - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info complex(psb_spk_) :: y(:,:), beta complex(psb_spk_),target :: work(:) @@ -57,7 +58,8 @@ module psi_c_comm_a_mod import type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info complex(psb_spk_) :: y(:,:), beta complex(psb_spk_),target :: work(:) @@ -80,7 +82,8 @@ module psi_c_comm_a_mod interface psi_swaptran subroutine psi_cswaptranm(flag,n,beta,y,desc_a,work,info,data) import - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(in) :: flag + integer(psb_Mpk_), intent(in) :: n integer(psb_ipk_), intent(out) :: info complex(psb_spk_) :: y(:,:), beta complex(psb_spk_),target :: work(:) @@ -101,7 +104,8 @@ module psi_c_comm_a_mod import type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info complex(psb_spk_) :: y(:,:), beta complex(psb_spk_),target :: work(:) diff --git a/base/modules/comm/psi_d_comm_a_mod.f90 b/base/modules/comm/psi_d_comm_a_mod.f90 index e2b0aa87..b1dda3f8 100644 --- a/base/modules/comm/psi_d_comm_a_mod.f90 +++ b/base/modules/comm/psi_d_comm_a_mod.f90 @@ -36,7 +36,8 @@ module psi_d_comm_a_mod interface psi_swapdata subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data) import - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info real(psb_dpk_) :: y(:,:), beta real(psb_dpk_),target :: work(:) @@ -57,7 +58,8 @@ module psi_d_comm_a_mod import type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info real(psb_dpk_) :: y(:,:), beta real(psb_dpk_),target :: work(:) @@ -80,7 +82,8 @@ module psi_d_comm_a_mod interface psi_swaptran subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data) import - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(in) :: flag + integer(psb_Mpk_), intent(in) :: n integer(psb_ipk_), intent(out) :: info real(psb_dpk_) :: y(:,:), beta real(psb_dpk_),target :: work(:) @@ -101,7 +104,8 @@ module psi_d_comm_a_mod import type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info real(psb_dpk_) :: y(:,:), beta real(psb_dpk_),target :: work(:) diff --git a/base/modules/comm/psi_e_comm_a_mod.f90 b/base/modules/comm/psi_e_comm_a_mod.f90 index 8c0d48ff..4b6c5104 100644 --- a/base/modules/comm/psi_e_comm_a_mod.f90 +++ b/base/modules/comm/psi_e_comm_a_mod.f90 @@ -36,7 +36,8 @@ module psi_e_comm_a_mod interface psi_swapdata subroutine psi_eswapdatam(flag,n,beta,y,desc_a,work,info,data) import - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_epk_) :: y(:,:), beta integer(psb_epk_),target :: work(:) @@ -57,7 +58,8 @@ module psi_e_comm_a_mod import type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_epk_) :: y(:,:), beta integer(psb_epk_),target :: work(:) @@ -80,7 +82,8 @@ module psi_e_comm_a_mod interface psi_swaptran subroutine psi_eswaptranm(flag,n,beta,y,desc_a,work,info,data) import - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(in) :: flag + integer(psb_Mpk_), intent(in) :: n integer(psb_ipk_), intent(out) :: info integer(psb_epk_) :: y(:,:), beta integer(psb_epk_),target :: work(:) @@ -101,7 +104,8 @@ module psi_e_comm_a_mod import type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_epk_) :: y(:,:), beta integer(psb_epk_),target :: work(:) diff --git a/base/modules/comm/psi_i2_comm_a_mod.f90 b/base/modules/comm/psi_i2_comm_a_mod.f90 index 49f1af71..484c9824 100644 --- a/base/modules/comm/psi_i2_comm_a_mod.f90 +++ b/base/modules/comm/psi_i2_comm_a_mod.f90 @@ -36,7 +36,8 @@ module psi_i2_comm_a_mod interface psi_swapdata subroutine psi_i2swapdatam(flag,n,beta,y,desc_a,work,info,data) import - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_) :: y(:,:), beta integer(psb_i2pk_),target :: work(:) @@ -57,7 +58,8 @@ module psi_i2_comm_a_mod import type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_) :: y(:,:), beta integer(psb_i2pk_),target :: work(:) @@ -80,7 +82,8 @@ module psi_i2_comm_a_mod interface psi_swaptran subroutine psi_i2swaptranm(flag,n,beta,y,desc_a,work,info,data) import - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(in) :: flag + integer(psb_Mpk_), intent(in) :: n integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_) :: y(:,:), beta integer(psb_i2pk_),target :: work(:) @@ -101,7 +104,8 @@ module psi_i2_comm_a_mod import type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_) :: y(:,:), beta integer(psb_i2pk_),target :: work(:) diff --git a/base/modules/comm/psi_m_comm_a_mod.f90 b/base/modules/comm/psi_m_comm_a_mod.f90 index ca49efa5..825e1579 100644 --- a/base/modules/comm/psi_m_comm_a_mod.f90 +++ b/base/modules/comm/psi_m_comm_a_mod.f90 @@ -36,7 +36,8 @@ module psi_m_comm_a_mod interface psi_swapdata subroutine psi_mswapdatam(flag,n,beta,y,desc_a,work,info,data) import - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_mpk_) :: y(:,:), beta integer(psb_mpk_),target :: work(:) @@ -57,7 +58,8 @@ module psi_m_comm_a_mod import type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_mpk_) :: y(:,:), beta integer(psb_mpk_),target :: work(:) @@ -80,7 +82,8 @@ module psi_m_comm_a_mod interface psi_swaptran subroutine psi_mswaptranm(flag,n,beta,y,desc_a,work,info,data) import - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(in) :: flag + integer(psb_Mpk_), intent(in) :: n integer(psb_ipk_), intent(out) :: info integer(psb_mpk_) :: y(:,:), beta integer(psb_mpk_),target :: work(:) @@ -101,7 +104,8 @@ module psi_m_comm_a_mod import type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info integer(psb_mpk_) :: y(:,:), beta integer(psb_mpk_),target :: work(:) diff --git a/base/modules/comm/psi_s_comm_a_mod.f90 b/base/modules/comm/psi_s_comm_a_mod.f90 index f2d3ae79..10369b51 100644 --- a/base/modules/comm/psi_s_comm_a_mod.f90 +++ b/base/modules/comm/psi_s_comm_a_mod.f90 @@ -36,7 +36,8 @@ module psi_s_comm_a_mod interface psi_swapdata subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data) import - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info real(psb_spk_) :: y(:,:), beta real(psb_spk_),target :: work(:) @@ -57,7 +58,8 @@ module psi_s_comm_a_mod import type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info real(psb_spk_) :: y(:,:), beta real(psb_spk_),target :: work(:) @@ -80,7 +82,8 @@ module psi_s_comm_a_mod interface psi_swaptran subroutine psi_sswaptranm(flag,n,beta,y,desc_a,work,info,data) import - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(in) :: flag + integer(psb_Mpk_), intent(in) :: n integer(psb_ipk_), intent(out) :: info real(psb_spk_) :: y(:,:), beta real(psb_spk_),target :: work(:) @@ -101,7 +104,8 @@ module psi_s_comm_a_mod import type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info real(psb_spk_) :: y(:,:), beta real(psb_spk_),target :: work(:) diff --git a/base/modules/comm/psi_z_comm_a_mod.f90 b/base/modules/comm/psi_z_comm_a_mod.f90 index 16872677..9f7477a1 100644 --- a/base/modules/comm/psi_z_comm_a_mod.f90 +++ b/base/modules/comm/psi_z_comm_a_mod.f90 @@ -36,7 +36,8 @@ module psi_z_comm_a_mod interface psi_swapdata subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data) import - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info complex(psb_dpk_) :: y(:,:), beta complex(psb_dpk_),target :: work(:) @@ -57,7 +58,8 @@ module psi_z_comm_a_mod import type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info complex(psb_dpk_) :: y(:,:), beta complex(psb_dpk_),target :: work(:) @@ -80,7 +82,8 @@ module psi_z_comm_a_mod interface psi_swaptran subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data) import - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(in) :: flag + integer(psb_Mpk_), intent(in) :: n integer(psb_ipk_), intent(out) :: info complex(psb_dpk_) :: y(:,:), beta complex(psb_dpk_),target :: work(:) @@ -101,7 +104,8 @@ module psi_z_comm_a_mod import type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm - integer(psb_ipk_), intent(in) :: flag, n + integer(psb_mpk_), intent(in) :: n + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info complex(psb_dpk_) :: y(:,:), beta complex(psb_dpk_),target :: work(:) diff --git a/base/modules/penv/psi_c_collective_mod.F90 b/base/modules/penv/psi_c_collective_mod.F90 index 6457e81e..0e04fd5e 100644 --- a/base/modules/penv/psi_c_collective_mod.F90 +++ b/base/modules/penv/psi_c_collective_mod.F90 @@ -1221,8 +1221,8 @@ contains integer(psb_mpk_), intent(inout), optional :: request complex(psb_spk_), intent(inout) :: dat complex(psb_spk_) :: dat_ - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1256,6 +1256,7 @@ contains call mpi_wait(request,status,minfo) end if end if + info = minfo #endif end subroutine psb_cscan_sums @@ -1272,8 +1273,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request complex(psb_spk_) :: dat_ - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1308,6 +1309,7 @@ contains call mpi_wait(request,status,minfo) end if end if + info = minfo #else dat = czero #endif @@ -1326,8 +1328,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1356,11 +1358,12 @@ contains else if (collective_start) then call mpi_iscan(dat_,dat,size(dat),& - & psb_mpi_c_spk_,mpi_sum,icomm,request,info) + & psb_mpi_c_spk_,mpi_sum,icomm,request,minfo) else if (collective_end) then - call mpi_wait(request,status,info) + call mpi_wait(request,status,minfo) end if end if + info = minfo #endif end subroutine psb_cscan_sumv @@ -1377,8 +1380,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1408,12 +1411,12 @@ contains else if (collective_start) then call mpi_iexscan(dat_,dat,size(dat),& - & psb_mpi_c_spk_,mpi_sum,icomm,request,info) + & psb_mpi_c_spk_,mpi_sum,icomm,request,minfo) else if (collective_end) then - call mpi_wait(request,status,info) + call mpi_wait(request,status,minfo) end if end if - + info = minfo #else dat = czero #endif @@ -1428,7 +1431,9 @@ contains integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + integer(psb_ipk_) :: i,j,k, ipx, idx + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) @@ -1473,9 +1478,11 @@ contains integer(psb_ipk_), intent(out) :: info !Local variables - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_ipk_) :: i,j,k, ipx, idx, counter integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) @@ -1556,9 +1563,11 @@ contains integer(psb_ipk_), intent(out) :: info !Local variables - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_ipk_) :: i,j,k, ipx, idx, counter integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) diff --git a/base/modules/penv/psi_d_collective_mod.F90 b/base/modules/penv/psi_d_collective_mod.F90 index 7a0e7d9e..bf66dc47 100644 --- a/base/modules/penv/psi_d_collective_mod.F90 +++ b/base/modules/penv/psi_d_collective_mod.F90 @@ -1861,8 +1861,8 @@ contains integer(psb_mpk_), intent(inout), optional :: request real(psb_dpk_), intent(inout) :: dat real(psb_dpk_) :: dat_ - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1896,6 +1896,7 @@ contains call mpi_wait(request,status,minfo) end if end if + info = minfo #endif end subroutine psb_dscan_sums @@ -1912,8 +1913,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request real(psb_dpk_) :: dat_ - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1948,6 +1949,7 @@ contains call mpi_wait(request,status,minfo) end if end if + info = minfo #else dat = dzero #endif @@ -1966,8 +1968,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1996,11 +1998,12 @@ contains else if (collective_start) then call mpi_iscan(dat_,dat,size(dat),& - & psb_mpi_r_dpk_,mpi_sum,icomm,request,info) + & psb_mpi_r_dpk_,mpi_sum,icomm,request,minfo) else if (collective_end) then - call mpi_wait(request,status,info) + call mpi_wait(request,status,minfo) end if end if + info = minfo #endif end subroutine psb_dscan_sumv @@ -2017,8 +2020,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -2048,12 +2051,12 @@ contains else if (collective_start) then call mpi_iexscan(dat_,dat,size(dat),& - & psb_mpi_r_dpk_,mpi_sum,icomm,request,info) + & psb_mpi_r_dpk_,mpi_sum,icomm,request,minfo) else if (collective_end) then - call mpi_wait(request,status,info) + call mpi_wait(request,status,minfo) end if end if - + info = minfo #else dat = dzero #endif @@ -2068,7 +2071,9 @@ contains integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + integer(psb_ipk_) :: i,j,k, ipx, idx + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) @@ -2113,9 +2118,11 @@ contains integer(psb_ipk_), intent(out) :: info !Local variables - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_ipk_) :: i,j,k, ipx, idx, counter integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) @@ -2196,9 +2203,11 @@ contains integer(psb_ipk_), intent(out) :: info !Local variables - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_ipk_) :: i,j,k, ipx, idx, counter integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) diff --git a/base/modules/penv/psi_e_collective_mod.F90 b/base/modules/penv/psi_e_collective_mod.F90 index 5a6234d6..15c69864 100644 --- a/base/modules/penv/psi_e_collective_mod.F90 +++ b/base/modules/penv/psi_e_collective_mod.F90 @@ -1699,8 +1699,8 @@ contains integer(psb_mpk_), intent(inout), optional :: request integer(psb_epk_), intent(inout) :: dat integer(psb_epk_) :: dat_ - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1734,6 +1734,7 @@ contains call mpi_wait(request,status,minfo) end if end if + info = minfo #endif end subroutine psb_escan_sums @@ -1750,8 +1751,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request integer(psb_epk_) :: dat_ - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1786,6 +1787,7 @@ contains call mpi_wait(request,status,minfo) end if end if + info = minfo #else dat = ezero #endif @@ -1804,8 +1806,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1834,11 +1836,12 @@ contains else if (collective_start) then call mpi_iscan(dat_,dat,size(dat),& - & psb_mpi_epk_,mpi_sum,icomm,request,info) + & psb_mpi_epk_,mpi_sum,icomm,request,minfo) else if (collective_end) then - call mpi_wait(request,status,info) + call mpi_wait(request,status,minfo) end if end if + info = minfo #endif end subroutine psb_escan_sumv @@ -1855,8 +1858,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1886,12 +1889,12 @@ contains else if (collective_start) then call mpi_iexscan(dat_,dat,size(dat),& - & psb_mpi_epk_,mpi_sum,icomm,request,info) + & psb_mpi_epk_,mpi_sum,icomm,request,minfo) else if (collective_end) then - call mpi_wait(request,status,info) + call mpi_wait(request,status,minfo) end if end if - + info = minfo #else dat = ezero #endif @@ -1906,7 +1909,9 @@ contains integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + integer(psb_ipk_) :: i,j,k, ipx, idx + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) @@ -1951,9 +1956,11 @@ contains integer(psb_ipk_), intent(out) :: info !Local variables - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_ipk_) :: i,j,k, ipx, idx, counter integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) @@ -2034,9 +2041,11 @@ contains integer(psb_ipk_), intent(out) :: info !Local variables - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_ipk_) :: i,j,k, ipx, idx, counter integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) diff --git a/base/modules/penv/psi_i2_collective_mod.F90 b/base/modules/penv/psi_i2_collective_mod.F90 index 7f504b12..7ca2de15 100644 --- a/base/modules/penv/psi_i2_collective_mod.F90 +++ b/base/modules/penv/psi_i2_collective_mod.F90 @@ -1699,8 +1699,8 @@ contains integer(psb_mpk_), intent(inout), optional :: request integer(psb_i2pk_), intent(inout) :: dat integer(psb_i2pk_) :: dat_ - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1734,6 +1734,7 @@ contains call mpi_wait(request,status,minfo) end if end if + info = minfo #endif end subroutine psb_i2scan_sums @@ -1750,8 +1751,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request integer(psb_i2pk_) :: dat_ - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1786,6 +1787,7 @@ contains call mpi_wait(request,status,minfo) end if end if + info = minfo #else dat = i2zero #endif @@ -1804,8 +1806,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1834,11 +1836,12 @@ contains else if (collective_start) then call mpi_iscan(dat_,dat,size(dat),& - & psb_mpi_i2pk_,mpi_sum,icomm,request,info) + & psb_mpi_i2pk_,mpi_sum,icomm,request,minfo) else if (collective_end) then - call mpi_wait(request,status,info) + call mpi_wait(request,status,minfo) end if end if + info = minfo #endif end subroutine psb_i2scan_sumv @@ -1855,8 +1858,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1886,12 +1889,12 @@ contains else if (collective_start) then call mpi_iexscan(dat_,dat,size(dat),& - & psb_mpi_i2pk_,mpi_sum,icomm,request,info) + & psb_mpi_i2pk_,mpi_sum,icomm,request,minfo) else if (collective_end) then - call mpi_wait(request,status,info) + call mpi_wait(request,status,minfo) end if end if - + info = minfo #else dat = i2zero #endif @@ -1906,7 +1909,9 @@ contains integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + integer(psb_ipk_) :: i,j,k, ipx, idx + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) @@ -1951,9 +1956,11 @@ contains integer(psb_ipk_), intent(out) :: info !Local variables - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_ipk_) :: i,j,k, ipx, idx, counter integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) @@ -2034,9 +2041,11 @@ contains integer(psb_ipk_), intent(out) :: info !Local variables - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_ipk_) :: i,j,k, ipx, idx, counter integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) diff --git a/base/modules/penv/psi_m_collective_mod.F90 b/base/modules/penv/psi_m_collective_mod.F90 index a616587e..0e858c03 100644 --- a/base/modules/penv/psi_m_collective_mod.F90 +++ b/base/modules/penv/psi_m_collective_mod.F90 @@ -1699,8 +1699,8 @@ contains integer(psb_mpk_), intent(inout), optional :: request integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_) :: dat_ - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1734,6 +1734,7 @@ contains call mpi_wait(request,status,minfo) end if end if + info = minfo #endif end subroutine psb_mscan_sums @@ -1750,8 +1751,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request integer(psb_mpk_) :: dat_ - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1786,6 +1787,7 @@ contains call mpi_wait(request,status,minfo) end if end if + info = minfo #else dat = mzero #endif @@ -1804,8 +1806,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1834,11 +1836,12 @@ contains else if (collective_start) then call mpi_iscan(dat_,dat,size(dat),& - & psb_mpi_mpk_,mpi_sum,icomm,request,info) + & psb_mpi_mpk_,mpi_sum,icomm,request,minfo) else if (collective_end) then - call mpi_wait(request,status,info) + call mpi_wait(request,status,minfo) end if end if + info = minfo #endif end subroutine psb_mscan_sumv @@ -1855,8 +1858,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1886,12 +1889,12 @@ contains else if (collective_start) then call mpi_iexscan(dat_,dat,size(dat),& - & psb_mpi_mpk_,mpi_sum,icomm,request,info) + & psb_mpi_mpk_,mpi_sum,icomm,request,minfo) else if (collective_end) then - call mpi_wait(request,status,info) + call mpi_wait(request,status,minfo) end if end if - + info = minfo #else dat = mzero #endif @@ -1906,7 +1909,9 @@ contains integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + integer(psb_ipk_) :: i,j,k, ipx, idx + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) @@ -1951,9 +1956,11 @@ contains integer(psb_ipk_), intent(out) :: info !Local variables - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_ipk_) :: i,j,k, ipx, idx, counter integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) @@ -2034,9 +2041,11 @@ contains integer(psb_ipk_), intent(out) :: info !Local variables - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_ipk_) :: i,j,k, ipx, idx, counter integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) diff --git a/base/modules/penv/psi_penv_mod.F90 b/base/modules/penv/psi_penv_mod.F90 index 9a15c888..7091411d 100644 --- a/base/modules/penv/psi_penv_mod.F90 +++ b/base/modules/penv/psi_penv_mod.F90 @@ -263,7 +263,7 @@ module psi_penv_mod interface psb_info module procedure psb_info_mpik end interface -#if defined(PSB_IPK4) && defined(PSB_LPK8) +#if (defined(PSB_IPK4) && defined(PSB_LPK8))||defined(PSB_IPK8) interface psb_info module procedure psb_info_epk end interface @@ -918,7 +918,7 @@ contains end subroutine psi_register_mpi_extras -#if defined(PSB_IPK4) && defined(PSB_LPK8) +#if (defined(PSB_IPK4) && defined(PSB_LPK8))||defined(PSB_IPK8) subroutine psb_info_epk(ctxt,iam,np) type(psb_ctxt_type), intent(in) :: ctxt diff --git a/base/modules/penv/psi_s_collective_mod.F90 b/base/modules/penv/psi_s_collective_mod.F90 index 01e50408..9936395a 100644 --- a/base/modules/penv/psi_s_collective_mod.F90 +++ b/base/modules/penv/psi_s_collective_mod.F90 @@ -1861,8 +1861,8 @@ contains integer(psb_mpk_), intent(inout), optional :: request real(psb_spk_), intent(inout) :: dat real(psb_spk_) :: dat_ - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1896,6 +1896,7 @@ contains call mpi_wait(request,status,minfo) end if end if + info = minfo #endif end subroutine psb_sscan_sums @@ -1912,8 +1913,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request real(psb_spk_) :: dat_ - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1948,6 +1949,7 @@ contains call mpi_wait(request,status,minfo) end if end if + info = minfo #else dat = szero #endif @@ -1966,8 +1968,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1996,11 +1998,12 @@ contains else if (collective_start) then call mpi_iscan(dat_,dat,size(dat),& - & psb_mpi_r_spk_,mpi_sum,icomm,request,info) + & psb_mpi_r_spk_,mpi_sum,icomm,request,minfo) else if (collective_end) then - call mpi_wait(request,status,info) + call mpi_wait(request,status,minfo) end if end if + info = minfo #endif end subroutine psb_sscan_sumv @@ -2017,8 +2020,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -2048,12 +2051,12 @@ contains else if (collective_start) then call mpi_iexscan(dat_,dat,size(dat),& - & psb_mpi_r_spk_,mpi_sum,icomm,request,info) + & psb_mpi_r_spk_,mpi_sum,icomm,request,minfo) else if (collective_end) then - call mpi_wait(request,status,info) + call mpi_wait(request,status,minfo) end if end if - + info = minfo #else dat = szero #endif @@ -2068,7 +2071,9 @@ contains integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + integer(psb_ipk_) :: i,j,k, ipx, idx + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) @@ -2113,9 +2118,11 @@ contains integer(psb_ipk_), intent(out) :: info !Local variables - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_ipk_) :: i,j,k, ipx, idx, counter integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) @@ -2196,9 +2203,11 @@ contains integer(psb_ipk_), intent(out) :: info !Local variables - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_ipk_) :: i,j,k, ipx, idx, counter integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) diff --git a/base/modules/penv/psi_z_collective_mod.F90 b/base/modules/penv/psi_z_collective_mod.F90 index d4ef2802..de4e5bcc 100644 --- a/base/modules/penv/psi_z_collective_mod.F90 +++ b/base/modules/penv/psi_z_collective_mod.F90 @@ -1221,8 +1221,8 @@ contains integer(psb_mpk_), intent(inout), optional :: request complex(psb_dpk_), intent(inout) :: dat complex(psb_dpk_) :: dat_ - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1256,6 +1256,7 @@ contains call mpi_wait(request,status,minfo) end if end if + info = minfo #endif end subroutine psb_zscan_sums @@ -1272,8 +1273,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request complex(psb_dpk_) :: dat_ - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1308,6 +1309,7 @@ contains call mpi_wait(request,status,minfo) end if end if + info = minfo #else dat = zzero #endif @@ -1326,8 +1328,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1356,11 +1358,12 @@ contains else if (collective_start) then call mpi_iscan(dat_,dat,size(dat),& - & psb_mpi_c_dpk_,mpi_sum,icomm,request,info) + & psb_mpi_c_dpk_,mpi_sum,icomm,request,minfo) else if (collective_end) then - call mpi_wait(request,status,info) + call mpi_wait(request,status,minfo) end if end if + info = minfo #endif end subroutine psb_zscan_sumv @@ -1377,8 +1380,8 @@ contains integer(psb_ipk_), intent(in), optional :: mode integer(psb_mpk_), intent(inout), optional :: request - integer(psb_ipk_) :: iam, np, info - integer(psb_mpk_) :: minfo + integer(psb_ipk_) :: info + integer(psb_mpk_) :: iam, np, minfo integer(psb_mpk_) :: icomm integer(psb_mpk_) :: status(mpi_status_size) logical :: collective_start, collective_end, collective_sync @@ -1408,12 +1411,12 @@ contains else if (collective_start) then call mpi_iexscan(dat_,dat,size(dat),& - & psb_mpi_c_dpk_,mpi_sum,icomm,request,info) + & psb_mpi_c_dpk_,mpi_sum,icomm,request,minfo) else if (collective_end) then - call mpi_wait(request,status,info) + call mpi_wait(request,status,minfo) end if end if - + info = minfo #else dat = zzero #endif @@ -1428,7 +1431,9 @@ contains integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz + integer(psb_ipk_) :: i,j,k, ipx, idx + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) @@ -1473,9 +1478,11 @@ contains integer(psb_ipk_), intent(out) :: info !Local variables - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_ipk_) :: i,j,k, ipx, idx, counter integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) @@ -1556,9 +1563,11 @@ contains integer(psb_ipk_), intent(out) :: info !Local variables - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter + integer(psb_ipk_) :: i,j,k, ipx, idx, counter integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) + integer(psb_mpk_) :: ip, sz + integer(psb_mpk_) :: iam, np call psb_info(ctxt,iam,np) diff --git a/base/modules/psb_const_mod.F90 b/base/modules/psb_const_mod.F90 index b056d207..b4cacdca 100644 --- a/base/modules/psb_const_mod.F90 +++ b/base/modules/psb_const_mod.F90 @@ -155,7 +155,7 @@ module psb_const_mod integer(psb_i2pk_), parameter :: i2zero=0, i2one=1 integer(psb_i2pk_), parameter :: i2two=2, i2three=3, i2mone=-1 - integer(psb_ipk_), parameter :: psb_root_=0 + integer(psb_mpk_), parameter :: psb_root_=0 real(psb_spk_), parameter :: szero=0.0_psb_spk_, sone=1.0_psb_spk_ real(psb_dpk_), parameter :: dzero=0.0_psb_dpk_, done=1.0_psb_dpk_ complex(psb_spk_), parameter :: czero=(0.0_psb_spk_,0.0_psb_spk_) diff --git a/base/modules/psb_error_impl.F90 b/base/modules/psb_error_impl.F90 index adc84a3d..76a3c4fb 100644 --- a/base/modules/psb_error_impl.F90 +++ b/base/modules/psb_error_impl.F90 @@ -15,7 +15,7 @@ subroutine psb_errcomm_m(ctxt, err) use psb_error_mod, psb_protect_name => psb_errcomm use psb_penv_mod type(psb_ctxt_type), intent(in) :: ctxt - integer(psb_ipk_), intent(inout) :: err + integer(psb_mpk_), intent(inout) :: err if (psb_get_global_checks()) call psb_amx(ctxt, err) diff --git a/base/modules/psi_i_mod.F90 b/base/modules/psi_i_mod.F90 index e852dd99..881ae078 100644 --- a/base/modules/psi_i_mod.F90 +++ b/base/modules/psi_i_mod.F90 @@ -87,8 +87,8 @@ module psi_i_mod subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,ctxt,info) import implicit none - integer(psb_ipk_), intent(in) :: dl_ptr(0:) - integer(psb_ipk_), intent(inout) :: c_dep_list(:), l_dep_list(0:) + integer(psb_mpk_), intent(in) :: dl_ptr(0:), l_dep_list(0:) + integer(psb_ipk_), intent(inout) :: c_dep_list(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info end subroutine psi_i_csr_sort_dl @@ -98,8 +98,10 @@ module psi_i_mod subroutine psi_i_bld_glb_dep_list(ctxt,loc_dl,length_dl,c_dep_list,dl_ptr,info) import type(psb_ctxt_type), intent(in) :: ctxt - integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:) - integer(psb_ipk_), allocatable, intent(out) :: c_dep_list(:), dl_ptr(:) + integer(psb_ipk_), intent(in) :: loc_dl(:) + integer(psb_mpk_), intent(in) :: length_dl(0:) + integer(psb_mpk_), allocatable, intent(out) :: dl_ptr(:) + integer(psb_ipk_), allocatable, intent(out) :: c_dep_list(:) integer(psb_ipk_), intent(out) :: info end subroutine psi_i_bld_glb_dep_list end interface @@ -110,7 +112,8 @@ module psi_i_mod logical, intent(in) :: is_bld, is_upd type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(in) :: desc_str(:) - integer(psb_ipk_), allocatable, intent(out) :: loc_dl(:), length_dl(:) + integer(psb_ipk_), allocatable, intent(out) :: loc_dl(:) + integer(psb_mpk_), allocatable, intent(out) :: length_dl(:) integer(psb_ipk_), intent(out) :: info end subroutine psi_i_xtr_loc_dl end interface diff --git a/base/modules/serial/psb_c_base_vect_mod.F90 b/base/modules/serial/psb_c_base_vect_mod.F90 index eac61c75..ddb56976 100644 --- a/base/modules/serial/psb_c_base_vect_mod.F90 +++ b/base/modules/serial/psb_c_base_vect_mod.F90 @@ -1831,7 +1831,8 @@ contains subroutine c_base_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: alpha, beta, y(:) class(psb_c_base_vect_type) :: x @@ -1851,7 +1852,8 @@ contains subroutine c_base_gthzv_x(i,n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i,n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx complex(psb_spk_) :: y(:) class(psb_c_base_vect_type) :: x @@ -1867,7 +1869,8 @@ contains subroutine c_base_gthzbuf(i,n,idx,x) use psi_serial_mod implicit none - integer(psb_ipk_) :: i,n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx class(psb_c_base_vect_type) :: x @@ -1930,7 +1933,8 @@ contains subroutine c_base_gthzv(n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: y(:) class(psb_c_base_vect_type) :: x @@ -1955,7 +1959,8 @@ contains subroutine c_base_sctb(n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: beta, x(:) class(psb_c_base_vect_type) :: y @@ -1968,7 +1973,8 @@ contains subroutine c_base_sctb_x(i,n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx complex(psb_spk_) :: beta, x(:) class(psb_c_base_vect_type) :: y @@ -1982,7 +1988,8 @@ contains subroutine c_base_sctb_buf(i,n,idx,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx complex(psb_spk_) :: beta class(psb_c_base_vect_type) :: y @@ -3247,10 +3254,11 @@ contains subroutine c_base_mlv_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: alpha, beta, y(:) class(psb_c_base_multivect_type) :: x - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (x%is_dev()) call x%sync() if (.not.allocated(x%v)) then @@ -3272,7 +3280,8 @@ contains subroutine c_base_mlv_gthzv_x(i,n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx complex(psb_spk_) :: y(:) class(psb_c_base_multivect_type) :: x @@ -3294,10 +3303,11 @@ contains subroutine c_base_mlv_gthzv(n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: y(:) class(psb_c_base_multivect_type) :: x - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (x%is_dev()) call x%sync() if (.not.allocated(x%v)) then @@ -3320,10 +3330,11 @@ contains subroutine c_base_mlv_gthzm(n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: y(:,:) class(psb_c_base_multivect_type) :: x - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (x%is_dev()) call x%sync() if (.not.allocated(x%v)) then @@ -3341,7 +3352,8 @@ contains subroutine c_base_mlv_gthzbuf(i,ixb,n,idx,x) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, ixb, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i, ixb class(psb_i_base_vect_type) :: idx class(psb_c_base_multivect_type) :: x integer(psb_ipk_) :: nc @@ -3373,10 +3385,11 @@ contains subroutine c_base_mlv_sctb(n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: beta, x(:) class(psb_c_base_multivect_type) :: y - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (y%is_dev()) call y%sync() nc = psb_size(y%v,2_psb_ipk_) @@ -3388,10 +3401,11 @@ contains subroutine c_base_mlv_sctbr2(n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: beta, x(:,:) class(psb_c_base_multivect_type) :: y - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (y%is_dev()) call y%sync() nc = y%get_ncols() @@ -3403,7 +3417,8 @@ contains subroutine c_base_mlv_sctb_x(i,n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx complex( psb_spk_) :: beta, x(:) class(psb_c_base_multivect_type) :: y @@ -3415,7 +3430,8 @@ contains subroutine c_base_mlv_sctb_buf(i,iyb,n,idx,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, iyb, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i, iyb class(psb_i_base_vect_type) :: idx complex(psb_spk_) :: beta class(psb_c_base_multivect_type) :: y diff --git a/base/modules/serial/psb_c_vect_mod.F90 b/base/modules/serial/psb_c_vect_mod.F90 index 737ba26d..9effe9ef 100644 --- a/base/modules/serial/psb_c_vect_mod.F90 +++ b/base/modules/serial/psb_c_vect_mod.F90 @@ -491,7 +491,8 @@ contains subroutine c_vect_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: alpha, beta, y(:) class(psb_c_vect_type) :: x @@ -502,7 +503,8 @@ contains subroutine c_vect_gthzv(n,idx,x,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: y(:) class(psb_c_vect_type) :: x @@ -513,7 +515,8 @@ contains subroutine c_vect_sctb(n,idx,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: beta, x(:) class(psb_c_vect_type) :: y @@ -1649,7 +1652,8 @@ contains subroutine c_mvect_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: alpha, beta, y(:) class(psb_c_multivect_type) :: x @@ -1660,7 +1664,8 @@ contains subroutine c_mvect_gthzv(n,idx,x,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: y(:) class(psb_c_multivect_type) :: x @@ -1671,7 +1676,8 @@ contains subroutine c_mvect_gthzv_x(i,n,idx,x,y) use psi_serial_mod - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx complex(psb_spk_) :: y(:) class(psb_c_multivect_type) :: x @@ -1683,7 +1689,8 @@ contains subroutine c_mvect_sctb(n,idx,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: beta, x(:) class(psb_c_multivect_type) :: y @@ -1694,7 +1701,8 @@ contains subroutine c_mvect_sctb_x(i,n,idx,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx complex(psb_spk_) :: beta, x(:) class(psb_c_multivect_type) :: y diff --git a/base/modules/serial/psb_d_base_vect_mod.F90 b/base/modules/serial/psb_d_base_vect_mod.F90 index c7bd08a2..f8a14569 100644 --- a/base/modules/serial/psb_d_base_vect_mod.F90 +++ b/base/modules/serial/psb_d_base_vect_mod.F90 @@ -1918,7 +1918,8 @@ contains subroutine d_base_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: alpha, beta, y(:) class(psb_d_base_vect_type) :: x @@ -1938,7 +1939,8 @@ contains subroutine d_base_gthzv_x(i,n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i,n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx real(psb_dpk_) :: y(:) class(psb_d_base_vect_type) :: x @@ -1954,7 +1956,8 @@ contains subroutine d_base_gthzbuf(i,n,idx,x) use psi_serial_mod implicit none - integer(psb_ipk_) :: i,n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx class(psb_d_base_vect_type) :: x @@ -2017,7 +2020,8 @@ contains subroutine d_base_gthzv(n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: y(:) class(psb_d_base_vect_type) :: x @@ -2042,7 +2046,8 @@ contains subroutine d_base_sctb(n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: beta, x(:) class(psb_d_base_vect_type) :: y @@ -2055,7 +2060,8 @@ contains subroutine d_base_sctb_x(i,n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx real(psb_dpk_) :: beta, x(:) class(psb_d_base_vect_type) :: y @@ -2069,7 +2075,8 @@ contains subroutine d_base_sctb_buf(i,n,idx,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx real(psb_dpk_) :: beta class(psb_d_base_vect_type) :: y @@ -3426,10 +3433,11 @@ contains subroutine d_base_mlv_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: alpha, beta, y(:) class(psb_d_base_multivect_type) :: x - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (x%is_dev()) call x%sync() if (.not.allocated(x%v)) then @@ -3451,7 +3459,8 @@ contains subroutine d_base_mlv_gthzv_x(i,n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx real(psb_dpk_) :: y(:) class(psb_d_base_multivect_type) :: x @@ -3473,10 +3482,11 @@ contains subroutine d_base_mlv_gthzv(n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: y(:) class(psb_d_base_multivect_type) :: x - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (x%is_dev()) call x%sync() if (.not.allocated(x%v)) then @@ -3499,10 +3509,11 @@ contains subroutine d_base_mlv_gthzm(n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: y(:,:) class(psb_d_base_multivect_type) :: x - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (x%is_dev()) call x%sync() if (.not.allocated(x%v)) then @@ -3520,7 +3531,8 @@ contains subroutine d_base_mlv_gthzbuf(i,ixb,n,idx,x) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, ixb, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i, ixb class(psb_i_base_vect_type) :: idx class(psb_d_base_multivect_type) :: x integer(psb_ipk_) :: nc @@ -3552,10 +3564,11 @@ contains subroutine d_base_mlv_sctb(n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: beta, x(:) class(psb_d_base_multivect_type) :: y - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (y%is_dev()) call y%sync() nc = psb_size(y%v,2_psb_ipk_) @@ -3567,10 +3580,11 @@ contains subroutine d_base_mlv_sctbr2(n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: beta, x(:,:) class(psb_d_base_multivect_type) :: y - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (y%is_dev()) call y%sync() nc = y%get_ncols() @@ -3582,7 +3596,8 @@ contains subroutine d_base_mlv_sctb_x(i,n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx real( psb_dpk_) :: beta, x(:) class(psb_d_base_multivect_type) :: y @@ -3594,7 +3609,8 @@ contains subroutine d_base_mlv_sctb_buf(i,iyb,n,idx,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, iyb, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i, iyb class(psb_i_base_vect_type) :: idx real(psb_dpk_) :: beta class(psb_d_base_multivect_type) :: y diff --git a/base/modules/serial/psb_d_vect_mod.F90 b/base/modules/serial/psb_d_vect_mod.F90 index 2564c714..302e6fc1 100644 --- a/base/modules/serial/psb_d_vect_mod.F90 +++ b/base/modules/serial/psb_d_vect_mod.F90 @@ -498,7 +498,8 @@ contains subroutine d_vect_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: alpha, beta, y(:) class(psb_d_vect_type) :: x @@ -509,7 +510,8 @@ contains subroutine d_vect_gthzv(n,idx,x,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: y(:) class(psb_d_vect_type) :: x @@ -520,7 +522,8 @@ contains subroutine d_vect_sctb(n,idx,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: beta, x(:) class(psb_d_vect_type) :: y @@ -1728,7 +1731,8 @@ contains subroutine d_mvect_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: alpha, beta, y(:) class(psb_d_multivect_type) :: x @@ -1739,7 +1743,8 @@ contains subroutine d_mvect_gthzv(n,idx,x,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: y(:) class(psb_d_multivect_type) :: x @@ -1750,7 +1755,8 @@ contains subroutine d_mvect_gthzv_x(i,n,idx,x,y) use psi_serial_mod - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx real(psb_dpk_) :: y(:) class(psb_d_multivect_type) :: x @@ -1762,7 +1768,8 @@ contains subroutine d_mvect_sctb(n,idx,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: beta, x(:) class(psb_d_multivect_type) :: y @@ -1773,7 +1780,8 @@ contains subroutine d_mvect_sctb_x(i,n,idx,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx real(psb_dpk_) :: beta, x(:) class(psb_d_multivect_type) :: y diff --git a/base/modules/serial/psb_i_base_vect_mod.F90 b/base/modules/serial/psb_i_base_vect_mod.F90 index 466a9a0f..97a617a1 100644 --- a/base/modules/serial/psb_i_base_vect_mod.F90 +++ b/base/modules/serial/psb_i_base_vect_mod.F90 @@ -841,7 +841,8 @@ contains subroutine i_base_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_ipk_) :: alpha, beta, y(:) class(psb_i_base_vect_type) :: x @@ -861,7 +862,8 @@ contains subroutine i_base_gthzv_x(i,n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i,n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx integer(psb_ipk_) :: y(:) class(psb_i_base_vect_type) :: x @@ -877,7 +879,8 @@ contains subroutine i_base_gthzbuf(i,n,idx,x) use psi_serial_mod implicit none - integer(psb_ipk_) :: i,n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx class(psb_i_base_vect_type) :: x @@ -940,7 +943,8 @@ contains subroutine i_base_gthzv(n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_ipk_) :: y(:) class(psb_i_base_vect_type) :: x @@ -965,7 +969,8 @@ contains subroutine i_base_sctb(n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_ipk_) :: beta, x(:) class(psb_i_base_vect_type) :: y @@ -978,7 +983,8 @@ contains subroutine i_base_sctb_x(i,n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx integer(psb_ipk_) :: beta, x(:) class(psb_i_base_vect_type) :: y @@ -992,7 +998,8 @@ contains subroutine i_base_sctb_buf(i,n,idx,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx integer(psb_ipk_) :: beta class(psb_i_base_vect_type) :: y @@ -1690,10 +1697,11 @@ contains subroutine i_base_mlv_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_ipk_) :: alpha, beta, y(:) class(psb_i_base_multivect_type) :: x - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (x%is_dev()) call x%sync() if (.not.allocated(x%v)) then @@ -1715,7 +1723,8 @@ contains subroutine i_base_mlv_gthzv_x(i,n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx integer(psb_ipk_) :: y(:) class(psb_i_base_multivect_type) :: x @@ -1737,10 +1746,11 @@ contains subroutine i_base_mlv_gthzv(n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_ipk_) :: y(:) class(psb_i_base_multivect_type) :: x - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (x%is_dev()) call x%sync() if (.not.allocated(x%v)) then @@ -1763,10 +1773,11 @@ contains subroutine i_base_mlv_gthzm(n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_ipk_) :: y(:,:) class(psb_i_base_multivect_type) :: x - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (x%is_dev()) call x%sync() if (.not.allocated(x%v)) then @@ -1784,7 +1795,8 @@ contains subroutine i_base_mlv_gthzbuf(i,ixb,n,idx,x) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, ixb, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i, ixb class(psb_i_base_vect_type) :: idx class(psb_i_base_multivect_type) :: x integer(psb_ipk_) :: nc @@ -1816,10 +1828,11 @@ contains subroutine i_base_mlv_sctb(n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_ipk_) :: beta, x(:) class(psb_i_base_multivect_type) :: y - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (y%is_dev()) call y%sync() nc = psb_size(y%v,2_psb_ipk_) @@ -1831,10 +1844,11 @@ contains subroutine i_base_mlv_sctbr2(n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_ipk_) :: beta, x(:,:) class(psb_i_base_multivect_type) :: y - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (y%is_dev()) call y%sync() nc = y%get_ncols() @@ -1846,7 +1860,8 @@ contains subroutine i_base_mlv_sctb_x(i,n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx integer( psb_ipk_) :: beta, x(:) class(psb_i_base_multivect_type) :: y @@ -1858,7 +1873,8 @@ contains subroutine i_base_mlv_sctb_buf(i,iyb,n,idx,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, iyb, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i, iyb class(psb_i_base_vect_type) :: idx integer(psb_ipk_) :: beta class(psb_i_base_multivect_type) :: y diff --git a/base/modules/serial/psb_i_vect_mod.F90 b/base/modules/serial/psb_i_vect_mod.F90 index 0ff16c54..55ed7e9d 100644 --- a/base/modules/serial/psb_i_vect_mod.F90 +++ b/base/modules/serial/psb_i_vect_mod.F90 @@ -436,7 +436,8 @@ contains subroutine i_vect_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_ipk_) :: alpha, beta, y(:) class(psb_i_vect_type) :: x @@ -447,7 +448,8 @@ contains subroutine i_vect_gthzv(n,idx,x,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_ipk_) :: y(:) class(psb_i_vect_type) :: x @@ -458,7 +460,8 @@ contains subroutine i_vect_sctb(n,idx,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_ipk_) :: beta, x(:) class(psb_i_vect_type) :: y @@ -972,7 +975,8 @@ contains subroutine i_mvect_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_ipk_) :: alpha, beta, y(:) class(psb_i_multivect_type) :: x @@ -983,7 +987,8 @@ contains subroutine i_mvect_gthzv(n,idx,x,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_ipk_) :: y(:) class(psb_i_multivect_type) :: x @@ -994,7 +999,8 @@ contains subroutine i_mvect_gthzv_x(i,n,idx,x,y) use psi_serial_mod - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx integer(psb_ipk_) :: y(:) class(psb_i_multivect_type) :: x @@ -1006,7 +1012,8 @@ contains subroutine i_mvect_sctb(n,idx,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_ipk_) :: beta, x(:) class(psb_i_multivect_type) :: y @@ -1017,7 +1024,8 @@ contains subroutine i_mvect_sctb_x(i,n,idx,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx integer(psb_ipk_) :: beta, x(:) class(psb_i_multivect_type) :: y diff --git a/base/modules/serial/psb_l_base_vect_mod.F90 b/base/modules/serial/psb_l_base_vect_mod.F90 index 4c14e6d1..fbb59f95 100644 --- a/base/modules/serial/psb_l_base_vect_mod.F90 +++ b/base/modules/serial/psb_l_base_vect_mod.F90 @@ -842,7 +842,8 @@ contains subroutine l_base_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_lpk_) :: alpha, beta, y(:) class(psb_l_base_vect_type) :: x @@ -862,7 +863,8 @@ contains subroutine l_base_gthzv_x(i,n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i,n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx integer(psb_lpk_) :: y(:) class(psb_l_base_vect_type) :: x @@ -878,7 +880,8 @@ contains subroutine l_base_gthzbuf(i,n,idx,x) use psi_serial_mod implicit none - integer(psb_ipk_) :: i,n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx class(psb_l_base_vect_type) :: x @@ -941,7 +944,8 @@ contains subroutine l_base_gthzv(n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_lpk_) :: y(:) class(psb_l_base_vect_type) :: x @@ -966,7 +970,8 @@ contains subroutine l_base_sctb(n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_lpk_) :: beta, x(:) class(psb_l_base_vect_type) :: y @@ -979,7 +984,8 @@ contains subroutine l_base_sctb_x(i,n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx integer(psb_lpk_) :: beta, x(:) class(psb_l_base_vect_type) :: y @@ -993,7 +999,8 @@ contains subroutine l_base_sctb_buf(i,n,idx,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx integer(psb_lpk_) :: beta class(psb_l_base_vect_type) :: y @@ -1691,10 +1698,11 @@ contains subroutine l_base_mlv_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_lpk_) :: alpha, beta, y(:) class(psb_l_base_multivect_type) :: x - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (x%is_dev()) call x%sync() if (.not.allocated(x%v)) then @@ -1716,7 +1724,8 @@ contains subroutine l_base_mlv_gthzv_x(i,n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx integer(psb_lpk_) :: y(:) class(psb_l_base_multivect_type) :: x @@ -1738,10 +1747,11 @@ contains subroutine l_base_mlv_gthzv(n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_lpk_) :: y(:) class(psb_l_base_multivect_type) :: x - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (x%is_dev()) call x%sync() if (.not.allocated(x%v)) then @@ -1764,10 +1774,11 @@ contains subroutine l_base_mlv_gthzm(n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_lpk_) :: y(:,:) class(psb_l_base_multivect_type) :: x - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (x%is_dev()) call x%sync() if (.not.allocated(x%v)) then @@ -1785,7 +1796,8 @@ contains subroutine l_base_mlv_gthzbuf(i,ixb,n,idx,x) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, ixb, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i, ixb class(psb_i_base_vect_type) :: idx class(psb_l_base_multivect_type) :: x integer(psb_ipk_) :: nc @@ -1817,10 +1829,11 @@ contains subroutine l_base_mlv_sctb(n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_lpk_) :: beta, x(:) class(psb_l_base_multivect_type) :: y - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (y%is_dev()) call y%sync() nc = psb_size(y%v,2_psb_ipk_) @@ -1832,10 +1845,11 @@ contains subroutine l_base_mlv_sctbr2(n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_lpk_) :: beta, x(:,:) class(psb_l_base_multivect_type) :: y - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (y%is_dev()) call y%sync() nc = y%get_ncols() @@ -1847,7 +1861,8 @@ contains subroutine l_base_mlv_sctb_x(i,n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx integer( psb_lpk_) :: beta, x(:) class(psb_l_base_multivect_type) :: y @@ -1859,7 +1874,8 @@ contains subroutine l_base_mlv_sctb_buf(i,iyb,n,idx,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, iyb, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i, iyb class(psb_i_base_vect_type) :: idx integer(psb_lpk_) :: beta class(psb_l_base_multivect_type) :: y diff --git a/base/modules/serial/psb_l_vect_mod.F90 b/base/modules/serial/psb_l_vect_mod.F90 index 2490d7a2..6936e75f 100644 --- a/base/modules/serial/psb_l_vect_mod.F90 +++ b/base/modules/serial/psb_l_vect_mod.F90 @@ -437,7 +437,8 @@ contains subroutine l_vect_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_lpk_) :: alpha, beta, y(:) class(psb_l_vect_type) :: x @@ -448,7 +449,8 @@ contains subroutine l_vect_gthzv(n,idx,x,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_lpk_) :: y(:) class(psb_l_vect_type) :: x @@ -459,7 +461,8 @@ contains subroutine l_vect_sctb(n,idx,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_lpk_) :: beta, x(:) class(psb_l_vect_type) :: y @@ -973,7 +976,8 @@ contains subroutine l_mvect_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_lpk_) :: alpha, beta, y(:) class(psb_l_multivect_type) :: x @@ -984,7 +988,8 @@ contains subroutine l_mvect_gthzv(n,idx,x,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_lpk_) :: y(:) class(psb_l_multivect_type) :: x @@ -995,7 +1000,8 @@ contains subroutine l_mvect_gthzv_x(i,n,idx,x,y) use psi_serial_mod - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx integer(psb_lpk_) :: y(:) class(psb_l_multivect_type) :: x @@ -1007,7 +1013,8 @@ contains subroutine l_mvect_sctb(n,idx,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_lpk_) :: beta, x(:) class(psb_l_multivect_type) :: y @@ -1018,7 +1025,8 @@ contains subroutine l_mvect_sctb_x(i,n,idx,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx integer(psb_lpk_) :: beta, x(:) class(psb_l_multivect_type) :: y diff --git a/base/modules/serial/psb_s_base_vect_mod.F90 b/base/modules/serial/psb_s_base_vect_mod.F90 index 2d1b03b7..b0ee9988 100644 --- a/base/modules/serial/psb_s_base_vect_mod.F90 +++ b/base/modules/serial/psb_s_base_vect_mod.F90 @@ -1918,7 +1918,8 @@ contains subroutine s_base_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: alpha, beta, y(:) class(psb_s_base_vect_type) :: x @@ -1938,7 +1939,8 @@ contains subroutine s_base_gthzv_x(i,n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i,n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx real(psb_spk_) :: y(:) class(psb_s_base_vect_type) :: x @@ -1954,7 +1956,8 @@ contains subroutine s_base_gthzbuf(i,n,idx,x) use psi_serial_mod implicit none - integer(psb_ipk_) :: i,n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx class(psb_s_base_vect_type) :: x @@ -2017,7 +2020,8 @@ contains subroutine s_base_gthzv(n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: y(:) class(psb_s_base_vect_type) :: x @@ -2042,7 +2046,8 @@ contains subroutine s_base_sctb(n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: beta, x(:) class(psb_s_base_vect_type) :: y @@ -2055,7 +2060,8 @@ contains subroutine s_base_sctb_x(i,n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx real(psb_spk_) :: beta, x(:) class(psb_s_base_vect_type) :: y @@ -2069,7 +2075,8 @@ contains subroutine s_base_sctb_buf(i,n,idx,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx real(psb_spk_) :: beta class(psb_s_base_vect_type) :: y @@ -3426,10 +3433,11 @@ contains subroutine s_base_mlv_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: alpha, beta, y(:) class(psb_s_base_multivect_type) :: x - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (x%is_dev()) call x%sync() if (.not.allocated(x%v)) then @@ -3451,7 +3459,8 @@ contains subroutine s_base_mlv_gthzv_x(i,n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx real(psb_spk_) :: y(:) class(psb_s_base_multivect_type) :: x @@ -3473,10 +3482,11 @@ contains subroutine s_base_mlv_gthzv(n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: y(:) class(psb_s_base_multivect_type) :: x - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (x%is_dev()) call x%sync() if (.not.allocated(x%v)) then @@ -3499,10 +3509,11 @@ contains subroutine s_base_mlv_gthzm(n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: y(:,:) class(psb_s_base_multivect_type) :: x - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (x%is_dev()) call x%sync() if (.not.allocated(x%v)) then @@ -3520,7 +3531,8 @@ contains subroutine s_base_mlv_gthzbuf(i,ixb,n,idx,x) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, ixb, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i, ixb class(psb_i_base_vect_type) :: idx class(psb_s_base_multivect_type) :: x integer(psb_ipk_) :: nc @@ -3552,10 +3564,11 @@ contains subroutine s_base_mlv_sctb(n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: beta, x(:) class(psb_s_base_multivect_type) :: y - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (y%is_dev()) call y%sync() nc = psb_size(y%v,2_psb_ipk_) @@ -3567,10 +3580,11 @@ contains subroutine s_base_mlv_sctbr2(n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: beta, x(:,:) class(psb_s_base_multivect_type) :: y - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (y%is_dev()) call y%sync() nc = y%get_ncols() @@ -3582,7 +3596,8 @@ contains subroutine s_base_mlv_sctb_x(i,n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx real( psb_spk_) :: beta, x(:) class(psb_s_base_multivect_type) :: y @@ -3594,7 +3609,8 @@ contains subroutine s_base_mlv_sctb_buf(i,iyb,n,idx,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, iyb, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i, iyb class(psb_i_base_vect_type) :: idx real(psb_spk_) :: beta class(psb_s_base_multivect_type) :: y diff --git a/base/modules/serial/psb_s_vect_mod.F90 b/base/modules/serial/psb_s_vect_mod.F90 index 259081a6..3e27495a 100644 --- a/base/modules/serial/psb_s_vect_mod.F90 +++ b/base/modules/serial/psb_s_vect_mod.F90 @@ -498,7 +498,8 @@ contains subroutine s_vect_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: alpha, beta, y(:) class(psb_s_vect_type) :: x @@ -509,7 +510,8 @@ contains subroutine s_vect_gthzv(n,idx,x,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: y(:) class(psb_s_vect_type) :: x @@ -520,7 +522,8 @@ contains subroutine s_vect_sctb(n,idx,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: beta, x(:) class(psb_s_vect_type) :: y @@ -1728,7 +1731,8 @@ contains subroutine s_mvect_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: alpha, beta, y(:) class(psb_s_multivect_type) :: x @@ -1739,7 +1743,8 @@ contains subroutine s_mvect_gthzv(n,idx,x,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: y(:) class(psb_s_multivect_type) :: x @@ -1750,7 +1755,8 @@ contains subroutine s_mvect_gthzv_x(i,n,idx,x,y) use psi_serial_mod - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx real(psb_spk_) :: y(:) class(psb_s_multivect_type) :: x @@ -1762,7 +1768,8 @@ contains subroutine s_mvect_sctb(n,idx,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: beta, x(:) class(psb_s_multivect_type) :: y @@ -1773,7 +1780,8 @@ contains subroutine s_mvect_sctb_x(i,n,idx,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx real(psb_spk_) :: beta, x(:) class(psb_s_multivect_type) :: y diff --git a/base/modules/serial/psb_z_base_vect_mod.F90 b/base/modules/serial/psb_z_base_vect_mod.F90 index 5a55cdc6..ce3b6094 100644 --- a/base/modules/serial/psb_z_base_vect_mod.F90 +++ b/base/modules/serial/psb_z_base_vect_mod.F90 @@ -1831,7 +1831,8 @@ contains subroutine z_base_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: alpha, beta, y(:) class(psb_z_base_vect_type) :: x @@ -1851,7 +1852,8 @@ contains subroutine z_base_gthzv_x(i,n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i,n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx complex(psb_dpk_) :: y(:) class(psb_z_base_vect_type) :: x @@ -1867,7 +1869,8 @@ contains subroutine z_base_gthzbuf(i,n,idx,x) use psi_serial_mod implicit none - integer(psb_ipk_) :: i,n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx class(psb_z_base_vect_type) :: x @@ -1930,7 +1933,8 @@ contains subroutine z_base_gthzv(n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: y(:) class(psb_z_base_vect_type) :: x @@ -1955,7 +1959,8 @@ contains subroutine z_base_sctb(n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: beta, x(:) class(psb_z_base_vect_type) :: y @@ -1968,7 +1973,8 @@ contains subroutine z_base_sctb_x(i,n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx complex(psb_dpk_) :: beta, x(:) class(psb_z_base_vect_type) :: y @@ -1982,7 +1988,8 @@ contains subroutine z_base_sctb_buf(i,n,idx,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx complex(psb_dpk_) :: beta class(psb_z_base_vect_type) :: y @@ -3247,10 +3254,11 @@ contains subroutine z_base_mlv_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: alpha, beta, y(:) class(psb_z_base_multivect_type) :: x - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (x%is_dev()) call x%sync() if (.not.allocated(x%v)) then @@ -3272,7 +3280,8 @@ contains subroutine z_base_mlv_gthzv_x(i,n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx complex(psb_dpk_) :: y(:) class(psb_z_base_multivect_type) :: x @@ -3294,10 +3303,11 @@ contains subroutine z_base_mlv_gthzv(n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: y(:) class(psb_z_base_multivect_type) :: x - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (x%is_dev()) call x%sync() if (.not.allocated(x%v)) then @@ -3320,10 +3330,11 @@ contains subroutine z_base_mlv_gthzm(n,idx,x,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: y(:,:) class(psb_z_base_multivect_type) :: x - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (x%is_dev()) call x%sync() if (.not.allocated(x%v)) then @@ -3341,7 +3352,8 @@ contains subroutine z_base_mlv_gthzbuf(i,ixb,n,idx,x) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, ixb, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i, ixb class(psb_i_base_vect_type) :: idx class(psb_z_base_multivect_type) :: x integer(psb_ipk_) :: nc @@ -3373,10 +3385,11 @@ contains subroutine z_base_mlv_sctb(n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: beta, x(:) class(psb_z_base_multivect_type) :: y - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (y%is_dev()) call y%sync() nc = psb_size(y%v,2_psb_ipk_) @@ -3388,10 +3401,11 @@ contains subroutine z_base_mlv_sctbr2(n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: beta, x(:,:) class(psb_z_base_multivect_type) :: y - integer(psb_ipk_) :: nc + integer(psb_mpk_) :: nc if (y%is_dev()) call y%sync() nc = y%get_ncols() @@ -3403,7 +3417,8 @@ contains subroutine z_base_mlv_sctb_x(i,n,idx,x,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx complex( psb_dpk_) :: beta, x(:) class(psb_z_base_multivect_type) :: y @@ -3415,7 +3430,8 @@ contains subroutine z_base_mlv_sctb_buf(i,iyb,n,idx,beta,y) use psi_serial_mod implicit none - integer(psb_ipk_) :: i, iyb, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i, iyb class(psb_i_base_vect_type) :: idx complex(psb_dpk_) :: beta class(psb_z_base_multivect_type) :: y diff --git a/base/modules/serial/psb_z_vect_mod.F90 b/base/modules/serial/psb_z_vect_mod.F90 index 5342cc74..79606f3b 100644 --- a/base/modules/serial/psb_z_vect_mod.F90 +++ b/base/modules/serial/psb_z_vect_mod.F90 @@ -491,7 +491,8 @@ contains subroutine z_vect_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: alpha, beta, y(:) class(psb_z_vect_type) :: x @@ -502,7 +503,8 @@ contains subroutine z_vect_gthzv(n,idx,x,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: y(:) class(psb_z_vect_type) :: x @@ -513,7 +515,8 @@ contains subroutine z_vect_sctb(n,idx,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: beta, x(:) class(psb_z_vect_type) :: y @@ -1649,7 +1652,8 @@ contains subroutine z_mvect_gthab(n,idx,alpha,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: alpha, beta, y(:) class(psb_z_multivect_type) :: x @@ -1660,7 +1664,8 @@ contains subroutine z_mvect_gthzv(n,idx,x,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: y(:) class(psb_z_multivect_type) :: x @@ -1671,7 +1676,8 @@ contains subroutine z_mvect_gthzv_x(i,n,idx,x,y) use psi_serial_mod - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx complex(psb_dpk_) :: y(:) class(psb_z_multivect_type) :: x @@ -1683,7 +1689,8 @@ contains subroutine z_mvect_sctb(n,idx,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: beta, x(:) class(psb_z_multivect_type) :: y @@ -1694,7 +1701,8 @@ contains subroutine z_mvect_sctb_x(i,n,idx,x,beta,y) use psi_serial_mod - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx complex(psb_dpk_) :: beta, x(:) class(psb_z_multivect_type) :: y diff --git a/base/psblas/psb_cspmm.f90 b/base/psblas/psb_cspmm.f90 index 69f315ea..777ade06 100644 --- a/base/psblas/psb_cspmm.f90 +++ b/base/psblas/psb_cspmm.f90 @@ -359,9 +359,9 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,& ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me,& - & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & - & liwork, iiy, jjy, i, ib, ib1, ip, idx, ik + integer(psb_mpk_) :: np, me, ib1, ik + integer(psb_ipk_) :: err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & + & liwork, iiy, jjy, i, ib, ip, idx integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik integer(psb_ipk_), parameter :: nb=4 complex(psb_spk_), pointer :: xp(:,:), yp(:,:), iwork(:) @@ -707,9 +707,9 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,& ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me,& - & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & - & liwork, iiy, jjy, ib, ip, idx, ik + integer(psb_mpk_) :: np, me, ik + integer(psb_ipk_) :: err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & + & liwork, iiy, jjy, ib, ip, idx integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik, jx, jy integer(psb_ipk_), parameter :: nb=4 complex(psb_spk_), pointer :: iwork(:), xp(:), yp(:) diff --git a/base/psblas/psb_cspsm.f90 b/base/psblas/psb_cspsm.f90 index 3b948ea0..9787b2d8 100644 --- a/base/psblas/psb_cspsm.f90 +++ b/base/psblas/psb_cspsm.f90 @@ -291,9 +291,9 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,& ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me,& - & err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& - & ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm + integer(psb_mpk_) :: np, me, ik + integer(psb_ipk_) :: err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& + & i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik character :: lscale diff --git a/base/psblas/psb_dspmm.f90 b/base/psblas/psb_dspmm.f90 index 717133fa..ca7e7c56 100644 --- a/base/psblas/psb_dspmm.f90 +++ b/base/psblas/psb_dspmm.f90 @@ -359,9 +359,9 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me,& - & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & - & liwork, iiy, jjy, i, ib, ib1, ip, idx, ik + integer(psb_mpk_) :: np, me, ib1, ik + integer(psb_ipk_) :: err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & + & liwork, iiy, jjy, i, ib, ip, idx integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik integer(psb_ipk_), parameter :: nb=4 real(psb_dpk_), pointer :: xp(:,:), yp(:,:), iwork(:) @@ -707,9 +707,9 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me,& - & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & - & liwork, iiy, jjy, ib, ip, idx, ik + integer(psb_mpk_) :: np, me, ik + integer(psb_ipk_) :: err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & + & liwork, iiy, jjy, ib, ip, idx integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik, jx, jy integer(psb_ipk_), parameter :: nb=4 real(psb_dpk_), pointer :: iwork(:), xp(:), yp(:) diff --git a/base/psblas/psb_dspsm.f90 b/base/psblas/psb_dspsm.f90 index 2b0774d9..e4010b01 100644 --- a/base/psblas/psb_dspsm.f90 +++ b/base/psblas/psb_dspsm.f90 @@ -291,9 +291,9 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,& ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me,& - & err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& - & ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm + integer(psb_mpk_) :: np, me, ik + integer(psb_ipk_) :: err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& + & i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik character :: lscale diff --git a/base/psblas/psb_sspmm.f90 b/base/psblas/psb_sspmm.f90 index 0e432054..7f680934 100644 --- a/base/psblas/psb_sspmm.f90 +++ b/base/psblas/psb_sspmm.f90 @@ -359,9 +359,9 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,& ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me,& - & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & - & liwork, iiy, jjy, i, ib, ib1, ip, idx, ik + integer(psb_mpk_) :: np, me, ib1, ik + integer(psb_ipk_) :: err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & + & liwork, iiy, jjy, i, ib, ip, idx integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik integer(psb_ipk_), parameter :: nb=4 real(psb_spk_), pointer :: xp(:,:), yp(:,:), iwork(:) @@ -707,9 +707,9 @@ subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,& ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me,& - & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & - & liwork, iiy, jjy, ib, ip, idx, ik + integer(psb_mpk_) :: np, me, ik + integer(psb_ipk_) :: err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & + & liwork, iiy, jjy, ib, ip, idx integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik, jx, jy integer(psb_ipk_), parameter :: nb=4 real(psb_spk_), pointer :: iwork(:), xp(:), yp(:) diff --git a/base/psblas/psb_sspsm.f90 b/base/psblas/psb_sspsm.f90 index 4c23cdba..c354569b 100644 --- a/base/psblas/psb_sspsm.f90 +++ b/base/psblas/psb_sspsm.f90 @@ -291,9 +291,9 @@ subroutine psb_sspsm(alpha,a,x,beta,y,desc_a,info,& ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me,& - & err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& - & ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm + integer(psb_mpk_) :: np, me, ik + integer(psb_ipk_) :: err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& + & i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik character :: lscale diff --git a/base/psblas/psb_zspmm.f90 b/base/psblas/psb_zspmm.f90 index 23766b52..b7fc5cc6 100644 --- a/base/psblas/psb_zspmm.f90 +++ b/base/psblas/psb_zspmm.f90 @@ -359,9 +359,9 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me,& - & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & - & liwork, iiy, jjy, i, ib, ib1, ip, idx, ik + integer(psb_mpk_) :: np, me, ib1, ik + integer(psb_ipk_) :: err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & + & liwork, iiy, jjy, i, ib, ip, idx integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik integer(psb_ipk_), parameter :: nb=4 complex(psb_dpk_), pointer :: xp(:,:), yp(:,:), iwork(:) @@ -707,9 +707,9 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me,& - & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & - & liwork, iiy, jjy, ib, ip, idx, ik + integer(psb_mpk_) :: np, me, ik + integer(psb_ipk_) :: err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & + & liwork, iiy, jjy, ib, ip, idx integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik, jx, jy integer(psb_ipk_), parameter :: nb=4 complex(psb_dpk_), pointer :: iwork(:), xp(:), yp(:) diff --git a/base/psblas/psb_zspsm.f90 b/base/psblas/psb_zspsm.f90 index c42408da..3cb06b02 100644 --- a/base/psblas/psb_zspsm.f90 +++ b/base/psblas/psb_zspsm.f90 @@ -291,9 +291,9 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,& ! locals type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: np, me,& - & err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& - & ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm + integer(psb_mpk_) :: np, me, ik + integer(psb_ipk_) :: err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& + & i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik character :: lscale diff --git a/base/serial/psi_c_serial_impl.F90 b/base/serial/psi_c_serial_impl.F90 index a5290da4..d6706c88 100644 --- a/base/serial/psi_c_serial_impl.F90 +++ b/base/serial/psi_c_serial_impl.F90 @@ -910,7 +910,8 @@ subroutine psi_cgthmv(n,k,idx,alpha,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: x(:,:), y(:),alpha,beta ! Locals @@ -995,7 +996,8 @@ subroutine psi_cgthv(n,idx,alpha,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: x(:), y(:),alpha,beta ! Locals @@ -1051,7 +1053,8 @@ subroutine psi_cgthzmm(n,k,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: x(:,:), y(:,:) ! Locals @@ -1069,7 +1072,8 @@ subroutine psi_cgthzmv(n,k,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: x(:,:), y(:) ! Locals @@ -1090,7 +1094,8 @@ subroutine psi_cgthzv(n,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: x(:), y(:) ! Locals @@ -1107,7 +1112,8 @@ subroutine psi_csctmm(n,k,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: beta, x(:,:), y(:,:) ! Locals @@ -1133,7 +1139,8 @@ subroutine psi_csctmv(n,k,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: beta, x(:), y(:,:) ! Locals @@ -1171,7 +1178,8 @@ subroutine psi_csctv(n,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: beta, x(:), y(:) ! Locals diff --git a/base/serial/psi_d_serial_impl.F90 b/base/serial/psi_d_serial_impl.F90 index bbc7acec..772f28ea 100644 --- a/base/serial/psi_d_serial_impl.F90 +++ b/base/serial/psi_d_serial_impl.F90 @@ -910,7 +910,8 @@ subroutine psi_dgthmv(n,k,idx,alpha,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: x(:,:), y(:),alpha,beta ! Locals @@ -995,7 +996,8 @@ subroutine psi_dgthv(n,idx,alpha,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: x(:), y(:),alpha,beta ! Locals @@ -1051,7 +1053,8 @@ subroutine psi_dgthzmm(n,k,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: x(:,:), y(:,:) ! Locals @@ -1069,7 +1072,8 @@ subroutine psi_dgthzmv(n,k,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: x(:,:), y(:) ! Locals @@ -1090,7 +1094,8 @@ subroutine psi_dgthzv(n,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: x(:), y(:) ! Locals @@ -1107,7 +1112,8 @@ subroutine psi_dsctmm(n,k,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: beta, x(:,:), y(:,:) ! Locals @@ -1133,7 +1139,8 @@ subroutine psi_dsctmv(n,k,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: beta, x(:), y(:,:) ! Locals @@ -1171,7 +1178,8 @@ subroutine psi_dsctv(n,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: beta, x(:), y(:) ! Locals diff --git a/base/serial/psi_e_serial_impl.F90 b/base/serial/psi_e_serial_impl.F90 index 882372c0..10ea49cf 100644 --- a/base/serial/psi_e_serial_impl.F90 +++ b/base/serial/psi_e_serial_impl.F90 @@ -910,7 +910,8 @@ subroutine psi_egthmv(n,k,idx,alpha,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_epk_) :: x(:,:), y(:),alpha,beta ! Locals @@ -995,7 +996,8 @@ subroutine psi_egthv(n,idx,alpha,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_epk_) :: x(:), y(:),alpha,beta ! Locals @@ -1051,7 +1053,8 @@ subroutine psi_egthzmm(n,k,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_epk_) :: x(:,:), y(:,:) ! Locals @@ -1069,7 +1072,8 @@ subroutine psi_egthzmv(n,k,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_epk_) :: x(:,:), y(:) ! Locals @@ -1090,7 +1094,8 @@ subroutine psi_egthzv(n,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_epk_) :: x(:), y(:) ! Locals @@ -1107,7 +1112,8 @@ subroutine psi_esctmm(n,k,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_epk_) :: beta, x(:,:), y(:,:) ! Locals @@ -1133,7 +1139,8 @@ subroutine psi_esctmv(n,k,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_epk_) :: beta, x(:), y(:,:) ! Locals @@ -1171,7 +1178,8 @@ subroutine psi_esctv(n,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_epk_) :: beta, x(:), y(:) ! Locals diff --git a/base/serial/psi_i2_serial_impl.F90 b/base/serial/psi_i2_serial_impl.F90 index 8f1d0332..ae6ee65a 100644 --- a/base/serial/psi_i2_serial_impl.F90 +++ b/base/serial/psi_i2_serial_impl.F90 @@ -910,7 +910,8 @@ subroutine psi_i2gthmv(n,k,idx,alpha,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_i2pk_) :: x(:,:), y(:),alpha,beta ! Locals @@ -995,7 +996,8 @@ subroutine psi_i2gthv(n,idx,alpha,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_i2pk_) :: x(:), y(:),alpha,beta ! Locals @@ -1051,7 +1053,8 @@ subroutine psi_i2gthzmm(n,k,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_i2pk_) :: x(:,:), y(:,:) ! Locals @@ -1069,7 +1072,8 @@ subroutine psi_i2gthzmv(n,k,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_i2pk_) :: x(:,:), y(:) ! Locals @@ -1090,7 +1094,8 @@ subroutine psi_i2gthzv(n,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_i2pk_) :: x(:), y(:) ! Locals @@ -1107,7 +1112,8 @@ subroutine psi_i2sctmm(n,k,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_i2pk_) :: beta, x(:,:), y(:,:) ! Locals @@ -1133,7 +1139,8 @@ subroutine psi_i2sctmv(n,k,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_i2pk_) :: beta, x(:), y(:,:) ! Locals @@ -1171,7 +1178,8 @@ subroutine psi_i2sctv(n,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_i2pk_) :: beta, x(:), y(:) ! Locals diff --git a/base/serial/psi_m_serial_impl.F90 b/base/serial/psi_m_serial_impl.F90 index aff8745c..25eaca32 100644 --- a/base/serial/psi_m_serial_impl.F90 +++ b/base/serial/psi_m_serial_impl.F90 @@ -910,7 +910,8 @@ subroutine psi_mgthmv(n,k,idx,alpha,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_mpk_) :: x(:,:), y(:),alpha,beta ! Locals @@ -995,7 +996,8 @@ subroutine psi_mgthv(n,idx,alpha,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_mpk_) :: x(:), y(:),alpha,beta ! Locals @@ -1051,7 +1053,8 @@ subroutine psi_mgthzmm(n,k,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_mpk_) :: x(:,:), y(:,:) ! Locals @@ -1069,7 +1072,8 @@ subroutine psi_mgthzmv(n,k,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_mpk_) :: x(:,:), y(:) ! Locals @@ -1090,7 +1094,8 @@ subroutine psi_mgthzv(n,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_mpk_) :: x(:), y(:) ! Locals @@ -1107,7 +1112,8 @@ subroutine psi_msctmm(n,k,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_mpk_) :: beta, x(:,:), y(:,:) ! Locals @@ -1133,7 +1139,8 @@ subroutine psi_msctmv(n,k,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) integer(psb_mpk_) :: beta, x(:), y(:,:) ! Locals @@ -1171,7 +1178,8 @@ subroutine psi_msctv(n,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_mpk_) :: beta, x(:), y(:) ! Locals diff --git a/base/serial/psi_s_serial_impl.F90 b/base/serial/psi_s_serial_impl.F90 index 7bfb796c..6baa8dd7 100644 --- a/base/serial/psi_s_serial_impl.F90 +++ b/base/serial/psi_s_serial_impl.F90 @@ -910,7 +910,8 @@ subroutine psi_sgthmv(n,k,idx,alpha,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: x(:,:), y(:),alpha,beta ! Locals @@ -995,7 +996,8 @@ subroutine psi_sgthv(n,idx,alpha,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: x(:), y(:),alpha,beta ! Locals @@ -1051,7 +1053,8 @@ subroutine psi_sgthzmm(n,k,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: x(:,:), y(:,:) ! Locals @@ -1069,7 +1072,8 @@ subroutine psi_sgthzmv(n,k,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: x(:,:), y(:) ! Locals @@ -1090,7 +1094,8 @@ subroutine psi_sgthzv(n,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: x(:), y(:) ! Locals @@ -1107,7 +1112,8 @@ subroutine psi_ssctmm(n,k,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: beta, x(:,:), y(:,:) ! Locals @@ -1133,7 +1139,8 @@ subroutine psi_ssctmv(n,k,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: beta, x(:), y(:,:) ! Locals @@ -1171,7 +1178,8 @@ subroutine psi_ssctv(n,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: beta, x(:), y(:) ! Locals diff --git a/base/serial/psi_z_serial_impl.F90 b/base/serial/psi_z_serial_impl.F90 index e5ab9334..dcd02540 100644 --- a/base/serial/psi_z_serial_impl.F90 +++ b/base/serial/psi_z_serial_impl.F90 @@ -910,7 +910,8 @@ subroutine psi_zgthmv(n,k,idx,alpha,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: x(:,:), y(:),alpha,beta ! Locals @@ -995,7 +996,8 @@ subroutine psi_zgthv(n,idx,alpha,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: x(:), y(:),alpha,beta ! Locals @@ -1051,7 +1053,8 @@ subroutine psi_zgthzmm(n,k,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: x(:,:), y(:,:) ! Locals @@ -1069,7 +1072,8 @@ subroutine psi_zgthzmv(n,k,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: x(:,:), y(:) ! Locals @@ -1090,7 +1094,8 @@ subroutine psi_zgthzv(n,idx,x,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: x(:), y(:) ! Locals @@ -1107,7 +1112,8 @@ subroutine psi_zsctmm(n,k,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: beta, x(:,:), y(:,:) ! Locals @@ -1133,7 +1139,8 @@ subroutine psi_zsctmv(n,k,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, k, idx(:) + integer(psb_mpk_) :: n, k + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: beta, x(:), y(:,:) ! Locals @@ -1171,7 +1178,8 @@ subroutine psi_zsctv(n,idx,x,beta,y) use psb_const_mod implicit none - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: beta, x(:), y(:) ! Locals diff --git a/base/tools/psb_c_remap.F90 b/base/tools/psb_c_remap.F90 index 881b2ad0..ccab6c92 100644 --- a/base/tools/psb_c_remap.F90 +++ b/base/tools/psb_c_remap.F90 @@ -55,10 +55,12 @@ subroutine psb_c_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & ! locals type(psb_ctxt_type) :: ctxt, newctxt - integer(psb_ipk_) :: np, me, err_act + integer(psb_mpk_) :: np, me, nrm, mipd, i + integer(psb_ipk_) :: err_act integer(psb_ipk_) :: rnp, rme - integer(psb_ipk_) :: ipdest, id1, id2, imd, i, nsrc - integer(psb_ipk_), allocatable :: newnl(:), nzsrc(:), ids(:) + integer(psb_ipk_) :: ipdest, id1, id2, imd, nsrc + integer(psb_ipk_), allocatable :: newnl(:), nzsrc(:) + integer(psb_mpk_), allocatable :: ids(:), misrc(:) type(psb_lc_coo_sparse_mat) :: acoo_snd, acoo_rcv integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -84,28 +86,29 @@ subroutine psb_c_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & endif !!$ write(0,*) ' Remapping from ',np,' onto ', np_remap - + mipd = ipd if (desc_in%get_fmt() == 'BLOCK') then ! ! Should we spread the processes in the new context, ! or should we keep them close? ! - if (.true.) then - allocate(ids(0:np_remap-1)) - if (np_remap <= np/2) then + if (.true.) then + nrm = np_remap + allocate(ids(0:nrm-1)) + if (nrm <= np/2) then ids(0) = 0 - do ipdest=1,np_remap -1 - ids(ipdest) = ids(ipdest-1) + np/np_remap + do ipdest=1,nrm -1 + ids(ipdest) = ids(ipdest-1) + np/nrm end do !!$ write(0,*) ' IDS ',ids(:) else - do ipdest = 0, np_remap-1 + do ipdest = 0, nrm-1 ids(ipdest) = ipdest end do end if - call psb_init(newctxt,np=np_remap,basectxt=ctxt,ids=ids) + call psb_init(newctxt,np=nrm,basectxt=ctxt,ids=ids) else - call psb_init(newctxt,np=np_remap,basectxt=ctxt) + call psb_init(newctxt,np=nrm,basectxt=ctxt) end if call psb_info(newctxt,rme,rnp) @@ -140,12 +143,12 @@ subroutine psb_c_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & ipdest = ( ((me-imd*id1)/id2) + imd) end if if (allocated(ids)) then - ipd = ids(ipdest) + mipd = ids(ipdest) else - ipd = ipdest + mipd = ipdest end if !!$ write(0,*) ' Sending my data from ',me,' to ', & -!!$ & ipd, 'out of ',rnp,rnp-1 +!!$ & mipd, 'out of ',rnp,rnp-1 ! ! Compute local rows for all new @@ -158,13 +161,14 @@ subroutine psb_c_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & if (rme>=0) then ! if (rme < imd) then - isrc = [ (i, i=rme*id1,min(rme*id1+id1-1,np-1)) ] + misrc = [ (i, i=rme*id1,min(rme*id1+id1-1,np-1)) ] else - isrc = [ (i, i= imd*id1+((rme-imd))*id2,& + misrc = [ (i, i= imd*id1+((rme-imd))*id2,& & min(imd*id1+(rme-imd)*id2+id2-1,np-1) ) ] end if -!!$ write(0,*) me,rme,imd,' ISRC: ',isrc(:) - nsrc = size(isrc) +!!$ write(0,*) me,rme,imd,' ISRC: ',misrc(:) + isrc = misrc + nsrc = size(misrc) !!$ write(0,*) me,rme,'In ',desc_in%get_local_rows(),desc_in%get_global_rows(),& !!$ & ' out ',desc_out%get_local_rows(),desc_out%get_global_rows() else @@ -187,24 +191,24 @@ subroutine psb_c_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & integer(psb_ipk_) :: nrl, ncl, nzl, nzp call a_in%cp_to(acoo_snd) nzsnd = acoo_snd%get_nzeros() - call psb_snd(ctxt,nzsnd,ipd) - call psb_snd(ctxt,desc_in%get_local_rows(),ipd) + call psb_snd(ctxt,nzsnd,mipd) + call psb_snd(ctxt,desc_in%get_local_rows(),mipd) ! Convert to global numbering call psb_loc_to_glob(acoo_snd%ia(1:nzsnd),desc_in,info) call psb_loc_to_glob(acoo_snd%ja(1:nzsnd),desc_in,info) - call psb_snd(ctxt,acoo_snd%ia(1:nzsnd),ipd) - call psb_snd(ctxt,acoo_snd%ja(1:nzsnd),ipd) - call psb_snd(ctxt,acoo_snd%val(1:nzsnd),ipd) + call psb_snd(ctxt,acoo_snd%ia(1:nzsnd),mipd) + call psb_snd(ctxt,acoo_snd%ja(1:nzsnd),mipd) + call psb_snd(ctxt,acoo_snd%val(1:nzsnd),mipd) if (rme>=0) then ! prepare to receive - nzsrc = isrc - nrsrc = isrc + nzsrc = misrc + nrsrc = misrc nzl = 0 do ip=1, nsrc - call psb_rcv(ctxt,nzsrc(ip),isrc(ip)) - call psb_rcv(ctxt,nrsrc(ip),isrc(ip)) + call psb_rcv(ctxt,nzsrc(ip),misrc(ip)) + call psb_rcv(ctxt,nrsrc(ip),misrc(ip)) nzl = nzl + nzsrc(ip) end do !!$ write(0,*) rme,' Check on NR:',newnl(rme+1),sum(nrsrc) @@ -213,9 +217,9 @@ subroutine psb_c_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & ncl = acoo_rcv%get_ncols() nzp = 0 do ip=1, nsrc - call psb_rcv(ctxt,acoo_rcv%ia(nzp+1:nzp+nzsrc(ip)),isrc(ip)) - call psb_rcv(ctxt,acoo_rcv%ja(nzp+1:nzp+nzsrc(ip)),isrc(ip)) - call psb_rcv(ctxt,acoo_rcv%val(nzp+1:nzp+nzsrc(ip)),isrc(ip)) + call psb_rcv(ctxt,acoo_rcv%ia(nzp+1:nzp+nzsrc(ip)),misrc(ip)) + call psb_rcv(ctxt,acoo_rcv%ja(nzp+1:nzp+nzsrc(ip)),misrc(ip)) + call psb_rcv(ctxt,acoo_rcv%val(nzp+1:nzp+nzsrc(ip)),misrc(ip)) nzp = nzp + nzsrc(ip) end do call acoo_rcv%set_nzeros(nzp) diff --git a/base/tools/psb_callc.f90 b/base/tools/psb_callc.f90 index 272ece8b..82348a78 100644 --- a/base/tools/psb_callc.f90 +++ b/base/tools/psb_callc.f90 @@ -116,7 +116,7 @@ subroutine psb_calloc_vect(x, desc_a,info, dupl, bldmode) end if call x%set_dupl(dupl_) call x%set_remote_build(bldmode_) - call x%set_nrmv(0) + call x%set_nrmv(izero) if (x%is_remote_build()) then nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows())) call psb_ensure_size(nrmt_,x%rmtv,info) diff --git a/base/tools/psb_cd_remap.F90 b/base/tools/psb_cd_remap.F90 index 32a2e94e..882af13d 100644 --- a/base/tools/psb_cd_remap.F90 +++ b/base/tools/psb_cd_remap.F90 @@ -51,7 +51,8 @@ subroutine psb_cd_remap(np_remap, desc_in, desc_out, info) !locals type(psb_ctxt_type) :: ctxt, newctxt - integer(psb_ipk_) :: np, me, err_act + integer(psb_mpk_) :: np, me, nprm + integer(psb_ipk_) :: err_act integer(psb_ipk_) :: rnp, rme integer(psb_ipk_) :: ipdest, id1, id2, imd, i integer(psb_ipk_), allocatable :: newnl(:) @@ -82,7 +83,8 @@ subroutine psb_cd_remap(np_remap, desc_in, desc_out, info) if (desc_in%get_fmt() == 'BLOCK') then ! OK - call psb_init(newctxt,np=np_remap,basectxt=ctxt) + nprm = np_remap + call psb_init(newctxt,np=nprm,basectxt=ctxt) call psb_info(newctxt,rme,rnp) write(0,*) 'Old context: ',me,np,' New context: ',rme,rnp call psb_bcast(ctxt,rnp) diff --git a/base/tools/psb_d_remap.F90 b/base/tools/psb_d_remap.F90 index 2157b56b..dc321918 100644 --- a/base/tools/psb_d_remap.F90 +++ b/base/tools/psb_d_remap.F90 @@ -55,10 +55,12 @@ subroutine psb_d_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & ! locals type(psb_ctxt_type) :: ctxt, newctxt - integer(psb_ipk_) :: np, me, err_act + integer(psb_mpk_) :: np, me, nrm, mipd, i + integer(psb_ipk_) :: err_act integer(psb_ipk_) :: rnp, rme - integer(psb_ipk_) :: ipdest, id1, id2, imd, i, nsrc - integer(psb_ipk_), allocatable :: newnl(:), nzsrc(:), ids(:) + integer(psb_ipk_) :: ipdest, id1, id2, imd, nsrc + integer(psb_ipk_), allocatable :: newnl(:), nzsrc(:) + integer(psb_mpk_), allocatable :: ids(:), misrc(:) type(psb_ld_coo_sparse_mat) :: acoo_snd, acoo_rcv integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -84,28 +86,29 @@ subroutine psb_d_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & endif !!$ write(0,*) ' Remapping from ',np,' onto ', np_remap - + mipd = ipd if (desc_in%get_fmt() == 'BLOCK') then ! ! Should we spread the processes in the new context, ! or should we keep them close? ! - if (.true.) then - allocate(ids(0:np_remap-1)) - if (np_remap <= np/2) then + if (.true.) then + nrm = np_remap + allocate(ids(0:nrm-1)) + if (nrm <= np/2) then ids(0) = 0 - do ipdest=1,np_remap -1 - ids(ipdest) = ids(ipdest-1) + np/np_remap + do ipdest=1,nrm -1 + ids(ipdest) = ids(ipdest-1) + np/nrm end do !!$ write(0,*) ' IDS ',ids(:) else - do ipdest = 0, np_remap-1 + do ipdest = 0, nrm-1 ids(ipdest) = ipdest end do end if - call psb_init(newctxt,np=np_remap,basectxt=ctxt,ids=ids) + call psb_init(newctxt,np=nrm,basectxt=ctxt,ids=ids) else - call psb_init(newctxt,np=np_remap,basectxt=ctxt) + call psb_init(newctxt,np=nrm,basectxt=ctxt) end if call psb_info(newctxt,rme,rnp) @@ -140,12 +143,12 @@ subroutine psb_d_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & ipdest = ( ((me-imd*id1)/id2) + imd) end if if (allocated(ids)) then - ipd = ids(ipdest) + mipd = ids(ipdest) else - ipd = ipdest + mipd = ipdest end if !!$ write(0,*) ' Sending my data from ',me,' to ', & -!!$ & ipd, 'out of ',rnp,rnp-1 +!!$ & mipd, 'out of ',rnp,rnp-1 ! ! Compute local rows for all new @@ -158,13 +161,14 @@ subroutine psb_d_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & if (rme>=0) then ! if (rme < imd) then - isrc = [ (i, i=rme*id1,min(rme*id1+id1-1,np-1)) ] + misrc = [ (i, i=rme*id1,min(rme*id1+id1-1,np-1)) ] else - isrc = [ (i, i= imd*id1+((rme-imd))*id2,& + misrc = [ (i, i= imd*id1+((rme-imd))*id2,& & min(imd*id1+(rme-imd)*id2+id2-1,np-1) ) ] end if -!!$ write(0,*) me,rme,imd,' ISRC: ',isrc(:) - nsrc = size(isrc) +!!$ write(0,*) me,rme,imd,' ISRC: ',misrc(:) + isrc = misrc + nsrc = size(misrc) !!$ write(0,*) me,rme,'In ',desc_in%get_local_rows(),desc_in%get_global_rows(),& !!$ & ' out ',desc_out%get_local_rows(),desc_out%get_global_rows() else @@ -187,24 +191,24 @@ subroutine psb_d_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & integer(psb_ipk_) :: nrl, ncl, nzl, nzp call a_in%cp_to(acoo_snd) nzsnd = acoo_snd%get_nzeros() - call psb_snd(ctxt,nzsnd,ipd) - call psb_snd(ctxt,desc_in%get_local_rows(),ipd) + call psb_snd(ctxt,nzsnd,mipd) + call psb_snd(ctxt,desc_in%get_local_rows(),mipd) ! Convert to global numbering call psb_loc_to_glob(acoo_snd%ia(1:nzsnd),desc_in,info) call psb_loc_to_glob(acoo_snd%ja(1:nzsnd),desc_in,info) - call psb_snd(ctxt,acoo_snd%ia(1:nzsnd),ipd) - call psb_snd(ctxt,acoo_snd%ja(1:nzsnd),ipd) - call psb_snd(ctxt,acoo_snd%val(1:nzsnd),ipd) + call psb_snd(ctxt,acoo_snd%ia(1:nzsnd),mipd) + call psb_snd(ctxt,acoo_snd%ja(1:nzsnd),mipd) + call psb_snd(ctxt,acoo_snd%val(1:nzsnd),mipd) if (rme>=0) then ! prepare to receive - nzsrc = isrc - nrsrc = isrc + nzsrc = misrc + nrsrc = misrc nzl = 0 do ip=1, nsrc - call psb_rcv(ctxt,nzsrc(ip),isrc(ip)) - call psb_rcv(ctxt,nrsrc(ip),isrc(ip)) + call psb_rcv(ctxt,nzsrc(ip),misrc(ip)) + call psb_rcv(ctxt,nrsrc(ip),misrc(ip)) nzl = nzl + nzsrc(ip) end do !!$ write(0,*) rme,' Check on NR:',newnl(rme+1),sum(nrsrc) @@ -213,9 +217,9 @@ subroutine psb_d_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & ncl = acoo_rcv%get_ncols() nzp = 0 do ip=1, nsrc - call psb_rcv(ctxt,acoo_rcv%ia(nzp+1:nzp+nzsrc(ip)),isrc(ip)) - call psb_rcv(ctxt,acoo_rcv%ja(nzp+1:nzp+nzsrc(ip)),isrc(ip)) - call psb_rcv(ctxt,acoo_rcv%val(nzp+1:nzp+nzsrc(ip)),isrc(ip)) + call psb_rcv(ctxt,acoo_rcv%ia(nzp+1:nzp+nzsrc(ip)),misrc(ip)) + call psb_rcv(ctxt,acoo_rcv%ja(nzp+1:nzp+nzsrc(ip)),misrc(ip)) + call psb_rcv(ctxt,acoo_rcv%val(nzp+1:nzp+nzsrc(ip)),misrc(ip)) nzp = nzp + nzsrc(ip) end do call acoo_rcv%set_nzeros(nzp) diff --git a/base/tools/psb_dallc.f90 b/base/tools/psb_dallc.f90 index 108e2000..7b7b21f7 100644 --- a/base/tools/psb_dallc.f90 +++ b/base/tools/psb_dallc.f90 @@ -116,7 +116,7 @@ subroutine psb_dalloc_vect(x, desc_a,info, dupl, bldmode) end if call x%set_dupl(dupl_) call x%set_remote_build(bldmode_) - call x%set_nrmv(0) + call x%set_nrmv(izero) if (x%is_remote_build()) then nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows())) call psb_ensure_size(nrmt_,x%rmtv,info) diff --git a/base/tools/psb_iallc.f90 b/base/tools/psb_iallc.f90 index 7ed69ed6..21d4d8a5 100644 --- a/base/tools/psb_iallc.f90 +++ b/base/tools/psb_iallc.f90 @@ -116,7 +116,7 @@ subroutine psb_ialloc_vect(x, desc_a,info, dupl, bldmode) end if call x%set_dupl(dupl_) call x%set_remote_build(bldmode_) - call x%set_nrmv(0) + call x%set_nrmv(izero) if (x%is_remote_build()) then nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows())) call psb_ensure_size(nrmt_,x%rmtv,info) diff --git a/base/tools/psb_lallc.f90 b/base/tools/psb_lallc.f90 index 53857029..a781e55a 100644 --- a/base/tools/psb_lallc.f90 +++ b/base/tools/psb_lallc.f90 @@ -116,7 +116,7 @@ subroutine psb_lalloc_vect(x, desc_a,info, dupl, bldmode) end if call x%set_dupl(dupl_) call x%set_remote_build(bldmode_) - call x%set_nrmv(0) + call x%set_nrmv(izero) if (x%is_remote_build()) then nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows())) call psb_ensure_size(nrmt_,x%rmtv,info) diff --git a/base/tools/psb_s_remap.F90 b/base/tools/psb_s_remap.F90 index 899c1b26..b7cf7369 100644 --- a/base/tools/psb_s_remap.F90 +++ b/base/tools/psb_s_remap.F90 @@ -55,10 +55,12 @@ subroutine psb_s_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & ! locals type(psb_ctxt_type) :: ctxt, newctxt - integer(psb_ipk_) :: np, me, err_act + integer(psb_mpk_) :: np, me, nrm, mipd, i + integer(psb_ipk_) :: err_act integer(psb_ipk_) :: rnp, rme - integer(psb_ipk_) :: ipdest, id1, id2, imd, i, nsrc - integer(psb_ipk_), allocatable :: newnl(:), nzsrc(:), ids(:) + integer(psb_ipk_) :: ipdest, id1, id2, imd, nsrc + integer(psb_ipk_), allocatable :: newnl(:), nzsrc(:) + integer(psb_mpk_), allocatable :: ids(:), misrc(:) type(psb_ls_coo_sparse_mat) :: acoo_snd, acoo_rcv integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -84,28 +86,29 @@ subroutine psb_s_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & endif !!$ write(0,*) ' Remapping from ',np,' onto ', np_remap - + mipd = ipd if (desc_in%get_fmt() == 'BLOCK') then ! ! Should we spread the processes in the new context, ! or should we keep them close? ! - if (.true.) then - allocate(ids(0:np_remap-1)) - if (np_remap <= np/2) then + if (.true.) then + nrm = np_remap + allocate(ids(0:nrm-1)) + if (nrm <= np/2) then ids(0) = 0 - do ipdest=1,np_remap -1 - ids(ipdest) = ids(ipdest-1) + np/np_remap + do ipdest=1,nrm -1 + ids(ipdest) = ids(ipdest-1) + np/nrm end do !!$ write(0,*) ' IDS ',ids(:) else - do ipdest = 0, np_remap-1 + do ipdest = 0, nrm-1 ids(ipdest) = ipdest end do end if - call psb_init(newctxt,np=np_remap,basectxt=ctxt,ids=ids) + call psb_init(newctxt,np=nrm,basectxt=ctxt,ids=ids) else - call psb_init(newctxt,np=np_remap,basectxt=ctxt) + call psb_init(newctxt,np=nrm,basectxt=ctxt) end if call psb_info(newctxt,rme,rnp) @@ -140,12 +143,12 @@ subroutine psb_s_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & ipdest = ( ((me-imd*id1)/id2) + imd) end if if (allocated(ids)) then - ipd = ids(ipdest) + mipd = ids(ipdest) else - ipd = ipdest + mipd = ipdest end if !!$ write(0,*) ' Sending my data from ',me,' to ', & -!!$ & ipd, 'out of ',rnp,rnp-1 +!!$ & mipd, 'out of ',rnp,rnp-1 ! ! Compute local rows for all new @@ -158,13 +161,14 @@ subroutine psb_s_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & if (rme>=0) then ! if (rme < imd) then - isrc = [ (i, i=rme*id1,min(rme*id1+id1-1,np-1)) ] + misrc = [ (i, i=rme*id1,min(rme*id1+id1-1,np-1)) ] else - isrc = [ (i, i= imd*id1+((rme-imd))*id2,& + misrc = [ (i, i= imd*id1+((rme-imd))*id2,& & min(imd*id1+(rme-imd)*id2+id2-1,np-1) ) ] end if -!!$ write(0,*) me,rme,imd,' ISRC: ',isrc(:) - nsrc = size(isrc) +!!$ write(0,*) me,rme,imd,' ISRC: ',misrc(:) + isrc = misrc + nsrc = size(misrc) !!$ write(0,*) me,rme,'In ',desc_in%get_local_rows(),desc_in%get_global_rows(),& !!$ & ' out ',desc_out%get_local_rows(),desc_out%get_global_rows() else @@ -187,24 +191,24 @@ subroutine psb_s_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & integer(psb_ipk_) :: nrl, ncl, nzl, nzp call a_in%cp_to(acoo_snd) nzsnd = acoo_snd%get_nzeros() - call psb_snd(ctxt,nzsnd,ipd) - call psb_snd(ctxt,desc_in%get_local_rows(),ipd) + call psb_snd(ctxt,nzsnd,mipd) + call psb_snd(ctxt,desc_in%get_local_rows(),mipd) ! Convert to global numbering call psb_loc_to_glob(acoo_snd%ia(1:nzsnd),desc_in,info) call psb_loc_to_glob(acoo_snd%ja(1:nzsnd),desc_in,info) - call psb_snd(ctxt,acoo_snd%ia(1:nzsnd),ipd) - call psb_snd(ctxt,acoo_snd%ja(1:nzsnd),ipd) - call psb_snd(ctxt,acoo_snd%val(1:nzsnd),ipd) + call psb_snd(ctxt,acoo_snd%ia(1:nzsnd),mipd) + call psb_snd(ctxt,acoo_snd%ja(1:nzsnd),mipd) + call psb_snd(ctxt,acoo_snd%val(1:nzsnd),mipd) if (rme>=0) then ! prepare to receive - nzsrc = isrc - nrsrc = isrc + nzsrc = misrc + nrsrc = misrc nzl = 0 do ip=1, nsrc - call psb_rcv(ctxt,nzsrc(ip),isrc(ip)) - call psb_rcv(ctxt,nrsrc(ip),isrc(ip)) + call psb_rcv(ctxt,nzsrc(ip),misrc(ip)) + call psb_rcv(ctxt,nrsrc(ip),misrc(ip)) nzl = nzl + nzsrc(ip) end do !!$ write(0,*) rme,' Check on NR:',newnl(rme+1),sum(nrsrc) @@ -213,9 +217,9 @@ subroutine psb_s_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & ncl = acoo_rcv%get_ncols() nzp = 0 do ip=1, nsrc - call psb_rcv(ctxt,acoo_rcv%ia(nzp+1:nzp+nzsrc(ip)),isrc(ip)) - call psb_rcv(ctxt,acoo_rcv%ja(nzp+1:nzp+nzsrc(ip)),isrc(ip)) - call psb_rcv(ctxt,acoo_rcv%val(nzp+1:nzp+nzsrc(ip)),isrc(ip)) + call psb_rcv(ctxt,acoo_rcv%ia(nzp+1:nzp+nzsrc(ip)),misrc(ip)) + call psb_rcv(ctxt,acoo_rcv%ja(nzp+1:nzp+nzsrc(ip)),misrc(ip)) + call psb_rcv(ctxt,acoo_rcv%val(nzp+1:nzp+nzsrc(ip)),misrc(ip)) nzp = nzp + nzsrc(ip) end do call acoo_rcv%set_nzeros(nzp) diff --git a/base/tools/psb_sallc.f90 b/base/tools/psb_sallc.f90 index 951d8128..d318e45f 100644 --- a/base/tools/psb_sallc.f90 +++ b/base/tools/psb_sallc.f90 @@ -116,7 +116,7 @@ subroutine psb_salloc_vect(x, desc_a,info, dupl, bldmode) end if call x%set_dupl(dupl_) call x%set_remote_build(bldmode_) - call x%set_nrmv(0) + call x%set_nrmv(izero) if (x%is_remote_build()) then nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows())) call psb_ensure_size(nrmt_,x%rmtv,info) diff --git a/base/tools/psb_z_remap.F90 b/base/tools/psb_z_remap.F90 index f9c5c39c..661ae3cc 100644 --- a/base/tools/psb_z_remap.F90 +++ b/base/tools/psb_z_remap.F90 @@ -55,10 +55,12 @@ subroutine psb_z_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & ! locals type(psb_ctxt_type) :: ctxt, newctxt - integer(psb_ipk_) :: np, me, err_act + integer(psb_mpk_) :: np, me, nrm, mipd, i + integer(psb_ipk_) :: err_act integer(psb_ipk_) :: rnp, rme - integer(psb_ipk_) :: ipdest, id1, id2, imd, i, nsrc - integer(psb_ipk_), allocatable :: newnl(:), nzsrc(:), ids(:) + integer(psb_ipk_) :: ipdest, id1, id2, imd, nsrc + integer(psb_ipk_), allocatable :: newnl(:), nzsrc(:) + integer(psb_mpk_), allocatable :: ids(:), misrc(:) type(psb_lz_coo_sparse_mat) :: acoo_snd, acoo_rcv integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -84,28 +86,29 @@ subroutine psb_z_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & endif !!$ write(0,*) ' Remapping from ',np,' onto ', np_remap - + mipd = ipd if (desc_in%get_fmt() == 'BLOCK') then ! ! Should we spread the processes in the new context, ! or should we keep them close? ! - if (.true.) then - allocate(ids(0:np_remap-1)) - if (np_remap <= np/2) then + if (.true.) then + nrm = np_remap + allocate(ids(0:nrm-1)) + if (nrm <= np/2) then ids(0) = 0 - do ipdest=1,np_remap -1 - ids(ipdest) = ids(ipdest-1) + np/np_remap + do ipdest=1,nrm -1 + ids(ipdest) = ids(ipdest-1) + np/nrm end do !!$ write(0,*) ' IDS ',ids(:) else - do ipdest = 0, np_remap-1 + do ipdest = 0, nrm-1 ids(ipdest) = ipdest end do end if - call psb_init(newctxt,np=np_remap,basectxt=ctxt,ids=ids) + call psb_init(newctxt,np=nrm,basectxt=ctxt,ids=ids) else - call psb_init(newctxt,np=np_remap,basectxt=ctxt) + call psb_init(newctxt,np=nrm,basectxt=ctxt) end if call psb_info(newctxt,rme,rnp) @@ -140,12 +143,12 @@ subroutine psb_z_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & ipdest = ( ((me-imd*id1)/id2) + imd) end if if (allocated(ids)) then - ipd = ids(ipdest) + mipd = ids(ipdest) else - ipd = ipdest + mipd = ipdest end if !!$ write(0,*) ' Sending my data from ',me,' to ', & -!!$ & ipd, 'out of ',rnp,rnp-1 +!!$ & mipd, 'out of ',rnp,rnp-1 ! ! Compute local rows for all new @@ -158,13 +161,14 @@ subroutine psb_z_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & if (rme>=0) then ! if (rme < imd) then - isrc = [ (i, i=rme*id1,min(rme*id1+id1-1,np-1)) ] + misrc = [ (i, i=rme*id1,min(rme*id1+id1-1,np-1)) ] else - isrc = [ (i, i= imd*id1+((rme-imd))*id2,& + misrc = [ (i, i= imd*id1+((rme-imd))*id2,& & min(imd*id1+(rme-imd)*id2+id2-1,np-1) ) ] end if -!!$ write(0,*) me,rme,imd,' ISRC: ',isrc(:) - nsrc = size(isrc) +!!$ write(0,*) me,rme,imd,' ISRC: ',misrc(:) + isrc = misrc + nsrc = size(misrc) !!$ write(0,*) me,rme,'In ',desc_in%get_local_rows(),desc_in%get_global_rows(),& !!$ & ' out ',desc_out%get_local_rows(),desc_out%get_global_rows() else @@ -187,24 +191,24 @@ subroutine psb_z_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & integer(psb_ipk_) :: nrl, ncl, nzl, nzp call a_in%cp_to(acoo_snd) nzsnd = acoo_snd%get_nzeros() - call psb_snd(ctxt,nzsnd,ipd) - call psb_snd(ctxt,desc_in%get_local_rows(),ipd) + call psb_snd(ctxt,nzsnd,mipd) + call psb_snd(ctxt,desc_in%get_local_rows(),mipd) ! Convert to global numbering call psb_loc_to_glob(acoo_snd%ia(1:nzsnd),desc_in,info) call psb_loc_to_glob(acoo_snd%ja(1:nzsnd),desc_in,info) - call psb_snd(ctxt,acoo_snd%ia(1:nzsnd),ipd) - call psb_snd(ctxt,acoo_snd%ja(1:nzsnd),ipd) - call psb_snd(ctxt,acoo_snd%val(1:nzsnd),ipd) + call psb_snd(ctxt,acoo_snd%ia(1:nzsnd),mipd) + call psb_snd(ctxt,acoo_snd%ja(1:nzsnd),mipd) + call psb_snd(ctxt,acoo_snd%val(1:nzsnd),mipd) if (rme>=0) then ! prepare to receive - nzsrc = isrc - nrsrc = isrc + nzsrc = misrc + nrsrc = misrc nzl = 0 do ip=1, nsrc - call psb_rcv(ctxt,nzsrc(ip),isrc(ip)) - call psb_rcv(ctxt,nrsrc(ip),isrc(ip)) + call psb_rcv(ctxt,nzsrc(ip),misrc(ip)) + call psb_rcv(ctxt,nrsrc(ip),misrc(ip)) nzl = nzl + nzsrc(ip) end do !!$ write(0,*) rme,' Check on NR:',newnl(rme+1),sum(nrsrc) @@ -213,9 +217,9 @@ subroutine psb_z_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & ncl = acoo_rcv%get_ncols() nzp = 0 do ip=1, nsrc - call psb_rcv(ctxt,acoo_rcv%ia(nzp+1:nzp+nzsrc(ip)),isrc(ip)) - call psb_rcv(ctxt,acoo_rcv%ja(nzp+1:nzp+nzsrc(ip)),isrc(ip)) - call psb_rcv(ctxt,acoo_rcv%val(nzp+1:nzp+nzsrc(ip)),isrc(ip)) + call psb_rcv(ctxt,acoo_rcv%ia(nzp+1:nzp+nzsrc(ip)),misrc(ip)) + call psb_rcv(ctxt,acoo_rcv%ja(nzp+1:nzp+nzsrc(ip)),misrc(ip)) + call psb_rcv(ctxt,acoo_rcv%val(nzp+1:nzp+nzsrc(ip)),misrc(ip)) nzp = nzp + nzsrc(ip) end do call acoo_rcv%set_nzeros(nzp) diff --git a/base/tools/psb_zallc.f90 b/base/tools/psb_zallc.f90 index be4d9089..b43e57ca 100644 --- a/base/tools/psb_zallc.f90 +++ b/base/tools/psb_zallc.f90 @@ -116,7 +116,7 @@ subroutine psb_zalloc_vect(x, desc_a,info, dupl, bldmode) end if call x%set_dupl(dupl_) call x%set_remote_build(bldmode_) - call x%set_nrmv(0) + call x%set_nrmv(izero) if (x%is_remote_build()) then nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows())) call psb_ensure_size(nrmt_,x%rmtv,info) diff --git a/cbind/base/psb_cpenv_mod.f90 b/cbind/base/psb_cpenv_mod.f90 index e0e7b8a2..e1003e99 100644 --- a/cbind/base/psb_cpenv_mod.f90 +++ b/cbind/base/psb_cpenv_mod.f90 @@ -70,12 +70,13 @@ contains integer(psb_c_ipk_) :: info ! Local variables + integer(psb_c_mpk_) :: mctxt type(psb_ctxt_type), pointer :: ctxt ctxt => psb_c2f_ctxt(cctxt) - call ctxt%get_i_ctxt(ictxt,info) - + call ctxt%get_i_ctxt(mctxt,info) + ictxt = mctxt end subroutine function psb_c_cmp_ctxt(cctxt1, cctxt2) bind(c,name="psb_c_cmp_ctxt") result(res) @@ -177,6 +178,7 @@ contains type(psb_c_object_type), value :: cctxt integer(psb_c_ipk_), value :: n, root integer(psb_c_mpk_) :: v(*) + integer(psb_c_mpk_) :: mroot type(psb_ctxt_type), pointer :: ctxt ctxt => psb_c2f_ctxt(cctxt) @@ -186,8 +188,9 @@ contains return end if if (n==0) return + mroot=root - call psb_bcast(ctxt,v(1:n),root=root) + call psb_bcast(ctxt,v(1:n),root=mroot) end subroutine psb_c_mbcast subroutine psb_c_ibcast(cctxt,n,v,root) bind(c) @@ -197,6 +200,7 @@ contains integer(psb_c_ipk_), value :: n, root integer(psb_c_ipk_) :: v(*) type(psb_ctxt_type), pointer :: ctxt + integer(psb_c_mpk_) :: mroot ctxt => psb_c2f_ctxt(cctxt) @@ -205,8 +209,9 @@ contains return end if if (n==0) return + mroot=root - call psb_bcast(ctxt,v(1:n),root=root) + call psb_bcast(ctxt,v(1:n),root=mroot) end subroutine psb_c_ibcast subroutine psb_c_lbcast(cctxt,n,v,root) bind(c) @@ -216,6 +221,7 @@ contains integer(psb_c_ipk_), value :: n, root integer(psb_c_lpk_) :: v(*) type(psb_ctxt_type), pointer :: ctxt + integer(psb_c_mpk_) :: mroot ctxt => psb_c2f_ctxt(cctxt) if (n < 0) then @@ -223,8 +229,9 @@ contains return end if if (n==0) return + mroot=root - call psb_bcast(ctxt,v(1:n),root=root) + call psb_bcast(ctxt,v(1:n),root=mroot) end subroutine psb_c_lbcast subroutine psb_c_ebcast(cctxt,n,v,root) bind(c) @@ -234,6 +241,7 @@ contains integer(psb_c_ipk_), value :: n, root integer(psb_c_epk_) :: v(*) type(psb_ctxt_type), pointer :: ctxt + integer(psb_c_mpk_) :: mroot ctxt => psb_c2f_ctxt(cctxt) if (n < 0) then @@ -241,8 +249,9 @@ contains return end if if (n==0) return + mroot=root - call psb_bcast(ctxt,v(1:n),root=root) + call psb_bcast(ctxt,v(1:n),root=mroot) end subroutine psb_c_ebcast subroutine psb_c_sbcast(cctxt,n,v,root) bind(c) @@ -252,6 +261,7 @@ contains integer(psb_c_ipk_), value :: n, root real(c_float) :: v(*) type(psb_ctxt_type), pointer :: ctxt + integer(psb_c_mpk_) :: mroot ctxt => psb_c2f_ctxt(cctxt) if (n < 0) then @@ -259,8 +269,9 @@ contains return end if if (n==0) return + mroot=root - call psb_bcast(ctxt,v(1:n),root=root) + call psb_bcast(ctxt,v(1:n),root=mroot) end subroutine psb_c_sbcast subroutine psb_c_dbcast(cctxt,n,v,root) bind(c) @@ -270,6 +281,7 @@ contains integer(psb_c_ipk_), value :: n, root real(c_double) :: v(*) type(psb_ctxt_type), pointer :: ctxt + integer(psb_c_mpk_) :: mroot ctxt => psb_c2f_ctxt(cctxt) if (n < 0) then @@ -277,8 +289,9 @@ contains return end if if (n==0) return + mroot=root - call psb_bcast(ctxt,v(1:n),root=root) + call psb_bcast(ctxt,v(1:n),root=mroot) end subroutine psb_c_dbcast @@ -289,6 +302,7 @@ contains integer(psb_c_ipk_), value :: n, root complex(c_float_complex) :: v(*) type(psb_ctxt_type), pointer :: ctxt + integer(psb_c_mpk_) :: mroot ctxt => psb_c2f_ctxt(cctxt) if (n < 0) then @@ -296,8 +310,9 @@ contains return end if if (n==0) return + mroot=root - call psb_bcast(ctxt,v(1:n),root=root) + call psb_bcast(ctxt,v(1:n),root=mroot) end subroutine psb_c_cbcast subroutine psb_c_zbcast(cctxt,n,v,root) bind(c) @@ -307,6 +322,7 @@ contains integer(psb_c_ipk_), value :: n, root complex(c_double_complex) :: v(*) type(psb_ctxt_type), pointer :: ctxt + integer(psb_c_mpk_) :: mroot ctxt => psb_c2f_ctxt(cctxt) if (n < 0) then @@ -314,8 +330,9 @@ contains return end if if (n==0) return + mroot=root - call psb_bcast(ctxt,v(1:n),root=root) + call psb_bcast(ctxt,v(1:n),root=mroot) end subroutine psb_c_zbcast subroutine psb_c_hbcast(cctxt,v,root) bind(c) @@ -326,6 +343,7 @@ contains character(c_char) :: v(*) integer(psb_ipk_) :: iam, np, n type(psb_ctxt_type), pointer :: ctxt + integer(psb_c_mpk_) :: mroot ctxt => psb_c2f_ctxt(cctxt) call psb_info(ctxt,iam,np) @@ -337,8 +355,9 @@ contains n = n + 1 end do end if - call psb_bcast(ctxt,n,root=root) - call psb_bcast(ctxt,v(1:n),root=root) + mroot=root + call psb_bcast(ctxt,n,root=mroot) + call psb_bcast(ctxt,v(1:n),root=mroot) end subroutine psb_c_hbcast function psb_c_f2c_errmsg(cmesg,len) bind(c) result(res) diff --git a/cbind/util/psb_util_cbind_mod.f90 b/cbind/util/psb_util_cbind_mod.f90 index 1ded8136..0322cfc4 100644 --- a/cbind/util/psb_util_cbind_mod.f90 +++ b/cbind/util/psb_util_cbind_mod.f90 @@ -18,11 +18,12 @@ contains implicit none integer(psb_c_ipk_) :: idx - integer(psb_c_ipk_), value :: modes, base + integer(psb_c_ipk_), value :: modes + integer(psb_c_mpk_), value :: base integer(psb_c_ipk_) :: ijk(modes) integer(psb_c_ipk_) :: sizes(modes) - integer(psb_ipk_) :: fijk(modes), fsizes(modes) + integer(psb_mpk_) :: fijk(modes), fsizes(modes) fijk(1:modes) = ijk(1:modes) fsizes(1:modes) = sizes(1:modes) @@ -37,11 +38,12 @@ contains implicit none integer(psb_c_lpk_) :: idx - integer(psb_c_ipk_), value :: modes, base + integer(psb_c_ipk_), value :: modes + integer(psb_c_mpk_), value :: base integer(psb_c_ipk_) :: ijk(modes) integer(psb_c_ipk_) :: sizes(modes) - integer(psb_ipk_) :: fijk(modes), fsizes(modes) + integer(psb_mpk_) :: fijk(modes), fsizes(modes) fijk(1:modes) = ijk(1:modes) fsizes(1:modes) = sizes(1:modes) @@ -56,15 +58,17 @@ contains integer(psb_c_ipk_) :: res integer(psb_c_ipk_), value :: idx - integer(psb_c_ipk_), value :: modes, base + integer(psb_c_ipk_), value :: modes + integer(psb_c_mpk_), value :: base integer(psb_c_ipk_) :: ijk(modes) integer(psb_c_ipk_) :: sizes(modes) - integer(psb_ipk_) :: fijk(modes), fsizes(modes) + integer(psb_mpk_) :: fijk(modes), fsizes(modes) res = -1 fsizes(1:modes) = sizes(1:modes) + call idx2ijk(fijk,idx,fsizes,base=base) ijk(1:modes) = fijk(1:modes) @@ -79,11 +83,12 @@ contains integer(psb_c_ipk_) :: res integer(psb_c_lpk_), value :: idx - integer(psb_c_ipk_), value :: modes, base + integer(psb_c_ipk_), value :: modes + integer(psb_c_mpk_), value :: base integer(psb_c_ipk_) :: ijk(modes) integer(psb_c_ipk_) :: sizes(modes) - integer(psb_ipk_) :: fijk(modes), fsizes(modes) + integer(psb_mpk_) :: fijk(modes), fsizes(modes) res = -1 diff --git a/cuda/psb_c_cuda_vect_mod.F90 b/cuda/psb_c_cuda_vect_mod.F90 index 752d2bf1..95f6d602 100644 --- a/cuda/psb_c_cuda_vect_mod.F90 +++ b/cuda/psb_c_cuda_vect_mod.F90 @@ -222,7 +222,8 @@ contains subroutine c_cuda_gthzv_x(i,n,idx,x,y) use psb_cuda_env_mod use psi_serial_mod - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx complex(psb_spk_) :: y(:) class(psb_c_vect_cuda) :: x @@ -331,7 +332,8 @@ contains subroutine c_cuda_gthzbuf(i,n,idx,x) use psb_cuda_env_mod use psi_serial_mod - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx class(psb_c_vect_cuda) :: x integer :: info, ni @@ -384,7 +386,8 @@ contains subroutine c_cuda_sctb(n,idx,x,beta,y) implicit none !use psb_const_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: beta, x(:) class(psb_c_vect_cuda) :: y integer(psb_ipk_) :: info @@ -401,7 +404,8 @@ contains subroutine c_cuda_sctb_x(i,n,idx,x,beta,y) use psb_cuda_env_mod use psi_serial_mod - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx complex(psb_spk_) :: beta, x(:) class(psb_c_vect_cuda) :: y @@ -507,7 +511,8 @@ contains use psi_serial_mod use psb_cuda_env_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx complex(psb_spk_) :: beta class(psb_c_vect_cuda) :: y diff --git a/cuda/psb_d_cuda_vect_mod.F90 b/cuda/psb_d_cuda_vect_mod.F90 index 4e17be02..080c8686 100644 --- a/cuda/psb_d_cuda_vect_mod.F90 +++ b/cuda/psb_d_cuda_vect_mod.F90 @@ -222,7 +222,8 @@ contains subroutine d_cuda_gthzv_x(i,n,idx,x,y) use psb_cuda_env_mod use psi_serial_mod - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx real(psb_dpk_) :: y(:) class(psb_d_vect_cuda) :: x @@ -331,7 +332,8 @@ contains subroutine d_cuda_gthzbuf(i,n,idx,x) use psb_cuda_env_mod use psi_serial_mod - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx class(psb_d_vect_cuda) :: x integer :: info, ni @@ -384,7 +386,8 @@ contains subroutine d_cuda_sctb(n,idx,x,beta,y) implicit none !use psb_const_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: beta, x(:) class(psb_d_vect_cuda) :: y integer(psb_ipk_) :: info @@ -401,7 +404,8 @@ contains subroutine d_cuda_sctb_x(i,n,idx,x,beta,y) use psb_cuda_env_mod use psi_serial_mod - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx real(psb_dpk_) :: beta, x(:) class(psb_d_vect_cuda) :: y @@ -507,7 +511,8 @@ contains use psi_serial_mod use psb_cuda_env_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx real(psb_dpk_) :: beta class(psb_d_vect_cuda) :: y diff --git a/cuda/psb_i_cuda_vect_mod.F90 b/cuda/psb_i_cuda_vect_mod.F90 index eeafe90e..04e69d24 100644 --- a/cuda/psb_i_cuda_vect_mod.F90 +++ b/cuda/psb_i_cuda_vect_mod.F90 @@ -204,7 +204,8 @@ contains subroutine i_cuda_gthzv_x(i,n,idx,x,y) use psb_cuda_env_mod use psi_serial_mod - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx integer(psb_ipk_) :: y(:) class(psb_i_vect_cuda) :: x @@ -313,7 +314,8 @@ contains subroutine i_cuda_gthzbuf(i,n,idx,x) use psb_cuda_env_mod use psi_serial_mod - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx class(psb_i_vect_cuda) :: x integer :: info, ni @@ -366,7 +368,8 @@ contains subroutine i_cuda_sctb(n,idx,x,beta,y) implicit none !use psb_const_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_ipk_) :: beta, x(:) class(psb_i_vect_cuda) :: y integer(psb_ipk_) :: info @@ -383,7 +386,8 @@ contains subroutine i_cuda_sctb_x(i,n,idx,x,beta,y) use psb_cuda_env_mod use psi_serial_mod - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx integer(psb_ipk_) :: beta, x(:) class(psb_i_vect_cuda) :: y @@ -489,7 +493,8 @@ contains use psi_serial_mod use psb_cuda_env_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx integer(psb_ipk_) :: beta class(psb_i_vect_cuda) :: y diff --git a/cuda/psb_s_cuda_vect_mod.F90 b/cuda/psb_s_cuda_vect_mod.F90 index 3006ebd8..3651d6e6 100644 --- a/cuda/psb_s_cuda_vect_mod.F90 +++ b/cuda/psb_s_cuda_vect_mod.F90 @@ -222,7 +222,8 @@ contains subroutine s_cuda_gthzv_x(i,n,idx,x,y) use psb_cuda_env_mod use psi_serial_mod - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx real(psb_spk_) :: y(:) class(psb_s_vect_cuda) :: x @@ -331,7 +332,8 @@ contains subroutine s_cuda_gthzbuf(i,n,idx,x) use psb_cuda_env_mod use psi_serial_mod - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx class(psb_s_vect_cuda) :: x integer :: info, ni @@ -384,7 +386,8 @@ contains subroutine s_cuda_sctb(n,idx,x,beta,y) implicit none !use psb_const_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: beta, x(:) class(psb_s_vect_cuda) :: y integer(psb_ipk_) :: info @@ -401,7 +404,8 @@ contains subroutine s_cuda_sctb_x(i,n,idx,x,beta,y) use psb_cuda_env_mod use psi_serial_mod - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx real(psb_spk_) :: beta, x(:) class(psb_s_vect_cuda) :: y @@ -507,7 +511,8 @@ contains use psi_serial_mod use psb_cuda_env_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx real(psb_spk_) :: beta class(psb_s_vect_cuda) :: y diff --git a/cuda/psb_z_cuda_vect_mod.F90 b/cuda/psb_z_cuda_vect_mod.F90 index f4860911..4e490df6 100644 --- a/cuda/psb_z_cuda_vect_mod.F90 +++ b/cuda/psb_z_cuda_vect_mod.F90 @@ -222,7 +222,8 @@ contains subroutine z_cuda_gthzv_x(i,n,idx,x,y) use psb_cuda_env_mod use psi_serial_mod - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx complex(psb_dpk_) :: y(:) class(psb_z_vect_cuda) :: x @@ -331,7 +332,8 @@ contains subroutine z_cuda_gthzbuf(i,n,idx,x) use psb_cuda_env_mod use psi_serial_mod - integer(psb_ipk_) :: i,n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx class(psb_z_vect_cuda) :: x integer :: info, ni @@ -384,7 +386,8 @@ contains subroutine z_cuda_sctb(n,idx,x,beta,y) implicit none !use psb_const_mod - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: beta, x(:) class(psb_z_vect_cuda) :: y integer(psb_ipk_) :: info @@ -401,7 +404,8 @@ contains subroutine z_cuda_sctb_x(i,n,idx,x,beta,y) use psb_cuda_env_mod use psi_serial_mod - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx complex(psb_dpk_) :: beta, x(:) class(psb_z_vect_cuda) :: y @@ -507,7 +511,8 @@ contains use psi_serial_mod use psb_cuda_env_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_mpk_) :: n + integer(psb_ipk_) :: i class(psb_i_base_vect_type) :: idx complex(psb_dpk_) :: beta class(psb_z_vect_cuda) :: y diff --git a/openacc/psb_c_oacc_vect_mod.F90 b/openacc/psb_c_oacc_vect_mod.F90 index 067c571b..2aa11db9 100644 --- a/openacc/psb_c_oacc_vect_mod.F90 +++ b/openacc/psb_c_oacc_vect_mod.F90 @@ -409,7 +409,8 @@ contains subroutine c_oacc_sctb_buf(i, n, idx, beta, y) use psb_base_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx complex(psb_spk_) :: beta class(psb_c_vect_oacc) :: y @@ -441,7 +442,8 @@ contains contains subroutine inner_sctb(n,x,beta,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: beta,x(:), y(:) integer(psb_ipk_) :: k !$acc update device(x(1:n)) @@ -457,7 +459,8 @@ contains subroutine c_oacc_sctb_x(i, n, idx, x, beta, y) use psb_base_mod implicit none - integer(psb_ipk_):: i, n + integer(psb_ipk_):: i + integer(psb_mpk_):: n class(psb_i_base_vect_type) :: idx complex(psb_spk_) :: beta, x(:) class(psb_c_vect_oacc) :: y @@ -486,7 +489,8 @@ contains contains subroutine inner_sctb(n,x,beta,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: beta, x(:), y(:) integer(psb_ipk_) :: k !$acc update device(x(1:n)) @@ -502,7 +506,7 @@ contains subroutine c_oacc_sctb(n, idx, x, beta, y) use psb_base_mod implicit none - integer(psb_ipk_) :: n + integer(psb_mpk_) :: n integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: beta, x(:) class(psb_c_vect_oacc) :: y @@ -522,7 +526,8 @@ contains subroutine c_oacc_gthzbuf(i, n, idx, x) use psb_base_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx class(psb_c_vect_oacc) :: x integer(psb_ipk_) :: info,k @@ -555,7 +560,8 @@ contains contains subroutine inner_gth(n,x,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: x(:), y(:) integer(psb_ipk_) :: k ! @@ -571,7 +577,8 @@ contains subroutine c_oacc_gthzv_x(i, n, idx, x, y) use psb_base_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type):: idx complex(psb_spk_) :: y(:) class(psb_c_vect_oacc):: x @@ -599,7 +606,8 @@ contains end if contains subroutine inner_gth(n,x,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_spk_) :: x(:), y(:) integer(psb_ipk_) :: k ! @@ -690,9 +698,10 @@ contains integer(psb_ipk_) :: info call x%free(info) - call x%all(n, info) + call x%all(ione*n, info) if (info /= 0) then - call psb_errpush(info, 'c_oacc_bld_mn', i_err=(/n, n, n, n, n/)) + call psb_errpush(info, 'c_oacc_bld_mn',& + & i_err=ione*(/n, n, n, n, n/)) end if call x%set_host() call x%sync_dev_space() @@ -712,7 +721,7 @@ contains if (info /= 0) then info = psb_err_alloc_request_ call psb_errpush(info, 'c_oacc_bld_x', & - i_err=(/size(this), izero, izero, izero, izero/)) + i_err=(/size(this)*ione, izero, izero, izero, izero/)) return end if x%v(:) = this(:) diff --git a/openacc/psb_d_oacc_vect_mod.F90 b/openacc/psb_d_oacc_vect_mod.F90 index 929066ae..1e3f07d7 100644 --- a/openacc/psb_d_oacc_vect_mod.F90 +++ b/openacc/psb_d_oacc_vect_mod.F90 @@ -409,7 +409,8 @@ contains subroutine d_oacc_sctb_buf(i, n, idx, beta, y) use psb_base_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx real(psb_dpk_) :: beta class(psb_d_vect_oacc) :: y @@ -441,7 +442,8 @@ contains contains subroutine inner_sctb(n,x,beta,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: beta,x(:), y(:) integer(psb_ipk_) :: k !$acc update device(x(1:n)) @@ -457,7 +459,8 @@ contains subroutine d_oacc_sctb_x(i, n, idx, x, beta, y) use psb_base_mod implicit none - integer(psb_ipk_):: i, n + integer(psb_ipk_):: i + integer(psb_mpk_):: n class(psb_i_base_vect_type) :: idx real(psb_dpk_) :: beta, x(:) class(psb_d_vect_oacc) :: y @@ -486,7 +489,8 @@ contains contains subroutine inner_sctb(n,x,beta,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: beta, x(:), y(:) integer(psb_ipk_) :: k !$acc update device(x(1:n)) @@ -502,7 +506,7 @@ contains subroutine d_oacc_sctb(n, idx, x, beta, y) use psb_base_mod implicit none - integer(psb_ipk_) :: n + integer(psb_mpk_) :: n integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: beta, x(:) class(psb_d_vect_oacc) :: y @@ -522,7 +526,8 @@ contains subroutine d_oacc_gthzbuf(i, n, idx, x) use psb_base_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx class(psb_d_vect_oacc) :: x integer(psb_ipk_) :: info,k @@ -555,7 +560,8 @@ contains contains subroutine inner_gth(n,x,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: x(:), y(:) integer(psb_ipk_) :: k ! @@ -571,7 +577,8 @@ contains subroutine d_oacc_gthzv_x(i, n, idx, x, y) use psb_base_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type):: idx real(psb_dpk_) :: y(:) class(psb_d_vect_oacc):: x @@ -599,7 +606,8 @@ contains end if contains subroutine inner_gth(n,x,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_dpk_) :: x(:), y(:) integer(psb_ipk_) :: k ! @@ -690,9 +698,10 @@ contains integer(psb_ipk_) :: info call x%free(info) - call x%all(n, info) + call x%all(ione*n, info) if (info /= 0) then - call psb_errpush(info, 'd_oacc_bld_mn', i_err=(/n, n, n, n, n/)) + call psb_errpush(info, 'd_oacc_bld_mn',& + & i_err=ione*(/n, n, n, n, n/)) end if call x%set_host() call x%sync_dev_space() @@ -712,7 +721,7 @@ contains if (info /= 0) then info = psb_err_alloc_request_ call psb_errpush(info, 'd_oacc_bld_x', & - i_err=(/size(this), izero, izero, izero, izero/)) + i_err=(/size(this)*ione, izero, izero, izero, izero/)) return end if x%v(:) = this(:) diff --git a/openacc/psb_i_oacc_vect_mod.F90 b/openacc/psb_i_oacc_vect_mod.F90 index 42cdc18c..344ad931 100644 --- a/openacc/psb_i_oacc_vect_mod.F90 +++ b/openacc/psb_i_oacc_vect_mod.F90 @@ -63,7 +63,8 @@ contains subroutine i_oacc_sctb_buf(i, n, idx, beta, y) use psb_base_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx integer(psb_ipk_) :: beta class(psb_i_vect_oacc) :: y @@ -95,7 +96,8 @@ contains contains subroutine inner_sctb(n,x,beta,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_ipk_) :: beta,x(:), y(:) integer(psb_ipk_) :: k !$acc update device(x(1:n)) @@ -111,7 +113,8 @@ contains subroutine i_oacc_sctb_x(i, n, idx, x, beta, y) use psb_base_mod implicit none - integer(psb_ipk_):: i, n + integer(psb_ipk_):: i + integer(psb_mpk_):: n class(psb_i_base_vect_type) :: idx integer(psb_ipk_) :: beta, x(:) class(psb_i_vect_oacc) :: y @@ -140,7 +143,8 @@ contains contains subroutine inner_sctb(n,x,beta,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_ipk_) :: beta, x(:), y(:) integer(psb_ipk_) :: k !$acc update device(x(1:n)) @@ -156,7 +160,7 @@ contains subroutine i_oacc_sctb(n, idx, x, beta, y) use psb_base_mod implicit none - integer(psb_ipk_) :: n + integer(psb_mpk_) :: n integer(psb_ipk_) :: idx(:) integer(psb_ipk_) :: beta, x(:) class(psb_i_vect_oacc) :: y @@ -176,7 +180,8 @@ contains subroutine i_oacc_gthzbuf(i, n, idx, x) use psb_base_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx class(psb_i_vect_oacc) :: x integer(psb_ipk_) :: info,k @@ -209,7 +214,8 @@ contains contains subroutine inner_gth(n,x,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_ipk_) :: x(:), y(:) integer(psb_ipk_) :: k ! @@ -225,7 +231,8 @@ contains subroutine i_oacc_gthzv_x(i, n, idx, x, y) use psb_base_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type):: idx integer(psb_ipk_) :: y(:) class(psb_i_vect_oacc):: x @@ -253,7 +260,8 @@ contains end if contains subroutine inner_gth(n,x,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_ipk_) :: x(:), y(:) integer(psb_ipk_) :: k ! @@ -344,9 +352,10 @@ contains integer(psb_ipk_) :: info call x%free(info) - call x%all(n, info) + call x%all(ione*n, info) if (info /= 0) then - call psb_errpush(info, 'i_oacc_bld_mn', i_err=(/n, n, n, n, n/)) + call psb_errpush(info, 'i_oacc_bld_mn',& + & i_err=ione*(/n, n, n, n, n/)) end if call x%set_host() call x%sync_dev_space() @@ -366,7 +375,7 @@ contains if (info /= 0) then info = psb_err_alloc_request_ call psb_errpush(info, 'i_oacc_bld_x', & - i_err=(/size(this), izero, izero, izero, izero/)) + i_err=(/size(this)*ione, izero, izero, izero, izero/)) return end if x%v(:) = this(:) diff --git a/openacc/psb_l_oacc_vect_mod.F90 b/openacc/psb_l_oacc_vect_mod.F90 index 60cdee35..85b561a9 100644 --- a/openacc/psb_l_oacc_vect_mod.F90 +++ b/openacc/psb_l_oacc_vect_mod.F90 @@ -65,7 +65,8 @@ contains subroutine l_oacc_sctb_buf(i, n, idx, beta, y) use psb_base_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx integer(psb_lpk_) :: beta class(psb_l_vect_oacc) :: y @@ -97,7 +98,8 @@ contains contains subroutine inner_sctb(n,x,beta,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_lpk_) :: beta,x(:), y(:) integer(psb_ipk_) :: k !$acc update device(x(1:n)) @@ -113,7 +115,8 @@ contains subroutine l_oacc_sctb_x(i, n, idx, x, beta, y) use psb_base_mod implicit none - integer(psb_ipk_):: i, n + integer(psb_ipk_):: i + integer(psb_mpk_):: n class(psb_i_base_vect_type) :: idx integer(psb_lpk_) :: beta, x(:) class(psb_l_vect_oacc) :: y @@ -142,7 +145,8 @@ contains contains subroutine inner_sctb(n,x,beta,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_lpk_) :: beta, x(:), y(:) integer(psb_ipk_) :: k !$acc update device(x(1:n)) @@ -158,7 +162,7 @@ contains subroutine l_oacc_sctb(n, idx, x, beta, y) use psb_base_mod implicit none - integer(psb_ipk_) :: n + integer(psb_mpk_) :: n integer(psb_ipk_) :: idx(:) integer(psb_lpk_) :: beta, x(:) class(psb_l_vect_oacc) :: y @@ -178,7 +182,8 @@ contains subroutine l_oacc_gthzbuf(i, n, idx, x) use psb_base_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx class(psb_l_vect_oacc) :: x integer(psb_ipk_) :: info,k @@ -211,7 +216,8 @@ contains contains subroutine inner_gth(n,x,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_lpk_) :: x(:), y(:) integer(psb_ipk_) :: k ! @@ -227,7 +233,8 @@ contains subroutine l_oacc_gthzv_x(i, n, idx, x, y) use psb_base_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type):: idx integer(psb_lpk_) :: y(:) class(psb_l_vect_oacc):: x @@ -255,7 +262,8 @@ contains end if contains subroutine inner_gth(n,x,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) integer(psb_lpk_) :: x(:), y(:) integer(psb_ipk_) :: k ! @@ -346,9 +354,10 @@ contains integer(psb_ipk_) :: info call x%free(info) - call x%all(n, info) + call x%all(ione*n, info) if (info /= 0) then - call psb_errpush(info, 'l_oacc_bld_mn', i_err=(/n, n, n, n, n/)) + call psb_errpush(info, 'l_oacc_bld_mn',& + & i_err=ione*(/n, n, n, n, n/)) end if call x%set_host() call x%sync_dev_space() @@ -368,7 +377,7 @@ contains if (info /= 0) then info = psb_err_alloc_request_ call psb_errpush(info, 'l_oacc_bld_x', & - i_err=(/size(this), izero, izero, izero, izero/)) + i_err=(/size(this)*ione, izero, izero, izero, izero/)) return end if x%v(:) = this(:) diff --git a/openacc/psb_s_oacc_vect_mod.F90 b/openacc/psb_s_oacc_vect_mod.F90 index 9cb42a95..b8d9700d 100644 --- a/openacc/psb_s_oacc_vect_mod.F90 +++ b/openacc/psb_s_oacc_vect_mod.F90 @@ -409,7 +409,8 @@ contains subroutine s_oacc_sctb_buf(i, n, idx, beta, y) use psb_base_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx real(psb_spk_) :: beta class(psb_s_vect_oacc) :: y @@ -441,7 +442,8 @@ contains contains subroutine inner_sctb(n,x,beta,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: beta,x(:), y(:) integer(psb_ipk_) :: k !$acc update device(x(1:n)) @@ -457,7 +459,8 @@ contains subroutine s_oacc_sctb_x(i, n, idx, x, beta, y) use psb_base_mod implicit none - integer(psb_ipk_):: i, n + integer(psb_ipk_):: i + integer(psb_mpk_):: n class(psb_i_base_vect_type) :: idx real(psb_spk_) :: beta, x(:) class(psb_s_vect_oacc) :: y @@ -486,7 +489,8 @@ contains contains subroutine inner_sctb(n,x,beta,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: beta, x(:), y(:) integer(psb_ipk_) :: k !$acc update device(x(1:n)) @@ -502,7 +506,7 @@ contains subroutine s_oacc_sctb(n, idx, x, beta, y) use psb_base_mod implicit none - integer(psb_ipk_) :: n + integer(psb_mpk_) :: n integer(psb_ipk_) :: idx(:) real(psb_spk_) :: beta, x(:) class(psb_s_vect_oacc) :: y @@ -522,7 +526,8 @@ contains subroutine s_oacc_gthzbuf(i, n, idx, x) use psb_base_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx class(psb_s_vect_oacc) :: x integer(psb_ipk_) :: info,k @@ -555,7 +560,8 @@ contains contains subroutine inner_gth(n,x,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: x(:), y(:) integer(psb_ipk_) :: k ! @@ -571,7 +577,8 @@ contains subroutine s_oacc_gthzv_x(i, n, idx, x, y) use psb_base_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type):: idx real(psb_spk_) :: y(:) class(psb_s_vect_oacc):: x @@ -599,7 +606,8 @@ contains end if contains subroutine inner_gth(n,x,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) real(psb_spk_) :: x(:), y(:) integer(psb_ipk_) :: k ! @@ -690,9 +698,10 @@ contains integer(psb_ipk_) :: info call x%free(info) - call x%all(n, info) + call x%all(ione*n, info) if (info /= 0) then - call psb_errpush(info, 's_oacc_bld_mn', i_err=(/n, n, n, n, n/)) + call psb_errpush(info, 's_oacc_bld_mn',& + & i_err=ione*(/n, n, n, n, n/)) end if call x%set_host() call x%sync_dev_space() @@ -712,7 +721,7 @@ contains if (info /= 0) then info = psb_err_alloc_request_ call psb_errpush(info, 's_oacc_bld_x', & - i_err=(/size(this), izero, izero, izero, izero/)) + i_err=(/size(this)*ione, izero, izero, izero, izero/)) return end if x%v(:) = this(:) diff --git a/openacc/psb_z_oacc_vect_mod.F90 b/openacc/psb_z_oacc_vect_mod.F90 index 90ddcf0d..a119303d 100644 --- a/openacc/psb_z_oacc_vect_mod.F90 +++ b/openacc/psb_z_oacc_vect_mod.F90 @@ -409,7 +409,8 @@ contains subroutine z_oacc_sctb_buf(i, n, idx, beta, y) use psb_base_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx complex(psb_dpk_) :: beta class(psb_z_vect_oacc) :: y @@ -441,7 +442,8 @@ contains contains subroutine inner_sctb(n,x,beta,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: beta,x(:), y(:) integer(psb_ipk_) :: k !$acc update device(x(1:n)) @@ -457,7 +459,8 @@ contains subroutine z_oacc_sctb_x(i, n, idx, x, beta, y) use psb_base_mod implicit none - integer(psb_ipk_):: i, n + integer(psb_ipk_):: i + integer(psb_mpk_):: n class(psb_i_base_vect_type) :: idx complex(psb_dpk_) :: beta, x(:) class(psb_z_vect_oacc) :: y @@ -486,7 +489,8 @@ contains contains subroutine inner_sctb(n,x,beta,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: beta, x(:), y(:) integer(psb_ipk_) :: k !$acc update device(x(1:n)) @@ -502,7 +506,7 @@ contains subroutine z_oacc_sctb(n, idx, x, beta, y) use psb_base_mod implicit none - integer(psb_ipk_) :: n + integer(psb_mpk_) :: n integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: beta, x(:) class(psb_z_vect_oacc) :: y @@ -522,7 +526,8 @@ contains subroutine z_oacc_gthzbuf(i, n, idx, x) use psb_base_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type) :: idx class(psb_z_vect_oacc) :: x integer(psb_ipk_) :: info,k @@ -555,7 +560,8 @@ contains contains subroutine inner_gth(n,x,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: x(:), y(:) integer(psb_ipk_) :: k ! @@ -571,7 +577,8 @@ contains subroutine z_oacc_gthzv_x(i, n, idx, x, y) use psb_base_mod implicit none - integer(psb_ipk_) :: i, n + integer(psb_ipk_) :: i + integer(psb_mpk_) :: n class(psb_i_base_vect_type):: idx complex(psb_dpk_) :: y(:) class(psb_z_vect_oacc):: x @@ -599,7 +606,8 @@ contains end if contains subroutine inner_gth(n,x,y,idx) - integer(psb_ipk_) :: n, idx(:) + integer(psb_mpk_) :: n + integer(psb_ipk_) :: idx(:) complex(psb_dpk_) :: x(:), y(:) integer(psb_ipk_) :: k ! @@ -690,9 +698,10 @@ contains integer(psb_ipk_) :: info call x%free(info) - call x%all(n, info) + call x%all(ione*n, info) if (info /= 0) then - call psb_errpush(info, 'z_oacc_bld_mn', i_err=(/n, n, n, n, n/)) + call psb_errpush(info, 'z_oacc_bld_mn',& + & i_err=ione*(/n, n, n, n, n/)) end if call x%set_host() call x%sync_dev_space() @@ -712,7 +721,7 @@ contains if (info /= 0) then info = psb_err_alloc_request_ call psb_errpush(info, 'z_oacc_bld_x', & - i_err=(/size(this), izero, izero, izero, izero/)) + i_err=(/size(this)*ione, izero, izero, izero, izero/)) return end if x%v(:) = this(:) diff --git a/prec/psb_prec_const_mod.f90 b/prec/psb_prec_const_mod.f90 index 73c22e58..d74c5bf0 100644 --- a/prec/psb_prec_const_mod.f90 +++ b/prec/psb_prec_const_mod.f90 @@ -74,15 +74,15 @@ module psb_prec_const_mod integer(psb_ipk_), parameter :: psb_ilu_scale_arcsum_ = 5 ! Numerical parameters relative to Approximate Inverse Preconditioners - integer, parameter :: psb_inv_fillin_ = 3 - integer, parameter :: psb_ainv_alg_ = psb_inv_fillin_ + 1 - integer, parameter :: psb_inv_thresh_ = 3 - integer, parameter :: psb_ainv_llk_ = psb_inv_thresh_ + 1 - integer, parameter :: psb_ainv_s_llk_ = psb_ainv_llk_ + 1 - integer, parameter :: psb_ainv_s_ft_llk_ = psb_ainv_s_llk_ + 1 - integer, parameter :: psb_ainv_llk_noth_ = psb_ainv_s_ft_llk_ + 1 - integer, parameter :: psb_ainv_mlk_ = psb_ainv_llk_noth_ + 1 - integer, parameter :: psb_ainv_lmx_ = psb_ainv_mlk_ + integer(psb_ipk_), parameter :: psb_inv_fillin_ = 3 + integer(psb_ipk_), parameter :: psb_ainv_alg_ = psb_inv_fillin_ + 1 + integer(psb_ipk_), parameter :: psb_inv_thresh_ = 3 + integer(psb_ipk_), parameter :: psb_ainv_llk_ = psb_inv_thresh_ + 1 + integer(psb_ipk_), parameter :: psb_ainv_s_llk_ = psb_ainv_llk_ + 1 + integer(psb_ipk_), parameter :: psb_ainv_s_ft_llk_ = psb_ainv_s_llk_ + 1 + integer(psb_ipk_), parameter :: psb_ainv_llk_noth_ = psb_ainv_s_ft_llk_ + 1 + integer(psb_ipk_), parameter :: psb_ainv_mlk_ = psb_ainv_llk_noth_ + 1 + integer(psb_ipk_), parameter :: psb_ainv_lmx_ = psb_ainv_mlk_ interface psb_check_def diff --git a/test/fileread/psb_cf_sample.f90 b/test/fileread/psb_cf_sample.f90 index 01d9a10b..9fd965ae 100644 --- a/test/fileread/psb_cf_sample.f90 +++ b/test/fileread/psb_cf_sample.f90 @@ -185,7 +185,7 @@ program psb_cf_sample endif call psb_barrier(ctxt) - call distr_mtpart(psb_root_,ctxt) + call distr_mtpart(ione*psb_root_,ctxt) call getv_mtpart(ivg) call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg) @@ -194,7 +194,7 @@ program psb_cf_sample call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,parts=part_block) end select - call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_) + call psb_scatter(b_col_glob,b_col,desc_a,info,root=ione*psb_root_) call psb_geall(x_col,desc_a,info) call x_col%zero() call psb_geasb(x_col,desc_a,info) @@ -274,9 +274,9 @@ program psb_cf_sample & desc_a%get_fmt() end if - call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_) + call psb_gather(x_col_glob,x_col,desc_a,info,root=ione*psb_root_) if (info == psb_success_) & - & call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_) + & call psb_gather(r_col_glob,r_col,desc_a,info,root=ione*psb_root_) if (info /= psb_success_) goto 9999 if (iam == psb_root_) then write(psb_err_unit,'(" ")') diff --git a/test/fileread/psb_df_sample.f90 b/test/fileread/psb_df_sample.f90 index b186241d..b07e4ede 100644 --- a/test/fileread/psb_df_sample.f90 +++ b/test/fileread/psb_df_sample.f90 @@ -185,7 +185,7 @@ program psb_df_sample endif call psb_barrier(ctxt) - call distr_mtpart(psb_root_,ctxt) + call distr_mtpart(ione*psb_root_,ctxt) call getv_mtpart(ivg) call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg) @@ -194,7 +194,7 @@ program psb_df_sample call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,parts=part_block) end select - call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_) + call psb_scatter(b_col_glob,b_col,desc_a,info,root=ione*psb_root_) call psb_geall(x_col,desc_a,info) call x_col%zero() call psb_geasb(x_col,desc_a,info) @@ -276,9 +276,9 @@ program psb_df_sample & desc_a%get_fmt() end if - call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_) + call psb_gather(x_col_glob,x_col,desc_a,info,root=ione*psb_root_) if (info == psb_success_) & - & call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_) + & call psb_gather(r_col_glob,r_col,desc_a,info,root=ione*psb_root_) if (info /= psb_success_) goto 9999 if (iam == psb_root_) then write(psb_err_unit,'(" ")') diff --git a/test/fileread/psb_sf_sample.f90 b/test/fileread/psb_sf_sample.f90 index da0fe6b4..289df307 100644 --- a/test/fileread/psb_sf_sample.f90 +++ b/test/fileread/psb_sf_sample.f90 @@ -185,7 +185,7 @@ program psb_sf_sample endif call psb_barrier(ctxt) - call distr_mtpart(psb_root_,ctxt) + call distr_mtpart(ione*psb_root_,ctxt) call getv_mtpart(ivg) call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg) @@ -194,7 +194,7 @@ program psb_sf_sample call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,parts=part_block) end select - call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_) + call psb_scatter(b_col_glob,b_col,desc_a,info,root=ione*psb_root_) call psb_geall(x_col,desc_a,info) call x_col%zero() call psb_geasb(x_col,desc_a,info) @@ -276,9 +276,9 @@ program psb_sf_sample & desc_a%get_fmt() end if - call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_) + call psb_gather(x_col_glob,x_col,desc_a,info,root=ione*psb_root_) if (info == psb_success_) & - & call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_) + & call psb_gather(r_col_glob,r_col,desc_a,info,root=ione*psb_root_) if (info /= psb_success_) goto 9999 if (iam == psb_root_) then write(psb_err_unit,'(" ")') diff --git a/test/fileread/psb_zf_sample.f90 b/test/fileread/psb_zf_sample.f90 index eefe0901..b8385922 100644 --- a/test/fileread/psb_zf_sample.f90 +++ b/test/fileread/psb_zf_sample.f90 @@ -185,7 +185,7 @@ program psb_zf_sample endif call psb_barrier(ctxt) - call distr_mtpart(psb_root_,ctxt) + call distr_mtpart(ione*psb_root_,ctxt) call getv_mtpart(ivg) call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg) @@ -194,7 +194,7 @@ program psb_zf_sample call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,parts=part_block) end select - call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_) + call psb_scatter(b_col_glob,b_col,desc_a,info,root=ione*psb_root_) call psb_geall(x_col,desc_a,info) call x_col%zero() call psb_geasb(x_col,desc_a,info) @@ -274,9 +274,9 @@ program psb_zf_sample & desc_a%get_fmt() end if - call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_) + call psb_gather(x_col_glob,x_col,desc_a,info,root=ione*psb_root_) if (info == psb_success_) & - & call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_) + & call psb_gather(r_col_glob,r_col,desc_a,info,root=ione*psb_root_) if (info /= psb_success_) goto 9999 if (iam == psb_root_) then write(psb_err_unit,'(" ")') diff --git a/test/pdegen/psb_d_pde2d.F90 b/test/pdegen/psb_d_pde2d.F90 index ee7cb7f6..e04ec678 100644 --- a/test/pdegen/psb_d_pde2d.F90 +++ b/test/pdegen/psb_d_pde2d.F90 @@ -328,7 +328,7 @@ contains allocate(bndx(0:npx),bndy(0:npy)) ! We can reuse idx2ijk for process indices as well. - call idx2ijk(iamx,iamy,iam,npx,npy,base=0) + call idx2ijk(iamx,iamy,iam,npx,npy,base=mzero) ! Now let's split the 2D square in rectangles call dist1Didx(bndx,idim,npx) mynx = bndx(iamx+1)-bndx(iamx) @@ -368,7 +368,7 @@ contains ! ! Use adjcncy methods ! - integer(psb_mpk_), allocatable :: neighbours(:) + integer(psb_ipk_), allocatable :: neighbours(:) integer(psb_mpk_) :: cnt logical, parameter :: debug_adj=.true. if (debug_adj.and.(np > 1)) then @@ -376,19 +376,19 @@ contains allocate(neighbours(np)) if (iamx < npx-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx+1,iamy,npx,npy,base=0) + call ijk2idx(neighbours(cnt),iamx+1,iamy,npx,npy,base=mzero) end if if (iamy < npy-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy+1,npx,npy,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy+1,npx,npy,base=mzero) end if if (iamx >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx-1,iamy,npx,npy,base=0) + call ijk2idx(neighbours(cnt),iamx-1,iamy,npx,npy,base=mzero) end if if (iamy >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy-1,npx,npy,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy-1,npx,npy,base=mzero) end if call psb_realloc(cnt, neighbours,info) call desc_a%set_p_adjcncy(neighbours) diff --git a/test/pdegen/psb_d_pde3d.F90 b/test/pdegen/psb_d_pde3d.F90 index 1f323a46..cac1c413 100644 --- a/test/pdegen/psb_d_pde3d.F90 +++ b/test/pdegen/psb_d_pde3d.F90 @@ -345,7 +345,7 @@ contains allocate(bndx(0:npx),bndy(0:npy),bndz(0:npz)) ! We can reuse idx2ijk for process indices as well. - call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=0) + call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=mzero) ! Now let's split the 3D cube in hexahedra call dist1Didx(bndx,idim,npx) mynx = bndx(iamx+1)-bndx(iamx) @@ -389,7 +389,7 @@ contains ! ! Use adjcncy methods ! - integer(psb_mpk_), allocatable :: neighbours(:) + integer(psb_ipk_), allocatable :: neighbours(:) integer(psb_mpk_) :: cnt logical, parameter :: debug_adj=.true. if (debug_adj.and.(np > 1)) then @@ -397,27 +397,27 @@ contains allocate(neighbours(np)) if (iamx < npx-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=mzero) end if if (iamy < npy-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=mzero) end if if (iamz < npz-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=mzero) end if if (iamx >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=mzero) end if if (iamy >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=mzero) end if if (iamz >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=mzero) end if call psb_realloc(cnt, neighbours,info) call desc_a%set_p_adjcncy(neighbours) diff --git a/test/pdegen/psb_s_pde2d.F90 b/test/pdegen/psb_s_pde2d.F90 index c27d2ebe..121980bf 100644 --- a/test/pdegen/psb_s_pde2d.F90 +++ b/test/pdegen/psb_s_pde2d.F90 @@ -328,7 +328,7 @@ contains allocate(bndx(0:npx),bndy(0:npy)) ! We can reuse idx2ijk for process indices as well. - call idx2ijk(iamx,iamy,iam,npx,npy,base=0) + call idx2ijk(iamx,iamy,iam,npx,npy,base=mzero) ! Now let's split the 2D square in rectangles call dist1Didx(bndx,idim,npx) mynx = bndx(iamx+1)-bndx(iamx) @@ -368,7 +368,7 @@ contains ! ! Use adjcncy methods ! - integer(psb_mpk_), allocatable :: neighbours(:) + integer(psb_ipk_), allocatable :: neighbours(:) integer(psb_mpk_) :: cnt logical, parameter :: debug_adj=.true. if (debug_adj.and.(np > 1)) then @@ -376,19 +376,19 @@ contains allocate(neighbours(np)) if (iamx < npx-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx+1,iamy,npx,npy,base=0) + call ijk2idx(neighbours(cnt),iamx+1,iamy,npx,npy,base=mzero) end if if (iamy < npy-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy+1,npx,npy,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy+1,npx,npy,base=mzero) end if if (iamx >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx-1,iamy,npx,npy,base=0) + call ijk2idx(neighbours(cnt),iamx-1,iamy,npx,npy,base=mzero) end if if (iamy >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy-1,npx,npy,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy-1,npx,npy,base=mzero) end if call psb_realloc(cnt, neighbours,info) call desc_a%set_p_adjcncy(neighbours) diff --git a/test/pdegen/psb_s_pde3d.F90 b/test/pdegen/psb_s_pde3d.F90 index a80d94f8..49b7e979 100644 --- a/test/pdegen/psb_s_pde3d.F90 +++ b/test/pdegen/psb_s_pde3d.F90 @@ -345,7 +345,7 @@ contains allocate(bndx(0:npx),bndy(0:npy),bndz(0:npz)) ! We can reuse idx2ijk for process indices as well. - call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=0) + call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=mzero) ! Now let's split the 3D cube in hexahedra call dist1Didx(bndx,idim,npx) mynx = bndx(iamx+1)-bndx(iamx) @@ -389,7 +389,7 @@ contains ! ! Use adjcncy methods ! - integer(psb_mpk_), allocatable :: neighbours(:) + integer(psb_ipk_), allocatable :: neighbours(:) integer(psb_mpk_) :: cnt logical, parameter :: debug_adj=.true. if (debug_adj.and.(np > 1)) then @@ -397,27 +397,27 @@ contains allocate(neighbours(np)) if (iamx < npx-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=mzero) end if if (iamy < npy-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=mzero) end if if (iamz < npz-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=mzero) end if if (iamx >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=mzero) end if if (iamy >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=mzero) end if if (iamz >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=mzero) end if call psb_realloc(cnt, neighbours,info) call desc_a%set_p_adjcncy(neighbours) diff --git a/util/psb_c_mat_dist_impl.f90 b/util/psb_c_mat_dist_impl.f90 index 081252dd..26d04041 100644 --- a/util/psb_c_mat_dist_impl.f90 +++ b/util/psb_c_mat_dist_impl.f90 @@ -89,9 +89,9 @@ subroutine psb_cmatdist(a_glob, a, ctxt, desc_a,& ! local variables logical :: use_parts, use_vg, use_vsz - integer(psb_ipk_) :: np, iam, np_sharing - integer(psb_ipk_) :: k_count, root, liwork, nnzero, nrhs,& - & i, ll, nz, isize, iproc, nnr, err, err_act + integer(psb_mpk_) :: np, iam, root, iproc + integer(psb_ipk_) :: k_count, inp, np_sharing, liwork, nnzero, nrhs,& + & i, ll, nz, isize, nnr, err, err_act integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig, lastigp integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:) integer(psb_lpk_), allocatable :: irow(:),icol(:) @@ -112,7 +112,7 @@ subroutine psb_cmatdist(a_glob, a, ctxt, desc_a,& root = psb_root_ end if call psb_info(ctxt, iam, np) - + use_parts = present(parts) use_vg = present(vg) use_vsz = present(vsz) @@ -195,8 +195,9 @@ subroutine psb_cmatdist(a_glob, a, ctxt, desc_a,& end if do while (i_count <= nrow) - if (use_parts) then - call parts(i_count,nrow,np,iwork, np_sharing) + if (use_parts) then + inp = np + call parts(i_count,nrow,inp,iwork, np_sharing) ! ! np_sharing allows for overlap in the data distribution. ! If an index is overlapped, then we have to send its row @@ -211,7 +212,7 @@ subroutine psb_cmatdist(a_glob, a, ctxt, desc_a,& j_count = j_count + 1 if (j_count-i_count >= nb) exit if (j_count > nrow) exit - call parts(j_count,nrow,np,iwrk2, np_sharing) + call parts(j_count,nrow,inp,iwrk2, np_sharing) if (np_sharing /= 1 ) exit if (iwrk2(1) /= iproc ) exit end do @@ -431,8 +432,8 @@ subroutine psb_lcmatdist(a_glob, a, ctxt, desc_a,& ! local variables logical :: use_parts, use_vg, use_vsz - integer(psb_ipk_) :: np, iam, np_sharing, root, iproc - integer(psb_ipk_) :: err_act, il, inz + integer(psb_mpk_) :: np, iam, root, iproc + integer(psb_ipk_) :: err_act, il, inz, np_sharing, inp integer(psb_lpk_) :: k_count, liwork, nnzero, nrhs,& & i, ll, nz, isize, nnr, err integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig, lastigp @@ -533,8 +534,9 @@ subroutine psb_lcmatdist(a_glob, a, ctxt, desc_a,& end if do while (i_count <= nrow) - if (use_parts) then - call parts(i_count,nrow,np,iwork, np_sharing) + if (use_parts) then + inp = np + call parts(i_count,nrow,inp,iwork, np_sharing) ! ! np_sharing allows for overlap in the data distribution. ! If an index is overlapped, then we have to send its row @@ -549,7 +551,7 @@ subroutine psb_lcmatdist(a_glob, a, ctxt, desc_a,& j_count = j_count + 1 if (j_count-i_count >= nb) exit if (j_count > nrow) exit - call parts(j_count,nrow,np,iwrk2, np_sharing) + call parts(j_count,nrow,inp,iwrk2, np_sharing) if (np_sharing /= 1 ) exit if (iwrk2(1) /= iproc ) exit end do diff --git a/util/psb_d_mat_dist_impl.f90 b/util/psb_d_mat_dist_impl.f90 index e85dc773..44d853e4 100644 --- a/util/psb_d_mat_dist_impl.f90 +++ b/util/psb_d_mat_dist_impl.f90 @@ -89,9 +89,9 @@ subroutine psb_dmatdist(a_glob, a, ctxt, desc_a,& ! local variables logical :: use_parts, use_vg, use_vsz - integer(psb_ipk_) :: np, iam, np_sharing - integer(psb_ipk_) :: k_count, root, liwork, nnzero, nrhs,& - & i, ll, nz, isize, iproc, nnr, err, err_act + integer(psb_mpk_) :: np, iam, root, iproc + integer(psb_ipk_) :: k_count, inp, np_sharing, liwork, nnzero, nrhs,& + & i, ll, nz, isize, nnr, err, err_act integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig, lastigp integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:) integer(psb_lpk_), allocatable :: irow(:),icol(:) @@ -112,7 +112,7 @@ subroutine psb_dmatdist(a_glob, a, ctxt, desc_a,& root = psb_root_ end if call psb_info(ctxt, iam, np) - + use_parts = present(parts) use_vg = present(vg) use_vsz = present(vsz) @@ -195,8 +195,9 @@ subroutine psb_dmatdist(a_glob, a, ctxt, desc_a,& end if do while (i_count <= nrow) - if (use_parts) then - call parts(i_count,nrow,np,iwork, np_sharing) + if (use_parts) then + inp = np + call parts(i_count,nrow,inp,iwork, np_sharing) ! ! np_sharing allows for overlap in the data distribution. ! If an index is overlapped, then we have to send its row @@ -211,7 +212,7 @@ subroutine psb_dmatdist(a_glob, a, ctxt, desc_a,& j_count = j_count + 1 if (j_count-i_count >= nb) exit if (j_count > nrow) exit - call parts(j_count,nrow,np,iwrk2, np_sharing) + call parts(j_count,nrow,inp,iwrk2, np_sharing) if (np_sharing /= 1 ) exit if (iwrk2(1) /= iproc ) exit end do @@ -431,8 +432,8 @@ subroutine psb_ldmatdist(a_glob, a, ctxt, desc_a,& ! local variables logical :: use_parts, use_vg, use_vsz - integer(psb_ipk_) :: np, iam, np_sharing, root, iproc - integer(psb_ipk_) :: err_act, il, inz + integer(psb_mpk_) :: np, iam, root, iproc + integer(psb_ipk_) :: err_act, il, inz, np_sharing, inp integer(psb_lpk_) :: k_count, liwork, nnzero, nrhs,& & i, ll, nz, isize, nnr, err integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig, lastigp @@ -533,8 +534,9 @@ subroutine psb_ldmatdist(a_glob, a, ctxt, desc_a,& end if do while (i_count <= nrow) - if (use_parts) then - call parts(i_count,nrow,np,iwork, np_sharing) + if (use_parts) then + inp = np + call parts(i_count,nrow,inp,iwork, np_sharing) ! ! np_sharing allows for overlap in the data distribution. ! If an index is overlapped, then we have to send its row @@ -549,7 +551,7 @@ subroutine psb_ldmatdist(a_glob, a, ctxt, desc_a,& j_count = j_count + 1 if (j_count-i_count >= nb) exit if (j_count > nrow) exit - call parts(j_count,nrow,np,iwrk2, np_sharing) + call parts(j_count,nrow,inp,iwrk2, np_sharing) if (np_sharing /= 1 ) exit if (iwrk2(1) /= iproc ) exit end do diff --git a/util/psb_metispart_mod.F90 b/util/psb_metispart_mod.F90 index 4d6c1226..413bbdff 100644 --- a/util/psb_metispart_mod.F90 +++ b/util/psb_metispart_mod.F90 @@ -117,7 +117,8 @@ contains implicit none type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: root - integer(psb_ipk_) :: me, np, info + integer(psb_ipk_) :: info + integer(psb_mpk_) :: me, np, mroot integer(psb_lpk_) :: n call psb_info(ctxt,me,np) @@ -128,8 +129,8 @@ contains call psb_abort(ctxt) return endif - - if (me == root) then + mroot = root + if (me == mroot) then if (.not.allocated(graph_vect)) then write(psb_err_unit,*) 'Fatal error in DISTR_MTPART: vector GRAPH_VECT ',& & 'not initialized' @@ -137,9 +138,9 @@ contains return endif n = size(graph_vect) - call psb_bcast(ctxt,n,root=root) + call psb_bcast(ctxt,n,root=mroot) else - call psb_bcast(ctxt,n,root=root) + call psb_bcast(ctxt,n,root=mroot) allocate(graph_vect(n),stat=info) if (info /= psb_success_) then @@ -148,7 +149,7 @@ contains return endif endif - call psb_bcast(ctxt,graph_vect(1:n),root=root) + call psb_bcast(ctxt,graph_vect(1:n),root=mroot) return diff --git a/util/psb_s_mat_dist_impl.f90 b/util/psb_s_mat_dist_impl.f90 index 9299998f..126938bf 100644 --- a/util/psb_s_mat_dist_impl.f90 +++ b/util/psb_s_mat_dist_impl.f90 @@ -89,9 +89,9 @@ subroutine psb_smatdist(a_glob, a, ctxt, desc_a,& ! local variables logical :: use_parts, use_vg, use_vsz - integer(psb_ipk_) :: np, iam, np_sharing - integer(psb_ipk_) :: k_count, root, liwork, nnzero, nrhs,& - & i, ll, nz, isize, iproc, nnr, err, err_act + integer(psb_mpk_) :: np, iam, root, iproc + integer(psb_ipk_) :: k_count, inp, np_sharing, liwork, nnzero, nrhs,& + & i, ll, nz, isize, nnr, err, err_act integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig, lastigp integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:) integer(psb_lpk_), allocatable :: irow(:),icol(:) @@ -112,7 +112,7 @@ subroutine psb_smatdist(a_glob, a, ctxt, desc_a,& root = psb_root_ end if call psb_info(ctxt, iam, np) - + use_parts = present(parts) use_vg = present(vg) use_vsz = present(vsz) @@ -195,8 +195,9 @@ subroutine psb_smatdist(a_glob, a, ctxt, desc_a,& end if do while (i_count <= nrow) - if (use_parts) then - call parts(i_count,nrow,np,iwork, np_sharing) + if (use_parts) then + inp = np + call parts(i_count,nrow,inp,iwork, np_sharing) ! ! np_sharing allows for overlap in the data distribution. ! If an index is overlapped, then we have to send its row @@ -211,7 +212,7 @@ subroutine psb_smatdist(a_glob, a, ctxt, desc_a,& j_count = j_count + 1 if (j_count-i_count >= nb) exit if (j_count > nrow) exit - call parts(j_count,nrow,np,iwrk2, np_sharing) + call parts(j_count,nrow,inp,iwrk2, np_sharing) if (np_sharing /= 1 ) exit if (iwrk2(1) /= iproc ) exit end do @@ -431,8 +432,8 @@ subroutine psb_lsmatdist(a_glob, a, ctxt, desc_a,& ! local variables logical :: use_parts, use_vg, use_vsz - integer(psb_ipk_) :: np, iam, np_sharing, root, iproc - integer(psb_ipk_) :: err_act, il, inz + integer(psb_mpk_) :: np, iam, root, iproc + integer(psb_ipk_) :: err_act, il, inz, np_sharing, inp integer(psb_lpk_) :: k_count, liwork, nnzero, nrhs,& & i, ll, nz, isize, nnr, err integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig, lastigp @@ -533,8 +534,9 @@ subroutine psb_lsmatdist(a_glob, a, ctxt, desc_a,& end if do while (i_count <= nrow) - if (use_parts) then - call parts(i_count,nrow,np,iwork, np_sharing) + if (use_parts) then + inp = np + call parts(i_count,nrow,inp,iwork, np_sharing) ! ! np_sharing allows for overlap in the data distribution. ! If an index is overlapped, then we have to send its row @@ -549,7 +551,7 @@ subroutine psb_lsmatdist(a_glob, a, ctxt, desc_a,& j_count = j_count + 1 if (j_count-i_count >= nb) exit if (j_count > nrow) exit - call parts(j_count,nrow,np,iwrk2, np_sharing) + call parts(j_count,nrow,inp,iwrk2, np_sharing) if (np_sharing /= 1 ) exit if (iwrk2(1) /= iproc ) exit end do diff --git a/util/psb_z_mat_dist_impl.f90 b/util/psb_z_mat_dist_impl.f90 index 360cb991..48abe46d 100644 --- a/util/psb_z_mat_dist_impl.f90 +++ b/util/psb_z_mat_dist_impl.f90 @@ -89,9 +89,9 @@ subroutine psb_zmatdist(a_glob, a, ctxt, desc_a,& ! local variables logical :: use_parts, use_vg, use_vsz - integer(psb_ipk_) :: np, iam, np_sharing - integer(psb_ipk_) :: k_count, root, liwork, nnzero, nrhs,& - & i, ll, nz, isize, iproc, nnr, err, err_act + integer(psb_mpk_) :: np, iam, root, iproc + integer(psb_ipk_) :: k_count, inp, np_sharing, liwork, nnzero, nrhs,& + & i, ll, nz, isize, nnr, err, err_act integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig, lastigp integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:) integer(psb_lpk_), allocatable :: irow(:),icol(:) @@ -112,7 +112,7 @@ subroutine psb_zmatdist(a_glob, a, ctxt, desc_a,& root = psb_root_ end if call psb_info(ctxt, iam, np) - + use_parts = present(parts) use_vg = present(vg) use_vsz = present(vsz) @@ -195,8 +195,9 @@ subroutine psb_zmatdist(a_glob, a, ctxt, desc_a,& end if do while (i_count <= nrow) - if (use_parts) then - call parts(i_count,nrow,np,iwork, np_sharing) + if (use_parts) then + inp = np + call parts(i_count,nrow,inp,iwork, np_sharing) ! ! np_sharing allows for overlap in the data distribution. ! If an index is overlapped, then we have to send its row @@ -211,7 +212,7 @@ subroutine psb_zmatdist(a_glob, a, ctxt, desc_a,& j_count = j_count + 1 if (j_count-i_count >= nb) exit if (j_count > nrow) exit - call parts(j_count,nrow,np,iwrk2, np_sharing) + call parts(j_count,nrow,inp,iwrk2, np_sharing) if (np_sharing /= 1 ) exit if (iwrk2(1) /= iproc ) exit end do @@ -431,8 +432,8 @@ subroutine psb_lzmatdist(a_glob, a, ctxt, desc_a,& ! local variables logical :: use_parts, use_vg, use_vsz - integer(psb_ipk_) :: np, iam, np_sharing, root, iproc - integer(psb_ipk_) :: err_act, il, inz + integer(psb_mpk_) :: np, iam, root, iproc + integer(psb_ipk_) :: err_act, il, inz, np_sharing, inp integer(psb_lpk_) :: k_count, liwork, nnzero, nrhs,& & i, ll, nz, isize, nnr, err integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig, lastigp @@ -533,8 +534,9 @@ subroutine psb_lzmatdist(a_glob, a, ctxt, desc_a,& end if do while (i_count <= nrow) - if (use_parts) then - call parts(i_count,nrow,np,iwork, np_sharing) + if (use_parts) then + inp = np + call parts(i_count,nrow,inp,iwork, np_sharing) ! ! np_sharing allows for overlap in the data distribution. ! If an index is overlapped, then we have to send its row @@ -549,7 +551,7 @@ subroutine psb_lzmatdist(a_glob, a, ctxt, desc_a,& j_count = j_count + 1 if (j_count-i_count >= nb) exit if (j_count > nrow) exit - call parts(j_count,nrow,np,iwrk2, np_sharing) + call parts(j_count,nrow,inp,iwrk2, np_sharing) if (np_sharing /= 1 ) exit if (iwrk2(1) /= iproc ) exit end do