fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-20 21:02:26 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas3-integer8:

Browse Source 
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.
This commit is contained in:
Salvatore Filippone
2012-02-04 17:12:05 +00:00
parent 2f1c0e8892
commit 1ed539347e
11 changed files with 681 additions and 41 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psi_p2p_mod.F90
+583
View File
@@ -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
base/modules/psi_penv_mod.F90
+15 -15
View File
@@ -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)
test/pargen/ppde.f90
+7 -6
View File
@@ -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
util/psb_c_mat_dist_impl.f90
+2 -2
View File
@@ -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_
util/psb_c_renum_impl.F90
+21 -3
View File
@@ -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
util/psb_d_mat_dist_impl.f90
+2 -2
View File
@@ -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_
util/psb_d_renum_impl.F90
+5 -3
View File
@@ -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
util/psb_s_mat_dist_impl.f90
+2 -2
View File
@@ -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_
util/psb_s_renum_impl.F90
+21 -3
View File
@@ -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
util/psb_z_mat_dist_impl.f90
+2 -2
View File
@@ -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_
util/psb_z_renum_impl.F90
+21 -3
View File
@@ -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