From 1ed539347e0f3b4d19e15433b0d09ce4698204b4 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sat, 4 Feb 2012 17:12:05 +0000 Subject: [PATCH] psblas3-integer8: base/modules/psi_p2p_mod.F90 base/modules/psi_penv_mod.F90 test/pargen/ppde.f90 util/psb_c_mat_dist_impl.f90 util/psb_c_renum_impl.F90 util/psb_d_mat_dist_impl.f90 util/psb_d_renum_impl.F90 util/psb_s_mat_dist_impl.f90 util/psb_s_renum_impl.F90 util/psb_z_mat_dist_impl.f90 util/psb_z_renum_impl.F90 8-bytes version now compiles cleanly. ppde runs in serial mode but hangs in parallel; will need a bit of debugging. --- base/modules/psi_p2p_mod.F90 | 583 ++++++++++++++++++++++++++++++++++ base/modules/psi_penv_mod.F90 | 30 +- test/pargen/ppde.f90 | 13 +- util/psb_c_mat_dist_impl.f90 | 4 +- util/psb_c_renum_impl.F90 | 24 +- util/psb_d_mat_dist_impl.f90 | 4 +- util/psb_d_renum_impl.F90 | 8 +- util/psb_s_mat_dist_impl.f90 | 4 +- util/psb_s_renum_impl.F90 | 24 +- util/psb_z_mat_dist_impl.f90 | 4 +- util/psb_z_renum_impl.F90 | 24 +- 11 files changed, 681 insertions(+), 41 deletions(-) diff --git a/base/modules/psi_p2p_mod.F90 b/base/modules/psi_p2p_mod.F90 index 77bd9369..c89b1ad3 100644 --- a/base/modules/psi_p2p_mod.F90 +++ b/base/modules/psi_p2p_mod.F90 @@ -45,6 +45,28 @@ module psi_p2p_mod #endif +#if defined(LONG_INTEGERS) + interface psb_snd + module procedure psb_isnds_ic, psb_isndv_ic, psb_isndm_ic, & + & psb_ssnds_ic, psb_ssndv_ic, psb_ssndm_ic,& + & psb_dsnds_ic, psb_dsndv_ic, psb_dsndm_ic,& + & psb_csnds_ic, psb_csndv_ic, psb_csndm_ic,& + & psb_zsnds_ic, psb_zsndv_ic, psb_zsndm_ic,& + & psb_lsnds_ic, psb_lsndv_ic, & + & psb_lsndm_ic, psb_hsnds_ic + end interface + + interface psb_rcv + module procedure psb_ircvs_ic, psb_ircvv_ic, psb_ircvm_ic, & + & psb_srcvs_ic, psb_srcvv_ic, psb_srcvm_ic,& + & psb_drcvs_ic, psb_drcvv_ic, psb_drcvm_ic,& + & psb_crcvs_ic, psb_crcvv_ic, psb_crcvm_ic,& + & psb_zrcvs_ic, psb_zrcvv_ic, psb_zrcvm_ic,& + & psb_lrcvs_ic, psb_lrcvv_ic, & + & psb_lrcvm_ic, psb_hrcvs_ic + end interface + +#endif integer(psb_mpik_), private, parameter:: psb_int_tag = 543987 integer(psb_mpik_), private, parameter:: psb_real_tag = psb_int_tag + 1 @@ -1540,4 +1562,565 @@ contains #endif + +! +! Integer * 8 aliases. +! + +#if defined(LONG_INTEGERS) + ! !!!!!!!!!!!!!!!!!!!!!!!! + ! + ! Point-to-point SND + ! + ! !!!!!!!!!!!!!!!!!!!!!!!! + + subroutine psb_isnds_ic(ictxt,dat,dst) + + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: dat + integer(psb_ipk_), intent(in) :: dst + + integer(psb_mpik_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_isnds_ic + + subroutine psb_isndv_ic(ictxt,dat,dst) + + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: dat(:) + integer(psb_ipk_), intent(in) :: dst + + integer(psb_mpik_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_isndv_ic + + subroutine psb_isndm_ic(ictxt,dat,dst,m) + + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: dat(:,:) + integer(psb_ipk_), intent(in) :: dst + + integer(psb_mpik_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_isndm_ic + + subroutine psb_ssnds_ic(ictxt,dat,dst) + + integer(psb_ipk_), intent(in) :: ictxt + real(psb_spk_), intent(in) :: dat + integer(psb_ipk_), intent(in) :: dst + + integer(psb_mpik_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_ssnds_ic + + subroutine psb_ssndv_ic(ictxt,dat,dst) + + integer(psb_ipk_), intent(in) :: ictxt + real(psb_spk_), intent(in) :: dat(:) + integer(psb_ipk_), intent(in) :: dst + + integer(psb_mpik_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_ssndv_ic + + subroutine psb_ssndm_ic(ictxt,dat,dst,m) + + integer(psb_ipk_), intent(in) :: ictxt + real(psb_spk_), intent(in) :: dat(:,:) + integer(psb_ipk_), intent(in) :: dst + + integer(psb_mpik_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_ssndm_ic + + + subroutine psb_dsnds_ic(ictxt,dat,dst) + + integer(psb_ipk_), intent(in) :: ictxt + real(psb_dpk_), intent(in) :: dat + integer(psb_ipk_), intent(in) :: dst + + integer(psb_mpik_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_dsnds_ic + + subroutine psb_dsndv_ic(ictxt,dat,dst) + + integer(psb_ipk_), intent(in) :: ictxt + real(psb_dpk_), intent(in) :: dat(:) + integer(psb_ipk_), intent(in) :: dst + + integer(psb_mpik_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_dsndv_ic + + subroutine psb_dsndm_ic(ictxt,dat,dst,m) + + integer(psb_ipk_), intent(in) :: ictxt + real(psb_dpk_), intent(in) :: dat(:,:) + integer(psb_ipk_), intent(in) :: dst + + integer(psb_mpik_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_dsndm_ic + + + subroutine psb_csnds_ic(ictxt,dat,dst) + + integer(psb_ipk_), intent(in) :: ictxt + complex(psb_spk_), intent(in) :: dat + integer(psb_ipk_), intent(in) :: dst + + integer(psb_mpik_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_csnds_ic + + subroutine psb_csndv_ic(ictxt,dat,dst) + + integer(psb_ipk_), intent(in) :: ictxt + complex(psb_spk_), intent(in) :: dat(:) + integer(psb_ipk_), intent(in) :: dst + + integer(psb_mpik_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_csndv_ic + + subroutine psb_csndm_ic(ictxt,dat,dst,m) + + integer(psb_ipk_), intent(in) :: ictxt + complex(psb_spk_), intent(in) :: dat(:,:) + integer(psb_ipk_), intent(in) :: dst + + integer(psb_mpik_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_csndm_ic + + + subroutine psb_zsnds_ic(ictxt,dat,dst) + + integer(psb_ipk_), intent(in) :: ictxt + complex(psb_dpk_), intent(in) :: dat + integer(psb_ipk_), intent(in) :: dst + + integer(psb_mpik_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_zsnds_ic + + subroutine psb_zsndv_ic(ictxt,dat,dst) + + integer(psb_ipk_), intent(in) :: ictxt + complex(psb_dpk_), intent(in) :: dat(:) + integer(psb_ipk_), intent(in) :: dst + + integer(psb_mpik_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_zsndv_ic + + subroutine psb_zsndm_ic(ictxt,dat,dst,m) + integer(psb_ipk_), intent(in) :: ictxt + complex(psb_dpk_), intent(in) :: dat(:,:) + integer(psb_ipk_), intent(in) :: dst + + integer(psb_mpik_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_zsndm_ic + + + subroutine psb_lsnds_ic(ictxt,dat,dst) + integer(psb_ipk_), intent(in) :: ictxt + logical, intent(in) :: dat + integer(psb_ipk_), intent(in) :: dst + + integer(psb_mpik_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_lsnds_ic + + subroutine psb_lsndv_ic(ictxt,dat,dst) + + integer(psb_ipk_), intent(in) :: ictxt + logical, intent(in) :: dat(:) + integer(psb_ipk_), intent(in) :: dst + + integer(psb_mpik_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_lsndv_ic + + subroutine psb_lsndm_ic(ictxt,dat,dst,m) + + integer(psb_ipk_), intent(in) :: ictxt + logical, intent(in) :: dat(:,:) + integer(psb_ipk_), intent(in) :: dst + + integer(psb_mpik_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_lsndm_ic + + + subroutine psb_hsnds_ic(ictxt,dat,dst) + + integer(psb_ipk_), intent(in) :: ictxt + character(len=*), intent(in) :: dat + integer(psb_ipk_), intent(in) :: dst + + integer(psb_mpik_) :: iictxt, idst + + iictxt = ictxt + idst = dst + call psb_snd(iictxt, dat, idst) + + end subroutine psb_hsnds_ic + + + ! !!!!!!!!!!!!!!!!!!!!!!!! + ! + ! Point-to-point RCV + ! + ! !!!!!!!!!!!!!!!!!!!!!!!! + + subroutine psb_ircvs_ic(ictxt,dat,src) + + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: dat + integer(psb_ipk_), intent(in) :: src + + integer(psb_mpik_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_ircvs_ic + + subroutine psb_ircvv_ic(ictxt,dat,src) + + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: dat(:) + integer(psb_ipk_), intent(in) :: src + + integer(psb_mpik_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_ircvv_ic + + subroutine psb_ircvm_ic(ictxt,dat,src,m) + + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: dat(:,:) + integer(psb_ipk_), intent(in) :: src + + integer(psb_mpik_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_ircvm_ic + + subroutine psb_srcvs_ic(ictxt,dat,src) + + integer(psb_ipk_), intent(in) :: ictxt + real(psb_spk_), intent(out) :: dat + integer(psb_ipk_), intent(in) :: src + + integer(psb_mpik_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_srcvs_ic + + subroutine psb_srcvv_ic(ictxt,dat,src) + + integer(psb_ipk_), intent(in) :: ictxt + real(psb_spk_), intent(out) :: dat(:) + integer(psb_ipk_), intent(in) :: src + + integer(psb_mpik_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_srcvv_ic + + subroutine psb_srcvm_ic(ictxt,dat,src,m) + + integer(psb_ipk_), intent(in) :: ictxt + real(psb_spk_), intent(out) :: dat(:,:) + integer(psb_ipk_), intent(in) :: src + + integer(psb_mpik_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_srcvm_ic + + + subroutine psb_drcvs_ic(ictxt,dat,src) + + integer(psb_ipk_), intent(in) :: ictxt + real(psb_dpk_), intent(out) :: dat + integer(psb_ipk_), intent(in) :: src + + integer(psb_mpik_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_drcvs_ic + + subroutine psb_drcvv_ic(ictxt,dat,src) + + integer(psb_ipk_), intent(in) :: ictxt + real(psb_dpk_), intent(out) :: dat(:) + integer(psb_ipk_), intent(in) :: src + + integer(psb_mpik_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_drcvv_ic + + subroutine psb_drcvm_ic(ictxt,dat,src,m) + + integer(psb_ipk_), intent(in) :: ictxt + real(psb_dpk_), intent(out) :: dat(:,:) + integer(psb_ipk_), intent(in) :: src + + integer(psb_mpik_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_drcvm_ic + + + subroutine psb_crcvs_ic(ictxt,dat,src) + + integer(psb_ipk_), intent(in) :: ictxt + complex(psb_spk_), intent(out) :: dat + integer(psb_ipk_), intent(in) :: src + + integer(psb_mpik_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_crcvs_ic + + subroutine psb_crcvv_ic(ictxt,dat,src) + + integer(psb_ipk_), intent(in) :: ictxt + complex(psb_spk_), intent(out) :: dat(:) + integer(psb_ipk_), intent(in) :: src + + integer(psb_mpik_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_crcvv_ic + + subroutine psb_crcvm_ic(ictxt,dat,src,m) + + integer(psb_ipk_), intent(in) :: ictxt + complex(psb_spk_), intent(out) :: dat(:,:) + integer(psb_ipk_), intent(in) :: src + + integer(psb_mpik_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_crcvm_ic + + + subroutine psb_zrcvs_ic(ictxt,dat,src) + + integer(psb_ipk_), intent(in) :: ictxt + complex(psb_dpk_), intent(out) :: dat + integer(psb_ipk_), intent(in) :: src + + integer(psb_mpik_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_zrcvs_ic + + subroutine psb_zrcvv_ic(ictxt,dat,src) + + integer(psb_ipk_), intent(in) :: ictxt + complex(psb_dpk_), intent(out) :: dat(:) + integer(psb_ipk_), intent(in) :: src + + integer(psb_mpik_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_zrcvv_ic + + subroutine psb_zrcvm_ic(ictxt,dat,src,m) + integer(psb_ipk_), intent(in) :: ictxt + complex(psb_dpk_), intent(out) :: dat(:,:) + integer(psb_ipk_), intent(in) :: src + + integer(psb_mpik_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_zrcvm_ic + + + subroutine psb_lrcvs_ic(ictxt,dat,src) + integer(psb_ipk_), intent(in) :: ictxt + logical, intent(out) :: dat + integer(psb_ipk_), intent(in) :: src + + integer(psb_mpik_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_lrcvs_ic + + subroutine psb_lrcvv_ic(ictxt,dat,src) + + integer(psb_ipk_), intent(in) :: ictxt + logical, intent(out) :: dat(:) + integer(psb_ipk_), intent(in) :: src + + integer(psb_mpik_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_lrcvv_ic + + subroutine psb_lrcvm_ic(ictxt,dat,src,m) + + integer(psb_ipk_), intent(in) :: ictxt + logical, intent(out) :: dat(:,:) + integer(psb_ipk_), intent(in) :: src + + integer(psb_mpik_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_lrcvm_ic + + + subroutine psb_hrcvs_ic(ictxt,dat,src) + + integer(psb_ipk_), intent(in) :: ictxt + character(len=*), intent(out) :: dat + integer(psb_ipk_), intent(in) :: src + + integer(psb_mpik_) :: iictxt, isrc + + iictxt = ictxt + isrc = src + call psb_rcv(iictxt, dat, isrc) + + end subroutine psb_hrcvs_ic + + +#endif + + end module psi_p2p_mod diff --git a/base/modules/psi_penv_mod.F90 b/base/modules/psi_penv_mod.F90 index e20e681a..bd2effef 100644 --- a/base/modules/psi_penv_mod.F90 +++ b/base/modules/psi_penv_mod.F90 @@ -3,23 +3,23 @@ module psi_penv_mod use psi_comm_buffers_mod, only : psb_buffer_queue interface psb_init - module procedure psb_init + module procedure psb_init_mpik end interface interface psb_exit - module procedure psb_exit + module procedure psb_exit_mpik end interface interface psb_abort - module procedure psb_abort + module procedure psb_abort_mpik end interface interface psb_info - module procedure psb_info + module procedure psb_info_mpik end interface interface psb_barrier - module procedure psb_barrier + module procedure psb_barrier_mpik end interface #if defined(LONG_INTEGERS) @@ -204,7 +204,7 @@ contains #endif - subroutine psb_init(ictxt,np,basectxt,ids) + subroutine psb_init_mpik(ictxt,np,basectxt,ids) use psi_comm_buffers_mod use psb_const_mod use psb_error_mod @@ -329,9 +329,9 @@ contains ! !$ endif ! !$ endif - end subroutine psb_init + end subroutine psb_init_mpik - subroutine psb_exit(ictxt,close) + subroutine psb_exit_mpik(ictxt,close) use psi_comm_buffers_mod ! !$ use psb_rsb_mod #ifdef MPI_MOD @@ -381,10 +381,10 @@ contains #endif - end subroutine psb_exit + end subroutine psb_exit_mpik - subroutine psb_barrier(ictxt) + subroutine psb_barrier_mpik(ictxt) #ifdef MPI_MOD use mpi #endif @@ -401,7 +401,7 @@ contains end if #endif - end subroutine psb_barrier + end subroutine psb_barrier_mpik function psb_wtime() use psb_const_mod @@ -417,7 +417,7 @@ contains psb_wtime = mpi_wtime() end function psb_wtime - subroutine psb_abort(ictxt,errc) + subroutine psb_abort_mpik(ictxt,errc) use psi_comm_buffers_mod integer(psb_mpik_), intent(in) :: ictxt @@ -437,10 +437,10 @@ contains call mpi_abort(ictxt,code,info) #endif - end subroutine psb_abort + end subroutine psb_abort_mpik - subroutine psb_info(ictxt,iam,np) + subroutine psb_info_mpik(ictxt,iam,np) use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -468,7 +468,7 @@ contains end if #endif - end subroutine psb_info + end subroutine psb_info_mpik subroutine psb_get_mpicomm(ictxt,comm) diff --git a/test/pargen/ppde.f90 b/test/pargen/ppde.f90 index f33d6d0f..1fd2f76c 100644 --- a/test/pargen/ppde.f90 +++ b/test/pargen/ppde.f90 @@ -92,7 +92,7 @@ program ppde integer(psb_ipk_) :: iter, itmax,itrace, istopc, irst integer(psb_long_int_k_) :: amatsize, precsize, descsize, d2size real(psb_dpk_) :: err, eps - + integer(psb_mpik_) :: iict ! other variables integer(psb_ipk_) :: info, i character(len=20) :: name,ch_err @@ -101,9 +101,10 @@ program ppde info=psb_success_ - call psb_init(ictxt) + call psb_init(iict) + ictxt = iict call psb_info(ictxt,iam,np) - + write(0,*) 'Fromt init/info',iam,np if (iam < 0) then ! This should not happen, but just in case call psb_exit(ictxt) @@ -111,7 +112,7 @@ program ppde endif if(psb_get_errstatus() /= 0) goto 9999 name='pde90' - call psb_set_errverbosity(2) + call psb_set_errverbosity(itwo) ! ! Hello world ! @@ -148,7 +149,7 @@ program ppde !!$ call psb_cdcpy(desc_a,desc_b,info) !!$ call psb_set_debug_level(9999) - call psb_cdbldext(a,desc_a,2,desc_b,info,extype=psb_ovt_asov_) + call psb_cdbldext(a,desc_a,itwo,desc_b,info,extype=psb_ovt_asov_) if (info /= 0) then write(0,*) 'Error from bldext' call psb_abort(ictxt) @@ -317,7 +318,7 @@ contains write(psb_out_unit,'(" ")') else ! wrong number of parameter, print an error message and exit - call pr_usage(0) + call pr_usage(izero) call psb_abort(ictxt) stop 1 endif diff --git a/util/psb_c_mat_dist_impl.f90 b/util/psb_c_mat_dist_impl.f90 index 107f7e49..aeaa24e7 100644 --- a/util/psb_c_mat_dist_impl.f90 +++ b/util/psb_c_mat_dist_impl.f90 @@ -365,7 +365,7 @@ subroutine cmatdist(a_glob, a, ictxt, desc_a,& call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - call psb_geins(1,(/i_count/),b_glob(i_count:i_count),& + call psb_geins(ione,(/i_count/),b_glob(i_count:i_count),& & b,desc_a,info) if(info /= psb_success_) then info=psb_err_from_subroutine_ @@ -396,7 +396,7 @@ subroutine cmatdist(a_glob, a, ictxt, desc_a,& call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - call psb_geins(1,(/i_count/),b_glob(i_count:i_count),& + call psb_geins(ione,(/i_count/),b_glob(i_count:i_count),& & b,desc_a,info) if(info /= psb_success_) then info=psb_err_from_subroutine_ diff --git a/util/psb_c_renum_impl.F90 b/util/psb_c_renum_impl.F90 index 0e81a748..4e1699a6 100644 --- a/util/psb_c_renum_impl.F90 +++ b/util/psb_c_renum_impl.F90 @@ -20,9 +20,13 @@ subroutine psb_c_mat_renums(alg,mat,info,perm) ialg = psb_mat_renum_gps_ case ('AMD') ialg = psb_mat_renum_amd_ + case ('NONE', 'ID') + ialg = psb_mat_renum_identity_ case default + write(0,*) 'Unknown algorithm "',psb_toupper(alg),'"' ialg = -1 end select + call psb_mat_renum(ialg,mat,info,perm) if (info /= psb_success_) then @@ -52,7 +56,7 @@ subroutine psb_c_mat_renum(alg,mat,info,perm) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), allocatable, optional, intent(out) :: perm(:) - integer(psb_ipk_) :: err_act, nr, nc + integer(psb_ipk_) :: err_act, nr, nc, i, ierr(5) character(len=20) :: name info = psb_success_ @@ -65,7 +69,8 @@ subroutine psb_c_mat_renum(alg,mat,info,perm) nc = mat%get_ncols() if (nr /= nc) then info = psb_err_rectangular_mat_unsupported_ - call psb_errpush(info,name,i_err=(/nr,nc,0,0,0/)) + ierr(1) = nr; ierr(2) = nc; + call psb_errpush(info,name,i_err=ierr) goto 9999 end if @@ -78,9 +83,22 @@ subroutine psb_c_mat_renum(alg,mat,info,perm) call psb_mat_renum_amd(mat,info,perm) + case(psb_mat_renum_identity_) + nr = mat%get_nrows() + allocate(perm(nr),stat=info) + if (info == 0) then + do i=1,nr + perm(i) = i + end do + else + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif case default info = psb_err_input_value_invalid_i_ - call psb_errpush(info,name,i_err=(/1,alg,0,0,0/)) + ierr(1) = 1; ierr(2) = alg; + call psb_errpush(info,name,i_err=ierr) goto 9999 end select diff --git a/util/psb_d_mat_dist_impl.f90 b/util/psb_d_mat_dist_impl.f90 index 00a611f1..e6c950a4 100644 --- a/util/psb_d_mat_dist_impl.f90 +++ b/util/psb_d_mat_dist_impl.f90 @@ -366,7 +366,7 @@ subroutine dmatdist(a_glob, a, ictxt, desc_a,& call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - call psb_geins(1,(/i_count/),b_glob(i_count:i_count),& + call psb_geins(ione,(/i_count/),b_glob(i_count:i_count),& & b,desc_a,info) if(info /= psb_success_) then info=psb_err_from_subroutine_ @@ -397,7 +397,7 @@ subroutine dmatdist(a_glob, a, ictxt, desc_a,& call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - call psb_geins(1,(/i_count/),b_glob(i_count:i_count),& + call psb_geins(ione,(/i_count/),b_glob(i_count:i_count),& & b,desc_a,info) if(info /= psb_success_) then info=psb_err_from_subroutine_ diff --git a/util/psb_d_renum_impl.F90 b/util/psb_d_renum_impl.F90 index 8d4b3888..643310d4 100644 --- a/util/psb_d_renum_impl.F90 +++ b/util/psb_d_renum_impl.F90 @@ -56,7 +56,7 @@ subroutine psb_d_mat_renum(alg,mat,info,perm) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), allocatable, optional, intent(out) :: perm(:) - integer(psb_ipk_) :: err_act, nr, nc, i + integer(psb_ipk_) :: err_act, nr, nc, i, ierr(5) character(len=20) :: name info = psb_success_ @@ -69,7 +69,8 @@ subroutine psb_d_mat_renum(alg,mat,info,perm) nc = mat%get_ncols() if (nr /= nc) then info = psb_err_rectangular_mat_unsupported_ - call psb_errpush(info,name,i_err=(/nr,nc,0,0,0/)) + ierr(1) = nr; ierr(2) = nc; + call psb_errpush(info,name,i_err=ierr) goto 9999 end if @@ -96,7 +97,8 @@ subroutine psb_d_mat_renum(alg,mat,info,perm) endif case default info = psb_err_input_value_invalid_i_ - call psb_errpush(info,name,i_err=(/1,alg,0,0,0/)) + ierr(1) = 1; ierr(2) = alg; + call psb_errpush(info,name,i_err=ierr) goto 9999 end select diff --git a/util/psb_s_mat_dist_impl.f90 b/util/psb_s_mat_dist_impl.f90 index 32df68bf..828dfb04 100644 --- a/util/psb_s_mat_dist_impl.f90 +++ b/util/psb_s_mat_dist_impl.f90 @@ -365,7 +365,7 @@ subroutine smatdist(a_glob, a, ictxt, desc_a,& call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - call psb_geins(1,(/i_count/),b_glob(i_count:i_count),& + call psb_geins(ione,(/i_count/),b_glob(i_count:i_count),& & b,desc_a,info) if(info /= psb_success_) then info=psb_err_from_subroutine_ @@ -396,7 +396,7 @@ subroutine smatdist(a_glob, a, ictxt, desc_a,& call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - call psb_geins(1,(/i_count/),b_glob(i_count:i_count),& + call psb_geins(ione,(/i_count/),b_glob(i_count:i_count),& & b,desc_a,info) if(info /= psb_success_) then info=psb_err_from_subroutine_ diff --git a/util/psb_s_renum_impl.F90 b/util/psb_s_renum_impl.F90 index 15cd72e4..964bfbd8 100644 --- a/util/psb_s_renum_impl.F90 +++ b/util/psb_s_renum_impl.F90 @@ -20,9 +20,13 @@ subroutine psb_s_mat_renums(alg,mat,info,perm) ialg = psb_mat_renum_gps_ case ('AMD') ialg = psb_mat_renum_amd_ + case ('NONE', 'ID') + ialg = psb_mat_renum_identity_ case default + write(0,*) 'Unknown algorithm "',psb_toupper(alg),'"' ialg = -1 end select + call psb_mat_renum(ialg,mat,info,perm) if (info /= psb_success_) then @@ -52,7 +56,7 @@ subroutine psb_s_mat_renum(alg,mat,info,perm) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), allocatable, optional, intent(out) :: perm(:) - integer(psb_ipk_) :: err_act, nr, nc + integer(psb_ipk_) :: err_act, nr, nc, i, ierr(5) character(len=20) :: name info = psb_success_ @@ -65,7 +69,8 @@ subroutine psb_s_mat_renum(alg,mat,info,perm) nc = mat%get_ncols() if (nr /= nc) then info = psb_err_rectangular_mat_unsupported_ - call psb_errpush(info,name,i_err=(/nr,nc,0,0,0/)) + ierr(1) = nr; ierr(2) = nc; + call psb_errpush(info,name,i_err=ierr) goto 9999 end if @@ -78,9 +83,22 @@ subroutine psb_s_mat_renum(alg,mat,info,perm) call psb_mat_renum_amd(mat,info,perm) + case(psb_mat_renum_identity_) + nr = mat%get_nrows() + allocate(perm(nr),stat=info) + if (info == 0) then + do i=1,nr + perm(i) = i + end do + else + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif case default info = psb_err_input_value_invalid_i_ - call psb_errpush(info,name,i_err=(/1,alg,0,0,0/)) + ierr(1) = 1; ierr(2) = alg; + call psb_errpush(info,name,i_err=ierr) goto 9999 end select diff --git a/util/psb_z_mat_dist_impl.f90 b/util/psb_z_mat_dist_impl.f90 index 694552de..0ba215c1 100644 --- a/util/psb_z_mat_dist_impl.f90 +++ b/util/psb_z_mat_dist_impl.f90 @@ -365,7 +365,7 @@ subroutine zmatdist(a_glob, a, ictxt, desc_a,& call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - call psb_geins(1,(/i_count/),b_glob(i_count:i_count),& + call psb_geins(ione,(/i_count/),b_glob(i_count:i_count),& & b,desc_a,info) if(info /= psb_success_) then info=psb_err_from_subroutine_ @@ -396,7 +396,7 @@ subroutine zmatdist(a_glob, a, ictxt, desc_a,& call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - call psb_geins(1,(/i_count/),b_glob(i_count:i_count),& + call psb_geins(ione,(/i_count/),b_glob(i_count:i_count),& & b,desc_a,info) if(info /= psb_success_) then info=psb_err_from_subroutine_ diff --git a/util/psb_z_renum_impl.F90 b/util/psb_z_renum_impl.F90 index bb06bccf..0f728ded 100644 --- a/util/psb_z_renum_impl.F90 +++ b/util/psb_z_renum_impl.F90 @@ -20,9 +20,13 @@ subroutine psb_z_mat_renums(alg,mat,info,perm) ialg = psb_mat_renum_gps_ case ('AMD') ialg = psb_mat_renum_amd_ + case ('NONE', 'ID') + ialg = psb_mat_renum_identity_ case default + write(0,*) 'Unknown algorithm "',psb_toupper(alg),'"' ialg = -1 end select + call psb_mat_renum(ialg,mat,info,perm) if (info /= psb_success_) then @@ -52,7 +56,7 @@ subroutine psb_z_mat_renum(alg,mat,info,perm) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), allocatable, optional, intent(out) :: perm(:) - integer(psb_ipk_) :: err_act, nr, nc + integer(psb_ipk_) :: err_act, nr, nc, i, ierr(5) character(len=20) :: name info = psb_success_ @@ -65,7 +69,8 @@ subroutine psb_z_mat_renum(alg,mat,info,perm) nc = mat%get_ncols() if (nr /= nc) then info = psb_err_rectangular_mat_unsupported_ - call psb_errpush(info,name,i_err=(/nr,nc,0,0,0/)) + ierr(1) = nr; ierr(2) = nc; + call psb_errpush(info,name,i_err=ierr) goto 9999 end if @@ -78,9 +83,22 @@ subroutine psb_z_mat_renum(alg,mat,info,perm) call psb_mat_renum_amd(mat,info,perm) + case(psb_mat_renum_identity_) + nr = mat%get_nrows() + allocate(perm(nr),stat=info) + if (info == 0) then + do i=1,nr + perm(i) = i + end do + else + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif case default info = psb_err_input_value_invalid_i_ - call psb_errpush(info,name,i_err=(/1,alg,0,0,0/)) + ierr(1) = 1; ierr(2) = alg; + call psb_errpush(info,name,i_err=ierr) goto 9999 end select